Add empty plots to facet, and combine with another facet - r

Using this SO solution I created a facet with two "empty" plots, with the aim of combining with another group of facet_wrap plots, as shown below. The purpose is to have two y-axis labels for different unit measurements. How can I make the grid layout look like the top image, which produces the arrangement I want, but not the axis labels? This was accomplished with plot_grid with individual plots. My current output does not scale correctly and overlaps the other plots, as seen in the second image, but provides the axis labels.
I have example data below, just copy and run the code to input it.
library(ggplot2)
library(grid)
library(cowplot)
clipboard <- readClipboard()
test.data <- read.table(file = "clipboard", sep = ",", header=TRUE)
test.data1 <- test.data[1:24, ]
test.data2 <- test.data[25:32, ]
testplot1 <- ggplot(test.data1, aes(Station, value)) +
geom_point() +
labs(x = "Stations", y = "Scale A") +
theme(legend.position = "none", legend.title = element_blank()) +
facet_wrap( ~ constituent, ncol = 3, scales = "free_y")
testplot2 <- ggplot(test.data2, aes(Station, value)) +
geom_point() +
labs(x = "Stations", y = "Scale B") +
theme(legend.position = "none", legend.title = element_blank(), axis.title.y = element_text(hjust = 0.2)) +
facet_wrap( ~ constituent, ncol = 1, scales = "free_y")
blankplots <- ggplotGrob(testplot2)
rm_grobs <- blankplots$layout$name %in% c("panel-1-1", "panel-2-1", "strip-t-1-1", "strip-t-1-2")
blankplots$grobs[rm_grobs] <- NULL
blankplots$layout <- blankplots$layout[!rm_grobs, ]
grid.newpage()
emptygrids <- grid.draw(blankplots)
plot_grid(emptygrids, MPLOOplot1)
Example date is below:
Station,constituent,value
A1,A,1
B1,A,1
A1,B,2
B1,B,2
A1,C,3
B1,C,3
A1,D,4
B1,D,4
A1,E,5
B1,E,5
A1,F,6
B1,F,6
A1,G,7
B1,G,7
A1,H,8
B1,H,8
A1,I,9
B1,I,9
A1,J,10
B1,J,10
A1,K,11
B1,K,11
A1,L,1.4
B1,L,1.4
A1,Blank1,NA
B1,Blank1,NA
A1,Blank2,NA
B1,Blank2,NA
A1,XX,0.52
B1,XX,0.52
A1,YY,0.355
B1,YY,0.355

I'm not sure I understand exactly what you're trying to do, so let me know if this is what you had in mind. I wasn't sure what you wanted colour to be mapped to, so I just used constituent for this example.
library(gridExtra)
library(ggplot2)
library(dplyr)
library(cowplot)
theme_set(theme_classic())
testplot1 <- ggplot(test.data1, aes(Station, value, colour=constituent)) +
geom_point() +
labs(x = "Stations", y = "Scale A") +
theme(legend.title = element_blank()) +
facet_wrap( ~ constituent, ncol = 3, scales = "free_y") +
guides(colour=guide_legend(ncol=2))
testplot2 <- ggplot(test.data2 %>% filter(!grepl("Blank", constituent)),
aes(Station, value, colour=constituent)) +
geom_point() +
labs(x = "Stations", y = "Scale B") +
theme(legend.title = element_blank(),
axis.title.y = element_text(hjust = 0.2)) +
facet_wrap( ~ constituent, ncol = 1, scales = "free_y")
leg1 = get_legend(testplot1)
leg2 = get_legend(testplot2)
testplot1 = testplot1 + guides(colour=FALSE)
testplot2 = testplot2 + guides(colour=FALSE)
Now we lay out the plots and legends with grid.arrange. This requires some manual tweaking of the heights and widths.
grid.arrange(
arrangeGrob(
arrangeGrob(nullGrob(), leg2, leg1, nullGrob(), ncol=4, widths=c(1,4,4,1)),
testplot2, ncol=1, heights=c(4.2,5)
),
testplot1, ncol=2, widths=c(1.1,3))

Related

Get all the legends on the top of the plot

