Related
I have a grob object (in my case it's euler plot) and a ggplot object, and I want to place one on top of another, for example:
library(eulerr)
library(ggplot2)
df <- data.frame(a=sample(100),b=sample(50:149), c=sample(20:119))
venn <- euler(list(
A=df$a,
B=df$b[1:50],
C=df$c
), shape='ellipse')
p_v <- plot(venn, quantities = T, fills=c('red','green','blue'))
p_g <- ggplot(df, aes(x=a,y=b)) + geom_point()
# Now I want somehow to draw p_v on top of p_g
p_g + p_v
Should produce something like this:
I tried using ggplotify for example but couldn't find a way to get rid of white rectangle that was drawn as a canvas for the second plot...
You could use annotation_custom:
p_g + annotation_custom(p_v, xmin = 0, xmax = 50, ymin = 80, ymax = 150)
If you want this to work with log axis scales, you will need to use grid to directly draw p_v over p_g. You will first need to put it in a grobtree so that you can specify its position and dimensions:
p_g <- ggplot(df, aes(x=a,y=b)) + geom_point() + scale_y_log10()
p_g
grid::grid.draw(
grid::grobTree(p_v$children,
vp = grid::viewport(x = unit(0.3, "npc"),
y = unit(0.7, "npc"),
width = unit(0.4, "npc"),
height = unit(0.5, "npc"))))
If you want this as a single R object, you can do:
obj <- grid::grobTree(ggplotGrob(p_g), grid::grobTree(p_v$children,
vp = grid::viewport(x = unit(0.3, "npc"),
y = unit(0.7, "npc"),
width = unit(0.4, "npc"),
height = unit(0.5, "npc"))))
So that obj is now a grob of your whole picture.
One further way to do this would be using geom_grob from package ggpmisc:
library(ggpmisc)
ggplot(df, aes(x=a,y=b)) +
geom_point() +
geom_grob(aes(x = 12.5, y = 100, label = list(p_v$children$canvas.grob)),
vp.width = 0.3, vp.height = 0.4) +
scale_y_log10()
I am trying to recreate the following plsr biplot:
plsr loading plots
plsr code
df.metric <- plsr(y ~ LMA + LDMC + Thick + Carbon + Nitrogen + Tough, scale
= TRUE, validation = "LOO", method = "oscorespls", data = df)
extract fungal taxa loadings
df2<-df.metric$Yloadings
comp1a <- df2[,1]
comp2a <- df2[,2]
namesa <- df2[,0]
df2<-as.data.frame(cbind(namesa,comp1a, comp2a))
extract leaf traits loadings
df1<-df.metric$loadings
comp1 <- df1[,1]
comp2 <- df1[,2]
names <- df1[,0]
df1<-as.data.frame(cbind(names, comp1, comp2))
Generate two plots, one for fungal taxa and one for leaf traits
#generate fungal taxa plot
plot.fungal.taxa<-ggplot(data=df2, aes(comp1a,comp2a))+
ylab("")+
xlab("")+
theme_bw()+
theme(panel.border = element_rect(colour = "black", fill=NA,
size=1),panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"))+
geom_text(aes(label=rownames(df2)), color="red")+
scale_x_continuous(breaks = c(0.10,0.05,0,-0.05,-0.10,-0.15))+
scale_y_continuous(breaks = c(0.10,0.05,0,-0.05,-0.10,-0.15))+
coord_fixed(ylim=c(0.10, -0.15),xlim=c(0.10, -0.15))+
theme(axis.ticks = element_line(colour = "red")) +
theme(axis.text.y=element_text(angle = 90, hjust = 0.65)) +
theme(axis.text.y = element_text(margin=margin(10,10,10,5,"pt")))
#generate leaf traits plot
plot.leaf.traits<-ggplot(data=df1, aes(comp1,comp2))+
ylab("Comp 2")+
xlab("Comp 1")+
theme_bw() +
theme(panel.border = element_rect(colour = "black", fill=NA, size=1),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"))+
geom_text(aes(label=rownames(df1)), color="black")+
scale_x_continuous(breaks = c(-0.8,-0.6,-0.4,-0.2,0,0.2,0.4,0.6))+
scale_y_continuous(breaks = c(-0.8,-0.6,-0.4,-0.2,0,0.2,0.4,0.6))+
coord_fixed(ylim=c(0.6, -0.8),xlim=c(0.6, -0.8))+
theme(axis.ticks = element_line(colour = "black")) +
theme(axis.text.y=element_text(angle = 90, hjust = 0.65)) +
theme(axis.text.y = element_text(margin=margin(10,10,10,5,"pt")))
function to overlay plots
ggplot_dual_axis = function(plot.leaf.traits, plot.fungal.taxa, which.axis =
"x")
{
# Update plot with transparent panel
plot.fungal.taxa = plot.fungal.taxa + theme(panel.background =
element_rect(fill = NA))
grid.newpage()
# Increase right margin if which.axis == "y"
if(which.axis == "y") plot.leaf.traits = plot.leaf.traits +
theme(plot.margin = unit(c(0.7, 1.5, 0.4, 0.4), "cm"))
# Extract gtable
g1 = ggplot_gtable(ggplot_build(plot.leaf.traits))
g2 = ggplot_gtable(ggplot_build(plot.fungal.taxa))
# Overlap the panel of the second plot on that of the first
pp = c(subset(g1$layout, name == "panel", se = t:r))
g = gtable_add_grob(g1, g2$grobs[[which(g2$layout$name=="panel")]], pp$t,
pp$l, pp$b, pp$l)
# Steal axis from second plot and modify
axis.lab = ifelse(which.axis == "x", "axis-b", "axis-l")
ia = which(g2$layout$name == axis.lab)
ga = g2$grobs[[ia]]
ax = ga$children[[2]]
# Switch position of ticks and labels
if(which.axis == "x") ax$heights = rev(ax$heights) else ax$widths =
rev(ax$widths)
ax$grobs = rev(ax$grobs)
if(which.axis == "x")
ax$grobs[[2]]$y = ax$grobs[[2]]$y - unit(1, "npc") + unit(0.15, "cm") else
ax$grobs[[1]]$x = ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15, "cm")
# Modify existing row to be tall enough for axis
if(which.axis == "x") g$heights[[2]] = g$heights[g2$layout[ia,]$t]
# Add new row or column for axis label
if(which.axis == "x") {
g = gtable_add_grob(g, ax, 2, 4, 2, 4)
g = gtable_add_rows(g, g2$heights[1], 1)
g = gtable_add_grob(g, g2$grob[[6]], 2, 4, 2, 4)
} else {
g = gtable_add_cols(g, g2$widths[g2$layout[ia, ]$l], length(g$widths) - 1)
g = gtable_add_grob(g, ax, pp$t, length(g$widths) - 1, pp$b)
g = gtable_add_grob(g, g2$grob[[7]], pp$t, length(g$widths), pp$b - 1)
}
# Draw it
grid.draw(g)
}
Run function on individual plots
ggplot_dual_axis(plot.leaf.traits, plot.fungal.taxa, "y")
this is what I end up getting:
plsr loading plot using ggplot2
My question is how to I get the top x axis to match on top of the plot? Currently it sits on top and adjacent to the plot. I used a previous code I found here (Plotting Partial Least Squares Regression (plsr) biplot with ggplot2). Any help would be amazing!
In the future when you're posting a question, you should try to include a minimal reproducible example. You almost did that, except you didn't include any data to work with.
If you have a question related to code from a particular package, you should be able to grab data that comes with that package or R, just look at the help section for any of the functions. For example, below I just copied and pasted the line in the PLSR package to make an example PLSR model. Alternatively you could have grabbed the table from the post your reference at the end of your question.
The main problem is that the code you're building off of broke when ggplot updated. You can follow that conversation here and here. Below is some code that should work, with the package version numbers noted at the top.
#Make a ggplot object for a Partial Least Squares Regression (PLSR) plot
#####################################################
## Note that this code may break as ggplot updates,##
## as is noted on some of the below posts. ##
#####################################################
#Mostly taken from the posts below
#Links to posts-------------
#https://stackoverflow.com/questions/48664746/how-to-set-two-x-axis-and-two-y-axis-using-ggplot2
#https://stackoverflow.com/questions/39137287/plotting-partial-least-squares-regression-plsr-biplot-with-ggplot2
#https://stackoverflow.com/questions/21026598/ggplot2-adding-secondary-transformed-x-axis-on-top-of-plot
#https://stackoverflow.com/questions/36754891/ggplot2-adding-secondary-y-axis-on-top-of-a-plot/36759348#36759348
#load libraries------
library(pls) #version 2.7.1
library(ggplot2) #version 3.1.0
library(grid) #version 3.5.1
library(gtable) #version 0.2.0
library(cowplot) #version 0.9.3
library(ggplotify) #version 0.0.3
#Read data into PLSR model-----
dens1 <- plsr(density ~ NIR, ncomp = 5, data = yarn)
#Extract information from plsr (AKA mvr) model----
df1<-as.data.frame(dens1$loadings[,1:2])
names(df1) <- c("comp1", "comp2")
df2<-as.data.frame(dens1$scores[,1:2])
names(df2) <- c("comp1a", "comp2a")
#make ggplot objects------
#Plot Loadings - colored red
p1 <- ggplot(data=df1,
aes(x = comp1, y = comp2)) +
geom_text(aes(label = rownames(df1)),
color="red") +
theme_bw() +
theme(panel.border = element_rect(colour = "black",
fill=NA,
size=1),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"),
axis.ticks = element_line(colour = "red"),
axis.text.y = element_text(margin = margin(10,10,10,5,"pt"),
angle = 90,
hjust = 0.65,
colour = "red"),
axis.text.x = element_text(colour = "red")) +
scale_y_continuous(limits = c(min(df1), max(df1))) +
scale_x_continuous(limits = c(min(df1), max(df1)))
#Plot 2 - scores in black
p2 <- ggplot(data=df2,
aes(x = comp1a, y = comp2a)) +
geom_text(aes(label = rownames(df2)),
color="black") +
theme_bw() +
theme(panel.border = element_rect(colour = "black",
fill=NA,
size=1),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"),
axis.ticks = element_line(colour = "black"),
axis.text.y = element_text(margin = margin(10,10,10,5,"pt"),
angle = 90,
hjust = 0.65,
colour = "black"),
axis.text.x = element_text(colour = "black")) +
scale_y_continuous(limits = c(min(df2), max(df2))) +
scale_x_continuous(limits = c(min(df2), max(df2)))
#Final plot----
#Overlay plots in order to get two graphs with different axes on same plot
#rename plots in case you want to make adjustments without regenerating plots
plot1 <- p1
plot2 <- p2
# Update plot with transparent panel
plot2 = plot2 +
theme(panel.background = element_rect(fill = "transparent"))
#clean plot space
grid.newpage()
# Extract gtables from ggplot objects
g1 = ggplot_gtable(ggplot_build(plot1))
g2 = ggplot_gtable(ggplot_build(plot2))
# Get the location of the plot panel in g1.
# These are used later when transformed elements of g2 are put back into g1
pp <- c(subset(g1$layout, name == "panel", se = t:r))
# Overlap panel for second plot on that of the first plot
g1 <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name == "panel")]], pp$t, pp$l, pp$b, pp$l)
#Note from stack overflow post:
# Get the location of the plot panel in g1.
# These are used later when transformed elements of g2 are put back into g1
pp <- c(subset(g1$layout, name == "panel", se = t:r))
# Overlap panel for second plot on that of the first plot
g1 <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name == "panel")]], pp$t, pp$l, pp$b, pp$l)
# Then proceed as before:
# ggplot contains many labels that are themselves complex grob;
# usually a text grob surrounded by margins.
# When moving the grobs from, say, the left to the right of a plot,
# Make sure the margins and the justifications are swapped around.
# The function below does the swapping.
# Taken from the cowplot package:
# https://github.com/wilkelab/cowplot/blob/master/R/switch_axis.R
hinvert_title_grob <- function(grob){
# Swap the widths
widths <- grob$widths
grob$widths[1] <- widths[3]
grob$widths[3] <- widths[1]
grob$vp[[1]]$layout$widths[1] <- widths[3]
grob$vp[[1]]$layout$widths[3] <- widths[1]
# Fix the justification
grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust
grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust
grob$children[[1]]$x <- unit(1, "npc") - grob$children[[1]]$x
grob
}
# Get the y axis title from g2
# Which grob contains the y axis title?
index <- which(g2$layout$name == "ylab-l")
# Extract that grob
ylab <- g2$grobs[[index]]
# Swap margins and fix justifications
ylab <- hinvert_title_grob(ylab)
# Put the transformed label on the right side of g1
g1 <- gtable_add_cols(g1, g2$widths[g2$layout[index, ]$l], pp$r)
g1 <- gtable_add_grob(g1, ylab, pp$t, pp$r + 1, pp$b, pp$r + 1, clip = "off", name = "ylab-r")
# Get the y axis from g2 (axis line, tick marks, and tick mark labels)
# Which grob
index <- which(g2$layout$name == "axis-l")
# Extract the grob
yaxis <- g2$grobs[[index]]
# yaxis is a complex of grobs containing the axis line, the tick marks, and the tick mark labels.
# The relevant grobs are contained in axis$children:
# axis$children[[1]] contains the axis line;
# axis$children[[2]] contains the tick marks and tick mark labels.
# First, move the axis line to the left
yaxis$children[[1]]$x <- unit.c(unit(0, "npc"), unit(0, "npc"))
# Second, swap tick marks and tick mark labels
ticks <- yaxis$children[[2]]
ticks$widths <- rev(ticks$widths)
ticks$grobs <- rev(ticks$grobs)
# Third, move the tick marks
ticks$grobs[[1]]$x <- ticks$grobs[[1]]$x - unit(1, "npc") + unit(1, "mm")
# Fourth, swap margins and fix justifications for the tick mark labels
ticks$grobs[[2]] <- hinvert_title_grob(ticks$grobs[[2]])
# Fifth, put ticks back into yaxis
yaxis$children[[2]] <- ticks
# Put the transformed yaxis on the right side of g1
g1 <- gtable_add_cols(g1, g2$widths[g2$layout[index, ]$l], pp$r)
g1 <- gtable_add_grob(g1, yaxis, pp$t, pp$r + 1, pp$b, pp$r + 1, clip = "off", name = "axis-r")
#Draw it for a dummy check
grid.newpage()
grid.draw(g1)
# function that can vertically invert a title grob, with margins treated properly
# title grobs are used a lot in the new ggplot2 version (>1.0.1)
vinvert_title_grob <- function(grob) {
heights <- grob$heights
grob$heights[1] <- heights[3]
grob$heights[3] <- heights[1]
grob$vp[[1]]$layout$heights[1] <- heights[3]
grob$vp[[1]]$layout$heights[3] <- heights[1]
grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust
grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust
grob$children[[1]]$y <- unit(1, "npc") - grob$children[[1]]$y
grob
}
# Copy title xlab from g2 and swap margins
index <- which(g2$layout$name == "xlab-b")
xlab <- g2$grobs[[index]]
xlab <- vinvert_title_grob(xlab)
# Put xlab at the top of g1
g1 <- gtable_add_rows(g1, g2$heights[g2$layout[index, ]$t], pp$t-1)
g1 <- gtable_add_grob(g1, xlab, pp$t, pp$l, pp$t, pp$r, clip = "off", name="xlab-t")
# Get "feet" axis (axis line, tick marks and tick mark labels) from g2
index <- which(g2$layout$name == "axis-b")
xaxis <- g2$grobs[[index]]
# Move the axis line to the bottom (Not needed in your example)
xaxis$children[[1]]$y <- unit.c(unit(0, "npc"), unit(0, "npc"))
# Swap axis ticks and tick mark labels
ticks <- xaxis$children[[2]]
ticks$heights <- rev(ticks$heights)
ticks$grobs <- rev(ticks$grobs)
# Move tick marks
ticks$grobs[[2]]$y <- ticks$grobs[[2]]$y - unit(1, "npc") + unit(3, "pt")
# Swap tick mark labels' margins
ticks$grobs[[1]] <- vinvert_title_grob(ticks$grobs[[1]])
# Put ticks and tick mark labels back into xaxis
xaxis$children[[2]] <- ticks
# Add axis to top of g1
g1 <- gtable_add_rows(g1, g2$heights[g2$layout[index, ]$t], pp$t)
g1 <- gtable_add_grob(g1, xaxis, pp$t+1, pp$l, pp$t+1, pp$r, clip = "off", name = "axis-t")
#remove title and axes titles if you want
g1 <- gtable_remove_grobs(g1, c("title", "xlab-t", "xlab-b", "ylab-r", "ylab-l"))
# Draw it
grid.newpage()
my_PLS = ggplotify::as.ggplot(g1)
#save plot in square format----
ggsave(paste0("my_PLS_",Sys.Date(),".png"), width = 6, height = 6, units = "in", plot = my_PLS)
Should look like this:
PLSR_ggplot_example
I copied line for line a code from someone on this site on how to overlay two plots with two y axes. However, the example uses two line plots, but I have one line plot and one barplot that I want to overlay. I can't seem to obtain an overlay at all and it just plots the line plot. Please help. Thanks.
library(ggplot2)
library(gtable)
library(grid)
require(ggplot2)
df1 <- data.frame(frax=c(0,30,60,114),solvb=c(0,0,100,100))
df2 <-data.frame(
type = factor(c("mascot","mstat"), levels=c("mascot","mstat")), frax = c(30,35,40,45,50,55), phos=c(542,413,233,500,600,650))
p1<-ggplot(df2,aes(x=frax, y=phos,fill=type)) + geom_bar(stat="identity",position="dodge") + scale_x_continuous("fractions",breaks=seq(1,115,2)) + scale_y_continuous("Phospho hits",breaks=seq(0,1400,250))
p2<-ggplot(df1,aes(x=frax,y=solvb)) + geom_line(colour="blue")
#extract gtable
g1<-ggplot_gtable(ggplot_build(p1))
g2<-ggplot_gtable(ggplot_build(p2))
#overlap the panel of 2nd plot on that of 1st plot
pp <-c(subset(g1$layout, name == "panel", se=t:r))
g<-gtable_add_grob(g1,
g2$grobs[[which(g2$layout$name == "panel")]],
pp$t,pp$l,pp$b,pp$l)
#axis tweaks
alab<-g2$grobs[[which(g2$layout$name=="ylab")]]
ia<-which(g2$layout$name == "axis-l")
ga<-g2$grobs[[ia]]
ax<-ga$children[[2]]
ax$widths<-rev(ax$widths)
ax$grobs<-rev(ax$grobs)
ax$grobs[[1]]$x<-ax$grobs[[1]]$x-unit(1,"npc")+
unit(0.15,"cm")
g<-gtable_add_cols(g,g2$widths[g2$layout[ia,]$l],
length(g$widths)-1)
g<-gtable_add_cols(g, g2$widths[g2$layout[ia,]$l],
length(g$widths)-1)
g<-gtable_add_grob(g,ax,pp$t,length(g$widths) - 2,pp$b)
g<-gtable_add_grob(g,alab,pp$t,length(g$widths) - 1,pp$b)
grid.draw(g)
I would like for the output to look exactly (or very similar) to this: However, I want the barplot "dodged"
This does most of what you want: inward pointing tick marks, combined legends from two plots, overlapping of two plots, and moving the y-axis of one to the right side of the plot.
library(ggplot2) # version 2.2.1
library(gtable) # version 0.2.0
library(grid)
# Your data
df1 <- data.frame(frax = c(16,30,60,64), solvb = c(0,0,100,100))
df2 <- data.frame(type = factor(c("mascot","mstat"), levels = c("mascot","mstat")),
frax = c(30,35,40,45,50,55), phos = c(542,413,233,500,600,650))
# Base plots
p1 <- ggplot(df2, aes(x = frax, y = phos, fill = type)) +
geom_bar(stat = "identity", position = "dodge") +
scale_x_continuous("fractions", expand = c(0,0), limits = c(16, 64),
breaks = seq(20,60,5), labels = seq(20, 60, 5)) +
scale_y_continuous("Phospho hits", breaks = seq(0,1400,250), expand = c(0,0),
limits = c(0, 700)) +
scale_fill_discrete("") +
theme_bw() +
theme(panel.grid = element_blank(),
legend.key = element_rect(colour = "white"),
axis.ticks.length = unit(-1, "mm"), #tick marks inside the panel
axis.text.x = element_text(margin = margin(t = 7, b = 0)), # Adjust the text margins
axis.text.y = element_text(margin = margin(l = 0, r = 7)))
p2 <- ggplot(df1, aes(x = frax, y = solvb)) +
geom_line(aes(linetype = "LC Gradient"), colour = "blue", size = .75) +
scale_x_continuous("fractions", expand = c(0,0), limits = c(16, 64)) +
scale_y_continuous("% Solvent B") +
scale_linetype_manual("", values="longdash") +
theme_bw() +
theme(panel.background = element_rect(fill = "transparent"),
panel.grid = element_blank(),
axis.ticks.length = unit(-1, "mm"),
axis.text.x = element_text(margin = margin(t = 7, b = 0)),
axis.text.y = element_text(margin = margin(l = 0, r = 7)),
legend.key.width = unit(1.5, "cm"), # Widen the key
legend.key = element_rect(colour = "white"))
# Extract gtables
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)
# Get their legends
leg1 = g1$grobs[[which(g1$layout$name == "guide-box")]]
leg2 = g2$grobs[[which(g2$layout$name == "guide-box")]]
# Join them into one legend
leg = cbind(leg1, leg2, size = "first") # leg to be positioned later
# Drop the legends from the two gtables
pos = subset(g1$layout, grepl("guide-box", name), l)
g1 = g1[, -pos$l]
g2 = g2[, -pos$l]
## Code taken from http://stackoverflow.com/questions/36754891/ggplot2-adding-secondary-y-axis-on-top-of-a-plot/36759348#36759348
# to move y axis to right hand side
# Get the location of the plot panel in g1.
# These are used later when transformed elements of g2 are put back into g1
pp <- c(subset(g1$layout, name == "panel", se = t:r))
# Overlap panel for second plot on that of the first plot
g1 <- gtable_add_grob(g1, g2$grobs[[which(g2$layout$name == "panel")]], pp$t, pp$l, pp$b, pp$l)
# ggplot contains many labels that are themselves complex grob;
# usually a text grob surrounded by margins.
# When moving the grobs from, say, the left to the right of a plot,
# Make sure the margins and the justifications are swapped around.
# The function below does the swapping.
# Taken from the cowplot package:
# https://github.com/wilkelab/cowplot/blob/master/R/switch_axis.R
hinvert_title_grob <- function(grob){
# Swap the widths
widths <- grob$widths
grob$widths[1] <- widths[3]
grob$widths[3] <- widths[1]
grob$vp[[1]]$layout$widths[1] <- widths[3]
grob$vp[[1]]$layout$widths[3] <- widths[1]
# Fix the justification
grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust
grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust
grob$children[[1]]$x <- unit(1, "npc") - grob$children[[1]]$x
grob
}
# Get the y axis title from g2
index <- which(g2$layout$name == "ylab-l") # Which grob contains the y axis title?
ylab <- g2$grobs[[index]] # Extract that grob
ylab <- hinvert_title_grob(ylab) # Swap margins and fix justifications
# Put the transformed label on the right side of g1
g1 <- gtable_add_cols(g1, g2$widths[g2$layout[index, ]$l], pp$r)
g1 <- gtable_add_grob(g1, ylab, pp$t, pp$r + 1, pp$b, pp$r + 1, clip = "off", name = "ylab-r")
# Get the y axis from g2 (axis line, tick marks, and tick mark labels)
index <- which(g2$layout$name == "axis-l") # Which grob
yaxis <- g2$grobs[[index]] # Extract the grob
# yaxis is a complex of grobs containing the axis line, the tick marks, and the tick mark labels.
# The relevant grobs are contained in axis$children:
# axis$children[[1]] contains the axis line;
# axis$children[[2]] contains the tick marks and tick mark labels.
# First, move the axis line to the left
yaxis$children[[1]]$x <- unit.c(unit(0, "npc"), unit(0, "npc"))
# Second, swap tick marks and tick mark labels
ticks <- yaxis$children[[2]]
ticks$widths <- rev(ticks$widths)
ticks$grobs <- rev(ticks$grobs)
# Third, move the tick marks
ticks$grobs[[1]]$x <- ticks$grobs[[1]]$x - unit(1, "npc") + unit(-1, "mm")
# Fourth, swap margins and fix justifications for the tick mark labels
ticks$grobs[[2]] <- hinvert_title_grob(ticks$grobs[[2]])
# Fifth, put ticks back into yaxis
yaxis$children[[2]] <- ticks
# Put the transformed yaxis on the right side of g1
g1 <- gtable_add_cols(g1, g2$widths[g2$layout[index, ]$l], pp$r)
g1 <- gtable_add_grob(g1, yaxis, pp$t, pp$r + 1, pp$b, pp$r + 1, clip = "off", name = "axis-r")
# Draw it
grid.newpage()
grid.draw(g1)
# Add the legend in a viewport
vp = viewport(x = 0.3, y = 0.92, height = .2, width = .2)
pushViewport(vp)
grid.draw(leg)
upViewport()
g = grid.grab()
grid.newpage()
grid.draw(g)
Recently, I discovered that starting with version 2.2.0 of ggplot2, it is possible to add a secondary axis. Some demos: here or here; some already answered questions with this approach: here, here or here. An interesting discussion about adding a second OY axis here.
The main idea is that one needs to apply a transformation for the second OY axis. In the example below, the transformation factor is the ratio between the max values of each OY axis.
require(ggplot2)
my_factor <- 650/100
ggplot() +
geom_bar(data = df2,
aes(x = frax, y = phos, fill = type),
stat = "identity",
position = "dodge") +
geom_line(data = df1,
# Apply the factor on values appearing on second OY axis (multiplication)
aes(x = frax, y = solvb * my_factor),
colour = "blue") +
# add second OY axis; note the transformation back (division)
scale_y_continuous(sec.axis = sec_axis(trans = ~ . / my_factor,
name = "% Solvent B")) +
# final adjustments
labs(x = "Fractions",
y = "Phospho hits",
fill = "") +
theme_bw()
I 've updated my R version including all packages and the function arrangeGrob (Package gridExtra) has changed.
On my old version R version 3.1.3 I used it as the following to make corner labels:
loading r packages
library(ggplot2)
library(grid)
library(gridExtra)
example data
a <- 1:20
b <- sample(a, 20)
c <- sample(b, 20)
d <- sample(c, 20)
create a data frame
mydata <- data.frame(a, b, c, d)
create example plots
myplot1 <- ggplot(mydata, aes(x=a, y=b)) + geom_point()
myplot2 <- ggplot(mydata, aes(x=b, y=c)) + geom_point()
myplot3 <- ggplot(mydata, aes(x=c, y=d)) + geom_point()
myplot4 <- ggplot(mydata, aes(x=d, y=a)) + geom_point()
set corner labels
myplot1 <- arrangeGrob(myplot1, main = textGrob("A", x = unit(0, "npc")
, y = unit(1, "npc"), just=c("left","top"),
gp=gpar(col="black", fontsize=18, fontfamily="Times Roman")))
myplot2 <- arrangeGrob(myplot2, main = textGrob("B", x = unit(0, "npc")
, y = unit(1, "npc"), just=c("left","top"),
gp=gpar(col="black", fontsize=18, fontfamily="Times Roman")))
myplot3 <- arrangeGrob(myplot3, main = textGrob("C", x = unit(0, "npc")
, y = unit(1, "npc"), just=c("left","top"),
gp=gpar(col="black", fontsize=18, fontfamily="Times Roman")))
myplot4 <- arrangeGrob(myplot4, main = textGrob("D", x = unit(0, "npc")
, y = unit(1, "npc"), just=c("left","top"),
gp=gpar(col="black", fontsize=18, fontfamily="Times Roman")))
grid.arrange(myplot1, myplot2, myplot3, myplot4)
and I got the following plot, which was fine:
but under the new R version 3.2.2 the image looks like this:
arrangeGrob opens for every textGrob a new image and I got eight images on one page instead of four. How can I fixed it that the plot looks like in the old version of R and gridExtra?
From Kev's comment:
There has been a rewrite of gridExtra, that is not (fully) backward
compatible - may be the issue. Have a look at the new wiki
cran.r-project.org/web/packages/gridExtra/vignettes/… . Try changing
main to top – user20650
I'm interested in trying to create simple corner labels for a multipanel figure I am preparing in ggplot. This is similar to this previously asked question, but the answers only explained how to include a label at the top of the plot, not produce a corner label in the format required by many journals. I hope to replicate something similar to the plotrix function corner.label() in ggplot2.
Here is an example using plottrix of what I would like to recreate in ggplot2.
require(plotrix)
foo1<-rnorm(50,25,5)
foo2<-rpois(50,25)
foo3<-rbinom(50,25,0.5)
foo4<-rnbinom(50,25,0.5)
par(mfrow=c(2,2))
hist(foo1)
corner.label(label='a',figcorner=T)
hist(foo2)
corner.label(label='b',figcorner=T)
hist(foo3)
corner.label(label='c',figcorner=T)
hist(foo4)
corner.label(label='d',figcorner=T)
This produces the following:
Thanks for any help in advance!
Two recent changes have made this a lot easier:
The latest release of ggplot2 has added the tag caption which can be used to label subplots.
The package patchwork makes it really easy to plot multiple ggplot objects. https://github.com/thomasp85/patchwork
This means that no altering of grobs is required. Adapting the reproducible example provided by Kev:
library(ggplot2)
# install.package("patchwork")
library(patchwork)
a <- 1:20
b <- sample(a, 20)
c <- sample(b, 20)
d <- sample(c, 20)
mydata <- data.frame(a, b, c, d)
myplot1 <- ggplot(mydata, aes(x=a, y=b)) + geom_point() + labs(tag = "A")
myplot2 <- ggplot(mydata, aes(x=b, y=c)) + geom_point() + labs(tag = "B")
myplot3 <- ggplot(mydata, aes(x=c, y=d)) + geom_point() + labs(tag = "C")
myplot4 <- ggplot(mydata, aes(x=d, y=a)) + geom_point() + labs(tag = "D")
myplot1 + myplot2 + myplot3 + myplot4
Extension: Changing Style:
If you want to change the labelling style, you can either set this individually for each plot or set a theme default. I would recommend the second approach. Add the following line before you build your plots to make the font bold and blue
ggplot2::theme_update(plot.tag = element_text(face = "bold", colour = "blue"))
For more information on customising the theme of ggplot2, see here.
I had the same problem and came up with the following solution, which is a bit different:
loading r packages
library(ggplot2)
library(grid)
library(gridExtra)
example data
a <- 1:20
b <- sample(a, 20)
c <- sample(b, 20)
d <- sample(c, 20)
create a data frame
mydata <- data.frame(a, b, c, d)
create example plots
myplot1 <- ggplot(mydata, aes(x=a, y=b)) + geom_point()
myplot2 <- ggplot(mydata, aes(x=b, y=c)) + geom_point()
myplot3 <- ggplot(mydata, aes(x=c, y=d)) + geom_point()
myplot4 <- ggplot(mydata, aes(x=d, y=a)) + geom_point()
set corner labels
myplot1 <- arrangeGrob(myplot1, top = textGrob("A", x = unit(0, "npc")
, y = unit(1, "npc"), just=c("left","top"),
gp=gpar(col="black", fontsize=18, fontfamily="Times Roman")))
myplot2 <- arrangeGrob(myplot2, top = textGrob("B", x = unit(0, "npc")
, y = unit(1, "npc"), just=c("left","top"),
gp=gpar(col="black", fontsize=18, fontfamily="Times Roman")))
myplot3 <- arrangeGrob(myplot3, top = textGrob("C", x = unit(0, "npc")
, y = unit(1, "npc"), just=c("left","top"),
gp=gpar(col="black", fontsize=18, fontfamily="Times Roman")))
myplot4 <- arrangeGrob(myplot4, top = textGrob("D", x = unit(0, "npc")
, y = unit(1, "npc"), just=c("left","top"),
gp=gpar(col="black", fontsize=18, fontfamily="Times Roman")))
plotting all plots on one page
grid.arrange(myplot1, myplot2, myplot3, myplot4, ncol = 2)
An example:
d <- data.frame(x = runif(16),
y = runif(16),
grp = rep(letters[1:4],each = 4))
ggplot(d,aes(x = x,y = y)) +
facet_wrap(~grp) +
geom_point() +
theme(strip.text = element_text(hjust = -0.05),
strip.background = element_blank())
Here's a solution using a custom labeller function. This doesn't invovle any manipulations to the data. Currently it only works with 1-dimensional facets (facet_wrap). I'm still working on how to increment along a 2-D grid...
Define the labeller function
make_labelstring <- function(mypanels) {
mylabels <- sapply(mypanels,
function(x) {LETTERS[which(mypanels == x)]})
return(mylabels)
}
label_panels <- ggplot2::as_labeller(make_labelstring)
Pass label_panels as the labeller to facet_wrap
library(ggplot2)
data("diamonds")
# create a faceted plot
ggplot(data = diamonds, aes(x = depth, y = price)) +
geom_point() +
facet_wrap(~cut, labeller = label_panels) +
theme(strip.text = element_text(hjust = -0),
strip.background = element_blank())