Thay đổi màu văn bản cho ô bằng cách sử dụng TableGrob trong R

Question

Có cách nào để thay đổi riêng màu sắc của văn bản của ô khi sử dụng tableGrob và ggplot2 không? Ví dụ trong đoạn code dưới đây nó sẽ là tuyệt vời nếu các tế bào với 1 có thể là màu xanh và các tế bào với 2 có thể là màu đỏ, với 3: 8 tất cả các màu đen.

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) 

Cảm ơn!

Answer 1

Phần lớn sự thất vọng của tôi, điều này dường như không dễ dàng. Các hàm tableGrob gọi makeTableGrobs để bố trí đối tượng lưới và trả về cấu trúc gTree được tính đầy đủ. Sẽ tốt hơn nếu bạn có thể đánh chặn điều đó, thay đổi một số thuộc tính và tiếp tục; tiếc là bản vẽ được thực hiện với gridExtra:::drawDetails.table và chức năng đó nhấn mạnh vào việc gọi makeTableGrobs một lần nữa, về cơ bản sẽ tiêu diệt mọi cơ hội để tùy chỉnh.

Nhưng không phải là không thể. Về cơ bản, chúng tôi có thể tạo phiên bản drawDetails.table của riêng mình mà không thực hiện xử lý lại. Đây là hàm từ gridExtra với một câu lệnh được thêm vào if ngay từ đầu.

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

Bằng cách xác định chức năng này trong môi trường toàn cầu, nó sẽ được ưu tiên hơn một trong gridExtra. Điều này sẽ cho phép chúng tôi tùy chỉnh bảng trước khi nó được rút ra và không có thay đổi của chúng tôi được đặt lại. Đây là mã để thay đổi màu của các giá trị trong hai hàng đầu tiên theo yêu cầu của bạn.

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) 

Và điều đó tạo ra cốt truyện này.

Vì vậy, cú pháp là một chút khó hiểu, nhưng hãy để tôi giải thích với dòng này

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

Đối tượng mytable thực sự chỉ là một danh sách trang trí. Nó có một mục lg được tính từ makeTableGrobs và có tất cả các phần tử grid thô bên trong. Phần tử lgt dưới đây là một danh sách khác có tất cả các lớp văn bản. Đối với bảng này, lgt có 15 phần tử. Một cho mỗi ô vuông trong bảng bắt đầu bằng ô "trống" ở phía trên bên trái. Chúng theo thứ tự từ trên xuống dưới, từ trái sang phải, do đó ô có 1 là [[7]] trong danh sách. Nếu bạn chạy str(mytable$lg$lgt[[7]]), bạn có thể xem các thuộc tính tạo nên văn bản grob đó. Bạn cũng sẽ thấy một phần cho gp nơi bạn có thể đặt màu của văn bản qua phần tử col. Vì vậy, chúng tôi thay đổi nó từ mặc định "đen" thành "màu đỏ" mong muốn.

gì chúng tôi đang làm không phải là một phần của API chính thức nên nó cần được xem xét một hack và như vậy có thể mong manh với những thay đổi trong tương lai trong các thư viện liên quan (ggplot2, grid, gridExtra). Nhưng hy vọng điều này ít nhất sẽ giúp bạn bắt đầu tùy biến bảng của bạn.

Answer 2

Sửa

gridExtra> = 2.0 được viết lại từ đầu, và chỉnh sửa ở mức độ thấp hiện nay là có thể. Tôi sẽ để lại câu trả lời cũ dưới đây cho đầy đủ.

Original câu trả lời

grid.table không cho phép hậu chỉnh sửa của grob; nó có lẽ nên được reimplemented bằng cách sử dụng chiến lược makeContext gần đây từ gói lưới, nhưng đó không phải là rất có khả năng xảy ra.

Nếu bạn thực sự muốn một bảng dựa trên đồ họa lưới, có lẽ bạn nên viết chức năng của riêng mình. Dưới đây là một khởi đầu tốt,

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

Với gridExtra> = 2.0 thông số thẩm mỹ có thể được xác định bằng lập luận chủ đề, ví dụ

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) 

Ngoài ra, grobs may be edited trước khi vẽ.