9

使用 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)
4

3 回答 3

10

使用 gridExtra >=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)

在此处输入图像描述

或者，可以在绘制之前编辑 grobs。

于 2016-09-05T05:53:15.523 回答
9

令我失望的是，这似乎并不容易。该tableGrob函数调用makeTableGrobs布局网格对象并返回完全计算的gTree结构。如果你能拦截它，改变一些属性，然后继续，那就太好了；不幸的是，绘图完成了gridExtra:::drawDetails.table，该函数坚持makeTableGrobs再次调用，基本上扼杀了任何定制的机会。

但这并非不可能。基本上我们可以创建我们自己的版本drawDetails.table，不进行再处理。这是函数 from在开头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)

这产生了这个情节。

有颜色的表

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

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

该mytable对象实际上只是一个装饰列表。它有一个lg项目，该项目是从中计算出来的，makeTableGrobs并且其中包含所有原始grid元素。其lgt下的元素是另一个包含所有文本层的列表。对于这个表，lgt有 15 个元素。表格中的每个方块一个，从左上角的“空”方块开始。它们按从上到下、从左到右的顺序排列，因此带有 1 的单元格[[7]]在列表中。如果您运行str(mytable$lg$lgt[[7]])，您可以看到构成该文本 grob 的属性。您还会注意到一个部分gp，您可以在其中通过col元素设置文本的颜色。因此，我们将其从默认的“黑色”更改为所需的“红色”。

我们正在做的不是官方 API 的一部分，所以它应该被认为是一个 hack，因此可能对所涉及的库的未来变化（ggplot2, grid, gridExtra）很脆弱。但希望这至少可以帮助您开始自定义表格。

于 2014-05-23T02:26:28.280 回答
7

编辑

gridExtra >=2.0 从头开始​​重写，现在可以进行低级编辑。为了完整起见，我将在下面留下旧答案。

原始答案

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

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

在此处输入图像描述

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)
于 2014-05-23T12:56:34.033 回答