multiple - Cambiar el color del texto para las celdas usando TableGrob en R

grid.table r

Question

¿Hay alguna manera de cambiar individualmente el color del texto de una celda al usar tableGrob y ggplot2? Por ejemplo, en el siguiente código sería genial si la celda con 1 pudiera ser azul y la celda con 2 podría ser roja, con 3: 8 totalmente negra.

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)

¡Gracias!

Answer 1

Editar

gridExtra> = 2.0 se reescribió desde cero, y ahora es posible la edición de bajo nivel. Dejaré la respuesta anterior a continuación para completar.

Respuesta original

grid.table no permite la edición posterior de grob; probablemente debería volver a implementarse utilizando la estrategia makeContext reciente del paquete grid, pero no es muy probable que suceda.

Si realmente desea una tabla basada en gráficos de cuadrícula, probablemente sea mejor que escriba su propia función. Aquí hay un posible comienzo,

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)

Answer 2

Para mi decepción, esto no parece ser fácil. La función tableGrob llama a makeTableGrobs para diseñar el objeto grid y devuelve una estructura gTree completamente calculada. Sería bueno si pudieras interceptar eso, cambiar algunas propiedades y continuar; desafortunadamente el dibujo se hace con gridExtra:::drawDetails.table y esa función insiste en llamar a makeTableGrobs otra vez, esencialmente matando cualquier oportunidad de personalización.

Pero no es imposible. Básicamente podemos crear nuestra propia versión de drawDetails.table que no reprocesa. Aquí está la función de gridExtra con una declaración if añadida al comienzo.

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

Al definir esta función en el entorno global, tendrá prioridad sobre la de gridExtra . Esto nos permitirá personalizar la tabla antes de que se dibuje y que nuestros cambios no se restablezcan. Aquí hay un código para cambiar los colores de los valores en las primeras dos filas como lo solicitó.

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)

Y eso produce esta trama.

Entonces la sintaxis es un poco críptica, pero déjame explicarte con esta línea

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

El objeto mytable es realmente solo una lista decorada. Tiene un ítem lg que es lo que se calcula a partir de makeTableGrobs y tiene todos los elementos de grid bruto dentro. El elemento lgt debajo de eso es otra lista que tiene todas las capas de texto. Para esta tabla, lgt tiene 15 elementos. Uno para cada cuadrado en la tabla comenzando con el "vacío" en la esquina superior izquierda. Van en orden de arriba a abajo, de izquierda a derecha, por lo que la celda con 1 es [[7]] en la lista. Si ejecuta str(mytable$lg$lgt[[7]]) puede ver las propiedades que componen ese texto grob. También notará una sección para gp donde puede establecer el color del texto a través del elemento col . Entonces lo cambiamos del "negro" predeterminado al "rojo" deseado.

Lo que estamos haciendo no es parte de la API oficial, por lo que debe considerarse un truco y, como tal, puede ser frágil para futuros cambios en las bibliotecas involucradas ( ggplot2 , grid , gridExtra ). Pero espero que esto al menos lo ayude a comenzar a personalizar su mesa.

Answer 3

Con gridExtra> = 2.0 los parámetros estéticos se pueden especificar a través del argumento del tema, por ej.

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)

Alternativamente, los grobs pueden editarse antes del dibujo.