時間ギャップが不均一なグループのローリング合計

Question

ここではpreviously posted questionの調整があります。ここに私のデータです：

set.seed(3737) 
DF2 = data.frame(user_id = c(rep(27, 7), rep(11, 7)), 
      date = as.Date(rep(c('2016-01-01', '2016-01-03', '2016-01-05', '2016-01-07', '2016-01-10', '2016-01-14', '2016-01-16'), 2)), 
      value = round(rnorm(14, 15, 5), 1)) 

user_id date  value 
27  2016-01-01 15.0 
27  2016-01-03 22.4 
27  2016-01-05 13.3 
27  2016-01-07 21.9 
27  2016-01-10 20.6 
27  2016-01-14 18.6 
27  2016-01-16 16.4 
11  2016-01-01 6.8 
11  2016-01-03 21.3 
11  2016-01-05 19.8 
11  2016-01-07 22.0 
11  2016-01-10 19.4 
11  2016-01-14 17.5 
11  2016-01-16 19.3 

この時間は、私が指定した期間」の各user_idためvalueの累積合計を計算したいと思います。例えば最後の7、14日。

user_id date  value v_minus7 v_minus14 
27  2016-01-01 15.0  15.0  15.0 
27  2016-01-03 22.4  37.4  37.4 
27  2016-01-05 13.3  50.7  50.7 
27  2016-01-07 21.9  72.6  72.6 
27  2016-01-10 20.6  78.2  93.2 
27  2016-01-14 18.6  61.1  111.8 
27  2016-01-16 16.4  55.6  113.2 
11  2016-01-01 6.8  6.8  6.8 
11  2016-01-03 21.3  28.1  28.1 
11  2016-01-05 19.8  47.9  47.9 
11  2016-01-07 22.0  69.9  69.9 
11  2016-01-10 19.4  82.5  89.3 
11  2016-01-14 17.5  58.9  106.8 
11  2016-01-16 19.3  56.2  119.3 

理想的には、私はこのためdplyrを使用するようにしたいのですが、他のパッケージは大丈夫だと思う：望ましい解決策は次のようになります。

Answer 1

ロジック：user_idによる最初のグループ、dateが続いています。データの各サブセットについて、論理的なベクトルを返すbetween()を使用して、現在の日付と7/14日の間にあるすべての日付を確認します。私はここでvalue列

library(data.table) 
setDT(DF2)[, `:=`(v_minus7 = sum(DF2$value[DF2$user_id == user_id][between(DF2$date[DF2$user_id == user_id], date-7, date, incbounds = TRUE)]), 
       v_minus14 = sum(DF2$value[DF2$user_id == user_id][between(DF2$date[DF2$user_id == user_id], date-14, date, incbounds = TRUE)])), 
      by = c("user_id", "date")][] 
# user_id  date value v_minus7 v_minus14 
#1:  27 2016-01-01 15.0  15.0  15.0 
#2:  27 2016-01-03 22.4  37.4  37.4 
#3:  27 2016-01-05 13.3  50.7  50.7 
#4:  27 2016-01-07 21.9  72.6  72.6 
#5:  27 2016-01-10 20.6  78.2  93.2 
#6:  27 2016-01-14 18.6  61.1  111.8 
#7:  27 2016-01-16 16.4  55.6  113.2 
#8:  11 2016-01-01 6.8  6.8  6.8 
#9:  11 2016-01-03 21.3  28.1  28.1 
#10:  11 2016-01-05 19.8  47.9  47.9 
#11:  11 2016-01-07 22.0  69.9  69.9 
#12:  11 2016-01-10 19.4  82.5  89.3 
#13:  11 2016-01-14 17.5  58.9  106.8 
#14:  11 2016-01-16 19.3  56.2  119.3 

---

# from alexis_laz answer. 
ff = function(date, value, minus){ 
    cs = cumsum(value) 
    i = findInterval(date - minus, date, rightmost.closed = TRUE) 
    w = which(as.logical(i)) 
    i[w] = cs[i[w]] 
    cs - i 
} 
setDT(DF2) 
DF2[, `:=`(v_minus7 = ff(date, value, 7), 
      v_minus14 = ff(date, value, 14)), by = c("user_id")] 

Answer 2

あなたが最初に欠落している日付を記入したら、あなたはzooからrollapplyを使用することができます。

library(dplyr) 
library(zoo) 

set.seed(3737) 
DF2 = data.frame(user_id = c(rep(27, 7), rep(11, 7)), 
      date = as.Date(rep(c('2016-01-01', '2016-01-03', '2016-01-05', '2016-01-07', '2016-01-10', '2016-01-14', '2016-01-16'), 2)), 
      value = round(rnorm(14, 15, 5), 1)) 

