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.

回答1:

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.

回答2:

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)

回答3:

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?

来源：https://stackoverflow.com/questions/18663159/conditional-coloring-of-cells-in-table

标签

plot

heatmap