计算多个条件的 cumsum 的函数

Question

我有一个如下所示的数据框：

set.seed(123)
df <- data.frame(loc.id = rep(1:10, each = 101*10), 
             year = rep(rep(2001:2010, each = 101), times = 10),
             day = rep(rep(250:350, times = 10), times = 10),
             ref.rain = rep(c(400,500,450,430,470,576,644,230,850,690), each = 10*101),
             rain = runif(min = 0, max = 20, 10*101*10))

数据框包含 10 个位置的数据。对于每个位置，我都有从 2001 年到 2010 年第 250 天到第 350 天的降雨数据。ref.rain 是每个位置的参考降雨量，一个位置的所有年份都相同，但 10 个位置中的每一个都不同.

对于每个位置和每年，我想确定累计降雨量达到参考值的 1%、2%、3%...5% 所需的天数（从第 250 天开始）该位置的降雨量。这就是我所做的

# define a function which does the job 

my.fun <- function(x,y){ifelse(sum(cumsum(x) >= y) == 0, NA, which.max(cumsum(x) >= y))} 

df1 <- data.table(df %>% group_by(loc.id,year) %>% 
            mutate(rain.01 = ref.rain*0.01, # calculate 1% of the ref.rain
                   rain.02 = ref.rain*0.02,
                   rain.03 = ref.rain*0.03,
                   rain.04 = ref.rain*0.04,
                   rain.05 = ref.rain*0.05) %>% 
            summarise(days2rain01 = my.fun(rain,rain.01), # apply the function that gives the no. of days to reach 1% 
                      days2rain02 = my.fun(rain,rain.02),
                      days2rain03 = my.fun(rain,rain.03),
                      days2rain04 = my.fun(rain,rain.04),
                      days2rain05 = my.fun(rain,rain.05)))

我的问题是我希望 my.fun 足够灵活以便我可以计算否。任何 % 降雨量（1%、2%、3%、.......50%）的天数。目前，如果我想计算更多的百分比，我必须添加一个额外的 rain.XX = ref.rain*XX 参数，然后添加一个额外的 days2rainXX = my.fun(rain,rain.XX) 参数。如何编写函数，使其采用百分比向量并生成结果。

Answer 1

library(dplyr)
# Create vector of percents
pct <- seq(0.01, 0.05, 0.01)
# Create reference rainfall columns 
df[paste0('rain', pct)] <- lapply(pct, `*`, df$ref.rain)
# summarise at new columns, with grouping
df %>% 
    group_by(loc.id, year) %>%  
    summarise_at(paste0('rain', pct), my.fun, x = as.name('rain'))

我不确定这是否更快或更清晰，但您的功能也可以

myfun <- function(x, y) which(cumsum(x) >= y)[1]

计算多个条件的 cumsum 的函数

Function to calculate cumsum for multiple conditions

r

cumsum

dplyr

data.table

tidyverse