Related
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")))
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)))
I'm trying to create a figure similar to the one below (taken from Ro, Russell, & Lavie, 2001). In their graph, they are plotting bars for the errors (i.e., accuracy) within the reaction time bars. Basically, what I am looking for is a way to plot bars within bars.
I know there are several challenges with creating a graph like this. First, Hadley points out that it is not possible to create a graph with two scales in ggplot2 because those graphs are fundamentally flawed (see Plot with 2 y axes, one y axis on the left, and another y axis on the right)
Nonetheless, the graph with superimposed bars seems to solve this dual sclaing problem, and I'm trying to figure out a way to create it in R. Any help would be appreciated.
It's fairly easy in base R, by using par(new = T) to add to an existing graph
set.seed(54321) # for reproducibility
data.1 <- sample(1000:2000, 10)
data.2 <- sample(seq(0, 5, 0.1), 10)
# Use xpd = F to avoid plotting the bars below the axis
barplot(data.1, las = 1, col = "black", ylim = c(500, 3000), xpd = F)
par(new = T)
# Plot the new data with a different ylim, but don't plot the axis
barplot(data.2, las = 1, col = "white", ylim = c(0, 30), yaxt = "n")
# Add the axis on the right
axis(4, las = 1)
It is pretty easy to make the bars in ggplot. Here is some example code. No two y-axes though (although look here for a way to do that too).
library(ggplot2)
data.1 <- sample(1000:2000, 10)
data.2 <- sample(500:1000, 10)
library(ggplot2)
ggplot(mapping = aes(x, y)) +
geom_bar(data = data.frame(x = 1:10, y = data.1), width = 0.8, stat = 'identity') +
geom_bar(data = data.frame(x = 1:10, y = data.2), width = 0.4, stat = 'identity', fill = 'white') +
theme_classic() + scale_y_continuous(expand = c(0, 0))
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 arrange multiple charts on shiny app. I am trying to plot 2 pie charts and a ggplot2 chart.
require(ggplot2)
require(gridExtra)
par(mfrow = c(2,2))
z=data.frame(x=1:10, y=11:20)
pie(z$x,z$y)
pie(z$x,z$y)
ggplot(z, aes(x,y)) + geom_bar(stat="identity", width=.3)
I tried with grid.arrange but it only render ggplot chart. I tried to to render these three plot using grid.arrange, then it return error message input must be grobs! Please help to render these three on single page.
I'm not certain what you want it to look like but here's an example how to combine your three plots:
require(ggplot2)
require(grid)
require(gridBase)
z=data.frame(x=1:10, y=11:20)
# setup everything
plot.new()
gl <- grid.layout(2,2)
vp.1 <- viewport(layout.pos.col = 1, layout.pos.row = 1)
vp.2 <- viewport(layout.pos.col = 2, layout.pos.row = 1)
vp.3 <- viewport(layout.pos.col = c(1,2), layout.pos.row = 2)
pushViewport(viewport(layout=gl))
# First plot
pushViewport(vp.1)
par(new = TRUE, fig = gridFIG(), mar=c(0,0,0,0))
pie(z$x,z$y)
popViewport()
# Second plot
pushViewport(vp.2)
par(new = TRUE, fig = gridFIG(), mar=c(0,0,0,0))
pie(z$x,z$y)
popViewport(1)
# Your ggplot
pushViewport(vp.3)
p<-ggplot(z, aes(x,y)) + geom_bar(stat="identity", width=.3)
print(p, newpage = FALSE)
popViewport(2)
NOTE: I do not recommend using pie charts. See this example