在一段時間內R的累積和

Question

  id   date     goal      date_followup_3month  cumulative_sum
  1 2004-12-31    1           2005-03-31              3
  1 2005-01-21    2           2005-04-21              6
  1 2005-04-04    3           2005-07-03              4
  1 2005-04-04    1           2005-07-03              1
  2 2001-01-05    4           2001-04-05              4
  2 2002-02-05    3           2002-05-06              5

cumulative_sum列是每個ID從日期到三個月的目標的累積值。

我認為的代碼如下，結果沒有出來。

錯誤代碼：缺少參數“yes”，沒有默認值

for(i in 1:length(id)){

    cumulative_sum[i] <-  for(j in 1:length(id))
    {max(cumsum(ifelse(id[i] == id[j]
                       & date[j] >= date[i]
                       & date[j] <= date_followup_3month[i])
                ,goal[j],0))}

}

我想知道是否還有其他好的代碼。 非常感謝你。

Answer 1

這有幾種可能性。 基於SQL的解決方案（1）似乎具有高可讀性，並且可能具有空間效率，因為SQL可以優化連接。 data.table解決方案（2）創建一個大的中間結果，但是看到@Frank的注釋以避免這種情況。 在（3）和（4）中創建甚至更大的中間結果，如果數據足夠大則這可能是不可行的。 基於循環的解決方案（5）是節省空間的，但是使用R中通常不使用的樣式。（5）可以直接轉換為C ++（使用Rcpp），我們在（6）中示出。

1）sqldf這可以在SQL中使用復雜邏輯條件下的自聯接表示：

library(sqldf)
sqldf("select a.*, sum(b.goal) cumulative_sum
  from DF a
  join DF b on a.id = b.id and b.rowid >= a.rowid and b.date <= a.date_followup_3month
  group by a.rowid")

贈送：

  id       date goal date_followup_3month cumulative_sum
1  1 2004-12-31    1           2005-03-31              3
2  1 2005-01-21    2           2005-04-21              6
3  1 2005-04-04    3           2005-07-03              4
4  1 2005-04-04    1           2005-07-03              1
5  2 2001-01-05    4           2001-04-05              4
6  2 2002-02-05    3           2002-05-06              3

2）data.table這可以在data.table中完成，但請注意，這涉及創建具有大量行的中間對象，而sql可以優化它。

library(data.table)

DT <- as.data.table(DF)
DT[, seq:=.I][
  DT, on = .(id == id, seq <= seq, date_followup_3month >= date)][
  , list(id = id[1], 
         date = date[1], 
         date_followup_3month = date_followup_3month[1],
         cumulative_sum = sum(i.goal)), by = seq]

3）Base R這是一個基本解決方案，它僅在id上顯式執行自連接，然后在條件中將行向下子集化為其他項。 最后，它使用tapply來執行求和。 它涉及顯式生成s ，這是一個更大的中間結果。

DF0 <- cbind(seq = 1:nrow(DF), DF)
s <- subset(merge(DF0, DF0, by = "id"), 
       seq.x <= seq.y & date_followup_3month.x >= date.y)
transform(DF, cumulative_sum = tapply(s$goal.y, s$seq.x, sum))

4）dplyr這使用dplyr和like（3）涉及一個可能非常大的中間結果，因為它僅針對id執行自連接。

library(dplyr)
DF %>% 
  mutate(seq = 1:n()) %>% 
  inner_join(., ., by = "id", suffix = c("", ".x")) %>%
  filter(seq.x >= seq & date.x <= date_followup_3month) %>%
  group_by(seq, date, goal, date_followup_3month) %>%
  summarize(cumulative_sum = sum(goal.x)) %>%
  ungroup %>%
  select(-seq)

5）循環 - 基礎R在R中不鼓勵顯式循環並且可以很慢但另一方面它相對簡單且節省空間。 這可以用作將代碼轉換為C ++的模型，我們在此之后的解決方案中執行此操作。 請注意，我們包含了幾個優化。 因為輸入是排序的，所以j循環可以從i開始，而不是從1開始，並且一旦j循環中的條件失敗，我們就可以立即退出j循環，因為滿足的行必然全部一起出現。

n <- nrow(DF)
Sum <- numeric(n)
for(i in 1:n) {
  for(j in i:n) {
    if (with(DF, id[i] == id[j] && date[j] <= date_followup_3month[i])) {
      Sum[i] <- Sum[i] + DF$goal[j]
    } else break
  }
}
transform(DF, cumulative_sum = Sum)

6）Rcpp我們可以將（5）翻譯成C ++。 假設我們有一個名為cum_sum.cpp的文件，其中包含：

#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::export]]
NumericVector cum_sum(NumericVector id, IntegerVector date, 
  IntegerVector date_followup_3month, NumericVector goal) {
  auto n = id.size();
  NumericVector Sum(n);
  for(auto i = 0; i < n; i++) {
    Sum[i] = 0.0;
    for(auto j = i; j < n; j++) {
      if (id[i] == id[j] && date[j] <= date_followup_3month[i]) {
        Sum[i] = Sum[i] + goal[j];
      } else break;
    }
  }
  return Sum;
}

然后運行：

library(Rcpp)
sourceCpp("cum_sum.cpp")
transform(DF, cumulative_sum = 
                cum_sum(id, date, date_followup_3month, as.numeric(goal)))

注意

可重復形式的輸入DF是：

Lines <- "id   date     goal      date_followup_3month
  1 2004-12-31    1           2005-03-31
  1 2005-01-21    2           2005-04-21
  1 2005-04-04    3           2005-07-03
  1 2005-04-04    1           2005-07-03
  2 2001-01-05    4           2001-04-05
  2 2002-02-05    3           2002-05-06"
DF <- read.table(text = Lines, header = TRUE)
DF$date <- as.Date(DF$date)
DF$date_followup_3month <- as.Date(DF$date_followup_3month)

Answer 2

你可以只使用sum來滿足日期和id的條件而不是max（cumsum）。 另外，為避免嵌套循環，可以使用函數。 下面簡要介紹一些示例：

      goalsum <- function(date, i){
      start <- date$date[i]
      end <- date$date_followup_3month[i]
      ind <- date$id[i]
      tot_goal <- date%>%
        filter(date>=start & date<=end & id==ind)%>%
        summarise(sum(goal))
      return(tot_goal[1,1])
    }

    for(i in 1:length(date)){date$res[i] <-goalsum(date, i)}