Textfarbe für Zellen ändern mit TableGrob in R

Question

Gibt es eine Möglichkeit, die Farbe des Texts einer Zelle individuell zu ändern, wenn Sie tableGrob und ggplot2 verwenden? Zum Beispiel wäre es in dem Code unten toll, wenn die Zelle mit 1 blau sein könnte und die Zelle mit 2 könnte rot sein, mit 3: 8 ganz schwarz.

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) 

Vielen Dank!

Answer 1

Zu meiner Enttäuschung scheint dies nicht einfach zu sein. Die tableGrob-Funktion ruft makeTableGrobs auf, um das Rasterobjekt zu erstellen, und gibt eine vollständig berechnete Struktur gTree zurück. Es wäre schön, wenn Sie das abfangen, einige Eigenschaften ändern und weitermachen könnten; Leider wird die Zeichnung mit gridExtra:::drawDetails.table gemacht und diese Funktion besteht darauf, wieder makeTableGrobs aufzurufen, was jede Möglichkeit zur Anpassung im Wesentlichen zunichte macht.

Aber es ist nicht unmöglich. Grundsätzlich können wir unsere eigene Version von drawDetails.table erstellen, die die erneute Verarbeitung nicht durchführt. Hier ist die Funktion von gridExtra mit einer zusätzlichen if Aussage zu Beginn.

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

Durch diese Funktion im globalen Umfeld zu definieren, wird es Vorrang vor dem in gridExtra nehmen. Dadurch können wir die Tabelle anpassen, bevor sie gezeichnet wird, und unsere Änderungen werden nicht zurückgesetzt. Hier ist Code, um die Farben der Werte in den ersten zwei Zeilen wie gewünscht zu ändern.

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) 

Und das erzeugt diese Handlung.

So ist die Syntax ein wenig kryptisch, aber lassen Sie mich mit dieser Linie erklären

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

Das mytable Objekt ist wirklich nur ein dekorierter Liste. Es hat einen lg Artikel, der aus makeTableGrobs berechnet wird und alle rohen grid Elemente enthält. Das lgt Element darunter ist eine andere Liste, die alle Textebenen enthält. Für diese Tabelle hat lgt 15 Elemente. Eins für jedes Quadrat in der Tabelle beginnend mit dem "leeren" in der oberen linken Ecke. Sie gehen von oben nach unten, von links nach rechts, also ist die Zelle mit 1 [[7]] in der Liste. Wenn Sie str(mytable$lg$lgt[[7]]) ausführen, können Sie die Eigenschaften sehen, aus denen dieser Text grob besteht. Sie werden auch einen Abschnitt für gp bemerken, wo Sie die Farbe des Textes über das Element col festlegen können. Also ändern wir es vom Standard "schwarz" zum gewünschten "rot".

Was wir tun, ist nicht Teil der offiziellen API, so dass es einen Hack in Betracht gezogen werden soll und können als solche in den Bibliotheken beteiligt (ggplot2, grid, gridExtra) auf zukünftige Änderungen zerbrechlich sein. Aber hoffentlich hilft Ihnen das zumindest bei der Anpassung Ihrer Tabelle.

Answer 2

bearbeiten

gridExtra> = 2.0 wurde von Grund auf neu geschrieben, und Low-Level-Bearbeitung ist nun möglich. Ich werde die alte Antwort unten der Vollständigkeit überlassen.

Ursprüngliche Antwort

grid.table erlaubt keine Nachbearbeitung des grob; Es sollte wahrscheinlich mit der aktuellen makeContext-Strategie aus dem Grid-Paket neu implementiert werden, aber das ist nicht sehr wahrscheinlich.

Wenn Sie wirklich eine Tabelle basierend auf Grid-Grafiken möchten, sind Sie wahrscheinlich besser dran, Ihre eigene Funktion zu schreiben. Hier ist eine mögliche Start,

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

Mit gridExtra> = 2.0 ästhetischen Parametern kann über das Thema Argument angegeben werden, zum Beispiel

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) 

Alternativ kann die grobs may be edited vor dem Zeichnen.