问题
I was wondering if there is any package in R that could use x, y coordinates and shape sizes to draw something like this:
I have the coordinates of vehicles' front centers and their sizes (length and width).
Edit
This is what the original data set looks like:
> head(df)
Vehicle.ID Frame.ID Global.X Global.Y Vehicle.Length Vehicle.width Lane Preceding.Vehicle.ID Following.Vehicle.ID Spacing Headway
1 2 43 6451214 1873261 14.5 4.9 2 0 13 0 0
2 2 44 6451217 1873258 14.5 4.9 2 0 13 0 0
3 2 45 6451220 1873256 14.5 4.9 2 0 13 0 0
4 2 46 6451223 1873253 14.5 4.9 2 0 13 0 0
5 2 47 6451225 1873250 14.5 4.9 2 0 13 0 0
6 2 48 6451228 1873247 14.5 4.9 2 0 13 0 0
For any given frame, I want to visualize the gaps, e.g., for frame no. 500:
ff <- subset(df, Frame.ID==500)
qplot(x=Global.X, y=Global.Y, data=ff)
All these dots are the front center coordinates of vehicles. I don't know how to display the length and width of each vehicle and label the gap values.
回答1:
So, I don't advocate you rely on ggplot
to do this as most likely some of the other suggested solutions are better, but this problem got me interested as I've been meaning to dig into the guts of ggplot
for a while. This is what I managed to come up with:
ggplot(df, aes(x=x, y=y, length=length, width=width, fill=label)) +
geom_hline(yintercept=seq(5, 35, by=10), color="white", size=2, linetype=2) +
geom_car() +
coord_equal() +
theme(panel.background = element_rect(fill="#555555"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank())
You can also add arrows with geom_segment
or explicit labels with geom_text
, but we leave that as an exercise for the reader.
Now, for this to work, we had to create geom_car
, though if you don't require detailed pictures, you could just use geom_rect
. Here is geom_car
(note: also now available as part of the ggbg package):
# Generate a car 'grob' using a baseline PNG
car.raster <- png::readPNG("~/Downloads/car2.png")
# The `grid` grob actually responsible for rendering our car,
# combines our transparent car elements with a background rectangle
# for color/fill.
carGrob <- function(x, y, length, width, gp) {
grid::grobTree(
grid::rectGrob(
x, y, hjust=.5, height=width, width=length,
gp = gp
),
grid::rasterGrob(
car.raster, x=x, y=y, hjust=.5, height=width, width=length
) ) }
# The `ggproto` object that maps our data to the `grid` grobs
GeomCar <- ggplot2::ggproto("GeomCar", ggplot2::Geom,
# Generate grobs from the data, we have to reconvert length/width so
# that the transformations persist
draw_panel=function(self, data, panel_params, coords) {
with(
coords$transform(data, panel_params),
carGrob(
x, y, length=xmax-xmin, width=ymax-ymin,
gp=grid::gpar(
col = colour, fill = alpha(fill, alpha),
lwd = size * .pt, lty = linetype, lineend = "butt"
) ) ) },
# Convert data to coordinates that will get transformed (length/width don't
# normally).
setup_data=function(self, data, params) {
transform(data,
xmin = x - length / 2, xmax = x + length / 2,
ymin = y - width / 2, ymax = y + width / 2
) },
# Required and default aesthetics
required_aes=c("x", "y", "length", "width"),
default_aes = aes(
colour = NA, fill = "grey35", size = 0.5, linetype = 1, alpha = NA
),
# Use the car grob in the legend
draw_key = function(data, params, size) {
with(
data,
carGrob(
0.5, 0.5, length=.75, width=.5,
gp = grid::gpar(
col = colour, fill = alpha(fill, alpha),
lwd = size * .pt, lty = linetype, lineend = "butt"
) ) ) }
)
# External interface
geom_car <- function(
mapping=NULL, data=NULL, ..., inherit.aes=TRUE, show.legend=NA
) {
layer(
data=data, mapping=mapping, geom=GeomCar, position="identity",
stat="identity", show.legend = show.legend, inherit.aes = inherit.aes,
params=list(...)
)
}
The car:
The data:
df <- read.table(h=T, t="vehicle x y length width label
1 150 10 14 5 other
2 180 8 12 5 other
3 220 10 18 5 other
4 145 20 15 5 target
5 250 18 14 5 other
6 160 30 13 5 autonomous
7 200 33 15 5 other
8 240 31 22 5 other
")
来源:https://stackoverflow.com/questions/22159087/is-it-possible-to-draw-diagrams-in-r