I would like to add vertical segments to a ridgeline plot whose histograms show customized quantiles.
I managed to get the vertical segments if I map fill color with ..x... But I would like to show quantiles in the density plots. I wrote the following code:
library(datasets)
library(ggplot2)
data("iris")
iris_lines <- data.frame(Species = c("setosa", "versicolor", "virginica"),
x0 = c(5, 5.9, 6.5))
Figure1 <- ggplot(iris, aes(x=Sepal.Length, y=Species, fill=(..quantile..))) +
geom_density_ridges_gradient(jittered_points = FALSE, calc_ecdf = TRUE, quantile_lines = c(TRUE), quantiles =c(0.1,0.25,0.75,0.9),scale=0.9, color='white')+
geom_segment(data = iris_lines, aes(x = x0, xend = x0, y = as.numeric(Species), yend = as.numeric(Species) + c(.9,.5,.5)), color = "red") + scale_y_discrete(expand = c(0.01, 0))
Figure1
The code works if I map fill color as fill = ..x.. I get three vertical lines representing the mean of each density plot; however, if I map fill color as fill = ..quantile.. I get the following error:
Error in data.frame(..., check.names = FALSE) :
arguments imply differing number of rows: 1, 3
Nice chart!
Add inherit.aes = F to the second geom so it doesn't try to match your data with the fill calculation in the ggplot(aes() call.
Figure1 <- ggplot(iris, aes(x=Sepal.Length, y=Species, fill=(..quantile..))) +
geom_density_ridges_gradient(jittered_points = FALSE,
calc_ecdf = TRUE,
quantile_lines = c(TRUE),
quantiles =c(0.1,0.25,0.75,0.9),
scale=0.9, color='white') +
geom_segment(data = iris_lines,
aes(x = x0, xend = x0,
y = as.numeric(Species), yend = as.numeric(Species) + c(.9,.5,.5)),
color = "red", inherit.aes = F) + #### HERE ####
scale_y_discrete(expand = c(0.01, 0))
Figure1
Edit:
OP asked in comment about selectively labeling some elements and adding a label for the median line. Here's an approach, probably not the pithiest.
Figure1 <- ggplot(iris, aes(x=Sepal.Length, y=Species,
fill = (..quantile..),
color = (..quantile..))) +
geom_density_ridges_gradient(jittered_points = FALSE,
calc_ecdf = TRUE,
quantile_lines = c(TRUE),
quantiles =c(0.1,0.25,0.75,0.9),
scale=0.9, color='white') +
geom_segment(data = iris_lines,
aes(x = x0, xend = x0, fill = "median",
y = as.numeric(Species),
yend = as.numeric(Species) + c(.9,.5,.5),
color = "median")) + #### HERE ####
scale_y_discrete(expand = c(0.01, 0)) +
scale_color_manual(name = "quantile",
limits = c(1:3, "median"),
values = alpha("firebrick1", c(0, 0, 0, 1)),
labels = c("<10%", "10-25%", "IQR", "median")) +
scale_fill_manual(name = "quantile",
limits = c(1:3, "median"),
values = c("cadetblue", "coral", "orange", "white"),
na.value = "gray30",
labels = c("<10%", "10-25%", "IQR", "median"))
Figure1
Related
First of all, some data similar to what I am working with.
rawdata <- data.frame(Score = rnorm(1000, seq(1, 0, length.out = 10), sd = 1),
Group = rep(LETTERS[1:3], 10000))
rawdata$Score <- ifelse(rawdata$Group == "A", rawdata$Score+2,rawdata$Score)
rawdata$Score <- ifelse(rawdata$Group == "C", rawdata$Score-2,rawdata$Score)
stdev <- c(10.78,10.51,9.42)
col <- c("#004d8d", "#cc2701", "#e5b400")
Now, the code of my geom_density_ridges with quantile lines, which in this case they will be white.
p <- ggplot(rawdata, aes(x = Score, y = Group)) +
scale_y_discrete() +
geom_rect(inherit.aes = FALSE, mapping = aes(ymin = 0, ymax = Inf, xmin = -0.1 * min(stdev), xmax = 0.1 * max(stdev)),
fill = "grey", alpha = 0.5) +
geom_density_ridges(scale = -0.5, size = 1, alpha=0.5, show.legend = FALSE,
quantile_lines = TRUE, quantiles = c(0.025, 0.975),
vline_color = "white", aes(fill = Group)) +
scale_color_manual(values = col) +
scale_fill_manual(values = col) +
labs(title="Toy Graph", y="Group", x="Value") +
coord_flip(xlim = c(-8, 8), ylim = NULL, expand = TRUE, clip = "on")
p
An we obtain the following plot, which is perfectly adjusted to expectation.
Now I was wondering if there was a way to make only this little white quantile line transparent to the background. I tried first to set the vline_color = "transparent" and leaving the aes(fill = Group) at the end of geom_density_ridges at the logic that options where drew in order but it gets transparent not to the different shades of grey background but to the density fill (so the quantile line disappears), which is not what I am trying to achieve.
Thanks in advance for your ideas!
Colors can be modified with scales::alpha. This can be passed to your color argument.
library(ggridges)
library(ggplot2)
rawdata <- data.frame(Score = rnorm(1000, seq(1, 0, length.out = 10), sd = 1),
Group = rep(LETTERS[1:3], 10000))
rawdata$Score <- ifelse(rawdata$Group == "A", rawdata$Score+2,rawdata$Score)
rawdata$Score <- ifelse(rawdata$Group == "C", rawdata$Score-2,rawdata$Score)
stdev <- c(10.78,10.51,9.42)
col <- c("#004d8d", "#cc2701", "#e5b400")
ggplot(rawdata, aes(x = Score, y = Group)) +
scale_y_discrete() +
geom_rect(inherit.aes = FALSE, mapping = aes(ymin = 0, ymax = Inf, xmin = -0.1 * min(stdev), xmax = 0.1 * max(stdev)),
fill = "grey", alpha = 0.5) +
geom_density_ridges(scale = -0.5, size = 1, alpha=0.5, show.legend = FALSE,
quantile_lines = TRUE, quantiles = c(0.025, 0.975),
### The only change is here
vline_color = alpha("white", .5), aes(fill = Group)) +
scale_color_manual(values = col) +
scale_fill_manual(values = col) +
labs(title="Toy Graph", y="Group", x="Value") +
coord_flip(xlim = c(-8, 8), ylim = NULL, expand = TRUE, clip = "on")
#> Picking joint bandwidth of 0.148
#> Warning: Using the `size` aesthietic with geom_segment was deprecated in ggplot2 3.4.0.
#> ℹ Please use the `linewidth` aesthetic instead.
Created on 2022-11-14 with reprex v2.0.2
No, if you make something transparent you will see what's underneath, which is the density plot.
However, you can replicate the visual effect of "seeing through to the background" by simply setting the line colour to the same as the background.
Your grey rectangle is currently plotted underneath the density plots, therefore the "background" doesn't have a single colour. This can be solved by plotting it on top instead. Instead of a 50% grey with 50% alpha, you can replicate the same effect with a 0% grey (aka black) with a 25% alpha. Move the geom_rect later than the density plots and it will be layered on top.
Finally, your geom_rect is being called once for each row of raw_data, since it inherits the same data as the main plot. You probably don't want that, so specify a (dummy) data source instead.
ggplot(rawdata, aes(x = Score, y = Group)) +
scale_y_discrete() +
geom_density_ridges(scale = -0.5, size = 1, alpha=0.5, show.legend = FALSE,
quantile_lines = TRUE, quantiles = c(0.025, 0.975),
vline_color = "grey90", aes(fill = Group)) +
scale_color_manual(values = col) +
scale_fill_manual(values = col) +
labs(title="Toy Graph", y="Group", x="Value") +
geom_rect(data=data.frame(), inherit.aes = FALSE, mapping = aes(
ymin = 0, ymax = Inf, xmin = -0.1 * min(stdev), xmax = 0.1 * max(stdev)
), fill = "black", alpha = 0.25) +
coord_flip(xlim = c(-8, 8), ylim = NULL, expand = TRUE, clip = "on")
Note: I'm not sure the background colour is really "grey90", I've eyeballed it. You may want to specify it explicitly with theme if you want to be exact.
If you want literal see-through portions of your density curves, you will need to make the gaps yourself:
library(tidyverse)
rawdata %>%
mutate(GroupNum = as.numeric(as.factor(Group))) %>%
group_by(GroupNum, Group) %>%
summarise(yval = first(GroupNum) - density(Score)$y,
xval = density(Score)$x,
q025 = quantile(Score, 0.025),
q975 = quantile(Score, 0.975)) %>%
mutate(Q = ifelse(xval < q025, 'low', ifelse(xval > q975, 'hi', 'mid'))) %>%
ggplot(aes(xval, yval, group = interaction(Group, Q))) +
geom_line(size = 1) +
geom_ribbon(aes(ymax = GroupNum, ymin = yval, fill = Group),
color = NA, alpha = 0.5, outline.type = 'full',
data = . %>% filter(abs(q025 - xval) > 0.03 &
abs(q975 - xval) > 0.03)) +
coord_flip() +
scale_fill_manual(values = col) +
scale_y_continuous(breaks = 1:3, labels = levels(factor(rawdata$Group)),
name = 'Group') +
labs(x = 'Score')
I want to show two ribbons per variable e.g. (max - min ribbon, and a confidence level ribbon) with geom_ribbon() in ggplot2 in R, as in the example below. I've not been able to set the colours for each ribbon separately. Ideally, I can map a colour palette to each level of the categorical variable (type), and the two ribbons will take colours from these.
## Set up data
set.seed(999)
n <- 100
mn1 <- seq(0.5, 0.9, length.out = n)
mn2 <- seq(0.75, 0.25, length.out = n)
tmp1 <- lapply(seq_len(n), function(x) {
x1 <- rnorm(n, mn1[x], 0.1)
x2 <- rnorm(n, mn2[x], 0.1)
rbind(cbind(min(x1), mean(x1)-sd(x1), mean(x1), mean(x1)+sd(x1), max(x1)),
cbind(min(x2), mean(x2)-sd(x2), mean(x2), mean(x2)+sd(x2), max(x2))
)
})
year <- seq(1900, 1900+n-1, 1)
type <- rep(c("all", "partial"), n)
df1 <- data.frame(rep(year,each = 2), do.call(rbind, tmp1), type)
colnames(df1) <- c("year", "xmin", "xsd_lwr", "xmn", "xsd_upr", "xmax", "type")
head(df1)
rm(tmp1, mn1, mn2, year, type, n)
This is what I have so far in ggplot2:
library(ggplot2)
ggplot(df1, aes(x = year, y = xmn, fill = type, col= type))+
geom_ribbon(aes(ymin=xsd_lwr, ymax = xsd_upr), linetype = 0, alpha = 0.4)+
geom_ribbon(aes(ymin=xmin, ymax = xmax), linetype = 0, alpha = 0.4)+
scale_color_manual(values = c("black", "darkred"))+
scale_fill_manual(values = c("grey10", "grey30"))+
geom_line(aes(linetype= type), size = 1)+
scale_x_continuous(breaks = seq(1900, 2000,10))
UPDATE:
I've accepted the answer as it does give exact control for four different colours, however, I wanted to show that the comment by #teunbrand also works as the transparency, in effect, creates four colours too, and has a better legend. I've modified the suggestion to this below:
ggplot(df1, aes(x = year, y = xmn,col= type))+
geom_ribbon(aes(ymin=xsd_lwr, ymax = xsd_upr, fill = type), linetype = 0, alpha = 0.5)+
geom_ribbon(aes(ymin=xmin, ymax = xmax, fill = type), linetype = 0, alpha =0.5)+
scale_fill_manual(values = c("tomato", "dodgerblue"))+
scale_color_manual(values = c("black", "darkred"))+
geom_line(aes(linetype= type), size = 1)+
scale_x_continuous(breaks = seq(1900, 2000,10))
You could define a specific fill group in the ribbon's aes, and associate the color you wish with it in scale_fill_manual:
ggplot(df1, aes(x = year, y = xmn, fill = type, col= type))+
geom_ribbon(aes(ymin=xsd_lwr, ymax = xsd_upr), linetype = 0, alpha = 0.4,show.legend=F)+
scale_fill_manual(values = c("grey10","red","grey30","green"))+
geom_ribbon(aes(ymin=xmin, ymax = xmax,fill=ifelse(type=='all','all_minmax','partial_min_max')), linetype = 0, alpha = 0.4,show.legend=F)+
scale_color_manual(values = c("black", "darkred"))+
geom_line(aes(linetype= type), size = 1)+
scale_x_continuous(breaks = seq(1900, 2000,10))
Note that I had to remove the legend for the ribbons to avoid to show the second legend with the new color groups.
For easiest and full control of as many colors/fills as you wish, use ggnewscale. This gives you also full legend control.
I am not on a console, coding on rdrr.io/snippets, therefore struggling to show a figure output. But reproducible it is
library(ggplot2)
library(ggnewscale)
ggplot(df1, aes(x = year, y = xmn, col = type))+
geom_ribbon(aes(ymin=xsd_lwr, ymax = xsd_upr, fill = "SE"), linetype = 0, alpha = 0.4)+
scale_fill_manual(name = NULL, values = c("tomato","darkred"))+
new_scale_fill()+
geom_ribbon(aes(ymin=xmin, ymax = xmax, fill= "range"), linetype = 0, alpha = 0.4)+
scale_fill_manual(name = NULL, values = c("dodgerblue", "darkred"))+
geom_line(aes(linetype= type), size = 1)+
scale_color_manual(values = c("black", "darkred"))+
scale_x_continuous(breaks = seq(1900, 2000,10))
I am trying to automate the process of plotting data using ggplot and the facet_wrap functionality. I want a single y-axis label instead individual plot Ob (i.e., A_Ob, B_ob etc) and also a single X-axis not all the plots having label for x-axis such as below. Below is my sample code using gridextra package. However, i would like to do it through facet_wrap as i have many other plots to draw which i think will save me sometime.
graphics.off()
rm(list = ls())
library(tidyverse)
library(gridExtra)
G1 = data.frame(A_Ob = runif(1000, 5, 50), A_Sim = runif(1000, 3,60), A_upper = runif(1000, 10,70), A_lower = runif(1000, 0, 45 ),
B_Ob = runif(1000, 5, 50), B_Sim = runif(1000, 3,60), B_upper = runif(1000, 10,70), B_lower = runif(1000, 0, 45 ),
C_Ob = runif(1000, 5, 50), C_Sim = runif(1000, 3,60), C_upper = runif(1000, 10,70), C_lower = runif(1000, 0, 45 ),
D_Ob = runif(1000, 5, 50), D_Sim = runif(1000, 3,60), D_upper = runif(1000, 10,70), D_lower = runif(1000, 0, 45 ),
Pos = 1:1000)
A1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = A_Ob), col = "black")+
geom_line(aes(y = A_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = A_upper, ymax = A_lower), fill = "grey70")
B1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = B_Ob), col = "black")+
geom_line(aes(y = B_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = B_upper, ymax = B_lower), fill = "grey70")
C1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = C_Ob), col = "black")+
geom_line(aes(y = C_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = C_upper, ymax = C_lower), fill = "grey70")
D1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = D_Ob), col = "black")+
geom_line(aes(y = D_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = D_upper, ymax = D_lower), fill = "grey70")
grid.arrange(A1,B1,C1,D1, nrow = 4)
Here is the result of the code
You need to reshape your dataframe into a longer format and separate values for Ob, Sim, upper and lower.
Using the function melt from data.table package can help you to achieve this:
library(data.table)
setDT(G1)
Ob_cols = grep("_Ob",colnames(G1),value = TRUE)
Sim_cols = grep("_Sim",colnames(G1),value = TRUE)
Upper_cols = grep("_upper",colnames(G1), value = TRUE)
Lower_cols = grep("_lower", colnames(G1), value = TRUE)
g.m <- melt(G1, measure = list(Ob_cols,Sim_cols,Upper_cols,Lower_cols), value.name = c("OBS","SIM","UP","LOW"))
levels(g.m$variable) <- c("A","B","C","D")
Pos variable OBS SIM UP LOW
1: 1 A 5.965488 29.167666 26.66783 29.97259
2: 2 A 23.855719 8.570245 43.75830 30.65616
3: 3 A 16.947887 51.201047 15.20758 39.76122
4: 4 A 49.883306 3.715319 34.38066 20.73177
5: 5 A 5.021938 3.102880 30.05036 32.05123
6: 6 A 19.887176 15.400853 53.67156 28.54982
and now, you can plot it:
library(ggplot2)
ggplot(g.m, aes(x = Pos))+
geom_line(aes(y = OBS), color = "black")+
geom_line(aes(y = SIM), color = "blue")+
geom_vline(xintercept = 750,color = "red", size = 1.5)+
geom_ribbon(aes(ymin = UP, ymax = LOW), fill = "grey70")+
facet_grid(variable~.)
EDIT: Adding annotations & renaming labels
To rename and replace facet labels, you can re-define levels of variable and use facet_wrap instead of facet_grid using ncol = 1 as argument.
To add multiple annotations on a single panel, you need to define a dataframe that you will use in geom_text.
Altogether, you have to do:
# renaming names of each facets:
levels(g.m$variable) <- c("M1","M2","M3","M4")
# Defining annotations to add:
df_text <- data.frame(label = c("Calibration", "Validation"),
x = c(740,760),
y = c(65,65),
hjust = c(1,0),
variable = factor("M1", levels = c("M1","M2","M3","M4")))
# Plotting
ggplot(g.m, aes(x = Pos))+
geom_line(aes(y = OBS), color = "black")+
geom_line(aes(y = SIM), color = "blue")+
geom_vline(xintercept = 750,color = "red", size = 1.5)+
geom_ribbon(aes(ymin = UP, ymax = LOW), fill = "grey70")+
facet_wrap(variable~., ncol = 1)+
theme(strip.text.x = element_text(hjust = 0),
strip.background = element_rect(fill = "white"))+
geom_text(data = df_text, aes(x = x, y = y, label = label, hjust = hjust), color = "red")
Does it look what you are expecting ?
I was trying to plot some predicted vs. actual data, something that resembles the following:
# Some random data
x <- seq(1: 10)
y_pred <- runif(10, min = -10, max = 10)
y_obs <- y_pred + rnorm(10)
# Faking a CI
Lo.95 <- y_pred - 1.96
Hi.95 <- y_pred + 1.96
my_df <- data.frame(x, y_pred, y_obs, Lo.95, Hi.95)
ggplot(my_df, aes(x = x, y = y_pred)) +
geom_line(aes(colour = "Forecasted Data"), size = 1.2) +
geom_point(aes(x = x, y = y_obs, colour = "Actual Data"), size = 3) +
geom_ribbon(aes(ymin=Lo.95, ymax=Hi.95, x=x, linetype = NA, colour = "Confidence Interval"), alpha=0.2) +
theme_grey() +
scale_colour_manual(
values = c("gray30", "blue", "red"),
guide = guide_legend(override.aes = list(
border=c(NA, NA, NA),
fill=c("gray30", "white", "white"),
linetype = c("blank", "blank", "solid"),
shape = c(NA, 19, NA))))
The plot looks like this:
The only issue I have with this plot is the red border surrounding the legend item symbol for the line (i.e. the forecasted data). Is there any way I can remove it without breaking the rest of my plot?
I think geom_ribbon was the problem. If we take its color & fill out of aes, everything looks fine
library(ggplot2)
# Some random data
x <- seq(1: 10)
y_pred <- runif(10, min = -10, max = 10)
y_obs <- y_pred + rnorm(10)
# Faking a CI
Lo.95 <- y_pred - 1.96
Hi.95 <- y_pred + 1.96
my_df <- data.frame(x, y_pred, y_obs, Lo.95, Hi.95)
m1 <- ggplot(my_df, aes(x = x, y = y_pred)) +
geom_point(aes(x = x, y = y_obs, colour = "Actual"), size = 3) +
geom_line(aes(colour = "Forecasted"), size = 1.2) +
geom_ribbon(aes(x = x, ymin = Lo.95, ymax = Hi.95),
fill = "grey30", alpha = 0.2) +
scale_color_manual("Legend",
values = c("blue", "red"),
labels = c("Actual", "Forecasted")) +
guides( color = guide_legend(
order = 1,
override.aes = list(
color = c("blue", "red"),
fill = c("white", "white"),
linetype = c("blank", "solid"),
shape = c(19, NA)))) +
theme_bw() +
# remove legend key border color & background
theme(legend.key = element_rect(colour = NA, fill = NA),
legend.box.background = element_blank())
m1
As we leave Confidence Interval out of aes, we no longer have its legend. One workaround is to create an invisible point and take one unused geom to manually create a legend key. Here we can use size/shape (credit to this answer)
m2 <- m1 +
geom_point(aes(x = x, y = y_obs, size = "Confidence Interval", shape = NA)) +
guides(size = guide_legend(NULL,
order = 2,
override.aes = list(shape = 15,
color = "lightgrey",
size = 6))) +
# Move legends closer to each other
theme(legend.title = element_blank(),
legend.justification = "center",
legend.spacing.y = unit(0.05, "cm"),
legend.margin = margin(0, 0, 0, 0),
legend.box.margin = margin(0, 0, 0, 0))
m2
Created on 2018-03-19 by the reprex package (v0.2.0).
A better way to address this question would be to specify show.legend = F option in the geom_ribbon(). This will eliminate the need for the second step for adding and merging the legend key for the confidence interval. Here is the code with slight modifications.
ggplot(my_dff, aes(x = x, y = y_pred)) +
geom_line(aes(colour = "Forecasted Data"), size = 1) +
geom_point(aes(x = x, y = y_obs, colour = "Actual Data"), size = 1) +
geom_ribbon(aes(ymin=Lo.95, ymax=Hi.95, x=x, linetype = NA, colour = "Confidence Interval"), alpha=0.2, show.legend = F) +
theme_grey() +
scale_colour_manual(
values = c("blue", "gray30", "red"))+
guides(color = guide_legend(
override.aes = list(linetype = c(1, 1, 0)),
shape = c(1, NA, NA),
reverse = T))
My plot
Credit to https://stackoverflow.com/users/4282026/marblo
for their answer to similar question.
I would like to add a vertical line by row to joy plots using ggridges.
# toy example
ggplot(iris, aes(x=Sepal.Length, y=Species, fill=..x..)) +
geom_density_ridges_gradient(jittered_points = FALSE, quantile_lines =
FALSE, quantiles = 2, scale=0.9, color='white') +
scale_y_discrete(expand = c(0.01, 0)) +
theme_ridges(grid = FALSE, center = TRUE)
I want to add a vertical line at 7 for virginica, 4 for versicolor, and 5 for setosa. Any ideas on how to do it?
Since your densities don't overlap, it may be easiest to just add additional segments.
iris_lines <- data.frame(Species = c("setosa", "versicolor", "virginica"),
x0 = c(5, 4, 7))
ggplot(iris, aes(x=Sepal.Length, y=Species, fill=..x..)) +
geom_density_ridges_gradient(jittered_points = FALSE, quantile_lines =
FALSE, quantiles = 2, scale=0.9, color='white') +
geom_segment(data = iris_lines, aes(x = x0, xend = x0, y = as.numeric(Species),
yend = as.numeric(Species) + .9),
color = "red") +
scale_y_discrete(expand = c(0.01, 0)) +
theme_ridges(grid = FALSE, center = TRUE)