10

Is there a way to individually change the color of the text of a cell when using tableGrob and ggplot2?

For instance in the code below it'd be great if the cell with 1 could be blue and the cell with 2 could be red, with 3:8 all black.

library(ggplot2)
library(grid)

mytable = as.table(matrix(c("1","2","3","4","5","6","7","8"),ncol=2,byrow=TRUE))
mytable = tableGrob(mytable,gpar.coretext = gpar(col = "black", cex = 1))
mydf = data.frame(x = 1:10,y = 1:10)

ggplot( mydf, aes(x, y)) + annotation_custom(mytable)
zx8754
  • 52,746
  • 12
  • 114
  • 209
user3667133
  • 147
  • 2
  • 9

3 Answers3

12

With gridExtra >=2.0 aesthetic parameters can be specified via the theme argument, e.g.

library(gridExtra)
library(ggplot2)
library(grid)
mytable = as.table(matrix(c("1","2","3","4","5","6","7","8"),ncol=2,byrow=TRUE))

cols <- matrix("black", nrow(mytable), ncol(mytable))
cols[1,1:2] <- c("blue", "red")
tt <- ttheme_default(core=list(fg_params = list(col = cols),
                                bg_params = list(col=NA)),
                      rowhead=list(bg_params = list(col=NA)),
                      colhead=list(bg_params = list(col=NA)))

mytable = tableGrob(mytable, theme = tt)
mydf = data.frame(x = 1:10,y = 1:10)
ggplot( mydf, aes(x, y)) + annotation_custom(mytable)

enter image description here

Alternatively, the grobs may be edited before drawing.

baptiste
  • 75,767
  • 19
  • 198
  • 294
  • How would you fill the sell instead of the colour of the font? – user2946746 May 19 '17 at 15:22
  • This might be a bit old but I recently encountered the same problem where I want to change the fill of a single cell. The method on https://cran.rstudio.com/web/packages/gridExtra/vignettes/tableGrob.html did not work for me, however I found a workaround with Baptiste's code above. change the `cols <- matrix("black", nrow(mytable), ncol(mytable)) cols[1,1:2] <- c("blue", "red")` into `fill <- matrix("black", nrow(mytable), ncol(mytable)) fill[1,1:2] <- c("blue", "red")`, then add `fill = fill` in the bg_params = list(col=NA) part of the core will do the work – JPHwang Jun 19 '17 at 02:39
  • "fill" can be specified using @baptiste's code, changing `bg_params = list(col=NA)` to `bg_params = list(fill=cols)`. The `fill=` parameter is not available in `fg_params` (errs) but works in `bg_params`; the `col=` parameter is available in `bg_params` but does not fill the whole cell. – r2evans Jun 29 '23 at 18:09
9

Much to my disappointment, this does not seem to be easy. The tableGrob function calls makeTableGrobs to layout the grid object and returns a fully calculated gTree structure. It would be nice if you could intercept that, change some properties, and continue on; unfortunately the drawing gets done with gridExtra:::drawDetails.table and that function insists on calling makeTableGrobs again, essentially killing any opportunity for customization.

But it's not impossible. Basically we can create our own version of drawDetails.table that doesn't do the reprocessing. Here's the function from gridExtra with one added if statement at the beginning.

drawDetails.table <- function (x, recording = TRUE) 
{
    lg <- if(!is.null(x$lg)) {
        x$lg
    } else {
        with(x, gridExtra:::makeTableGrobs(as.character(as.matrix(d)), 
        rows, cols, NROW(d), NCOL(d), parse, row.just = row.just, 
        col.just = col.just, core.just = core.just, equal.width = equal.width, 
        equal.height = equal.height, gpar.coretext = gpar.coretext, 
        gpar.coltext = gpar.coltext, gpar.rowtext = gpar.rowtext, 
        h.odd.alpha = h.odd.alpha, h.even.alpha = h.even.alpha, 
        v.odd.alpha = v.odd.alpha, v.even.alpha = v.even.alpha, 
        gpar.corefill = gpar.corefill, gpar.rowfill = gpar.rowfill, 
        gpar.colfill = gpar.colfill))
    }
    widthsv <- convertUnit(lg$widths + x$padding.h, "mm", valueOnly = TRUE)
    heightsv <- convertUnit(lg$heights + x$padding.v, "mm", valueOnly = TRUE)
    widthsv[1] <- widthsv[1] * as.numeric(x$show.rownames)
    widths <- unit(widthsv, "mm")
    heightsv[1] <- heightsv[1] * as.numeric(x$show.colnames)
    heights <- unit(heightsv, "mm")
    cells = viewport(name = "table.cells", layout = grid.layout(lg$nrow + 
        1, lg$ncol + 1, widths = widths, heights = heights))
    pushViewport(cells)
    tg <- gridExtra:::arrangeTableGrobs(lg$lgt, lg$lgf, lg$nrow, lg$ncol, 
        lg$widths, lg$heights, show.colnames = x$show.colnames, 
        show.rownames = x$show.rownames, padding.h = x$padding.h, 
        padding.v = x$padding.v, separator = x$separator, show.box = x$show.box, 
        show.vlines = x$show.vlines, show.hlines = x$show.hlines, 
        show.namesep = x$show.namesep, show.csep = x$show.csep, 
        show.rsep = x$show.rsep)
    upViewport()
}

