ggplot: graphic issue with multiple graphs in a column - r

I want to set a few graphs in one column. The graph output, also the html knit output, does not extend the view frame of all graphs. In this way, the height of each additionally added graph decreases.
Corresponding code:
p_load(ggplot2)
library(patchwork)
p1 <- ggplot(mpg) +
geom_point(aes(x = displ, y = hwy))
p2 <- ggplot(mpg) +
geom_bar(aes(x = as.character(year), fill = drv), position = "dodge") +
labs(x = "year")
p3 <- ggplot(mpg) +
geom_density(aes(x = hwy, fill = drv), colour = NA) +
facet_grid(rows = vars(drv))
p4 <- ggplot(mpg) +
stat_summary(aes(x = drv, y = hwy, fill = drv), geom = "col", fun.data = mean_se) +
stat_summary(aes(x = drv, y = hwy), geom = "errorbar", fun.data = mean_se, width = 0.5)
p5 <- ggplot(mpg, aes(x = displ, y = hwy)) +
geom_point()
p6 <-ggplot(mpg, aes(displ, hwy, colour = class)) +
geom_point()
p1/ p2 / p3 / p4 / p5 / p6
I used Ggplot Arrange Plots Manual
How I can extend the complete view frame height for each added graph?

If you are talking about html knit output from a .Rmd document, the way to increase the display panel for the plot is to edit the parameter of the block of r code. For example:
> ```{r, fig.height=10, fig.width=6}
> p1/ p2 / p3 / p4 / p5 / p6
> ```

Related

ggplot2 and grid.arrange, place legend below arranged plots

I am facing a problem when I arrange 2 ggplots next to each other using grid.arrange().
I want to place a legend evenly below both plots.
So I have (pseudocode):
p1 <- ggplot(data = df, aes(group = name, color=as.factor(fac), y = ys, x= (xs))) +
geom_point() +
geom_line() +
theme(legend.position="bottom")
p2 <- ggplot(data = df, aes(group = name, color=as.factor(fac), y = ys, x= (xs))) +
geom_point() +
geom_line() +
grid.arrange(p1,p2, ncol=2, widths=c(0.9,1))
Is there any possibility to arrange the legend so that it is positioned evenly below both plots? If I do it as above, the legend is (logically) placed below the first plot.
With package patchwork you could try this...
library(ggplot2)
library(patchwork)
p1 <- ggplot(data = mtcars, aes(group = gear, color=as.factor(am), y = mpg, x = hp)) +
geom_point() +
geom_line()
p2 <- ggplot(data = mtcars, aes(group = gear, color=as.factor(am), y = mpg, x = hp)) +
geom_point() +
geom_line()
p1 + p2 +
plot_layout(guides = "collect") &
theme(legend.position='bottom')
Created on 2022-02-04 by the reprex package (v2.0.1)

Patchwork legend collecting fails

I have been trying to collect legends of plots created in a loop. However, this fails to produce the desired result, as the legends are not collected. I tried
(res[[1]] / res[[2]]) + plot_layout(guides = "collect") + theme(legend.position = "bottom")
where res[[1]] and res[[2]] are list elements created in the loop.
Any advice would be much appreciated.
Resulting plot
Remove + theme(legend.position = "bottom"):
library(ggplot2)
library(patchwork)
p1 <- ggplot(data = mtcars, aes(x = disp, y = cyl, color = as.factor(vs))) +
geom_point()
p2 <- ggplot(data = mtcars, aes(x = disp, y = cyl, color = as.factor(vs))) +
geom_point()
p1 + p2 + plot_layout(guides = "collect")
Or if you'd like to place the legend in the center:
p1 + p2 + plot_layout(guides = "collect") & theme(legend.position = 'bottom')

Merging two y-axes titles in patchwork

