在R中構面ggplot的每個面板上添加子表

Question

我正在嘗試使用facet_wrap中ggplot2包中的facet_wrap創建一套完整的繪圖。

作為簡化示例，我使用了ggplot2中包含的數據集mpg的子集

library(plyr)
library(ggplot2)
library(gtable)
library(gridExtra)

myData = subset(mpg, manufacturer == "audi" | manufacturer == "chevrolet")
myData = droplevels(myData)

這是我繪制數據的代碼：

p =  ggplot(myData, aes(x=hwy, y=cty, colour=model) )
p = p + facet_wrap( ~ manufacturer)#, scales="free") # sets panel division 
p = p + geom_point(size = 3) # sets points aspect
p = p + geom_smooth(stat="identity")
print(p)

現在，這里出現了棘手的部分...我還有另一個數據框'indivParam'，它具有要在圖表上顯示為表格的額外信息。 假設這個愚蠢的人：

indivParam = ddply(myData, .(manufacturer  ,  model), summarize,
               var1 = unique(class),
               var2 = round(mean(displ)),
               var3 = round(mean(cyl)))

我想做的是在每個面板上添加一個子表，並從indivParam中提取信息。 例如，在圖表的第一個面板上添加下表：

tg = tableGrob(subset(indivParam, manufacturer == "audi"),
           show.rownames=FALSE, gp=gpar(fontsize=8, lwd=2), 
           xmin=15, xmax=30, ymin=10, ymax=20)
grid.newpage()
grid.draw(tg)

我嘗試了幾種選擇...

1. 使用annotate()但此參數不會傳遞數據幀...

2. 如該線程中所建議使用annotation_custom() ： 在r的ggplot的繪制區域內添加表

    p1 = p + annotation_custom(tableGrob(indivParam, show.rownames=FALSE, gp=gpar(fontsize=8, lwd=2)), xmin=15, xmax=30, ymin=10, ymax=20) print(p1) 

   這也不起作用，因為它在每個面板上顯示整個表格，而不是在子表格中顯示與每個面板相關的數據（）

3. 最后，在閱讀了“ tableGrob”文檔頁面上的示例之后，我嘗試使用所有子表grob創建一個網格並將其簡單地疊加在繪圖上：

    lg <- lapply(as.character(unique(indivParam$manufacturer)), function(x) tableGrob( as.data.frame(dlply(indivParam, .(manufacturer))[x]), name="test",show.rownames=FALSE, gp=gpar(fontsize=8, lwd=2))) grid.newpage() print(p) grid.draw(do.call(arrangeGrob, lg)) 

   但是隨后，該組織與構面所使用的那個不匹配。我懷疑，即使我可以將兩個表放在一起，它們也會居中並隱藏情節...

有什么辦法可以通過選擇子表的位置來改進最后一次嘗試？ 還是有解決這個問題的更好方法？ 一個明顯的方法是使用geom_table()但我不認為該geom存在（還）...

任何幫助/提示將不勝感激！ :-)

Answer 1

這是驚人的ggpmisc軟件包的解決方案：

library(ggpmisc)
library(dplyr)
library(tibble)

myData <- filter(mpg, manufacturer == "audi" | manufacturer == "chevrolet")

gg <- ggplot(myData, aes(x=hwy, y=cty, colour=model)) + 
  facet_wrap(~ manufacturer) + 
  geom_point(size = 3) +
  geom_smooth(stat="identity")

tb <- myData %>%
  group_by(manufacturer, model) %>%
  summarize(var1 = round(mean(displ)), var2 = round(mean(cyl))) %>%
  ungroup() 

tbs <- lapply(split(tb, tb$manufacturer), "[", -1)
df <- tibble(x = rep(-Inf, length(tbs)), 
             y = rep(Inf, length(tbs)), 
             manufacturer = levels(as.factor(tb$manufacturer)), 
             tbl = tbs)

gg + geom_table(data = df, aes(x = x, y = y, label = tbl),
                hjust = 0, vjust = 1)