Left-aligning ggplot when saved while using a fixed aspect ratio - r

I'm building a custom ggplot theme to standardize the look & feel of graphs I produce. The goal is more complex than this minimal example, so I'm looking for a general solution. I have a few key goals:
I want all graphs to export at the same size (3000 pixels wide, 1500 pixels high).
I want to control the aspect ratio of the plot panel itself.
I want to use textGrobs to include figure numbers.
I want the image to be left-aligned
The challenge I'm facing is that when combining these two constraints, the image that gets saved centers the ggplot graph within the window, which makes sense as a default, but looks bad in this case.
I'm hoping there's a general solution to left-align the ggplot panel when I export. Ideally, this will also work similarly for faceted graphs.
It seems that something should be possible using one of or some combination of the gridExtra, gtable, cowplot, and egg packages, but after experimenting for a few hours I'm at a bit of a loss. Does anybody know how I can accomplish this? My code is included below.
This is the image that gets produced. As you can see, the caption is left-aligned at the bottom, but the ggplot itself is horizontally centered. I want the ggplot graph left-aligned as well.
Graph output: https://i.stack.imgur.com/5EM2c.png
library(ggplot2)
# Generate dummy data
x <- paste0("var", seq(1,10))
y <- LETTERS[1:10]
data <- expand.grid(X=x, Y=y)
data$Z <- runif(100, -2, 2)
# Generate heatmap with fixed aspect ratio
p1 <- ggplot(data, aes(X, Y, fill= Z)) +
geom_tile() +
labs(title = 'A Heatmap Graph') +
theme(aspect.ratio = 1)
# A text grob for the footer
figure_number_grob <- grid::textGrob('Figure 10',
x = 0.004,
hjust = 0,
gp = grid::gpar(fontsize = 10,
col = '#01A184'))
plot_grid <- ggpubr::ggarrange(p1,
figure_number_grob,
ncol = 1,
nrow = 2,
heights = c(1,
0.05))
# save it
png(filename = '~/test.png', width = 3000, height = 1500, res = 300, type = 'cairo')
print(plot_grid)
dev.off()

I was able to find a solution to this that works for my needs, though it does feel a bit hacky.
Here's the core idea:
Generate the plot without a fixed aspect ratio.
Split the legend from the plot as its own component
Use GridExtra's arrangeGrob to combine the plot, a spacer, the legend, and another spacer horizontally
Set the width of the plot to some fraction of npc (normal parent coordinates), in this case 0.5. This means that the plot will take up 50% of the horizontal space of the output file.
Note that this is not exactly the same as setting a fixed aspect ratio for the plot. If you know the size of the output file, it's close to the same thing, but the size of axis text & axis titles will affect the output aspect ratio for the panel itself, so while it gets you close, it's not ideal if you need a truly fixed aspect ratio
Set the width of the spacers to the remaining portion of the npc (in this case, 0.5 again), minus the width of the legend to horizontally center the legend in the remaining space.
Here's my code:
library(ggplot2)
# Generate dummy data
x <- paste0("var", seq(1,10))
y <- LETTERS[1:10]
data <- expand.grid(X=x, Y=y)
data$Z <- runif(100, -2, 2)
# Generate heatmap WITHOUT fixed aspect ratio. I address this below
p1 <- ggplot(data, aes(X, Y, fill= Z)) +
geom_tile() +
labs(title = 'A Heatmap Graph')
# Extract the legend from our plot
legend = gtable::gtable_filter(ggplotGrob(p1), "guide-box")
plot_output <- gridExtra::arrangeGrob(
p1 + theme(legend.position="none"), # Remove legend from base plot
grid::rectGrob(gp=grid::gpar(col=NA)), # Add a spacer
legend, # Add the legend back
grid::rectGrob(gp=grid::gpar(col=NA)), # Add a spacer
nrow=1, # Format plots in 1 row
widths=grid::unit.c(unit(0.5, "npc"), # Plot takes up half of width
(unit(0.5, "npc") - legend$width) * 0.5, # Spacer width
legend$width, # Legend width
(unit(0.5, "npc") - legend$width) * 0.5)) # Spacer width
# A text grob for the footer
figure_number_grob <- grid::textGrob('Figure 10',
x = 0.004,
hjust = 0,
gp = grid::gpar(fontsize = 10,
col = '#01A184'))
plot_grid <- ggpubr::ggarrange(plot_output,
figure_number_grob,
ncol = 1,
nrow = 2,
heights = c(1,
0.05))
# save it
png(filename = '~/test.png', width = 3000, height = 1500, res = 300, type = 'cairo')
print(plot_grid)
dev.off()
And here's the output image: https://i.stack.imgur.com/rgzFy.png