I have a multiple plot within a plot, generated by ggpubr::ggarrange(). However the legends only appears for the first plot i.e., A and B. I wanted to get the legends for rest of the colours, C, D, E on the top. Setting common.legend = TRUE only gives the first two legends.
Thanks for the help!
library(ggpubr)
arranged_plot <- ggarrange(
plot_list[[1]] + rremove("ylab") + rremove("xlab") + rremove("x.text"),
plot_list[[2]] + rremove("ylab") + rremove("xlab") + rremove("axis.text"),
plot_list[[3]] + rremove("ylab") + rremove("xlab"),
plot_list[[4]] + rremove("ylab") + rremove("xlab") + rremove("y.text"),
labels = NULL, ncol = 2, nrow = 2,align = "hv",
font.label = list(size = 10, color = "black", face = "bold", family = NULL, position = "top"),
common.legend=TRUE)
I'm not sure how to do this with ggarrange, but if you're willing to look at other methods, here are two options:
Using patchwork (and collecting legends).
# sample data where each elem has cyl=4 and another cyl
mtcars$cyl <- factor(mtcars$cyl)
mtdat1 <- lapply(c(6, 8), function(CY) {
subset(mtcars, cyl %in% c(4, CY)) |>
transform(CY = CY)
})
plot_list <- lapply(mtdat1, function(dat) {
ggplot(dat, aes(mpg, disp, color = cyl)) +
geom_point() +
scale_color_manual(values = setNames(c("gray", "red", "blue"), c(4, 6, 8)), drop = FALSE)
})
library(patchwork)
plot_list[[1]] + plot_list[[2]] +
plot_layout(nrow = 1, guides = "collect") &
theme(legend.position = "top")
Facets.
# sample data, starting with `mtdat1` from above
mtdat2 <- do.call(rbind, args = mtdat1)
ggplot(mtdat2, aes(mpg, disp, color = cyl)) +
facet_wrap(~ CY) +
geom_point() +
scale_color_manual(values = setNames(c("gray", "red", "blue"), c(4, 6, 8)), drop = FALSE) +
theme(legend.position = "top")
If you prefer to not have the facet strips, we can remove those in a theme:
ggplot(mtdat2, aes(mpg, disp, color = cyl)) +
facet_wrap(~ CY) +
geom_point() +
scale_color_manual(values = setNames(c("gray", "red", "blue"), c(4, 6, 8)), drop = FALSE) +
theme(legend.position = "top", strip.text.x = element_blank())
I think there are two advantages to facets:
Simpler code, more efficient, allowing ggplot to handle everything in one step.
Since we don't explicitly free the scales (e.g., not doing scales="free"), the axes are all on the same scale, no need to explicitly control them. For comparisons as in your graph, this can be a big difference in visualizing the differences between levels. (Compare this plot with the first plot using patchwork, though those axis limits can easily be fixed as well.)

Alignment of y axis labels in faced_grid and ggplot?

