multiple - Cambiar el color del texto para las celdas usando TableGrob en R
grid.table r (3)
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)
¿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!
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.
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.