Related

How to apply a clipping mask to geom in a ggplot?

I am trying to apply a clipping mask to a geom from a ggplot to mask part of the data, but keep the axis, the grid, other geoms and the legend visible. I do not want to create a specific plot, and therefore I am not looking for a work-around with polygons masking some parts of the plot.
This is the kind of design I would like to emulate (the mask, not necessarily theme, I now how to do that):
(source)
See also this example
One could argue that I could filter the data that is not contained in the polygon that defines the mask. But, while it works for point, and can work for polygon/line-like objects, it does for rasters (the border would not exactly follow non-vertical or non-horizontal lines).
So I tried the following:
library(ggplot2)
library(gridSVG)
library(grImport)
# Create a plot
p <- ggplot(diamonds[1:300,], aes(carat, price)) + geom_point(aes(colour = cut))
# And a clipping mask
pg <- polygonGrob(c(.7, 0, 0, 1, 1),
c(0, .7, 1, 1, 0))
cp <- clipPath(pg)
I was able to use the packages gridSVG to define a clipping mask, but I have difficulties applying it on a ggplot object, even after extracting the grob (see resource here) with ggplotGrob(). I was not able to apply the clipping mask to the grob:
g <- ggplotGrob(p) # store the plot as a grob
registerClipPath("mask", cp)
g_clipped <- clipPath(g)
gridsvg(name = "test_c2.svg")
grid.draw(clipPathGrob(g_clipped, cp)$grob)
dev.off()
My intuition was that the g_clipped should be plotted, but I couldn't grid.draw() it, since its a clipPath object. And the grid.draw()
line written here show the plot not masked. I think I don't quite grasp how the clipPath objects function.
The function grobify() sounds like it could help for an alternative appraoch without gridSVG, see details here, but I do not understand the quite minimalistic documentation.
Since I cannot even apply the clipping mask to the whole plot, I am far for my objective.
If you can help me understand how to apply the clipping mask from gridSVGor have an alternative solution to apply a clipping mask to specific geoms, please let me know.
The following is a grid solution, but very much a work-around. It shows how to apply a non-rectangular clipping region to a ggplot, so that one set of points in your plot is clipped. You weren't too far wrong in your attempt. A couple of points to note:
You need to grid.force() the ggplotGrob object so the grid can see the grobs.
Do not define the ggplot grob as a clipping path - the clipping path is the polygon.
The clipping path is applied to the points grob within the plot panel of the ggplot. This means that other objects in the plot panel, the panel background and grid lines, do not get clipped. Only the data points are clipped.
I've added a blue line to the plot to show that the line too does not need to be clipped; but can be clipped if desired.
There are also commented lines of code that, when uncommented, will draw the clipping region, and move the grid lines and points to the front (that is, in front of the darker grey clipping region).
library(ggplot2)
library(gridSVG)
library(grid)
# Open the graphics device
gridsvg(name = "test.svg")
# Create a plot
p <- ggplot(diamonds[1:300, ], aes(carat, price)) +
geom_point(aes(colour = cut)) +
geom_line(data = data.frame(x = c(.3, .9), y = c(500, 2500)), aes(x,y), col = "skyblue", size = 2)
g <- ggplotGrob(p) # Store the plot as a grob
g = grid.force(g) # So that grid sees all grobs
grid.draw(g) # Draw the plot
# Define the clipping path
pg <- polygonGrob(c(.7, 0, 0, 1, 1),
c(0, .7, 1, 1, 0))
# The clipping path can be nearly any shape you desire.
# Try this for a circular region
# pg = circleGrob(x = .5, y = .6, r = .5)
cp <- clipPath(pg)
# Add the clipping path to the points grob.
# That is, only the points inside the polygon will be visible,
# but the background and grid lines will not be clipped.
# Nor will the blue line be clipped.
# grid.ls(g) # names of the grobs
seekViewport(grep("panel.[0-9]", grid.ls(g)$name, value = TRUE))
grid.clipPath("points", cp, grep = TRUE)
# To clip the blue line, uncomment the next line
# grid.clipPath("GRID.polyline", cp, grep = TRUE)
# To show the clipping region,
# uncomment the next two lines.
# showcp = editGrob(pg, gp = gpar(fill = rgb(0, 0, 0, 0.05), col = "transparent"))
# grid.draw(showcp)
# And to move the grid lines, remaining data points, and blue line in front of the clipping region,
# uncomment the next five lines
# panel = grid.get("panel", grep = TRUE) # Get the panel, and remove the background grob
# panel = removeGrob(panel, "background", grep = TRUE)
# grid.remove("points", grep = TRUE) # Remove points and grid lines from the rendered plot
# grid.remove("line", grep = TRUE, global = TRUE)
# grid.draw(panel) # Draw the edited panel - on top of the clipping region
# Turn off the graphics device
dev.off()
# Find text.svg in your working directory
Edit Defining the clipping region using the coordinate system in which the data points were drawn.
library(ggplot2)
library(gridSVG)
library(grid)
# Open the graphics device
gridsvg(name = "test.svg")
# Create a plot
p <- ggplot(diamonds[1:300, ], aes(carat, price)) +
geom_point(aes(colour = cut)) +
geom_line(data = data.frame(x = c(.3, .9), y = c(500, 2500)), aes(x,y), col = "skyblue", size = 2)
g <- ggplotGrob(p) # Store the plot as a grob
g = grid.force(g) # So that grid sees all grobs
grid.draw(g) # Draw the plot
# Get axis limits (including any expansion)
axis.limits = summarise_layout(ggplot_build(p))[1, c('xmin', 'xmax', 'ymin', 'ymax')]
# Find the 'panel' viewport,
# then push to a new viewport,
# one that exactly overlaps the 'panel' viewport,
# but with limits on the x and y scales that are the same
# as the limits for the original ggplot.
seekViewport(grep("panel.[0-9]", grid.ls(g)$name, value = TRUE))
pushViewport(dataViewport(xscale = axis.limits[1, 1:2],
yscale = axis.limits[1, 3:4]))
# Define the clipping path
pg <- polygonGrob(x = c(.6, 0.3, .3, .8, 1.2),
y = c(500, 1500, 2900, 2900, 1500),
default.units="native")
cp <- clipPath(pg)
# Add the clipping path to the points grob.
# That is, only the points inside the polygon will be visible,
# but the background and grid lines will not be clipped.
# Nor will the blue line be clipped.
# grid.ls(g) # names of the grobs
grid.clipPath("points", cp, grep = TRUE)
# To clip the blue line, uncomment the next line
grid.clipPath("GRID.polyline", cp, grep = TRUE)
# To show the clipping region.
showcp = editGrob(pg, gp = gpar(fill = rgb(0, 0, 0, 0.05), col = "transparent"))
grid.draw(showcp)
# And to move the grid lines and remaining data points in front of the clipping region.
panel = grid.get("panel", grep = TRUE) # Get the panel, and remove the background grob
panel = removeGrob(panel, "background", grep = TRUE)
grid.remove("points", grep = TRUE) # Remove points and grid lines from the rendered plot
grid.remove("line", grep = TRUE, global = TRUE)
grid.draw(panel) # Draw the edited panel - on top of the clipping region
# Turn off the graphics device
dev.off()
# Find text.svg in your working directory
Since you are starting out with a ggplot object, it may be simpler to create the mask itself as a geom layer, rather than convert everything to grob and work in the grid system there.
The geom_polypath() function from the ggpolypath package can be used here. Unlike the standard geom_polygon in ggplot2, it is able to handle polygons with holes (see vignette):
# sample data frame for clipping. The first four x & y coordinates are for the outer ends;
# the next four are for the hole in the polygon.
clipping.df <- data.frame(x = c(0, 1.5, 1.5, 0, 0.2, 1, 0.7, 0.3),
y = c(0, 0, 3000, 3000, 250, 2000, 2800, 1500),
hole = rep(c(FALSE, TRUE), each = 4),
group = rep(c("1", "2"), each = 4))
library(ggpolypath)
p +
geom_polypath(data = clipping.df,
aes(x = x, y = y, group = group),
colour = NA, fill = "black", alpha = 0.5,
inherit.aes = FALSE) +
scale_x_continuous(expand = c(0, 0)) + # don't show edges beyond the extent
scale_y_continuous(expand = c(0, 0)) # of the polygon

