I have a faceted plot made with ggplot that is already working, it shows data about river altitude against years. I'm trying to add arrows based on a second dataframe which details when floods occurred.
Here's the current plot:
I would like to draw arrows in the top part of each graph based on date information in my second dataframe where each row corresponds to a flood and contains a date.
The link between the two dataframes is the Station_code column, each river has one or more stations which is indicated by this data (in this case only the Var river has two stations).
Here is the dput of the data frame used to create the original plot:
structure(list(River = c("Durance", "Durance", "Durance", "Durance",
"Roya", "Var"), Reach = c("La Brillanne", "Les Mées", "La Brillanne",
"Les Mées", "Basse vallée", "Basse vallée"), Area_km = c(465,
465, 465, 465, 465, 465), Type = c("restored", "target", "restored",
"target", "witness", "restored"), Year = c(2017, 2017, 2012,
2012, 2018, 2011), Restoration_year = c(2013, 2013, 2013, 2013,
NA, 2009), Station_code = c("X1130010", "X1130010", "X1130010",
"X1130010", "Y6624010", "Y6442015"), BRI_adi_moy_sstransect = c(0.00375820736746399,
0.00244752138003355, 0.00446807607783864, 0.0028792618981479,
0.00989200896930529, 0.00357247516596474), SD_sstransect = c(0.00165574247612667,
0.0010044634990875, 0.00220534492332107, 0.00102694633805149,
0.00788573233793128, 0.00308489160008849), min_BRI_sstransect = c(0.00108123849595469,
0.00111493913953216, 0.000555500340370182, 0.00100279590198288,
0, 0), max_BRI_sstransect = c(0.0127781240385231, 0.00700537285706352,
0.0210216858227621, 0.00815151653110584, 0.127734814926934, 0.0223738711013954
), Nb_sstr_unique_m = c(0.00623321576795815, 0.00259754717331206,
0.00117035034437559, 0.00209845092352825, 0.0458628969163946,
3.60620609570031), BRI_adi_moy_transect = c(0.00280232169999531,
0.00173868254527501, 0.00333818552810438, 0.00181398859573415,
0.00903651639185542, 0.00447856455432537), SD_transect = c(0.00128472161839638,
0.000477209421076879, 0.00204050725984513, 0.000472466654940182,
0.00780731734792112, 0.00310039904793707), min_BRI_transect = c(0.00108123849595469,
0.00106445386542223, 0.000901992689363725, 0.000855135344651009,
0.000944414463851629, 0.000162012161197014), max_BRI_transect = c(0.00709151795418251,
0.00434366293208643, 0.011717024999411, 0.0031991369873946, 0.127734814926934,
0.0187952134332499), Nb_tr_unique_m = c(0, 0, 0, 0, 0, 0), Error_reso = c(0.0011,
8e-04, 0.0018, 0.0011, 0.0028, 0.0031), W_BA = c(296.553323029366,
411.056574923547, 263.944186046512, 363.32874617737, 88.6420798065296,
158.66866970576), W_BA_sd = c(84.1498544481585, 65.3909073242282,
100.067554749308, 55.5534084807705, 35.2337070278364, 64.6978349498119
), W_BA_min = c(131, 206, 33, 223, 6, 45), W_BA_max = c(472,
564, 657, 513, 188, 381), W_norm = c(5.73271228619998, 7.9461900926133,
5.10234066090722, 7.02355699765464, 5.09378494746752, 4.81262001531126
), W_norm_sd = c(1.62671218635823, 1.2640804493236, 1.93441939783807,
1.07391043231191, 2.02469218788178, 1.96236658443141), W_norm_min = c(2.53237866910643,
3.98221378500706, 0.637927450996277, 4.31084307794454, 0.344787822572658,
1.36490651299098), W_norm_max = c(9.12429566273463, 10.9027600715727,
12.7005556152895, 9.91687219276031, 10.8033517739433, 11.5562084766569
)), row.names = c(NA, -6L), class = c("tbl_df", "tbl", "data.frame"
))
And here is the dput of the date frame containing the flooding date:
structure(list(Station_code = c("Y6042010", "Y6042010", "Y6042010",
"Y6042010", "Y6042010", "Y6042010"), Date = structure(c(12006,
12007, 12016, 12017, 13416, 13488), class = "Date"), Qm3s = c(156,
177, 104, 124, 125, 90.4), Qual = c(5, 5, 5, 5, 5, 5), Year = c(2002,
2002, 2002, 2002, 2006, 2006), Month = c(11, 11, 11, 11, 9, 12
), Station_river = c("Var#Entrevaux", "Var#Entrevaux", "Var#Entrevaux",
"Var#Entrevaux", "Var#Entrevaux", "Var#Entrevaux"), River = c("Var",
"Var", "Var", "Var", "Var", "Var"), Mod_inter = c(13.32, 13.32,
13.32, 13.32, 13.32, 13.32), Qm3s_norm = c(11.7117117117117,
13.2882882882883, 7.80780780780781, 9.30930930930931, 9.38438438438438,
6.78678678678679), File_name = c("Var#Entrevaux.dat", "Var#Entrevaux.dat",
"Var#Entrevaux.dat", "Var#Entrevaux.dat", "Var#Entrevaux.dat",
"Var#Entrevaux.dat"), Station_name = c("#Entrevaux", "#Entrevaux",
"#Entrevaux", "#Entrevaux", "#Entrevaux", "#Entrevaux"), Reach = c("Daluis",
"Daluis", "Daluis", "Daluis", "Daluis", "Daluis"), Restauration_year = c(2009,
2009, 2009, 2009, 2009, 2009), `Area_km[BH]` = c(676, 676, 676,
676, 676, 676), Starting_year = c(1920, 1920, 1920, 1920, 1920,
1920), Ending_year = c("NA", "NA", "NA", "NA", "NA", "NA"), Accuracy = c("good",
"good", "good", "good", "good", "good"), Q2 = c(86, 86, 86, 86,
86, 86), Q5 = c(120, 120, 120, 120, 120, 120), Q10 = c(150, 150,
150, 150, 150, 150), Q20 = c(170, 170, 170, 170, 170, 170), Q50 = c(200,
200, 200, 200, 200, 200), Data_producer = c("DREAL_PACA", "DREAL_PACA",
"DREAL_PACA", "DREAL_PACA", "DREAL_PACA", "DREAL_PACA"), Coord_X_L2e_Z32 = c(959313,
959313, 959313, 959313, 959313, 959313), Coord_Y_L2e_Z32 = c(1893321,
1893321, 1893321, 1893321, 1893321, 1893321), Coord_X_L93 = c(1005748.88,
1005748.88, 1005748.88, 1005748.88, 1005748.88, 1005748.88),
Coord_Y_L93 = c(6324083.97, 6324083.97, 6324083.97, 6324083.97,
6324083.97, 6324083.97), New_FN = c("Var#Entrevaux.csv",
"Var#Entrevaux.csv", "Var#Entrevaux.csv", "Var#Entrevaux.csv",
"Var#Entrevaux.csv", "Var#Entrevaux.csv"), NA_perc = c(14.92,
14.92, 14.92, 14.92, 14.92, 14.92), Q2_norm = c(6.45645645645646,
6.45645645645646, 6.45645645645646, 6.45645645645646, 6.45645645645646,
6.45645645645646), Q5_norm = c(9.00900900900901, 9.00900900900901,
9.00900900900901, 9.00900900900901, 9.00900900900901, 9.00900900900901
), Q10_norm = c(11.2612612612613, 11.2612612612613, 11.2612612612613,
11.2612612612613, 11.2612612612613, 11.2612612612613), Q20_norm = c(12.7627627627628,
12.7627627627628, 12.7627627627628, 12.7627627627628, 12.7627627627628,
12.7627627627628), Q50_norm = c(15.015015015015, 15.015015015015,
15.015015015015, 15.015015015015, 15.015015015015, 15.015015015015
)), row.names = c(NA, -6L), groups = structure(list(Station_code = "Y6042010",
.rows = structure(list(1:6), ptype = integer(0), class = c("vctrs_list_of",
"vctrs_vctr", "list"))), row.names = 1L, class = c("tbl_df",
"tbl", "data.frame"), .drop = TRUE), class = c("grouped_df",
"tbl_df", "tbl", "data.frame"))
EDIT
Here is an example of what I would like to do on the plot:
This is the code I use currently to do the plot:
ggplot(data = tst_formule[tst_formule$River != "Roya",], aes(x = Year, y = BRI_adi_moy_transect, shape = River, col = Type)) +
geom_point(size = 3) +
geom_errorbar(aes(ymin = BRI_adi_moy_transect - SD_transect, ymax = BRI_adi_moy_transect + SD_transect), size = 0.7, width = 0.3) +
geom_errorbar(aes(ymin = BRI_adi_moy_transect - Error_reso, ymax = BRI_adi_moy_transect + Error_reso, linetype = "Error due to resolution"), size = 0.3, width = 0.3, colour = "black") +
scale_linetype_manual(name = NULL, values = 2) +
scale_shape_manual(values = c(15, 18, 17, 16)) +
scale_colour_manual(values = c("chocolate1", "darkcyan")) +
new_scale("linetype") +
geom_vline(aes(xintercept = Restoration_year, linetype = "Restoration"), colour = "chocolate1") +
scale_linetype_manual(name = NULL, values = 5) +
new_scale("linetype") +
geom_hline(aes(yintercept = 0.004, linetype = "Threshold"), colour= 'black') +
scale_linetype_manual(name = NULL, values = 4) +
scale_y_continuous("BRI*", limits = c(min(tst_formule$BRI_adi_moy_transect - tst_formule$SD_transect, tst_formule$BRI_adi_moy_transect - tst_formule$Error_reso ), max(tst_formule$BRI_adi_moy_transect + tst_formule$SD_transect, tst_formule$BRI_adi_moy_transect + tst_formule$Error_reso))) +
scale_x_continuous(limits = c(min(tst_formule$Year - 1),max(tst_formule$Year + 1)), breaks = scales::breaks_pretty(n = 6)) +
theme_bw() +
facet_wrap(vars(River)) +
theme(legend.spacing.y = unit(-0.01, "cm")) +
guides(shape = guide_legend(order = 1),
colour = guide_legend(order = 2),
line = guide_legend(order = 3))
After tests and more research, I managed to do it by adding the second dataframe in geom_text():
new_scale("linetype") +
geom_segment(data = Flood_plot, aes(x = Date, xend = Date, y = 0.025, yend = 0.020, linetype = "Morphogenic flood"), arrow = arrow(length = unit(0.2, "cm")), inherit.aes = F, guide = guide_legend(order = 6)) +
scale_linetype_manual(name = NULL, values = 1) +
new_scale() creates a new linetype definition after the ones I created before, geom_segment() allows to draw arrows which I wanted but it works with geom_text() and scale_linetype_manual() draws the arrow in the legend without the mention "linetype" above. The second dataframe has the same column (River) as the 1st one to wrap and create the panels.
Related
I would like to visualize consumer sentiment by day&year throughout different years. For example, I am interested in comparing consumer sentiment in Dec 18th of 2011, to Dec 18th in 2012.
Currently, I have been able to do so by month&year, but I want to visualize the data at a more granular level.
#Creating a month-year variable
valences_by_post<- valences_by_post %>%
mutate(month_year = zoo::as.yearmon(date))
#2011 & 2012
valence_11_12<-valences_by_post %>%
filter(year == 2011 | year ==2012)%>%
group_by(month_year) %>%
summarize(mean_valence= mean(valence), n=n())
ggplot(valence_11_12, aes(x =factor(month_year), y = mean_valence, group=1)) +
geom_point() +
geom_line()+
geom_smooth()+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5))
Which produces:
However, to compute sentiment by day&year, and visualize across different years, I ran the following:
valences_by_post<- valences_by_post %>%
mutate(year_day = paste(lubridate::year(date), lubridate::yday(date), sep = "-"))
head(valences_by_post$year_day)
valence_day<-valences_by_post %>%
filter(year == 2011| year == 2012)%>%
group_by(year_day) %>%
summarize(mean_valence= mean(valence), n=n())
And then the graph, but I receive an error that, "Error: Discrete value supplied to continuous scale" because the year_day variable is stored as "character", and I was wondering if there is a workaround for this or an equivalent of the "zoo::as.yearmon(date))" function from other packages?
ggplot(valence_day, aes(x =year_day, y = mean_valence)) +
geom_point() +
geom_line()+
scale_x_continuous(breaks=seq(1,365,1)) +
geom_smooth()
Here are data samples:
dput(head(valence_day,5))
structure(list(year_day = c("2011-175", "2011-176", "2011-177",
"2011-182", "2011-189"), mean_valence = c(0, 0.0806100217864924,
0.0714285714285714, 0, 0.5), n = c(1L, 9L, 1L, 1L, 1L)), row.names = c(NA,
-5L), class = c("tbl_df", "tbl", "data.frame"))
And
dput(head(valences_by_post,5))
structure(list(document = c("1", "2", "3", "4", "5"), positive = c(1,
0, 2, 1, 1), negative = c(1, 1, 0, 0, 1), total_words = c(34,
13, 4, 3, 6), valence = c(0, -0.0769230769230769, 0.5, 0.333333333333333,
0), date = structure(c(1308873600, 1308960000, 1308960000, 1308960000,
1308960000), class = c("POSIXct", "POSIXt"), tzone = "UTC"),
year = c(2011, 2011, 2011, 2011, 2011), month = c(6, 6, 6,
6, 6), year_day = c("2011-175", "2011-176", "2011-176", "2011-176",
"2011-176"), month_year = structure(c(2011.41666666667, 2011
IMHO there is no need to add a year_day. Basically this is the same as the date. Hence, you could do your computations by converting your date (which is a datetime object) to a Date . And to show the yearday in the plot this could be achieved via the labels argument of scale_x_date:
library(dplyr)
library(ggplot2)
valence_day <- valences_by_post %>%
filter(year %in% c(2011, 2012)) %>%
group_by(date = as.Date(date)) %>%
summarize(mean_valence = mean(valence), n = n())
ggplot(valence_day, aes(x = date, y = mean_valence)) +
geom_point() +
geom_line() +
scale_x_date(labels = ~ paste(lubridate::year(.x), lubridate::yday(.x), sep = "-")) +
geom_smooth()
DATA
valences_by_post <- structure(list(
document = c("1", "2", "3", "4", "5"), positive = c(
1,
0, 2, 1, 1
), negative = c(1, 1, 0, 0, 1), total_words = c(
34,
13, 4, 3, 6
), valence = c(
0, -0.0769230769230769, 0.5, 0.333333333333333,
0
), date = structure(c(
1308873600, 1308960000, 1308960000, 1308960000,
1308960000
), class = c("POSIXct", "POSIXt"), tzone = "UTC"),
year = c(2011, 2011, 2011, 2011, 2011), month = c(
6, 6, 6,
6, 6
), month_year = structure(c(
2011.41666666667, 2011.41666666667,
2011.41666666667, 2011.41666666667, 2011.41666666667
), class = "yearmon")
), row.names = c(
NA,
5L
), class = "data.frame")
This is my dataframe:
df<-structure(list(year = c(1984, 1984), team = c("Australia", "Brazil"
), continent = c("Oceania", "Americas"), medal = structure(c(3L,
3L), .Label = c("Bronze", "Silver", "Gold"), class = "factor"),
n = c(84L, 12L)), row.names = c(NA, -2L), class = c("tbl_df",
"tbl", "data.frame"))
And this is my ggplot (my question is related to the annotations regard Brazil label):
ggplot(data = df)+
geom_point(aes(x = year, y = n)) +
geom_text_repel(aes(x = year, y = n, label = team),
size = 3, color = 'black',
seed = 10,
nudge_x = -.029,
nudge_y = 35,
segment.size = .65,
segment.curvature = -1,
segment.angle = 178.975,
segment.ncp = 1)+
coord_flip()
So, I have a segment divided by two parts. On both parts I have 'small braks'. How can I avoid them?
I already tried to use segment.ncp, change nudge_xor nudge_ynut its not working.
Any help?
Not really sure what is going on here. This is the best I could generate by experimenting with variations to the input values for segment... arguments.
There is some guidance at: https://ggrepel.slowkow.com/articles/examples.html which has an example with shorter leader lines, maybe that's an approach you could use.
df<-structure(list(year = c(1984, 1984), team = c("Australia", "Brazil"
), continent = c("Oceania", "Americas"), medal = structure(c(3L,
3L), .Label = c("Bronze", "Silver", "Gold"), class = "factor"),
n = c(84L, 12L)), row.names = c(NA, -2L), class = c("tbl_df",
"tbl", "data.frame"))
library(ggplot2)
library(ggrepel)
ggplot(data = df)+
geom_point(aes(x = year, y = n)) +
geom_text_repel(aes(x = year, y = n, label = team),
size = 3, color = 'black',
seed = 1,
nudge_x = -0.029,
nudge_y = 35,
segment.size = 0.5,
segment.curvature = -0.0000002,
segment.angle = 1,
segment.ncp = 1000)+
coord_flip()
Created on 2021-08-26 by the reprex package (v2.0.0)
I have data as follows, to which I am trying to add p-values:
library(ggplot2)
library(ggsignif)
library(dplyr)
data <- structure(list(treatment = c(0, 1, 0, 1, 0, 1, 0, 1, 0, 1), New_Compare_Truth = c(57,
61, 12, 14, 141, 87, 104, 90, 12, 14), total_Hy = c(135,
168, 9, 15, 103, 83, 238, 251, 9, 15), total = c(285, 305, 60,
70, 705, 435, 520, 450, 60, 70), ratio = c(47.3684210526316,
55.0819672131148, 15, 21.4285714285714, 14.6099290780142, 19.0804597701149,
45.7692307692308, 55.7777777777778, 15, 21.4285714285714), Type = structure(c(2L,
2L, 1L, 1L, 3L, 3L, 5L, 5L, 4L, 4L), .Label = c("A1. Others \nMore \nH",
"A2. Similar \nNorm", "A3. Others \nLess \nH", "B1. Others \nMore \nH",
"B2. Similar \nNorm or \nHigher"), class = "factor"), `Sample Selection` = c("Answers pr",
"Answers pu", "Answers pr", "Answers pu", "Answers pr",
"Answers pu", "Answers pr", "Answers pu", "Answers pr",
"Answers pu"), p_value = c(0.0610371842601616, 0.0610371842601616,
0.346302201593934, 0.346302201593934, 0.0472159407450147, 0.0472159407450147,
0.0018764377521242, 0.0018764377521242, 0.346302201593934, 0.346302201593934
), x = c(2, 2, 1, 1, 3, 3, 5.5, 5.5, 4.5, 4.5)), row.names = c(NA,
-10L), class = c("data.table", "data.frame"))
breaks_labels <- structure(list(Type = structure(c(2L, 1L, 3L, 5L, 4L), .Label = c("A1. Others \nMore \nH",
"A2. Similar \nNorm", "A3. Others \nLess \nH", "B1. Others \nMore \nH",
"B2. Similar \nNorm or \nHigher"), class = "factor"), x = c(2,
1, 3, 5.5, 4.5)), row.names = c(NA, -5L), class = c("data.table",
"data.frame"))
data %>%
ggplot(aes(x = x, y = ratio)) +
geom_col(aes(fill = `Sample Selection`), position = position_dodge(preserve = "single"), na.rm = TRUE) +
geom_text(position = position_dodge(width = .9), # move to center of bars
aes(label=sprintf("%.02f %%", round(ratio, digits = 1)), group = `Sample Selection`),
vjust = -1.5, # nudge above top of bar
size = 4,
na.rm = TRUE) +
# geom_text(position = position_dodge(width = .9), # move to center of bars
# aes(label= paste0("(", ifelse(variable == "Crime = 0", `Observation for Crime = 0`, `Observation for Crime = 1`), ")"), group = `Sample Selection`),
# vjust = -0.6, # nudge above top of bar
# size = 4,
# na.rm = TRUE) +
scale_fill_grey(start = 0.8, end = 0.5) +
scale_y_continuous(expand = expansion(mult = c(0, .1))) +
scale_x_continuous(breaks = breaks_labels$x, labels = breaks_labels$Type) +
theme_bw(base_size = 15) +
xlab("Norm group for corporate Hy") +
ylab("Percentage Compliant Decisions") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
geom_signif(annotation=c("p=0.35", "p=0.06", "p=0.05", "p=0.34", "p=0.00"), y_position = c(30, 40, 55 ,75, 90), xmin=c(0.75,1.75,2.75,3.75,4.75),
xmax=c(1.25,2.25,3.25,4.25,5.25))
For some reason, the last line causes the following error:
Error in f(...) :
Can only handle data with groups that are plotted on the x-axis
Since I am just putting in text and not referring to any variable, I don't really understand why this happens. Can anyone help me out? Without the last line it looks like this:
EDIT: Please note that I would like to keep the space between the third and the fourth column (which is apparently also what caused the problem, see Jared's answer).
Edit
Thanks for clarifying your expected outcome. Here is one way to include geom_signif() annotations without altering the original plot:
library(tidyverse)
library(ggsignif)
data <- structure(list(treatment = c(0, 1, 0, 1, 0, 1, 0, 1, 0, 1), New_Compare_Truth = c(57,
61, 12, 14, 141, 87, 104, 90, 12, 14), total_Hy = c(135,
168, 9, 15, 103, 83, 238, 251, 9, 15), total = c(285, 305, 60,
70, 705, 435, 520, 450, 60, 70), ratio = c(47.3684210526316,
55.0819672131148, 15, 21.4285714285714, 14.6099290780142, 19.0804597701149,
45.7692307692308, 55.7777777777778, 15, 21.4285714285714), Type = structure(c(2L,
2L, 1L, 1L, 3L, 3L, 5L, 5L, 4L, 4L), .Label = c("A1. Others \nMore \nH",
"A2. Similar \nNorm", "A3. Others \nLess \nH", "B1. Others \nMore \nH",
"B2. Similar \nNorm or \nHigher"), class = "factor"), `Sample Selection` = c("Answers pr",
"Answers pu", "Answers pr", "Answers pu", "Answers pr",
"Answers pu", "Answers pr", "Answers pu", "Answers pr",
"Answers pu"), p_value = c(0.0610371842601616, 0.0610371842601616,
0.346302201593934, 0.346302201593934, 0.0472159407450147, 0.0472159407450147,
0.0018764377521242, 0.0018764377521242, 0.346302201593934, 0.346302201593934
), x = c(2, 2, 1, 1, 3, 3, 5.5, 5.5, 4.5, 4.5)), row.names = c(NA,
-10L), class = c("data.table", "data.frame"))
breaks_labels <- structure(list(Type = structure(c(2L, 1L, 3L, 5L, 4L), .Label = c("A1. Others \nMore \nH",
"A2. Similar \nNorm", "A3. Others \nLess \nH", "B1. Others \nMore \nH",
"B2. Similar \nNorm or \nHigher"), class = "factor"), x = c(2,
1, 3, 5.5, 4.5)), row.names = c(NA, -5L), class = c("data.table",
"data.frame"))
annotation_df <- data.frame(signif = c("p=0.35", "p=0.06", "p=0.05", "p=0.34", "p=0.00"),
y_position = c(30, 40, 55 ,75, 90),
xmin = c(0.75,1.75,2.75,4.25,5.25),
xmax = c(1.25,2.25,3.25,4.75,5.75),
group = c(1,2,3,4,5))
data %>%
ggplot(aes(x = x, y = ratio, group = `Sample Selection`)) +
geom_col(aes(fill = `Sample Selection`),
position = position_dodge(preserve = "single"), na.rm = TRUE) +
geom_text(position = position_dodge(width = .9), # move to center of bars
aes(label=sprintf("%.02f %%", round(ratio, digits = 1))),
vjust = -1.5, # nudge above top of bar
size = 4,
na.rm = TRUE) +
scale_fill_grey(start = 0.8, end = 0.5) +
scale_y_continuous(expand = expansion(mult = c(0, .1))) +
scale_x_continuous(breaks = breaks_labels$x, labels = breaks_labels$Type) +
theme_bw(base_size = 15) +
xlab("Norm group for corporate Hy") +
ylab("Percentage Compliant Decisions") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
geom_signif(aes(xmin = xmin,
xmax = xmax,
y_position = y_position,
annotations = signif,
group = group),
data = annotation_df, manual = TRUE)
#> Warning: Ignoring unknown aesthetics: xmin, xmax, y_position, annotations
Created on 2021-07-20 by the reprex package (v2.0.0)
Previous answer
One potential solution to your problem is to plot "Type" on the x axis instead of "x", e.g.
data %>%
ggplot(aes(x = Type, y = ratio)) +
geom_col(aes(fill = `Sample Selection`),
position = position_dodge(preserve = "single"), na.rm = TRUE) +
geom_text(position = position_dodge(width = .9), # move to center of bars
aes(label=sprintf("%.02f %%", round(ratio, digits = 1)),
group = `Sample Selection`),
vjust = -1.5,
size = 4,
na.rm = TRUE) +
scale_fill_grey(start = 0.8, end = 0.5) +
scale_y_continuous(expand = expansion(mult = c(0, .1))) +
theme_bw(base_size = 15) +
xlab("Norm group for corporate Hy") +
ylab("Percentage Compliant Decisions") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
geom_signif(annotation=c("p=0.35", "p=0.06", "p=0.05", "p=0.34", "p=0.00"),
y_position = c(30, 40, 55 ,75, 90),
xmin=c(0.75,1.75,2.75,3.75,4.75),
xmax=c(1.25,2.25,3.25,4.25,5.25))
I want to show more dates in the x axis. Something like this: Mar 09, Mar 12, Mar 19 , etc
So this is my general data:
structure(list(Dia = structure(c(1583452800, 1583539200, 1583625600,
1583712000, 1583798400, 1583884800, 1583884800, 1583884800, 1583971200,
1584057600, 1584057600, 1584144000, 1584230400, 1584316800, 1584403200,
1584489600, 1584576000), class = c("POSIXct", "POSIXt"), tzone = "UTC"),
Hora = structure(c(-2209010400, -2209010400, -2209075200,
-2209044600, -2209046400, -2209039200, -2209023600, -2209003200,
-2209039500, -2209044600, -2209017600, -2209041000, -2209027800,
-2209040160, -2209038720, -2209050000, -2209032000), class = c("POSIXct",
"POSIXt"), tzone = "UTC"), Total_Pruebas = c(155, 219, 250,
318, 346, 652, 656, 714, 855, 983, 1232, 1545, 1822, 2315,
2680, 3075, 4075), Descartados = c(154, 213, 243, 309, 335,
640, 641, 697, 833, 955, 1194, 1502, 1751, 2229, 2563, 2930,
3841), Positivos = c(1, 6, 7, 9, 11, 12, 15, 17, 22, 28,
38, 43, 71, 86, 117, 145, 234), TasaPositivos = c(0.645161290322581,
2.73972602739726, 2.8, 2.83018867924528, 3.17919075144509,
1.84049079754601, 2.28658536585366, 2.38095238095238, 2.57309941520468,
2.84842319430315, 3.08441558441558, 2.7831715210356, 3.89681668496158,
3.71490280777538, 4.36567164179105, 4.71544715447155, 5.74233128834356
), Pruebas_dia = c(155, 64, 31, 99, 28, 306, 4, 58, 141,
128, 249, 313, 277, 493, 365, 395, 1000), Recuperados = c(NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1, 1, 1,
1)), row.names = c(NA, 17L), class = "data.frame")
This is my code
dat1 <- dat %>%
mutate(pos_new = Positivos-lag(Positivos,default = 0)) %>%
group_by(Dia) %>%
summarise(pos_new = sum(pos_new), tot_pruebas = sum(Pruebas_dia)) %>%
mutate(cum_pos = cumsum(pos_new))
This is dat1 data base:
structure(list(Dia = structure(c(1583452800, 1583539200, 1583625600,
1583712000, 1583798400, 1583884800, 1583971200, 1584057600, 1584144000,
1584230400, 1584316800, 1584403200, 1584489600, 1584576000), class = c("POSIXct",
"POSIXt"), tzone = "UTC"), pos_new = c(1, 5, 1, 2, 2, 6, 5, 16,
5, 28, 15, 31, 28, 89), tot_pruebas = c(155, 64, 31, 99, 28,
368, 141, 377, 313, 277, 493, 365, 395, 1000), cum_pos = c(1,
6, 7, 9, 11, 17, 22, 38, 43, 71, 86, 117, 145, 234)), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -14L))
and this is my final code:
f1 <- dat1 %>%
ggplot(aes(x = Dia)) +
geom_bar(aes(y = pos_new, fill = "Nuevos"), stat = "identity", alpha=.5) +
geom_line(aes(y = cum_pos, col = "Acumulados"), size=1) +
geom_point(aes(y = cum_pos), col = "#8B1C62") +
geom_text(aes(y = pos_new, label = pos_new), vjust = -0.8, col = "#43CD80") +
geom_text(aes(y = cum_pos, label = cum_pos), vjust = -0.8, col = "#8B1C62") +
labs(y = "Número de casos reportados", color = " Casos", fill = " ",
title = paste0("Número de casos confirmados \nhasta: ", Sys.Date())) +
scale_fill_manual(values = c("Nuevos" = "#43CD80")) +
scale_color_manual(values = c("Acumulados" = "#8B1C62")) +
scale_y_continuous(sec.axis = sec_axis(~ .)) +
theme_minimal() +
theme(legend.position="bottom")+
scale_x_continuous(breaks = seq(from =3-06-20 , to = 3-06-20, by = 1),
limits = c(3-06-20,3-19-20))
But I get this message:
Error in as.POSIXct.numeric(value) : 'origin' must be supplied
I want to show more dates ON THE X-AXIS ( from Mar 09 to Mar 19)
Instead of using scale_x_continuous you can use scale_x_datetime or scale_x_date. As your day Dia is already in POSIXct format, I used scale_x_datetime.
For your breaks, make sure to also put in POSIXct format. You can add labels to show Month Day using date_format from scales package.
library(ggplot2)
library(scales)
dat1 %>%
ggplot(aes(x = Dia)) +
geom_bar(aes(y = pos_new, fill = "Nuevos"), stat = "identity", alpha=.5) +
geom_line(aes(y = cum_pos, col = "Acumulados"), size=1) +
geom_point(aes(y = cum_pos), col = "#8B1C62") +
geom_text(aes(y = pos_new, label = pos_new), vjust = -0.8, col = "#43CD80") +
geom_text(aes(y = cum_pos, label = cum_pos), vjust = -0.8, col = "#8B1C62") +
labs(y = "Número de casos reportados", color = " Casos", fill = " ",
title = paste0("Número de casos confirmados \nhasta: ", Sys.Date())) +
scale_fill_manual(values = c("Nuevos" = "#43CD80")) +
scale_color_manual(values = c("Acumulados" = "#8B1C62")) +
scale_y_continuous(sec.axis = sec_axis(~ .)) +
theme_minimal() +
theme(legend.position="bottom") +
scale_x_datetime(breaks = seq(from = as.POSIXct("2020-03-06"), to = as.POSIXct("2020-03-20-20"), by = "1 days"), labels = date_format("%b %d"))
Note: As suggested by #Dave2e you can simplify scale_x_datetime:
scale_x_datetime(date_breaks = "1 day", date_labels = "%b %d")
Output
I'd like to create a waterfall chart similar to the one below in plotly with connecting bars between the waterfall segments, and it appears to be possible based on the below.
#would like a plot similar to this with connecting bars
library(waterfalls)
library(plotly)
waterfall(.data = data.frame(category = letters[1:5],
value = c(100, -20, 10, 20, 110)),
calc_total = T,
fill_by_sign = T)
#appears to be possible
p <- waterfall(.data = data.frame(category = letters[1:5],
value = c(100, -20, 10, 20, 110)),
calc_total = T,
fill_by_sign = T)
ggplotly(p)
Looking at the plotly graph it seems as if the letters labels are actually numbers(?). Though I'm not quite sure how to create the bar chart with number indices. Below is my try at getting it right. Could someone point me in the right direction here?
library(waterfalls)
library(plotly)
shap <- structure(list(values = c(5.82983875274658, 0, 0, 0, -0.0259701404720545, -0.103678397834301, -1.02624976634979, 0),
names = structure(1:8, .Label = c("bias", "speciessetosa", "speciesversicolor", "speciesvirginica", "sepal_width", "petal_width", "petal_length", "Ttl. Target Pred"), class = c("ordered", "factor")),
base = c(0, 5.82983875274658, 5.82983875274658, 5.82983875274658, 5.82983875274658, 5.80386861227453, 5.70019021444023, 0),
positive = c(5.82983875274658, 0, 0, 0, 0, 0, 0, 0),
negative = c(0, 0, 0, 0, -0.0259701404720545, -0.103678397834301, -1.02624976634979, 0),
shap_total = c(0, 0, 0, 0, 0, 0, 0, 4.67394044809043),
position = c(2.91491937637329, 5.82983875274658, 5.82983875274658, 5.82983875274658, 5.81685368251055, 5.75202941335738, 5.18706533126533, 2.33697022404522),
text_vals = c("5.83", "0", "0", "0", "-0.03", "-0.1", "-1.03", "4.67"), row_num = 1:8),
class = "data.frame", row.names = c(NA, -8L))
p <- plotly::plot_ly(shap, y = ~names, x = ~base, type = 'bar', marker = list(color = 'rgba(1,1,1, 0.0)')) %>%
add_trace(x = ~positive, marker = list(color = 'rgba(50, 171, 96, 0.7)',
line = list(color = 'rgba(50, 171, 96, 1.0)',
width = 2))) %>%
add_trace(x = ~negative, marker = list(color = 'rgba(219, 64, 82, 0.7)',
line = list(color = 'rgba(219, 64, 82, 1.0)',
width = 2))) %>%
add_trace(x = ~shap_total, marker = list(color = 'rgba(55, 128, 191, 0.7)',
line = list(color = 'rgba(55, 128, 191, 1.0)',
width = 2))) %>%
layout(title = 'SHAP Value Prediction Contributions',
xaxis = list(title = "Prediction Contribution"),
yaxis = list(title = ""),
barmode = 'stack',
showlegend = FALSE) %>%
add_annotations(text = ~text_vals,
y = ~names,
x = ~position,
xref = "x",
yref = "y",
font = list(family = 'Arial',
size = 12,
color = 'rgba(0, 0, 0, 1)'),
showarrow = FALSE)
p