Change text color for cells using TableGrob

2020-01-31 07:25发布

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)

3条回答
倾城 Initia
2楼-- · 2020-01-31 08:00

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)
查看更多
够拽才男人
3楼-- · 2020-01-31 08:00

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.

查看更多
SAY GOODBYE
4楼-- · 2020-01-31 08:18

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.

查看更多
登录 后发表回答