Ggplot2: изменение макета легенды

Ответ 1

и вот взломать. могут быть ошибки:

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)

Ответ 2

В настоящее время вы можете просто использовать legend.direction = "horizontal". Например:

qplot(carat, price, data=diamonds, colour=color) + opts(legend.position="top", legend.direction="horizontal")

Ответ 3

Последние ggplot2, opts устарели в пользу theme():

qplot(carat, price, data=diamonds, colour=color) +
  theme(legend.position="top", legend.direction="horizontal")

Ответ 4

Есть что-то вроде guide_legends_box с опцией "horizontal", но я не могу заставить его работать.

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

дает:

Ошибка в масштабах $legend_desc: $оператор недействителен для атомных векторов

Может быть, вы знаете, что здесь происходит не так. Лично я считаю, что часть функциональности, упомянутая в документации, еще не реализована.