Adding legend for list of ggplots created in loop - r

I am creating a list of plots (without legend) by using a loop in ggplot2. Then I created a legend separately and trying to print a combined plots by using grid.arrange and grobs function. It creates the combined plot but without the legend. Could anyone please help to solve the problem?
I am attaching my code here:
df1<-data.frame(x=1:10,y1=rnorm(10),y2=rnorm(10),y3=rnorm(10),y4=rnorm(10),y5=rnorm(10))
df2 <- melt(df1,id.vars="x")
plot.list = list()
for (i in 1:3){
p <- ggplot(df2, aes(x=x, y=value)) +
geom_line(aes(colour=variable, group=variable))+
theme(legend.position='none')
plot.list[[i]] = p
}
temp_legend <- ggplot(df2, aes(x=x, y=value)) +
geom_line(aes(colour=variable, group=variable)) +
scale_color_manual("",labels = c("Observed","3d","5d","7d","10d"), values = c("black", "limegreen","blue","tan1","red3")) +
theme(legend.direction = "horizontal",
legend.position = "bottom")
library(gridExtra)
# create get_legend function
get_legend<-function(myggplot){
tmp <- ggplot_gtable(ggplot_build(myggplot))
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]
return(legend)
}
# Extract legend using get_legend function
legend <- get_legend(temp_legend)
# png export
png("Output.png", width = 5, height = 6.35, units = 'in', res = 300)
grid.arrange(grobs=plot.list,legend,
ncol=1, nrow = 4,
widths = 6, heights = c(2,2,2,0.35))
dev.off()

grid.arrange(grobs=c(plot.list,list(legend)),
ncol=1, heights = c(2,2,2,0.35))
or simply
grid.arrange(grobs=plot.list, ncol=1, bottom = legend)

Related

R-marrangeGrob unique legend

