Adding a table to a faceted plot

[jankatins]

I had the need for this, maybe you are interested in this (if not please close):

library(grid)
library(gridExtra)
library(gtable)
library(ggplot2)

GeomTable <- ggproto(
  "GeomTable",
  Geom,
  required_aes = c("x", "y",  "table"),
  default_aes = aes(
    widthx = 10,
    widthy = 10,
    rownames = NA
  ),
  draw_key = draw_key_blank,

  draw_panel = function(data, panel_scales, coord) {
    if (nrow(data) != 1) {
      stop(
        sprintf(
          "only one table per panel allowed, got %s (%s)",
          nrow(data),
          as.character(data)
        ),
        call. = FALSE
      )
    }
    wy = data$widthy / 2
    wx = data$widthx / 2

    corners <-
      data.frame(x = c(data$x - wx, data$x + wx),
                 y = c(data$y - wy, data$y + wy))
    d <- coord$transform(corners, panel_scales)

    # gross hack, but I've found no other way to get a table/matrix/dataframe to this point :-(
    table = read.csv(text = data$table, header = TRUE)
    if (!is.na(data$rownames)) {
      rownames(table) <-
        unlist(strsplit(data$rownames, "|", fixed = TRUE))
    }

    x_rng <- range(d$x, na.rm = TRUE)
    y_rng <- range(d$y, na.rm = TRUE)

    vp <-
      viewport(
        x = mean(x_rng),
        y = mean(y_rng),
        width = diff(x_rng),
        height = diff(y_rng),
        just = c("center", "center")
      )

    grob <-
      tableGrob(table, theme = ttheme_minimal())
    # add a line across the header
    grob <- gtable_add_grob(
      grob,
      grobs = segmentsGrob(y1 = unit(0, "npc"),
                           gp = gpar(lwd = 2.0)),
      t = 1,
      b = 1,
      l = 1,
      r = ncol(d) + 1
    )
    editGrob(grob, vp = vp, name = paste(grob$name, facet_id()))
  }
)

facet_id <- local({
  i <- 1
  function() {
    i <<- i + 1
    i
  }
})

geom_table <-
  function(mapping = NULL,
           data = NULL,
           stat = "identity",
           position = "identity",
           na.rm = FALSE,
           show.legend = NA,
           inherit.aes = TRUE,
           ...) {
    layer(
      geom = GeomTable,
      mapping = mapping,
      data = data,
      stat = stat,
      position = position,
      show.legend = show.legend,
      inherit.aes = inherit.aes,
      params = list(na.rm = na.rm, ...)
    )
  }

and then use it like this:

# helper function
to_csv_ <- function(x){paste(capture.output(write.csv(x, stdout(), row.names=F)), collapse="\n")}

# data
data <- data.frame(x=1:20, y=20:1, c = rep(c("a","b"),10))

# this could be the output of a summarize pipe
suma <- to_csv_(data.frame(a=c(1,2), b=c(2,3)))
sumb <- to_csv_(data.frame(a=c(9,9), b=c(9,9)))
dt <- data.frame(c=c("a", "b"), t=c(suma, sumb), stringsAsFactors = FALSE)
#dt

ggplot(data, aes(x, y)) + geom_point() + facet_wrap(~c) + geom_table(data=dt, aes(table=t), x=15, y=15, rownames="mean|sd")