Lock aspect ratio on part of grid

I'm trying to write a function wherein our company logo is automatically added to each graph on export as part of a function, next to the title and subtitle. The dimensions of each output will depend on the needs at the time, so having a set size won't be particularly helpful unfortunately.
To do this, I've generated a series of grids to slot everything together, as per the below (using the iris dataset).
library(datasets)
library(tidyverse)
library(gridExtra)
library(grid)
library(png)
m <- readPNG("Rlogo.png") # download from: https://www.r-project.org/logo/Rlogo.png
plot <- ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width)) +
geom_col() +
ggtitle("Title goes here",
subtitle = "subtitle down here")
txtTitle <- plot$labels$title
txtSubTitle <- plot$labels$subtitle
plot$labels$title <- NULL
plot$labels$subtitle <- NULL
buffer <- grobTree(rectGrob(gp = gpar(fill = "white", col = "white")))
Title <- grobTree(textGrob(label = txtTitle,
hjust = 1,
x = 0.98))
SubTitle <- textGrob(label = txtSubTitle,
hjust = 1,
x = 0.98)
Logo <- grobTree(rasterGrob(m, x = 0.02, hjust = 0))
TitlesGrid <- grid.arrange(Title, SubTitle, ncol = 1)
TopGrid <- grid.arrange(Logo, TitlesGrid, widths = c(1, 7), ncol = 2)
AllGrid <- grid.arrange(TopGrid, arrangeGrob(plot), heights = c(1,7))
This provides the following outputs at different aspect ratios.
The first example has a nice gap between the title and subtitle whereas there is too much for the second one. How would I make it so that the height of TopGrid is fixed to an absolute size, but the rest fills to the size desired?
Grid graphics has the concept of absolute and relative units. Absolute units (such as "cm", "in", "pt") always stay the same size, regardless of the viewport size. Relative units (called "null") expand or shrink as needed. In a regular ggplot2 object, the plot panel is specified in relative units while the various elements around the panel, such as title, axis ticks, etc. are specified in absolute units.
You specify absolute or relative units with the unit() function:
> library(grid)
> unit(1, "cm")
[1] 1cm
> unit(1, "null")
[1] 1null
In your case, the heights argument of grid.arrange can take arbitrary grid unit objects, so you just have to give the top height an absolute unit:
grid.arrange(TopGrid, arrangeGrob(plot), heights = unit(c(1, 1), c("cm", "null")))

