tags:

views:

196

answers:

2

Right now, the legend by default looks something like this:

Legend Title
x-1 
y-2 
z-3 

But is it possible to make it look something like this?

Legend Title 
x-1 y-2 z-3
+1  A: 

There is something like guide_legends_box with an option "horizontal", but I can't get it to work.

> d <- qplot(carat, price, data=dsamp, colour=clarity) +
+  scale_color_hue("clarity") +
+  guide_legends_box("clarity",horizontal=T)

gives :

Error in scales$legend_desc : $ operator is invalid for atomic vectors

Maybe you know what's going wrong here. Personally I think that part of the functionality mentioned in the documentation isn't implemented yet.

Joris Meys
Looking at the function that creates the legend. It seems like it's forcing horizontal to be false.
Brandon Bertelsen
Did you ask the developers of ggplot2 already? Indeed, the default value is false, but the problem is the scales object within the plot object, which is empty (try d$scales, it gives basically nothing).
Joris Meys
+3  A: 

and here is a hack. there may be bugs, though:

build_legend <- function(name, mapping, layers, default_mapping, theme) {
  legend_data <- plyr::llply(layers, build_legend_data, mapping, default_mapping)

  # determine if the elements are aligned horizontally or vertically
  horiz<-(!is.null(theme$legend.align) && theme$legend.align=="horizontal")

  # Calculate sizes for keys - mainly for v. large points and lines
  size_mat <- do.call("cbind", plyr::llply(legend_data, "[[", "size"))
  if (is.null(size_mat)) {
    key_sizes <- rep(0, nrow(mapping))
  } else {
    key_sizes <- apply(size_mat, 1, max)
  }

  title <- theme_render(
    theme, "legend.title",
    name, x = 0, y = 0.5
  )

                                        # Compute heights and widths of legend table
  nkeys <- nrow(mapping)
  hgap <- vgap <- unit(0.3, "lines")

  numeric_labels <- all(sapply(mapping$.label, is.language)) || suppressWarnings(all(!is.na(sapply(mapping$.label, "as.numeric"))))
  hpos <- numeric_labels * 1

  labels <- lapply(mapping$.label, function(label) {
    theme_render(theme, "legend.text", label, hjust = hpos, x = hpos, y = 0.5)
  })

  # align horizontally
  if(!horiz){
    label_width <- do.call("max", lapply(labels, grobWidth))
    label_width <- convertWidth(label_width, "cm")
    label_heights <- do.call("unit.c", lapply(labels, grobHeight))
    label_heights <- convertHeight(label_heights, "cm")

    width <- max(unlist(plyr::llply(legend_data, "[[", "size")), 0)
    key_width <- max(theme$legend.key.size, unit(width, "mm"))

    widths <- unit.c(
                     hgap, key_width,
                     hgap, label_width,
                     max(
                         unit(1, "grobwidth", title) - key_width - label_width,
                         hgap
                         )
                     )
    widths <- convertWidth(widths, "cm")

    heights <- unit.c(
                      vgap, 
                      unit(1, "grobheight", title),
                      vgap, 
                      unit.pmax(
                                theme$legend.key.size, 
                                label_heights, 
                                unit(key_sizes, "mm")
                                ),
                      vgap
                      )  
    heights <- convertHeight(heights, "cm")

  }else{
    label_width <- do.call("unit.c", lapply(labels, grobWidth))
    label_width <- convertWidth(label_width, "cm")
    label_heights <- do.call("max", lapply(labels, grobHeight))
    label_heights <- convertHeight(label_heights, "cm")

    height <- max(unlist(plyr::llply(legend_data, "[[", "size")), 0)
    key_heights <- max(theme$legend.key.size, unit(height, "mm"))

    key_width <- unit.pmax(theme$legend.key.size, unit(key_sizes, "mm"))
    # width of (key gap label gap) x nkeys
    kglg_width<-do.call("unit.c",lapply(1:length(key_width), function(i)unit.c(key_width[i], hgap, label_width[i], hgap)))
    widths <- unit.c(
                      hgap,
                      kglg_width,
                      max(
                          unit(0,"lines"),
                          unit.c(unit(1, "grobwidth", title) - (sum(kglg_width) - hgap))
                          )
                      )
    widths <- convertWidth(widths, "cm")

    heights <- unit.c(
                       vgap, 
                       unit(1, "grobheight", title),
                       vgap, 
                       max(
                           theme$legend.key.size,
                           label_heights, 
                           key_heights
                           ),
                       vgap
                       )  
  heights <- convertHeight(heights, "cm")

  }

  # Layout the legend table
  legend.layout <- grid.layout(
    length(heights), length(widths), 
    widths = widths, heights = heights, 
    just = c("left", "centre")
  )

  fg <- ggname("legend", frameGrob(layout = legend.layout))
  fg <- placeGrob(fg, theme_render(theme, "legend.background"))

  fg <- placeGrob(fg, title, col = 2:(length(widths)-1), row = 2)
  for (i in 1:nkeys) {

    if(!horiz){
      fg <- placeGrob(fg, theme_render(theme, "legend.key"), col = 2, row = i+3)
    }else{
      fg <- placeGrob(fg, theme_render(theme, "legend.key"), col = 1+(i*4)-3, row = 4)
    }

    for(j in seq_along(layers)) {
      if (!is.null(legend_data[[j]])) {
        legend_geom <- Geom$find(layers[[j]]$geom$guide_geom())
        key <- legend_geom$draw_legend(legend_data[[j]][i, ],
           c(layers[[j]]$geom_params, layers[[j]]$stat_params))
        if(!horiz){
          fg <- placeGrob(fg, ggname("key", key), col = 2, row = i+3)
        }else{
          fg <- placeGrob(fg, ggname("key", key), col = 1+(i*4)-3, row = 4)
        }
      }
    }
    label <- theme_render(
      theme, "legend.text", 
      mapping$.label[[i]], hjust = hpos,
      x = hpos, y = 0.5
    )
    if(!horiz){
      fg <- placeGrob(fg, label, col = 4, row = i+3)
    }else{
      fg <- placeGrob(fg, label, col = 1+(i*4)-1, row = 4)
    }
  }
  fg
}

assignInNamespace("build_legend", build_legend, "ggplot2")

# test and usage
# specify by opts(legend.align="horizontal")
p1<-qplot(mpg, wt, data=mtcars, colour=cyl)+opts(legend.align="horizontal",legend.position="bottom")
p2<-qplot(mpg, wt, data=mtcars, colour=cyl)
kohske
That works exactly how I would expect it to. Thank you!
Brandon Bertelsen
@kohske: Great hack!
Richie Cotton