使用雷达坐标将线段添加到ggplot2中的直方图中 [英] Add line segments to histogram in ggplot2 with radar coordinates
问题描述
我试图在ggplot2中使用非径向线的注释线制作极坐标直方图.
I am trying to make a polar histogram in ggplot2 with annotation lines which are not radial lines.
使用 coord_polar 的简单方法给出了曲线:
The simple approach with coord_polar gives curved lines:
library(ggplot2)
d = data.frame(x=rep(seq(0, 350, 10), times=1:36))
lines = data.frame(x = c(40, 90, 150, 220, 270),
y = c(20, 20, 20, 20, 20),
xend = c(115, 165, 225, 295, 345),
yend = c(5, 5, 5, 5, 5))
ggplot(d, aes(x)) +
geom_histogram(binwidth = 10) +
geom_segment(data = lines,
aes(x, y, xend = xend, yend = yend),
color = 'red') +
coord_polar() +
scale_x_continuous(limits=c(0, 360))
第二次尝试使用 coord_radar ，它们来自StackOverflow和邮件列表上的各种来源:
Second try uses coord_radar, from various sources on StackOverflow and mail lists:
coord_radar <- function (theta = "x", start = 0, direction = 1)
{
theta <- match.arg(theta, c("x", "y"))
r <- if (theta == "x")
"y"
else "x"
ggproto("CoordRadar", CoordPolar, theta = theta, r = r, start = start,
direction = sign(direction),
is_linear = function(coord) TRUE)
}
ggplot(d, aes(x)) +
geom_histogram(binwidth = 10) +
geom_segment(data = lines,
aes(x, y, xend = xend, yend = yend),
color = 'red') +
coord_radar()
这完全失败:
如果我使用分组线而不是线段，则可以绘制线条:
I can get the lines to draw if I use grouped lines instead of segments:
lines2 = data.frame(x = c(40, 115, 90, 165, 150, 225, 220, 295, 270, 345, 330, 45),
y = c(20, 5, 20, 5, 20, 5, 20, 5, 20, 5, 20, 5),
group = c(1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6))
ggplot(lines2, aes(x, y, group = group)) +
geom_line(color = 'red') +
coord_radar() +
scale_y_continuous(limits = c(0, 36)) +
scale_x_continuous(limits = c(0, 360))
但是我仍然需要直方图...
but I still need the histogram...
有什么想法吗?
推荐答案
我刚刚在 geom_segment 部分.它的长短是:在 geom_segment / geom_histogram 之后的ggproto Geom对象的 draw_panel 函数具有两种绘制各自的方法几何，具体取决于ggplot对象的坐标系是线性的还是非线性的.
I just answered a similar question on the geom_segment portion. The long and short of it is this: the draw_panel function of the ggproto Geom objects behind geom_segment / geom_histogram have two different methods of drawing the respective geoms, depending on whether the ggplot object's coordinate system is linear or non-linear.
coord_polar 是非线性的(我们可以运行 CoordPolar $ is_linear()进行确认)，因此可以使用与非线性相关的方法正确绘制几何图形坐标系. coord_radar 是线性的，因此使用线性方法会造成破坏.
coord_polar is non-linear (we can run CoordPolar$is_linear() to confirm this), so the geoms are drawn correctly using the methods associated with non-linear coordinate systems. coord_radar is linear, so the linear methods are used instead, and cause havoc.
我们可以通过定义相关Geoms的调整版本来解决此问题，这些版本仅包含非线性方法，而调用 geom _ * 函数而不是原始Geoms进行调用.
We can get around this by defining tweaked versions of relevant Geoms that only include the non-linear methods, and geom_* functions that call on them instead of the original Geoms.
geom_segment2 :
GeomSegment2 <- ggproto("GeomSegment2",
GeomSegment,
draw_panel = function (data, panel_params, coord, arrow = NULL,
arrow.fill = NULL, lineend = "butt",
linejoin = "round", na.rm = FALSE) {
data <- remove_missing(data, na.rm = na.rm,
c("x", "y", "xend", "yend", "linetype",
"size", "shape"),
name = "geom_segment")
if (ggplot2:::empty(data))
return(zeroGrob())
# remove option for linear coordinate system
data$group <- 1:nrow(data)
starts <- subset(data, select = c(-xend, -yend))
ends <- plyr::rename(subset(data, select = c(-x, -y)),
c(xend = "x", yend = "y"),
warn_missing = FALSE)
pieces <- rbind(starts, ends)
pieces <- pieces[order(pieces$group), ]
GeomPath$draw_panel(pieces, panel_params, coord, arrow = arrow,
lineend = lineend)
})
geom_segment2 <- function (mapping = NULL, data = NULL, stat = "identity",
position = "identity", ..., arrow = NULL, arrow.fill = NULL,
lineend = "butt", linejoin = "round", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE) {
layer(data = data, mapping = mapping, stat = stat,
geom = GeomSegment2, # instead of GeomSegment
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(arrow = arrow, arrow.fill = arrow.fill,
lineend = lineend, linejoin = linejoin, na.rm = na.rm,
...))
}
geom_histogram2 :
library(grid)
GeomBar2 <- ggproto("GeomBar2",
GeomBar,
draw_panel = function (self, data, panel_params, coord,
width = NULL) {
# copy over GeomRect's draw_panel function for the non-linear portion
aesthetics <- setdiff(names(data),
c("x", "y", "xmin", "xmax", "ymin", "ymax"))
polys <- plyr::alply(data, 1, function(row) {
poly <- ggplot2:::rect_to_poly(row$xmin, row$xmax, row$ymin, row$ymax)
aes <- as.data.frame(row[aesthetics],
stringsAsFactors = FALSE)[rep(1, 5), ]
GeomPolygon$draw_panel(cbind(poly, aes), panel_params, coord)
})
ggplot2:::ggname("bar", do.call("grobTree", polys))
})
geom_histogram2 <- function (mapping = NULL, data = NULL, stat = "bin",
position = "stack", ..., binwidth = NULL,
bins = NULL, na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE) {
layer(data = data, mapping = mapping, stat = stat,
geom = GeomBar2, # instead of GeomBar
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(binwidth = binwidth, bins = bins, na.rm = na.rm,
pad = FALSE, ...))
}
用法:
ggplot(d, aes(x)) +
geom_histogram2(binwidth = 10) +
geom_segment2(data = lines,
aes(x, y, xend = xend, yend = yend),
color = 'red') +
coord_radar() +
scale_x_continuous(limits = c(0, 360))
这篇关于使用雷达坐标将线段添加到ggplot2中的直方图中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
