I have a problem with combining ggplots using cowplot and ggpubr which is driving me crazy.
The problem is with the legend. When it's displayed with its original graph on its own, the spacing between the elements of the legend (guide title, key, key-label) are absolutely fine.
However, if I extract the legend from the original plot, and then display it in a combined plot (using either plot_grid from cowplot or ggarrange from ggpubr) then the spacing goes haywire. The longer the text, the more the spacing expands.
What is wrong here, and how do I fix it so that the legend in the combined plot looks exactly like the one in the original individual plot?
Example
This example uses ggarrange from ggpubr; my results with get_legend and plot_grid using cowplot are similar. Treatment names are entirely made up.
library(survival)
library(broom)
library(dplyr)
library(foreach)
library(ggpubr)
fit <- survfit(Surv(time,status == 2) ~ trt + sex, data=pbc)
time.xticks <- seq(0, 4000, 1000)
delta <- 0.00001
# Survival plot
kmdata <- tidy(fit) %>%
mutate(trt=factor(gsub('trt=(.*),.*','\\1',strata)),
sex=factor(gsub('.*sex=(.*)','\\1',strata), levels=levels(pbc$sex)))
p1 <- ggplot(data=filter(kmdata, time<=max(time.xticks)), aes(x=time, y=estimate, colour=sex, linetype=trt)) + geom_step() +
scale_x_continuous(breaks = time.xticks,
limits = c(min(time.xticks), max(time.xticks))) +
scale_colour_discrete(name="Sex", labels=c("Male","Female")) +
scale_linetype_discrete(name="Treatment group", labels=c("Zyxatrxilbroh 35 mg", "Placebo 35 mg")) +
theme(legend.position = "bottom", legend.box = "horizontal",
legend.background = element_rect(fill="grey90", colour="black", size=0),
legend.key.height=unit(0.2, "cm"),
text=element_text(size=18))
tardata <- foreach(s=unique(kmdata$strata), .combine="rbind") %do% {
filter(kmdata, strata==s)[findInterval(pmax(0, time.xticks-delta), filter(kmdata, strata==s)$time)+1,] %>%
bind_cols(tibble(time.xticks))
} %>%
mutate(ypos = -((as.integer(sex)-1)*(length(unique(pbc$trt))+2) + as.integer(trt) + 1))
tarheads <- tibble(xpos=0,
ypos=-(((1:length(unique(pbc$sex))) - 1)*(length(unique(pbc$trt)) + 2) + 1),
lab=levels(pbc$sex))
risk.yticks <- sort(unique(tardata$ypos))
risk.ylabels <- rep(rev(paste("trt =",levels(kmdata$trt))), length(unique(kmdata$sex)))
# Number-at-risk table
p2 <- ggplot(data=tardata, aes(x=time.xticks, y=ypos, label=n.risk, colour=sex)) + geom_text() +
geom_text(data=tarheads, aes(x=xpos, y=ypos, label=lab), colour="black", hjust="left") +
scale_x_continuous(breaks = time.xticks,
limits = c(min(time.xticks), max(time.xticks))) +
scale_y_continuous(breaks = risk.yticks,
labels = risk.ylabels) +
theme(text=element_text(size=18))
# put the two together
p.comb <- ggarrange(p1, p2, heights = c(2, 0.8), ncol=1,
align="v", common.legend = TRUE, legend="bottom")
# alternate version with guide headings at the top left instead of at the side
p1.a <- p1 + guides(colour = guide_legend(order=1,
title.position = "top",
title.hjust = 0),
linetype = guide_legend(order=1,
title.position = "top",
title.hjust = 0))
p.comb.a <- ggarrange(p1.a, p2, heights = c(2, 0.8), ncol=1,
align="v", common.legend = TRUE, legend="bottom")
# send to png
png("test-p1.png", width=8, height=4.5, units="in", res=200, type="cairo")
plot(p1)
dev.off()
png("test-pcomb.png", width=8, height=4.5, units="in", res=200, type="cairo")
plot(p.comb)
dev.off()
Results
Individual plot with correct legend spacing:
[
Combined plot with legend spacing expanded so much that the legend no longer fits in the image:
Related
How can I display two plots in one row with R function ggarrange() so that they have the same dimensions, in particular the same height?
In this example, the second plot is a bit higher than the first plot. I would like to increase the size of a1_plot, so that it matches the size of a2_plot.
# required packages
library(ggplot2)
library(ggbreak)
library(directlabels)
library(ggpubr)
# make dataframe
df1 <- data.frame(first_column=c("value_1","value_2","value_3","value_4","value_4","value_5"),
second_column=c("123","123","325","325","656","656"),
third_column=c(12,13,1,19,200,360),
fourth_column=c(1,124,155,3533,5533,6666))
# plot 1
a1_plot <-
ggplot(df1, aes(x=third_column, y=fourth_column, colour=second_column)) +
scale_x_continuous(breaks = c(0,50,100,150,200,250,300)) +
ylab("Fourth column")+ xlab("Third column") +
scale_x_break(breaks = c(210,400)) +
geom_dl(mapping=aes(x=third_column, y=fourth_column, label=second_column),
method = list(dl.trans(x = x + 0.1), dl.combine("last.points"))) +
theme(legend.position = "none")
# plot 2
a2_plot <-
ggplot(data=df1)+
geom_point(aes(x=second_column, y=fourth_column) +
xlab("X axis")+ ylab("Y axis") +
theme(legend.position = "none")
# merge plot1 and plot2
ggarrange(print(a1_plot), print(a2_plot), labels = c('a1', 'a2'))
I was unable to change the height of plot 1. By adjusting the margins of plot 2, the problem has been solved.
theme(legend.position = "none", plot.margin = unit(x=c(3.6,5,3.9,0), units = "mm"))
For the sake of simplicity, let's assume I have four graphs:
data("midwest", package = "ggplot2")
p1<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p2<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p3<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p4<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
grid.arrange(p1,p2,p3,p4,ncol=2)
Now, I want to create a title (TITLE 1, TITLE 2) between each two titles,, as presented below:
Any ideas how to do it?
Here is a gtable solution to your problem. There might be easier solutions out there, but this should work.
First we'll bake in some titles in the leftmost plots
library(grid) # needed later for plotting
data("midwest", package = "ggplot2")
p1<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point() + ggtitle("Title 1")
p2<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p3<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point() + ggtitle("Title 2")
p4<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
Then we can cbind and rbind the plots together as we see fit.
p12 <- cbind(ggplotGrob(p1), ggplotGrob(p2), size = "first")
p34 <- cbind(ggplotGrob(p3), ggplotGrob(p4), size = "first")
all <- rbind(p12, p34, size = "first")
grid.newpage(); grid.draw(all)
Note that we'd have to work with grid.newpage() and grid.draw() to get our plots, since we've left the ggplot sphere and are now in the realm of gtables and grid. Anyway, resulting plot looks like the following:
From your example I expect that you want these titles to be centered. This will be a bit more finicky:
# Decide what is a title
is_title <- grep("^title$", all$layout$name)
# Grab all titles
titles <- all$grobs[is_title]
# Exclude empty titles
is_title <- is_title[!sapply(titles, inherits, "zeroGrob")]
# Center title
all$grobs[is_title] <- lapply(all$grobs[is_title], function(title) {
title$children[[1]]$hjust <- 0.5
title$children[[1]]$x <- unit(0.5, "npc")
title
})
# Spread title over all panels
# You can see the number you'd need from the l/r coordinates of the 'panel' grobs
# which you can find by printing `all` or `all$layout`.
all$layout[is_title, "r"] <- 14
grid.newpage(); grid.draw(all)
EDIT: added example for adding extra titles
You can add extra titles, but you would need the gtable package for this.
library(gtable)
# First make extra titles
left <- textGrob("Left Title", gp = gpar(fontsize = 13.2, col = "black",
lineheight = 0.9, font = 1))
right <- textGrob("Right Title", gp = gpar(fontsize = 13.2, col = "black",
lineheight = 0.9, font = 1))
# Find a height that was 0, assign new height based on extra title
all$heights[[2]] <- unit(1, "grobheight", left)
# Add the titles (t = top position, l = left position)
all <- gtable_add_grob(all, left, t = 2, l = 5, clip = "off")
all <- gtable_add_grob(all, right, t = 2, l = 14, clip = "off")
grid.newpage(); grid.draw(all)
I am generating some plots with the following code.I have 8 plots generated with the the following code and what I want is to have them on the same page with no titles. More specifically, I want in every plot to have on the left up-corner a letter (a,b..) and at the end of the plot to have something like an one-row legend (e.g Plots: a. category one, b. category two, ...).
Code:
g1= ggplot(som, aes(x=value, y=variable))+geom_smooth(method=lm,alpha=0.25,col='green',lwd=0.1) +ylim(0,1000)+xlim(-2,2)+
geom_point(shape=23,fill="black",size=0.2)+theme_bw()+theme(plot.background = element_blank(),panel.grid.major = element_blank()
,panel.grid.minor = element_blank()) +labs(x="something here",y="something else")+
theme(axis.title.x = element_text(face="bold", size=7),axis.text.x = element_text(size=5))+
theme(axis.title.y = element_text(face="bold", size=7),axis.text.y = element_text(size=5))+
theme(plot.title = element_text(lineheight=.8, face="bold",size=8))
grid.arrange(g1,g2,g3,g4,g5,g6,g7,g8,ncol=2)
Is it possible to do that with ggplot? If so, how can I do this?
p.s I have no problem with the above code
Thank you.
This is how you could do it with library(cowplot).
First some plots:
set.seed(1)
plots <- list()
for (i in 1:8) {
my_cars <- mtcars[sample(1:nrow(mtcars), 10), ]
plots[[i]] <- ggplot(my_cars, aes(mpg, hp, color = as.factor(cyl))) +
geom_point() +
geom_smooth(method = "lm", color = "black")
}
Then to have a unifying title (or legend here) we use a combination of two plot_grid() calls.
lbls <- LETTERS[1:length(plots)]
# add a line break because its long
lbls <- gsub("E", "\nE", lbls)
grid <- plot_grid(plotlist = plots, labels = lbls, ncol = 2)
legend <- ggdraw() +
draw_label(paste0(lbls, "= category",1:length(plots), collapse = " "))
plot_grid(grid, legend, rel_heights = c(1, .1), ncol = 1)
The documentation for cowplot is great and has a ton of examples. Check it out here and here. Let me know if you get stuck.
Here is some example code, which provides a legend with 2 columns. I want to decrease the space between the two colums of the legend (see below).
library(ggplot2)
labels <- c(expression(""^13*CH[4]),
expression(""^13*CH[4]~"+"~SO[4]^{2-''}),
expression(""^13*CH[4]~"+"~MoO[4]^{2-''}))
ggplot(aes(mpg, wt, colour = factor(cyl), shape=factor(cyl)),
data = mtcars) +
geom_point() +
scale_colour_manual(values=c("red", "green", "blue"), label=labels)+
scale_shape_manual(values = c(4,5,6), label=labels)+
theme(legend.position = "bottom",
legend.text.align = 0,
legend.text = element_text(size=8),
legend.key.size = unit(0.8, 'lines')) +
guides(col = guide_legend("", ncol=2), shape=guide_legend("", col=2))
Here is my real life problem:
Additional space is needed on the right side of the plot, because the three factor levels there contain much more characters. However, i am really constrained in the plot size. Hence, I would like to decrease the space between the two rows of the legend.
I also would like to keep the most bottom factor level of the left hand side as is, without adding an extra line.
Based on your example, I simplified it a bit:
Create the problematic plot:
library(ggplot2)
labels <- c("short1", "loooooooooooooooooong", "short2")
plt <- ggplot(aes(mpg, wt, colour = factor(cyl), shape=factor(cyl)),
data = mtcars) +
geom_point() +
scale_colour_manual(values=c("red", "green", "blue"), label=labels)+
scale_shape_manual(values = c(4,5,6), label=labels)+
theme(legend.position = "bottom",
legend.text.align = 0,
legend.text = element_text(size=8),
legend.key.size = unit(0.8, 'lines')) +
guides(col = guide_legend("", ncol=2), shape=guide_legend("", col=2))
plot(plt)
Extract the legend and tweak it
I used this answer to extract the legend from the plot:
#Extract Legend
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 <- g_legend(plt)
And print it:
grid.newpage()
grid.draw(legend)
Then I explored the grobs inside the legend and I found the widths field:
legend$grobs[[1]]$widths
[1] 0.2cm 0cm 0.1524cm 0.4064cm 0.0762cm 3.22791666666667cm 0.0762cm 0.4064cm 0.0762cm
[10] 0.79375cm 0.2cm
>
Apparently those 3.227 cm are too much so I just changed them:
legend$grobs[[1]]$widths[6] <- unit(1.5, "cm")
And plot it:
grid.newpage()
grid.draw(legend)
Apply the fix to the global plot:
The final steps are to replicate that on the ggplot:
Apply that same manual correction to the global plot:
# this is how the legend was extracted:
plt_gtable <- ggplot_gtable(ggplot_build(plt))
leg <- which(sapply(plt_gtable$grobs, function(x) x$name) == "guide-box")
# Replace the legend with our modified legend:
plt_gtable$grobs[[leg]] <- legend
And replot:
grid.newpage()
grid.draw(plt_gtable)
R 3.1.2/ggplot2_1.0.0/Windows7
How can one add 2 vertical lines with legends in a faceted graph without them changing the linetype? In the following example i can't get the legends to appear as I would imagine them to (two solid lines and a adecuate legend) from the code I'm writing. A reproducible example:
library(ggplot2)
library(plyr)
library(e1071)
set.seed(89)
pm <- data.frame(pm10=rnorm(400, 150, 50), estacion=gl(4,100, labels = c('sur', 'norte', 'este', 'oeste'))) # data
curtosis <- ddply(pm, .(estacion), function(val) sprintf("curtosis==%.2f", kurtosis(val$pm10)))
asimetria <- ddply(pm, .(estacion), function(val) sprintf("asimetría==%.2f", skewness(val$pm10)))
p1 <- ggplot(data=pm, aes(x=pm10, y=..density..)) +
geom_histogram(bin=15, fill='#deebf7', colour='#bdbdbd')+
geom_density(size=1, colour='#cccccc')+
geom_vline(data=aggregate(pm[1], pm[2], quantile, .8), mapping=aes(xintercept=pm10, linetype='percentil .8'), size=1, colour='#dfc27d', show_guide = T)+
geom_vline(data=aggregate(pm[1], pm[2], median), mapping=aes(xintercept=pm10, linetype='mediana'), size=1, colour='#80cdc1', show_guide = T)+
geom_text(data=curtosis, aes(x=350, y=.010, label=V1), size=3, parse=T)+
geom_text(data=asimetria, aes(x=350, y=.008, label=V1), size=3, parse=T)+
guides(linetype=guide_legend(override.aes=list(colour = c("#dfc27d","#80cdc1"))))+
xlim(0,500)+
facet_wrap(~ estacion, ncol=2)
print(p1)
I want the lines to be solid (color is ok) and the legend's title to say: "Medida de tendencia".
The main idea for rather compicated ggplots like yours is to separate the data preparation from actual plotting. Within the data preparation step you can organize your data according to the plotting concept you have in mind.
In your case this implies precomputing the statistic in question:
df_vline <- rbind(
aggregate(pm[1], pm[2], quantile, .8),
aggregate(pm[1], pm[2], median)
)
df_vline$stat <- rep(c("percentil .8", "mediana"), each = nrow(df_vline) / 2)
and then the mapping scheme is quite straightforward, so you don't have to think about manual overriding of the legend.
ggplot(data=pm, aes(x=pm10, y=..density..)) +
geom_histogram(bin=15, fill='#deebf7', colour='#bdbdbd')+
geom_density(size=1, colour='#cccccc')+
geom_vline(data=df_vline, mapping=aes(xintercept=pm10, colour = stat),
linetype = 1, size=1, show_guide = T)+
geom_text(data=curtosis, aes(x=350, y=.010, label=V1), size=3, parse=T)+
geom_text(data=asimetria, aes(x=350, y=.008, label=V1), size=3, parse=T)+
scale_colour_manual(values = c("#dfc27d","#80cdc1"), name = "Medida de tendencia")+
xlim(0,500)+
facet_wrap(~ estacion, ncol=2)
(Nice plot, by the way.)