计算多个条件的累积和的函数答案

【问题标题】：Function to calculate cumsum for multiple conditions计算多个条件的累积和的函数
【发布时间】：2018-04-07 21:32:08
【问题描述】：

我有一个如下图的数据框：

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 年从 doy 250 到 doy 350 的降雨数据。ref.rain 是每个位置的参考降雨量，一个位置的所有年份都相同，但 10 个位置中的每一个都不同。

对于每个位置和每年，我想确定累积降雨量达到参考降雨量的 1%、2%、3%....5% 所需的天数（从 doy 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) 参数。如何编写函数以获取百分比向量并生成结果。

【问题讨论】：

标签： r dplyr data.table tidyverse cumsum

【解决方案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]

【讨论】：