R Совокупная сумма по коэффициенту с суммой 'reset'

моя проблема заключается в том, что я пытаюсь найти совокупную сумму осадков по сезону (DJF, MAM, JJA, SON) и по году (1926-2000), при этом сумма возвращается к нулю в конце каждого сезона.

Мне удалось это сделать только год, используя код

rainfall$yearly.cumsum=unlist(tapply(rainfall$RR, rainfall$year, FUN=cumsum))

и пытался адаптировать его к сезонам, используя

rainfall$seasonal.cumsum=unlist(tapply(rainfall$RR, .(season,year), transform, FUN=cumsum))

Это возвращает ошибку

Error in unique.default(x, nmax = nmax) : 
unique() applies only to vectors

Я также пробовал:

rainfall$seasonal.cumsum=unlist(tapply(rainfall$RR, rainfall$season, FUN=cumsum))

который является более перспективным, так как он добавляет к сезону, но не сбрасывается, когда меняется сезон. То есть, я думаю, что код сначала суммирует DJF на каждый год, прежде чем переходить на MAM каждый год, затем JJA и, наконец, SON, а не DJF в течение одного года, перезагружают, MAM за тот же год, перезагружают и т.д.

Вот часть фрейма данных. Обратите внимание, что yearly.cumsum суммирует значения из столбца RR, но seasonal.cumsum - нет.

DATE year month season RR yearly.cumsum seasonal.cumsum
 19260529 1926 05 MAM 0 2347 2518
 19260530 1926 05 MAM 0 2347 2518
 19260531 1926 05 MAM 9 2356 2530
 19260601 1926 06 JJA 0 2356 2530
 19260602 1926 06 JJA 3 2359 2530
 19260603 1926 06 JJA 71 2430 2530
 19260604 1926 06 JJA 0 2430 2530
 19260605 1926 06 JJA 48 2478 2534

Надеюсь, мой вопрос достаточно ясен!

Благодарю.

3 ответа

Может быть, вы можете попробовать dplyr

library(dplyr)
rainfall %>% 
 group_by(season, year) %>%
 mutate(seasonal.cumsum=cumsum(RR))

# DATE year month season RR yearly.cumsum seasonal.cumsum
#1 19260529 1926 5 MAM 0 2347 0
#2 19260530 1926 5 MAM 0 2347 0
#3 19260531 1926 5 MAM 9 2356 9
#4 19260601 1926 6 JJA 0 2356 0
#5 19260602 1926 6 JJA 3 2359 3
#6 19260603 1926 6 JJA 71 2430 74
#7 19260604 1926 6 JJA 0 2430 74
#8 19260605 1926 6 JJA 48 2478 122

Обновить

Что касается создания последовательных месяцев, чтобы пересечь год, вы можете попробовать это (здесь, это сбрасывается на 01 марта, начинается новый год)

indx <- rainfall2$year-min(rainfall2$year) + rainfall2$month %in% c(1,2,12)
 indx1 <- cumsum(c(TRUE,diff(indx) <0))
 rainfall2$year2 <- indx1+ (min(rainfall$year))

 res <- rainfall2 %>%
 group_by(season, year2) %>%
 mutate(seasonal.cumsum=cumsum(RR))

 do.call(rbind,lapply(split(res, res$year2), head,2))
 # DATE month year season RR year2 seasonal.cumsum
 #1 19260504 5 1926 MAM 50 1927 50
 #2 19260505 5 1926 MAM 84 1927 134
 #3 19270301 3 1927 MAM 98 1928 98
 #4 19270302 3 1927 MAM 112 1928 210
 #5 19280301 3 1928 MAM 91 1929 91
 #6 19280302 3 1928 MAM 85 1929 176
 #7 19290301 3 1929 MAM 18 1930 18
 #8 19290302 3 1929 MAM 111 1930 129

Update2

Если вам понадобится год для сброса на 1 декабря

indx <- rainfall2$year-min(rainfall2$year) + !rainfall2$month %in% c(1,2,12)
 indx1 <- cumsum(c(TRUE,diff(indx) <0))
 rainfall2$year2 <- indx1+ (min(rainfall2$year)-1) 

 res2 <- rainfall2 %>%
 group_by(season, year2) %>%
 mutate(seasonal.cumsum=cumsum(RR))

 do.call(rbind,lapply(split(res2, res2$year2), head,2))
 # DATE month year season RR year2 seasonal.cumsum
 #1 19260504 5 1926 MAM 50 1926 50
 #2 19260505 5 1926 MAM 84 1926 134
 #3 19261201 12 1926 DJF 120 1927 120
 #4 19261202 12 1926 DJF 26 1927 146
 #5 19271201 12 1927 DJF 112 1928 112
 #6 19271202 12 1927 DJF 78 1928 190
 #7 19281201 12 1928 DJF 96 1929 96
 #8 19281202 12 1928 DJF 26 1929 122

объяснение

Я думаю, что лучше создать небольшой набор данных для лучшего понимания

set.seed(24)
 df <- data.frame(month=rep(rep(1:12,each=4),3), year=rep(1926:1928, each=12*4))

Сначала мы проверяем, какие из следующих месяцев c(1,2,12) находятся в столбце df$month используя %in%. Он возвращает логический вектор с TRUE обозначающий те элементы, которые являются либо 1, 2, либо 12. Используя отрицание ! мы пытаемся сделать TRUE как FALSE и наоборот. Это означает, что здесь мы ищем месяцы, которые не являются 1, 2 или 12

