my.table.plot0 <- function(x,
highlight.matrix = NULL,
main = "Table", title2 = NULL, size = 20,
bold.lastrow = FALSE, bold.lastcol = FALSE
)
{
## PURPOSE: Draw a data frame as a R plot. Require R package "gridExtra".
## ARGUMENT:
## x: a data frame
## highlight.matrix: if provided a logical matrix (same dimension as "x"). Then "TRUE" cells will be highlighted.
## main: title for the plot
## title2: additional title with more verbose text
## size: text size of table text
## bold.lastrow: if T, make the last row bold font.
## bold.lastcol: if T, make the last column bold font.
## RETURN: a plot
## DATE: 21 Nov 2016, 15:46
## -----------------------------------------------------
x <- as.data.frame(x)
n1 <- nrow(x)
n2 <- ncol(x)
cl <- matrix("black", n1, n2)
cl[is.na(x)] <- "gray"
## Bold Total Column and Row
cl2 <- cl
cl2[] <- "plain"
if (bold.lastrow) {
cl2[n1,] <- "bold"
}
if (bold.lastcol) {
cl2[, n2] <- "bold"
}
require(gridExtra)
table_theme <- ttheme_default(base_size = size,
core = list(fg_params=list(col=cl, fontface = cl2)))
## Highlight Cells
if (!is.null(highlight.matrix)) {
cl3 <- cl
z <- ttheme_default()$core$bg_params$fill # default color
z1 <- rep(z, length.out = nrow(cl3))
for (i in 1:ncol(cl3)) cl3[,i] <- z1
cl3[highlight.matrix] <- "yellow"
table_theme$core$bg_params$fill <- cl3
}
plot.new()
gridExtra::grid.table(as.data.frame(x), theme=table_theme)
## Title Text
t2 <- ifelse(is.null(title2), "", paste0("\n", graph.title.split.lines(title2, sep=" ", num.chars = 40)))
title(main = paste0(main, t2))
}
if (F) { # Unit Test
x <- data.frame(Type=c('Car', 'Plane'), Speed=c(NA, 200))
my.table.plot0(x)
my.table.plot0(x, main='Test', title2='a very complex test', size=30, bold.lastcol = T, highlight.matrix = matrix(c(NA, F, F, T) , 2, 2))
x <- data.frame(Type=rep('Car', 20), Speed=rep(100, 20))
my.table.plot0(x)
}
my.table.plot <- function(x, highlight.matrix = NULL, bold.lastrow = FALSE, n = 20, ...)
{
## Purpose: Split a data frame to fit in each page and call "my.table.plot0".
## Arguments:
## x: a data frame or matrix
## highlight.matrix: if provided a logical matrix (same dimension as "x"). Then "TRUE" cells will be highlighted.
## bold.lastrow: if T, make the last row bold font.
## n: how many rows to fit into each page.
## ...: pass to "my.table.plot0".
## Return: multiple plots to plot the data matrix.
## Author: Feiming Chen, Date: 5 Jul 2017, 15:16
## ________________________________________________
x <- as.data.frame(x)
N <- nrow(x)
if ( N <= n ) {
my.table.plot0(x, highlight.matrix = highlight.matrix, bold.lastrow = bold.lastrow, ...)
} else {
s <- rep(seq.int(N %/% 20 + 1), each = n, length.out = N)
xs <- split(x, s)
ng <- length(xs) # number of pages
bold.lastrow.list <- c(rep(FALSE, ng-1), bold.lastrow)
if (is.null(highlight.matrix)) {
mapply(my.table.plot0, xs, bold.lastrow = bold.lastrow.list, MoreArgs = list(...))
} else {
ys <- split(highlight.matrix, s)
mapply(my.table.plot0, xs, highlight.matrix = ys, bold.lastrow = bold.lastrow.list, MoreArgs = list(...))
}
}
}
if (F) { # Unit Test
x <- data.frame(Type=rep('Car', 50), Speed=rep(100, 50))
h <- matrix(rep(c(F, T), 50), ncol=2)
my.table.plot(x, highlight.matrix = h, bold.lastrow = T)
}
Thursday, June 22, 2017
Draw a data frame as a R plot
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment