Question

我试图在ggplot2中创建一个极坐标直方图，注释线不是径向线。

coord_polar的简单方法给出了曲线：

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))

第二次尝试使用来自StackOverflow和邮件列表上各种来源的coord_radar：

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()

这完全失败了：

如果我使用分组线而不是段，我可以绘制线条：

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))

但我还需要直方图...

有什么想法吗？

Answer 1

我刚刚在geom_segment部分回答了similar question。它的长短是：draw_panel / geom_segment之后的ggproto Geom对象的geom_histogram函数有两种绘制各自几何图形的方法，这取决于ggplot对象的坐标是否系统是线性还是非线性。

coord_polar是非线性的（我们可以运行CoordPolar$is_linear()来确认），因此可以使用与非线性坐标系关联的方法正确绘制几何图形。 coord_radar是线性的，因此使用线性方法会造成破坏。

我们可以通过定义相关Geoms的调整版本来解决此问题，这些版本仅包含非线性方法，以及调用geom_*函数而不是原始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中将线段添加到极坐标图中

1 个答案: