ggplot2 geom_rug() 产生不同的线长和宽图

Question

我将此发布为 'sibling' 格子问题（即）的跟进，但由于不同的图形系统，它应该分开。

在 ggplot2 中生成宽度图时，其边距包括 ggthemes 中的 geom_rug()，不规则边距中线条的长度在 y 轴上比 x 轴长：

library(ggplot2)
library(ggthemes)
png(width=800, height=400)
ggplot(swiss, aes(Education, Fertility)) + geom_point() + geom_rug()
dev.off()

我希望 x 轴和 y 轴上的那些 rug 线的长度相同，而不管绘图的形状如何（注意：现在 rug 行只有在绘图为正方形时才具有相同的长度）。

Answer 1

我不确定 geom_rug 中是否有控制地毯段长度的方法（我找不到）。但是，您可以使用 geom_segment 创建自己的地毯并对段长度进行硬编码或添加一些逻辑以编程方式生成等长的地毯线。例如：

# Aspect ratio
ar = 0.33

# Distance from lowest value to start of rug segment
dist = 2

# Rug length factor
rlf = 2.5

ggplot(swiss, aes(Education, Fertility)) + geom_point() + 
  geom_segment(aes(y=Fertility, yend=Fertility, 
                   x=min(swiss$Education) - rlf*ar*dist, xend=min(swiss$Education) - ar*dist)) +
  geom_segment(aes(y=min(swiss$Fertility) - rlf*dist, yend=min(swiss$Fertility) - dist, 
                   x=Education, xend=Education)) +
  coord_fixed(ratio=ar,
              xlim=c(min(swiss$Education) - rlf*ar*dist, 1.03*max(swiss$Education)),
              ylim=c(min(swiss$Fertility) - rlf*dist, 1.03*max(swiss$Fertility)))

或者，如果您只想对其进行硬编码：

ggplot(swiss, aes(Education, Fertility)) + geom_point() + 
  geom_segment(aes(y=Fertility, yend=Fertility, 
                   x=min(swiss$Education) - 3, xend=min(swiss$Education) - 1.5)) +
  geom_segment(aes(y=min(swiss$Fertility) - 6, yend=min(swiss$Fertility) - 3, 
                   x=Education, xend=Education)) +
  coord_cartesian(xlim=c(min(swiss$Education) - 3, 1.03*max(swiss$Education)),
                  ylim=c(min(swiss$Fertility) - 6, 1.03*max(swiss$Fertility)))

Answer 2

这遵循 hadley 的 ~~current~~ 之前的 geom_rug 代码，但对其进行了修改以添加（或减去）地毯内部单元的绝对数量。它实际上是 grid::unit 函数的一个应用，比其他任何东西都重要，因为它利用了单位可以用不同的基数进行加减的事实。您可以修改它以接受带有您选择的默认值的 "rug_len" 参数，比如 unit(0.5, "cm")。（需要记住设置函数的 environment，这样一个闭包 geom_rug2 可以正确调用下一个闭包 ggplot2::'+'。）

geom_rug2 <- function (mapping = NULL, data = NULL, stat = "identity", position = "identity", sides = "bl", ...) {
  GeomRug2$new(mapping = mapping, data = data, stat = stat, position = position, sides = sides, ...)
}

