Global legend using grid.arrange (gridExtra) and lattice based plots - r

I am producing four plots using xyplot (lattice) and further combine them with grid.arrange (gridExtra).
I would like to obtain a graph with a common global legend. The closest that I have reached is the following. They have to be in a matrix layout, otherwise an option would be to put them in a column and include only a legend for the top or bottom one.
# Load packages
require(lattice)
require(gridExtra)
# Generate some values
x1<-rnorm(100,10,4)
x2<-rnorm(100,10,4)
x3<-rnorm(100,10,4)
x4<-rnorm(100,10,4)
y<-rnorm(100,10,1)
cond<-rbinom(100,1,0.5)
groups<-sample(c(0:10),100,replace=TRUE)
dataa<-data.frame(y,x1,x2,x3,x4,cond,groups)
# ploting function
plott<-function(x){
xyplot(y~x|cond,groups=groups,
col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))),
pch = 1:length(levels(as.factor(groups))),
key = list(space="top",
text = list(as.character(levels(as.factor(groups)))),
points = TRUE, lines = TRUE, columns = 3,
pch = 1:length(levels(as.factor(groups))),
col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))),
cex=1))
}
plot1<-plott(x=x1)
plot2<-plott(x=x2)
plot3<-plott(x=x3)
plot4<-plott(x=x4)
grid.arrange(plot1,plot2,plot2,plot4,ncol=2)
In a similar post, I have seen that it can be performed with the use of ggplot2 e.g. here and here but is there a way to include a global common legend using gridExtra and a lattice based plot e.g. xyplot?
Thank you.

One possible solution is to use ggplot, hinted here.
my.cols <- 1:3
my.grid.layout <- rbind(c(1,2),
c(3,3))
g_legend<-function(a.gplot){
tmp <- ggplot_gtable(ggplot_build(a.gplot))
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]
return(legend)
}
legend.plot <- ggplot(iris, aes(x=Petal.Length, y=Sepal.Width,colour=Species)) +
geom_line(size=1) + # legend should show lines, not points or rects ...
theme(legend.position="right", legend.background = element_rect(colour = "black"),
legend.key = element_rect(fill = "white")) + # position, box and background colour of legend
scale_color_manual(values=my.cols, name = "Categories") + # manually insert colours as used in corresponding xyplot
guides(colour = guide_legend(reverse=T)) # inverts order of colours in legend
mylegend <- g_legend(legend.plot)
plot1 <- xyplot(Sepal.Width ~ Petal.Length, groups = Species, data = iris, type = 'l',
par.settings = simpleTheme(col=my.cols))
plot2 <- xyplot(Sepal.Length ~ Petal.Length, groups = Species, data = iris, type = 'l',
par.settings = simpleTheme(col=my.cols))
grid.arrange(plot1,plot2,mylegend,layout_matrix=my.grid.layout,
top=textGrob(gp=gpar(col='black',fontsize=20),"Some useless example"))

