Related
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?
I would like to add a 2nd y-axis (right) and a 2nd x-axis (top) to the following (lattice) levelplot. These axes should only indicate certain rows and columns (no labels) and thus mimick base-graphics' rug function. How can this be done?
library(lattice)
library(latticeExtra)
## Generate a correlation matrix
d <- 50
L <- diag(1:d)
set.seed(271)
L[lower.tri(L)] <- runif(choose(d,2))
Sigma <- L %*% t(L)
P <- cor(Sigma)
## Panel function
my_panel <- function(...) {
panel.levelplot(...)
panel.abline(h = (1:4)*10, v = (1:4)*10, lty = 2)
panel.axis(side = "top", at = (1:50)-0.5, draw.labels = FALSE) # maybe a panel axis could do it? why not centered?
}
## Plot
obj1 <- levelplot(P, xlab = "Column", ylab = "Row",
col.regions = grey(c(seq(1, 0, length.out = 600))),
panel = my_panel)
obj2 <- xyplot(NA~NA, ylim = c(0, 50),
scales = list(x = list(at = (1:50)-0.5, labels = rep("", 50)),
y = list(at = (1:50)-0.5, labels = rep("", 50))))
doubleYScale(obj1, obj2, use.style = FALSE) # idea based on latticeExtra; only gives a 2nd y-axis, though
You were onto a good idea with panel.rug(), but were stymied by lattice's default clipping of its plotting to the panel's interior. To get around that, you can turn off clipping via the par.settings= argument. If you want to suppress the plotting of default axis tick marks on the right and top panel borders, you can do so using the tck= argument, as shown below.
my_panel <- function(...) {
panel.levelplot(...)
panel.abline(h = (1:4)*10, v = (1:4)*10, lty = 2)
## Have panel.rug print tick marks starting at 1 npc (edge of panel)
## and extending to 1.02 npc (slightly outside of panel). (See ?unit)
panel.rug(x = (1:51)-0.5, y = (1:51)-0.5,
start = 1, end = 1.02,
col="black")
}
levelplot(P, xlab = "Column", ylab = "Row",
col.regions = grey(c(seq(1, 0, length.out = 600))),
## Suppress default scales on right and top sides, by setting their
## tick lengths to zero
scales = list(tck=c(1,0)),
## Turn off clipping, so that panel.rug can plot outside of the panel
par.settings = list(clip = list(panel = "off")),
panel = my_panel)
Using the sample data below, how can I generate rasters and spatial points plot with the same colorkey as in the "manually" joined plot shown below?
library(rasterVis)
library(raster)
library(colorRamps)
col=colorRampPalette(matlab.like2(255))
s <- stack(replicate(2, raster(matrix(runif(100), 10))))
xy <- data.frame(coordinates(sampleRandom(s, 10, sp=TRUE)),
z1=runif(10), z2=runif(10))
levelplot(s, margin=FALSE, at=seq(0, 1, 0.05),col.regions=col)
x=xy$x;y=xy$y;z=xy$z1
levelplot(z ~ x + y,contour=F, panel = panel.levelplot.points,
margin=FALSE,col.regions=col,
par.settings=list(axis.line=list(lwd=3), strip.border=list(lwd=3)),
cex=1.4, scales=list(x=list(cex=1.7),y=list(cex=1.7)),xlab=list(label="Longitude",cex=2),
ylab=list(label="Latitude",cex=2))
Thanks to #fdestch I was able to generate the following plot using:
latticeCombineGrid(mget(rep("pp", 24)), layout = c(3, 8))
following my comments on printing multiple plots with the same colorkey.
An issue that remains to be clarified:
1) How can one decide on the order of panels? That is, which row & column to place a particular plot just as in levelplot using index.cond.
First of all, you should probably make sure that the breaks in the points plot are identical with those defined in the first levelplot.
## raster plot with colorkey disabled
pr <- levelplot(s, margin = FALSE, at = seq(0, 1, 0.05), col.regions = col,
colorkey = FALSE, xlab = list("Longitude", col = "transparent"))
## points plot
pp <- levelplot(z ~ x + y, panel = panel.levelplot.points, cex = 1.4,
contour = FALSE, margin = FALSE, col.regions = col,
colorkey = list(at = seq(0, 1, .05), width = .6, height = .6),
xlab = "Longitude", ylab = "Latitude")
Please note the definition of a transparent xlab when creating the raster plot. This little workaround comes in quite handy when using downViewport later on to ensure that the actual plot boundaries of pr and pp overlap (feel free to run grid.rect() right after print(pr, newpage = FALSE) to see what I mean).
The actual plot arrangement can then easily be achieved by using viewports from the grid package.
library(grid)
library(lattice)
## initialize new grid device
grid.newpage()
## add raster plot
vp1 <- viewport(x = 0, y = 0, width = .5, height = 1,
just = c("left", "bottom"))
pushViewport(vp1)
print(pr, newpage = FALSE)
## add points plot
downViewport(trellis.vpname("page"))
vp2 <- viewport(x = 1, y = 0, width = .75, height = 1,
just = c("left", "bottom"))
pushViewport(vp2)
print(pp, newpage = FALSE)
Here is my solution using latticeExtra::c.trellis:
library(raster)
library(rasterVis)
s <- stack(replicate(2, raster(matrix(runif(100), 10))))
xy <- data.frame(coordinates(sampleRandom(s, 10, sp=TRUE)),
z1=runif(10), z2=runif(10))
## Define theme and breaks
myTheme <- BTCTheme()
my.at <- seq(0, 1, 0.05)
Plot the Raster* object, using rasterVis::levelplot:
p1 <- levelplot(s, margin=FALSE,
at = my.at,
par.settings = myTheme)
Plot the points, using lattice::levelplot:
p2 <- levelplot(z1 ~ x + y, data = xy,
at = my.at,
panel = panel.levelplot.points,
par.settings = myTheme)
Join them with latticeExtra::c.trellis:
p3 <- c(p1, p2, layout = c(3, 1))
Unfortunately, c.trellis does not assign the strip labels correctly, so you have to define them directly:
update(p3,
strip = strip.custom(factor.levels = c(names(s), "Points")))
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)
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?