I am using gganimate and I need 4 elements in the plot area:
A geom_line()
A geom_point()
A geom_abline() with static slope and color, varying intercept
Another geom_abline() with varying slope, color, and intercept
The first 3 elements are animated as I wanted:
where only geom_line() is gradually revealed, with geom_line() and the first geom_abline() showing only the data of that frame
But when I add the fourth layer this way (I need manual color palette), the past geom_abline() does not disappear:
I tried adding the argument transition_reveal(keep_last = F), and also trying to define different rules for different layers using multiple shadow_mark()'s, but nothing works so far.
Anyway to make sure the fourth layer only shows the current frame?
Current code:
temp_ani <-
ggplot(tab_temp, aes(tot, new_loess)) +
geom_line(size = 1.25) +
geom_point(size = 2) +
geom_abline(aes(slope = ref_log10m, intercept = ref_log10c), size = 1.1, linetype = "dashed", alpha = 0.3) +
geom_abline(aes(slope = trend_log10m, intercept = trend_log10c, color = ID_factor), size = 1.1, linetype = "dashed", alpha = 0.7,
show.legend = F) +
scale_color_manual(values = tab_temp[, trend_color]) +
transition_reveal(t) +
scale_x_continuous(name = "tot", trans = "log10", limits = c(24, 786.5)) +
scale_y_continuous(name = "new_loess", trans = "log10", limits = c(21, 601.7)) +
theme_classic() +
theme(axis.title = element_text(size = 18),
axis.text = element_text(size = 16))
animate(temp_ani)
example data (generated by dput):
tab_temp <-
structure(list(tot = c(24L, 26L, 26L, 36L, 42L, 49L, 50L, 53L,
56L, 56L, 57L, 60L, 62L, 65L, 69L, 69L, 69L, 75L, 81L, 85L, 91L,
93L, 94L, 95L, 100L, 101L, 101L, 105L, 105L, 108L, 110L, 115L,
116L, 121L, 130L, 132L, 138L, 142L, 149L, 158L, 168L, 193L, 209L,
257L, 274L, 318L, 357L, 387L, 411L, 454L, 519L, 583L, 642L, 683L,
715L),
new = c(22L, 21L, 21L, 28L, 34L, 41L, 40L, 41L, 43L, 42L,
42L, 44L, 45L, 44L, 45L, 43L, 43L, 39L, 39L, 36L, 41L, 40L, 38L,
39L, 43L, 41L, 39L, 40L, 36L, 39L, 41L, 40L, 35L, 36L, 39L, 39L,
44L, 47L, 49L, 57L, 67L, 88L, 104L, 149L, 164L, 203L, 241L, 266L,
281L, 322L, 381L, 441L, 493L, 525L, 547L),
t = 1:55,
new_loess = c(20.4718824559981,
21.7890308359201, 21.7890308359201, 29.230438378301, 34.1819985150492,
39.5079831823911, 40.0755079303131, 41.4099675429299, 42.370529571607,
42.370529571607, 42.8201044925118, 43.8252925663542, 44.3125327660056,
44.5559375847947, 43.3892881478697, 43.3892881478697, 43.3892881478697,
40.6214119319565, 38.4905820730386, 37.9720281923537, 39.2781675720742,
39.6852276451529, 39.9358369585547, 40.1843988106463, 39.903890056883,
39.8282043659178, 39.8282043659178, 39.5872985292962, 39.5872985292962,
39.1703139824658, 38.8033157618615, 37.6950388015054, 37.5718391291946,
37.3871340774544, 38.9365752067175, 39.8424253760653, 42.8908232704117,
45.2358046101902, 49.8927271106793, 56.9673605996446, 65.3666082472634,
88.2333199821777, 103.004387148103, 148.220525358668, 163.942873635871,
204.371579248934, 238.230045236249, 264.200021490433, 285.078351674107,
323.515728645106, 381.682707746736, 438.213805930832, 489.137706154487,
523.921712190664, 550.558894652666),
ID_factor = structure(1:55, .Label = c("1",
"2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13",
"14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24",
"25", "26", "27", "28", "29", "30", "31", "32", "33", "34", "35",
"36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46",
"47", "48", "49", "50", "51", "52", "53", "54", "55"), class = "factor"),
ref_log10m = c(NA, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1),
ref_log10c = c(NA, -0.0767354344741067, -0.0767354344741067,
-0.0904671721067551, -0.0894518394244057, -0.09351121980074,
-0.096090968882282, -0.107170979497638, -0.12112413490539,
-0.12112413490539, -0.124227132918044, -0.136426426370142,
-0.145865115840727, -0.16400776974052, -0.201466565659624,
-0.201466565659624, -0.201466565659624, -0.266306248714822,
-0.323130540124996, -0.349955131070593, -0.364890173692428,
-0.369854072675033, -0.371765062973866, -0.373666129954109,
-0.398984764767179, -0.404130646875006, -0.404130646875006,
-0.423633432928999, -0.423633432928999, -0.440466702695637,
-0.452523847307499, -0.484413645662749, -0.489595535070859,
-0.510063194866713, -0.523585603228512, -0.520228163317121,
-0.507514703991367, -0.496806024856726, -0.475149025512369,
-0.443030988676679, -0.409953330914954, -0.339924688141996,
-0.307290563603587, -0.239024775067351, -0.223058019569702,
-0.192006619096867, -0.17567168290562, -0.165778116414225,
-0.15887758283895, -0.147160452867149, -0.133464873299646,
-0.123982498866305, -0.118103885501835, -0.115154306972075,
-0.113502258448684),
trend_log10m = c(NA, 0.779013043966055,
0, 0.902838605051119, 1.01516626395308, 0.939364077071771,
0.705975457374834, 0.562156421073622, 0.41648278860048, 0,
0.596322729780414, 0.452366794075921, 0.337191122084057,
0.115926899508026, -0.444292873406387, 0, 0, -0.790549373381475,
-0.700116895372846, -0.281394397911645, 0.495820425082167,
0.474249915989644, 0.588583559834837, 0.586342537885251,
-0.136567884586587, -0.190797733928004, 0, -0.156205385180462,
0, -0.375890288287152, -0.513019327466591, -0.651879927019231,
-0.378107511884984, -0.116780389727616, 0.566005001030829,
1.50635698066896, 1.6585525574429, 1.86295886106405, 2.03632300098696,
2.26097387810847, 2.24108569839695, 2.16233918241475, 1.94348336584128,
1.76030953589316, 1.57398365165524, 1.48010286623756, 1.32513096747946,
1.28232849305659, 1.26407605433669, 1.27114179598159, 1.23567759206272,
1.18776534049548, 1.14041338808179, 1.10970817963632, 1.08307872430731
),
trend_log10c = c(NA, 0.235955218563125, 1.33823791349671,
0.0607453498302259, -0.114070466624236, 0.00897537944146443,
0.403447909576491, 0.647792138304764, 0.898973667615296,
1.62706389210081, 0.584579635667037, 0.837348243495363, 1.04214800866147,
1.43874016239004, 2.45437007136201, 1.63738252507763, 1.63738252507763,
3.09108352150306, 2.92151708503656, 2.1223914715644, 0.622818482734461,
0.665076002900152, 0.440012174544851, 0.444433997374107,
1.874151004406, 1.98261070308883, 1.60019072690764, 1.91327651912479,
1.59755586614094, 2.35730129445125, 2.63614274028582, 2.91961175246926,
2.35544952785373, 1.81595066271427, 0.393855239776779, -1.59399557640782,
-1.91673754895948, -2.35414232320695, -2.72727194089704,
-3.21548014224428, -3.17175285497492, -2.99651750205615,
-2.49630999086779, -2.07131990960092, -1.62228698944198,
-1.39342905195201, -1.00562316966424, -0.896362653634025,
-0.849130617820197, -0.867599348834218, -0.773368978244672,
-0.643279196748284, -0.512319390951289, -0.426113442696479,
-0.350634363184159),
trend_color = c(NA, "#a7ad06", "#00b51b",
"#c1ac03", "#d7a800", "#c9ac02", "#97ae08", "#78af0c", "#59b110",
"#00b51b", "#80af0b", "#61b00f", "#48b212", "#19b418", "#00a980",
"#00b51b", "#00b51b", "#009fcf", "#00a1bb", "#00ad5b", "#6ab00e",
"#65b00e", "#7eaf0b", "#7daf0b", "#00b13a", "#00b047", "#00b51b",
"#00b13f", "#00b51b", "#00aa71", "#00a790", "#00a3b0", "#00aa71",
"#00b236", "#79af0c", "#eb5400", "#f13a00", "#f91700", "#fb0006",
"#df002b", "#e20028", "#eb001b", "#fd0a00", "#f52900", "#ee4900",
"#ea5900", "#e37300", "#e27b00", "#e17e00", "#e17d00", "#e08300",
"#de8b00", "#dc9300", "#da9800", "#d99d00")),
row.names = c(NA, -55L), class = c("data.table", "data.frame"))
Assuming that tab_temp$trend_color is the same as tab_ani$trend_color (which you don't provide), I got your desired result by moving the color argument out of the aesthetics in the second geom_abline and setting color equal to trend_color. Then the scale_color_manual is unnecessary:
temp_ani <-
ggplot(tab_temp, aes(tot, new_loess)) +
geom_line(size = 1.25) +
geom_point(size = 2) +
geom_abline(aes(slope = ref_log10m, intercept = ref_log10c), size = 1.1, linetype = "dashed", alpha = 0.3) +
geom_abline(aes(slope = trend_log10m, intercept = trend_log10c), color = tab_temp$trend_color, size = 1.1, linetype = "dashed", alpha = 0.7,
show.legend = F) +
transition_reveal(t) +
scale_x_continuous(name = "tot", trans = "log10", limits = c(24, 786.5)) +
scale_y_continuous(name = "new_loess", trans = "log10", limits = c(21, 601.7)) +
theme_classic() +
theme(axis.title = element_text(size = 18),
axis.text = element_text(size = 16))
Related
Sorry if this is a duplicate question but I cannot seem to find the answer to my question anywhere. I have two plots and I would like to overlay plot two on plot one so that they form one plot. Is this possible? I will attach how both plots look separately. They are both facetted by the same variable which is by location and are on the same x and y-axis scale so theoretically should be possible.
Thank you.
## Plot one
Proxy<-read.csv("ALLRSL.csv",header=T)
p1<-ggplot()+
geom_ribbon(data=Proxy,aes(x=YEAR,ymin=LOWER,ymax=UPPER,fill=SITE),alpha=.5)+
geom_line(data=Proxy,aes(x=YEAR,y=RSL,col=SITE))+
facet_wrap(~ SITE,ncol= 1)+
scale_fill_manual(values=c("#4E193D","#342955","#4E617E","#97B4CB"))+
scale_color_manual(values=c("#4E193D","#342955","#4E617E","#97B4CB"))+
theme_classic()+
xlim(1900, 2020)+
theme(panel.grid.major.x = element_blank())+
theme(panel.grid.minor.x = element_blank())+
theme(panel.grid.minor.y = element_blank())+
theme(panel.grid.major.y = element_blank())+
theme(axis.title.x=element_blank(),
axis.text.x=element_blank(),
axis.ticks.x=element_blank())+
theme(
strip.background = element_blank(),
strip.text.x = element_blank()
)+
theme(legend.position="none")
p1
plot two
tgsm<-read.csv("tgsm.csv",header=T)
tgsm<-na.omit(tgsm)
tglonger<-pivot_longer(tgsm, cols=c(-Year),names_to="Site", values_to = "value")
p2<-ggplot()+
geom_point(data=tglonger,aes(x=Year,y=value,col=Site),alpha=.7,size=1)+
facet_wrap(~Site,ncol=1)+
theme_classic()+
xlim(1900,2020)+
scale_color_manual(values=c("#4E193D","#342955","#4E617E","#97B4CB"))+
theme(panel.grid.major.x = element_blank())+
theme(panel.grid.minor.x = element_blank())+
theme(panel.grid.minor.y = element_blank())+
theme(panel.grid.major.y = element_blank())+
theme(axis.title.x=element_blank(),
axis.text.x=element_blank(),
axis.ticks.x=element_blank())+
theme(
strip.background = element_blank(),
strip.text.x = element_blank()
)+
theme(legend.position="none")
p2
Data
Proxy <- structure(list(RSL = c(-0.305251214, -0.306414006, -0.307194187,
-0.308202139, -0.309150572, -0.309679123), UPPER = c(-0.182716456,
-0.186724068, -0.189331305, -0.193118273, -0.197069799, -0.20118809
), LOWER = c(-0.416725663, -0.413606073, -0.411131729, -0.408930899,
-0.406531588, -0.404478981), YEAR = 1820:1825, SITE = structure(c(1L,
1L, 1L, 1L, 1L, 1L), .Label = c("Little Swanport", "Lutregala",
"Tarra", "Wapengo"), class = "factor")), row.names = c(NA, 6L
), class = "data.frame")
tgsm <- structure(list(Year = 1993:1998, Lg2002 = c(-0.001164223, -0.002229453,
-0.002734792, -0.002977787, -0.002786098, -0.002026994), Wap2002 = c(-0.002531348,
-0.002051993, -0.001468704, -0.001182162, -0.001027132, -0.00020881
), Tar2002 = c(-0.029020612, -0.024330561, -0.019927593, -0.015682528,
-0.012907219, -0.009784772), LSP2002 = c(-0.034514531, -0.030171621,
-0.026095138, -0.021952898, -0.018480702, -0.014531318)), na.action = structure(c(`1` = 1L,
`2` = 2L, `3` = 3L, `4` = 4L, `5` = 5L, `6` = 6L, `7` = 7L, `8` = 8L,
`9` = 9L, `10` = 10L, `11` = 11L, `12` = 12L, `13` = 13L, `14` = 14L,
`15` = 15L, `16` = 16L, `17` = 17L, `18` = 18L, `19` = 19L, `20` = 20L,
`21` = 21L, `22` = 22L, `23` = 23L, `24` = 24L, `25` = 25L, `26` = 26L,
`27` = 27L, `28` = 28L, `29` = 29L, `30` = 30L, `31` = 31L, `32` = 32L,
`33` = 33L, `34` = 34L, `35` = 35L, `36` = 36L, `37` = 37L, `38` = 38L,
`39` = 39L, `40` = 40L, `41` = 41L, `42` = 42L, `43` = 43L, `44` = 44L,
`45` = 45L, `46` = 46L, `47` = 47L, `48` = 48L, `49` = 49L, `50` = 50L,
`51` = 51L, `52` = 52L, `53` = 53L, `54` = 54L, `55` = 55L, `56` = 56L,
`57` = 57L, `58` = 58L, `59` = 59L, `60` = 60L, `61` = 61L, `62` = 62L,
`63` = 63L, `64` = 64L, `65` = 65L, `66` = 66L, `67` = 67L, `68` = 68L,
`69` = 69L, `70` = 70L, `71` = 71L, `72` = 72L, `73` = 73L, `74` = 74L,
`75` = 75L, `76` = 76L, `77` = 77L, `78` = 78L, `79` = 79L, `80` = 80L,
`81` = 81L, `82` = 82L, `83` = 83L, `84` = 84L, `85` = 85L, `86` = 86L,
`87` = 87L, `88` = 88L, `89` = 89L, `90` = 90L, `91` = 91L, `92` = 92L,
`93` = 93L, `94` = 94L, `95` = 95L, `96` = 96L, `97` = 97L, `98` = 98L,
`99` = 99L, `100` = 100L, `101` = 101L, `102` = 102L, `103` = 103L,
`104` = 104L, `105` = 105L, `106` = 106L, `107` = 107L, `108` = 108L,
`109` = 109L, `110` = 110L, `111` = 111L, `112` = 112L, `113` = 113L,
`114` = 114L, `115` = 115L, `116` = 116L, `117` = 117L, `118` = 118L,
`119` = 119L, `120` = 120L, `121` = 121L, `122` = 122L, `123` = 123L,
`124` = 124L, `125` = 125L, `126` = 126L, `127` = 127L, `128` = 128L,
`129` = 129L, `130` = 130L, `131` = 131L, `132` = 132L, `133` = 133L,
`134` = 134L, `135` = 135L, `136` = 136L, `137` = 137L, `138` = 138L,
`139` = 139L, `140` = 140L, `141` = 141L, `142` = 142L, `143` = 143L,
`144` = 144L, `145` = 145L, `146` = 146L, `147` = 147L, `148` = 148L,
`149` = 149L, `150` = 150L, `151` = 151L, `152` = 152L, `153` = 153L,
`154` = 154L, `155` = 155L, `156` = 156L, `157` = 157L, `183` = 183L
), class = "omit"), row.names = 158:163, class = "data.frame")
See plot one how you can do that with patchwork.
However. Conceptually, I am guessing you want to add a sort of prediction to some historic values or so. I personally would put everything in one data frame and plot this. If there is a too large gap between the two time points, you can facet by timepoints (as in my suggestion).
The plots look a bit different than your plot because you only provided data for one Site in Proxy (so I filtered the other for what I thought is the equivalent, it will work nonetheless, because the faceting remains) - and I removed all those theme elements that are not relevant to the problem.
Plot one - combining plots.
library(tidyverse)
library(patchwork)
tgsm<-na.omit(tgsm)
tglonger <-
pivot_longer(tgsm, cols=c(-Year), names_to="SITE", values_to = "RSL") %>%
filter(SITE == "LSP2002") %>%
rename(YEAR = Year)
p1 <- ggplot() +
geom_ribbon(data = Proxy, aes(x = YEAR, ymin = LOWER, ymax = UPPER, fill = SITE), alpha = .5) +
geom_line(data = Proxy, aes(x = YEAR, y = RSL, col = SITE)) +
facet_wrap(~SITE) +
coord_cartesian(xlim = c(1800, 1830), ylim = c(-1, 0)) +
theme_classic() +
theme(
axis.title.x = element_blank(),
axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
strip.background = element_blank(),
strip.text.x = element_blank(),
legend.position = "none"
)
p2 <- ggplot() +
geom_point(data = tglonger, aes(x = YEAR, y = RSL, col = SITE), alpha = .7, size = 1) +
facet_wrap(~SITE) +
coord_cartesian(xlim = c(1990, 2000), ylim = c(-1, 0)) +
theme_classic() +
## only one call to theme!!
theme(
## this is where the theme call is different to above
axis.title = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.line.y = element_blank(),
strip.background = element_blank(),
strip.text.x = element_blank(),
legend.position = "none",
)
p1 + p2
Suggestion for an alternative visualisation
df_new <-
bind_rows(time1 = Proxy, time2 = tglonger, .id = "timevar") %>%
mutate(SITE = "LSP2002")
ggplot(df_new)+
geom_point(aes(x=YEAR,y=RSL))+
facet_grid(SITE~timevar, scales = "free_x")+
theme(legend.position="none") +
theme(panel.spacing = unit(.5, "lines"))
You can also use this data frame in order to create a list of plots, and then stitch it together with patchwork. This approach doesn't allow to change individual plots though.
ls_p <-
df_new %>%
split(., .$timevar) %>%
map(~{ggplot(.x)+
geom_point(aes(x=YEAR,y=RSL))+
coord_cartesian(ylim = c(-0.4,0))+
facet_grid(~SITE, scales = "free_x")+
theme(legend.position="none") +
theme(panel.spacing = unit(.5, "lines"))})
library(patchwork)
wrap_plots(ls_p)
I am creating a scatterplot using ggplot. I am able to create a scatterplot using the following code.
ggplot(df2, aes(x = date, y = mean, color = NULL)) +
geom_point(position = "jitter") +
labs(title = "ShotSpotter incidents around July 4th",
x = "Day of year", y = "Mean daily gunshots") +
labs(fill = "Treatment Status") +
geom_segment(aes(x = "07-01", xend = "07-01", y = 0, yend = 50), colour = "red")
I would like to change the labels on the x-axis so that they are easier to read. When I try to do so using scale_x_discrete(), most of the datapoints disappear except for those corresponding to the values now labeled on the x-axis.
ggplot(df2, aes(x = date, y = mean, color = NULL)) +
geom_point(position = "jitter") +
labs(title = "ShotSpotter incidents around July 4th",
x = "Day of year", y = "Mean daily gunshots") +
labs(fill = "Treatment Status") +
geom_segment(aes(x = "07-01", xend = "07-01", y = 0, yend = 50), colour = "red") +
scale_x_discrete(limits = c("05-01", "06-01", "07-01", "08-01", "09-01"),
labels = c("May 1", "June 1", "July 1", "Aug 1", "Sept 1"))
How can I keep the labels from the 2nd graph and include all the datapoints shown in the 1st?
Data using dput():
structure(list(date = structure(c(1L, 2L, 3L, 4L, 5L, 6L, 7L,
8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L,
21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L, 29L, 30L, 31L, 32L, 33L,
34L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 42L, 43L, 44L, 45L, 46L,
47L, 48L, 49L, 50L, 51L, 52L, 53L, 54L, 55L, 56L, 57L, 58L, 59L,
60L, 61L, 62L, 63L, 64L, 68L, 69L, 70L, 71L, 72L, 73L, 74L, 75L,
76L, 77L, 78L, 79L, 80L, 81L, 82L, 83L, 84L, 85L, 86L, 87L, 88L,
89L, 90L, 91L, 92L, 93L, 94L, 95L, 96L, 97L, 98L, 99L, 100L,
101L, 102L, 103L, 104L, 105L, 106L, 107L, 108L, 109L, 110L, 111L,
112L, 113L, 114L, 115L, 116L, 117L, 118L, 119L, 120L, 121L, 122L,
123L, 124L), .Label = c("05-01", "05-02", "05-03", "05-04", "05-05",
"05-06", "05-07", "05-08", "05-09", "05-10", "05-11", "05-12",
"05-13", "05-14", "05-15", "05-16", "05-17", "05-18", "05-19",
"05-20", "05-21", "05-22", "05-23", "05-24", "05-25", "05-26",
"05-27", "05-28", "05-29", "05-30", "05-31", "06-01", "06-02",
"06-03", "06-04", "06-05", "06-06", "06-07", "06-08", "06-09",
"06-10", "06-11", "06-12", "06-13", "06-14", "06-15", "06-16",
"06-17", "06-18", "06-19", "06-20", "06-21", "06-22", "06-23",
"06-24", "06-25", "06-26", "06-27", "06-28", "06-29", "06-30",
"07-01", "07-02", "07-03", "07-04", "07-05", "07-06", "07-07",
"07-08", "07-09", "07-10", "07-11", "07-12", "07-13", "07-14",
"07-15", "07-16", "07-17", "07-18", "07-19", "07-20", "07-21",
"07-22", "07-23", "07-24", "07-25", "07-26", "07-27", "07-28",
"07-29", "07-30", "07-31", "08-01", "08-02", "08-03", "08-04",
"08-05", "08-06", "08-07", "08-08", "08-09", "08-10", "08-11",
"08-12", "08-13", "08-14", "08-15", "08-16", "08-17", "08-18",
"08-19", "08-20", "08-21", "08-22", "08-23", "08-24", "08-25",
"08-26", "08-27", "08-28", "08-29", "08-30", "08-31", "09-01"
), class = "factor"), mean = c(13, 15, 16.5, 17.6666666666667,
14.5, 13.3333333333333, 11.8333333333333, 13, 13, 14.3333333333333,
13.8333333333333, 15.5, 11.1666666666667, 15, 12.5, 15.6666666666667,
14.5, 10.5, 11.6666666666667, 17.5, 14.5, 13, 14.6666666666667,
15.6666666666667, 21.3333333333333, 30.6666666666667, 18.5, 17.5,
13.5, 18.5, 13.3333333333333, 14.5, 14.8333333333333, 9.66666666666667,
15.8333333333333, 13.5, 20.5, 16.1666666666667, 15.1666666666667,
14.8333333333333, 15.3333333333333, 14.1666666666667, 14.5, 13.6666666666667,
20.1666666666667, 17.8333333333333, 22.3333333333333, 15.8333333333333,
15.5, 16.1666666666667, 15, 20, 20.8333333333333, 20.8333333333333,
25, 21.1666666666667, 18.1666666666667, 27, 19.5, 19.5, 19.6666666666667,
25.6666666666667, 36.8333333333333, 46.6666666666667, 40.5, 21.3333333333333,
16.3333333333333, 18, 20.1666666666667, 22.6666666666667, 16.8333333333333,
13.8333333333333, 14.5, 14.1666666666667, 16.5, 15.1666666666667,
15.1666666666667, 13.3333333333333, 13.3333333333333, 12.6666666666667,
12.8333333333333, 12.3333333333333, 16.5, 19.6666666666667, 16.3333333333333,
10.6666666666667, 13.1666666666667, 17.5, 10.3333333333333, 15.5,
12.1666666666667, 14.3333333333333, 13.8333333333333, 11.6666666666667,
13, 10.6666666666667, 17.5, 19.3333333333333, 12.6666666666667,
12.5, 12.5, 13.5, 15.8333333333333, 13.5, 15.6666666666667, 16.3333333333333,
14.5, 13.8333333333333, 14.3333333333333, 11, 13.3333333333333,
23.8333333333333, 14.1666666666667, 13.5, 13.3333333333333, 13.3333333333333,
14, 10.6666666666667, 14.3333333333333, 13.3333333333333, 13.1666666666667
)), class = "data.frame", row.names = c(NA, -121L))
df2$date <- as.Date(paste0("2000-", as.character(df2$date)))
ggplot(df2, aes(x = date, y = mean, color = NULL)) +
geom_point(position = "jitter") +
labs(title = "ShotSpotter incidents around July 4th",
x = "Day of year", y = "Mean daily gunshots") +
labs(fill = "Treatment Status") +
geom_segment(aes(x = as.Date("2000-07-01"), xend = as.Date("2000-07-01"), y = 0, yend = 50), colour = "red") +
scale_x_date(labels = scales::date_format("%b-%d"))
This required the two changes: as.Date (I'm supposing 2000 year just for something), and changing geom_segment so that x and xend are Date objects.
We can use
library(dplyr)
library(lubridate)
library(ggplot2)
df2 %>%
mutate(date = mdy(date, truncated = 2)) %>%
ggplot(aes(x = date, y = mean, color = NULL)) +
geom_point(position = "jitter") +
labs(title = "ShotSpotter incidents around July 4th",
x = "Day of year", y = "Mean daily gunshots") +
labs(fill = "Treatment Status") +
geom_segment(aes(x = mdy('07-01', truncated = 2),
xend = mdy('07-01', truncated = 2), y=0, yend = 50), colour = 'red') +
scale_x_date(labels = scales::date_format("%b-%d"))
-output
So I thought this was going to be simple using the following:
df <- structure(list(time_bin = c("00", "01", "02", "03", "04", "05",
"06", "07", "08", "09", "10", "11", "12", "13", "14", "15", "16",
"17", "18", "19", "20", "21", "22", "23"), count = c(33L, 35L,
35L, 27L, 24L, 22L, 47L, 73L, 84L, 90L, 131L, 122L, 91L, 97L,
78L, 70L, 56L, 50L, 54L, 37L, 40L, 25L, 24L, 31L)), row.names = c(NA,
-24L), class = c("tbl_df", "tbl", "data.frame"))
And using the following code, get a plot with the color specified below. However this still does not plot...
ggplot(time_bin_counts, aes(y=count, x=as.factor(time_bin), color = "mediumpurple2" )) +
geom_line() +
labs(x = "Day of the Week", y = "Injury", fill = "") +
lims(y = c(0,150)) +
theme_hc() +
theme(axis.text.x=element_text(angle = 45))
You can try this:
ggplot(df, aes(y=count, x=as.factor(time_bin),group=1 )) +
geom_line(color = "mediumpurple2") +
labs(x = "Day of the Week", y = "Injury", fill = "") +
lims(y = c(0,150)) +
theme(axis.text.x=element_text(angle = 45))
Output:
I am trying to add a scatterplot and a barplot within the same plot area with ggplot. The scatterplot should be averages of var. '1' over var.'2' for one dataset, and the barplot should be the average value of '1' over my control dataset.
My data looks like this:
> dput(lapply(ubbs6, head))
list(structure(c(96L, 96L, 100L, 88L, 93L, 100L, 61L, 61L, 70L,
40L, 58L, 70L, 7807L, 7357L, 7695L, 6400L, 6009L, 7735L), .Dim = c(6L,
3L), .Dimnames = list(NULL, c("1", "2", "3"))), structure(c(99L,
96L, 100L, 96L, 96L, 96L, 66L, 67L, 70L, 63L, 57L, 62L, 7178L,
6028L, 6124L, 6082L, 6873L, 5629L, 31L, 27L, 60L, 42L, 12L, 18L
), .Dim = c(6L, 4L), .Dimnames = list(NULL, c("1", "2",
"3", "4"))), structure(c(99L, 95L, 95L, 100L, 96L, 95L, 69L,
58L, 56L, 70L, 61L, 65L, 6067L, 6331L, 6247L, 5988L, 7538L, 6162L,
50L, 36L, 67L, 10L, 55L, 70L), .Dim = c(6L, 4L), .Dimnames = list(
NULL, c("1", "2", "3", "4"))))
Example of what I've tried so far:
aggregate(ubbs6[[2]][,'1'], list(ubbs6[[2]][,'2']), mean)
m162 <- aggregate(ubbs6[[2]][,'1'], list(ubbs6[[2]][,'2']), mean)
m163 <- aggregate(ubbs6[[3]][,'1'], list(ubbs6[[3]][,'2']), mean)
m161 <- mean(ubbs6[[1]][,'1'])
ggplot(m162, aes_(x = m162[,'Group.1'], y = m162[,'x']))+
geom_point()+
geom_smooth(method = 'lm', formula = 'y ~ sqrt (x)')
I would like to do two things:
add a barplot of one x,y value of my control set (ubbs6[[1]])
throw this into a lapply structure so I can do this for 11 similar datasets
Any help would be greatly appreciated!
**EDIT: edited out specific details that aren't needed for others to understand the code **
Saving your data in d, you can try
ggplot(as.data.frame(d[[2]]),aes(age, FPAR) ) +
coord_cartesian(ylim = c(90,100)) +
geom_point() +
geom_smooth(method = 'lm', formula = 'y ~ sqrt (x)') +
geom_col(data=data.frame(x=max(as.data.frame(d[[2]])$age),
y=mean(as.data.frame(d[[1]])$FPAR)),
aes(x,y), inherit.aes = FALSE)
You have to use coord_cartesian to specify the y-limits and inherit.aes = FALSE. Otherwise the bar is not correctly drawn.
When you have to combine your second and third dataframe in one plot, you can try
library(tidyverse)
d %>%
.[2:3] %>%
map(as.data.frame) %>%
bind_rows(.id = "id") %>%
mutate(max = max(age),
Mean = mean(d[[1]][1])) %>%
ggplot(aes(age, FPAR, color=id)) +
geom_point() +
geom_smooth(method = 'lm', formula = 'y ~ sqrt (x)', se=FALSE) +
geom_col(data = . %>% distinct(max, Mean),
aes(max, Mean), inherit.aes = FALSE)
I have a dataframe df
df<-structure(list(X = c(540.857881018969, 179.756453922596, 375.597673455575,
-24.7802579900034, 435.072227193852, 316.91305374488, 385.910199259729,
118.282069554042, 47.0931945371692, 46.8541543075746, -1.34917072989697,
-7.85914134272889, -74.1514974421857, -14.1349095526425, -180.103770130757,
-138.258618377921, 189.011576650288, 69.2480232224876, 42.356103377609,
-330.116265944969, 12.2073132306264, 82.0963304851313, -76.2883430762099,
13.7563014075505, 286.364096895997, 238.289414874803, 192.304857815893,
196.85181686938, 545.585335607164, 380.551416666209, 285.533878238757,
349.173312050698, 234.149820388793, 182.680602233473, 123.508718623119,
-59.3666813922188, 309.812271637758, 378.745487723212, 383.286192402579,
407.250999438653, 968.521681377846, 168.221917301957, 308.817578621267,
187.43921153459, 219.229124870899, 273.756349813256, 330.797398870288,
310.938292903419, 285.256002320225, 404.534158133551, 298.161606939762,
96.4609965966811, 237.259654760246, 410.903483047603, 453.107209854966,
476.020674679612, 390.865258755938, -148.590524527974, 109.883635942258,
78.869912902272, 782.478670456904, 245.257050602357, 308.573221705999,
568.136911803784, 163.617826469925, 210.109579924637, 175.657357919781,
175.760684810558, -254.181869342232, 288.452497381572), Y = c(436.783385497984,
55.1825021383702, 526.4133417369, 560, 391.49284084118, -519.814235572849,
11.5525291214872, 162.441016515717, 39.0395567645998, -70.4910326673707,
17.1155716306239, -106.326129257097, -94.9308303585276, -66.4285516217351,
-144.929052323413, -220.613145695315, 157.129576861289, 44.1257786633602,
46.8326830295943, -146.719591499443, 30.8043649939355, -4.10548956954153,
-108.258462657337, 90.3369144331664, 126.866108251153, 42.9489971246803,
690.903947139159, -45.4886732113082, 483.932040393885, 618.930183215125,
590.754048774834, 82.1480000555981, 76.8863707484328, 404.007940533033,
202.629066249886, -46.9675149230141, 557.939170770813, 333.76992898155,
300.979565786038, 224.256197650044, 148.719307398695, 201.195892312115,
466.727302447427, 552.762670615377, 595.145436977735, 481.359543363331,
467.379381521489, 279.980726677847, 545.324660883673, 444.812610935212,
308.198167469197, -638.973101716489, 292, 331.193419647713, 181.896345832773,
629.214319321327, -176.181996958815, 214, 59.1716887350485, -77.1223124726675,
-186.42650026083, 279.123776521767, 515.533437888983, 595.091753601562,
367.15020653978, 713.607404187601, 268.681242669467, 239.81099676255,
91.8453621773515, 246.686055020047), A = c(98.5, 77, 63.2222222222222,
97, 52.5, 3.5, 15.5, 71, 161.833333333333, 153.5, 73, 39, 40,
23, 14, 5.5, 78, 129.5, 73.5, 4, 100, 10, 3, 30, 65.5, 198, 26,
45.5, 20, 42.5, 111.5, 44, 68.5, 102.5, 39.1111111111111, 83.8,
136, 28.6666666666667, 31.5, 56.5, 101, 39.25, 108.5, 52.1666666666667,
54.5, 9.5, 13, 8.5, 8, 52.1428571428571, 66.5, 1, 42, 45, 106,
19, 202.571428571429, 200, 36.6, 83.75, 2, 33, 21.2, 69, 67.5,
14, 83, 16, 4, 99)), .Names = c("X", "Y", "A"), row.names = c(1L,
2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L,
16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 28L,
29L, 30L, 31L, 32L, 33L, 34L, 35L, 36L, 37L, 38L, 39L, 40L, 41L,
42L, 43L, 44L, 45L, 46L, 47L, 48L, 49L, 50L, 51L, 52L, 53L, 54L,
55L, 56L, 57L, 58L, 59L, 60L, 61L, 62L, 63L, 64L, 65L, 66L, 67L,
68L, 69L, 71L), class = "data.frame", na.action = structure(c(70L,
72L, 73L, 74L, 75L, 76L, 77L, 78L, 79L, 80L, 81L, 82L, 83L, 84L,
85L, 86L, 87L, 88L, 89L, 90L), .Names = c("70", "72", "73", "74",
"75", "76", "77", "78", "79", "80", "81", "82", "83", "84", "85",
"86", "87", "88", "89", "90"), class = "omit"))
I am plotting Y against X with ggplot in a simple scatterplot. However I also want to add a color scheme and a legend based on the variable A. The idea is to have four classes (e.g. 0-50, 50-100, 100-150 and 150-200) in the legend.
I only managed to get a gradient legend so far as such:
library(ggplot2)
ggplot(df, aes(x=X, y=Y, colour=A))+
geom_point(shape=3)+
geom_abline(slope=1)+
theme_bw(base_size = 14, base_family = "Helvetica") +
theme(panel.grid = element_line(colour="grey", size=0.5),
axis.text.x = element_text(hjust = 1),
legend.position="bottom",
legend.box="horizontal",
legend.key = element_blank(),
legend.text=element_text(size=12))+
xlab("Predicted")+
ylab("Observed")+
scale_colour_gradient(name= "Stand age", low= "#67a9cf", high ="#ef8a62")+
guides(colour = guide_colourbar(title.position="top", title.hjust = 0.5),
size = guide_legend(title.position="top", title.hjust = 0.5))
In addition, I would like to have the legend box in the lower right corner inside the panel. Anyone knows how to do it?
library(RColorBrewer)
library (ggplot)
vecP <- c(0, 50, 100, 150, 200, 250)
labP <- c("0-50", "50-100", "100-150", "150-200", "200-250")
df$Age <- cut(df$A, breaks=vecP, labels =labP)
colorsP <- brewer.pal(length(labP), "RdBu")
ggplot(df, aes(x=X, y=Y, colour=Age))+
geom_point(shape=1)+
geom_abline(slope=1)+
theme_bw(base_size = 14, base_family = "Helvetica") +
theme(panel.grid = element_line(colour="grey", size=0.5),
axis.text.x = element_text(hjust = 1),
legend.position=c(1, 0),
legend.direction = "vertical",
legend.justification = c(1,0),
legend.key = element_blank())+
xlab("Predicted")+
ylab("Observed")+
scale_fill_manual(name = "Stand age", values = setNames(colorsP, labP),breaks=rev(labP),labels=rev(labP))
library(ggplot2)
plt <- ggplot(df, aes(x=X, y=Y, colour=A))+
geom_point(shape=3)+
geom_abline(slope=1)+
theme_bw(base_size = 14, base_family = "Helvetica") +
theme(panel.grid = element_line(colour="grey", size=0.5),
axis.text.x = element_text(hjust = 1),
legend.position=c(1, 0),
legend.direction = "horizontal",
legend.justification = c(1,0))+
xlab("Predicted")+
ylab("Observed")+
scale_colour_gradient(name= "Stand age", low= "#67a9cf", high ="#ef8a62")+
guides(colour = guide_colourbar(title.position="top", title.hjust = 0.5),
size = guide_legend(title.position="top", title.hjust = 0.5))
Just changed,
legend.position = c(1,0)
legend.direction = "horizontal"
legend.justification = c(1,0)