all_combinations <- expand.grid(user_id=unique(DF2$user_id), 
          date=seq(min(DF2$date), max(DF2$date), by="day")) 

res <- DF2 %>% 
    merge(all_combinations, by=c('user_id','date'), all=TRUE) %>% 
    group_by(user_id) %>% 
    arrange(date) %>% 
    mutate(v_minus7=rollapply(value, width=8, FUN=function(x) sum(x, na.rm=TRUE), partial=TRUE, align='right'), 
      v_minus14=rollapply(value, width=15, FUN=function(x) sum(x, na.rm=TRUE), partial=TRUE, align='right')) %>% 
    filter(!is.na(value)) 

Answer 3

を追加し、この論理ベクトルに基づいて

は動物園を使用して、いくつかのアプローチです。

1）動物園のオブジェクトを指定された機能sum_lastを定義回シリーズの最終日のK日以内であり、シリーズ全体に適用しroll関数を定義する値の和をとります。次に、aveを使用して、rollをk = 7の場合は1回、k = 14の場合は1回ずつuser_idに適用します。

これは、最新のバージョンの動物園で導入されたrollapplyの引数をcoredataとしているため、以前のバージョンを使用していないことを確認してください。

library(zoo) 

# compute sum of values within k time units of last time point 
sum_last <- function(z, k) { 
    tt <- time(z) 
    sum(z[tt > tail(tt, 1) - k]) 
} 

# given indexes ix run rollapplyr on read.zoo(DF2[ix, -1]) 
roll <- function(ix, k) { 
rollapplyr(read.zoo(DF2[ix, -1]), k, sum_last, coredata = FALSE, partial = TRUE, k = k) 
} 

nr <- nrow(DF2) 
transform(DF2, 
    v_minus7 = ave(1:nr, user_id, FUN = function(x) roll(x, 7)), 
    v_minus14 = ave(1:nr, user_id, FUN = function(x) roll(x, 14))) 

2）代替案は、以下に示すバージョンでrollを交換することであろう。これにより、DF2[ix, -1]が"zoo"に変換され、塗りつぶされた隙間を持つ幅ゼロのグリッドとマージされます。その後、rollapplyが適用され、windowを使用して元の時刻に戻します。

roll <- function(ix, k) { 
    z <- read.zoo(DF2[ix, -1]) 
    g <- zoo(, seq(start(z), end(z), "day")) 
    m <- merge(z, g, fill = 0) 
    r <- rollapplyr(m, k, sum, partial = TRUE) 
    window(r, time(z)) 
} 

Answer 4

findIntervalは、比較と操作を最小限に抑えるための別のアイデアです。最初に、グループ化を無視して基本部分に対応する関数を定義します。次の関数は、累積和を計算し、そのそれぞれの過去の日付に1つから各位置での累積和を減算：

ff = function(date, value, minus) 
{ 
    cs = cumsum(value) 
    i = findInterval(date - minus, date, left.open = TRUE) 
    w = which(as.logical(i)) 
    i[w] = cs[i[w]] 
    cs - i 
} 

そしてグループによってそれを適用する：

do.call(rbind, 
     lapply(split(DF2, DF2$user_id), 
       function(x) data.frame(x, 
         minus7 = ff(x$date, x$value, 7), 
         minus14 = ff(x$date, x$value, 14)))) 
#  user_id  date value minus7 minus14 
#11.8  11 2016-01-01 6.8 6.8  6.8 
#11.9  11 2016-01-03 21.3 28.1 28.1 
#11.10  11 2016-01-05 19.8 47.9 47.9 
#11.11  11 2016-01-07 22.0 69.9 69.9 
#11.12  11 2016-01-10 19.4 82.5 89.3 
#11.13  11 2016-01-14 17.5 58.9 106.8 
#11.14  11 2016-01-16 19.3 56.2 119.3 
#27.1  27 2016-01-01 15.0 15.0 15.0 
#27.2  27 2016-01-03 22.4 37.4 37.4 
#27.3  27 2016-01-05 13.3 50.7 50.7 
#27.4  27 2016-01-07 21.9 72.6 72.6 
#27.5  27 2016-01-10 20.6 78.2 93.2 
#27.6  27 2016-01-14 18.6 61.1 111.8 
#27.7  27 2016-01-16 16.4 55.6 113.2 

以上が適用バイもちろん、グループ操作は、任意の方法で置き換えることができます。