Change text color for cells using TableGrob

橙三吉。 提交于 2019-12-17 16:21:38

问题


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)

回答1:


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.

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.




回答2:


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,

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:


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)

Alternatively, the grobs may be edited before drawing.



来源:https://stackoverflow.com/questions/23819209/change-text-color-for-cells-using-tablegrob

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!