8
votes

I posted this as follow up to a 'sibling' question with lattice (i.e. Lattice's `panel.rug` produces different line length with wide plot) but due to different graphical system it deserves to be separate.

When producing a wide plot in ggplot2 with margins that include geom_rug() from ggthemes, the length of the lines in rugged margins is longer in the y-axis than x-axis:

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

enter image description here

I would like those rug lines in x- and y-axes to be the same length regardless of the shape of a plot (note: right now the rug lines will only be the same length when the plot is square).

5

5 Answers

8
votes

This followed hadley's current previous geom_rug code, but modified it to add (or subtract) an absolute amount for interior units of the rug-ticks. It's really an application of the grid::unit-function more than anything else, since it uses the fact that units can be added and subtracted with different bases. You could modify it to accept a "rug_len"-argument with a default of your choosing, say unit(0.5, "cm"). (Do need to remember to set the environment of the function, so that one closure, geom_rug2, can call the next closure, ggplot2::'+', correctly.)

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)

With your code creating a png I get:

enter image description here

6
votes

I'm not sure if there's a way to control the rug segment length in geom_rug (I couldn't find one). However, you can create your own rug using geom_segment and hard-code the segment lengths or add some logic to programatically produce equal-length rug lines. For example:

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

enter image description here

Or if you just want to hard-code it:

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

As of ggplot2 v3.2.0 you can pass a length argument to geom_rug() to specify the absolute length of the 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()

Fixed Length Geom_rug

2
votes

Delving into the structure of the ggplot grob:

Minor edit: updating to 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()

enter image description here

1
votes

Another under-the-hood solution. First, I get the ggplot grob, and then I use the editGrob function from the grid package. With editGrob, I simply name the grob to be edited; it's easier than having to follow the grob's structure all the way to the relevant parameters. Normally, editGrob can't see all of the ggplot grobs, but they can be exposed with 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()