将数据表格添加到 ggplot 图中，使用 viewPorts：对 Grob 进行缩放

Question

我正在尝试在ggplot制作的图表中添加数据表格（类似于Excel功能，但具有更改轴的灵活性）。

我已经尝试了几次，但一直遇到缩放问题，因此第一次尝试是：

library(grid)
library(gridExtra)
library(ggplot2)
xta=data.frame(f=rnorm(37,mean=400,sd=50))
xta$n=0
for(i in 1:37){xta$n[i]<-paste(sample(letters,4),collapse='')}
xta$c=0
for(i in 1:37){xta$c[i]<-sample((1:6),1)}
rect=data.frame(xmi=seq(0.5,36.5,1),xma=seq(1.5,37.5,1),ymi=0,yma=10)
xta=cbind(xta,rect)
a = ggplot(data=xta,aes(x=n,y=f,fill=c)) + geom_bar(stat='identity')
b = ggplot(data=xta,aes(x=n,y=5,label=round(f,1))) + geom_text(size=4) + geom_rect(aes(xmin=xmi,xmax=xma,ymin=ymi,ymax=yma),alpha=0,color='black')
z = theme(axis.text=element_blank(),panel.background=element_rect(fill='white'),axis.ticks=element_blank(),axis.title=element_blank())
b=b+z
la=grid.layout(nrow=2,ncol=1,heights=c(0.15,2),default.units=c('null','null'))
grid.show.layout(la)
grid.newpage()
pushViewport(viewport(layout=la))
print(a,vp=viewport(layout.pos.row=2,layout.pos.col=1))
print(b,vp=viewport(layout.pos.row=1,layout.pos.col=1))

生成了

第二次尝试（2）是

xta1=data.frame(t(round(xta$f,1)))
xtb=tableGrob(xta1,show.rownames=F,show.colnames=F,show.vlines=T,gpar.corefill=gpar(fill='white',col='black'),gp=gpar(fontsize=12),vp=viewport(layout.pos.row=1,layout.pos.col=1))
grid.newpage()
la=grid.layout(nrow=2,ncol=1,heights=c(0.15,2),default.units=c('null','null'))
grid.show.layout(la)
grid.newpage()
pushViewport(viewport(layout=la))
print(a,vp=viewport(layout.pos.row=2,layout.pos.col=1))
grid.draw(xtb)

这个产生了：

最后第三个是：

grid.newpage()
print(a + annotation_custom(grob=xtb,xmin=0,xmax=37,ymin=450,ymax=460))

产生了以下结果:

其中选项2是最好的选择，如果我能够将tableGrob缩放到与绘图相同的大小，但我不知道如何做到这一点。有关如何进一步操作的任何指针？-谢谢

- Tahnoon Pasha

Answer 1

你可以尝试使用新版本的tableGrob;生成的gtable宽度/高度可以设置为特定的大小（这里是均分的npc单位）

library(ggplot2)
library(gridExtra)
library(grid)
tg <- tableGrob(head(iris), rows=NULL)
tg$widths <- unit(rep(1/ncol(tg),ncol(tg)),"npc")
tg$heights <- unit(rep(1/nrow(tg),nrow(tg)),"npc")

qplot(colnames(iris), geom="bar")+ theme_bw() +
  scale_x_discrete(expand=c(0,0)) +
  scale_y_continuous(lim=c(0,2), expand=c(0,0)) +
  annotation_custom(ymin=1, ymax=2, xmin=-Inf, xmax=Inf, tg)

- baptiste

---

感谢@baptiste。我还没有测试过这个，但我会在周末测试一下，看起来应该是正确的答案。同时也感谢你提供如此棒的程序包。 - Tahnoon Pasha

一个快速的问题@baptiste，我每次都需要加载source_gist吗？您预计实验性的tableGrob何时进入主流代码？ - Tahnoon Pasha

如果您觉得有用的话，我的建议是复制代码并在本地加载（在包中或者您的.Rprofile文件中）。我真的不能保证发布日期，因为我很少工作在这个包上，而这个新版本是高度实验性的。如果它对您有用，应该很容易适应自定义颜色等。 - baptiste

Answer 2

你可以使用由 ggplot 创建的表格，然后像这个博客中所示进行组合。我在这里提供了一个简化且可用的示例:

首先生成您的绘图：

library(ggplot2)
library(reshape2)
library(grid)

 df <- structure(list(City = structure(c(2L,
     3L, 1L), .Label = c("Minneapolis", "Phoenix",
     "Raleigh"), class = "factor"), January = c(52.1,
     40.5, 12.2), February = c(55.1, 42.2, 16.5),
     March = c(59.7, 49.2, 28.3), April = c(67.7,
         59.5, 45.1), May = c(76.3, 67.4, 57.1),
     June = c(84.6, 74.4, 66.9), July = c(91.2,
         77.5, 71.9), August = c(89.1, 76.5,
         70.2), September = c(83.8, 70.6, 60),
     October = c(72.2, 60.2, 50), November = c(59.8,
         50, 32.4), December = c(52.5, 41.2,
         18.6)), .Names = c("City", "January",
     "February", "March", "April", "May", "June",
     "July", "August", "September", "October",
     "November", "December"), class = "data.frame",
     row.names = c(NA, -3L))

dfm <- melt(df, variable = "month")

 levels(dfm$month) <- month.abb
 p <- ggplot(dfm, aes(month, value, group = City,
     colour = City))
 p1 <- p + geom_line(size = 1) + theme(legend.position = "top") + xlab("")

接下来在ggplot中生成数据表格。使用与图形相同的x轴：