By using ggplot and faced_grid functions I'm trying to make a heatmap. I have a categorical y axis, and I want y axis labels to be left aligned. When I use theme(axis.text.y.left = element_text(hjust = 0)), each panels' labels are aligned independently. Here is the code:
#data
set.seed(1)
gruplar <- NA
for(i in 1:20) gruplar[i] <- paste(LETTERS[sample(c(1:20),sample(c(1:20),1),replace = T) ],
sep="",collapse = "")
gruplar <- cbind(gruplar,anagruplar=rep(1:4,each=5))
tarih <- data.frame(yil= rep(2014:2019,each=12) ,ay =rep_len(1:12, length.out = 72))
gruplar <- gruplar[rep(1:nrow(gruplar),each=nrow(tarih)),]
tarih <- tarih[rep_len(1:nrow(tarih),length.out = nrow(gruplar)),]
grouped <- cbind(tarih,gruplar)
grouped$value <- rnorm(nrow(grouped))
#plot
p <- ggplot(grouped,aes(ay,gruplar,fill=value))
p <- p + facet_grid(anagruplar~yil,scales = "free",
space = "free",switch = "y")
p <- p + theme_minimal(base_size = 14) +labs(x="",y="") +
theme(strip.placement = "outside",
strip.text.y = element_text(angle = 90))
p <- p + geom_raster(aes(fill = value), na.rm = T)
p + theme(axis.text.y.left = element_text(hjust = 0, size=14))
I know that by putting spaces and using a mono-space font I can solve the problem, but I have to use the font 'Calibri Light'.
Digging into grobs isn't my favourite hack, but it can serve its purpose here:
# generate plot
# (I used a smaller base_size because my computer screen is small)
p <- ggplot(grouped,aes(ay,gruplar,fill=value)) +
geom_raster(aes(fill = value),na.rm = T) +
facet_grid(anagruplar~yil,scales = "free",space = "free",switch = "y") +
labs(x="", y="") +
theme_minimal(base_size = 10) +
theme(strip.placement = "outside",
strip.text.y = element_text(angle = 90),
axis.text.y.left = element_text(hjust = 0, size=10))
# examine ggplot object: alignment is off
p
# convert to grob object: alignment is unchanged (i.e. still off)
gp <- ggplotGrob(p)
dev.off(); grid::grid.draw(gp)
# change viewport parameters for left axis grobs
for(i in which(grepl("axis-l", gp$layout$name))){
gp$grobs[[i]]$vp$x <- unit(0, "npc") # originally 1npc
gp$grobs[[i]]$vp$valid.just <- c(0, 0.5) # originally c(1, 0.5)
}
# re-examine grob object: alignment has been corrected
dev.off(); grid::grid.draw(gp)
I guess one option is to draw the labels on the right-hand side, and move that column in the gtable,
p <-ggplot(grouped,aes(ay,gruplar,fill=value)) +
facet_grid(anagruplar~yil,scales = "free",space = "free",switch = "y") +
geom_raster(aes(fill = value),na.rm = T) +
theme_minimal(base_size = 12) + labs(x="",y="") +
scale_y_discrete(position='right') +
theme(strip.placement = "outside", strip.text.y = element_text(angle = 90))+
theme(axis.text.y.left = element_text(hjust = 0,size=14))
g <- ggplotGrob(p)
id1 <- unique(g$layout[grepl("axis-l", g$layout$name),"l"])
id2 <- unique(g$layout[grepl("axis-r", g$layout$name),"l"])
g2 <- gridExtra::gtable_cbind(g[,seq(1,id1-1)],g[,id2], g[,seq(id1+1, id2-1)], g[,seq(id2+1, ncol(g))])
library(grid)
grid.newpage()
grid.draw(g2)
This seems like a bug in ggplot2, or at least what I consider an undesirable / unexpected behavior. You may have seen the approach suggested here, which uses string padding on a mono-space font to achieve the alignment.
This is pretty hacky, but if you need to achieve alignment using a particular font, you might replace the axis labels altogether with geom_text. I have a mostly-working solution, but it is ugly, in that each step seems to break something else!
library(ggplot2); library(dplyr)
# To add a blank facet before 2014, I convert to character
grouped$yil = as.character(grouped$yil)
# I add some rows for the dummy facet, in year "", to use for labels
grouped <- grouped %>%
bind_rows(grouped %>%
group_by(gruplar) %>%
slice(1) %>%
mutate(yil = "",
value = NA_real_) %>%
ungroup())
p <- ggplot(grouped,
aes(ay,gruplar,fill=value)) +
geom_raster(aes(fill = value),na.rm = T) +
scale_x_continuous(breaks = 4*0:3) +
facet_grid(anagruplar~yil,
scales = "free",space = "free",switch = "y") +
theme_minimal(base_size = 14) +
labs(x="",y="") +
theme(strip.placement = "outside",
strip.text.y = element_text(angle = 90),
axis.text.y.left = element_blank(),
panel.grid = element_blank()) +
geom_text(data = grouped %>%
filter(yil == ""),
aes(x = -40, y = gruplar, label = gruplar), hjust = 0) +
scale_fill_continuous(na.value = "white")
p
(The last problem with this plot that I can see is that it shows an orphaned "0" on the x axis of the dummy facet. Need another hack to get rid of that!)

How to position strip labels in facet_wrap like in facet_grid