I managed to produce something more close to what I first imagined. For that I am including an extra graphical element and I am using the layout_matrix option in grid.arrange to minimize its effect. That way I am keeping the legend and almost exclude the plot.
# Load packages
require(lattice)
require(gridExtra)
# Generate some values
x1<-rnorm(100,10,4)
x2<-rnorm(100,10,4)
x3<-rnorm(100,10,4)
x4<-rnorm(100,10,4)
y<-rnorm(100,10,1)
cond<-rbinom(100,1,0.5)
groups<-sample(c(0:10),100,replace=TRUE)
dataa<-data.frame(y,x1,x2,x3,x4,cond,groups)
# ploting function
plottNolegend<-function(x){
xyplot(y~x|cond,groups=groups,
col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))),
pch = 1:length(levels(as.factor(groups)))
)
}
plott<-function(x){
xyplot(y~x|cond,groups=groups,
col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))),
pch = 1:length(levels(as.factor(groups))),
key = list(space="top",
text = list(as.character(levels(as.factor(groups)))),
points = TRUE, lines = TRUE, columns = 3,
pch = 1:length(levels(as.factor(groups))),
col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))),
cex=1))
}
plot1<-plottNolegend(x=x1)
plot2<-plottNolegend(x=x2)
plot3<-plottNolegend(x=x3)
plot4<-plottNolegend(x=x4)
legend<-plott(x=x4)
lay <- rbind(c(1,2),
c(1,2),
c(3,4),
c(3,4),
c(5,5))
grid.arrange(plot1,plot2,plot2,plot4,legend, layout_matrix = lay)
Updated: The answer was much simpler than I expected. Thank you all for your help.
# Load packages
require(lattice)
require(gridExtra)
require(grid)
# Generate some values
x1<-rnorm(100,10,4)
x2<-rnorm(100,10,4)
x3<-rnorm(100,10,4)
x4<-rnorm(100,10,4)
y<-rnorm(100,10,1)
cond<-rbinom(100,1,0.5)
groups<-sample(c(0:10),100,replace=TRUE)
dataa<-data.frame(y,x1,x2,x3,x4,cond,groups)
# ploting function
plott<-function(x){
xyplot(y~x|cond,groups=groups,
col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))),
pch = 1:length(levels(as.factor(groups))),
key = NULL)
}
plot1<-plott(x=x1)
plot2<-plott(x=x2)
plot3<-plott(x=x3)
plot4<-plott(x=x4)
grid.arrange(plot1,plot2,plot2,plot4,ncol=2)
KeyA<-list(space="top",
text = list(as.character(levels(as.factor(groups)))),
points = TRUE, lines = TRUE, columns = 11,
pch = 1:length(levels(as.factor(groups))),
col = gray(seq(0.01,0.7,length=length(levels(as.factor(groups))))),
cex=1)
draw.key(KeyA, draw = TRUE, vp =
viewport(.50, .99))

I think the better solution is to use c.trellis from latticeExtra:
library(latticeExtra)
c(plot1, plot2, plot3, plot4)

Related

How to plot a table of values and corresponding colors in R? The dreaded heat map [duplicate]