[I also posted this on stackoverflow: http://stackoverflow.com/a/36022671/1380673, where initialy went for an answer...]

[hrbrmstr]

I would have use of this! #ty (I'll hit GH in the AM to do the PR)

On Tue, Mar 15, 2016 at 5:28 PM, Jan Schulz [email protected] wrote:

I had the need for this, maybe you are interested in this (if not please close):

library(grid) library(gridExtra) library(gtable) library(ggplot2)

GeomTable <- ggproto( "GeomTable", Geom, required_aes = c("x", "y", "table"), default_aes = aes( widthx = 10, widthy = 10, rownames = NA ), draw_key = draw_key_blank,

draw_panel = function(data, panel_scales, coord) { if (nrow(data) != 1) { stop( sprintf( "only one table per panel allowed, got %s (%s)", nrow(data), as.character(data) ), call. = FALSE ) } wy = data$widthy / 2 wx = data$widthx / 2

corners <-
  data.frame(x = c(data$x - wx, data$x + wx),
             y = c(data$y - wy, data$y + wy))
d <- coord$transform(corners, panel_scales)

# gross hack, but I've found no other way to get a table/matrix/dataframe to this point :-(
table = read.csv(text = data$table, header = TRUE)
if (!is.na(data$rownames)) {
  rownames(table) <-
    unlist(strsplit(data$rownames, "|", fixed = TRUE))
}

x_rng <- range(d$x, na.rm = TRUE)
y_rng <- range(d$y, na.rm = TRUE)

vp <-
  viewport(
    x = mean(x_rng),
    y = mean(y_rng),
    width = diff(x_rng),
    height = diff(y_rng),
    just = c("center", "center")
  )

grob <-
  tableGrob(table, theme = ttheme_minimal())
# add a line across the header
grob <- gtable_add_grob(
  grob,
  grobs = segmentsGrob(y1 = unit(0, "npc"),
                       gp = gpar(lwd = 2.0)),
  t = 1,
  b = 1,
  l = 1,
  r = ncol(d) + 1
)
editGrob(grob, vp = vp, name = paste(grob$name, facet_id()))

} )

facet_id <- local({ i <- 1 function() { i <<- i + 1 i } })

geom_table <- function(mapping = NULL, data = NULL, stat = "identity", position = "identity", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) { layer( geom = GeomTable, mapping = mapping, data = data, stat = stat, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list(na.rm = na.rm, ...) ) }

and then use it like this:

helper function

to_csv_ <- function(x){paste(capture.output(write.csv(x, stdout(), row.names=F)), collapse="\n")}

data

data <- data.frame(x=1:20, y=20:1, c = rep(c("a","b"),10))

this could be the output of a summarize pipe

suma <- to_csv_(data.frame(a=c(1,2), b=c(2,3))) sumb <- to_csv_(data.frame(a=c(9,9), b=c(9,9))) dt <- data.frame(c=c("a", "b"), t=c(suma, sumb), stringsAsFactors = FALSE) #dt

ggplot(data, aes(x, y)) + geom_point() + facet_wrap(~c) + geom_table(data=dt, aes(table=t), x=15, y=15, rownames="mean|sd")

[image: rplot] https://cloud.githubusercontent.com/assets/890156/13794610/0a0cba3c-eafd-11e5-8b78-d132bce197c4.png

— You are receiving this because you are subscribed to this thread. Reply to this email directly or view it on GitHub https://github.com/hrbrmstr/ggalt/issues/4

[jankatins]

I currently see two ways to polish it:

• add a param how to summarize the original dataframe (a dplyr pipe?), then build the table in the draw_panel function. It will be a little akwqrd, because you have to translate the pipe into "ggplot-names" (-> color, size, etc, whatever is available in the geom...) -> geom_summarize_table(aes(xpos, ypos), by=c("mean(y)", "median(y)", "sd(y)")). This seems doable, have to think a bit how to pass in the summary functions...
• add a way to pass in arbitrary grobs via the data. This depends on ggplot allowing grobs in the data. Up to now, I didn't manage to add grobs to the dataframe so that it didn't break somewhere :-( Maybe you have some idea...

[hrbrmstr]

going to start playing with the incorporation this week. grobs in data.frames shudders

[baptiste]

see also https://github.com/hadley/ggplot2/issues/1399. Not convinced geom_grob that @hadley suggests is currently possible. ggplot2 seems to choke on (lists of) grobs inside a data.frame.

[jankatins]

ggplot2 seems to choke on (lists of) grobs inside a data.frame

That's probably because of plyr and reshape2 instead of the new data_frame and dplyr.

So right now, the only way forwards seems to be to do a geom_summary_table(..., summary.funcs ) c(...), summary.labels=c(...)), which constructs the table and adds it to individual plots.