ggplot2 geom_rug（）产生不同的线长和宽图

Question

我发布了这个跟随格子的'兄弟'问题（即Lattice's `panel.rug` produces different line length with wide plot），但由于不同的图形系统，它应该是分开的。

在ggplot2中生成包含geom_rug() ggthemes边距的宽图时，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

这遵循hadley的当前geom_rug代码，但修改它以添加（或减去）地毯内部单位的绝对数量。它实际上是grid::unit - 函数的应用，因为它使用了可以使用不同的基数添加和减去单位的事实。你可以修改它以接受一个＆＃34; rug_len＆＃34; -argument，你选择的默认值，比如unit（0.5，＆＃34; cm＆＃34;）。 （需要记住设置函数的environment，以便一个闭包，＆＃39; geom_rug2 , can call the next closure, ggplot2 ::＆＃39; +＆＃39;`，正确。）< / p>

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我得到：

我也尝试过跟hadley's current description of how to extend ggplot2没有太大成功。

Answer 2

我不确定是否有办法控制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 3

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

Answer 4

深入研究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 5

另一个引擎盖下的解决方案。首先，我得到ggplot grob，然后使用editGrob包中的grid函数。使用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()