I would like to remove the redundancy of strip labels when using facet_wrap() and faceting with two variables and both scales free.
For example, this facet_wrap version of the following graph
library(ggplot2)
dt <- txhousing[txhousing$year %in% 2000:2002 & txhousing$month %in% 1:3,]
ggplot(dt, aes(median, sales)) +
geom_point() +
facet_wrap(c("year", "month"),
labeller = "label_both",
scales = "free")
should have the looks of this facet_grid version of it, where the strip labels are at the top and right edge of the graph (could be bottom and left edge as well).
ggplot(dt, aes(median, sales)) +
geom_point() +
facet_grid(c("year", "month"),
labeller = "label_both",
scales = "free")
Unfortunately, using facet_grid is not an option because, as far as I understand, it doesn't allow scales to be "completely free" - see here or here
One attempt that I thought about would be to produce separate plots and then combine them:
library(cowplot)
theme_set(theme_gray())
p1 <- ggplot(dt[dt$year == 2000,], aes(median, sales)) +
geom_point() +
facet_wrap("month", scales = "free") +
labs(y = "2000") +
theme(axis.title.x = element_blank())
p2 <- ggplot(dt[dt$year == 2001,], aes(median, sales)) +
geom_point() +
facet_wrap("month", scales = "free") +
labs(y = "2001") +
theme(strip.background = element_blank(),
strip.text.x = element_blank(),
axis.title.x = element_blank())
p3 <- ggplot(dt[dt$year == 2002,], aes(median, sales)) +
geom_point() +
facet_wrap("month", scales = "free") +
labs(y = "2002") +
theme(strip.background = element_blank(),
strip.text.x = element_blank())
plot_grid(p1, p2, p3, nrow = 3)
I am ok with the above hackish attempt, but I wonder if there is something in facet_wrap that could allow the desired output. I feel that I miss something obvious about it and maybe my search for an answer didn't include the proper key words (I have the feeling that this question was addressed before).
This does not seem easy, but one way is to use grid graphics to insert panel strips from a facet_grid plot into one created as a facet_wrap. Something like this:
First lets create two plots using facet_grid and facet_wrap.
dt <- txhousing[txhousing$year %in% 2000:2002 & txhousing$month %in% 1:3,]
g1 = ggplot(dt, aes(median, sales)) +
geom_point() +
facet_wrap(c("year", "month"), scales = "free") +
theme(strip.background = element_blank(),
strip.text = element_blank())
g2 = ggplot(dt, aes(median, sales)) +
geom_point() +
facet_grid(c("year", "month"), scales = "free")
Now we can fairly easily replace the top facet strips of g1 with those from g2
library(grid)
library(gtable)
gt1 = ggplot_gtable(ggplot_build(g1))
gt2 = ggplot_gtable(ggplot_build(g2))
gt1$grobs[grep('strip-t.+1$', gt1$layout$name)] = gt2$grobs[grep('strip-t', gt2$layout$name)]
grid.draw(gt1)
Adding the right hand panel strips need us to first add a new column in the grid layout, then paste the relevant strip grobs into it:
gt.side1 = gtable_filter(gt2, 'strip-r-1')
gt.side2 = gtable_filter(gt2, 'strip-r-2')
gt.side3 = gtable_filter(gt2, 'strip-r-3')
gt1 = gtable_add_cols(gt1, widths=gt.side1$widths[1], pos = -1)
gt1 = gtable_add_grob(gt1, zeroGrob(), t = 1, l = ncol(gt1), b=nrow(gt1))
panel_id <- gt1$layout[grep('panel-.+1$', gt1$layout$name),]
gt1 = gtable_add_grob(gt1, gt.side1, t = panel_id$t[1], l = ncol(gt1))
gt1 = gtable_add_grob(gt1, gt.side2, t = panel_id$t[2], l = ncol(gt1))
gt1 = gtable_add_grob(gt1, gt.side3, t = panel_id$t[3], l = ncol(gt1))
grid.newpage()
grid.draw(gt1)
I am not sure you can do this by just using facet_wrap, so probably your attempt is the way to go. But IMO it needs an improvement. Presently, you are missing actual y-lab (sales) and it kinda misguides what is plotted in y- axis
You could improve what you are doing by adding another plot title row by using gtable and grid.
p1 <- ggplot(dt[dt$year == 2000,], aes(median, sales)) +
geom_point() +
facet_wrap("month", scales = "free") +
theme(axis.title.x = element_blank())
p2 <- ggplot(dt[dt$year == 2001,], aes(median, sales)) +
geom_point() +
facet_wrap("month", scales = "free") +
theme(axis.title.x = element_blank())
p3 <- ggplot(dt[dt$year == 2002,], aes(median, sales)) +
geom_point() +
facet_wrap("month", scales = "free")
Note that the labs are removed from the above plots.
if ( !require(grid) ) { install.packages("grid"); library(grid) }
if ( !require(gtable ) ) { install.packages("gtable"); library(gtable) }
z1 <- ggplotGrob(p1) # Generate a ggplot2 plot grob
z1 <- gtable_add_rows(z1, unit(0.6, 'cm'), 2) # add new rows in specified position
z1 <- gtable_add_grob(z1,
list(rectGrob(gp = gpar(col = NA, fill = gray(0.7))),
textGrob("2000", gp = gpar(col = "black",cex=0.9))),
t=2, l=4, b=3, r=13, name = paste(runif(2))) #add grobs into the table
Note that in step 3, getting the exact values for t (top extent), l(left extent), b (bottom extent) and r(right extent) might need trial and error method
Now repeat the above steps for p2 and p3
z2 <- ggplotGrob(p2)
z2 <- gtable_add_rows(z2, unit(0.6, 'cm'), 2)
z2 <- gtable_add_grob(z2,
list(rectGrob(gp = gpar(col = NA, fill = gray(0.7))),
textGrob("2001", gp = gpar(col = "black",cex=0.9))),
t=2, l=4, b=3, r=13, name = paste(runif(2)))
z3 <- ggplotGrob(p3)
z3 <- gtable_add_rows(z3, unit(0.6, 'cm'), 2)
z3 <- gtable_add_grob(z3,
list(rectGrob(gp = gpar(col = NA, fill = gray(0.7))),
textGrob("2002", gp = gpar(col = "black",cex=0.9))),
t=2, l=4, b=3, r=13, name = paste(runif(2)))
finally, plotting
plot_grid(z1, z2, z3, nrow = 3)
You can also have the years indicated in the column like in facet_grid instead of row. In that case, you have to add a column by using gtable_add_cols. But make sure to (a) add the column at the correct position in step-2, and (b) get the correct values for t, l, b and r in step-3.
You can achieve that using facet_grid2 function of ggh4x package like
library(ggplot2)
library(ggh4x)
dt <- txhousing[txhousing$year %in% 2000:2002 & txhousing$month %in% 1:3,]
ggplot(dt, aes(median, sales)) +
geom_point() +
facet_grid2(c("year", "month"),
labeller = "label_both",
scales = "free", independent = "all")

