Absolute positioning of rasterGrobs in gtable cells - r

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)

Related

Is it possible to draw the axis line first, before the data?

This is a follow up to my previous question where I was looking for a solution to get the axis drawn first, then the data. The answer works for that specific question and example, but it opened a more general question how to change the plotting order of the underlying grobs. First the axis, then the data.
Very much in the way that the panel grid grob can be drawn on top or not.
Panel grid and axis grobs are apparently generated differently - axes more as guide objects rather than "simple" grobs. (Axes are drawn with ggplot2:::draw_axis(), whereas the panel grid is built as part of the ggplot2:::Layout object).
I guess this is why axes are drawn on top, and I wondered if the drawing order can be changed.
# An example to play with
library(ggplot2)
df <- data.frame(var = "", val = 0)
ggplot(df) +
geom_point(aes(val, var), color = "red", size = 10) +
scale_x_continuous(
expand = c(0, 0),
limits = c(0,1)
) +
coord_cartesian(clip = "off") +
theme_classic()
A ggplot can be represented by its gtable. The position of the grobs are given by the layout element, and "the z-column is used to define the drawing order of the grobs".
The z value for the panel, which contains the points grob, can then be increased so that it is drawn last.
So if p is your plot then
g <- ggplotGrob(p) ;
g$layout[g$layout$name == "panel", "z"] <- max(g$layout$z) + 1L
grid::grid.draw(g)
However, as noted in the comment this changes how the axis look, which perhaps, is due to the panel being drawn over some of the axis.
But in new exciting news from dww
if we add theme(panel.background = element_rect(fill = NA)) to the plot, the axes are no longer partially obscured. This both proves that this is the cause of the thinner axis lines, and also provides a reasonable workaround, provided you don't need a colored panel background.
Since you are looking for a more "on the draw level" solution, then the place to start is to ask "how is the ggplot drawn in the first place?". The answer can be found in the print method for ggplot objects:
ggplot2:::print.ggplot
#> function (x, newpage = is.null(vp), vp = NULL, ...)
#> {
#> set_last_plot(x)
#> if (newpage)
#> grid.newpage()
#> grDevices::recordGraphics(requireNamespace("ggplot2",
#> quietly = TRUE), list(), getNamespace("ggplot2"))
#> data <- ggplot_build(x)
#> gtable <- ggplot_gtable(data)
#> if (is.null(vp)) {
#> grid.draw(gtable)
#> }
#> else {
#> if (is.character(vp))
#> seekViewport(vp)
#> else pushViewport(vp)
#> grid.draw(gtable)
#> upViewport()
#> }
#> invisible(x)
#> }
where you can see that a ggplot is actually drawn by calling ggplot_build on the ggplot object, then ggplot_gtable on the output of ggplot_build.
The difficulty is that the panel, with its background, gridlines and data is created as a distinct grob tree. This is then nested as a single entity inside the final grob table produced by ggplot_build. The axis lines are drawn "on top" of that panel. If you draw these lines first, part of their thickness will be over-drawn with the panel. As mentioned in user20650's answer, this is not a problem if you don't need your plot to have a background color.
To my knowledge, there is no native way to include the axis lines as part of the panel unless you add them yourself as grobs.
The following little suite of functions allows you to take a plot object, remove the axis lines from it and add axis lines into the panel:
get_axis_grobs <- function(p_table)
{
axes <- grep("axis", p_table$layout$name)
axes[sapply(p_table$grobs[axes], function(x) class(x)[1] == "absoluteGrob")]
}
remove_lines_from_axis <- function(axis_grob)
{
axis_grob$children[[grep("polyline", names(axis_grob$children))]] <- zeroGrob()
axis_grob
}
remove_all_axis_lines <- function(p_table)
{
axes <- get_axis_grobs(p_table)
for(i in axes) p_table$grobs[[i]] <- remove_lines_from_axis(p_table$grobs[[i]])
p_table
}
get_panel_grob <- function(p_table)
{
p_table$grobs[[grep("panel", p_table$layout$name)]]
}
add_axis_lines_to_panel <- function(panel)
{
old_order <- panel$childrenOrder
panel <- grid::addGrob(panel, grid::linesGrob(x = unit(c(0, 0), "npc")))
panel <- grid::addGrob(panel, grid::linesGrob(y = unit(c(0, 0), "npc")))
panel$childrenOrder <- c(old_order[1],
setdiff(panel$childrenOrder, old_order),
old_order[2:length(old_order)])
panel
}
These can all be co-ordinated into a single function now to make the whole process much easier:
underplot_axes <- function(p)
{
p_built <- ggplot_build(p)
p_table <- ggplot_gtable(p_built)
p_table <- remove_all_axis_lines(p_table)
p_table$grobs[[grep("panel", p_table$layout$name)]] <-
add_axis_lines_to_panel(get_panel_grob(p_table))
grid::grid.newpage()
grid::grid.draw(p_table)
invisible(p_table)
}
And now you can just call underplot_axes on a ggplot object. I have modified your example a little to create a gray background panel, so that we can see more clearly what's going on:
library(ggplot2)
df <- data.frame(var = "", val = 0)
p <- ggplot(df) +
geom_point(aes(val, var), color = "red", size = 10) +
scale_x_continuous(
expand = c(0, 0),
limits = c(0,1)
) +
coord_cartesian(clip = "off") +
theme_classic() +
theme(panel.background = element_rect(fill = "gray90"))
p
underplot_axes(p)
Created on 2021-05-07 by the reprex package (v0.3.0)
Now, you may consider this "creating fake axes", but I would consider it more as "moving" the axis lines from one place in the grob tree to another. It's a shame that the option doesn't seem to be built into ggplot, but I can also see that it would take a pretty major overhaul of how a ggplot is constructed to allow that option.
Here's a hack that doesn't require going "under the hood", but rather uses patchwork to add another layer on top that is just the geom layer.
a <- [your plot above]
library(patchwork)
a + inset_element(a + them_void(), left = 0, bottom = 0, right = 1, top = 1)

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

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

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

