Related
I would like to make heatmaps using the following data:
dt <- data.frame(
h = rep(LETTERS[1:7], 7),
j = c(rep("A", 7), rep("B", 7), rep("C", 7), rep("D", 7), rep("E", 7), rep("F", 7), rep("G", 7)),
Red = runif(7, 0, 1),
Yellow = runif(7, 0, 1),
Green = runif(7, 0, 1),
Blue = runif(7, 0, 1),
Black = runif(7, 0, 1)
)
For each of the heatmaps, the x and y axes stay as the first 2 columns of df. The values that fill in each heatmap will be each of the remaining columns, e.g., Red, Yellow, ...
I borrowed this example to produce the following code:
loop = function(df, x_var, y_var, f_var) {
ggplot(df, aes(x = .data[[x_var]], y = .data[[y_var]], fill = .data[[f_var]])) +
geom_tile(color = "black") +
scale_fill_gradient(low = "white", high = "blue") +
geom_text(aes(label = .data[[f_var]]), color = "black", size = 4) +
coord_fixed() +
theme_minimal() +
labs(x = "",
y = "",
fill = "R", # Want the legend title to be each of the column names that are looped
title = .data[[f_var]])
ggsave(a, file = paste0("heatmap_", f_var,".png"), device = png, width = 15, height = 15, units = "cm")
}
plot_list <- colnames(dt)[-1] %>%
map( ~ loop(df = dt,
x_var = colnames(dt)[1],
y_var = colnames(dt)[2],
f_var = .x))
# view all plots individually (not shown)
plot_list
Problems I encountered when ran this chunk of code:
Error: Discrete value supplied to continuous scale
Step ggsave didn't work. I would like to save each plot by the names of the changing columns.
There are some minor issues with your code. You get the first error as you included the second column of your dataset (which is a categorical, i.e. discrete variable) in the loop. Second, title = .data[[f_var]] will not work. Simply use title = f_var to add the variable name as the title. Finally, you are trying to save an object called a which however is not defined in your code, i.e. you have to assign your plot to a variable a and to return the plot I added a return(a):
set.seed(123)
library(ggplot2)
library(purrr)
loop = function(df, x_var, y_var, f_var) {
a <- ggplot(df, aes(x = .data[[x_var]], y = .data[[y_var]], fill = .data[[f_var]])) +
geom_tile(color = "black") +
scale_fill_gradient(low = "white", high = "blue") +
geom_text(aes(label = .data[[f_var]]), color = "black", size = 4) +
coord_fixed() +
theme_minimal() +
labs(x = "",
y = "",
fill = "R", # Want the legend title to be each of the column names that are looped
title = f_var)
ggsave(a, file = paste0("heatmap_", f_var,".png"), device = png, width = 15, height = 15, units = "cm")
return(a)
}
plot_list <- colnames(dt)[-c(1, 2)] %>%
map( ~ loop(df = dt,
x_var = colnames(dt)[1],
y_var = colnames(dt)[2],
f_var = .x))
# view all plots individually (not shown)
plot_list[c(1, 5)]
#> [[1]]
#>
#> [[2]]
I would like to generate, in R, a heatmap visualization of a matrix using circles, in order to have both the color and diameter of the circles be informative. Something looking like this:
This sort of plotting is called "bubblegum plot" in certain computational biology labs, but I could not find an R function/package to do it.
Any ideas? Thanks!
Not sure whether there is a package which offers this out-of-the-box but using just ggplot2 this could be achieved like so:
library(ggplot2)
set.seed(42)
d <- data.frame(
x = rep(paste("Team", LETTERS[1:8]), 4),
y = rep(paste("Task", 1:4), each = 8),
value = runif(32)
)
ggplot(d, aes(x, forcats::fct_rev(y), fill = value, size = value)) +
geom_point(shape = 21, stroke = 0) +
geom_hline(yintercept = seq(.5, 4.5, 1), size = .2) +
scale_x_discrete(position = "top") +
scale_radius(range = c(1, 15)) +
scale_fill_gradient(low = "orange", high = "blue", breaks = c(0, .5, 1), labels = c("Great", "OK", "Bad"), limits = c(0, 1)) +
theme_minimal() +
theme(legend.position = "bottom",
panel.grid.major = element_blank(),
legend.text = element_text(size = 8),
legend.title = element_text(size = 8)) +
guides(size = guide_legend(override.aes = list(fill = NA, color = "black", stroke = .25),
label.position = "bottom",
title.position = "right",
order = 1),
fill = guide_colorbar(ticks.colour = NA, title.position = "top", order = 2)) +
labs(size = "Area = Time Spent", fill = "Score:", x = NULL, y = NULL)
I wrote an alternative function to perform the plotting, without ggplot and tidyverse. I will soon upload it to the CRAN corto package. Enjoy!
Usage
inputp<-matrix(runif(1000),nrow=50)
inputn<-matrix(rnorm(1000),nrow=50)
colnames(inputp)<-colnames(inputn)<-paste0("Score",1:ncol(inputp))
rownames(inputp)<-rownames(inputn)<-paste0("Car",1:nrow(inputp))
par(las=2,mar=c(0,6,6,10))
bubblegum(inputp,inputn)
BUBBLEGUM function
require(gplots)
require(plotrix)
bubblegum<-function(
inputp,
inputn,
pcr=0.1,
grid=FALSE,
reorder=FALSE,
legend=TRUE,
matrix2col=TRUE
) {
if(nrow(inputp)!=nrow(inputn)|ncol(inputp)!=ncol(inputn)){
warning("inputp and inpute have different sizes!")
}
### Initialize
rownumber<-nrow(inputp)
colnumber<-ncol(inputp)
### Trasform the NESs into colors
if(matrix2col){
colconversion<-matrix2col(inputn,nbreaks=20)
nescolors<-colconversion$colormatrix
} else {
nescolors<-inputn
}
#pradii<-0.3*(-log(inputp)/max(-log(inputp)))
pradii<-inputp
pradii[inputp>0.1]<-pcr*0
pradii[inputp<=0.1]<-pcr*1
pradii[inputp<0.05]<-pcr*2
pradii[inputp<1E-5]<-pcr*3
pradii[inputp<1E-10]<-pcr*4
pradii[inputp<1E-20]<-pcr*5
### Order by sum NES
sumnes<-apply(inputn,1,function(x){sum(abs(x))})
if(reorder){
neworder<-order(sumnes)
pradii<-pradii[neworder,]
nescolors<-nescolors[neworder,]
} else {
pradii<-pradii[nrow(pradii):1,]
nescolors<-nescolors[nrow(nescolors):1,]
}
### Plot
#par(las=2,mar=c(0,20,6,0))
plot(0,ylim=c(0,rownumber+1),xlim=c(0,colnumber+1),xaxt="n",yaxt="n",type="n",frame.plot=FALSE,xlab="",ylab="")#,xaxs="i",yaxs="i")
if(grid){
abline(h=1:rownumber,lty=2)
abline(v=1:colnumber,lty=2)
}
for (i in (1:rownumber)) {
for(j in 1:colnumber) {
radius<-pradii[i,j]
color<-nescolors[i,j]
draw.circle(j,i,radius=radius,col=color,lwd=0.2)
}
}
axis(3,at=1:colnumber,labels=colnames(pradii))
axis(2,at=1:rownumber,labels=rownames(pradii),cex.axis=0.7)
### Enable things to be drawn outside the plot region
par(xpd=TRUE)
### Title
### Legend
if(legend){
#legend(-colnumber,rownumber,c("group A", "group B"), pch = c(1,2), lty = c(1,2))
legend("topright",inset=c(-0.1,0),legend=c(
"<0.1","0.05","<1e-5","<1e-10","<1e-20"
), pch=c(21), title="FDR",pt.bg="white",horiz=FALSE,pt.cex=c(1,1.5,2,2.5,3))
}
if(matrix2col){
extreme<-round(max(abs(inputn)),1)
legend("bottomright", inset=c(-0.1,0),legend=c(
-extreme,-extreme/2,0,extreme/2,extreme
), pch=c(21), title="Score",
pt.bg=colconversion$col[c(1,5,10,15,19)],
horiz=FALSE,pt.cex=3)
}
}
###########################
matrix2col<-function(z,col1="navy",col2="white",col3="red3",nbreaks=100,center=TRUE){
if(center){
extreme=max(abs(z))+0.001
breaks <- seq(-extreme, extreme, length = nbreaks)
}else {
breaks <- seq(min(z), max(z), length = nbreaks)
}
ncol <- length(breaks) - 1
col <- colorpanel(ncol,col1,col2,col3)
CUT <- cut(z, breaks=breaks)
colorlevels <- col[match(CUT, levels(CUT))] # assign colors to heights for each point
names(colorlevels)<-rownames(z)
colormatrix<-matrix(colorlevels,ncol=ncol(z),nrow=nrow(z))
dimnames(colormatrix)<-dimnames(z)
return(list(colormatrix=colormatrix,col=col))
}
I have a large number of variables and would like to create scatterplots comparing all variables to a single variable. I have been able to do this in base R using lapply, but I cannot complete the same task in ggplot2 using lapply.
Below is an example dataset.
df <- data.frame("ID" = 1:16)
df$A <- c(1,2,3,4,5,6,7,8,9,10,11,12,12,14,15,16)
df$B <- c(5,6,7,8,9,10,13,15,14,15,16,17,18,18,19,20)
df$C <- c(11,12,14,16,10,12,14,16,10,12,14,16,10,12,14,16)
I define the variables I would like to generate scatterplots with, using the code below:
df_col_names <- df %>% select(A:C) %>% colnames(.)
Below is how I have been able to successfully complete the task of plotting all variables against variable A, using lapply in base R:
lapply(df_col_names, function(x) {
tiff(filename=sprintf("C:\\Documents\\%s.tiff", x),
width = 1000, height = 1000, res=200)
plot(df$A, df[[x]],
pch=19,
cex = 1.5,
ylab = x,
ylim = c(0, 20),
xlim = c(0, 20))
dev.off()
})
Below is my attempt at completing the task in ggplot2 without any success. It generates the tiff images, although they are empty.
lapply(df_col_names, function(x) {
tiff(filename=sprintf("C:\\Documents\\%s.tiff", x),
width = 1000, height = 1000, res=200)
ggplot(df) +
geom_point(data = df,
aes(x = A, y = df_col_names[[x]], size = 3)) +
geom_smooth(aes(x = A, y = df_col_names[[x]], size = 0), method = "lm", size=0.5) +
coord_fixed(ratio = 1, xlim = c(0, 20), ylim = c(0, 20)) +
guides(size = FALSE, color = FALSE) +
theme_bw(base_size = 14)
dev.off()
})
It works for me with ggsave. Also note that you are passing string column names to ggplot so use .data to refer to actual column values.
library(ggplot2)
lapply(df_col_names, function(x) {
ggplot(df) +
geom_point( aes(x = A, y = .data[[x]], size = 3)) +
geom_smooth(aes(x = A, y = .data[[x]], size = 0), method = "lm", size=0.5) +
coord_fixed(ratio = 1, xlim = c(0, 20), ylim = c(0, 20)) +
guides(size = FALSE, color = FALSE) +
theme_bw(base_size = 14) -> plt
ggsave(sprintf("%s.tiff", x), plt)
})
I recently asked this question. However, I am asking a separate question now as the scope of my new question falls outside the range of the last question.
I am trying to create a heatmap in ggplot... however, outside of the axis I am trying to plot geom_tile. The issue is I cannot find a consistent way to get it to work. For example, the code I am using to plot is:
library(colorspace)
library(ggplot2)
library(ggnewscale)
library(tidyverse)
asd <- expand_grid(paste0("a", 1:9), paste0("b", 1:9))
df <- data.frame(
a = asd$`paste0("a", 1:9)`,
b = asd$`paste0("b", 1:9)`,
c = sample(20, 81, replace = T)
)
# From discrete to continuous
df$a <- match(df$a, sort(unique(df$a)))
df$b <- match(df$b, sort(unique(df$b)))
z <- sample(10, 18, T)
# set color palettes
pal <- rev(diverging_hcl(palette = "Blue-Red", n = 11))
palEdge <- rev(sequential_hcl(palette = "Plasma", n = 11))
# plot
ggplot(df, aes(a, b)) +
geom_tile(aes(fill = c)) +
scale_fill_gradientn(
colors = pal,
guide = guide_colorbar(
frame.colour = "black",
ticks.colour = "black"
),
name = "C"
) +
theme_classic() +
labs(x = "A axis", y = "B axis") +
new_scale_fill() +
geom_tile(data = tibble(a = 1:9,
z = z[1:9]),
aes(x = a, y = 0, fill = z, height = 0.3)) +
geom_tile(data = tibble(b = 1:9,
z = z[10:18]),
aes(x = 0, y = b, fill = z, width = 0.3)) +
scale_fill_gradientn(
colors = palEdge,
guide = guide_colorbar(
frame.colour = "black",
ticks.colour = "black"
),
name = "Z"
)+
coord_cartesian(clip = "off", xlim = c(0.5, NA), ylim = c(0.5, NA)) +
theme(aspect.ratio = 1,
plot.margin = margin(10, 15.5, 25, 25, "pt")
)
This produces something like this:
However, I am trying to find a consistent way to plot something more like this (which I quickly made in photoshop):
The main issue im having is being able to manipulate the coordinates of the new scale 'outside' of the plotting area. Is there a way to move the tiles that are outside so I can position them in an area that makes sense?
There are always the two classic options when plotting outside the plot area:
annotate/ plot with coord_...(clip = "off")
make different plots and combine them.
The latter option usually gives much more flexibility and way less headaches, in my humble opinion.
library(colorspace)
library(tidyverse)
library(patchwork)
asd <- expand_grid(paste0("a", 1:9), paste0("b", 1:9))
df <- data.frame(
a = asd$`paste0("a", 1:9)`,
b = asd$`paste0("b", 1:9)`,
c = sample(20, 81, replace = T)
)
# From discrete to continuous
df$a <- match(df$a, sort(unique(df$a)))
df$b <- match(df$b, sort(unique(df$b)))
z <- sample(10, 18, T)
# set color palettes
pal <- rev(diverging_hcl(palette = "Blue-Red", n = 11))
palEdge <- rev(sequential_hcl(palette = "Plasma", n = 11))
# plot
p_main <- ggplot(df, aes(a, b)) +
geom_tile(aes(fill = c)) +
scale_fill_gradientn("C",colors = pal,
guide = guide_colorbar(frame.colour = "black",
ticks.colour = "black")) +
theme_classic() +
labs(x = "A axis", y = "B axis")
p_bottom <- ggplot() +
geom_tile(data = tibble(a = 1:9, z = z[1:9]),
aes(x = a, y = 0, fill = z, height = 0.3)) +
theme_void() +
scale_fill_gradientn("Z",limits = c(0,10),
colors = palEdge,
guide = guide_colorbar(
frame.colour = "black", ticks.colour = "black"))
p_left <- ggplot() +
theme_void()+
geom_tile(data = tibble(b = 1:9, z = z[10:18]),
aes(x = 0, y = b, fill = z, width = 0.3)) +
scale_fill_gradientn("Z",limits = c(0,10),
colors = palEdge,
guide = guide_colorbar( frame.colour = "black", ticks.colour = "black"))
p_left + p_main +plot_spacer()+ p_bottom +
plot_layout(guides = "collect",
heights = c(1, .1),
widths = c(.1, 1))
Created on 2021-02-21 by the reprex package (v1.0.0)
I would like to produce a graphic combining four facets of a graph with insets in each facet showing a detail of the respective plot. This is one of the things I tried:
#create data frame
n_replicates <- c(rep(1:10,15),rep(seq(10,100,10),15),rep(seq(100,1000,100),15),rep(seq(1000,10000,1000),15))
sim_years <- rep(sort(rep((1:15),10)),4)
sd_data <- rep (NA,600)
for (i in 1:600) {
sd_data[i]<-rnorm(1,mean=exp(0.1 * sim_years[i]), sd= 1/n_replicates[i])
}
max_rep <- sort(rep(c(10,100,1000,10000),150))
data_frame <- cbind.data.frame(n_replicates,sim_years,sd_data,max_rep)
#do first basic plot
library(ggplot2)
plot1<-ggplot(data=data_frame, aes(x=sim_years,y=sd_data,group =n_replicates, col=n_replicates)) +
geom_line() + theme_bw() +
labs(title ="", x = "year", y = "sd")
plot1
#make four facets
my_breaks = c(2, 10, 100, 1000, 10000)
facet_names <- c(
`10` = "2, 3, ..., 10 replicates",
`100` = "10, 20, ..., 100 replicates",
`1000` = "100, 200, ..., 1000 replicates",
`10000` = "1000, 2000, ..., 10000 replicates"
)
plot2 <- plot1 +
facet_wrap( ~ max_rep, ncol=2, labeller = as_labeller(facet_names)) +
scale_colour_gradientn(name = "number of replicates", trans = "log",
breaks = my_breaks, labels = my_breaks, colours = rainbow(20))
plot2
#extract inlays (this is where it goes wrong I think)
library(ggpmisc)
library(tibble)
library(dplyr)
inset <- tibble(x = 0.01, y = 10.01,
plot = list(plot2 +
facet_wrap( ~ max_rep, ncol=2, labeller = as_labeller(facet_names)) +
coord_cartesian(xlim = c(13, 15),
ylim = c(3, 5)) +
labs(x = NULL, y = NULL, color = NULL) +
scale_colour_gradient(guide = FALSE) +
theme_bw(10)))
plot3 <- plot2 +
expand_limits(x = 0, y = 0) +
geom_plot_npc(data = inset, aes(npcx = x, npcy = y, label = plot)) +
annotate(geom = "rect",
xmin = 13, xmax = 15, ymin = 3, ymax = 5,
linetype = "dotted", fill = NA, colour = "black")
plot3
That leads to the following graphic:
As you can see, the colours in the insets are wrong, and all four of them appear in each of the facets even though I only want the corresponding inset of course. I read through a lot of questions here (to even get me this far) and also some examples in the ggpmisc user guide but unfortunately I am still a bit lost on how to achieve what I want. Except maybe to do it by hand extracting four insets and then combining them with plot2. But I hope there will be a better way to do this. Thank you for your help!
Edit: better graphic now thanks to this answer, but problem remains partially unsolved:
The following code does good insets, but unfortunately the colours are not preserved. As in the above version each inset does its own rainbow colours anew instead of inheriting the partial rainbow scale from the facet it belongs to. Does anyone know why and how I could change this? In comments I put another (bad) attempt at solving this, it preserves the colors but has the problem of putting all four insets in each facet.
library(ggpmisc)
library(tibble)
library(dplyr)
# #extract inlays: good colours, but produces four insets.
# fourinsets <- tibble(#x = 0.01, y = 10.01,
# x = c(rep(0.01, 4)),
# y = c(rep(10.01, 4)),
# plot = list(plot2 +
# facet_wrap( ~ max_rep, ncol=2) +
# coord_cartesian(xlim = c(13, 15),
# ylim = c(3, 5)) +
# labs(x = NULL, y = NULL, color = NULL) +
# scale_colour_gradientn(name = "number of replicates", trans = "log", guide = FALSE,
# colours = rainbow(20)) +
# theme(
# strip.background = element_blank(),
# strip.text.x = element_blank()
# )
# ))
# fourinsets$plot
library(purrr)
pp <- map(unique(data_frame$max_rep), function(x) {
plot2$data <- plot2$data %>% filter(max_rep == x)
plot2 +
coord_cartesian(xlim = c(12, 14),
ylim = c(3, 4)) +
labs(x = NULL, y = NULL) +
theme(
strip.background = element_blank(),
strip.text.x = element_blank(),
legend.position = "none",
axis.text=element_blank(),
axis.ticks=element_blank()
)
})
#pp[[2]]
inset_new <- tibble(x = c(rep(0.01, 4)),
y = c(rep(10.01, 4)),
plot = pp,
max_rep = unique(data_frame$max_rep))
final_plot <- plot2 +
geom_plot_npc(data = inset_new, aes(npcx = x, npcy = y, label = plot, vp.width = 0.3, vp.height =0.6)) +
annotate(geom = "rect",
xmin = 12, xmax = 14, ymin = 3, ymax = 4,
linetype = "dotted", fill = NA, colour = "black")
#final_plot
final_plot then looks like this:
I hope this clarifies the problem a bit. Any ideas are very welcome :)
Modifying off #user63230's excellent answer:
pp <- map(unique(data_frame$max_rep), function(x) {
plot2 +
aes(alpha = ifelse(max_rep == x, 1, 0)) +
coord_cartesian(xlim = c(12, 14),
ylim = c(3, 4)) +
labs(x = NULL, y = NULL) +
scale_alpha_identity() +
facet_null() +
theme(
strip.background = element_blank(),
strip.text.x = element_blank(),
legend.position = "none",
axis.text=element_blank(),
axis.ticks=element_blank()
)
})
Explanation:
Instead of filtering the data passed into plot2 (which affects the mapping of colours), we impose a new aesthetic alpha, where lines belonging to the other replicate numbers are assigned 0 for transparency;
Use scale_alpha_identity() to tell ggplot that the alpha mapping is to be used as-is: i.e. 1 for 100%, 0 for 0%.
Add facet_null() to override plot2's existing facet_wrap, which removes the facet for the inset.
Everything else is unchanged from the code in the question.
I think this will get you started although its tricky to get the size of the inset plot right (when you include a legend).
#set up data
library(ggpmisc)
library(tibble)
library(dplyr)
library(ggplot2)
# create data frame
n_replicates <- c(rep(1:10, 15), rep(seq(10, 100, 10), 15), rep(seq(100,
1000, 100), 15), rep(seq(1000, 10000, 1000), 15))
sim_years <- rep(sort(rep((1:15), 10)), 4)
sd_data <- rep(NA, 600)
for (i in 1:600) {
sd_data[i] <- rnorm(1, mean = exp(0.1 * sim_years[i]), sd = 1/n_replicates[i])
}
max_rep <- sort(rep(c(10, 100, 1000, 10000), 150))
data_frame <- cbind.data.frame(n_replicates, sim_years, sd_data, max_rep)
# make four facets
my_breaks = c(2, 10, 100, 1000, 10000)
facet_names <- c(`10` = "2, 3, ..., 10 replicates", `100` = "10, 20, ..., 100 replicates",
`1000` = "100, 200, ..., 1000 replicates", `10000` = "1000, 2000, ..., 10000 replicates")
Get overall plot:
# overall facet plot
overall_plot <- ggplot(data = data_frame, aes(x = sim_years, y = sd_data, group = n_replicates, col = n_replicates)) +
geom_line() +
theme_bw() +
labs(title = "", x = "year", y = "sd") +
facet_wrap(~max_rep, ncol = 2, labeller = as_labeller(facet_names)) +
scale_colour_gradientn(name = "number of replicates", trans = "log", breaks = my_breaks, labels = my_breaks, colours = rainbow(20))
#plot
overall_plot
which gives:
Then from the overall plot you want to extract each plot, see here. We can map over the list to extract one at a time:
pp <- map(unique(data_frame$max_rep), function(x) {
overall_plot$data <- overall_plot$data %>% filter(max_rep == x)
overall_plot + # coord_cartesian(xlim = c(13, 15), ylim = c(3, 5)) +
labs(x = NULL, y = NULL) +
theme_bw(10) +
theme(legend.position = "none")
})
If we look at one of these (I've removed the legend) e.g.
pp[[1]]
#pp[[2]]
#pp[[3]]
#pp[[4]]
Gives:
Then we want to add these inset plots into a dataframe so that each plot has its own row:
inset <- tibble(x = c(rep(0.01, 4)),
y = c(rep(10.01, 4)),
plot = pp,
max_rep = unique(data_frame$max_rep))
Then merge this into the overall plot:
overall_plot +
expand_limits(x = 0, y = 0) +
geom_plot_npc(data = inset, aes(npcx = x, npcy = y, label = plot, vp.width = 0.8, vp.height = 0.8))
Gives:
Here is a solution based on Z. Lin's answer, but using ggforce::facet_wrap_paginate() to do the filtering and keeping colourscales consistent.
First, we can make the 'root' plot containing all the data with no facetting.
library(ggpmisc)
library(tibble)
library(dplyr)
n_replicates <- c(rep(1:10,15),rep(seq(10,100,10),15),rep(seq(100,1000,100),15),rep(seq(1000,10000,1000),15))
sim_years <- rep(sort(rep((1:15),10)),4)
sd_data <- rep (NA,600)
for (i in 1:600) {
sd_data[i]<-rnorm(1,mean=exp(0.1 * sim_years[i]), sd= 1/n_replicates[i])
}
max_rep <- sort(rep(c(10,100,1000,10000),150))
data_frame <- cbind.data.frame(n_replicates,sim_years,sd_data,max_rep)
my_breaks = c(2, 10, 100, 1000, 10000)
facet_names <- c(
`10` = "2, 3, ..., 10 replicates",
`100` = "10, 20, ..., 100 replicates",
`1000` = "100, 200, ..., 1000 replicates",
`10000` = "1000, 2000, ..., 10000 replicates"
)
base <- ggplot(data=data_frame,
aes(x=sim_years,y=sd_data,group =n_replicates, col=n_replicates)) +
geom_line() +
theme_bw() +
scale_colour_gradientn(
name = "number of replicates",
trans = "log10", breaks = my_breaks,
labels = my_breaks, colours = rainbow(20)
) +
labs(title ="", x = "year", y = "sd")
Next, the main plot will be just the root plot with facet_wrap().
main <- base + facet_wrap(~ max_rep, ncol = 2, labeller = as_labeller(facet_names))
Then the new part is to use facet_wrap_paginate with nrow = 1 and ncol = 1 for every max_rep, which we'll use as insets. The nice thing is that this does the filtering and it keeps colour scales consistent with the root plot.
nmax_rep <- length(unique(data_frame$max_rep))
insets <- lapply(seq_len(nmax_rep), function(i) {
base + ggforce::facet_wrap_paginate(~ max_rep, nrow = 1, ncol = 1, page = i) +
coord_cartesian(xlim = c(12, 14), ylim = c(3, 4)) +
guides(colour = "none", x = "none", y = "none") +
theme(strip.background = element_blank(),
strip.text = element_blank(),
axis.title = element_blank(),
plot.background = element_blank())
})
insets <- tibble(x = rep(0.01, nmax_rep),
y = rep(10.01, nmax_rep),
plot = insets,
max_rep = unique(data_frame$max_rep))
main +
geom_plot_npc(data = insets,
aes(npcx = x, npcy = y, label = plot,
vp.width = 0.3, vp.height = 0.6)) +
annotate(geom = "rect",
xmin = 12, xmax = 14, ymin = 3, ymax = 4,
linetype = "dotted", fill = NA, colour = "black")
Created on 2020-12-15 by the reprex package (v0.3.0)