Cambia colore testo per celle utilizzando TableGrob in R

Question

C'è un modo per modificare individualmente il colore del testo di una cella quando si utilizza tableGrob e ggplot2? Ad esempio nel codice qui sotto sarebbe bello se la cella con 1 potesse essere blu e la cella con 2 potesse essere rossa, con 3: 8 tutto nero.

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) 

Grazie!

Answer 1

Con mia grande delusione, questo non sembra essere facile. La funzione tableGrob chiama makeTableGrobs per impaginare l'oggetto griglia e restituisce una struttura gTree completamente calcolata. Sarebbe bello se tu potessi intercettarlo, cambiare alcune proprietà e continuare; sfortunatamente il disegno viene eseguito con gridExtra:::drawDetails.table e tale funzione insiste nel chiamare di nuovo makeTableGrobs, essenzialmente eliminando ogni possibilità di personalizzazione.

Ma non è impossibile. Fondamentalmente possiamo creare la nostra versione di drawDetails.table che non esegue la rielaborazione. Ecco la funzione da gridExtra con una aggiunta if istruzione all'inizio.

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

Con la definizione di questa funzione nel contesto globale, sarà avere la precedenza su quello di gridExtra. Questo ci consentirà di personalizzare la tabella prima che venga tracciata e di non avere le nostre modifiche ripristinate. Ecco il codice per cambiare i colori dei valori nelle prime due righe come richiesto.

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) 

E questo produce questa trama.

Così la sintassi è un po 'criptico, ma mi permetta di spiegare con questa linea

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

Il mytable oggetto è in realtà solo un elenco decorato. Ha un articolo lg che è quello che viene calcolato da makeTableGrobs e contiene tutti gli elementi originali grid. L'elemento lgt sotto questo è un altro elenco che ha tutti i livelli di testo. Per questa tabella, lgt ha 15 elementi. Uno per ogni quadrato del tavolo che inizia con quello "vuoto" in alto a sinistra. Vanno in ordine dall'alto al basso, da sinistra a destra, quindi la cella con 1 è [[7]] nell'elenco. Se esegui str(mytable$lg$lgt[[7]]) puoi vedere le proprietà che costituiscono quel testo grob. Noterai inoltre una sezione per gp in cui puoi impostare il colore del testo tramite l'elemento col. Quindi lo cambiamo dal "nero" predefinito al "rosso" desiderato.

Quello che stiamo facendo non fa parte delle API ufficiali e quindi dovrebbe essere considerato un hack e come tale può essere fragile per futuri cambiamenti nelle librerie coinvolti (ggplot2, grid, gridExtra). Ma spero che questo ti aiuti almeno a iniziare a personalizzare il tuo tavolo.

Answer 2

Modifica

gridExtra> = 2.0 è stato riscritto da zero, e la modifica a basso livello è ora possibile. Lascerò la vecchia risposta di seguito per completezza.

risposta originale

grid.table non consente post-editing del Grob; dovrebbe probabilmente essere reimplementato usando la recente strategia makeContext dal pacchetto della griglia, ma non è molto probabile che accada.

Se si desidera realmente una tabella basata sulla grafica della griglia, è preferibile scrivere una propria funzione. Ecco una possibile partenza,

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 3

Con gridExtra> = 2.0 parametri estetici può essere specificato tramite l'argomento tema, per esempio

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) 

In alternativa, la prima grobs may be edited disegno.