y-axis for each subplot using facet_grid

I can't get the answer to this question to work.
What both me and that user want is to add axis ticks and labels to all columns when using facet_grid().
Display y-axis for each subplot when faceting
When I run the reproducable example and the solution (after adding abc=as.data.frame(abc) to fix the initial error) I receive an error message
Error in gtable_add_grob(g, grobs = list(segmentsGrob(1, 0, 1, 1),
segmentsGrob(1, : Not all inputs have either length 1 or same
length same as 'grobs
I made my own reproducible example because the original one is ehhm, a bit odd :-). It results in the same error message
require(ggplot2)
require(reshape)
require(grid)
require(gtable)
data(iris)
iris$category=rep(letters[1:4],length.out=150)
plot1=ggplot(data=iris,aes(x=1,y=Sepal.Width))+geom_boxplot()+facet_grid(Species~category)
The answer should be this:
g <- ggplotGrob(plot1)
require(gtable)
axis <- gtable_filter(g, "axis-l")[["grobs"]][[1]][["children"]][["axis"]][,2]
segment <- segmentsGrob(1,0,1,1)
panels <- subset(g$layout, name == "panel")
g <- gtable_add_grob(g, grobs=list(axis, axis), name="ticks",
t = unique(panels$t), l=tail(panels$l, -1)-1)
g <- gtable_add_grob(g, grobs=list(segmentsGrob(1,0,1,1),
segmentsGrob(1,0,1,1)),
t = unique(panels$t), l=tail(panels$l, -1)-1,
name="segments")
The answer you refer to does not apply to your situation.
To get nice placement of the tick marks and tick mark labels, I would add columns to the gtable to take the axis material. The new columns have the same width as the original y axis.
You might want to add more margin space between the panels. Do so with theme(panel.margin.x = unit(1, "lines")).
require(ggplot2)
require(grid)
require(gtable)
data(iris)
iris$category = rep(letters[1:4], length.out = 150)
plot1 = ggplot(data = iris, aes(x = 1, y = Sepal.Width))+
geom_boxplot()+
facet_grid(Species~category)
# Get the ggplot grob
g <- ggplotGrob(plot1)
# Get the yaxis
yaxis <- gtable_filter(g, "axis-l")
# Get the width of the y axis
Widths = yaxis$widths
# Add columns to the gtable to the left of the panels,
# with a width equal to yaxis width
panels <- g$layout[grepl("panel", g$layout$name), ]
pos = rev(unique(panels$l)[-1] - 1)
for(i in pos) g = gtable_add_cols(g, Widths, i)
# Add y axes to the new columns
panels <- g$layout[grepl("panel", g$layout$name), ]
posx = rev(unique(panels$l)[-1] - 1)
posy = unique(panels$t)
g = gtable_add_grob(g, rep(list(yaxis), length(posx)),
t = rep(min(posy), length(posx)), b = rep(max(posy), length(posx)), l = posx)
# Draw it
grid.newpage()
grid.draw(g)
Alternatively, place the axis in a viewport of the same width as the original y axis, but with right justification. Then, add the resulting grob to the existing margin columns between the panels, adjusting the width of those columns to suit.
require(ggplot2)
require(grid)
require(gtable)
data(iris)
iris$category = rep(letters[1:4], length.out = 150)
plot1 = ggplot(data = iris, aes(x = 1, y = Sepal.Width))+
geom_boxplot() +
facet_grid(Species ~ category )
# Get the ggplot grob
g <- ggplotGrob(plot1)
# Get the yaxis
axis <- gtable_filter(g, "axis-l")
# Get the width of the y axis
Widths = axis$width
# Place the axis into a viewport,
# of width equal to the original yaxis material,
# and positioned to be right justified
axis$vp = viewport(x = unit(1, "npc"), width = Widths, just = "right")
# Add y axes to the existing margin columns between the panels
panels <- g$layout[grepl("panel", g$layout$name), ]
posx = unique(panels$l)[-1] - 1
posy = unique(panels$t)
g = gtable_add_grob(g, rep(list(axis), length(posx)),
t = rep(min(posy), length(posx)), b = rep(max(posy), length(posx)), l = posx)
# Increase the width of the margin columns
g$widths[posx] <- unit(25, "pt")
# Or increase width of the panel margins in the original construction of plot1
# Draw it
grid.newpage()
grid.draw(g)
This is what I came up (using ggplot2_2.1.0):
g <- ggplotGrob(plot1)
axis <- gtable_filter(g, "axis-l")
newG <- gtable_add_grob(g, list(axis, axis, axis),
t = rep(4, 3), b = rep(8, 3), l = c(5, 7, 9))
grid.draw(newG)
..Which looks like this:
This is the process I went through:
g <- ggplotGrob(plot1) Create a gtable.
print(g) Look over the elements of the gtable...I'm looking for the names of the grobs that I want to mess around with. Here, it is the three grobs called "axis-l".
axis <- gtable_filter(g, "axis-l") I select my three grobs from the larger gtable object, g, and save them in a gtable called axis. Note that gtable_filter is actually selecting the grobs, not filtering them from g.
gtable_show_layout(g) Look over the layout of g so I can figure out where I want to put axis in relationship to the overall plot.
gtable_add_grob, etc. Now that I know where I'm going with it, I can append the original plot with axis.
I think that those steps are a pretty common workflow when it comes to gtable. Of course you'll have other stuff that you may what to mess around with. For example, the space that is given for all but the left-most y axis labels is not sufficient in this case. So maybe just:
newG$widths[c(5, 7, 9)] <- grid:::unit.list(axis$widths) # you won't need to wrap this in grid
grid.draw(newG)

how to make the biplot name more clear using ggbiplot

I have a data which can be download from here
https://gist.github.com/anonymous/5f1135e4f750a39b0255
I try to plot a PCA with ggbiplot using the following function
data <- read.delim("path to the data.txt")
data.pca <- prcomp (data, center = TRUE, scale =TRUE)
library(ggbiplot)
g <- ggbiplot(data.pca, obs.scale =1, var.scale=1, ellipse = TRUE, circle=TRUE)
g <- g + scale_color_discrete(name='')
g <- g + theme(legend.direction = 'horizontal', legend.position = 'top')
print(g)
however, it is very difficult to see the biplot lines names,
is there any way to make it more clear or show it better ?
I think a way to make it clearer is to adjust the size and position of the labels using the varname.sizeand varname.adjust arguments. However, with a lot of variables it still looks crowded. By increasing the length of the arrows (similar to stats::biplot()), makes it look somewhat better (imo)
# install ggbiplot
#require(devtools)
#install_github('ggbiplot','vqv')
library(httr)
library(ggbiplot)
# read data
url <- "https://gist.githubusercontent.com/anonymous/5f1135e4f750a39b0255/raw/data.txt"
dat <- read.table(text=content(GET(url), as="text"), header=TRUE)
# pca
data.pca <- prcomp (dat, center = TRUE, scale =TRUE)
# original plot + increase labels size and space from line
p <- ggbiplot(data.pca, obs.scale=1,
var.scale=1, circle=F,
varname.size=4, varname.adjust=2)
p
# use coord_equal() to change size ratio of plot (excludes use of circle)
p <- p + coord_equal(1.5) + theme_classic()
p
To extend the arrows, the x and y coordinates need to be recalculated. You can then use these to edit the relevant grobs, and change any other parameter (colour, size, rotation etc). (you could go the whole ggplotGrob(p) approach, but just use grid.edit() below.)
# function to rescale the x & y positions of the lines and labels
f <- function(a0, a1, M=M)
{
l <- lapply(as.list(environment()), as.numeric)
out <- M* (l$a1 - l$a0) + l$a0
grid::unit(out, "native")
}
# get list of grobs in current graphics window
grobs <- grid.ls(print=FALSE)
# find segments grob for the arrows
s_id <- grobs$name[grep("segments", grobs$name)]
# edit length and colour of lines
seg <- grid.get(gPath(s_id[2]))
grid.edit(gPath(s_id[2]),
x1=f(seg$x0, seg$x1, 2),
y1=f(seg$y0, seg$y1, 2),
gp=gpar(col="red"))
# find text grob for the arrow labels
lab_id <- grobs$name[grep("text", grobs$name)]
# edit position of text, and rotate and colour labels
seg2 <- grid.get(gPath(lab_id))
grid.edit(gPath(lab_id),
x=f(seg$x0, seg2$x, 2),
y=f(seg$y0, seg2$y, 2),
rot=0,
gp=gpar(col="red"))
Subjective if this makes it better, and perhaps it is easier just to use biplot() or even define a new function

Resources