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')
This question already has answers here:
Create a split violin plot with paired points and proper orientation
(2 answers)
Closed 10 months ago.
This post was edited and submitted for review 10 months ago and failed to reopen the post:
Original close reason(s) were not resolved
In this article: https://www.nature.com/articles/s41591-022-01744-z.epdf
I noticed an interesting plot:
2
Is there a simple way to do this in R?
EDIT: I am aware there are similar questions but none deal with the color-coding scheme that marks the improved / worsened cases.
The see package has a half violin geom like that:
ggplot(data = data.frame(id = rep(1:10, 2),
time = rep(c("A", "B"), each = 10),
value = runif(20)),
aes(time, value)) +
see::geom_violinhalf(aes(group = time, fill = time),
trim = FALSE, flip = 1, alpha = 0.2) +
geom_point(aes(color = time)) +
geom_line(aes(group = id))
You can get arbitrarily close to a chosen chart using ggplot:
ggplot(df, aes(xval, modularity, color = group)) +
geom_polygon(data = densdf, aes( x = y, y = x, fill = group), colour = NA) +
scale_fill_manual(values = c('#c2c2c2', '#fbc5b4')) +
scale_color_manual(values = c('#676767', '#ef453e')) +
geom_path(data = densdf, aes(x = y, y = x), size = 2) +
geom_segment(color = '#c2c2c2', inherit.aes = FALSE, size = 1.5,
data = df2[df2$`Post-treatment` > df2$Baseline,], alpha = 0.8,
aes(x = 1, xend = 2, y = Baseline, yend = `Post-treatment`)) +
geom_segment(color = '#ef453e', inherit.aes = FALSE, size = 1.5, alpha = 0.8,
data = df2[df2$`Post-treatment` < df2$Baseline,],
aes(x = 1, xend = 2, y = Baseline, yend = `Post-treatment`)) +
geom_point(size = 3) +
theme_classic() +
scale_x_continuous(breaks = 1:2, labels = c('Baseline', 'Post-treatment'),
name = '', expand = c(0.3, 0)) +
theme(legend.position = 'none',
text = element_text(size = 18, face = 2),
panel.background = element_rect(fill = NA, color = 'black', size = 1.5))
As long as you are prepared to do some work getting your data into the right format:
set.seed(4)
mod <- c(rnorm(16, 2.5, 0.25))
df <- data.frame(modularity = c(mod, mod + rnorm(16, -0.25, 0.2)),
xval = rep(c(1, 2), each = 16),
group = rep(c('Baseline', 'Post-treatment'), each = 16),
id = factor(rep(1:16, 2)))
df2 <- df %>% tidyr::pivot_wider(id_cols = id, names_from = group,
values_from = modularity)
BLdens <- as.data.frame(density(df$modularity[1:16])[c('x', 'y')])
PTdens <- as.data.frame(density(df$modularity[17:32])[c('x', 'y')])
BLdens$y <- 1 - 0.25 * BLdens$y
PTdens$y <- 2 + 0.25 * PTdens$y
densdf <- rbind(BLdens, PTdens)
densdf$group <- rep(c('Baseline', 'Post-treatment'), each = nrow(BLdens))
I am trying to draw a box on top of the plot on a specific x = Date and y = Price.
I have multiple Date entries stored in specificDates, but even though the code can be ran and doesn't output any errors, the box doesn't show on the plot.
dataDate <- as.Date(c("2015-01-01","2016-03-01","2018-06-01","2020-08-01"))
dataPrice <- c(170, 320, 7000,8000)
dummyData <- data.frame(dataDate, dataPrice)
specificDates <- as.Date(c("2016-07-15", "2020-05-20"))
plot_linPrice <- ggplot(data = dummyData,
mapping = aes(x = dataDate, y = dataPrice)) +
geom_line() +
scale_y_log10() +
geom_vline(xintercept = as.numeric(specificDates), color = "blue", lwd = .5) #+ #uncommenting + brings up error
geom_rect(aes(xmin = "2015-01-01", xmax = "2015-06-01", ymin = 5000, ymax = 8000), fill = "blue")
print(plot_linPrice)
Try with this:
library(ggplot2)
#Data
dataDate <- as.Date(c("2015-01-01","2016-03-01","2018-06-01","2020-08-01"))
dataPrice <- c(170, 320, 7000,8000)
dummyData <- data.frame(dataDate, dataPrice)
specificDates <- as.Date(c("2016-07-15", "2020-05-20"))
#Code
ggplot(data = dummyData,
mapping = aes(x = dataDate, y = dataPrice)) +
geom_line() +
scale_y_log10() +
geom_vline(xintercept = as.numeric(specificDates), color = "blue", lwd = .5)+
geom_rect(aes(xmin = as.Date("2015-01-01"), xmax = as.Date("2015-06-01"), ymin = 5000, ymax = 8000), fill = "blue")
Output:
I mean, I'd want to paint only the square area P1 X (Q1-Q2).
Not the trapezoid (P2+P1) X (Q1-Q2/2).
Here's code that I used. I used ggplot and dplyr. How can I solve this problem?
How can I paint the only square area not the trapezoied area!!!!
library(ggplot2)
library(dplyr)
supply <- Hmisc::bezier(x = c(1, 8, 9),
y = c(1, 5, 9)) %>%
as_data_frame()
demand <- Hmisc::bezier(c(1, 3, 9),
c(9, 3, 1)) %>%
as_data_frame()
fun_supply <- approxfun(supply$x, supply$y, rule = 2)
fun_supply(c(2, 6, 8))
fun_demand <- approxfun(demand$x, demand$y, rule = 2)
intersection_funs <- uniroot(function(x) fun_supply(x) - fun_demand(x), c(1, 9))
intersection_funs
y_root <- fun_demand(intersection_funs$root)
curve_intersect <- function(curve1, curve2) {
# Approximate the functional form of both curves
curve1_f <- approxfun(curve1$x, curve1$y, rule = 2)
curve2_f <- approxfun(curve2$x, curve2$y, rule = 2)
# Calculate the intersection of curve 1 and curve 2 along the x-axis
point_x <- uniroot(function(x) curve1_f(x) - curve2_f(x),
c(min(curve1$x), max(curve1$x)))$root
# Find where point_x is in curve 2
point_y <- curve2_f(point_x)
# Finish
return(list(x = point_x, y = point_y))
}
intersection_xy <- curve_intersect(supply, demand)
intersection_xy
intersection_xy_df <- intersection_xy %>% as_data_frame()
demand2 <- Hmisc::bezier(c(1.5, 3.5, 9.5),
c(9.5, 3.5, 1.5)) %>%
as_data_frame()
supply2 <- Hmisc::bezier(c(1,7,8),
c(3,7,11)) %>%
as_data_frame()
#Make a data frame of the intersections of the supply curve and both demand curves
intersections <- bind_rows(curve_intersect(supply, demand),
curve_intersect(supply2, demand2))
plot_labels <- data_frame(label = c("S", "D","S[1]","D[1]"),
x = c(9, 1, 6.5, 3),
y = c(8, 8, 8, 8))
ggplot(mapping = aes(x = x, y = y)) +
geom_path(data = supply, color = "#0073D9", size = 1, linetype = "dashed") +
geom_path(data = demand, color = "#FF4036", size = 1, linetype = "dashed") +
geom_path(data = demand2, color = "#FF4036", size = 1) +
geom_path(data = supply2, color = "#0073D9", size = 1) +
geom_segment(data = intersections,
aes(x = x, y = 0, xend = x, yend = y), lty = "dotted") +
geom_segment(data = intersections,
aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") +
geom_segment(data = intersections,
aes(x = x, y = y, xend = x, yend= y), lty = "dotted") +
geom_point(data = intersections, size = 3) +
geom_text(data = plot_labels,
aes(x = x, y = y, label = label), parse = TRUE) +
scale_x_continuous(expand = c(0, 0), breaks = intersections$x,
labels = expression(Q[1], Q[2])) +
scale_y_continuous(expand = c(0, 0), breaks = intersections$y,
labels = expression(P[1], P[2]))+
labs(x = "Quantity", y = "Price") +
geom_area(data =intersections, fill="#9999FF", alpha=0.5) +
theme_classic() +
coord_equal()
Could you help me to paint the area that I mentioned.
You might try adding geom_rect(data=intersections[1,], aes(xmin=0, xmax=x, ymin=0, ymax=y),fill='green', alpha=0.5) to your plot call.
So we have:
ggplot(mapping = aes(x = x, y = y)) +
geom_path(data = supply, color = "#0073D9", size = 1, linetype = "dashed") +
geom_path(data = demand, color = "#FF4036", size = 1, linetype = "dashed") +
geom_path(data = demand2, color = "#FF4036", size = 1) +
geom_path(data = supply2, color = "#0073D9", size = 1) +
geom_segment(data = intersections,
aes(x = x, y = 0, xend = x, yend = y), lty = "dotted") +
geom_segment(data = intersections,
aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") +
geom_segment(data = intersections,
aes(x = x, y = y, xend = x, yend= y), lty = "dotted") +
geom_point(data = intersections, size = 3) +
geom_text(data = plot_labels,
aes(x = x, y = y, label = label), parse = TRUE) +
scale_x_continuous(expand = c(0, 0), breaks = intersections$x,
labels = expression(Q[1], Q[2])) +
scale_y_continuous(expand = c(0, 0), breaks = intersections$y,
labels = expression(P[1], P[2]))+
labs(x = "Quantity", y = "Price") +
geom_area(data =intersections, fill="#9999FF", alpha=0.5) +
theme_classic() +
coord_equal()+
geom_rect(data=intersections[1,], aes(xmin=0, xmax=x, ymin=0, ymax=y),fill='green', alpha=0.5)
Edit based on comment:
geom_rect(data=intersections, aes(xmin=x[2], xmax=x[1], ymin=0, ymax=y[1]),fill='green', alpha=0.5)
Though the answer from J Con is in depth and does provide a solution, a cleaner approach in ggplot2 may be to use the annotate function, with geom and other arguments set appropriately. (See link for help page.)
This is because using something like geom_rect involves passing positions and so on as a data.frame, which is a bit more of a hack as, conceptually, from a grammar of graphics perspective, the data layer and the annotation layer are distinct: the act of mapping data variables to graphical aesthetics in a systematic and objective way, and of marking up features within the dataset in a piecemeal and subjective way, are separate activities, and using annotate explicitly for the latter purpose makes this divide clearer in terms of the code and concepts.
Edit
To be more specific, the annotate equivalent of the following:
geom_rect(data=intersections, aes(xmin=x[2], xmax=x[1], ymin=0, ymax=y[1]),fill='green', alpha=0.5)
Would likely be as follows
annotate(
geom = "rect",
xmin = intersections$x[2], x = intersections$x[1],
ymin = 0, ymax = intersections$y[1],
fill = 'green', alpha = 0.5
)
Functionally this is exactly the same, but conceptually it makes the separation between the data layer and the annotation layer much clearer in the code expressed.
Note: Annotate could also be used for the points and text.
I would like to add and nudge a text label in ggplot, but nudge_x when x is POSIXct class does not change anything, no matter the value. Sample code here:
library(ggplot2)
start.time <- c("7:00", "8:00", "9:30")
end.time <- c("10:00", "11:00", "13:30")
market <- c("Name1", "Name2", "Name3")
df <- data.frame(market, start.time, end.time)
df$start.time <- as.POSIXct(df$start.time, format="%H:%M")
df$end.time <- as.POSIXct(df$end.time, format="%H:%M")
df$length <- df$end.time - df$start.time
ggplot(df) +
geom_segment(aes(x = start.time, xend = end.time,
y = market, yend = market),
color = "darkgreen", size = 2) +
geom_text(aes(x = min(start.time), y = market, label = length),
hjust = 0, size = 3, color = "darkgreen", nudge_x = -1)
Creates this image:
I would like the labels for the length of the lines to be further to the left. I do not think nudge_x = -1 is registering because it is not the correct class.
Thanks!
As another option, you could put the labels inside the segments. For example:
library(dplyr)
ggplot(df) +
geom_segment(aes(x = start.time, xend = end.time,
y = market, yend = market),
color = "darkgreen", size = 5) +
geom_text(data=df %>% group_by(market) %>%
summarise(xval=mean(c(end.time, start.time)),
length=paste(length, "hours")),
aes(x = xval, y = market, label = length),
size = 3, color = "white") +
labs(x="Time") + theme_bw()
On datetime scale nudge_x=-1 shifts to left by 1 sec, which is not visible, may be you want to nudge by 1 hr (3600 secs):
ggplot(df) +
geom_segment(aes(x = start.time, xend = end.time,
y = market, yend = market),
color = "darkgreen", size = 2) +
geom_text(aes(x = min(start.time), y = market, label = length),
hjust = 0, size = 3, color = "darkgreen", nudge_x = -3600)
To nudge by 15 mins use to nudge_x = -15*60