Absolute positioning of rasterGrobs in gtable cells

I have been attempting to specify absolute positions for rasterGrobs in gtable cells without success. I would like to be able to have the extents of an image align to values on the y axis. The script aligns drill-core images alongside multi-sensor data plotted in ggplot2 facets. For example, a particular radiograph core image needs to have its top at 192 mm, and bottom at 1482 mm, but I want the scale to go from 0 to 1523 mm. Please see the included link for an example of what I am doing, but for simplicity I have only posted an MWE here. Is it possible to specify an absolute position for a rasterGrob inside a gtable cell?
sample of intended output
In terms of the MWE below, my only solution thus far has been to move Rlogo.png around using relative positions set when using rasterGrob(). Using "native" coordinates does not appear to be what I need either. Similarly, I can't make sense of the position parameters called in gtable_add_grob().
library(png)
library(ggplot2)
library(gtable)
# read Image
img <- readPNG(system.file("img", "Rlogo.png", package = "png"))
# convert to rastergrob
g <- rasterGrob(img, y = unit(0.5, "npc"), x = unit(0.5, "npc"))
# create plot
tp <- qplot(1:5, 1:5, geom="blank") + scale_y_reverse()
# convert plot to gtable
tt <- ggplot_gtable(ggplot_build(tp))
# add column to gtable to hold image
tt <- gtable_add_cols(tt, tt$width[[.5*4]], 3)
# add grob to cell 3, 4
tt <- gtable_add_grob(tt,g,3,4)
# render
grid.draw(tt)
Did a lot of searching before coming up with this solution of using rasterGrob to add images to panels in a ggplot. Perhaps though there is a more elegant solution someone can suggest?
The grob can set its position within a cell, as illustrated below
library(gridExtra)
library(grid)
library(gtable)
# quick shortcut to create a 2x2 gtable filled with 4 rectGrobs
tg <- arrangeGrob(grobs=replicate(4, rectGrob(), FALSE))
# red rect of fixed size with default position (0.5, 0.5) npc
rg1 <- rasterGrob("red", width=unit(1,"cm"), height=unit(1,"cm"))
# blue rect with specific x position (0) npc, left-justified
rg2 <- rasterGrob("blue", width=unit(1,"cm"), height=unit(1,"cm"),
x = 0, hjust=0)
# green rect at x = 1cm left-justified, y=-0.5cm from middle, top-justified
rg3 <- rasterGrob("green", width=unit(1,"cm"), height=unit(1,"cm"),
x = unit(1,"cm"), y=unit(0.5, "npc") - unit(0.5, "cm"),
hjust=0, vjust=1)
# place those on top
tg <- gtable_add_grob(tg, rg1, 1, 2, z = Inf, name = "default")
tg <- gtable_add_grob(tg, rg2, 1, 2, z = Inf, name = "left")
tg <- gtable_add_grob(tg, rg3, 1, 2, z = Inf, name = "custom")
grid.newpage()
grid.draw(tg)