By defining this function in the global environment, it will take precedence over the one in gridExtra. This will allow us to customize the table before it gets drawn and not have our changes get reset. Here's code to change the colors of the values in the first two rows as you requested.

mytable = as.table(matrix(c("1","2","3","4","5","6","7","8"),ncol=2,byrow=TRUE))
mytable = tableGrob(mytable,gpar.coretext = gpar(col = "black", cex = 1))

mytable$lg$lgt[[7]]$gp$col <- "red"
mytable$lg$lgt[[12]]$gp$col <- "blue"

mydf = data.frame(x = 1:10,y = 1:10)
ggplot( mydf, aes(x, y)) + annotation_custom(mytable)

And that produces this plot.

table with color

So the syntax is a bit cryptic, but let me explain with this line

mytable$lg$lgt[[7]]$gp$col <- "red"

The mytable object is really just a decorated list. It has an lg item which is what's calculated from makeTableGrobs and has all the raw grid elements inside. The lgt element under that is another list that has all the text layers. For this table, lgt has 15 elements. One for each square in the table starting with the "empty" one in the upper left. They go in order top-to-bottom, left-to-right, so the cell with 1 is [[7]] in the list. If you run str(mytable$lg$lgt[[7]]) you can see the properties that make up that text grob. You will also notice a section for gp where you can set the color of the text via the col element. So we change it from the default "black" to the desired "red".

What we are doing isn't part of the official API so it should be considered a hack and as such may be fragile to future changes in the libraries involved (ggplot2,grid,gridExtra). But hopefully this will at least help you get started in customizing your table.

MrFlick
  • 195,160
  • 17
  • 277
  • 295
  • Thanks for this. Just to add for others, you can use this approach to change the background fill as well `mytable$lg$lgf[[7]]$gp$fill <- "black"` – mrbcuda Aug 28 '14 at 13:24
7

Edit

gridExtra >=2.0 was rewritten from scratch, and low-level editing is now possible. I'll leave the old answer below for completeness.

Original answer

grid.table doesn't allow post-editing of the grob; it should probably be reimplemented using the recent makeContext strategy from the grid package, but that's not very likely to happen.

If you really want a table based on grid graphics, you're probably better off writing your own function. Here's a possible start,

enter image description here

library(gtable)

gt <- function(d, colours="black", fill=NA){

  label_matrix <- as.matrix(d)

  nc <- ncol(label_matrix)
  nr <- nrow(label_matrix)
  n <- nc*nr

  colours <- rep(colours, length.out = n)
  fill <- rep(fill, length.out = n)

  ## text for each cell
  labels <- lapply(seq_len(n), function(ii) 
    textGrob(label_matrix[ii], gp=gpar(col=colours[ii])))
  label_grobs <- matrix(labels, ncol=nc)

  ## define the fill background of cells
  fill <- lapply(seq_len(n), function(ii) 
    rectGrob(gp=gpar(fill=fill[ii])))

  ## some calculations of cell sizes
  row_heights <- function(m){
    do.call(unit.c, apply(m, 1, function(l)
      max(do.call(unit.c, lapply(l, grobHeight)))))
  }

  col_widths <- function(m){
    do.call(unit.c, apply(m, 2, function(l)
      max(do.call(unit.c, lapply(l, grobWidth)))))
  }

  ## place labels in a gtable
  g <- gtable_matrix("table", grobs=label_grobs, 
                     widths=col_widths(label_grobs) + unit(4,"mm"), 
                     heights=row_heights(label_grobs) + unit(4,"mm"))

  ## add the background
  g <- gtable_add_grob(g, fill, t=rep(seq_len(nr), each=nc), 
                        l=rep(seq_len(nc), nr), z=0, name="fill")

  g
}

d <- head(iris, 3)

core <- gt(d, 1:5)
colhead <- gt(t(colnames(d)))
rowhead <- gt(c("", rownames(d)))
g <- rbind(colhead, core, size = "first")
g <- cbind(rowhead, g, size = "last")
grid.newpage()
grid.draw(g)
baptiste
  • 75,767
  • 19
  • 198
  • 294