I am trying to create a data table whose cells are different colors based on the value in the cell. I can achieve this with the function addtable2plot from the plotrix package. The addtable2plot function lays a table on an already existing plot. The problem with that solution is that I don't want a plot, just the table.
I've also looked at the heatmap functions. The problem there is that some of the values in my table are character, and the heatmap functions, from what I can tell, only accept numeric matrices. Also, I want my column names to be at the top of the table, not the bottom, and that doesn't seem to be an option.
Here's the example code for addtable2plot. If I could get just the table, filling the whole screen, that would be great.
library(plotrix)
testdf<-data.frame(Before=c(10,7,5,9),During=c(8,6,2,5),After=c(5,3,4,3))
rownames(testdf)<-c("Red","Green","Blue","Lightblue")
barp(testdf,main="Test addtable2plot",ylab="Value",
names.arg=colnames(testdf),col=2:5)
# show most of the options including the christmas tree colors
abg<-matrix(c(2,3,5,6,7,8),nrow=4,ncol=3)
addtable2plot(2,8,testdf,bty="o",display.rownames=TRUE,hlines=TRUE,
vlines=TRUE,title="The table",bg=abg)
Any help would be greatly appreciated.
A heatmap alternative:
library(gplots)
# need data as matrix
mm <- as.matrix(testdf, ncol = 3)
heatmap.2(x = mm, Rowv = FALSE, Colv = FALSE, dendrogram = "none",
cellnote = mm, notecol = "black", notecex = 2,
trace = "none", key = FALSE, margins = c(7, 11))
In heatmap.2 the side of the plot the axis is to be drawn on is hard-coded. But if you type "heatmap.2" at the console and copy the output to an editor, you can search for axis(1, where the 1 is the side argument (two hits). You can then change from a 1 (axis below plot) to a 3 (axis above the plot). Assign the updated function to a new name, e.g. heatmap.3, and run it as above.
An addtable2plot alternative
library(plotrix)
# while plotrix is loaded anyway:
# set colors with color.scale
# need data as matrix*
mm <- as.matrix(testdf, ncol = 3)
cols <- color.scale(mm, extremes = c("red", "yellow"))
par(mar = c(0.5, 1, 2, 0.5))
# create empty plot
plot(1:10, axes = FALSE, xlab = "", ylab = "", type = "n")
# add table
addtable2plot(x = 1, y = 1, table = testdf,
bty = "o", display.rownames = TRUE,
hlines = TRUE, vlines = TRUE,
bg = cols,
xjust = 2, yjust = 1, cex = 3)
# *According to `?color.scale`, `x` can be a data frame.
# However, when I tried with `testdf`, I got "Error in `[.data.frame`(x, segindex) : undefined columns selected".
A color2D.matplot alternative
library(plotrix)
par(mar = c(0.5, 8, 3.5, 0.5))
color2D.matplot(testdf,
show.values = TRUE,
axes = FALSE,
xlab = "",
ylab = "",
vcex = 2,
vcol = "black",
extremes = c("red", "yellow"))
axis(3, at = seq_len(ncol(testdf)) - 0.5,
labels = names(testdf), tick = FALSE, cex.axis = 2)
axis(2, at = seq_len(nrow(testdf)) -0.5,
labels = rev(rownames(testdf)), tick = FALSE, las = 1, cex.axis = 2)
After this little exercise, I tend to agree with #Drew Steen that LaTeX alternatives may be investigated as well. For example, check here and here.
You can hack something with grid and gtable,
palette(c(RColorBrewer::brewer.pal(8, "Pastel1"),
RColorBrewer::brewer.pal(8, "Pastel2")))
library(gtable)
gtable_add_grobs <- gtable_add_grob # alias
d <- head(iris, 3)
nc <- ncol(d)
nr <- nrow(d)
extended_matrix <- cbind(c("", rownames(d)), rbind(colnames(d), as.matrix(d)))
## text for each cell
all_grobs <- matrix(lapply(extended_matrix, textGrob), ncol=ncol(d) + 1)
## define the fill background of cells
fill <- lapply(seq_len(nc*nr), function(ii)
rectGrob(gp=gpar(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=all_grobs,
widths=col_widths(all_grobs) + unit(4,"mm"),
heights=row_heights(all_grobs) + unit(4,"mm"))
## add the background
g <- gtable_add_grobs(g, fill, t=rep(seq(2, nr+1), each=nc),
l=rep(seq(2, nc+1), nr), z=0,name="fill")
## draw
grid.newpage()
grid.draw(g)
Sort of a hacky solution based on ggplot2. I don't totally understand how you actually want to map your colors, since in your example the colors in the table are not mapped to the rownames of testdf, but here I've mapped the colors to the value (converted to a factor).
testdf$color <- rownames(testdf)
dfm <- melt(testdf, id.vars="color")
p <- ggplot(dfm, aes(x=variable, y=color, label=value, fill=as.factor(value))) +
geom_text(colour="black") +
geom_tile(alpha=0.2)
p
You can change what variable the values are mapped to using fill=, and you can change the mapping using scale_fill_manual(values=[a vector of values].
That said, I'd be curious to see a solution that produces an actual table, rather than a plot masquerading as a table. Possibly using Sweave and LaTeX tables?

R; plotting scatter plot and heat map side by side

I am trying to create an image showing a scatter plot and a heat map side by side. I create the scatter plot with geom_point and the heatmap with heatmap.2. I then use grid.draw to put them in the same image HOWEVER I cannot get the images to be the same size. How can I make sure they are the same height (this is important as they are ordered the same way and match each other)?
The code I have is:
grab_grob <- function(){
grid.echo()
grid.grab()
}
g1 <- ggplot(x, aes(x=VIPscore, y=reorder(metabolite, VIPscore))) + geom_point(colour="blue") + labs(y="", x="VIP score")
heatmap.2(xhm, cexRow=0.5, cexCol=1, Colv=FALSE, Rowv = FALSE, keep.dendro = FALSE, trace="none", key=FALSE, lwid = c(0.5, 0.5), col=heat.colors(ncol(xhm)))
g2 <- grab_grob()
grid.newpage()
lay <- grid.layout(nrow = 1, ncol=2)
pushViewport(viewport(layout = lay))
print(g1,vp=viewport(layout.pos.row = 1, layout.pos.col = 1))
grid.draw(editGrob(g2, vp=viewport(layout.pos.row = 1, layout.pos.col = 2, clip=TRUE)))
upViewport(1)
I have also tried the geom_tile (instead of heatmap.2) followed by grid.arrange; although the images now match in size colors are awful - they look flat across my data set.
A package called plotly might be of help here. Check out their API docs
library(plotly)
df <- data.frame(x = 1:1000,
y = rnorm(1000))
p1 <- plot_ly(df, x = x, y = y, mode = "markers")
p2 <- plot_ly(z = volcano, type = "heatmap")%>% layout(title = "Scatterplot and Heatmap Subplot")
subplot(p1, p2)
A drop-in solution could be to use the package "ComplexHeatmap".
https://bioconductor.org/packages/release/bioc/vignettes/ComplexHeatmap/inst/doc/s4.heatmap_annotation.html

set key text inside key rectangle in lattice plots

is there an comfortable way to set the legend/key label inside the rectanlge in latice plots: (although overplot/overlayer lines, points, rectangles in keys would be nice)
library(lattice)
barchart(yield ~ variety | site, data = barley,
groups = year, layout = c(1,6), stack = TRUE,
auto.key = list(space = "right"),
ylab = "Barley Yield (bushels/acre)",
scales = list(x = list(rot = 45)))
Well, there's no really automatic way, but it can be done. Here are a couple of options I came up with. Both construct a legend 'grob' and pass it in via the barchart()'s legend= argument. The first solution uses the nifty gtable package to construct a table grob. The second is a bit more programmatic, and uses grid's own frameGrob() and packGrob() functions to construct a similar legend.
Option 1: Construct legend using gtable()
library(lattice)
library(grid)
library(gtable)
## Extract group labels and their colors for use in gtable
ll <- levels(barley[["year"]])
cc <- trellis.par.get("superpose.polygon")[["col"]][seq_along(ll)]
## Prepare a grob for passing in to legend.
## Set up a two cell gtable , and 'paint' then annotate both cells
## (Note: this could be further "vectorized", as, e.g., at
## http://stackoverflow.com/a/18033613/980833)
gt <- gtable(widths = unit(1.5,"cm"), heights = unit(rep(.7,2), "cm"))
gt <- gtable_add_grob(gt, rectGrob(gp=gpar(fill=cc[1])), 1, 1, name=1)
gt <- gtable_add_grob(gt, textGrob(ll[1]), 1, 1, name=2)
gt <- gtable_add_grob(gt, rectGrob(gp=gpar(fill=cc[2])), 2, 1, name=1)
gt <- gtable_add_grob(gt, textGrob(ll[2]), 2, 1, name=2)
## Plot barchart with legend
barchart(yield ~ variety | site, data = barley,
groups = year, layout = c(1,6), stack = TRUE,
legend = list(right=list(fun=gt)),
ylab = "Barley Yield (bushels/acre)",
scales = list(x = list(rot = 45)))
Option 2: Construct legend by packing a frameGrob()
library(lattice)
library(grid)
## A function for making grobs with text on a colored background
labeledRect <- function(text, color) {
rg <- rectGrob(gp=gpar(fill=color))
tg <- textGrob(text)
gTree(children=gList(rg, tg), cl="boxedTextGrob")
}
## A function for constructing a legend consisting of several
## labeled rectangles
legendGrob <- function(labels, colors) {
gf <- frameGrob()
border <- unit(c(0,0.5,0,0.5), "cm")
for (i in seq_along(labels)) {
gf <- packGrob(gf, labeledRect(labels[i], colors[i]),
width = 1.1*stringWidth(labels[i]),
height = 1.5*stringHeight(labels[i]),
col = 1, row = i, border = border)
}
gf
}
## Use legendGrob() to prepare the legend
ll <- levels(barley[["year"]])
cc <- trellis.par.get("superpose.polygon")[["col"]][seq_along(ll)]
gf <- legendGrob(labels=ll, colors=cc)
## Put it all together
barchart(yield ~ variety | site, data = barley,
groups = year, layout = c(1,6), stack = TRUE,
legend = list(right=list(fun=gf)),
ylab = "Barley Yield (bushels/acre)",
scales = list(x = list(rot = 45)))

Plot multipoints and a best fit line

I want to create one plot graph with the Roundrobin and Prediction points, without colors, where the Roundrobin and Prediction type of points are different, and it has a legend. I was want to add a best fit line for the results.
I am having trouble in adding all these features into one graph that has 2 points. I am used to Gnuplot, but I don't know how to do this with R. How I do this with R?
[1] Input data
Inputdata,Roundrobin,Prediction
1,178,188
2,159,185
3,140,175
[2] Script to generate data
no_faults_data <- read.csv("testresults.csv", header=TRUE, sep=",")
# Graph 1
plot(no_faults_data$Inputdata, no_faults_data$Roundrobin,ylim = range(c(no_faults_data$Roundrobin,no_faults_data$Prediction)),xlab="Input data size (MB)", ylab="Makespan (seconds)")
points(no_faults_data$Inputdata, no_faults_data$Prediction)
abline(no_faults_data$Inputdata, no_faults_data$Roundrobin, untf = FALSE, \dots)
abline(no_faults_data$Inputdata, no_faults_data$Prediction, untf = FALSE, \dots)
legend("top", notitle, c("Round-robin","Prediction"), fill=terrain.colors(2), horiz=TRUE)
In base R you will have to create a fitted model first:
robin <- lm(Roundrobin ~ Inputdata, data = no_faults_data)
pred <- lm(Prediction ~ Inputdata, data = no_faults_data)
plot(no_faults_data$Inputdata, no_faults_data$Roundrobin,
ylim = range(c(no_faults_data$Roundrobin,no_faults_data$Prediction)),
xlab = "Input data size (MB)", ylab = "Makespan (seconds)",
col = "green", pch = 19, cex = 1.5)
points(no_faults_data$Inputdata, no_faults_data$Prediction, pch = 22, cex = 1.5)
abline(robin, lty = 1)
abline(pred, lty = 5)
legend(1.1, 155, legend = c("Round-robin","Prediction"), pch = c(19,22), col = c("green","black"),
bty = "n", cex = 1.2)
which gives:
For further customization of the base R plot, see ?par and ?legend.
With ggplot2 you will need to reshape your data into long format:
library(reshape2)
library(ggplot2)
ggplot(melt(no_faults_data, id="Inputdata"),
aes(x=Inputdata, y=value, shape=variable, color=variable)) +
geom_point(size=4) +
geom_smooth(method = "lm", se = FALSE) +
theme_minimal()
which gives:
Used data:
no_faults_data <- read.csv(text="Inputdata,Roundrobin,Prediction
1,178,188
2,159,185
3,140,175", header=TRUE)
You should look into the ggplot2 package for plotting. Maybe not needed for the 3 points data you provided but it makes much nicer plots than the default.
df <- data.frame("Inputdata" = c(1,2,3,1,2,3), "score" = c(178,159,140,188,185,175), "scoreType" = c(rep("Roundrobin",3), rep("Prediction",3)))
p <- ggplot(data=df, aes(x=Inputdata, y=score, group=scoreType, shape = scoreType)) + geom_point(size=5)
p <- p + ggtitle("My Title")
p+stat_smooth(method="lm",se = FALSE)
Here you group by the type of score and let GG plot make the legend for you. stat_smooth is using lm here.

Conditional coloring of cells in table

I am trying to create a data table whose cells are different colors based on the value in the cell. I can achieve this with the function addtable2plot from the plotrix package. The addtable2plot function lays a table on an already existing plot. The problem with that solution is that I don't want a plot, just the table.
I've also looked at the heatmap functions. The problem there is that some of the values in my table are character, and the heatmap functions, from what I can tell, only accept numeric matrices. Also, I want my column names to be at the top of the table, not the bottom, and that doesn't seem to be an option.
Here's the example code for addtable2plot. If I could get just the table, filling the whole screen, that would be great.
library(plotrix)
testdf<-data.frame(Before=c(10,7,5,9),During=c(8,6,2,5),After=c(5,3,4,3))
rownames(testdf)<-c("Red","Green","Blue","Lightblue")
barp(testdf,main="Test addtable2plot",ylab="Value",
names.arg=colnames(testdf),col=2:5)
# show most of the options including the christmas tree colors
abg<-matrix(c(2,3,5,6,7,8),nrow=4,ncol=3)
addtable2plot(2,8,testdf,bty="o",display.rownames=TRUE,hlines=TRUE,
vlines=TRUE,title="The table",bg=abg)
Any help would be greatly appreciated.
A heatmap alternative:
library(gplots)
# need data as matrix
mm <- as.matrix(testdf, ncol = 3)
heatmap.2(x = mm, Rowv = FALSE, Colv = FALSE, dendrogram = "none",
cellnote = mm, notecol = "black", notecex = 2,
trace = "none", key = FALSE, margins = c(7, 11))
In heatmap.2 the side of the plot the axis is to be drawn on is hard-coded. But if you type "heatmap.2" at the console and copy the output to an editor, you can search for axis(1, where the 1 is the side argument (two hits). You can then change from a 1 (axis below plot) to a 3 (axis above the plot). Assign the updated function to a new name, e.g. heatmap.3, and run it as above.
An addtable2plot alternative
library(plotrix)
# while plotrix is loaded anyway:
# set colors with color.scale
# need data as matrix*
mm <- as.matrix(testdf, ncol = 3)
cols <- color.scale(mm, extremes = c("red", "yellow"))
par(mar = c(0.5, 1, 2, 0.5))
# create empty plot
plot(1:10, axes = FALSE, xlab = "", ylab = "", type = "n")
# add table
addtable2plot(x = 1, y = 1, table = testdf,
bty = "o", display.rownames = TRUE,
hlines = TRUE, vlines = TRUE,
bg = cols,
xjust = 2, yjust = 1, cex = 3)
# *According to `?color.scale`, `x` can be a data frame.
# However, when I tried with `testdf`, I got "Error in `[.data.frame`(x, segindex) : undefined columns selected".
A color2D.matplot alternative
library(plotrix)
par(mar = c(0.5, 8, 3.5, 0.5))
color2D.matplot(testdf,
show.values = TRUE,
axes = FALSE,
xlab = "",
ylab = "",
vcex = 2,
vcol = "black",
extremes = c("red", "yellow"))
axis(3, at = seq_len(ncol(testdf)) - 0.5,
labels = names(testdf), tick = FALSE, cex.axis = 2)
axis(2, at = seq_len(nrow(testdf)) -0.5,
labels = rev(rownames(testdf)), tick = FALSE, las = 1, cex.axis = 2)
After this little exercise, I tend to agree with #Drew Steen that LaTeX alternatives may be investigated as well. For example, check here and here.
You can hack something with grid and gtable,
palette(c(RColorBrewer::brewer.pal(8, "Pastel1"),
RColorBrewer::brewer.pal(8, "Pastel2")))
library(gtable)
gtable_add_grobs <- gtable_add_grob # alias
d <- head(iris, 3)
nc <- ncol(d)
nr <- nrow(d)
extended_matrix <- cbind(c("", rownames(d)), rbind(colnames(d), as.matrix(d)))
## text for each cell
all_grobs <- matrix(lapply(extended_matrix, textGrob), ncol=ncol(d) + 1)
## define the fill background of cells
fill <- lapply(seq_len(nc*nr), function(ii)
rectGrob(gp=gpar(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=all_grobs,
widths=col_widths(all_grobs) + unit(4,"mm"),
heights=row_heights(all_grobs) + unit(4,"mm"))
## add the background
g <- gtable_add_grobs(g, fill, t=rep(seq(2, nr+1), each=nc),
l=rep(seq(2, nc+1), nr), z=0,name="fill")
## draw
grid.newpage()
grid.draw(g)
Sort of a hacky solution based on ggplot2. I don't totally understand how you actually want to map your colors, since in your example the colors in the table are not mapped to the rownames of testdf, but here I've mapped the colors to the value (converted to a factor).
testdf$color <- rownames(testdf)
dfm <- melt(testdf, id.vars="color")
p <- ggplot(dfm, aes(x=variable, y=color, label=value, fill=as.factor(value))) +
geom_text(colour="black") +
geom_tile(alpha=0.2)
p
You can change what variable the values are mapped to using fill=, and you can change the mapping using scale_fill_manual(values=[a vector of values].
That said, I'd be curious to see a solution that produces an actual table, rather than a plot masquerading as a table. Possibly using Sweave and LaTeX tables?

Resources