Removing one tableGrob when applied to a box plot with a facet_wrap

I'm using the code below to enrich a box plot with a summary table for categorical variable created on the x-axis.

# Libs
require(ggplot2); require(gridExtra); require(grid); require(ggthemes)

# Data
data(mtcars)

# Function to summarise the data
fun_dta_sum <- function(var_sum, group, data) {
    sum_dta <- data.frame(
        aggregate(var_sum ~ group, FUN = min, data = data),
        aggregate(var_sum ~ group, FUN = max, data = data),
        aggregate(var_sum ~ group, FUN = mean, data = data))

    sum_dta <- sum_dta[,c(1,2,4,6)]
    colnames(sum_dta) <- c("Group (x axis)", "min", "max", "mean")
    rownames(sum_dta) <- NULL
    sum_dta[,-1] <-round(sum_dta[,-1],1)
    return(sum_dta)

}

# Graph
ggplot(data = mtcars, aes(x = cyl, y = qsec, fill = as.factor(gear))) +
    scale_x_discrete() +
    geom_boxplot(outlier.shape = NA) +
    scale_y_continuous(limits = quantile(mtcars$qsec, c(0.1, 0.9))) +
    scale_fill_tableau(palette = "tableau10") +
    xlab("am") + ylab("qsec") +
    facet_wrap(~am, shrink = TRUE) +
    theme_pander() +
    annotation_custom(tableGrob(
        fun_dta_sum(var_sum = mtcars$qsec, group = mtcars$cyl, 
                    data = mtcars)
    )) +
    theme(axis.title = element_text(colour = 'black', face = 'bold', size = 12,
                                    family = 'sans'),
          axis.text.x = element_text(colour = 'black', size = 14, hjust = 1, vjust = 0.5),
          axis.text.y = element_text(colour = 'black', size = 12),
          axis.line = element_line(size = 1, colour = 'black'),
          plot.title = element_text(size = 17, face = "bold", colour = "black"),
          panel.background = element_rect(fill = NA, colour = 'black'),
          panel.grid.major = element_line(colour = 'gray', linetype = 'dotted'),
          panel.grid.minor = element_line(colour = 'gray', linetype = 'dotted'),
          panel.margin = unit(1,"lines"),
          strip.background = element_rect(fill = NA, colour = NA),
          strip.text = element_text(colour = 'black', face = 'plain', size = 13),
          plot.background = element_rect(fill = NA, colour = 'black', size = 0.25),
          plot.margin = unit(c(10,10,10,10),"mm"),
          legend.position = "bottom",
          legend.background = element_rect(colour = "black"))

Problematic table

I'm looking to alter the code in a following manner:

  1. I want only one table, not two
  2. I want for the table to appear in the top right corner of the first box plot from the left
  3. I don't want for the rownames or whatever else creates italicised (1,2,3) figures on the left hand side to appear.

It would probably make sense to let annotation_custom access facetting info *; this trivial change seems to do the trick,

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

annotation_custom2 <- 
function (grob, xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf, data) 
{
  layer(data = data, stat = StatIdentity, position = PositionIdentity, 
        geom = ggplot2:::GeomCustomAnn,
        inherit.aes = TRUE, params = list(grob = grob, 
                                          xmin = xmin, xmax = xmax, 
                                          ymin = ymin, ymax = ymax))
}

p <- ggplot(mtcars) + geom_point(aes(mpg, wt)) + facet_wrap(~ cyl)


tg <- tableGrob(iris[1:2,1:2], rows=NULL)
# position the table within the annotation area
tg$vp=viewport(x=unit(0,"npc") + 0.5*sum(tg$widths),
               y=unit(0,"npc") + 0.5*sum(tg$heights))
# need to wrap in a gTree since annotation_custom overwrites the vp
g <- grobTree(tg)
p + annotation_custom2(g, data=data.frame(cyl=8))

Edit * hadley has a different view though, annotation is designed to appear in all panels. It's not clear to me how to produce the geom equivalent for this particular case, if possible. enter image description here


This is just an illustration of the comment.

ggp <- ggplot(data = mtcars, aes(x = factor(cyl), y = qsec, fill = as.factor(gear))) +
  geom_boxplot() +
  scale_y_continuous(limits = quantile(mtcars$qsec, c(0.1, 0.9))) +
  scale_fill_tableau("gear",palette = "tableau10") +
  xlab("cyl") + ylab("qsec") +
  facet_wrap(~am) 

# this requires gridExtra 2.0.0
tt <- ttheme_default(core    = list(fg_params=list(cex = 0.7)),
                     colhead = list(fg_params=list(cex = 0.7)))
grid.newpage()
grid.draw(arrangeGrob(ggp))
grid.draw(grobTree(tableGrob(fun_dta_sum(var_sum = mtcars$qsec, group = mtcars$cyl, data = mtcars),
                             rows=NULL, theme=tt), 
                   vp=viewport(x=unit(0.20,"npc"),y=unit(0.20,"npc"))))

The point is that you really just need to tweak the x=... and y=... arguments to viewport(...). Using annotation_custom(...), even if you could hack the gTable to get rid of one of the grobs, you would still need to tweak the position (using xmin=... and ymin=...). This approach does not maintain the relative position when you shrink or enlarge the image, but neither does annotation_custom(...), so overall I don't really see this as any more difficult.