I just wanted to plot multiple facets using ggplot2 in combination with for loop and found the solution in this postggplot2-plots-over-multiple-pages.
However, I want to modify appearances of these facets with ggplotGrop for reducing the strip size of facets after this for loop.
I am providing here reproducible example of previous question for only plotting facets
library(ggplot2)
library(vcd) # For the Baseball data
data(Baseball)
pdf("baseball.pdf", 7, 5)
aa<- for (i in seq(1, length(unique(Baseball$team87)), 6)) {
print(ggplot(Baseball[Baseball$team87 %in% levels(Baseball$team87)[i:(i+5)], ],
aes(hits86, sal87)) +
geom_point() +
facet_wrap(~ team87) +
scale_y_continuous(limits=c(0, max(Baseball$sal87, na.rm=TRUE))) +
scale_x_continuous(limits=c(0, max(Baseball$hits86))) +
theme_bw())
}
dev.off()
want to implement ggplotGrob to reduce the strip size.
library(gridExtra)
library(grid)
g = ggplotGrob(aa)
pos = c(unique(subset(g$layout, grepl("panel", g$layout$name), select = t)))
for(i in pos) g$heights[i-1] = unit(0.4,"cm")
grobs = which(grepl("strip", g$layout$name))
for(i in grobs) g$grobs[[i]]$heights <- unit(1, "npc")
grid.draw(g)
dev.off()
Error in plot_clone(plot) : attempt to apply non-function
I just wonder how to implement ggplotGrop to that for loop.
The main probleme is that you're using ggplotGrob on an the wrong object.
You have to use it inside each loop.
Then you must grid.arrange to make the multipage pdf
First method: with a trick as ggplotGrob create a blank page
pdf("baseball.pdf", 7, 5)
for (i in seq(1, length(unique(Baseball$team87)), 6)) {
temp <- ggplot(Baseball[Baseball$team87 %in% levels(Baseball$team87)[i:(i+5)], ],
aes(hits86, sal87)) +
geom_point(na.rm=TRUE) + ## to avoid warnings
facet_wrap(~ team87) +
scale_y_continuous(limits=c(0, max(Baseball$sal87, na.rm=TRUE))) +
scale_x_continuous(limits=c(0, max(Baseball$hits86))) +
theme_bw()
pdf(file=NULL) ## because ggplotGrob will create a blank page
g <- ggplotGrob(temp)
pos = c(unique(subset(g$layout, grepl("panel", g$layout$name), select = t)))
for(i in pos) g$heights[i-1] = unit(0.4,"cm")
grobs = which(grepl("strip", g$layout$name))
for(i in grobs) g$grobs[[i]]$heights <- unit(1, "npc")
dev.off() ## to close the fake device
grid.arrange(g)
}
dev.off()
Second method: to avoid using fake device
plotlist <- list()
j <- 1
for (i in seq(1, length(unique(Baseball$team87)), 6)) {
temp <- ggplot(Baseball[Baseball$team87 %in% levels(Baseball$team87)[i:(i+5)], ],
aes(hits86, sal87)) +
geom_point(na.rm=TRUE) +
facet_wrap(~ team87) +
scale_y_continuous(limits=c(0, max(Baseball$sal87, na.rm=TRUE))) +
scale_x_continuous(limits=c(0, max(Baseball$hits86))) +
theme_bw()
g <- ggplotGrob(temp)
pos = c(unique(subset(g$layout, grepl("panel", g$layout$name), select = t)))
for(i in pos) g$heights[i-1] = unit(0.4,"cm")
grobs = which(grepl("strip", g$layout$name))
for(i in grobs) g$grobs[[i]]$heights <- unit(1, "npc")
plotlist[[j]] <- g
j <- j+1
}
pdf("baseball.pdf", 7, 5)
for (i in (1:length(plotlist))) {
grid.arrange(plotlist[[i]])
}
dev.off()
Actually, you can even use grid.arrange and ggplotGrob, without using facet to make all more customisable.
Related
I have the same problem as this user - I have a 'jagged' faceted plot, in which the bottom row has fewer panels than the other rows, and I would like to have x-axis ticks on the bottom of each column.
The suggested solution for that problem was to set scales="free_x". (In ggplot 0.9.2.1; I believe the behavior I'm looking for was default in earlier versions.) That's a poor solution in my case: my actual axis labels will be rather long, so putting them under each row will occupy too much room. The results are something like this:
x <- gl(3, 1, 15, labels=paste("this is a very long axis label ", letters[1:5]))
y <- rnorm(length(x))
l <- gl(5, 3, 15)
d <- data.frame(x=x, y=y, l=l)
ggplot(d, aes(x=x, y=y)) + geom_point() + facet_wrap(~l, scales="free_x") +
theme(axis.text.x=element_text(angle=90, hjust=1))
In a comment here, Andrie suggests that it can be done manually in grid but I have no idea how to get started on that.
If I remember right, there were questions on both how to add all labels to the same line under the last column and how to lift these last labels up to the next row. So here is the function for both cases:
Edit: since this is like a substitute for print.ggplot (see getAnywhere(print.ggplot)) I have added some lines from it to preserve functionality.
Edit 2: I have improved it a bit more: no need to specify nrow and ncol anymore, plots with all the panels can be printed too.
library(grid)
# pos - where to add new labels
# newpage, vp - see ?print.ggplot
facetAdjust <- function(x, pos = c("up", "down"),
newpage = is.null(vp), vp = NULL)
{
# part of print.ggplot
ggplot2:::set_last_plot(x)
if(newpage)
grid.newpage()
pos <- match.arg(pos)
p <- ggplot_build(x)
gtable <- ggplot_gtable(p)
# finding dimensions
dims <- apply(p$panel$layout[2:3], 2, max)
nrow <- dims[1]
ncol <- dims[2]
# number of panels in the plot
panels <- sum(grepl("panel", names(gtable$grobs)))
space <- ncol * nrow
# missing panels
n <- space - panels
# checking whether modifications are needed
if(panels != space){
# indices of panels to fix
idx <- (space - ncol - n + 1):(space - ncol)
# copying x-axis of the last existing panel to the chosen panels
# in the row above
gtable$grobs[paste0("axis_b",idx)] <- list(gtable$grobs[[paste0("axis_b",panels)]])
if(pos == "down"){
# if pos == down then shifting labels down to the same level as
# the x-axis of last panel
rows <- grep(paste0("axis_b\\-[", idx[1], "-", idx[n], "]"),
gtable$layout$name)
lastAxis <- grep(paste0("axis_b\\-", panels), gtable$layout$name)
gtable$layout[rows, c("t","b")] <- gtable$layout[lastAxis, c("t")]
}
}
# again part of print.ggplot, plotting adjusted version
if(is.null(vp)){
grid.draw(gtable)
}
else{
if (is.character(vp))
seekViewport(vp)
else pushViewport(vp)
grid.draw(gtable)
upViewport()
}
invisible(p)
}
And here is how it looks
d <- ggplot(diamonds, aes(carat, price, fill = ..density..)) +
xlim(0, 2) + stat_binhex(na.rm = TRUE) + theme(aspect.ratio = 1) +
facet_wrap(~ color)
facetAdjust(d)
facetAdjust(d, "down")
Edit 3:
This is an alternative solution, the one above is fine as well.
There are some issues when one wants to use ggsave together with facetAdjust. A plot of class of ggplot is required because of two parts in the source code of ggsave: print(plot) and default_name(plot) in case one does not provide a filename manually (according to ?ggsave it seems that it is not supposed to work, though). Hence, given a filename, there is a workaround (possibly with side effects in some cases):
First, let us consider the separate function that achieves the main effect of floating axis. Normally, it would return a gtable object, however we use class(gtable) <- c("facetAdjust", "gtable", "ggplot"). In this way, it is allowed to use ggsave and print(plot) works as required (see below for print.facetAdjust)
facetAdjust <- function(x, pos = c("up", "down"))
{
pos <- match.arg(pos)
p <- ggplot_build(x)
gtable <- ggplot_gtable(p); dev.off()
dims <- apply(p$panel$layout[2:3], 2, max)
nrow <- dims[1]
ncol <- dims[2]
panels <- sum(grepl("panel", names(gtable$grobs)))
space <- ncol * nrow
n <- space - panels
if(panels != space){
idx <- (space - ncol - n + 1):(space - ncol)
gtable$grobs[paste0("axis_b",idx)] <- list(gtable$grobs[[paste0("axis_b",panels)]])
if(pos == "down"){
rows <- grep(paste0("axis_b\\-[", idx[1], "-", idx[n], "]"),
gtable$layout$name)
lastAxis <- grep(paste0("axis_b\\-", panels), gtable$layout$name)
gtable$layout[rows, c("t","b")] <- gtable$layout[lastAxis, c("t")]
}
}
class(gtable) <- c("facetAdjust", "gtable", "ggplot"); gtable
}
The function for printing which differs only by few lines from ggplot2:::print.ggplot:
print.facetAdjust <- function(x, newpage = is.null(vp), vp = NULL) {
if(newpage)
grid.newpage()
if(is.null(vp)){
grid.draw(x)
} else {
if (is.character(vp))
seekViewport(vp)
else pushViewport(vp)
grid.draw(x)
upViewport()
}
invisible(x)
}
Example:
d <- ggplot(diamonds, aes(carat, price, fill = ..density..)) +
xlim(0, 2) + stat_binhex(na.rm = TRUE) + theme(aspect.ratio = 1) +
facet_wrap(~ color)
p <- facetAdjust(d) # No output
print(p) # The same output as with the old version of facetAdjust()
ggsave("name.pdf", p) # Works, a filename is necessary
I have the same problem as this user - I have a 'jagged' faceted plot, in which the bottom row has fewer panels than the other rows, and I would like to have x-axis ticks on the bottom of each column.
The suggested solution for that problem was to set scales="free_x". (In ggplot 0.9.2.1; I believe the behavior I'm looking for was default in earlier versions.) That's a poor solution in my case: my actual axis labels will be rather long, so putting them under each row will occupy too much room. The results are something like this:
x <- gl(3, 1, 15, labels=paste("this is a very long axis label ", letters[1:5]))
y <- rnorm(length(x))
l <- gl(5, 3, 15)
d <- data.frame(x=x, y=y, l=l)
ggplot(d, aes(x=x, y=y)) + geom_point() + facet_wrap(~l, scales="free_x") +
theme(axis.text.x=element_text(angle=90, hjust=1))
In a comment here, Andrie suggests that it can be done manually in grid but I have no idea how to get started on that.
If I remember right, there were questions on both how to add all labels to the same line under the last column and how to lift these last labels up to the next row. So here is the function for both cases:
Edit: since this is like a substitute for print.ggplot (see getAnywhere(print.ggplot)) I have added some lines from it to preserve functionality.
Edit 2: I have improved it a bit more: no need to specify nrow and ncol anymore, plots with all the panels can be printed too.
library(grid)
# pos - where to add new labels
# newpage, vp - see ?print.ggplot
facetAdjust <- function(x, pos = c("up", "down"),
newpage = is.null(vp), vp = NULL)
{
# part of print.ggplot
ggplot2:::set_last_plot(x)
if(newpage)
grid.newpage()
pos <- match.arg(pos)
p <- ggplot_build(x)
gtable <- ggplot_gtable(p)
# finding dimensions
dims <- apply(p$panel$layout[2:3], 2, max)
nrow <- dims[1]
ncol <- dims[2]
# number of panels in the plot
panels <- sum(grepl("panel", names(gtable$grobs)))
space <- ncol * nrow
# missing panels
n <- space - panels
# checking whether modifications are needed
if(panels != space){
# indices of panels to fix
idx <- (space - ncol - n + 1):(space - ncol)
# copying x-axis of the last existing panel to the chosen panels
# in the row above
gtable$grobs[paste0("axis_b",idx)] <- list(gtable$grobs[[paste0("axis_b",panels)]])
if(pos == "down"){
# if pos == down then shifting labels down to the same level as
# the x-axis of last panel
rows <- grep(paste0("axis_b\\-[", idx[1], "-", idx[n], "]"),
gtable$layout$name)
lastAxis <- grep(paste0("axis_b\\-", panels), gtable$layout$name)
gtable$layout[rows, c("t","b")] <- gtable$layout[lastAxis, c("t")]
}
}
# again part of print.ggplot, plotting adjusted version
if(is.null(vp)){
grid.draw(gtable)
}
else{
if (is.character(vp))
seekViewport(vp)
else pushViewport(vp)
grid.draw(gtable)
upViewport()
}
invisible(p)
}
And here is how it looks
d <- ggplot(diamonds, aes(carat, price, fill = ..density..)) +
xlim(0, 2) + stat_binhex(na.rm = TRUE) + theme(aspect.ratio = 1) +
facet_wrap(~ color)
facetAdjust(d)
facetAdjust(d, "down")
Edit 3:
This is an alternative solution, the one above is fine as well.
There are some issues when one wants to use ggsave together with facetAdjust. A plot of class of ggplot is required because of two parts in the source code of ggsave: print(plot) and default_name(plot) in case one does not provide a filename manually (according to ?ggsave it seems that it is not supposed to work, though). Hence, given a filename, there is a workaround (possibly with side effects in some cases):
First, let us consider the separate function that achieves the main effect of floating axis. Normally, it would return a gtable object, however we use class(gtable) <- c("facetAdjust", "gtable", "ggplot"). In this way, it is allowed to use ggsave and print(plot) works as required (see below for print.facetAdjust)
facetAdjust <- function(x, pos = c("up", "down"))
{
pos <- match.arg(pos)
p <- ggplot_build(x)
gtable <- ggplot_gtable(p); dev.off()
dims <- apply(p$panel$layout[2:3], 2, max)
nrow <- dims[1]
ncol <- dims[2]
panels <- sum(grepl("panel", names(gtable$grobs)))
space <- ncol * nrow
n <- space - panels
if(panels != space){
idx <- (space - ncol - n + 1):(space - ncol)
gtable$grobs[paste0("axis_b",idx)] <- list(gtable$grobs[[paste0("axis_b",panels)]])
if(pos == "down"){
rows <- grep(paste0("axis_b\\-[", idx[1], "-", idx[n], "]"),
gtable$layout$name)
lastAxis <- grep(paste0("axis_b\\-", panels), gtable$layout$name)
gtable$layout[rows, c("t","b")] <- gtable$layout[lastAxis, c("t")]
}
}
class(gtable) <- c("facetAdjust", "gtable", "ggplot"); gtable
}
The function for printing which differs only by few lines from ggplot2:::print.ggplot:
print.facetAdjust <- function(x, newpage = is.null(vp), vp = NULL) {
if(newpage)
grid.newpage()
if(is.null(vp)){
grid.draw(x)
} else {
if (is.character(vp))
seekViewport(vp)
else pushViewport(vp)
grid.draw(x)
upViewport()
}
invisible(x)
}
Example:
d <- ggplot(diamonds, aes(carat, price, fill = ..density..)) +
xlim(0, 2) + stat_binhex(na.rm = TRUE) + theme(aspect.ratio = 1) +
facet_wrap(~ color)
p <- facetAdjust(d) # No output
print(p) # The same output as with the old version of facetAdjust()
ggsave("name.pdf", p) # Works, a filename is necessary
I have the same problem as this user - I have a 'jagged' faceted plot, in which the bottom row has fewer panels than the other rows, and I would like to have x-axis ticks on the bottom of each column.
The suggested solution for that problem was to set scales="free_x". (In ggplot 0.9.2.1; I believe the behavior I'm looking for was default in earlier versions.) That's a poor solution in my case: my actual axis labels will be rather long, so putting them under each row will occupy too much room. The results are something like this:
x <- gl(3, 1, 15, labels=paste("this is a very long axis label ", letters[1:5]))
y <- rnorm(length(x))
l <- gl(5, 3, 15)
d <- data.frame(x=x, y=y, l=l)
ggplot(d, aes(x=x, y=y)) + geom_point() + facet_wrap(~l, scales="free_x") +
theme(axis.text.x=element_text(angle=90, hjust=1))
In a comment here, Andrie suggests that it can be done manually in grid but I have no idea how to get started on that.
If I remember right, there were questions on both how to add all labels to the same line under the last column and how to lift these last labels up to the next row. So here is the function for both cases:
Edit: since this is like a substitute for print.ggplot (see getAnywhere(print.ggplot)) I have added some lines from it to preserve functionality.
Edit 2: I have improved it a bit more: no need to specify nrow and ncol anymore, plots with all the panels can be printed too.
library(grid)
# pos - where to add new labels
# newpage, vp - see ?print.ggplot
facetAdjust <- function(x, pos = c("up", "down"),
newpage = is.null(vp), vp = NULL)
{
# part of print.ggplot
ggplot2:::set_last_plot(x)
if(newpage)
grid.newpage()
pos <- match.arg(pos)
p <- ggplot_build(x)
gtable <- ggplot_gtable(p)
# finding dimensions
dims <- apply(p$panel$layout[2:3], 2, max)
nrow <- dims[1]
ncol <- dims[2]
# number of panels in the plot
panels <- sum(grepl("panel", names(gtable$grobs)))
space <- ncol * nrow
# missing panels
n <- space - panels
# checking whether modifications are needed
if(panels != space){
# indices of panels to fix
idx <- (space - ncol - n + 1):(space - ncol)
# copying x-axis of the last existing panel to the chosen panels
# in the row above
gtable$grobs[paste0("axis_b",idx)] <- list(gtable$grobs[[paste0("axis_b",panels)]])
if(pos == "down"){
# if pos == down then shifting labels down to the same level as
# the x-axis of last panel
rows <- grep(paste0("axis_b\\-[", idx[1], "-", idx[n], "]"),
gtable$layout$name)
lastAxis <- grep(paste0("axis_b\\-", panels), gtable$layout$name)
gtable$layout[rows, c("t","b")] <- gtable$layout[lastAxis, c("t")]
}
}
# again part of print.ggplot, plotting adjusted version
if(is.null(vp)){
grid.draw(gtable)
}
else{
if (is.character(vp))
seekViewport(vp)
else pushViewport(vp)
grid.draw(gtable)
upViewport()
}
invisible(p)
}
And here is how it looks
d <- ggplot(diamonds, aes(carat, price, fill = ..density..)) +
xlim(0, 2) + stat_binhex(na.rm = TRUE) + theme(aspect.ratio = 1) +
facet_wrap(~ color)
facetAdjust(d)
facetAdjust(d, "down")
Edit 3:
This is an alternative solution, the one above is fine as well.
There are some issues when one wants to use ggsave together with facetAdjust. A plot of class of ggplot is required because of two parts in the source code of ggsave: print(plot) and default_name(plot) in case one does not provide a filename manually (according to ?ggsave it seems that it is not supposed to work, though). Hence, given a filename, there is a workaround (possibly with side effects in some cases):
First, let us consider the separate function that achieves the main effect of floating axis. Normally, it would return a gtable object, however we use class(gtable) <- c("facetAdjust", "gtable", "ggplot"). In this way, it is allowed to use ggsave and print(plot) works as required (see below for print.facetAdjust)
facetAdjust <- function(x, pos = c("up", "down"))
{
pos <- match.arg(pos)
p <- ggplot_build(x)
gtable <- ggplot_gtable(p); dev.off()
dims <- apply(p$panel$layout[2:3], 2, max)
nrow <- dims[1]
ncol <- dims[2]
panels <- sum(grepl("panel", names(gtable$grobs)))
space <- ncol * nrow
n <- space - panels
if(panels != space){
idx <- (space - ncol - n + 1):(space - ncol)
gtable$grobs[paste0("axis_b",idx)] <- list(gtable$grobs[[paste0("axis_b",panels)]])
if(pos == "down"){
rows <- grep(paste0("axis_b\\-[", idx[1], "-", idx[n], "]"),
gtable$layout$name)
lastAxis <- grep(paste0("axis_b\\-", panels), gtable$layout$name)
gtable$layout[rows, c("t","b")] <- gtable$layout[lastAxis, c("t")]
}
}
class(gtable) <- c("facetAdjust", "gtable", "ggplot"); gtable
}
The function for printing which differs only by few lines from ggplot2:::print.ggplot:
print.facetAdjust <- function(x, newpage = is.null(vp), vp = NULL) {
if(newpage)
grid.newpage()
if(is.null(vp)){
grid.draw(x)
} else {
if (is.character(vp))
seekViewport(vp)
else pushViewport(vp)
grid.draw(x)
upViewport()
}
invisible(x)
}
Example:
d <- ggplot(diamonds, aes(carat, price, fill = ..density..)) +
xlim(0, 2) + stat_binhex(na.rm = TRUE) + theme(aspect.ratio = 1) +
facet_wrap(~ color)
p <- facetAdjust(d) # No output
print(p) # The same output as with the old version of facetAdjust()
ggsave("name.pdf", p) # Works, a filename is necessary
I have the same problem as this user - I have a 'jagged' faceted plot, in which the bottom row has fewer panels than the other rows, and I would like to have x-axis ticks on the bottom of each column.
The suggested solution for that problem was to set scales="free_x". (In ggplot 0.9.2.1; I believe the behavior I'm looking for was default in earlier versions.) That's a poor solution in my case: my actual axis labels will be rather long, so putting them under each row will occupy too much room. The results are something like this:
x <- gl(3, 1, 15, labels=paste("this is a very long axis label ", letters[1:5]))
y <- rnorm(length(x))
l <- gl(5, 3, 15)
d <- data.frame(x=x, y=y, l=l)
ggplot(d, aes(x=x, y=y)) + geom_point() + facet_wrap(~l, scales="free_x") +
theme(axis.text.x=element_text(angle=90, hjust=1))
In a comment here, Andrie suggests that it can be done manually in grid but I have no idea how to get started on that.
If I remember right, there were questions on both how to add all labels to the same line under the last column and how to lift these last labels up to the next row. So here is the function for both cases:
Edit: since this is like a substitute for print.ggplot (see getAnywhere(print.ggplot)) I have added some lines from it to preserve functionality.
Edit 2: I have improved it a bit more: no need to specify nrow and ncol anymore, plots with all the panels can be printed too.
library(grid)
# pos - where to add new labels
# newpage, vp - see ?print.ggplot
facetAdjust <- function(x, pos = c("up", "down"),
newpage = is.null(vp), vp = NULL)
{
# part of print.ggplot
ggplot2:::set_last_plot(x)
if(newpage)
grid.newpage()
pos <- match.arg(pos)
p <- ggplot_build(x)
gtable <- ggplot_gtable(p)
# finding dimensions
dims <- apply(p$panel$layout[2:3], 2, max)
nrow <- dims[1]
ncol <- dims[2]
# number of panels in the plot
panels <- sum(grepl("panel", names(gtable$grobs)))
space <- ncol * nrow
# missing panels
n <- space - panels
# checking whether modifications are needed
if(panels != space){
# indices of panels to fix
idx <- (space - ncol - n + 1):(space - ncol)
# copying x-axis of the last existing panel to the chosen panels
# in the row above
gtable$grobs[paste0("axis_b",idx)] <- list(gtable$grobs[[paste0("axis_b",panels)]])
if(pos == "down"){
# if pos == down then shifting labels down to the same level as
# the x-axis of last panel
rows <- grep(paste0("axis_b\\-[", idx[1], "-", idx[n], "]"),
gtable$layout$name)
lastAxis <- grep(paste0("axis_b\\-", panels), gtable$layout$name)
gtable$layout[rows, c("t","b")] <- gtable$layout[lastAxis, c("t")]
}
}
# again part of print.ggplot, plotting adjusted version
if(is.null(vp)){
grid.draw(gtable)
}
else{
if (is.character(vp))
seekViewport(vp)
else pushViewport(vp)
grid.draw(gtable)
upViewport()
}
invisible(p)
}
And here is how it looks
d <- ggplot(diamonds, aes(carat, price, fill = ..density..)) +
xlim(0, 2) + stat_binhex(na.rm = TRUE) + theme(aspect.ratio = 1) +
facet_wrap(~ color)
facetAdjust(d)
facetAdjust(d, "down")
Edit 3:
This is an alternative solution, the one above is fine as well.
There are some issues when one wants to use ggsave together with facetAdjust. A plot of class of ggplot is required because of two parts in the source code of ggsave: print(plot) and default_name(plot) in case one does not provide a filename manually (according to ?ggsave it seems that it is not supposed to work, though). Hence, given a filename, there is a workaround (possibly with side effects in some cases):
First, let us consider the separate function that achieves the main effect of floating axis. Normally, it would return a gtable object, however we use class(gtable) <- c("facetAdjust", "gtable", "ggplot"). In this way, it is allowed to use ggsave and print(plot) works as required (see below for print.facetAdjust)
facetAdjust <- function(x, pos = c("up", "down"))
{
pos <- match.arg(pos)
p <- ggplot_build(x)
gtable <- ggplot_gtable(p); dev.off()
dims <- apply(p$panel$layout[2:3], 2, max)
nrow <- dims[1]
ncol <- dims[2]
panels <- sum(grepl("panel", names(gtable$grobs)))
space <- ncol * nrow
n <- space - panels
if(panels != space){
idx <- (space - ncol - n + 1):(space - ncol)
gtable$grobs[paste0("axis_b",idx)] <- list(gtable$grobs[[paste0("axis_b",panels)]])
if(pos == "down"){
rows <- grep(paste0("axis_b\\-[", idx[1], "-", idx[n], "]"),
gtable$layout$name)
lastAxis <- grep(paste0("axis_b\\-", panels), gtable$layout$name)
gtable$layout[rows, c("t","b")] <- gtable$layout[lastAxis, c("t")]
}
}
class(gtable) <- c("facetAdjust", "gtable", "ggplot"); gtable
}
The function for printing which differs only by few lines from ggplot2:::print.ggplot:
print.facetAdjust <- function(x, newpage = is.null(vp), vp = NULL) {
if(newpage)
grid.newpage()
if(is.null(vp)){
grid.draw(x)
} else {
if (is.character(vp))
seekViewport(vp)
else pushViewport(vp)
grid.draw(x)
upViewport()
}
invisible(x)
}
Example:
d <- ggplot(diamonds, aes(carat, price, fill = ..density..)) +
xlim(0, 2) + stat_binhex(na.rm = TRUE) + theme(aspect.ratio = 1) +
facet_wrap(~ color)
p <- facetAdjust(d) # No output
print(p) # The same output as with the old version of facetAdjust()
ggsave("name.pdf", p) # Works, a filename is necessary
I have a viewport with two graphs drawn in a left to right fashion. I'm trying to have a single title appear over both of the graphs centered in the viewport. Is this possible? Sorry, no pic because of my noob status and I can't post the code because of my work environment.
I think you might be interested in the gridExtra package, which provides the grid.arrange() function that fulfills everything you wonder about.
With #Kevin's example, the command would be
grid.arrange(plots[[1]], plots[[2]], ncol=2,
main="test main", sub="subtitle test")
I have been using an almost unmodified version of code in this post to the ggplot2 mailing list to put a main title and subtitle above and below a matrix of plots. Credit to Baptiste Auguié.
arrange <- function(..., nrow=NULL, ncol=NULL, as.table=FALSE,
main=NULL, sub=NULL, plot=TRUE) {
dots <- list(...)
n <- length(dots)
if(is.null(nrow) & is.null(ncol)) { nrow = floor(n/2) ; ncol = ceiling(n/nrow)}
if(is.null(nrow)) { nrow = ceiling(n/ncol)}
if(is.null(ncol)) { ncol = ceiling(n/nrow)}
fg <- frameGrob(layout=grid.layout(nrow,ncol))
ii.p <- 1
for(ii.row in seq(1, nrow)){
ii.table.row <- ii.row
if(as.table) {ii.table.row <- nrow - ii.table.row + 1}
for(ii.col in seq(1, ncol)){
ii.table <- ii.p
if(ii.p > n) break
fg <- placeGrob(fg, ggplotGrob(dots[[ii.table]]),
row=ii.table.row, col=ii.col)
ii.p <- ii.p + 1
}
}
if(!is.null(main) | !is.null(sub)){
g <- frameGrob() # large frame to place title(s) and content
g <- packGrob(g, fg)
if (!is.null(main))
g <- packGrob(g, textGrob(main), side="top")
if (!is.null(sub))
g <- packGrob(g, textGrob(sub), side="bottom")
} else {
g <- fg
}
if(plot) grid.draw(g)
invisible(g)
}
library(ggplot2)
plots <- llply(1:2, function(.x) qplot(1:10,rnorm(10), main=paste("plot",.x)))
arrange(plots[[1]],plots[[2]], nrow=1, ncol = 2, as.table=TRUE, main="test main",
sub="subtitle test")
Produces:
Another Possibility, it's kind of cheating by way of creating a blank plot...
p1 <- ggplot(diamonds, aes(price,depth)) + geom_point()
p2 <- ggplot(diamonds, aes(price,carat)) + geom_point()
p3 <- ggplot(diamonds, aes(x=1,y=1,label="Title")) + geom_text(size=20) + opts(panel.background=theme_blank(), panel.grid.minor=theme_blank(), panel.grid.major=theme_blank(), axis.text.x=theme_blank(), axis.text.y=theme_blank(), axis.ticks=theme_blank(), axis.title.x=theme_blank(), axis.title.y=theme_blank())
vplayout <- function(x, y) viewport(layout.pos.row=x, layout.pos.col=y)
grid.newpage()
pushViewport(viewport(layout=grid.layout(4,4)))
print(p1,vp=vplayout(2:4,1:2))
print(p2,vp=vplayout(2:4,3:4))
print(p3,vp=vplayout(1,1:4))