head(!df$month %in% c(1,2,12), 15)
# [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE TRUE TRUE TRUE
#[13] TRUE TRUE TRUE

Затем мы вычитаем year с minimum года в наборе данных, чтобы получить значения

df$year-min(df$year)
#[1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
#[38] 0 0 0 0 0 0 0 0 0 0 0 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
#[75] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
#[112] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2

Если мы добавим два выше, TRUE/FALSE в первом будет принуждать к целому числу (1/0), и мы получим

indx <- df$year-min(df$year) + !df$month %in% c(1,2,12)
 indx
 #[1] 0 0 0 0 0 0 0 0 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
 #[38] 1 1 1 1 1 1 1 0 0 0 0 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
 #[75] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3
 #[112] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 2 2 2

На втором этапе мы сначала делаем diff или разницу между соседними элементами indx и это возвращает вектор с одним меньшим элементом, чем длина indx. Затем проверьте, где это возвращает значения <0. Чтобы сделать длину равной, мы можем использовать c(TRUE,..)

head(diff(indx),55)
 #[1] 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
 #[26] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -1 0 0 0 1 0 0
 #[51] 0 0 0 0 0

 head(c(TRUE,diff(indx) <0), 55)
 #[1] TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
 #[13] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
 #[25] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
 #[37] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE FALSE FALSE FALSE
 #[49] FALSE FALSE FALSE FALSE FALSE FALSE FALSE

 head(cumsum(c(TRUE,diff(indx) <0)), 55)
 #[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
 #[39] 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2

 indx1 <- cumsum(c(TRUE, diff(indx) <0))

На предыдущем шаге мы получаем indx1 а затем добавляем, что с минимальным year

head( indx1+ (min(df$year)),55)
 #[1] 1927 1927 1927 1927 1927 1927 1927 1927 1927 1927 1927 1927 1927 1927 1927
 #[16] 1927 1927 1927 1927 1927 1927 1927 1927 1927 1927 1927 1927 1927 1927 1927
 #[31] 1927 1927 1927 1927 1927 1927 1927 1927 1927 1927 1927 1927 1927 1927 1928
 #[46] 1928 1928 1928 1928 1928 1928 1928 1928 1928 1928

 indx2 <- indx1+ (min(df$year))
 split(df, indx2) #to check the results

данные

rainfall <- structure(list(DATE = c(19260529L, 19260530L, 19260531L, 19260601L, 
 19260602L, 19260603L, 19260604L, 19260605L), year = c(1926L, 
 1926L, 1926L, 1926L, 1926L, 1926L, 1926L, 1926L), month = c(5L, 
 5L, 5L, 6L, 6L, 6L, 6L, 6L), season = c("MAM", "MAM", "MAM", 
 "JJA", "JJA", "JJA", "JJA", "JJA"), RR = c(0L, 0L, 9L, 0L, 3L, 
 71L, 0L, 48L), yearly.cumsum = c(2347L, 2347L, 2356L, 2356L, 
 2359L, 2430L, 2430L, 2478L), seasonal.cumsum = c(2518L, 2518L, 
 2530L, 2530L, 2530L, 2530L, 2530L, 2534L)), .Names = c("DATE", 
 "year", "month", "season", "RR", "yearly.cumsum", "seasonal.cumsum"
 ), class = "data.frame", row.names = c(NA, -8L))

NewData

DATE= format(seq(as.Date("1926-05-04"), length.out=1200, by='1 day'), '%Y%m%d')
 month <- as.numeric(substr(DATE,5,6))
 year <- as.numeric(substr(DATE,1,4))
 season <- ifelse(month %in% c(12,1,2), 'DJF', 
 ifelse(month %in% 3:5, 'MAM', ifelse(month %in% 6:8, 'JJA','SON')))
 set.seed(25)
 RR <- sample(0:120, 1200, replace=TRUE)

 rainfall2 <- data.frame(DATE, month, year, season, RR, stringsAsFactors=FALSE)


Попробуйте data.table:

> library(data.table)
> ddt = data.table(rainfall)
> ddt[,scumsum:=cumsum(RR),by=list(season,year)]
> ddt
 DATE year month season RR yearly.cumsum seasonal.cumsum scumsum
1: 19260529 1926 5 MAM 0 2347 2518 0
2: 19260530 1926 5 MAM 0 2347 2518 0
3: 19260531 1926 5 MAM 9 2356 2530 9
4: 19260601 1926 6 JJA 0 2356 2530 0
5: 19260602 1926 6 JJA 3 2359 2530 3
6: 19260603 1926 6 JJA 71 2430 2530 74
7: 19260604 1926 6 JJA 0 2430 2530 74
8: 19260605 1926 6 JJA 48 2478 2534 122


Вы можете на самом деле сделать это с tapply без использования yearly.cumsum (хотя я согласен, что tapply ведет себя немного неудобно, изменяя порядок)

transform(rainfall, 
 seasonal.cumsum = 
 unlist(rev(tapply(RR, list(season, year), FUN = cumsum))))
# DATE year month season RR yearly.cumsum seasonal.cumsum
# 1 19260529 1926 5 MAM 0 2347 0
# 2 19260530 1926 5 MAM 0 2347 0
# 3 19260531 1926 5 MAM 9 2356 9
# 4 19260601 1926 6 JJA 0 2356 0
# 5 19260602 1926 6 JJA 3 2359 3
# 6 19260603 1926 6 JJA 71 2430 74
# 7 19260604 1926 6 JJA 0 2430 74
# 8 19260605 1926 6 JJA 48 2478 122

licensed under cc by-sa 3.0 with attribution.