Any ideas as to how I can "merge" two identical y-axes titles into one, and then place this y-axis title in the middle between the plot? I have succeded in merging legends by using plot_layout(guides = "collect") but I cannot seem to find anything similar for axes. In this case I would merge the two axes titles called disp_disp_disp into one.
mtcars
library(ggplot2)
library(patchwork)
p1 <- ggplot(mtcars) +
geom_point(aes(mpg, disp)) +
labs(x = "mpg", y = "disp_disp_disp_disp_disp")
p2 <- ggplot(mtcars) +
geom_boxplot(aes(gear, disp, group = gear)) +
labs(x = "gear", y = "disp_disp_disp_disp_disp")
p3 <- ggplot(mtcars) +
geom_point(aes(hp, wt, colour = mpg)) +
ggtitle('Plot 3')
p1 / (p2 | p3)
I guess it would be slightly easier to strip out the y axis title before the plot is built then draw it back on after it is plotted:
library(ggplot2)
library(patchwork)
p1 <- ggplot(mtcars) +
geom_point(aes(mpg, disp)) +
labs(x = "mpg", y = "disp_disp_disp_disp_disp")
p2 <- ggplot(mtcars) +
geom_boxplot(aes(gear, disp, group = gear)) +
labs(x = "gear", y = "disp_disp_disp_disp_disp")
p3 <- ggplot(mtcars) +
geom_point(aes(hp, wt, colour = mpg)) +
ggtitle('Plot 3')
ylab <- p1$labels$y
p1$labels$y <- p2$labels$y <- " "
p1 / (p2 | p3)
grid::grid.draw(grid::textGrob(ylab, x = 0.02, rot = 90))
Another option if you want to avoid getting your hands dirty with grobs altogether is to specify a text-only ggplot and add that as your axis text:
p4 <- ggplot(data.frame(l = p1$labels$y, x = 1, y = 1)) +
geom_text(aes(x, y, label = l), angle = 90) +
theme_void() +
coord_cartesian(clip = "off")
p1$labels$y <- p2$labels$y <- " "
p4 + (p1 / (p2 | p3)) + plot_layout(widths = c(1, 25))
This behaves a bit better on resizing too.
The only way I could think of is to hack this at the gtable level, but I'd also be excited to learn more convenient ways. Here is the gtable method:
library(ggplot2)
library(patchwork)
library(grid)
p1 <- ggplot(mtcars) +
geom_point(aes(mpg, disp)) +
labs(x = "mpg", y = "disp_disp_disp_disp_disp")
p2 <- ggplot(mtcars) +
geom_boxplot(aes(gear, disp, group = gear)) +
labs(x = "gear", y = "disp_disp_disp_disp_disp")
p3 <- ggplot(mtcars) +
geom_point(aes(hp, wt, colour = mpg)) +
ggtitle('Plot 3')
p123 <- p1 / (p2 | p3)
# Convert to gtable
gt <- patchworkGrob(p123)
# Stretching one y-axis title
is_yaxis_title <- which(gt$layout$name == "ylab-l")
# Find new bottom position based on gtable::gtable_show_layout(gt)
gt$layout$b[is_yaxis_title] <- gt$layout$b[is_yaxis_title] + 18
# Deleting other y-axis title in sub-patchwork
is_patchwork <- which(gt$layout$name == "patchwork-table")
pw <- gt$grobs[[is_patchwork]]
pw <- gtable::gtable_filter(pw, "ylab-l", invert = TRUE)
# Set background to transparent
pw$grobs[[which(pw$layout$name == "background")[1]]]$gp$fill <- NA
# Putting sub-patchwork back into main patchwork
gt$grobs[[is_patchwork]] <- pw
# Render
grid.newpage(); grid.draw(gt)
Created on 2020-12-14 by the reprex package (v0.3.0)
Another way to do this with gridExtra.
library(ggplot2)
library(patchwork)
library(gridExtra)
p1 <- ggplot(mtcars) +
geom_point(aes(mpg, disp)) +
labs(x = "mpg") +
theme(axis.title.y = element_blank())
p2 <- ggplot(mtcars) +
geom_boxplot(aes(gear, disp, group = gear)) +
labs(x = "gear") +
theme(axis.title.y = element_blank())
p3 <- ggplot(mtcars) +
geom_point(aes(hp, wt, colour = mpg)) +
ggtitle('Plot 3')
grid.arrange(patchworkGrob(p1 / (p2 | p3)), left = "disp_disp_disp_disp_disp")

Flushing the png device in plot_grid (using cowplot)

