Related
I am trying to arrange two ggplot2 plots side by side, i.e., in a two-column
layout using the package gridExtra. I am interested in ensuring that both
plots have equal plotting area (i.e., the gray plot panel is the same for both
plots) regardless of the height of the x-axis labels. As you can see in the
example below, when longer x-axis labels are used, gridExtra::grid.arrange()
seems to compensate this by adjusting the plotting area (i.e., the grayed out
part of the plot).
# Dummy data.
data <- data.frame(x = 1:10, y = rnorm(10))
# Dummy labels.
x_labels_short <- 1:10
x_labels_long <- 100001:100010
# Common settings for both `ggplot2` plots.
layers <- list(
labs(
x = "Plot title"
),
theme(
axis.text.x = element_text(
angle = 90,
vjust = 0.5,
hjust = 1
)
)
)
# `ggplot2 plot (a).
plot_a <- ggplot(data, aes(x, y)) +
scale_x_continuous(breaks = 1:10, labels = x_labels_short) +
layers
# `ggplo2` plot (b).
plot_b <- ggplot(data, aes(x, y)) +
scale_x_continuous(breaks = 1:10, labels = x_labels_long) +
layers
# Showing the plots side by side.
gridExtra::grid.arrange(
plot_a,
plot_b,
ncol = 2
)
Output:
What I want is for both plots to (1) have equal plotting area and (b) the x-axis
title of plot_a to be aligned with that of plot_b (i.e., the x-axis title of
plot_a to be offset based on the length of of the x-axis labels of plot_b).
If this is not clear, this is what I want to achieve would look like with base
R.
# Wrapper for convenience.
plot_gen <- function(data, labels) {
plot(
NULL,
xlim = c(1, 10),
ylim = c(min(data$y), max(data$y)),
xlab = "",
ylab = "y",
xaxt = "n"
)
axis(
side = 1,
at = 1:10,
labels = labels,
las = 2
)
title(
xlab = "Plot title",
line = 4.5
)
}
# Get `par`.
old_par = par(no.readonly = TRUE)
# Set the two-column layout.
layout(matrix(1:2, ncol = 2))
# Adjust margins.
par(mar = old_par$mar + c(1.5, 0, 0, 0))
# Plot base plot one.
plot_gen(data, x_labels_short)
# Plot base plot two.
plot_gen(data, x_labels_long)
# Restore `par`.
par(old_par)
# Restore layout.
layout(1:1)
Output:
Quick mention. I found a similar question on SO (i.e.,
How to specify the size of a graph in ggplot2 independent of axis labels), however I fail to see how the
answers address the problem. Also, the plots I am trying to arrange are based
on different data and I don't think I can use a facet_wrap approach.
One suggestion: the patchwork package.
library(patchwork)
plot_a + plot_b
It also works for more complex layouts, e.g.:
(plot_a | plot_b) / plot_a
I use R to analyse data, ggplot to create plots, tikzDevice to print them and finally latex to create a report. THe problem is that large plots with many points fail due to the memory limit of latex. I found here https://github.com/yihui/tikzDevice/issues/103 a solution that rasterises the plot before printing the tikz file, which allows printing the points and the text individually.
require(png)
require(ggplot2)
require(tikzDevice)
## generate data
n=1000000; x=rnorm(n); y=rnorm(n)
## first try primitive
tikz("test.tex",standAlone=TRUE)
plot(x,y)
dev.off()
## fails due to memory
system("pdflatex test.tex")
## rasterise points first
png("inner.png",width=8,height=6,units="in",res=300,bg="transparent")
par(mar=c(0,0,0,0))
plot.new(); plot.window(range(x), range(y))
usr <- par("usr")
points(x,y)
dev.off()
# create tikz file with rasterised points
im <- readPNG("inner.png",native=TRUE)
tikz("test.tex",7,6,standAlone=TRUE)
plot.new()
plot.window(usr[1:2],usr[3:4],xaxs="i",yaxs="i")
rasterImage(im, usr[1],usr[3],usr[2],usr[4])
axis(1); axis(2); box(); title(xlab="x",ylab="y")
dev.off()
## this works
system("pdflatex test.tex")
## now with ggplot
p <- ggplot(data.frame(x=x, y=y), aes(x=x, y=y)) + geom_point()
## what here?
In this example the first pdflatex fails. The second succeeds due to the rasterisation.
How can I apply this using ggplot?
here's a proof-of-principle to illustrate the steps that would be involved. As pointed out in the comments it's not recommendable or practical, but could be the basis of a lower-level implementation.
require(png)
require(ggplot2)
require(tikzDevice)
n=100;
d <- data.frame(x=rnorm(n), y=rnorm(n), z=rnorm(n))
p <- ggplot(d, aes(x=x, y=y, colour=z, size=z, alpha=x)) + geom_point()
## draw the layer by itself on a png file
library(grid)
g <- ggplotGrob(p)
# grid.newpage()
gg <- g$grobs[[6]]$children[[3]]
gg$vp <- viewport() # don't ask me
tmp <- tempfile(fileext = "png")
png(tmp, width=10, height=4, bg = "transparent", res = 30, units = "in")
grid.draw(gg)
dev.off()
## import it as a raster layer
rl <- readPNG(tmp, native = TRUE)
unlink(tmp)
## add it to a plot - note that the positions match,
## but the size can be off unless one ensures that the panel has the same size and aspect ratio
ggplot(d, aes(x=x, y=y)) + geom_point(shape="+", colour="red") +
annotation_custom(rasterGrob(rl, width = unit(1,"npc"), height=unit(1,"npc"))) +
geom_point(aes(size=z), shape=1, colour="red", show.legend = FALSE)
## to illustrate the practical use, we use a blank layer to train the scales
## and set the panel size to match the png file
pf <- ggplot(d, aes(x=x, y=y)) + geom_blank() +
annotation_custom(rasterGrob(rl, width = unit(1,"npc"), height=unit(1,"npc"), interpolate = FALSE))
tikz("test.tex", standAlone=TRUE)
grid.draw(egg::set_panel_size(pf, width=unit(10, "cm"), height=unit(4, "cm")))
dev.off()
system("lualatex test.tex")
system("open test.pdf")
we can zoom in and check that the text is vector-based while the layer is (here low-res for demonstration) raster.
ok, I will write it here because it was too big for the comment box. Instead of adding the rasterised points to a nw plot with new scales you can actually replace the original grob with the rasterised grob by
g$grobs[[6]]$children[[3]] <- rasterGrob(rl). The problem is that it doesn't scale, so you have to know the size of the final image before. Then you can sue sth like this:
rasterise <- function(ggp,
width = 6,
height = 3,
res.raster = 300,
raster.id= c(4,3),
file = ""){
## RASTERISE
require(grid)
require(png)
## draw the layer by itself on a png file
gb <- ggplot_build(ggp)
gt <- ggplot_gtable(gb)
## calculate widths
h <- as.numeric(convertUnit(sum(gt$heights), unitTo="in"))
w <- as.numeric(convertUnit(sum(gt$widths) , unitTo="in"))
w.raster <- width-w
h.raster <- height-h
## print points as png
grid.newpage()
gg <- gt$grobs[[raster.id[1]]]$children[[raster.id[2]]]
gg$vp <- viewport() # don't ask me
tmp <- tempfile(fileext = "png")
png(tmp, width=w.raster, height=h.raster, bg = "transparent", res = res.raster, units = "in")
grid.draw(gg)
dev.off()
## import it as a raster layer
points <- readPNG(tmp, native = TRUE)
points <- rasterGrob(points, width = w.raster, height = h.raster, default.units = "in")
unlink(tmp)
## ADD TO PLOT
gt$grobs[[raster.id[1]]]$children[[raster.id[2]]] <- points
## PLOT TMP
### HERE YOU CAN ONLY PRINT IT IN THIS DIMENSIONS!
pdf(file, width = width, height = height)
grid.draw(gt)
dev.off()
}
And then use it with
data <- data.frame(x = rnorm(1000), y = rnorm(1000))
plot <- ggplot(data, aes(x = x, y = y)) +
geom_point() +
annotate("text", x = 2, y = 2, label = "annotation")
rasterise(ggp = plot,
width = 6,
height = 3,
res.raster = 10,
raster.id = c(4,2),
file = "~/test.pdf")
The problem remains the ID of the grob you want to rasterise. I didn't figure out a good way to find the correct one automatically. It depends on which layers you add to the plot.
I want to plot data for a linear model in a main plot and a plot of the effects (forest plot) as a subplot using arrangeGrob.
Here are the data:
set.seed(1)
main.df <- data.frame(sample=c(paste("E.plus.A.plus",1:3,sep="_"),paste("E.minus.A.plus",1:3,sep="_"),paste("E.plus.A.minus",1:3,sep="_"),paste("E.minus.A.minus",1:3,sep="_")),
replicate=rep(1:3,4),cpm=c(rnorm(12)),
factor.level=factor(c(rep("E.plus.A.plus",3),rep("E.minus.A.plus",3),rep("E.plus.A.minus",3),rep("E.minus.A.minus",3)),
levels=c("E.plus.A.plus","E.minus.A.plus","E.plus.A.minus","E.minus.A.minus")))
effects.df <- data.frame(factor.level=c("E.plus.A.plus-E.minus.A.plus","E.plus.A.plus-E.plus.A.minus","E.plus.A.plus-E.minus.A.minus",
"E.minus.A.plus-E.plus.A.minus","E.minus.A.plus-E.minus.A.minus","E.plus.A.minus-E.minus.A.minus"),
effect=rnorm(6),effect.df=runif(6,0,0.5),p.value=runif(6,0,1),y=1:6+0.2)
effects.df$effect.high <- effects.df$effect+effects.df$effect.df
effects.df$effect.low <- effects.df$effect-effects.df$effect.df
effects.df$factor.level <- factor(effects.df$factor.level,levels=effects.df$factor.level)
The ggplots:
require(ggplot2)
require(grid)
require(gridExtra)
main.plot <- ggplot(main.df,aes(x=replicate,y=cpm,color=factor.level))+geom_point(size=3)+
facet_wrap(~factor.level,ncol=length(levels(main.df$factor.level)))+
labs(x="replicate",y="cpm")+scale_x_continuous(breaks=unique(main.df$replicate))+theme_bw()+
theme(legend.key=element_blank(),panel.border=element_blank(),strip.background=element_blank(),axis.title=element_text(size=8),plot.title=element_text(size=9,hjust=0.5))
Which is:
sub.plot <- ggplot(effects.df,aes(x=effect,y=factor.level,color=factor.level))+geom_point(size=2.5,shape=19)+geom_errorbarh(aes(xmax=effect.high,xmin=effect.low),height=0.1)+
geom_vline(xintercept=0,linetype="longdash",colour="black",size=0.25)+theme_bw()+theme(legend.key=element_blank(),panel.border=element_blank(),strip.background=element_blank(),axis.title=element_text(size=7),axis.text=element_text(size=7),legend.text=element_text(size=7),legend.title=element_text(size=7))+
geom_text(aes(x=effects.df$effect,y=effects.df$y,label=format(signif(effects.df$p.value,2),scientific=T)),size=2.5)
And is:
And here's how I try to combine them into a single plot:
if(!is.null(dev.list())) dev.off()
blank <- grid.rect(gp = gpar(col = "white"))
sub.plot.grob <- arrangeGrob(blank,sub.plot,ncol=1)
combined.plot <- arrangeGrob(main.plot,sub.plot,ncol=2,widths=c(1,1))
grid.arrange(combined.plot)
which gives:
How do I adjust the position and dimensions so that sub.plot is smaller (all layers, e.g., text are reduced proportionally), and is positioned below the legend of main.plot?
I strongly recommend the package cowplot for this sort of task. Here, I am building three nested sets (the main plot to the left, then the two legends together at the top right, then the sub plot at the bottom right). Note the wonderful get_legend function that make pulling the legends incredibly easy.
plot_grid(
main.plot + theme(legend.position = "none")
, plot_grid(
plot_grid(
get_legend(main.plot)
, get_legend(sub.plot)
, nrow = 1
)
, sub.plot + theme(legend.position = "none")
, nrow = 2
)
, nrow = 1
)
gives:
Obviously I'd recommend changing one (or both) of the color palettes, but that should give what you want.
If you really want the legend with the sub.plot, instead of with the other legend, you could skip the get_legend.
You can also adjust the width/height of the sets using rel_widths and rel_heights if you want something other than the even sizes.
As an additional note, cowplot sets its own default theme on load. I generally revert to what I like by running theme_set(theme_minimal()) right after loading it.
here's a grid.arrange solution,
grid.arrange(grobs = replicate(4, ggplot(), simplify = FALSE),
layout_matrix = cbind(c(1,1), c(3,2), c(4, 2)),
widths = c(2,1,1))
with those bits and pieces,
get_legend <- function(p) {
g <- ggplotGrob(p)
id <- grep("guide", g$layout$name)
g$grobs[[id]]
}
leg1 <- get_legend(main.plot); leg2 <- get_legend(sub.plot)
gl <- list(main.plot + theme(legend.position = "none"),
sub.plot + theme(legend.position = "none"), leg1, leg2)
grid.arrange(grobs = gl,
layout_matrix = cbind(c(1,1), c(3,2), c(4, 2)),
widths = c(2,1,1))
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
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)