GeomRug2 <- proto(ggplot2:::Geom, {
  objname <- "rug2"

  draw <- function(., data, scales, coordinates, sides, ...) {
    rugs <- list()
    data <- coord_transform(coordinates, data, scales)
    if (!is.null(data$x)) {
      if(grepl("b", sides)) {
        rugs$x_b <- segmentsGrob(
          x0 = unit(data$x, "native"), x1 = unit(data$x, "native"),
          y0 = unit(0, "npc"), y1 = unit(0, "npc")+unit(1, "cm"),
          gp = gpar(col = alpha(data$colour, data$alpha), lty = data$linetype, lwd = data$size * .pt)
        )
      }

      if(grepl("t", sides)) {
        rugs$x_t <- segmentsGrob(
          x0 = unit(data$x, "native"), x1 = unit(data$x, "native"),
          y0 = unit(1, "npc"), y1 = unit(1, "npc")-unit(1, "cm"),
          gp = gpar(col = alpha(data$colour, data$alpha), lty = data$linetype, lwd = data$size * .pt)
        )
      }
    }

    if (!is.null(data$y)) {
      if(grepl("l", sides)) {
        rugs$y_l <- segmentsGrob(
          y0 = unit(data$y, "native"), y1 = unit(data$y, "native"),
          x0 = unit(0, "npc"), x1 = unit(0, "npc")+unit(1, "cm"),
          gp = gpar(col = alpha(data$colour, data$alpha), lty = data$linetype, lwd = data$size * .pt)
        )
      }

      if(grepl("r", sides)) {
        rugs$y_r <- segmentsGrob(
          y0 = unit(data$y, "native"), y1 = unit(data$y, "native"),
          x0 = unit(1, "npc"), x1 = unit(1, "npc")-unit(1, "cm"),
          gp = gpar(col = alpha(data$colour, data$alpha), lty = data$linetype, lwd = data$size * .pt)
        )
      }
    }

    gTree(children = do.call("gList", rugs))
  }

  default_stat <- function(.) StatIdentity
  default_aes <- function(.) aes(colour="black", size=0.5, linetype=1, alpha = NA)
  guide_geom <- function(.) "path"
})
environment(geom_rug2) <- environment(ggplot)

p <- qplot(x,y)
p + geom_rug2(size=.1)

用你的代码创建一个 png 我得到：

Answer 3

深入研究 ggplot grob 的结构：

小修改：更新到 ggplot2 2.2.1

library(ggplot2)
p = ggplot(swiss, aes(Education, Fertility)) + geom_point() + geom_rug()

# Get the ggplot grob
gp = ggplotGrob(p)

# Set end points of rug segments
library(grid)
gp$grobs[[6]]$children[[4]]$children[[1]]$y1 = unit(0.03, "snpc")
gp$grobs[[6]]$children[[4]]$children[[2]]$x1 = unit(0.03, "snpc")

png(width=900, height=300)
grid.draw(gp)
dev.off()

Answer 4

另一个底层解决方案。首先，我得到 ggplot grob，然后我使用 grid 包中的 editGrob 函数。使用 editGrob，我只是简单地命名要编辑的 grob；这比必须一直遵循 grob 的结构到相关参数要容易得多。通常，editGrob 看不到所有的 ggplot grob，但可以使用 grid.force() 暴露它们。

library(ggplot2)
library(grid)

p = ggplot(swiss, aes(Education, Fertility)) + geom_point() + geom_rug() 

# Get the ggplot grob
gp = ggplotGrob(p)

# Get names of relevant grobs.
# The grid.force function generates the gtable's at-drawing-time contents.
names.grobs = grid.ls(grid.force(gp))$name # We're interested in the children of rugs.gTree
segments = names.grobs[which(grepl("GRID.segments", names.grobs))]

# Check them out
str(getGrob(grid.force(gp), gPath(segments[1]))) # Note: y1 = 0.03 npc
str(getGrob(grid.force(gp), gPath(segments[2]))) # Note: x1 = 0.03 npc

# Set y1 and x1 to 0.03 snpc
gp = editGrob(grid.force(gp), gPath(segments[1]), y1 = unit(0.03, "snpc"))
gp = editGrob(grid.force(gp), gPath(segments[2]), x1 = unit(0.03, "snpc"))

png(width=900, height=300)
grid.draw(gp)
dev.off()

Answer 5

从 ggplot2 v3.2.0 开始，您可以将长度参数传递给 geom_rug() 以指定地毯的绝对长度：

library(ggplot2)
library(ggthemes)
png(width=800, height=400)
ggplot(swiss, aes(Education, Fertility)) + geom_point() + geom_rug(length = unit(0.5,"cm"))
dev.off()

ggplot2 geom_rug() 产生不同的线长和宽图

ggplot2 geom_rug() produces different line length with wide plot

r

data-visualization

ggplot2