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

Question

我发布了这个跟随格子的'兄弟'问题(即莱迪思的`panel.rug`产生不同的线长和宽图),但由于不同的图形系统,它应该是分开的.

在ggplot2中生成包含geom_rug()from的边距的宽图时,ggthemesy轴中的线条长度比x轴长:

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

我想在x轴和y轴上的那些地毯线是相同的长度,而不管绘图的形状如何(注意:现在,当绘图是正方形时,地毯线只会是相同的长度).

Answer 1

这遵循hadley的当前geom_rug代码,但修改它以添加(或减去)地毯内部单位的绝对数量.它实际上是grid::unit函数的应用,因为它使用了可以使用不同的基数添加和减去单位的事实.您可以将其修改为接受"rug_len"参数,并使用您选择的默认值,例如unit(0.5,"cm").(需要记住设置environment函数,以便一个闭包,'geom_rug2 geom_rug2ggplot2 ::'+'`,正确.)

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目前关于如何扩展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)))