none <- element_blank()
data_table <- ggplot(dfm, aes(x = month, y = factor(City),
     label = format(value, nsmall = 1), colour = City)) +
     geom_text(size = 3.5) +
  scale_y_discrete(labels = abbreviate)+ theme_bw()  +
     theme(panel.grid.major = none, legend.position = "none",
         panel.border = none, axis.text.x = none,
         axis.ticks = none) + theme(plot.margin = unit(c(-0.5,
     1, 0, 0.5), "lines")) + xlab(NULL) + ylab(NULL)

使用视口（viewport）将两者结合：

Layout <- grid.layout(nrow = 2, ncol = 1, heights = unit(c(2,
     0.25), c("null", "null")))
grid.show.layout(Layout)
vplayout <- function(...) {
     grid.newpage()
     pushViewport(viewport(layout = Layout))
 }

subplot <- function(x, y) viewport(layout.pos.row = x,
     layout.pos.col = y)

mmplot <- function(a, b) {
     vplayout()
     print(a, vp = subplot(1, 1))
     print(b, vp = subplot(2, 1))
 }

mmplot(p1, data_table)

请注意仍需要进行一些微调，例如绘图中图例的位置以及表格中城市名称的缩写，但结果看起来不错： 应用到您的示例中：

library(grid)
library(gridExtra)
library(ggplot2)
xta=data.frame(f=rnorm(37,mean=400,sd=50))
xta$n=0
for(i in 1:37){xta$n[i]<-paste(sample(letters,4),collapse='')}
xta$c=0
for(i in 1:37){xta$c[i]<-sample((1:6),1)}
rect=data.frame(xmi=seq(0.5,36.5,1),xma=seq(1.5,37.5,1),ymi=0,yma=10)
xta=cbind(xta,rect)
a = ggplot(data=xta,aes(x=n,y=f,fill=c)) + geom_bar(stat='identity')+ theme(legend.position = "top")+xlab("")

none <- element_blank()
z=ggplot(xta, aes(x = n, y = "fvalues",
     label = round(f,1)) )+
     geom_text(size = 3)+ theme_bw()  +
     theme(panel.grid.major = none, legend.position = "none",
         panel.border = none, axis.text.x = none,
         axis.ticks = none) + theme(plot.margin = unit(c(-0.5,
     1, 0, 0.5), "lines")) + xlab(NULL) + ylab(NULL)

Layout <- grid.layout(nrow = 2, ncol = 1, heights = unit(c(2,
     0.25), c("null", "null")))
grid.show.layout(Layout)
vplayout <- function(...) {
     grid.newpage()
     pushViewport(viewport(layout = Layout))
 }

subplot <- function(x, y) viewport(layout.pos.row = x,
     layout.pos.col = y)

mmplot <- function(a, b) {
     vplayout()
     print(a, vp = subplot(1, 1))
     print(b, vp = subplot(2, 1))
 }

mmplot(a, z)

编辑:

与Dennis的解决方案类似，但是使用条形图并添加了+ coord_flip()。如果您不想翻转它，可以删除后者，但它会增加可读性：

ggplot(xta, aes(x=n,y=f,fill=c)) +
   geom_bar() +
   labs(color = "c") +
   geom_text(aes(y = max(f)+30, label = round(f, 1)), size = 3, color = "black") + coord_flip()

- Jonas Tundo

---

感谢@JT85，这很有用，我确实看到了那篇博客。我的第一次尝试（不使用tableGrob）本质上就是这个过程，但是去掉了函数调用并在数字周围画了矩形。我知道如果我移动图例，我可以让它工作，但我正在尝试调整grob的大小以适应图形而不是更改图形以允许显示数据。虽然这几乎是我所需要的。 - Tahnoon Pasha

我在答案中添加了另一种解决方案。 - Jonas Tundo

感谢@JT85。这绝对是一个解决方案，但如果可能的话，我想要一个实际的数据表。如果您不介意，我会暂时不将其标记为答案，因为它仍然看起来像是注释而不是具有值的独立表格。我有一个明确的外观和感觉。 - Tahnoon Pasha

Answer 3

在我看来，这个图形设计得不够好。首先，我不明白为什么需要将零点作为起点，当数值范围从300到500时，这是一种掩盖柱状图隐喻的方式。您还试图使用柱状填充来表示c值的差异，而其中只有六个。以下是我认为解决问题的更简单方法。根据您的xta数据：

# Convert the categories to a factor
xta$N <- factor(xta$n, levels = xta$n)

# Simple approach:
ggplot(xta, aes(x = f, y = N, color = factor(c))) +
   geom_point() +
   labs(color = "c") +
   geom_text(aes(x = 575, label = round(f, 1)), size = 4, color = "black")

这张图对我来说不是很有趣。根据问题的背景，将响应按递增顺序排序并添加大小美学以突出c的级别差异可能会增加一些见解。（也可以使用大小而不是颜色）最后，因为我们将因子水平放在垂直轴上以使其标签清晰可见，所以我们还可以通过扩展水平轴并将f值作为文本插入来进行补充。

ggplot(xta, aes(x = f, y = reorder(N, f), color = factor(c), size = c)) + 
   geom_point() +
   labs(color = "c") +
   geom_text(aes(x = 575, label = round(f, 1)), size = 4, color = "black")

这段代码中有足够的提示，让你可以按照不同的方向进行操作。我将把这个决定留给你。

- Dennis

---

感谢您的输入，@Dennis。实际数据已经排序，使用条形图更为合适。我考虑过散点图，但是考虑到我的受众不熟悉这种图形，可能会让事情变得更加混乱。非常感谢您的建议。在同一项目中，我将使用散点图作为另一种可视化辅助工具。 - Tahnoon Pasha