避免使用for循环的cumsum

时间:2017-12-12 12:18:00

标签: r for-loop apply cumsum split-apply-combine

首先生成一些样本数据:

$('#calendar').fullCalendar({
    dayClick: function(date, jsEvent, view) {
        alert('Clicked on: ' + date.format());
        $('#modalTitle').text(date.format());
        $('#fullCalModal').modal('show');
    }
});

我想做的是以下内容:

对于 doy <- rep(1:365,times=2) year <- rep(2000:2001,each=365) set.seed(1) value <-runif(min=0,max=10,365*2) doy.range <- c(40,50,60,80) thres <- 200 df <- data.frame(cbind(doy,year,value)) ,从df$year == 2000开始,开始添加 doy.range == 40df$value的累积总和为&gt; = df$doy

时计算df$value

这是我的长期thres来实现这一目标:

for loop

此循环向我提供了矩阵的第三列,# create a matrix to store results mat <- matrix(, nrow = length(doy.range)*length(unique(year)),ncol=3) mat[,1] <- rep(unique(year),each=4) mat[,2] <- rep(doy.range,times=2) for(i in unique(df$year)){ dat <- df[df$year== i,] for(j in doy.range){ dat1 <- dat[dat$doy >= j,] dat1$cum.sum <-cumsum(dat1$value) day.thres <- dat1[dat1$cum.sum >= thres,"doy"][1] # gives me the doy of the year where cumsum of df$value becomes >= thres mat[mat[,2] == j & mat[,1] == i,3] <- day.thres } } 超过doycumsum$value

但是,我真的想避免循环。有什么办法可以用更少的代码来实现吗?

2 个答案:

答案 0 :(得分:3)

如果我理解正确,您可以使用dplyr。假设阈值为200:

library(dplyr)
df %>% group_by(year) %>% 
  filter(doy >= 40) %>% 
  mutate(CumSum = cumsum(value)) %>% 
  filter(CumSum >= 200) %>% 
  top_n(n = -1, wt = CumSum)

产生

# A tibble: 2 x 4
# Groups:   year [2]
    doy  year    value   CumSum
  <dbl> <dbl>    <dbl>    <dbl>
1    78  2000 3.899895 201.4864
2    75  2001 9.205178 204.3171

我猜使用的动词不言自明。如果没有,请告诉我。

对于不同的doy创建一个函数并使用lapply

f <- function(doy.range) {
  df %>% group_by(year) %>% 
    filter(doy >= doy.range) %>% 
    mutate(CumSum = cumsum(value)) %>% 
    filter(CumSum >= 200) %>% 
    top_n(n = -1, wt = CumSum)
}

lapply(doy.range, f)

[[1]]
# A tibble: 2 x 4
# Groups:   year [2]
    doy  year    value   CumSum
  <dbl> <dbl>    <dbl>    <dbl>
1    78  2000 3.899895 201.4864
2    75  2001 9.205178 204.3171

[[2]]
# A tibble: 2 x 4
# Groups:   year [2]
    doy  year    value   CumSum
  <dbl> <dbl>    <dbl>    <dbl>
1    89  2000 2.454885 200.2998
2    91  2001 6.578281 200.6544

[[3]]
# A tibble: 2 x 4
# Groups:   year [2]
    doy  year    value   CumSum
  <dbl> <dbl>    <dbl>    <dbl>
1    98  2000 4.100841 200.5048
2   102  2001 7.158333 200.3770

[[4]]
# A tibble: 2 x 4
# Groups:   year [2]
    doy  year    value   CumSum
  <dbl> <dbl>    <dbl>    <dbl>
1   120  2000 6.401010 204.9951
2   120  2001 5.884192 200.8252

答案 1 :(得分:3)

我们的想法是创建一个基于给定(起始)doy和阈值的函数来获取相关信息。然后将此函数应用于启动doys和阈值的不同组合,并返回包含所有相关信息的数据集:

# create example data
doy <- rep(1:365,times=2)
year <- rep(2000:2001,each=365)
set.seed(1)
value <-runif(min=0,max=10,365*2)

df <- data.frame(doy,year,value)


library(dplyr)
library(purrr)

# function (inputs: dr for doy range and t for threshold)
f = function(dr, t) {

  df %>% 
    filter(doy >= dr) %>%                    # keep rows with values aboven a given doy
    group_by(year) %>%                       # for each year
    mutate(CumSumValue = cumsum(value)) %>%  # get the cumulative sum of value
    filter(CumSumValue >= t) %>%             # keep rows equal or above a given threshold
    slice(1) %>%                             # keep the first row
    ungroup() %>%                            # forget the grouping
    select(-value) %>%                       # remove unnecessary variable
    mutate(doy_input=dr, thres_input=t) %>%  # add the input info as columns
    select(doy_input, thres_input, year, doy, CumSumValue)  # re arrange columns 

}

# input doy and threshold
doy.range <- c(40,50,60,80)
thres <- 200

# map those vectors to the function
map2_df(doy.range, thres, f)

# # A tibble: 8 x 5
#   doy_input thres_input  year   doy CumSumValue
#       <dbl>       <dbl> <int> <int>       <dbl>
# 1        40         200  2000    78    201.4864
# 2        40         200  2001    75    204.3171
# 3        50         200  2000    89    200.2998
# 4        50         200  2001    91    200.6544
# 5        60         200  2000    98    200.5048
# 6        60         200  2001   102    200.3770
# 7        80         200  2000   120    204.9951
# 8        80         200  2001   120    200.8252