Generate Figure Wide Axes for Figure with Multiple Plots (grid)

I have an analysis in which I varying parameters of a model, and would like to generate a well-labeled figure showing the effects of various combinations of settings. I can generate the actual plots without issue, and arrange them in a grid. Now I would like to add axes which refer not to the data but to the parameter values that I am varying. Here is a simple example of what I am trying to do.
library(lattice)
library(gridExtra)
dat <- rnorm(1000, 0, 1)
# these are my parameters
scales <- c(0.1, 0.5, 1, 10, 15)
adds <- c(1, 2, 3, 4, 5)
# generate data to be plotted
revData <- list()
ptr <- 1
for (ii in 1:length(scales)){
for (jj in 1:length(adds)){
revData[[ptr]] <- (dat * scales[[ii]]) + adds[[jj]]
ptr <- ptr + 1
}
}
# generating plots
plotList <- lapply(revData, function(xx){
xyplot(xx ~ 1:1000)
})
names(plotList) <- sprintf("N%s", 1:length(plotList))
plotList <- c(plotList, list(ncol=length(scales)))
do.call(grid.arrange, plotList)
This produces the following figure:
What I would like to do now is generate X and Y axes for this set of plots, in which the X-axis refers to the scales variable and has the values listed, and similarly a Y-axis which corresponds to the adds value. How do I do this?
Another answer using grid package. First create a grid of viewports, then at each iteration of creating the data just plot it. This maybe gives a bit more control over spacing.
library(lattice)
library(grid)
# Data
dat <- rnorm(1000, 0, 1)
# these are my parameters
scales <- c(0.1, 0.5, 1, 10, 15)
adds <- c(1, 2, 3, 4, 5)
Create grid layout - this lets you look at the plot grid: 6 by 6 with the first column and last row used for the additional parameter labels.
grid.show.layout(grid.layout(6, 6,
widths = unit(c(2, rep(1,5)), c("lines", rep("null",5))) ,
heights = unit(c(rep(1,5),2), c(rep("null",5), "lines"))))
Start plot
grid.newpage()
pushViewport(viewport(layout=grid.layout(6, 6,
widths = unit(c(2, rep(1,5)), c("lines", rep("null",5))) ,
heights = unit(c(rep(1,5),2), c(rep("null",5), "lines")))))
# generate data and plot
for (ii in 1:length(scales)) {
for (jj in 1:length(adds)) {
revData <- (dat * scales[ii]) + adds[jj]
# plot (top to bottom / left to right)
pushViewport(viewport(layout.pos.row=jj, layout.pos.col=ii+1))
plot(xyplot(revData ~ 1:1000 , xlab=NULL , ylab=NULL) , newpage=FALSE)
upViewport(1)
}
}
add "scales" labels to x-axis
pushViewport(viewport(layout.pos.row=6, layout.pos.col=2:6 ))
grid.text(scales, x=seq(0.1,0.9 ,length=5), y=0.8 , hjust=0.2,
gp=gpar(col="red" , fontsize=14))
grid.text("Scales" , x=0.5 , y=0.3 , gp=gpar(fontsize=20))
grid.lines(y=1 , gp=gpar(col="red"))
upViewport(1)
add "adds" labels to y-axis
pushViewport(viewport(layout.pos.row=1:5, layout.pos.col=1 ))
grid.text(rev(adds),hjust=0.4 , x=0.8, y=seq(0.1,0.9 ,length=5), rot=90,
gp=gpar(col="red" , fontsize=14))
grid.text("Adds" , x=0.3 , y=0.5 , rot=90, gp=gpar(fontsize=20))
grid.lines(x=1 , gp=gpar(col="red"))
EDIT
I added axis titles using grid.text and tweaking the x & y slightly. A better way would be to add another row and column to the grid and use this for the labels. An example grid is below - you will need to tweak another couple of things in the code but is not difficult.
grid.show.layout(grid.layout(7,7,
widths = unit(c(2, 2,rep(1,5)), c("lines", "lines",rep("null",5))) ,
heights = unit(c(rep(1,5),2,2), c(rep("null",5), "lines","lines"))))
You could use the first column and last row for axis titles, the second column and second last row for axis labels and line, leaving the rest of the grid for the plot.
Not sure this is what you are looking for, but you can add a textGrob underneath and to the left of the plot to indicate what value of "scales" or "adds" each plot represents. The sub and left arguments of grid.arrange can be used.
do.call(grid.arrange,
c(plotList ,
list(
sub = textGrob(paste0("scales_",scales),
x=unit(seq(0.05,0.85,length=5), "npc"),
hjust=0, vjust=0 ,
gp=gpar(col="red", fontsize=14) ),
left = textGrob(paste0("adds_",rev(adds)),
y=unit(seq(0.05,0.85,length=5), "npc"),
hjust=0, vjust=1 , rot = 90,
gp=gpar(col="red", fontsize=14) ))))
You will need to play about with the x and y coordinates.
This produces the plot:

How to get equal-sized subplots with different multi-figure layouts in R and grid

I am using the grid package to do a multi-figure graph:
# load libraries
library(grid)
library(ggplot2)
library(gridSVG)
# create some data
p <- ggplot(mtcars, aes(wt, mpg))
# push Viewport and create layout
pushViewport(viewport(layout = grid.layout(nrow = 5, ncol = 4)))
matrixindex = cbind(rep(1:5,each =4), rep(1:4,times=5))
#fill viewport
for (k in 1:20){
print(p+geom_point(),
vp=viewport(layout.pos.row=matrixindex[k,1],layout.pos.col=matrixindex[k,2]))}
# export as SVG
gridToSVG("trial.svg","none","none")
Now, I would like to produce a second figure, with a changed layout (just one row, but again
4 columns). But the individual plots within the figure should have the same size like in the 5x4 layout. How can I achieve this?
You can use the heights and / or widths argument to grid.layout to fix the sizes, eg:
pushViewport(viewport(layout = grid.layout(heights = unit(0.2 , "npc" ) ,nrow = 1, ncol = 4)))
'npc' means normalised parent coordinates, so 0.2 takes 1/5 the viewport.

Resources