Question

我正在使用下面的代码来丰富一个箱形图，其中包含在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"))

我希望以下列方式更改代码：

我只想要一张桌子，而不是两张
我希望桌子出现在左边第一个方框图的右上角
我不希望左侧显示rownames或其他任何创建斜体（ 1,2,3 ）的数字。

Answer 1

让annotation_custom访问facetting info *可能是有意义的;这个微不足道的变化似乎可以解决问题，

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

修改 * hadley has a different view但annotation旨在显示在所有面板中。如果可能的话，我不清楚如何为这种特殊情况生成geom等价物。

Answer 2

这只是评论的一个例子。

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

关键是你真的需要调整x=...和y=... viewport(...)的参数。使用annotation_custom(...)，即使你可以破解gTable来摆脱其中一个grob，你仍然需要调整位置（使用xmin=...和ymin=...）。缩小或放大图像时，此方法不会保持相对位置，但annotation_custom(...)也没有，所以总体而言我并不认为这更难。

应用于带有facet_wrap的箱形图时，删除一个tableGrob

2 个答案: