How to make gap in the x axis using ggplot2 - r

I made a plot for presenting OR ratio. However, OR for log(PTH) has a large 95CI. Can I make a gap into x axis between 20 and 30, making other variables more visible? Some, examples suggest gap_plot(), but I do not know how to combine it with this type of graph.
I already transform PTH value, so it will be hard to change it regarding interpretation. If you have some other way to do it, feel free to suggest. I would like to make values of all variables visible. However, this vales of lof(PTH) makes Pol hard to interpret from the plot, despite being significant.
Best,
A.
library(gridExtra)
library(ggplot2)
Nezavisna<-c("Pol","Starost","Ca","P","log(PTH)","log(mg)","BrojZlezda","MIBI","Iskustvo","Pridruzena")
OR<-c(0.399,1.023,0.814,0.568,14.14,0.417,2.193,0.709,1.468,1.445)
LL<-c(0.174,0.996,0.277,0.122,4.969,0.197,1.019,0.339,0.754,0.702)
UL<-c(0.917,1.052,2.396,2.649,40.238,0.882,4.722,1.483,2.859,2.976)
istrazivanje<-data.frame(Nezavisna,OR,LL,UL)
istrazivanje
ggplot(istrazivanje, aes(y = Nezavisna, x = OR)) +geom_point(shape = 18, size = 5) + geom_errorbarh(aes(xmin = LL, xmax = UL), height = 0.25) + geom_vline(xintercept = 1, color = "red", linetype = "dashed", cex = 1, alpha = 0.5)

As mentioned by stefan in the comments you can transform your data, but to make it readable set your labels and breaks to the normal values.
ggplot(istrazivanje, aes(y = Nezavisna, x = log2(OR))) +
geom_point(shape = 18, size = 5) +
geom_errorbarh(aes(xmin = log2(LL), xmax = log2(UL)), height = 0.25) +
geom_vline(xintercept = log2(1), color = "red", linetype = "dashed", cex = 1, alpha = 0.5) +
scale_x_continuous(breaks = log2(c(1, 10, 20, 30, 40)), labels =c(1, 10, 20, 30, 40))
Edit: or as you already take log(PTH) you could do log10(PTH) which roughly bring your OR value there from roughly 14 to 6 and perhaps then you do not even have to transform the scales of the graph.

If, I understand correctly your question one solution could be ggforce facet zoom function
Sample code:
library(gridExtra)
library(ggplot2)
library(ggforce)
ggplot(istrazivanje, aes(y = Nezavisna, x = OR)) +
geom_point(shape = 18, size = 5) +
geom_errorbarh(aes(xmin = LL, xmax = UL), height = 0.25) +
geom_vline(xintercept = 1,
color = "red",
linetype = "dashed",
cex = 1,
alpha = 0.5)+
facet_zoom(xlim = c(20, 30)) # use facet_zoom to zoom on x axis
Plot:
Sample data:
Nezavisna<-c("Pol","Starost","Ca","P","log(PTH)","log(mg)","BrojZlezda","MIBI","Iskustvo","Pridruzena")
OR<-c(0.399,1.023,0.814,0.568,14.14,0.417,2.193,0.709,1.468,1.445)
LL<-c(0.174,0.996,0.277,0.122,4.969,0.197,1.019,0.339,0.754,0.702)
UL<-c(0.917,1.052,2.396,2.649,40.238,0.882,4.722,1.483,2.859,2.976)
istrazivanje<-data.frame(Nezavisna,OR,LL,UL)
istrazivanje

Related

Problem with "fill" argument data visualisation R, ggplot2

I currently have an issue regarding how the "fill" argument colors the different bars in my plot. I wish to have a predetermined ranking of the colors such that each value in the table that I'm plotting, corresponds to a color instead of in my case, where it varies. The way it works in my code is that the highest value in my table corresponds to the lightest color (in the default ggplot palette), and the lowest value corresponds to the darkest color. My wish specifically is that 100 should be what corresponds to the lightest color and 0 corresponding to the darkest color (as I'm plotting quantiles) and of course, everything in-between.
Here is my code.
library(tidyverse)
test <- tibble(factors=c("fact1","fact2","fact3","fact4"),
percent=c(18.3,42.6,81.1,62.8))
ggplot(test) +
geom_hline(
aes(yintercept = y),
data.frame(y = c(0:4) * 25),
color = "lightgrey"
) +
geom_col(
aes(
x = reorder(str_wrap((factors), 5), percent),
y = percent,
fill = percent
),
position = "dodge2",
show.legend = TRUE,
alpha = .9,
width=0.8
) +
geom_segment(
aes(
x = reorder(str_wrap(factors, 5), percent),
y = 0,
xend = reorder(str_wrap(factors, 5), percent),
yend = 100
),
linetype = "dashed",
color = "gray12"
) +
scale_y_continuous(
limits = c(-50, 100),
expand = c(0, 0),
breaks = c(0, 25, 50, 75,100)
)+
coord_polar()
If you change the values in the "percent" part of the "test" tibble, to something like percent=c(80.1,80.5,80.1,79.9) you'll quickly understand what I am talking about, as in my ideal case, It should only be showing four pretty much identical colors instead of the range of colors being determined from the highest to lowest of the "percent" column, showing dark to light colors.
Thanks in advance!
First you should create a palette:
my_palette <- colorRampPalette((RColorBrewer::brewer.pal(9, "Blues")))
Then you can add a scale_fill_gradientn to your ggplot:
test <- tibble(factors=c("fact1","fact2","fact3","fact4"),
# percent=c(18.3,42.6,81.1,62.8))
percent = c(80.1,80.5,80.1,79.9))
ggplot(test) +
geom_hline(
aes(yintercept = y),
data.frame(y = c(0:4) * 25),
color = "lightgrey"
) +
geom_col(
aes(
x = reorder(str_wrap((factors), 5), percent),
y = percent,
fill = percent
),
position = "dodge2",
show.legend = TRUE,
alpha = .9,
width=0.8
) +
geom_segment(
aes(
x = reorder(str_wrap(factors, 5), percent),
y = 0,
xend = reorder(str_wrap(factors, 5), percent),
yend = 100
),
linetype = "dashed",
color = "gray12"
) +
scale_y_continuous(
limits = c(-50, 100),
expand = c(0, 0),
breaks = c(0, 25, 50, 75,100)
)+
scale_fill_gradientn(colours = my_palette(100),
limits=c(0,100))+
coord_polar()

CI/SD geom_ribbon() missing when zoomed in

I have an issue with geom_ribbon and I think this is a bug and not a feature.
I want to zoom in on the "interesting" part of my plot but I don't want ggplot to exclude anything just because the entire thing doesn't fit into the plot. For that I use coord_cartesian to do the limiting. And it works for lines and points and probably many other things (bars) but not for geom_ribbon. So here's an example:
# Load libraries
library(ggplot2)
# Create data:
set.seed(1234)
LineA=c(seq(1,20,0.1))
LineB=c(seq(1,25,0.1))
LineC=c(seq(1,19,0.1))
LineD=c(seq(1,60,0.1))
my_df=data.frame(Mean = c(sort(sample(LineA,40)),sort(sample(LineB,40)),sort(sample(LineC,40)),
sort(sample(LineD,40))))
my_df$Names=c(rep("Line-A",40),rep("Line-B",40),rep("Line-C",40),rep("Line-D",40))
my_df$SD=c(runif(n = 120, min = 1, max = 5),runif(n = 40, min = 1, max = 20))
my_df$Time=c(1:40,1:40,1:40,1:40)
my_df$Mean_low=my_df$Mean-my_df$SD
my_df$Mean_low[my_df$Mean_low<0]=0
my_df$Mean_hi=my_df$Mean+my_df$SD
head(my_df)
# Plot
# Ribbon visible:
ggplot(my_df, aes(x=Time, y=Mean)) + geom_line(aes(colour = Names), size = 1) +
geom_point(size = 2, aes(shape = Names, color = Names))+
geom_ribbon(aes(x = Time, y=NULL, ymin = Mean_low, ymax = Mean_hi, fill = Names),
show.legend = F, linetype = 0, alpha = 0.1, na.rm = T) +
geom_hline(yintercept = 20, linetype = "dotdash", color = "red", size = 1)+
theme_classic()+
scale_y_continuous("Mean value", breaks = seq(0, 100, 2), expand = expansion(mult = c(0, 0.01))) +
scale_x_continuous("Days", breaks = seq(0, max(my_df$Time),2),
expand = expansion(mult = c(0.01, 0.005))) +
coord_cartesian(ylim = c(0, 100), xlim = c(0, 50))
Here the ribbon visible if all of it is allowed to fit in the plot but the Ribbon is missing for Line-D completely when I limit the y axis as seen here below:
ggplot(my_df, aes(x=Time, y=Mean)) + geom_line(aes(colour = Names), size = 1) +
geom_point(size = 2, aes(shape = Names, color = Names))+
geom_ribbon(aes(x = Time, y=NULL, ymin = Mean_low, ymax = Mean_hi, fill = Names),
show.legend = F, linetype = 0, alpha = 0.1, na.rm = T) +
geom_hline(yintercept = 20, linetype = "dotdash", color = "red", size = 1)+
theme_classic()+
scale_y_continuous("Mean value", breaks = seq(0, 100, 2), expand = expansion(mult = c(0, 0.01))) +
scale_x_continuous("Days", breaks = seq(0, max(my_df$Time),2),
expand = expansion(mult = c(0.01, 0.005))) +
coord_cartesian(ylim = c(0, 30), xlim = c(0, 50))
I found only one workaround as also described here: Extended range in geom_ribbon by manually removing the data (NA for values) for values that would stay outside limits but that is a workaround and not a solution. The limiting/zooming works for most other geom options, then why not for the geom_ribbon as well? Does anyone know a more elegant solution? Is it a bug? Should I try to let ggplot people know?
Thank you!!
Just installing the ragg library [library(ragg)] displays the ribbons when the plot is exported/saved. The cut off bands are still not visible when zooming-in in R-studio plot, though. It could be a bug in the ggplot.

R ggplot2 ggrepel labelling positions

I am trying to add labels to a ggplot object. The labels do not look neat and tidy due to their positioning. I have tried using various geom_label_repel and geom_text_repel options but am not having much luck.
I cannot share the data unfortunately, but I have inserted one of my codes below and a screenshot of one section of the redacted graph. The graph has multiple peaks that need labelling. Each label has 2 lines.
I would like the lines connecting the labels to be directly above each peak on the x axis, then turn at a right angle and the line continue horizontally slightly. I would then like the label to sit on top of this horizontal section of the line.
Some peaks are very close together, so the labels will end up being pushed up the y axis so they are able to stack up neatly.
I hope that description makes sense. I would appreciate it if anyone is able to help.
Thank you!
library(ggplot2)
library(ggrepel)
library(dplyr)
upper_plot <- ggplot() +
geom_point(data = plot_data[which(analysis == "Analysis1"),],
aes(x = rel_pos, y = logged_p, color = as.factor(chr)),
size = 0.25) +
scale_color_manual(values = rep(my_upper_colors, nrow(axis_df))) +
geom_point(data=upper_highlight_pos2_old,
aes(x = rel_pos, y = logged_p),
color= c('grey'),
size=0.75,
pch = 16) +
geom_point(data=upper_labels_old,
aes(x = rel_pos, y = logged_p),
color='dark grey',
size=2,
pch = 18) +
geom_point(data=upper_highlight_pos2_novel,
aes(x = rel_pos, y = logged_p),
color= c('black'),
size=0.75,
pch = 16) +
geom_point(data=upper_labels_novel,
aes(x = rel_pos, y = logged_p),
color='black',
size=2,
pch = 18) +
scale_x_continuous(labels = axis_df$chr,
breaks = axis_df$chr_center,
expand = expansion(mult = 0.01)) +
scale_y_continuous(limits = c(0, maxp),
expand = expansion(mult = c(0.02, 0.06))) +
# geom_hline(yintercept = -log10(1e-5), color = "red", linetype = "dashed",
# size = 0.3) +
geom_hline(yintercept = -log10(5e-8), color = "black", linetype = "dashed",
size = 0.3) +
labs(x = "", y = bquote(atop('GWAS', '-log'[10]*'(p)'))) +
theme_classic() +
theme(legend.position = "none",
axis.title.x = element_blank(),
plot.margin = margin(t=5, b = 5, r=5, l = 10)) +
geom_label_repel(data = upper_labels,
aes(x = rel_pos, y = logged_p, label = label),
ylim = c(maxp / 3, NA),
size = 2,
force_pull = 0,
nudge_x = 0.5,
box.padding = 0.5,
nudge_y = 0.5,
min.segment.length = 0, # draw all lines no matter how short
segment.size = 0.2,
segment.curvature = -0.1,
segment.ncp = 3,
segment.angle = 45,
label.size=NA, #no border/box
fill = NA, #no background
)
This is my current untidy layout...
EDIT:
This is the sort of layout I am after. The lines will need to be flexible and either be right-handed or left-handed depending on space (source: https://www.nature.com/articles/s41588-020-00725-7)

How to stop ggrepel labels moving between gganimate frames in R/ggplot2?

I would like to add labels to the end of lines in ggplot, avoid them overlapping, and avoid them moving around during animation.
So far I can put the labels in the right place and hold them static using geom_text, but the labels overlap, or I can prevent them overlapping using geom_text_repel but the labels do not appear where I want them to and then dance about once the plot is animated (this latter version is in the code below).
I thought a solution might involve effectively creating a static layer in ggplot (p1 below) then adding an animated layer (p2 below), but it seems not.
How do I hold some elements of a plot constant (i.e. static) in an animated ggplot? (In this case, the labels at the end of lines.)
Additionally, with geom_text the labels appear as I want them - at the end of each line, outside of the plot - but with geom_text_repel, the labels all move inside the plotting area. Why is this?
Here is some example data:
library(dplyr)
library(ggplot2)
library(gganimate)
library(ggrepel)
set.seed(99)
# data
static_data <- data.frame(
hline_label = c("fixed_label_1", "fixed_label_2", "fixed_label_3", "fixed_label_4",
"fixed_label_5", "fixed_label_6", "fixed_label_7", "fixed_label_8",
"fixed_label_9", "fixed_label_10"),
fixed_score = c(2.63, 2.45, 2.13, 2.29, 2.26, 2.34, 2.34, 2.11, 2.26, 2.37))
animated_data <- data.frame(condition = c("a", "b")) %>%
slice(rep(1:n(), each = 10)) %>%
group_by(condition) %>%
mutate(time_point = row_number()) %>%
ungroup() %>%
mutate(score = runif(20, 2, 3))
and this is the code I am using for my animated plot:
# colours for use in plot
condition_colours <- c("red", "blue")
# plot static background layer
p1 <- ggplot(static_data, aes(x = time_point)) +
scale_x_continuous(breaks = seq(0, 10, by = 2), expand = c(0, 0)) +
scale_y_continuous(breaks = seq(2, 3, by = 0.10), limits = c(2, 3), expand = c(0, 0)) +
# add horizontal line to show existing scores
geom_hline(aes(yintercept = fixed_score), alpha = 0.75) +
# add fixed labels to the end of lines (off plot)
geom_text_repel(aes(x = 11, y = fixed_score, label = hline_label),
hjust = 0, size = 4, direction = "y", box.padding = 1.0) +
coord_cartesian(clip = 'off') +
guides(col = F) +
labs(title = "[Title Here]", x = "Time", y = "Mean score") +
theme_minimal() +
theme(panel.grid.minor = element_blank(),
plot.margin = margin(5.5, 120, 5.5, 5.5))
# animated layer
p2 <- p1 +
geom_point(data = animated_data,
aes(x = time_point, y = score, colour = condition, group = condition)) +
geom_line(data = animated_data,
aes(x = time_point, y = score, colour = condition, group = condition),
show.legend = FALSE) +
scale_color_manual(values = condition_colours) +
geom_segment(data = animated_data,
aes(xend = time_point, yend = score, y = score, colour = condition),
linetype = 2) +
geom_text(data = animated_data,
aes(x = max(time_point) + 1, y = score, label = condition, colour = condition),
hjust = 0, size = 4) +
transition_reveal(time_point) +
ease_aes('linear')
# render animation
animate(p2, nframes = 50, end_pause = 5, height = 1000, width = 1250, res = 120)
Suggestions for consideration:
The specific repelling direction / amount / etc. in geom_text_repel is determined by a random seed. You can set seed to a constant value in order to get the same repelled positions in each frame of animation.
I don't think it's possible for repelled text to go beyond the plot area, even if you turn off clipping & specify some repel range outside plot limits. The whole point of that package is to keep text labels away from one another while remaining within the plot area. However, you can extend the plot area & use geom_segment instead of geom_hline to plot the horizontal lines, such that these lines stop before they reach the repelled text labels.
Since there are more geom layers using animated_data as their data source, it would be cleaner to put animated_data & associated common aesthetic mappings in the top level ggplot() call, rather than static_data.
Here's a possible implementation. Explanation in annotations:
p3 <- ggplot(animated_data,
aes(x = time_point, y = score, colour = condition, group = condition)) +
# static layers (assuming 11 is the desired ending point)
geom_segment(data = static_data,
aes(x = 0, xend = 11, y = fixed_score, yend = fixed_score),
inherit.aes = FALSE, colour = "grey25") +
geom_text_repel(data = static_data,
aes(x = 11, y = fixed_score, label = hline_label),
hjust = 0, size = 4, direction = "y", box.padding = 1.0, inherit.aes = FALSE,
seed = 123, # set a constant random seed
xlim = c(11, NA)) + # specify repel range to be from 11 onwards
# animated layers (only specify additional aesthetic mappings not mentioned above)
geom_point() +
geom_line() +
geom_segment(aes(xend = time_point, yend = score), linetype = 2) +
geom_text(aes(x = max(time_point) + 1, label = condition),
hjust = 0, size = 4) +
# static aesthetic settings (limits / expand arguments are specified in coordinates
# rather than scales, margin is no longer specified in theme since it's no longer
# necessary)
scale_x_continuous(breaks = seq(0, 10, by = 2)) +
scale_y_continuous(breaks = seq(2, 3, by = 0.10)) +
scale_color_manual(values = condition_colours) +
coord_cartesian(xlim = c(0, 13), ylim = c(2, 3), expand = FALSE) +
guides(col = F) +
labs(title = "[Title Here]", x = "Time", y = "Mean score") +
theme_minimal() +
theme(panel.grid.minor = element_blank()) +
# animation settings (unchanged)
transition_reveal(time_point) +
ease_aes('linear')
animate(p3, nframes = 50, end_pause = 5, height = 1000, width = 1250, res = 120)

Align multiple plots with varying spacings and add arrows between them

I have 6 plots which I want to align neatly in a two-step manner (see picture). Preferably, I'd like to add nice arrows.
Any ideas?
UPD. As my question started to gather negative feedback, I want to clarify that I've checked all the (partially) related questions at SO and found no indication on how to position ggplots freely on a "canvas". Moreover, I cannot think of a single way to draw arrows between the plots. I'm not asking for a ready made solution. Please, just indicate the way.
Here's an attempt at the layout you want. It requires some formatting by hand, but you can probably automate much of that by taking advantage of the coordinate system built into the plot layout. Also, you may find that grid.curve is better than grid.bezier (which I used) for getting the arrow curves shaped exactly the way you want.
I know just enough about grid to be dangerous, so I'd be interested in any suggestions for improvements. Anyway, here goes...
Load the packages we'll need, create a couple of utility grid objects, and create a plot to lay out:
library(ggplot2)
library(gridExtra)
# Empty grob for spacing
#b = rectGrob(gp=gpar(fill="white", col="white"))
b = nullGrob() # per #baptiste's comment, use nullGrob() instead of rectGrob()
# grid.bezier with a few hard-coded settings
mygb = function(x,y) {
grid.bezier(x=x, y=y, gp=gpar(fill="black"),
arrow=arrow(type="closed", length=unit(2,"mm")))
}
# Create a plot to arrange
p = ggplot(mtcars, aes(wt, mpg)) +
geom_point()
Create the main plot arrangement. Use the empty grob b that we created above for spacing the plots:
grid.arrange(arrangeGrob(p, b, p, p, heights=c(0.3,0.1,0.3,0.3)),
b,
arrangeGrob(b, p, p, b, p, heights=c(0.07,0.3, 0.3, 0.03, 0.3)),
ncol=3, widths=c(0.45,0.1,0.45))
Add the arrows:
# Switch to viewport for first set of arrows
vp = viewport(x = 0.5, y=.75, width=0.09, height=0.4)
pushViewport(vp)
#grid.rect(gp=gpar(fill="black", alpha=0.1)) # Use this to see where your viewport is located on the full graph layout
# Add top set of arrows
mygb(x=c(0,0.8,0.8,1), y=c(1,0.8,0.6,0.6))
mygb(x=c(0,0.6,0.6,1), y=c(1,0.4,0,0))
# Up to "main" viewport (the "full" canvas of the main layout)
popViewport()
# New viewport for lower set of arrows
vp = viewport(x = 0.6, y=0.38, width=0.15, height=0.3, just=c("right","top"))
pushViewport(vp)
#grid.rect(gp=gpar(fill="black", alpha=0.1)) # Use this to see where your viewport is located on the full graph layout
# Add bottom set of arrows
mygb(x=c(1,0.8,0.8,0), y=c(1,0.9,0.9,0.9))
mygb(x=c(1,0.7,0.4,0), y=c(1,0.8,0.4,0.4))
And here's the resulting plot:
Probably using ggplot with annotation_custom here is a more convenient approach. First, we generate sample plots.
require(ggplot2)
require(gridExtra)
require(bezier)
# generate sample plots
set.seed(17)
invisible(
sapply(paste0("gg", 1:6), function(ggname) {
assign(ggname, ggplotGrob(
ggplot(data.frame(x = rnorm(10), y = rnorm(10))) +
geom_path(aes(x,y), size = 1,
color = colors()[sample(1:length(colors()), 1)]) +
theme_bw()),
envir = as.environment(1)) })
)
After that we can plot them inside a bigger ggplot.
# necessary plot
ggplot(data.frame(a=1)) + xlim(1, 20) + ylim(1, 32) +
annotation_custom(gg1, xmin = 1, xmax = 9, ymin = 23, ymax = 31) +
annotation_custom(gg2, xmin = 11, xmax = 19, ymin = 21, ymax = 29) +
annotation_custom(gg3, xmin = 11, xmax = 19, ymin = 12, ymax = 20) +
annotation_custom(gg4, xmin = 1, xmax = 9, ymin = 10, ymax = 18) +
annotation_custom(gg5, xmin = 1, xmax = 9, ymin = 1, ymax = 9) +
annotation_custom(gg6, xmin = 11, xmax = 19, ymin = 1, ymax = 9) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(9, 10, 10, 11), y = c(27, 27, 25, 25)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(9, 10, 10, 11), y = c(27, 27, 18, 18)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(15, 15, 12, 9), y = c(12, 11, 11, 11)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(15, 15, 12, 9), y = c(12, 11, 11, 9)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(15, 15, 12, 12), y = c(12, 10.5, 10.5, 9)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
theme(rect = element_blank(),
line = element_blank(),
text = element_blank(),
plot.margin = unit(c(0,0,0,0), "mm"))
Here we use bezier function from bezier package to generate coordinates for geom_path. Maybe one should look for some additional information about bezier curves and their control points to make connections between plots look prettier. Now the resulting plot is following.
Thanks a lot for your tips and especially #eipi10 for an actual implementation of them - the answer is great.
I found a native ggplot solution which I want to share.
UPD While I was typing this answer, #inscaven posted his answer with basically the same idea. The bezier package gives more freedom to create neat curved arrows.
ggplot2::annotation_custom
The simple solution is to use ggplot's annotation_custom to position the 6 plots over the "canvas" ggplot.
The script
Step 1. Load the required packages and create the list of 6 square ggplots. My initial need was to arrange 6 maps, thus, I trigger theme parameter accordingly.
library(ggplot2)
library(ggthemes)
library(gridExtra)
library(dplyr)
p <- ggplot(mtcars, aes(mpg,wt))+
geom_point()+
theme_map()+
theme(aspect.ratio=1,
panel.border=element_rect(color = 'black',size=.5,fill = NA))+
scale_x_continuous(expand=c(0,0)) +
scale_y_continuous(expand=c(0,0)) +
labs(x = NULL, y = NULL)
plots <- list(p,p,p,p,p,p)
Step 2. I create a data frame for the canvas plot. I'm sure, there is a better way to this. The idea is to get a 30x20 canvas like an A4 sheet.
df <- data.frame(x=factor(sample(1:21,1000,replace = T)),
y=factor(sample(1:31,1000,replace = T)))
Step 3. Draw the canvas and position the square plot over it.
canvas <- ggplot(df,aes(x=x,y=y))+
annotation_custom(ggplotGrob(plots[[1]]),
xmin = 1,xmax = 9,ymin = 23,ymax = 31)+
annotation_custom(ggplotGrob(plots[[2]]),
xmin = 13,xmax = 21,ymin = 21,ymax = 29)+
annotation_custom(ggplotGrob(plots[[3]]),
xmin = 13,xmax = 21,ymin = 12,ymax = 20)+
annotation_custom(ggplotGrob(plots[[4]]),
xmin = 1,xmax = 9,ymin = 10,ymax = 18)+
annotation_custom(ggplotGrob(plots[[5]]),
xmin = 1,xmax = 9,ymin = 1,ymax = 9)+
annotation_custom(ggplotGrob(plots[[6]]),
xmin = 13,xmax = 21,ymin = 1,ymax = 9)+
coord_fixed()+
scale_x_discrete(expand = c(0, 0)) +
scale_y_discrete(expand = c(0, 0)) +
theme_bw()
theme_map()+
theme(panel.border=element_rect(color = 'black',size=.5,fill = NA))+
labs(x = NULL, y = NULL)
Step 4. Now we need to add the arrows. First, a data frame with arrows' coordinates is required.
df.arrows <- data.frame(id=1:5,
x=c(9,9,13,13,13),
y=c(23,23,12,12,12),
xend=c(13,13,9,9,13),
yend=c(22,19,11,8,8))
Step 5. Finally, plot the arrows.
gg <- canvas + geom_curve(data = df.arrows %>% filter(id==1),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = 0.1,
arrow = arrow(type="closed",length = unit(0.25,"cm"))) +
geom_curve(data = df.arrows %>% filter(id==2),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = -0.1,
arrow = arrow(type="closed",length = unit(0.25,"cm"))) +
geom_curve(data = df.arrows %>% filter(id==3),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = -0.15,
arrow = arrow(type="closed",length = unit(0.25,"cm"))) +
geom_curve(data = df.arrows %>% filter(id==4),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = 0,
arrow = arrow(type="closed",length = unit(0.25,"cm"))) +
geom_curve(data = df.arrows %>% filter(id==5),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = 0.3,
arrow = arrow(type="closed",length = unit(0.25,"cm")))
The result
ggsave('test.png',gg,width=8,height=12)

Resources