Related
I have a Shiny dashboard which includes a line graph which tracks number of visitors on mon-thur and fri-sun periods per month for three years:
I originally also had an annotation which shaded the parts of the graph which occur during the Covid pandemic in Australia, i.e. 2020-03-01 to present. When ggplotly is called on the ggplot, it strips the annotations out. What I want to do is add the shading from 2020-03-01 to present back in. I've tried adding
%>% layout(
shapes = list(
list(type = "rect",
fillcolor = "blue", line = list(color = "blue"), opacity = 0.9,
x0 = "2020-03-01", x1 = Inf,
y0 = 0, y1 = Inf
)
)
after the ggplotly() call, but it doesn't do anything.
I also tried following the code in this question, but the shading doesn't start at the correct date, and it's also only on the first facet.
Reproducible code example:
date <- c("2019-01-01","2019-01-01","2019-02-01","2019-02-01","2019-03-01","2019-03-01","2019-04-01",
"2019-04-01","2019-05-01","2019-05-01","2019-06-01","2019-06-01","2019-07-01","2019-07-01",
"2019-08-01","2019-08-01","2019-09-01","2019-09-01","2019-10-01","2019-10-01","2019-11-01",
"2019-11-01","2019-12-01","2019-12-01","2020-01-01","2020-01-01","2020-02-01","2020-02-01",
"2020-03-01","2020-03-01","2020-04-01","2020-04-01","2020-05-01","2020-05-01","2020-06-01",
"2020-06-01","2020-07-01","2020-07-01","2020-08-01","2020-08-01","2020-09-01","2020-09-01",
"2020-10-01","2020-10-01","2020-11-01","2020-11-01","2020-12-01","2020-12-01","2021-01-01",
"2021-01-01","2021-02-01","2021-02-01","2021-03-01","2021-03-01","2021-04-01","2021-04-01",
"2021-05-01","2021-05-01","2021-06-01","2021-06-01","2019-01-01","2019-01-01","2019-02-01",
"2019-02-01","2019-03-01","2019-03-01","2019-04-01","2019-04-01","2019-05-01","2019-05-01",
"2019-06-01","2019-06-01","2019-07-01","2019-07-01","2019-08-01","2019-08-01","2019-09-01",
"2019-09-01","2019-10-01","2019-10-01","2019-11-01","2019-11-01","2019-12-01","2019-12-01",
"2020-01-01","2020-01-01","2020-02-01","2020-02-01","2020-03-01","2020-03-01","2020-04-01",
"2020-04-01","2020-05-01","2020-05-01","2020-06-01","2020-06-01","2020-07-01","2020-07-01",
"2020-08-01","2020-08-01","2020-09-01","2020-09-01","2020-10-01","2020-10-01","2020-11-01",
"2020-11-01","2020-12-01","2020-12-01","2021-01-01","2021-01-01","2021-02-01","2021-02-01",
"2021-03-01","2021-03-01","2021-04-01","2021-04-01","2021-05-01","2021-05-01","2021-06-01",
"2021-06-01")
location <- rep(c("1001", "1002"), c(60, 60))
daytype <- rep(c("mon-thur", "fri-sat"), 60)
visitors <- c(5694,6829,3087,4247,2814,4187,5310,6408,5519,5934,2817,4080,6762,6595,5339,6669,
4863,6137,8607,11974,4909,9103,7986,9493,15431,13044,6176,5997,6458,7694,5990,5419,
5171,8149,6091,7971,10677,10468,7782,7627,7210,9526,8554,9844,8262,9218,9418,9038,
13031,13418,7408,10621,6908,8122,8851,8861,7940,9179,5992,7026,7939,6923,8209,7815,
8190,7085,9136,7905,9784,8454,9467,9092,9183,8436,9029,8927,8828,8323,7679,7112,
1885,3156,6932,5530,6077,4975,4922,4008,5549,4557,3932,3395,4865,4820,5090,4529,
5407,4262,4858,4200,5101,4761,5108,4413,5209,4116,5405,4445,4140,2985,5589,4684,
5322,4540,4898,4214,5266,4188,5184,4555)
total <- data.frame(location, date, daytype, visitors)
mon_year_vis <- total %>%
ggplot() +
(
mapping =
aes(
x = as.Date(date),
y = visitors,
group = daytype,
color = daytype
)
) +
geom_line() +
geom_point(show.legend = FALSE, size = 1) +
scale_y_continuous(labels = comma) +
facet_wrap( ~location, ncol = 1, scales = "free") +
scale_x_date(date_labels = "%b-%y",
breaks = "3 month",
limits = range)
ggplotly(mon_year_vis)
this task is a bit more complex than it appears to be, since you use the scales_free argument in the facet_wrap call. Because of this you need a little helper that holds none global limits of the shaded areas and work with ggplot2::geom_rect else you could use ggplot2::annotate (for completeness I will list this option also). It is important to bear in mind that plotly seems to have issues with INF as limitations for coordinates when using plotly::ggplotly at least. (I will omit the lines until the declaration of your total variable)
# libraries needed to make things work
library(dplyr)
library(ggplot2)
library(plotly)
library(scales)
ggplot2::geom_rect
# needed for coordinates of shadowed area
helper <- total %>%
dplyr::group_by(location) %>%
dplyr::summarise(mv = max(visitors) , md = max(as.Date(date))) %>%
dplyr::ungroup()
mon_year_vis <- total %>%
ggplot() +
(
mapping =
aes(
x = as.Date(date),
y = visitors,
group = daytype,
color = daytype
)
) +
# insert the geom_rect before the lines so that plotly gets the layer order right
geom_rect(data = helper, aes(xmin = as.Date("2020-03-01"), xmax = md, ymin = 0, ymax = mv), alpha = 0.3, fill="blue", inherit.aes = FALSE) +
geom_line() +
geom_point(show.legend = FALSE, size = 1) +
scale_y_continuous(labels = comma) +
facet_wrap( ~location, ncol = 1, scales = "free") +
scale_x_date(date_labels = "%b-%y",
breaks = "3 month",
limits = range)
ggplotly(mon_year_vis)
ggplot2::annotate
mon_year_vis2 <- total %>%
group_by(daytype) %>%
mutate(maxy = max(visitors)) %>%
ggplot() +
(
mapping =
aes(
x = as.Date(date),
y = visitors,
group = daytype,
color = daytype
)
) +
# insert the annotate before the lines so that plotly gets the layer order right
annotate("rect", xmin=as.Date("2020-03-01"), xmax=max(as.Date(date)), ymin=0, ymax=max(visitors), alpha=0.2, fill="blue") +
geom_line() +
geom_point(show.legend = FALSE, size = 1) +
scale_y_continuous(labels = comma) +
facet_wrap( ~location, ncol = 1, scales = "free") +
scale_x_date(date_labels = "%b-%y",
breaks = "3 month",
limits = range)
ggplotly(mon_year_vis2)
The two resources I have used are: 1 2
I would like to create a raincloud plot. I have successfully done it. But I would like to know if instead of the density curve, I can put a histogram (it's better for my dataset).
This is my code if it can be usefull
ATSC <- ggplot(data = data, aes(y = atsc, x = numlecteur, fill = numlecteur)) +
geom_flat_violin(position = position_nudge(x = .2, y = 0), alpha = .5) +
geom_point(aes(y = atsc, color = numlecteur), position = position_jitter(width = .15), size = .5, alpha = 0.8) +
geom_point(data = sumld, aes(x = numlecteur, y = mean), position = position_nudge(x = 0.25), size = 2.5) +
geom_errorbar(data = sumld, aes(ymin = lower, ymax = upper, y = mean), position = position_nudge(x = 0.25), width = 0) +
guides(fill = FALSE) +
guides(color = FALSE) +
scale_color_brewer(palette = "Spectral") +
scale_y_continuous(breaks=c(0,2,4,6,8,10), labels=c("0","2","4","6","8","10"))+
scale_fill_brewer(palette = "Spectral") +
coord_flip() +
theme_bw() +
expand_limits(y=c(0, 10))+
xlab("Lecteur") + ylab("Age total sans check")+
raincloud_theme
I think we can maybe put the "geom_histogram()" but it doesn't work
Thank you in advance for your help !
(sources : https://peerj.com/preprints/27137v1.pdf
https://neuroconscience.wordpress.com/2018/03/15/introducing-raincloud-plots/)
This is actually not quite easy. There are a few challenges.
geom_histogram is "horizontal by nature", and the custom geom_flat_violin is vertical - as are boxplots. Therefore the final call to coord_flip in that tutorial. In order to combine both, I think best is switch x and y, forget about coord_flip, and use ggstance::geom_boxploth instead.
Creating separate histograms for each category is another challenge. My workaround to create facets and "merge them together".
The histograms are scaled way bigger than the width of the points/boxplots. My workaround scale via after_stat function.
How to nudge the histograms to the right position above Boxplot and points - I am converting the discrete scale to a continuous by mapping a constant numeric to the global y aesthetic, and then using the facet labels for discrete labels.
library(tidyverse)
my_data<-read.csv("https://data.bris.ac.uk/datasets/112g2vkxomjoo1l26vjmvnlexj/2016.08.14_AnxietyPaper_Data%20Sheet.csv")
my_datal <-
my_data %>%
pivot_longer(cols = c("AngerUH", "DisgustUH", "FearUH", "HappyUH"), names_to = "EmotionCondition", values_to = "Sensitivity")
# use y = -... to position boxplot and jitterplot below the histogram
ggplot(data = my_datal, aes(x = Sensitivity, y = -.5, fill = EmotionCondition)) +
# after_stat for scaling
geom_histogram(aes(y = after_stat(count/100)), binwidth = .05, alpha = .8) +
# from ggstance
ggstance::geom_boxploth( width = .1, outlier.shape = NA, alpha = 0.5) +
geom_point(aes(color = EmotionCondition), position = position_jitter(width = .15), size = .5, alpha = 0.8) +
# merged those calls to one
guides(fill = FALSE, color = FALSE) +
# scale_y_continuous(breaks = 1, labels = unique(my_datal$EmotionCondition))
scale_color_brewer(palette = "Spectral") +
scale_fill_brewer(palette = "Spectral") +
# facetting, because each histogram needs its own y
# strip position = left to fake discrete labels in continuous scale
facet_wrap(~EmotionCondition, nrow = 4, scales = "free_y" , strip.position = "left") +
# remove all continuous labels from the y axis
theme(axis.title.y = element_blank(), axis.text.y = element_blank(),
axis.ticks.y = element_blank())
Created on 2021-04-15 by the reprex package (v1.0.0)
I can't fix the colors of my heat-maps according to their values. Same values should have same colors. The goal is to keep all values below a certain threshold (0.05) in (constant) gray. For values greather than this threshold, the colors should gradually change from "firebrick1" to "firebrick4".
For example, "Plant 5"/"202004" = 70.6 is red if I use variable utilization2 and gray if I use variable utilization. How can I fix that?
library(tidyverse)
library(rlang)
MONTHS <- str_c("2020", sprintf("%02d", 1:12))
PLANTS <- str_c("Plant ", 1:5)
crossing(month = MONTHS, plant = PLANTS) %>%
mutate(utilization = runif(nrow(.), 70, 100)) %>%
mutate(utilization2 = if_else(plant == "Plant 2", utilization * 0.67, utilization)) -> d
draw_plot <- function(fill) {
fill <- ensym(fill)
d %>%
ggplot(mapping = aes(x = month, y = plant, fill = !!fill)) +
geom_tile(aes(width = 0.85, height = 0.85)) +
geom_text(aes(label = round(!!fill, 1)), color = "white") +
scale_x_discrete(expand=c(0,0)) +
scale_y_discrete(expand=c(0,0)) +
scale_fill_gradientn(colours = c("darkgray", "firebrick1", "firebrick4"),
values = c(0, 0.05, 1)) +
labs(x = "Month", y = "Production plant", title = str_c("fill = ", fill), color = "Utilization") +
theme_light() +
theme(legend.position = "none")
}
draw_plot(utilization)
draw_plot(utilization2)
library(tidyverse)
library(rlang)
MONTHS <- str_c("2020", sprintf("%02d", 1:12))
PLANTS <- str_c("Plant ", 1:5)
crossing(month = MONTHS, plant = PLANTS) %>%
mutate(utilization = runif(nrow(.), 70, 100)) %>%
mutate(utilization2 = if_else(plant == "Plant 2", utilization * 0.67, utilization)) -> d
draw_plot <- function(fill) {
fill <- ensym(fill)
d %>%
ggplot(mapping = aes(x = month, y = plant, fill = !!fill)) +
geom_tile(aes(width = 0.85, height = 0.85)) +
geom_text(aes(label = round(!!fill, 1)), color = "white") +
scale_x_discrete(expand=c(0,0)) +
scale_y_discrete(expand=c(0,0)) +
scale_fill_gradientn(colours = c("darkgray", "firebrick1", "firebrick4"),
values = c(0, 0.05, 1), limits = c(min(d$utilization, d$utilization2), max(d$utilization, d$utilization2))) +
labs(x = "Month", y = "Production plant", title = str_c("fill = ", fill), color = "Utilization") +
scale_color_identity() +
theme_light() +
theme(legend.position = "none")
}
draw_plot(utilization)
draw_plot(utilization2)
The point is that scale_fill_gradientn() sets the limits of the scale to max and min of the vector of interest. You have to set them manually. In this case I chose both the max and min of both columns (limits = c(min(d$utilization, d$utilization2), max(d$utilization, d$utilization2))).
The colours are interpolated between the values, so a trick you could do is is to set both 0 and 0.05 as gray, and begin the next colour at a very small increment to 0.05.
draw_plot <- function(fill) {
fill <- ensym(fill)
d %>%
ggplot(mapping = aes(x = month, y = plant, fill = !!fill)) +
geom_tile(aes(width = 0.85, height = 0.85)) +
geom_text(aes(label = round(!!fill, 1)), color = "white") +
scale_x_discrete(expand=c(0,0)) +
scale_y_discrete(expand=c(0,0)) +
scale_fill_gradientn(colours = c("darkgray", "darkgray", "firebrick1", "firebrick4"),
values = c(0, 0.05, 0.05 + .Machine$double.eps, 1)) +
labs(x = "Month", y = "Production plant", title = str_c("fill = ", fill), color = "Utilization") +
theme_light() +
theme(legend.position = "none")
}
draw_plot(utilization)
draw_plot(utilization2)
Maybe this is not necessary to mention, but the fill scale rescales all fill values to a range between 0-1 depending on the limits (see ?scales::rescale), so the 0.05 you put in the values argument is the bottom 5% of the range value and not unscaled data values in utilization that are below 0.05. If you want to have consistent fill scales over multiple plots, you'd have to set the limits argument manually.
I wanted to comment on the following doubt.
Using this code:
Plot<-data.frame(Age=c(0,0,0,0,0),Density=c(0,0,0,0,0),Sensitivity=c(0,0,0,0,0),inf=c(0,0,0,0,0),sup=c(0,0,0,0,0),tde=c(0,0,0,0,0))
Plot[1,]<-c(1,1,0.857,0.793,0.904,0.00209834)
Plot[2,]<-c(1,2,0.771 ,0.74,0.799,0.00348286)
Plot[3,]<-c(1,3,0.763 ,0.717,0.804,0.00577784)
Plot[4,]<-c(1,4,0.724 ,0.653,0.785,0.00504161)
Plot[5,]<-c(2,1,0.906,0.866,0.934,0.00365742)
Plot[6,]<-c(2,2,0.785 ,0.754,0.813,0.00440399)
Plot[7,]<-c(2,3,0.660,0.593,0.722,0.00542849)
Plot[8,]<-c(2,4,0.544,0.425,0.658,0.00433052)
names(Plot)<-c("Age","Mammographyc density","Sensitivity","inf","sup","tde")
Plot$Age<-c("50-59","50-59","50-59","50-59","60-69","60-69","60-69","60-69")
Plot$Density<-c("Almost entirely fat","Scattered fibroglandular density","Heterogeneously dense","Extremely dense","Almost entirely fat","Scattered fibroglandular density","Heterogeneously dense","Extremely dense")
levels(Plot$Age)<-c("50-59","60-69")
levels(Plot$Density)<-c("Almost entirely fat","Scattered fibroglandular density","Heterogeneously dense","Extremely dense")
pd <- position_dodge(0.2) #
Plot$Density <- reorder(Plot$Density, 1-Plot$Sensitivity)
ggplot(Plot, aes(x = Density, y = 100*Sensitivity, colour=Age)) +
geom_errorbar(aes(ymin = 100*inf, ymax = 100*sup), width = .1, position = pd) +
geom_line(position = pd, aes(group = Age), linetype = c("dashed")) +
geom_point(position = pd, size = 4)+
scale_y_continuous(expand = c(0, 0),name = 'Sensitivity (%)',sec.axis = sec_axis(~./5, name = 'Breast cancer detection rate (per 1000 mammograms)', breaks = c(0,5,10,15,20),
labels = c('0‰',"5‰", '10‰', '15‰', '20‰')), limits = c(0,100)) +
geom_line(position = pd, aes(x = Density, y = tde * 5000, colour = Age, group = Age), linetype = c("dashed"), data = Plot) +
geom_point(shape=18,aes(x = Density, y = tde * 5000, colour = Age, group = Age), position = pd, size = 4) +
theme_light() +
scale_color_manual(name="Age (years)",values = c("50-59"= "grey55", "60-69" = "grey15")) +
theme(legend.position="bottom") + guides(colour = guide_legend(), size = guide_legend(),
shape = guide_legend())
I have made the following graph,
in which the axis on the left is the scale of the circles and the axis on the right is the scale of the diamonds. The fact is that I would like to have a legend approximately like this:
But it is impossible for me, I have tried suggestions of other threads like scale_shape and different commands in guides but I have not got success. I just want to make clear the difference in what shape and color represent.
Would someone know how to help me?
Best regards,
What you should do is a panel plot to avoid the confusion of double axes:
library(dplyr)
library(tidyr)
Plot %>%
gather(measure, Result, Sensitivity, tde) %>%
ggplot(aes(x = Density, y = Result, colour=Age)) +
geom_errorbar(aes(ymin = inf, ymax = sup), width = .1, position = pd,
data = . %>% filter(measure == "Sensitivity")) +
geom_line(aes(group = Age), position = pd, linetype = "dashed") +
geom_point(position = pd, size = 4)+
# scale_y_continuous(expand = c(0, 0), limits = c(0, 1)) +
scale_y_continuous(labels = scales::percent) +
facet_wrap(~measure, ncol = 1, scales = "free_y") +
theme_light() +
scale_color_manual(name="Age (years)",values = c("50-59"= "grey55", "60-69" = "grey15")) +
theme(legend.position="bottom")
But to do what you asked, you problem is that you have only 1 non-positional aesthetic mapped so you cannot get more than one legend. To force a second legend, you need to add a second mapping. It can be a dummy mapping that has no effect, as below we map alpha but then manually scale both levels to 100%. This solution is not advisable because, as you have done in your example of a desired legend, it is easy to mix up the mappings and have your viz tell a lie by mislabeling which points are sensitivity and which are detection rate.
ggplot(Plot, aes(x = Density, y = 100*Sensitivity, colour=Age, alpha = Age)) +
geom_errorbar(aes(ymin = 100*inf, ymax = 100*sup), width = .1, position = pd) +
geom_line(position = pd, aes(group = Age), linetype = c("dashed")) +
geom_point(position = pd, size = 4)+
scale_y_continuous(expand = c(0, 0),name = 'Sensitivity (%)',sec.axis = sec_axis(~./5, name = 'Breast cancer detection rate (per 1000 mammograms)', breaks = c(0,5,10,15,20),
labels = c('0‰',"5‰", '10‰', '15‰', '20‰')), limits = c(0,100)) +
geom_line(position = pd, aes(x = Density, y = tde * 5000, colour = Age, group = Age), linetype = c("dashed"), data = Plot) +
geom_point(shape=18,aes(x = Density, y = tde * 5000, colour = Age, group = Age), position = pd, size = 4) +
theme_light() +
scale_color_manual(name="Age (years)",values = c("50-59"= "grey55", "60-69" = "grey15")) +
scale_alpha_manual(values = c(1, 1)) +
guides(alpha = guide_legend("Sensitivity"),
color = guide_legend("Detection Rate", override.aes = list(shape = 18))) +
theme(legend.position="bottom")
I'm looking to make a radar plot for multivariate data, a task simple enough for excel.
The problem comes when I would like to also plot some error bars on this. From what I understand, I cannot do this in excel. Is this possible on R?
Or can someone suggest an alternative? I have 32 single value dimensions.
Thanks!
I don't much like radar charts but here are some ideas to get you going, drawing on this approach. I like the look of my option 1 best, but I'm not sure how to solve the gap between var32 and var1 (I have some ideas, but a bit awkward).
library(tidyverse)
library(ggplot2)
library(scales)
# make some mock data
mydata <- data.frame(variable = paste0("Var", 1:32),
midpoint = rnorm(32),
stderr = rnorm(32, 1, 0.1),
stringsAsFactors = FALSE) %>%
mutate(upper = midpoint + 1.96 * stderr,
lower = midpoint - 1.96 * stderr) %>%
mutate(variable = factor(variable, levels = variable))
# Option 1:
mydata %>%
ggplot(aes(x = variable, y = midpoint, group = 1)) +
geom_ribbon(aes(ymin = lower, ymax = upper), fill = "grey50", alpha = 0.5) +
geom_line(colour = "purple") +
theme_light() +
theme(panel.grid.minor = element_blank()) +
coord_polar() +
labs(x = "", y = "")
# Option 2:
mydata %>%
gather(measure, value, -variable, -stderr) %>%
ggplot(aes(x = variable, y = value, colour = measure, group = measure, linetype = measure)) +
geom_polygon(fill = NA) +
theme_light() +
theme(panel.grid.minor = element_blank()) +
coord_polar() +
scale_colour_manual(values = c("steelblue", "black", "steelblue")) +
scale_linetype_manual(values = c(2,1,2)) +
labs(x = "", y = "")
# Option 3:
mydata %>%
ggplot(aes(x = variable, y = midpoint, group = 1)) +
geom_polygon(fill = NA, colour = "purple") +
geom_segment(aes(xend = variable, y = lower, yend = upper), colour = "grey50") +
geom_point(colour = "purple") +
theme_light() +
theme(panel.grid.minor = element_blank()) +
theme(panel.grid.major.x = element_blank()) +
coord_polar() +
labs(x = "", y = "")
Edit / addition
I think I prefer this one:
# Option 4:
mydata %>%
ggplot(aes(x = variable, y = midpoint, group = 1)) +
geom_polygon(aes(y = upper), fill = "grey50", alpha = 0.5) +
geom_polygon(aes(y = lower), fill = "grey99", alpha = 0.7) +
geom_polygon(fill = NA, colour = "purple") +
theme_light() +
theme(panel.grid.minor = element_blank()) +
coord_polar() +
labs(x = "", y = "")