R adding a datatable to a ggplot graph using viewPorts : Scaling the Grob

Question

I'm trying to add a data-table to a graph made in ggplot (similar to the excel functionality but with the flexibility to change the axis its on)

I've had a few goes at it and keep hitting a problem with scaling so attempt 1) was

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

which produced

the second attempt 2) was

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)

which produced

and finally 3) was

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

which produced

Of them option 2 would be the best if I could scale the tableGrob to the same size as the plot, but I've no idea how to do that. Any pointers on how to take this further? - Thanks

Answer 1

You can use for instance a table created by ggplot and combine them with like in this blog. I made a simplified and working example here:

First produce your plot:

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

Next produce the data table in ggplot. Use the same x-axis as the plot:

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)

Combine the two with 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)

Note that still some tweaking is needed like the position of the legend of the plot and the abbrevation of the city names in the table, but the result looks nice:

Applied to your example:

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)

EDIT:

similar to Dennis his solution but than a barplot and with + coord_flip(). You can remove the latter if you don't want to flip it, but it increases readability:

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