Hello everyone and happy new year !!! I would need help in order to improve a ggplot figure.
df1 <- structure(list(x = structure(c(1L, 2L, 3L, 4L, 1L, 2L, 3L, 4L,
1L, 2L, 3L, 4L, 1L, 2L, 3L, 4L), .Label = c("a", "b", "c", "d"
), class = "factor"), y = c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 3L,
3L, 3L, 3L, 4L, 4L, 4L, 4L), z = c(-0.130312994048691, 0.714073455094197,
-0.156691533710652, 0.39894708481517, 0.644656691110372, -1.18694632145378,
-0.257204564112021, 1.34927378214664, -1.03584454605617, 0.148408762003154,
0.501192202628166, 0.511688097742773, -0.947953281835912, 0.0861048893885463,
1.55144239199118, 0.20220333664676)), class = "data.frame", row.names = c(NA,
-16L))
library(ggplot2)
df1$facet <- ifelse(df1$x %in% c("c", "d"), "cd", df1$x)
p1 <- ggplot(df1, aes(x = x, y = y))
p1 <- p1 + geom_tile(aes(fill = z), colour = "grey20")
p1 <- p1 + scale_fill_gradient2(
low = "darkgreen",
mid = "white",
high = "darkred",
breaks = c(min(df1$z), max(df1$z)),
labels = c("Low", "High")
)
p1 + facet_grid(.~facet, space = "free", scales = "free_x") +
theme(strip.text.x = element_blank())
With this code (inspired from here) I get this figure:
But I wondered if someone had an idea in order to :
To add sub Y axis element (here noted as Element 1-3) where Element1 (first box); Element2 (2 and 3 box) and Element3 (4 box)
the result should be something like:
This is not easy! As usual with plot annotation, there are basically three main options.
annotate outside the plot area with clipping turned off.
create plots and paste them together
mess with the grobs.
In my plots, I've decided to replace your scale_fill call with something simpler.
Here option 1:
library(tidyverse)
df1$facet <- fct_collapse(df1$x, cd = c("c", "d")) # slightly changed
# Create data frames for segments and labels
yseg <- c(.5, 1.5, 3.5, 4.5)
df_txt <- data.frame(x = -0.75, y = c(1, 2.5, 4),
label = paste0("element", 1:3), facet = "a")
df_seg <- data.frame(x = 0.5, xend = -1.5, y = yseg, facet = "a")
ggplot(df1, aes(x = x, y = y)) +
geom_tile(aes(fill = z), colour = "grey20") +
scale_fill_distiller(palette = "RdBu") +
scale_x_discrete(expand = c(0, 0)) + # kind of necessary
facet_grid(.~facet, scales = "free_x", space = "free") +
geom_segment(data = df_seg,
aes(x = x, xend = xend, y = yseg,yend = yseg), lty = "dashed",
color = "black") +
geom_text(data = df_txt, aes(x = x, y = y, label = label), hjust = 0.5) +
coord_cartesian(xlim = c(0.5, NA), clip = "off") + # this is how you turn clipping off
theme(strip.text.x = element_blank(),
plot.margin = margin(l = 2, unit = "inch"))
Another option is to make 3 different plots - arguably less hacky. Well. I still think it's hacky.
library(patchwork)
# create three plots. You could obviously also create four plots.
p_right <-
ggplot(filter(df1, x != "a"), aes(x = x, y = y)) +
geom_tile(aes(fill = z), colour = "grey20") +
scale_x_discrete(expand = c(0, 0)) +
scale_fill_distiller(palette = "RdBu", limits = c(-1, 1.5)) + # You need to set the same scale limits
facet_grid(.~facet, scales = "free_x", space = "free") +
theme(axis.title.y = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
plot.margin = margin(),
panel.spacing = unit(0.5, "lines")
)
p_left <-
ggplot(filter(df1, x == "a"), aes(x = x, y = y)) +
geom_tile(aes(fill = z), colour = "grey20") +
scale_x_discrete(expand = c(0, 0)) +
scale_fill_distiller(palette = "RdBu", limits = c(-1, 1.5)) + # You need to set the same scale limits
facet_grid(.~facet, scales = "free_x", space = "free") +
theme(plot.margin = margin(r = 0.4, unit = "lines"),
axis.title.y = element_text(margin = margin()))
p_seg <-
ggplot() +
geom_segment(data = df_seg,
aes(x = x, xend = xend, y = yseg,yend = yseg), lty = "dashed",
color = "black") +
scale_x_discrete(expand = c(0, 0)) +
geom_text(data = df_txt, aes(x = x, y = y, label = label), hjust = 0.5) +
theme_void() # important short cut to get rid of "everything but... "
p_seg + p_left + p_right +
plot_layout(nrow = 1, guides = "collect",
widths = c(2, 1, 3)) &
# the theme call in patchwork sets theme options globally, for all plots.
theme(strip.text.x = element_blank(),
axis.title.x = element_blank())
There is now a gap between segments and plots, so not quite the expected result, but visually fairly close. Also it requires (too much?) trial and error with the right margins / relative plot widths to get everything to look nice... On the other hand, this option probably gives you the biggest flexibility and you don't need to worry too much of the effects of scale expansion. So I personally would prefer the option. Would probably create four separate plots for full control of the gaps.
The last option would be to mess with the grobs, which I admit I am not very good at, so I will leave it with those two options. Hope this helped.
Related
This question already has answers here:
How can I make a discontinuous axis in R with ggplot2?
(3 answers)
Force the origin to start at 0
(4 answers)
Closed last year.
I am still working on finalizing a reproducible figure for publication. Reviewers would like to see the below plot's y-axis start at 0 and include line break "//". The y-axis will need to not only be pretty large (think, 1500 units) but also zoomed in pretty tightly (think, 300 units). This makes the reviewer want us to add a line break to denote that our axis starts at 0, but continues on.
Example of what I can create:
Example of what I want (note the y axis; this was done manually in powerpoint in a similar figure):
My code:
ggplot(data = quad2,
aes(x, predicted, group = group)) +
geom_point(aes(shape = group), size = 6) +
scale_shape_manual(values=c(19, 1)) +
geom_line(size = 2,
aes(linetype = group),
color = "black") +
scale_linetype_manual(values = c("solid", "dashed")) +
geom_linerange(size = 1,
aes(ymin = predicted - conf.low,
ymax = predicted + conf.high),
color = "black",
alpha = .8) +
geom_segment(aes(xend = x,
yend = ifelse(group == "Control", conf.high, conf.low)),
arrow = arrow(angle = 90), color = "red")+
labs(x = "Time",
y = expression(bold("QUAD Volume (cm"^"3"*")")),
linetype = "",
shape = "") + #Legend title
scale_y_continuous(limits =c(1500, 2000))
Reproducible data:
dput(quad2)
structure(list(x = structure(c(1L, 1L, 2L, 2L, 3L, 3L, 4L, 4L,
5L, 5L), .Label = c("PRE", "MID1", "MID2", "MID3", "POST"), class = "factor"),
predicted = c(1666.97185871754, 1660.27445165342, 1743.2831065274,
1678.48945165342, 1788.50605542978, 1637.40907049806, 1807.55826371403,
1639.78265640012, 1865.8766220711, 1652.91070173056), std.error = c(88.8033117577884,
91.257045996107, 92.9973963841595, 95.3834973421298, 95.0283457128716,
97.3739053806999, 95.6466346849776, 97.9142418717957, 93.3512943191676,
95.5735155125126), conf.low = c(0, 91.257045996107, 0, 95.3834973421298,
0, 97.3739053806999, 0, 97.9142418717957, 0, 95.5735155125126
), conf.high = c(88.8033117577884, 0, 92.9973963841595, 0,
95.0283457128716, 0, 95.6466346849776, 0, 93.3512943191676,
0), group = structure(c(1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L,
2L), .Label = c("Intervention", "Control"), class = "factor")), class = "data.frame", row.names = c(NA,
-10L))
Plotting discontinuous axis is made difficult for a reason, that reason being that you should avoid doing it whenever possible. While I disagree with your reviewers, you can get down and dirty with the underlying grid graphics if you truly want a y-axis break.
First make your plot. The only thing I added was y-axis formatting and an axis line theme. We'll just label the bottom tick with "0".
plt <- ggplot(data = quad2,
aes(x, predicted, group = group)) +
geom_point(aes(shape = group), size = 6) +
scale_shape_manual(values=c(19, 1)) +
geom_line(size = 2,
aes(linetype = group),
color = "black") +
scale_linetype_manual(values = c("solid", "dashed")) +
geom_linerange(size = 1,
aes(ymin = predicted - conf.low,
ymax = predicted + conf.high),
color = "black",
alpha = .8) +
geom_segment(aes(xend = x,
yend = ifelse(group == "Control", conf.high, conf.low)),
arrow = arrow(angle = 90), color = "red")+
labs(x = "Time",
y = expression(bold("QUAD Volume (cm"^"3"*")")),
linetype = "",
shape = "") + #Legend title
scale_y_continuous(limits =c(1400, 2000),
breaks = seq(1400, 2000, by = 200),
labels = c(0, seq(1600, 2000, by = 200)),
expand = c(0,0,0.05,0)) +
theme(axis.line = element_line())
Then, we'll make this into a gtable and grab the y-axis line:
gt <- ggplotGrob(plt)
is_yaxis <- which(gt$layout$name == "axis-l")
yaxis <- gt$grobs[[is_yaxis]]
# You should grab the polyline child
yline <- yaxis$children[[1]]
Now we can edit the line as we see fit:
yline$x <- unit(rep(1, 4), "npc")
yline$y <- unit(c(0, 0.1, 1, 0.15), "npc")
yline$id <- c(1, 1, 2, 2)
yline$arrow <- arrow(angle = 90)
Place it back into the gtable object and plot it:
yaxis$children[[1]] <- yline
gt$grobs[[is_yaxis]] <- yaxis
# grid plotting syntax
grid.newpage(); grid.draw(gt)
You can make stylistic choices at the line editing step as you see fit.
To my knowledge ggplot2 doesn't support axis breaks. There is a solution here with facet_grid.
Here is my raw data.
v <-
structure(list(Estimate = c(0.233244696051868, 5.48753303603373,
1.95671969454631, 3.16568487759413, 4.79631204302344, 2.10818637730716,
0.329940200056173, 0.055145498993132, 0.222410032790494), `Std. Error` = c(1.10523192028695,
2.75434167314693, 2.52507525836928, 0.964768253150336, 1.73374160980673,
0.852388938087655, 0.736511882227423, 0.326506324068342, 1.26750100880987
), ID = structure(c(1L, 3L, 2L, 4L, 8L, 5L, 6L, 7L, 9L), .Label = c("CD",
"MFS2", "MFS", "Crop.Nb", "CD:SNC", "MFS:SNC", "CD:MFS", "SNC",
"SNC2"), class = "factor"), group = structure(c(1L, 1L, 1L, 1L,
3L, 2L, 2L, 2L, 3L), .Label = c("crop", "inter", "semi"), class = "factor"),
ES = c(-0.233244696051868, -5.48753303603373, 1.95671969454631,
3.16568487759413, 4.79631204302344, 2.10818637730716, 0.329940200056173,
0.055145498993132, 0.222410032790494)), class = "data.frame", row.names = c(NA,
-9L))
I want to plot 2 images as below:
p1 <- v %>% ggplot(aes(x = factor(ID), y = ES, color = factor(group))) +
geom_hline(yintercept = 0) +
geom_errorbar(aes(ymin = ES - `Std. Error`,ymax = ES + `Std. Error`),
width = 0, lwd = 1.5
)+
coord_flip()+
geom_text(aes(label = ID), nudge_y = .6,nudge_x = .2)+
geom_point(size = 4)+
scale_color_discrete()+
theme(axis.text.y = element_blank()) +
xlab('') + guides(color = FALSE)
(p2 <- arrange(v,desc(group)) %>% ggplot(aes(x = '1', y =Estimate, fill = group )) +
#geom_bar(position = 'fill', stat = 'identity') +
geom_col(position = position_fill(reverse = TRUE)) +
scale_y_continuous(labels = scales::percent, name = "Variance explained")+
theme(legend.position = 'none', axis.title.x = element_blank(), axis.text.x = element_blank()) )
Now I want to combine p2 and p1: I get:
cowplot::plot_grid(p2,p1,nrow = 1, rel_widths = c(0.2,1))
But what I want to achieve the effect as below:
Panel A : I wish the distance between p1 and p2 is less narrow; And red area only has red bars; Green area only has green bars; I wish you can help me to achieve the draft of panel B as below:
To ensure proper alignment, it might be neater to have both parts in the same plot. Also, I don't quite see the need to flip your coordinates here, so I went with a simpler version:
v %>%
# calculate y-axis positions within [0%, 100%] range
arrange(group) %>%
mutate(y = seq(0.5, by = 1, length.out = n())) %>%
mutate(y = y / ceiling(max(y))) %>%
ggplot(aes(y = y, x = ES, label = ID, color = group,
xmin = ES - `Std. Error`, xmax = ES + `Std. Error`)) +
geom_vline(xintercept = 0) +
geom_pointrange(lwd = 1.5, fatten = 2) + # instead of flipped errorbar with 0 width + point
geom_text(nudge_y = 0.05) +
geom_bar(aes(x = -10, fill = group), # change this to shift the bar closer / further away
position = position_fill(reverse = TRUE),
inherit.aes = FALSE) +
scale_y_continuous(name = "Variance explained", labels = scales::percent) +
# actually not necessary to have this line for default palette, but in case
# you want to change that, the `aesthetics = c("colour", "fill")` line saves you from
# having to specify the same palette twice in both colour & fill scales.
scale_color_discrete(aesthetics = c("colour", "fill")) +
theme_minimal() + # or whatever theme you need
theme(legend.position = "none")
I'm trying to replicate the theme of these graph using ggplot, I searched online for articles and question to show me how to assign these plots the right size and position and also to assign the tight dot shape, and I found few articles that discussed changing position, I tried the following:
d1<-read.csv("./data/games.csv")
p.1<-ggplot(d1, aes(x=cream_rating, y=charcoal_rating)) +
# Map winner on color. Add some transparency in case of overplotting
geom_point(aes(color = winner), alpha = 0.2) +
# Add the cross: Add geom_pints with one variable fixed on its mean
geom_point(aes(x = mean(cream_rating), color = winner), alpha = 0.2) +
geom_point(aes(y = mean(charcoal_rating), color = winner), alpha = 0.2) +
scale_shape_manual(values=c(16, 17)) +
# "draw"s should be dropped and removed from the title
scale_color_manual(values = c(cream = "seagreen4", charcoal = "chocolate3", draw = NA)) +
ggtitle("Rating of Cream vs Charcoal") +
xlab("rating of cream") + ylab("rating of charcoal") + theme_classic() + theme(plot.title = element_text(hjust = 0.5))
I tried the following to place them together:
require(gridExtra)
plot.1<-p.1
plot.2<-ggExtra::ggMarginal(p.1, type = "histogram")
grid.arrange(plot.1, plot.2, ncol=3)
library(cowplot)
theme_set(theme_cowplot())
plot.1<-p.1
plot.2<-ggExtra::ggMarginal(p.1, type = "histogram")
plot_grid(plot.1, plot.2, labels = "AUTO")
cowplot::plot_grid(plot.1, plot.2, labels = "AUTO")
library(magrittr)
library(multipanelfigure)
figure1 <- multi_panel_figure(columns = 2, rows = 1, panel_label_type = "none")
# show the layout
figure1
figure1 %<>%
fill_panel(plot.1, column = 1, row = 1) %<>%
fill_panel(plot.2, column = 2, row = 1) %<>%
figure1
This is my data set structure:
structure(list(rated = c(FALSE, TRUE, TRUE, TRUE, TRUE, FALSE,
TRUE, FALSE, TRUE, TRUE), turns = c(13L, 16L, 61L, 61L, 95L,
5L, 33L, 9L, 66L, 119L), victory_status = structure(c(3L, 4L,
2L, 2L, 2L, 1L, 4L, 4L, 4L, 2L), .Label = c("draw", "mate", "outoftime",
"resign"), class = "factor"), winner = structure(c(2L, 1L, 2L,
2L, 2L, 3L, 2L, 1L, 1L, 2L), .Label = c("charcoal", "cream",
"draw"), class = "factor"), increment_code = structure(c(3L,
7L, 7L, 5L, 6L, 1L, 1L, 4L, 2L, 1L), .Label = c("10+0", "15+0",
"15+2", "15+30", "20+0", "30+3", "5+10"), class = "factor"),
cream_rating = c(1500L, 1322L, 1496L, 1439L, 1523L, 1250L,
1520L, 1413L, 1439L, 1381L), charcoal_rating = c(1191L, 1261L,
1500L, 1454L, 1469L, 1002L, 1423L, 2108L, 1392L, 1209L)), row.names = c(NA,
10L), class = "data.frame")
This is what I want to achieve:
I tried Stefan's suggestion (which was great help) with some modifications:
d1<-read.csv("./data/games.csv")
ggplot(d1, aes(x=cream_rating, y=charcoal_rating)) +
##### Map winner on color. Add some transparency in case of overplotting
geom_point(aes(color = winner), alpha = 0.2) +
##### Add the cross: Add geom_pints with one variable fixed on its mean
geom_point(aes(x = mean(cream_rating), color = winner), alpha = 0.2) +
geom_point(aes(y = mean(charcoal_rating), color = winner), alpha = 0.2) +
scale_shape_manual(values=c(16, 17)) +
##### "draw"s should be dropped and removed from the title
scale_color_manual(values = c(cream = "seagreen4", charcoal = "chocolate3", draw = NA)) +
ggtitle("Rating of Cream vs Charcoal") +
xlab("rating of cream") + ylab("rating of charcoal") + theme_bw() + theme(plot.title = element_text(hjust = 0.5))
I want to filter out "draw" from the plot, also when I change the dot shapes to triangles and circle, they don't seem to be changing, in addition I get this error:
Warning message:
“Removed 950 rows containing missing values (geom_point).”
Warning message:
“Removed 950 rows containing missing values (geom_point).”
Warning message:
“Removed 950 rows containing missing values (geom_point).”
One more thing that I noticed, I get double cross instead of one!
This is my output:
When I try the first code block in this question, I get long distorted figures not square next to each other.
Maybe this fits your need. To glue the three plots together I make use of the cowplot package. The legend is probably still not perfect.
To get only one legend but still a nice alignment of the plots I made the legends for the first and the third plot "transparent" vis guide_legend and theme options
To make all plots the same size I added transparent marginals to the scatter plot
To fix the position and make the plots square I set the same limits for both axes via xlim and ylim and set the aspect ratio to 1 using theme()
library(ggplot2)
library(dplyr)
library(cowplot)
# Add a second draw to the example data to make the density work
d1 <- d1 %>%
add_row(winner = "draw", cream_rating = 1002, charcoal_rating = 1250)
# Get the limits
lims <- c(floor(min(d1$cream_rating, d1$charcoal_rating)), ceiling(max(d1$cream_rating, d1$charcoal_rating)))
p1 <- d1 %>%
ggplot(aes(x=cream_rating, y=charcoal_rating, color = winner, shape = winner)) +
geom_point(alpha = 0.2, na.rm = TRUE) +
scale_color_manual(values = c(cream = "seagreen4", charcoal = "chocolate3", draw = "blue")) +
scale_shape_manual(values = c(cream = 16, charcoal = 17, draw = 15)) +
xlim(lims) +
ylim(lims) +
labs(x = "rating of cream", y = "rating of charcoal") +
theme_classic() +
theme(plot.title = element_text(hjust = 0.5), legend.position = "bottom") +
theme(aspect.ratio = 1)
p1_1 <- p1 +
guides(color = guide_legend(override.aes = list(color = c(NA, NA, NA)))) +
theme(legend.text = element_blank(), legend.title = element_blank())
p1_1 <- ggExtra::ggMarginal(p1_1, type = "histogram",
margins = 'both',
size = 5,
position = "identity",
color = NA,
fill= NA)
p2 <- ggExtra::ggMarginal(p1, type = "histogram",
margins = 'both',
size = 5,
groupColour = TRUE,
groupFill = TRUE,
position = "identity"
)
# Make legend transparent
p1 <- p1 +
guides(color = guide_legend(override.aes = list(color = c(NA, NA, NA)))) +
theme(legend.text = element_blank(), legend.title = element_blank())
p3 <- d1 %>%
ggplot(aes(x=cream_rating, y=charcoal_rating, color = winner, shape = winner)) +
geom_density_2d(na.rm = TRUE) +
geom_point(alpha = 0, show.legend = FALSE) +
scale_color_manual(values = c(cream = "seagreen4", charcoal = "chocolate3", draw = "blue")) +
xlim(lims) +
ylim(lims) +
labs(x = "rating of cream", y = "rating of charcoal") +
theme_classic() +
theme(plot.title = element_text(hjust = 0.5),
legend.position = "bottom") +
theme(aspect.ratio = 1)
# Make legend transparent
p3 <- p3 +
guides(color = guide_legend(override.aes = list(color = c(NA, NA, NA)))) +
theme(legend.text = element_blank(), legend.title = element_blank())
p3 <- ggExtra::ggMarginal(p3, d1, type = "density",
margins = 'both',
size = 5,
groupColour = TRUE,
groupFill = TRUE,
position = "identity"
)
plot_row <- plot_grid(p1_1, p2, p3, nrow = 1)
# now add the title
title <- ggdraw() +
draw_label(
"Rating of Cream vs Charcoal",
fontface = 'bold',
x = 0,
hjust = 0
)
final <- plot_grid(
title, plot_row,
ncol = 1,
# rel_heights values control vertical title margins
rel_heights = c(0.1, 1)
)
final
Note Depending on the width and heigth of your plotting device, fixing the aspect ratio adds some white space at the top and bottom. Depending on your final output you probably have to play a bit around with the width and height (and scale), e.g. using
ggsave("final.png", width = 18, height = 6, units = "cm", scale = 1.5)
gives
Here is some example data:
exampledata <- structure(list(x = c(2.93131952459005, 3.21275054434318, 1.36466997175509,
2.13626543532502, 1.45889556823722, 1.94598707699052, 0.719062322132357,
2.38139571953234, 2.37813367615963, 3.98126576880209), y = c(7.51581380181603,
9.77495763943671, 8.9666894018554, 8.62675858853528, 7.89238665417542,
9.84865061237773, 7.24526820962333, 7.64727218939944, 7.28026738945878,
8.6913070524479), z = structure(c(1L, 1L, 1L, 2L, 2L, 2L, 2L,
3L, 3L, 3L), .Label = c("a", "b", "c"), class = "factor"), z2 = structure(c(1L,
1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L), .Label = c("cat", "dog"), class = "factor")), class = "data.frame", row.names = c(NA,
-10L))
The plot of that data:
asdf <- ggplot(exampledata, aes(x = x, y = y, color = z, shape = z)) +
geom_point() +
geom_line(aes(color = z, linetype = z2))+
scale_linetype_manual(values = c(1,2,3)) +
theme(legend.position = 'top',
legend.spacing = unit(2, 'cm'))
This code below just increases the size of points within the z component of the legend (independently of the lines in z or actual points in the figure). The output of this is a gTree object. Although this section might seem arbitrary, it is an important step for the final plots
grid::grid.ls(grid::grid.force())
# Set the size of the point in the legend to 2 mm
grid::grid.gedit("key-1-[-0-9]+-1.2-[-0-9]+-2-[-0-9]+", size = unit(4, "mm"))
# save the modified plot to an object
g2 <- grid::grid.grab()
ggsave(g2, filename = 'g2.tiff')
Now imagine a scatter plot of the following dataframe:
datasetb <- structure(list(x = c(2.55279478309192, 0.929375129220925, 1.56509894419863,
2.48026699500513, 1.18018131012236, 1.79675395182943, 0.817046700547386,
1.99710482619256, 2.18780091987683, 3.41661353718804), y = c(8.88460717718884,
9.11053089978428, 7.68492406933585, 8.23110925234432, 7.48154953916593,
9.0253526297593, 9.41899905471655, 8.54779428609509, 9.17050925351926,
5.83078691211861)), class = "data.frame", row.names = c(NA, -10L
))
b <- ggplot(data = datasetb, aes(x = x, y = y) +
geom_point()
I want to be able to use plot_grid to combine these plots into one. However I don't think a gTree can be used as an argument to get_legend. Is there any way to convert a gTree back into a ggplot object, or any workaround
Below is my end goal.
prow <- plot_grid( asdf + theme(legend.position="none"),
b + theme(legend.position="none"),
align = 'vh',
labels = c("A", "B"),
hjust = -1,
nrow = 1
)
legend_a <- get_legend(asdf + theme(legend.position="top"))
p <- plot_grid( legend_a, prow, ncol = 1, rel_heights = c(.2, 1))
tiff("BothPlots.tiff", units = 'in', width = 12, height = 7, res = 400)
p
dev.off()
The short answer is no. A ggplot is like a recipe. The gTree is like the cake that the recipe produces. You can't unbake a cake to get the recipe back.
However, the answer here is that, instead of modifying the legend then extracting it and stitching the plot together, you can stitch the plot together then modify the legend. So if you do things in this order:
asdf <- ggplot(exampledata, aes(x = x, y = y, color = z, shape = z)) +
geom_point() +
geom_line(aes(color = z, linetype = z2)) +
scale_linetype_manual(values = c(1, 2, 3)) +
theme(legend.position = 'top', legend.spacing = unit(2, 'cm'))
b <- ggplot(data = datasetb, aes(x = x, y = y)) + geom_point()
prow <- plot_grid(asdf + theme(legend.position="none"),
b + theme(legend.position="none"),
align = 'vh',
labels = c("A", "B"),
hjust = -1,
nrow = 1)
legend_a <- get_legend(asdf + theme(legend.position = "top"))
plot_grid(legend_a, prow, ncol = 1, rel_heights = c(.2, 1))
grid.ls(grid::grid.force())
grid.gedit("key-1-[-0-9]+-1.2-[-0-9]+-2-[-0-9]+", size = unit(4, "mm"))
# save the modified plot to an object
g2 <- grid::grid.grab()
Now we can save (I've had to save as a small png to allow upload here):
png("BothPlots.png", units = 'in', width = 6, height = 3.5, res = 200)
grid::grid.draw(g2)
dev.off()
You get:
BothPlots.png
This question already has answers here:
How can I make a discontinuous axis in R with ggplot2?
(3 answers)
Force the origin to start at 0
(4 answers)
Closed last year.
I am still working on finalizing a reproducible figure for publication. Reviewers would like to see the below plot's y-axis start at 0 and include line break "//". The y-axis will need to not only be pretty large (think, 1500 units) but also zoomed in pretty tightly (think, 300 units). This makes the reviewer want us to add a line break to denote that our axis starts at 0, but continues on.
Example of what I can create:
Example of what I want (note the y axis; this was done manually in powerpoint in a similar figure):
My code:
ggplot(data = quad2,
aes(x, predicted, group = group)) +
geom_point(aes(shape = group), size = 6) +
scale_shape_manual(values=c(19, 1)) +
geom_line(size = 2,
aes(linetype = group),
color = "black") +
scale_linetype_manual(values = c("solid", "dashed")) +
geom_linerange(size = 1,
aes(ymin = predicted - conf.low,
ymax = predicted + conf.high),
color = "black",
alpha = .8) +
geom_segment(aes(xend = x,
yend = ifelse(group == "Control", conf.high, conf.low)),
arrow = arrow(angle = 90), color = "red")+
labs(x = "Time",
y = expression(bold("QUAD Volume (cm"^"3"*")")),
linetype = "",
shape = "") + #Legend title
scale_y_continuous(limits =c(1500, 2000))
Reproducible data:
dput(quad2)
structure(list(x = structure(c(1L, 1L, 2L, 2L, 3L, 3L, 4L, 4L,
5L, 5L), .Label = c("PRE", "MID1", "MID2", "MID3", "POST"), class = "factor"),
predicted = c(1666.97185871754, 1660.27445165342, 1743.2831065274,
1678.48945165342, 1788.50605542978, 1637.40907049806, 1807.55826371403,
1639.78265640012, 1865.8766220711, 1652.91070173056), std.error = c(88.8033117577884,
91.257045996107, 92.9973963841595, 95.3834973421298, 95.0283457128716,
97.3739053806999, 95.6466346849776, 97.9142418717957, 93.3512943191676,
95.5735155125126), conf.low = c(0, 91.257045996107, 0, 95.3834973421298,
0, 97.3739053806999, 0, 97.9142418717957, 0, 95.5735155125126
), conf.high = c(88.8033117577884, 0, 92.9973963841595, 0,
95.0283457128716, 0, 95.6466346849776, 0, 93.3512943191676,
0), group = structure(c(1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L,
2L), .Label = c("Intervention", "Control"), class = "factor")), class = "data.frame", row.names = c(NA,
-10L))
Plotting discontinuous axis is made difficult for a reason, that reason being that you should avoid doing it whenever possible. While I disagree with your reviewers, you can get down and dirty with the underlying grid graphics if you truly want a y-axis break.
First make your plot. The only thing I added was y-axis formatting and an axis line theme. We'll just label the bottom tick with "0".
plt <- ggplot(data = quad2,
aes(x, predicted, group = group)) +
geom_point(aes(shape = group), size = 6) +
scale_shape_manual(values=c(19, 1)) +
geom_line(size = 2,
aes(linetype = group),
color = "black") +
scale_linetype_manual(values = c("solid", "dashed")) +
geom_linerange(size = 1,
aes(ymin = predicted - conf.low,
ymax = predicted + conf.high),
color = "black",
alpha = .8) +
geom_segment(aes(xend = x,
yend = ifelse(group == "Control", conf.high, conf.low)),
arrow = arrow(angle = 90), color = "red")+
labs(x = "Time",
y = expression(bold("QUAD Volume (cm"^"3"*")")),
linetype = "",
shape = "") + #Legend title
scale_y_continuous(limits =c(1400, 2000),
breaks = seq(1400, 2000, by = 200),
labels = c(0, seq(1600, 2000, by = 200)),
expand = c(0,0,0.05,0)) +
theme(axis.line = element_line())
Then, we'll make this into a gtable and grab the y-axis line:
gt <- ggplotGrob(plt)
is_yaxis <- which(gt$layout$name == "axis-l")
yaxis <- gt$grobs[[is_yaxis]]
# You should grab the polyline child
yline <- yaxis$children[[1]]
Now we can edit the line as we see fit:
yline$x <- unit(rep(1, 4), "npc")
yline$y <- unit(c(0, 0.1, 1, 0.15), "npc")
yline$id <- c(1, 1, 2, 2)
yline$arrow <- arrow(angle = 90)
Place it back into the gtable object and plot it:
yaxis$children[[1]] <- yline
gt$grobs[[is_yaxis]] <- yaxis
# grid plotting syntax
grid.newpage(); grid.draw(gt)
You can make stylistic choices at the line editing step as you see fit.
To my knowledge ggplot2 doesn't support axis breaks. There is a solution here with facet_grid.