I have a list of 45 ggplot objects that I'm arranging across multiple pages thanks to the marrangeGrob() function from gridExtra. I would like to show a same and unique legend on each pages.
I know how to extract the legend (g_legend), how to plot my ggplot without the legend. But I do not find a way to have a multipages thanks to marrangeGrob and a unique legend.
I used g_legend() to extract my legend
g_legend<-function(a.gplot){
g <- ggplotGrob(a.gplot + theme(legend.position = "right"))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
return(legend)}
In order to simplify, the reproductible data set is from diamonds, and let say I want to produce on one page p1 and p2 and on an other page p2 and p1.
df <- count(diamonds, cut)
p1 = ggplot(df, aes(x=cut, y=n, label=format(n, big.mark=","), fill=cut)) +
geom_bar(stat="identity") +
geom_text(aes(y=0.5*n), colour="white") +
coord_flip() +
theme(legend.position="bottom")
p2 = ggplot(diamonds %>% sample_n(1000), aes(x=carat, y=price, colour=cut)) +
geom_point()
leg = g_legend(p1)
I first try to plot the 4 graphs in one page
combined<-arrangeGrob(do.call("arrangeGrob",c(
lapply(list(p1,p2,p2,p1), function(x){ x + theme(legend.position="none")}),ncol=2)),
leg,
ncol = 2)
grid.newpage()
grid.draw(combined)
which works perfectly but when I try to do it with multipages
marrangeGrob(do.call("marrangeGrob",c(lapply(list(p1,p2,p2,p1), function(x){ x + theme(legend.position="none")}),
ncol=2,nrow=2)),
leg,
ncol = 2,nrow=1)
I obtained :
Error in $<-.data.frame(*tmp*, "wrapvp", value = list(x = 0.5, y = 0.5, : replacement has 17 rows, data has 5
Does anyone know a way to use marrangeGrob and obtain a unique legend on each multipages?

Multipanel plot with ggplot2?

I have bar charts faceted by stock symbol name:
I would like to be able to add a little "subplot" of an indicator below each plot, like this:
Is this possible with ggplot2? I thought of a secondary axis, but most often there is no linear relation between the main plot axis and the indicator axis (so using sec_axis is not an option).
Thanks!
Since these appear to be categorically different types of plots, I think you'll have better luck creating separate plots and then rendering them together. Here's one solution using cowplot package:
library(ggplot2)
library(cowplot)
#sample data
df <- data.frame(x = 1:100, y = cumsum(rnorm(100)), volume = sample(1:10, 100, replace = TRUE))
p1 <- ggplot(df, aes(x,y)) +
geom_line()
p2 <- ggplot(df, aes(x,volume)) +
geom_bar(stat = "identity")
plot_grid(p1, p2, align = "v", ncol = 1, rel_heights = c(.8, .2))
Created on 2019-01-25 by the reprex package (v0.2.1)
Edit
Continuing to build on this kludgy example to support the concept of faceting. Ignore the ugly graph, it's smooshed due to image size constraints.
library(ggplot2)
library(cowplot)
library(gridExtra)
#sample data
df <- data.frame(x = 1:100, y = cumsum(rnorm(100)), volume = sample(1:10, 400, replace = TRUE), group = letters[1:4])
plots <- list()
for (j in unique(df$group)){
plot_df <- df[df$group == j, ]
p1 <- ggplot(plot_df, aes(x,y)) +
geom_line() +
facet_wrap(~group) +
xlab("")
p2 <- ggplot(plot_df, aes(x,volume)) +
geom_bar(stat = "identity")
p_out <- plot_grid(p1, p2, align = "v", ncol = 1, rel_heights = c(.7, .3))
plots[[j]] <- p_out
}
do.call(grid.arrange, plots)
Created on 2019-01-25 by the reprex package (v0.2.1)

saving each modified facet in ggplot2

I try to save each Species data in iris data set to .png file using for loop. But before, that I would like to modify facet strip thickness as I needed to do in my real data plotting process.
However, when I attempted to write each facet
the following code below it just giving me the empty plots for each of these Species.
Here is my attempt,
library(ggplot2)
plot_list = list()
for (i in unique(iris$Species)) {
p = ggplot(iris[iris$Species == i, ], aes(x=Sepal.Length, y=Sepal.Width)) +
geom_point(size=3, aes(colour=Species))+
facet_wrap(~Species)
#this part to modify facet_wrap strips
g1 = ggplotGrob(p)
pos = c(unique(subset(g1$layout, grepl("panel", g1$layout$name), select = t)))
for(i in pos) g1$heights[i-1] = unit(0.4,"cm")
grobs = which(grepl("strip", g1$layout$name))
for(i in grobs) g1$grobs[[i]]$heights <- unit(1, "npc")
grid.newpage()
grid.draw(g1)
plot_list[[i]] = g1
}
#finally write the modified graphs to file
for (i in 1:3) {
file_name = paste("iris_plot_", i, ".png", sep="")
tiff(file_name)
print(plot_list[[i]])
dev.off()
}
Currently this code is producing the empty graphs and do not know why! Any help will be appreciated!
You don't need to modify strip height using ggplotGrob. Setting the relevant parameter in ggplot's theme() would do:
p1 = ggplot(iris[iris$Species == "setosa",],
aes(x = Sepal.Length, y = Sepal.Width)) +
geom_point() +
facet_wrap(~Species)
p2 = p1 + theme(strip.text.x = element_text(margin = margin(t = 10, b = 10)))
# note: default margin for top & bottom is 5.5
gridExtra::grid.arrange(p1, p2, ncol = 2)
As for the rest, you may wish to check the length of plot_list after the first loop. You initially assigned i to take on the unique values of iris$Species, then tried to use it as index for the list of plots. The first three elements of plot_list did not contain plots.
The following would work in this example. You probably need to make some modifications for the actual use case:
plot_list = list()
loop.list <- unique(iris$Species)
for (i in seq_along(loop.list)) {
p = ggplot(iris[iris$Species == loop.list[i], ],
aes(x = Sepal.Length, y=Sepal.Width)) +
geom_point(size = 3, aes(colour = Species))+
facet_wrap(~Species) +
theme(strip.text.x = element_text(margin = margin(t = 11, b = 11)))
plot_list[[i]] <- ggplotGrob(p)
}
for (i in 1:3) {
file_name = paste("iris_plot_", i, ".png", sep="")
tiff(file_name)
grid.draw(plot_list[[i]])
dev.off()
}

Getting even figure widths in grid.arrange

I'm trying to plot three figures using grid.arrange of R'sgridExtra package. I want them to appear as 3 columns in one row, where the left most figure should have the y-axis but no legend, the middle figure no y-axis and no legend, and the right most figure should have no y-axis but should include the legend. That way the legend and y-axis, which are identical to all figures, appear only once.
Here are the data - they relate to gene ontology enrichment tests:
First, the color scheme of the legend - a color for each enrichment p-value range:
color.order <- c("#7d4343","#B20000","#C74747","#E09898","#EBCCD6","#C8C8C8")
names(color.order) <- c("(0-0.05]","(0.05-0.1]","(0.1-0.15]","(0.15-0.2]","(0.2-0.25]","(0.25-1]")
Then the figure data.frames:
df.g1 <- data.frame(category=c("C1-up","C1-down","C2-up","C2-down"),
p.value=c(0.4833,0.5114,0.3487,0.6522),log10.p.value=c(3.157832,2.912393,4.575481,1.856192),
col=c("(0.25-1]","(0.25-1]","(0.25-1]","(0.25-1]"),
col.cat=c("(0.25-1]","(0.25-1]","(0.25-1]","(0.25-1]"))
df.g2 <- data.frame(category=c("C1-up","C1-down","C2-up","C2-down"),
p.value=c(0.5345,0.4819,0.9986,0.0013),log10.p.value=c(2.720522905,3.170430737,0.006084383,28.860566477),
col=c("(0.25-1]","(0.25-1]","(0.25-1]","(0-0.05]"),
col.cat=c("(0.25-1]","(0.25-1]","(0.25-1]","(0-0.05]"))
df.g3 <- data.frame(category=c("C1-up","C1-down","C2-up","C2-down"),
p.value=c(0.2262,0.7703,0.9926,0.0080),log10.p.value=c(6.45507399,1.13340102,0.03225729,20.96910013),
col=c("(0.2-0.25]","(0.25-1]","(0.25-1]","(0-0.05]"),
col.cat=c("(0.2-0.25]","(0.25-1]","(0.25-1]","(0-0.05]"))
Putting them together in a list:
df.list <- list(g1=df.g1,g2=df.g2,g3=df.g3)
This is for the legend which associates p-value ranges with colors:
color.order <- c("#7d4343","#B20000","#C74747","#E09898","#EBCCD6","#C8C8C8")
names(color.order) <- c("(0-0.05]","(0.05-0.1]","(0.1-0.15]","(0.15-0.2]","(0.2-0.25]","(0.25-1]")
And the plot creation code:
library(ggplot2)
library(gridExtra)
ggplot.list <- vector(mode="list", length(df.list))
for(g in 1:length(df.list))
{
if(g==1){ #draw y-axis but no legend
ggplot.list[[g]] <- ggplot(df.list[[g]], aes(y=log10.p.value,x=category,fill=col))+
scale_fill_manual(drop=FALSE,values=color.order,name="Enrichment P-value",guide=F)+
geom_bar(stat="identity",width=0.2)+scale_y_continuous(limits=c(0,30),labels=c(seq(0,20,10)," >30"),expand=c(0,0))+
theme_bw()+theme(panel.border=element_blank(),axis.text=element_text(size=8),axis.title=element_text(size=8,face="bold"))+coord_flip()+theme(plot.margin=unit(c(0.1,1,0.1,0.1),"cm"),axis.title.y = element_text(size=8),axis.title.x = element_text(size=8))+labs(x="Category",y="-10log10(P-value)")+ggtitle(names(df.list)[g])
} else if(g==2){ #no y-axis and no legend
ggplot.list[[g]] <- ggplot(df.list[[g]], aes(y=log10.p.value,x=category,fill=col))+
scale_fill_manual(drop=FALSE,values=color.order,name="Enrichment P-value",guide=F)+
geom_bar(stat="identity",width=0.2)+scale_y_continuous(limits=c(0,30),labels = c(seq(0,20,10)," >30"),expand=c(0,0))+
theme_bw()+theme(panel.border=element_blank(),axis.text=element_text(size=8),axis.title=element_text(size=8,face="bold"))+coord_flip()+theme(plot.margin=unit(c(0.1,1,0.1,0.1),"cm"),axis.title.y = element_blank(),axis.text.y=element_blank(),axis.title.x = element_text(size=8))+labs(y="-10log10(P-value)")+ggtitle(names(df.list)[g])
} else if(g==3){ #only legend
ggplot.list[[g]] <- ggplot(df.list[[g]], aes(y=log10.p.value,x=category,fill=col))+
scale_fill_manual(drop=FALSE,values=color.order,name="Enrichment P-value")+
geom_bar(stat="identity",width=0.2)+scale_y_continuous(limits=c(0,30),labels = c(seq(0,20,10)," >30"),expand=c(0,0))+
theme_bw()+theme(panel.border=element_blank(),axis.text=element_text(size=8),axis.title=element_text(size=8,face="bold"))+coord_flip()+theme(plot.margin=unit(c(0.1,1,0.1,0.1),"cm"),axis.title.y = element_blank(),axis.text.y=element_blank(),axis.title.x = element_text(size=8))+labs(y="-10log10(P-value)")+ggtitle(names(df.list)[g])
}
}
This gives me almost what I need:
My problem is that the three figures have different widths. So my question is how do I make the widths identical?
This data seems tailor-made for faceting:
library(dplyr)
library(ggplot2)
color.order <- c("#7d4343","#B20000","#C74747","#E09898","#EBCCD6","#C8C8C8")
names(color.order) <- c("(0-0.05]","(0.05-0.1]","(0.1-0.15]","(0.15-0.2]","(0.2-0.25]","(0.25-1]")
df <- bind_rows(df.list, .id="grp")
df <- mutate(df, col=factor(col, levels=names(color.order)))
gg <- ggplot(df, aes(y=log10.p.value, x=category, fill=col))
gg <- gg + geom_bar(stat="identity", width=0.2)
gg <- gg + scale_y_continuous(limits=c(0,30), labels=c(seq(0,20,10)," >30"), expand=c(0,0))
gg <- gg + scale_fill_manual(drop=FALSE, values=color.order, name="Enrichment P-value")
gg <- gg + coord_flip()
gg <- gg + facet_wrap(~grp)
gg <- gg + labs(x="Category", y="-10log10(P-value)")
gg <- gg + theme_bw()
gg <- gg + theme(panel.border=element_blank(),
panel.margin=margin(1,1,1,1, unit="cm"),
axis.text=element_text(size=8),
axis.title=element_text(size=8,face="bold"),
axis.title.y=element_text(size=8),
axis.title.x=element_text(size=8),
strip.background=element_blank(),
plot.margin=margin(0.1, 0.1, 0.1, 0.1, unit="cm"))
gg

Arrange many plots using gridExtra

I have spent many hours trying to fit 11 graphs in one plot and arrange them using gridExtra but I have failed miserably, so I turn to you hoping you can help.
I have 11 classifications of diamonds (call it size1) and other 11 classifications (size2) and I want to plot how the median price for each increasing size1 and increasing clarity (from 1 to 6) varies by increasing size2 of the diamonds, and plot all the 11 plots in the same graph.
I tried using gridExtra as suggested in other posts but the legend is far away to the right and all the graphs are squished to the left, can you please help me figure out how the "widths" for the legend in gridExtra has to be specified? I cannot find any good explanations. Thank you very much for your help, I really appreciate it...
I have been trying to find a good example to recreate my data frame but failed in this as well. I hope this data frame helps understand what I am trying to do, I could not get it to work and be the same as mine and some plots don't have enough data, but the important part is the disposition of the graphs using gridExtra (although if you have other comments on other parts please let me know):
library(ggplot2)
library(gridExtra)
df <- data.frame(price=matrix(sample(1:1000, 100, replace = TRUE), ncol = 1))
df$size1 = 1:nrow(df)
df$size1 = cut(df$size1, breaks=11)
df=df[sample(nrow(df)),]
df$size2 = 1:nrow(df)
df$size2 = cut(df$size2, breaks=11)
df=df[sample(nrow(df)),]
df$clarity = 1:nrow(df)
df$clarity = cut(df$clarity, breaks=6)
# Create one graph for each size1, plotting the median price vs. the size2 by clarity:
for (c in 1:length(table(df$size1))) {
mydf = df[df$size1==names(table(df$size1))[c],]
mydf = aggregate(mydf$price, by=list(mydf$size2, mydf$clarity),median);
names(mydf)[1] = 'size2'
names(mydf)[2] = 'clarity'
names(mydf)[3] = 'median_price'
assign(paste("p", c, sep=""), qplot(data=mydf, x=as.numeric(mydf$size2), y=mydf$median_price, group=as.factor(mydf$clarity), geom="line", colour=as.factor(mydf$clarity), xlab = "number of samples", ylab = "median price", main = paste("region number is ",c, sep=''), plot.title=element_text(size=10)) + scale_colour_discrete(name = "clarity") + theme_bw() + theme(axis.title.x=element_text(size = rel(0.8)), axis.title.y=element_text(size = rel(0.8)) , axis.text.x=element_text(size=8),axis.text.y=element_text(size=8) ))
}
# Couldnt get some to work, so use:
p5=p4
p6=p4
p7=p4
p8=p4
p9=p4
# Use gridExtra to arrange the 11 plots:
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)}
mylegend<-g_legend(p1)
grid.arrange(arrangeGrob(p1 + theme(legend.position="none"),
p2 + theme(legend.position="none"),
p3 + theme(legend.position="none"),
p4 + theme(legend.position="none"),
p5 + theme(legend.position="none"),
p6 + theme(legend.position="none"),
p7 + theme(legend.position="none"),
p8 + theme(legend.position="none"),
p9 + theme(legend.position="none"),
p10 + theme(legend.position="none"),
p11 + theme(legend.position="none"),
main ="Main title",
left = ""), mylegend,
widths=unit.c(unit(1, "npc") - mylegend$width, mylegend$width), nrow=1)
I had to change the qplot loop call slightly (i.e. put the factors in the data frame) as it was throwing a mismatched size error. I'm not including that bit since that part is obviously working in your environment or it was an errant paste.
Try adjusting your widths units like this:
widths=unit(c(1000,50),"pt")
And you'll get something a bit closer to what you were probably expecting:
And, I can paste code now a few months later :-)
library(ggplot2)
library(gridExtra)
df <- data.frame(price=matrix(sample(1:1000, 100, replace = TRUE), ncol = 1))
df$size1 = 1:nrow(df)
df$size1 = cut(df$size1, breaks=11)
df=df[sample(nrow(df)),]
df$size2 = 1:nrow(df)
df$size2 = cut(df$size2, breaks=11)
df=df[sample(nrow(df)),]
df$clarity = 1:nrow(df)
df$clarity = cut(df$clarity, breaks=6)
# Create one graph for each size1, plotting the median price vs. the size2 by clarity:
for (c in 1:length(table(df$size1))) {
mydf = df[df$size1==names(table(df$size1))[c],]
mydf = aggregate(mydf$price, by=list(mydf$size2, mydf$clarity),median);
names(mydf)[1] = 'size2'
names(mydf)[2] = 'clarity'
names(mydf)[3] = 'median_price'
mydf$clarity <- factor(mydf$clarity)
assign(paste("p", c, sep=""),
qplot(data=mydf,
x=as.numeric(size2),
y=median_price,
group=clarity,
geom="line", colour=clarity,
xlab = "number of samples",
ylab = "median price",
main = paste("region number is ",c, sep=''),
plot.title=element_text(size=10)) +
scale_colour_discrete(name = "clarity") +
theme_bw() + theme(axis.title.x=element_text(size = rel(0.8)),
axis.title.y=element_text(size = rel(0.8)),
axis.text.x=element_text(size=8),
axis.text.y=element_text(size=8) ))
}
# Use gridExtra to arrange the 11 plots:
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)}
mylegend<-g_legend(p1)
grid.arrange(arrangeGrob(p1 + theme(legend.position="none"),
p2 + theme(legend.position="none"),
p3 + theme(legend.position="none"),
p4 + theme(legend.position="none"),
p5 + theme(legend.position="none"),
p6 + theme(legend.position="none"),
p7 + theme(legend.position="none"),
p8 + theme(legend.position="none"),
p9 + theme(legend.position="none"),
p10 + theme(legend.position="none"),
p11 + theme(legend.position="none"),
top ="Main title",
left = ""), mylegend,
widths=unit(c(1000,50),"pt"), nrow=1)
Edit (16/07/2015): with gridExtra >= 2.0.0, the main parameter has been renamed top.

Resources