Mix ggplot graphs in multiple pages in pdf

Im trying to combine this graph i made in ggplot [![enter image description here][1]][1]
with a few more graphs (an example shown below) in a single PDF file. But the 1st graph is on one page, the next graph 2 is in page 2, graph 3 in page 3 and so on.
[![enter image description here][2]][2]
My problem is that i cant seem to combine the graphs in 1 pdf file as i keep getting an error where I cant open the PDF file.
Ive tried to modify the code ive seen here:
Printing multiple ggplots into a single pdf, multiple plots per page
but it cant seem to work
(this part is for the 4 graphs in 1 page)
pdf("plots.pdf", onefile = TRUE)
plot1 <- ggplot(data = FBMKLCI.df) +
theme_minimal() +
geom_line(aes(x = Date, y = PX_LAST., color =
PE)) +
scale_color_continuous(low = 'green', high='red') +
labs(y="", colour = "PE") +
theme(legend.position = 'bottom',
plot.title = element_text(colour = 'blue', face = 'bold'),
legend.key.width = unit(1, "cm")) +
ggtitle('FBMKLCI')
plot2<- ggplot(data = FBM70.df) +
theme_minimal() +
geom_line(aes(x = Date, y = PX_LAST., color =
PE)) +
scale_color_continuous(low = 'green', high='red') +
labs(y="",colour = "PE")+
theme(legend.position = 'bottom',
plot.title = element_text(colour = 'blue', face = 'bold'),
legend.key.width = unit(1, "cm")) +
ggtitle('FBM70')
plot3 <- ggplot(....
plot4<-...
grid.arrange(plot1, plot2, plot3, plot4, ncol=2)
(this part is for the graphs in the next pages)
p <- list()
for(i in 1:3) {
p[[i]] <- list()
p[[i]][[1]] <- ggplot(data = plot1) +
theme_minimal() +
facet_wrap(~Sector, nrow = 5, scales="free_y") +
geom_line(aes(x = Date, y = BEST_EPS.BEST_FPERIOD_OVERRIDE.1GY, color =
Sector)) +
theme(legend.position="none")
p[[i]][[2]] <- ggplot(data = plot2) +
theme_minimal() +
facet_wrap(~Sector, nrow = 5, scales="free_y") +
geom_line(aes(x = Date, y = eps.rev3mo, color = Sector)) +
theme(legend.position="none")
p[[i]][[3]] <- ggplot(data = plot3) +
theme_minimal() +
facet_wrap(~Sector, nrow = 5, scales="free_y") +
geom_line(aes(x = Date, y = eps.rev3mo, color = Sector)) +
theme(legend.position="none")
}
print(p)
dev.off()
I apologise in advance as this is my first time using ggplot2. Really appreciate and thanks in advance for the help.
Maybe this helps,
library(ggplot2)
library(gridExtra)
page1 <- replicate(4, ggplot(), simplify = FALSE)
other <- replicate(3, replicate(6, ggplot(), simplify = FALSE), simplify = FALSE)
pdf("multipage.pdf", width=6, height = 4)
grid.arrange(grobs = page1, ncol=2)
print(marrangeGrob(grobs = unlist(other, recursive = FALSE), ncol=3,nrow=2))
dev.off()

Specify plot height in plot_grid with 'hv' aligment: cowplot

I have been using the plot_grid command from cowplot to arrange my plots. I use the labeling feature, and my plots all look the same in that regard. However, when I 'hv' align some plots that have very different y-axis limits, such as the one below, it appears the height of the plot with shortest range of y is used.
If I just 'v' align the plot it looks better in some respects, but it is hard to resize the plot and have the labels looking good. I'd prefer the plot height not consider the x-axis labels, etc, like above.
Using gtables, I can get the desired width/height (below), but these leaves me without the consistent labels across all the figures in a document. Can I use the 'hv' alignment with cowplot and specify which plot height to use?
library(ggplot2)
library(dplyr)
library(scales)
library(grid)
library(cowplot)
data(iris)
iris <- iris %>% mutate(Petal.Width2 = ifelse(Species == "setosa", Petal.Width * 75, Petal.Width))
p1 <- ggplot(data=iris, aes(x = factor(Species), y=Sepal.Width)) +
geom_bar(stat="identity") +
labs(x = NULL, y = "Plot One") +
scale_y_continuous(labels = percent) +
theme(axis.text.x = element_blank(),
axis.title.y = element_text(vjust=1), plot.margin=unit(c(2,2,0,2),"mm"))
p2 <- ggplot(data=iris, aes(x = factor(Species), y=Petal.Width2)) + geom_bar(stat="identity") +
labs(x = NULL, y = "Plot Two") +
scale_y_continuous(labels = percent) +
theme(axis.text.x = element_blank(),
axis.title.y = element_text(vjust=1), plot.margin=unit(c(0,2,0,2),"mm"))
p3 <- ggplot(data=iris, aes(x = factor(Species), y=Petal.Length*0+.01)) + geom_bar(stat="identity") +
labs(x = "SPECIES", y = "The Third plot") +
scale_y_continuous(labels = percent) +
theme( axis.title.y = element_text(vjust=1, color="blue"), plot.margin=unit(c(0,2,0,2),"mm"),
axis.text.x = element_text(angle = 90, hjust=1, vjust=1,face ="italic", size=10))
plot_grid(p1,p2,p3,ncol=1, align="v", labels=c("A", "B", "C"))
# https://stackoverflow.com/a/27408589/1670053
plots <- list(p1, p2, p3)
grobs = lapply(plots, ggplotGrob)
g = do.call(rbind, c(grobs, size="first"))
g$widths = do.call(unit.pmax, lapply(grobs, "[[", "widths"))
grid.newpage()
grid.draw(g)
it's easy as to add labels,
plots <- list(p1, p2, p3)
grobs = lapply(plots, ggplotGrob)
library(gridExtra)
g = do.call(rbind, grobs) # uses gridExtra::rbind.gtable
panels <- g$layout[g$layout$name=="panel",]
g <- gtable::gtable_add_grob(g, lapply(LETTERS[1:nrow(panels)],
textGrob, vjust=1, y=1,
gp=gpar(fontface=2)),
t=panels$t, l=2)
grid.newpage()
grid.draw(g)

Resources