Here is my problem:
I do :
plot_grid(first_graph_by_mistake)
plot_grid(second_graph_on_purpuse)
ggsave("graph1.png")
vs ONLY
plot_grid(second_graph_on_purpose)
ggsave("graph2.png")
both the graphs look the same but when I do:
system("diff graph1.png graph2.png") it shows a difference.
Perhaps the png device is not flushed and some settings are different and that is why diff is showing a difference. How can I make the 2 graphs exactly the same ? That is my MAIN query.
I did the above in a very long piece of code. When I try to make a reprex example the diff does not show any difference between the 2 graphs. I am UNABLE to reproduce what I refer to in my query.
Here is the reprex:
library(cowplot)
library(grid)
plot.mpg.1 <- ggplot(mpg, aes(x = cty, y = hwy, colour = factor(cyl))) + geom_point(size=2.5)
plot.mpg.2 <- ggplot(mpg, aes(x = cty, y = displ, colour = factor(cyl))) + geom_point(size = 2.5)
plot.mpg.3 <- ggplot(mpg, aes(x = hwy, y = displ, colour = factor(cyl))) + geom_point(size = 2.5)
plot.mpg.4 <- ggplot(mpg, aes(x = drv, y = displ, colour = factor(cyl))) + geom_point(size = 2.5)
mygraphs <- list(plot.mpg.1,plot.mpg.2,plot.mpg.3,plot.mpg.4)
dummygraph <- mygraphs[[1]]
legend = get_legend(dummygraph + theme(legend.position = "bottom",legend.justification="center") + guides(fill = guide_legend(nrow = 1 )))
toplotlist <- lapply(mygraphs,function(x){x + theme(plot.margin = unit(c(0, 0, 0,0), "in"),legend.position="none")})
pmatrix <- do.call("plot_grid",toplotlist)
p<-plot_grid(pmatrix,legend,nrow=2,rel_heights = c(8,.2),rel_widths = c(10,1))
# Note : Please run first, the first section. Then run the second section.
######################################################################################################
# Without this line
# plot_grid(pmatrix,legend,nrow=2,rel_heights = c(64,1))
title <- ggdraw() + draw_label("My title", fontface='bold',size = 20)
semifinal <- plot_grid(title, p, ncol=1, rel_heights=c(0.1, 1))
blank <- grid.rect(gp=gpar(col="white"))
plot_grid(semifinal,blank,ncol=1,rel_heights=c(15,1))
ggsave(paste0("without_line.png"),height = 10,width = 10,dpi = 600)
########################################################################### ############################
# With this line
plot_grid(pmatrix,legend,nrow=2,rel_heights = c(64,1))
title <- ggdraw() + draw_label("My title", fontface='bold',size = 20)
semifinal <- plot_grid(title, p, ncol=1, rel_heights=c(0.1, 1))
blank <- grid.rect(gp=gpar(col="white"))
plot_grid(semifinal,blank,ncol=1,rel_heights=c(15,1))
ggsave(paste0("with_line.png"),height = 10,width = 10,dpi = 600)
###################################################################################################
# Now do
system("diff without_line.png with_line.png")

Combined bar plot and points in ggplot2

I would like to plot a "combined" bar plot with points.
Consider to following dummy data:
library(ggplot2)
library(gridExtra)
library(dplyr)
se <- function(x){sd(x)/sqrt(length(x))}
p1 <- ggplot(mtcars, aes(y=disp, x=cyl, fill=cyl))
p1 <- p1 + geom_point() + theme_classic() + ylim(c(0,500))
my_dat <- summarise(group_by(mtcars, cyl), my_mean=mean(disp),my_se=se(disp))
p2 <- ggplot(my_dat, aes(y=my_mean,x=cyl,ymin=my_mean-my_se,ymax=my_mean+my_se))
p2 <- p2 + geom_bar(stat="identity",width=0.75) + geom_errorbar(stat="identity",width=0.75) + theme_classic() + ylim(c(0,500))
The final plot should look like that:
You can add layers together, but if they have different data and/or aesthetics you'll want to include the data and aes arguments in each graphical layer.
p3 <- ggplot() +
geom_bar(data=my_dat, aes(y=my_mean,x=cyl,ymin=my_mean-my_se,ymax=my_mean+my_se), stat="identity", width = 0.75) +
geom_errorbar(data=my_dat, aes(y=my_mean,x=cyl,ymin=my_mean-my_se,ymax=my_mean+my_se), width = 0.75) +
geom_point(data=mtcars, aes(y=disp, x=cyl, fill=cyl)) +
ylim(c(0,500)) +
theme_classic()
If you want to make it so that the the points are off to the side of the bars, you could subtract an offset from the cyl values to move over the points. Like #LukeA mentioned, by changing the geom_point to geom_point(data=mtcars, aes(y=disp, x=cyl-.5, fill=cyl)).
You can specify each layer individually to ggplot2. Often you are using the same data frame and options for each geom, so it makes sense to set defaults in ggplot(). In your case you should specify each geom separately:
library(ggplot2)
library(gridExtra)
library(dplyr)
se <- function(x){sd(x)/sqrt(length(x))}
my_dat <- summarise(group_by(mtcars, cyl),
my_mean = mean(disp),
my_se = se(disp))
p1 <- ggplot() +
geom_bar(data = my_dat,
aes(y = my_mean, x = cyl,
ymin = my_mean - my_se,
ymax = my_mean + my_se), stat="identity", width=0.75) +
geom_errorbar(data = my_dat,
aes(y = my_mean, x = cyl,
ymin = my_mean - my_se,
ymax = my_mean + my_se), stat="identity", width=0.75) +
geom_point(data = mtcars, aes(y = disp, x = cyl, fill = cyl)) +
theme_classic() + ylim(c(0,500))
p1

Resources