Suppression d'un tableGrob lorsqu'il est appliqué sur un tracé de boîte avec une enveloppe facette

j'utilise le code ci-dessous pour enrichir un graphique en boîte avec un tableau récapitulatif pour la variable catégorique créée sur l'axe des X. 

# 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

je cherche à modifier le code de la façon suivante:

  1. Je ne veux qu'une table, pas deux
  2. je veux que la table apparaisse dans le coin supérieur droit de la première case à partir de la gauche
  3. je ne veux pas pour le rownames ou quoi que ce soit crée en italique ( 1,2,3 ) les chiffres sur le côté gauche, à paraître.
4
demandé sur Konrad 2015-09-27 15:00:47

2 réponses

il serait probablement sensé de laisser annotation_custom accéder aux informations facetting *; ce changement trivial semble faire l'affaire, 

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 a une vue différente cependant, annotation est conçu pour apparaître dans tous les panneaux. Je ne sais pas comment produire l'équivalent geom pour ce cas particulier, si possible. enter image description here

10
répondu baptiste 2016-07-31 12:08:54

ceci n'est qu'une illustration du commentaire. 

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

le point est que vous avez vraiment juste besoin de modifier les arguments x=... et y=... à viewport(...) . En utilisant annotation_custom(...) , même si vous pouviez hacker le gTable pour vous débarrasser de l'un des grobs, vous auriez tout de même besoin de modifier la position (en utilisant xmin=... et ymin=... ). Cette approche ne permet pas de maintenez la position relative lorsque vous rétrécissez ou agrandissez l'image, mais annotation_custom(...) non plus , donc dans l'ensemble Je ne vois pas cela comme plus difficile.

3
répondu jlhoward 2015-09-28 15:00:04