使用TableGrob更改单元格的文本颜色

时间:2014-05-23 00:26:39

标签: r colors ggplot2 gridextra r-grid

使用tableGrob和ggplot2时,有没有办法单独更改单元格文本的颜色?

例如,在下面的代码中,如果带有1的单元格可能是蓝色而带有2的单元格可能是红色,而3:8的单元格全黑,那么它会很棒。

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 个答案:

答案 0 :(得分:9)

令我失望的是,这似乎并不容易。 tableGrob函数调用makeTableGrobs来布局网格对象并返回完全计算的gTree结构。如果您能拦截,改变一些属性并继续,那将是很好的;遗憾的是,绘图已经完成了gridExtra:::drawDetails.table,并且该函数仍然坚持再次调用makeTableGrobs,从根本上消除了任何自定义的机会。

但这并非不可能。基本上我们可以创建我们自己的drawDetails.table版本,它不会进行重新处理。这里是gridExtra的函数,开头添加了一个if语句。

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

通过在全局环境中定义此函数,它将优先于gridExtra中的函数。这将允许我们在绘制表之前自定义表,而不是重置我们的更改。这是代码,可以根据您的要求更改前两行中值的颜色。

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)

这就产生了这个情节。

table with color

所以语法有点神秘,但让我用这一行来解释

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

mytable对象实际上只是一个装饰列表。它有一个lg项,它是从makeTableGrobs计算的,并且内部包含所有原始grid元素。其下的lgt元素是另一个包含所有文本图层的列表。对于此表,lgt有15个元素。表中每个方格一个以&#34;空&#34;开头一个在左上角。它们从上到下,从左到右依次排列,因此列表中包含1的单元格为[[7]]。如果您运行str(mytable$lg$lgt[[7]]),您可以看到构成该文本grob的属性。您还会注意到gp的一个部分,您可以通过col元素设置文本的颜色。所以我们从默认的&#34; black&#34;到期望的&#34;红色&#34;。

我们正在做的事情不是官方API的一部分,所以它应该被视为黑客,因此可能对所涉及的库(ggplot2grid的未来变化很脆弱, gridExtra)。但希望这至少可以帮助您开始定制表格。

答案 1 :(得分:7)

修改

从头开始重写

gridExtra&gt; = 2.0,现在可以进行低级编辑。为了完整起见,我将在下面留下旧答案。

原始回答

grid.table不允许对grob进行后期编辑;它可能应该使用网格包中最近的makeContext策略重新实现,但这不太可能发生。

如果您真的想要一个基于网格图形的表格,那么您最好自己编写自己的函数。这是一个可能的开始,

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)

答案 2 :(得分:6)

使用gridExtra&gt; = 2.0美学参数可以通过主题参数指定,例如

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

或者,在绘制之前grobs may be edited