如何在R中累积data.frame的多列？

Question

I am trying to find accumulated values for each year of variables A to Z in myData . I have tried a few things but didn't succeed. Once i do that, i would then need to compute maximum,minimum, median, upper and lower quartile average across all those years. Here is my laborious code so far but don't have any idea how to proceed further- in fact, the current code also is not giving me what i am after.

library(tidyverse)

mydate <- as.data.frame(seq(as.Date("2000-01-01"), to= as.Date("2019-12-31"), by="day"))
colnames(mydate) <- "Date"
Data <- data.frame(A = runif(7305,0,10), 
                   J = runif(7305,0,8), 
                   X = runif(7305,0,12), 
                   Z = runif(7305,0,10))
DF <- data.frame(mydate, Data)

myData <- DF %>% separate(Date, into = c("Year","Month","Day")) %>% 
   sapply(as.numeric) %>% 
   as.data.frame() %>% 
   mutate(Date = DF$Date) %>% 
   filter(Month > 4 & Month < 11) %>% 
   mutate(DOY = format(Date, "%j")) %>% 
   group_by(Year) %>% 
   mutate(cumulativeSum = accumulate(DOY))

I am trying to get a Figure like below for A, J, X, Z . any help would be appreciated.

Update (EDIT)

My question is pretty confusing so i decided to break it down into steps using excel. Here i am using only one variable which in this case is A (note: in my question i have multiple variable). i am accumulated data from May to October each year which is reflected in column cumulative sum . In the second step (Step-2) , i re-arrange the data in day of the year (May to October) with their data. in step-3 , i am taking the statistics i mentioned earlier across all the years for every day of the year. I try to clarify as much as i could but probably this a bit strange question.

Ultimate Figure Here is an example Figure that i would like to derive as a result of this exercise.

Answer 1

So, if I'm understand well, you are trying to plot the statistical descriptive of the cumulative values of each variable between May and October of years 2000 to 2019.

So here is a possible solution to calculate first descriptive statistics of each variable (using dplyr , lubridate , tiydr package) - I encouraged you to break this code in several part in order to understand all steps.

Basically, I isolate month and year of the date, then, pivot the dataframe into a longer format, filter for keeping values only in the period of interest (May to October), calculate the cumulative sum of values grouped by variables and year. Then, I create a fake date (by pasting a consistent year with real month and days) in order to calculate descriptive statistics in function of this date and variable.

Altogether, it gives something like that:

library(lubridate)
library(dplyr)
library(tidyr)

mydata <- DF %>% mutate(Year = year(Date), Month = month(Date)) %>%
  pivot_longer(-c(Date,Year,Month), names_to = "variable", values_to = "values") %>% 
  filter(between(Month,5,10)) %>% 
  group_by(Year, variable) %>% 
  mutate(Cumulative = cumsum(values)) %>%
  mutate(NewDate = ymd(paste("2020", Month,day(Date), sep = "-"))) %>%
  ungroup() %>%
  group_by(variable, NewDate) %>%
  summarise(Median = median(Cumulative),
            Maximum = max(Cumulative),
            Minimum = min(Cumulative),
            Upper = quantile(Cumulative,0.75),
            Lower = quantile(Cumulative, 0.25))

Then, you can get a similar plot to your example by doing:

library(ggplot2)
ggplot(mydata, aes(x = NewDate))+
  geom_ribbon(aes(ymin = Lower, ymax = Upper), color = "grey", alpha =0.5)+
  geom_line(aes(y = Median), color = "darkblue")+
  geom_line(aes(y = Maximum), color = "red", linetype = "dashed", size = 1.5)+
  geom_line(aes(y = Minimum), color ="red", linetype = "dashed", size = 1.5)+
  facet_wrap(~variable, scales = "free")+
  scale_x_date(date_labels = "%b", date_breaks = "month", name = "Month")+
  ylab("Daily Cumulative Precipitation (mm)")

Does it look what you are trying to achieve ?

---

EDIT: Adding Legends

Adding a legend here is not easy as you are using different geom (ribbon, line) with different color, shape, ...

So, one way is to regroup statistics that can be plot with the same geom and do:

mydata %>% pivot_longer(cols = c(Median, Minimum,Maximum), names_to = "Statistic",values_to = "Value") %>%
  ggplot(aes(x = NewDate))+
  geom_ribbon(aes(ymin = Lower, ymax = Upper, fill = "Upper / Lower"), alpha =0.5)+
  geom_line(aes(y = Value, color = Statistic, linetype = Statistic, size = Statistic))+
  facet_wrap(~variable, scales = "free")+
  scale_x_date(date_labels = "%b", date_breaks = "month", name = "Month")+
  ylab("Daily Cumulative Precipitation (mm)")+
  scale_size_manual(values = c(1.5,1,1.5))+
  scale_linetype_manual(values = c("dashed","solid","dashed"))+
  scale_color_manual(values = c("red","darkblue","red"))+
  scale_fill_manual(values = "grey", name = "")

So, it looks good but as you can see, it's a litle bit weird as the Upper/Lower is slightly out of the main legends.

Another solution is to add legends as labeling on the last date. For that, you can create a second dataframe by subsetting only the last date of your first dataframe:

mydata_label <- mydata %>% filter(NewDate == max(NewDate)) %>% 
  pivot_longer(cols = Median:Lower, names_to = "Stat",values_to = "val")

Then, without changing much the plotting part, you can do:

ggplot(mydata, aes(x = NewDate))+
  geom_ribbon(aes(ymin = Lower, ymax = Upper), alpha =0.5)+
  geom_line(aes(y = Median), color = "darkblue")+
  geom_line(aes(y = Maximum), color = "red", linetype = "dashed", size = 1.5)+
  geom_line(aes(y = Minimum), color ="red", linetype = "dashed", size = 1.5)+
  facet_wrap(~variable, scales = "free")+
  scale_x_date(date_labels = "%b", date_breaks = "month", name = "Month", limits = c(min(mydata$NewDate),max(mydata$NewDate)+25))+
  ylab("Daily Cumulative Precipitation (mm)")+
  geom_text(data = mydata_label, 
            aes(x = NewDate+5, y = val, label = Stat, color = Stat), size = 2, hjust = 0, show.legend = FALSE)+
  scale_color_manual(values = c("Median" = "darkblue","Maximum" = "red","Minimum" = "red","Upper" = "black", "Lower" = "black"))

I reduced on purpose the size of the text labeling due to space issues in order you can see all of them. But based on the figure you attached to your question, you should have plenty of space to make it working.