特定の日付基準の間だけを見る条件付き合計を行うにはどうすればよいですか
https://stackoverflow.com//questions/24020207
-
21-12-2019 - |
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
Russian質問
次のようなデータがあるとします
date, user, items_bought, event_number
2013-01-01, x, 2, 1
2013-01-02, x, 1, 2
2013-01-03, x, 0, 3
2013-01-04, x, 0, 4
2013-01-04, x, 1, 5
2013-01-04, x, 2, 6
2013-01-05, x, 3, 7
2013-01-06, x, 1, 8
2013-01-01, y, 1, 1
2013-01-02, y, 1, 2
2013-01-03, y, 0, 3
2013-01-04, y, 5, 4
2013-01-05, y, 6, 5
2013-01-06, y, 1, 6
私がやっていたデータポイントごとのユーザーごとの累積合計を取得するには
data.frame(cum_items_bought=unlist(tapply(as.numeric(data$items_bought), data$user, FUN = cumsum)))
これからの出力は次のようになります
date, user, items_bought
2013-01-01, x, 2
2013-01-02, x, 3
2013-01-03, x, 3
2013-01-04, x, 3
2013-01-04, x, 4
2013-01-04, x, 6
2013-01-05, x, 9
2013-01-06, x, 10
2013-01-01, y, 1
2013-01-02, y, 2
2013-01-03, y, 2
2013-01-04, y, 7
2013-01-05, y, 13
2013-01-06, y, 14
ただし、各行の3日以内に発生したもののみを合計するように合計を制限したい（ユーザーに対して）。すなわち出力は次のようになります:
date, user, cum_items_bought_3_days
2013-01-01, x, 2
2013-01-02, x, 3
2013-01-03, x, 3
2013-01-04, x, 1
2013-01-04, x, 2
2013-01-04, x, 4
2013-01-05, x, 6
2013-01-06, x, 7
2013-01-01, y, 1
2013-01-02, y, 2
2013-01-03, y, 2
2013-01-04, y, 6
2013-01-05, y, 11
2013-01-06, y, 12
解決
これは、問題に指定されているように所望の結果（14行）を生成する一般的な結果（14行）である。ユーザーXのための2013-01-04の重複日付エントリの世話をすることに注意してください。
# define a custom function to be used in the dplyr chain
myfunc <- function(x){
with(x, sapply(event_number, function(y)
sum(items_bought[event_number <= event_number[y] & date[y] - date <= 2])))
}
require(dplyr) #install and load into your library
df %>%
mutate(date = as.Date(as.character(date))) %>%
group_by(user) %>%
do(data.frame(., cum_items_bought_3_days = myfunc(.))) %>%
select(-c(items_bought, event_number))
# date user cum_items_bought_3_days
#1 2013-01-01 x 2
#2 2013-01-02 x 3
#3 2013-01-03 x 3
#4 2013-01-04 x 1
#5 2013-01-04 x 2
#6 2013-01-04 x 4
#7 2013-01-05 x 6
#8 2013-01-06 x 7
#9 2013-01-01 y 1
#10 2013-01-02 y 2
#11 2013-01-03 y 2
#12 2013-01-04 y 6
#13 2013-01-05 y 11
#14 2013-01-06 y 12
私の答えでは、dplyrチェーン内でカスタム関数myfuncを使用します。これはdplyrからdo演算子を使用して行われます。カスタム関数は、サブセット付きDFをdplyrグループに渡されます。その後、userを使用して各sapplyを渡してevent_numberの合計を計算します。 items_boughtチェーンの最後の行は、望ましくない列の選択を解除します。
あなたがより詳細な説明を望むかどうか私に知らせてください。
OP：
でコメント後の編集他の列を条件付きでもっと柔軟性が必要な場合は、次のようにコードを調整できます。ここでは、他の列をdplyrと同じ方法で合計する必要があります。それが正しくない場合は、他の列をどのように合計するかを指定してください。
まずデータに乱数を持つ2つの追加の列を作成します（私の答えの下部にあるデータのitems_boughtを投稿します）：
set.seed(99) # for reproducibility only
df$newCol1 <- sample(0:10, 14, replace=T)
df$newCol2 <- runif(14)
df
# date user items_bought event_number newCol1 newCol2
#1 2013-01-01 x 2 1 6 0.687800094
#2 2013-01-02 x 1 2 1 0.640190769
#3 2013-01-03 x 0 3 7 0.357885360
#4 2013-01-04 x 0 4 10 0.102584999
#5 2013-01-04 x 1 5 5 0.097790922
#6 2013-01-04 x 2 6 10 0.182886256
#7 2013-01-05 x 3 7 7 0.227903474
#8 2013-01-06 x 1 8 3 0.080524150
#9 2013-01-01 y 1 1 3 0.821618422
#10 2013-01-02 y 1 2 1 0.591113977
#11 2013-01-03 y 0 3 6 0.773389019
#12 2013-01-04 y 5 4 5 0.350085977
#13 2013-01-05 y 6 5 2 0.006061323
#14 2013-01-06 y 1 6 7 0.814506223
次に、1の代わりにdputを2つの引数を2引数にすることができます。 myfuncへの2番目の引数は、合計（.）の列を指定します。
myfunc <- function(x, colname){
with(x, sapply(event_number, function(y)
sum(x[event_number <= event_number[y] & date[y] - date <= 2, colname])))
}
次に、いくつかの列を条件付きで合計したい場合は、xを数回使用できます。
df %>%
mutate(date = as.Date(as.character(date))) %>%
group_by(user) %>%
do(data.frame(., cum_items_bought_3_days = myfunc(., "items_bought"),
newCol1Sums = myfunc(., "newCol1"),
newCol2Sums = myfunc(., "newCol2"))) %>%
select(-c(items_bought, event_number, newCol1, newCol2))
# date user cum_items_bought_3_days newCol1Sums newCol2Sums
#1 2013-01-01 x 2 6 0.6878001
#2 2013-01-02 x 3 7 1.3279909
#3 2013-01-03 x 3 14 1.6858762
#4 2013-01-04 x 1 18 1.1006611
#5 2013-01-04 x 2 23 1.1984520
#6 2013-01-04 x 4 33 1.3813383
#7 2013-01-05 x 6 39 0.9690510
#8 2013-01-06 x 7 35 0.6916898
#9 2013-01-01 y 1 3 0.8216184
#10 2013-01-02 y 2 4 1.4127324
#11 2013-01-03 y 2 10 2.1861214
#12 2013-01-04 y 6 12 1.7145890
#13 2013-01-05 y 11 13 1.1295363
#14 2013-01-06 y 12 14 1.1706535
列myfunc、myfunc、およびcolnameの条件付き合計を作成しました。また、DPLYRチェーンのいずれかの合計を省略するか、または列を追加するために列を追加することもできます。
op：
のコメント後の編集＃2ユーザーごとに購入された異なる（ユニークな）アイテムの累積合計を計算するには、2番目のカスタム関数myfuncを定義してDPLYRチェーン内で使用できます。この関数はitems_boughtとしても柔軟ですので、機能を適用する列を定義できます。
コードは次のようになります。
myfunc <- function(x, colname){
with(x, sapply(event_number, function(y)
sum(x[event_number <= event_number[y] & date[y] - date <= 2, colname])))
}
myfunc2 <- function(x, colname){
cumsum(sapply(seq_along(x[[colname]]), function(y)
ifelse(!y == 1 & x[y, colname] %in% x[1:(y-1), colname], 0, 1)))
}
require(dplyr) #install and load into your library
dd %>%
mutate(date = as.Date(as.character(date))) %>%
group_by(user) %>%
do(data.frame(., cum_items_bought_3_days = myfunc(., "items_bought"),
newCol1Sums = myfunc(., "newCol1"),
newCol2Sums = myfunc(., "newCol2"),
distinct_items_bought = myfunc2(., "items_bought"))) %>%
select(-c(items_bought, event_number, newCol1, newCol2))
これは私が使用したデータです：
dput(df)
structure(list(date = structure(c(1L, 2L, 3L, 4L, 4L, 4L, 5L,
6L, 1L, 2L, 3L, 4L, 5L, 6L), .Label = c("2013-01-01", "2013-01-02",
"2013-01-03", "2013-01-04", "2013-01-05", "2013-01-06"), class = "factor"),
user = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L, 2L), .Label = c(" x", " y"), class = "factor"),
items_bought = c(2L, 1L, 0L, 0L, 1L, 2L, 3L, 1L, 1L, 1L,
0L, 5L, 6L, 1L), event_number = c(1L, 2L, 3L, 4L, 5L, 6L,
7L, 8L, 1L, 2L, 3L, 4L, 5L, 6L), newCol1 = c(6L, 1L, 7L,
10L, 5L, 10L, 7L, 3L, 3L, 1L, 6L, 5L, 2L, 7L), newCol2 = c(0.687800094485283,
0.640190769452602, 0.357885359786451, 0.10258499882184, 0.0977909218054265,
0.182886255905032, 0.227903473889455, 0.0805241498164833,
0.821618422167376, 0.591113976901397, 0.773389018839225,
0.350085976999253, 0.00606132275424898, 0.814506222726777
)), .Names = c("date", "user", "items_bought", "event_number",
"newCol1", "newCol2"), row.names = c(NA, -14L), class = "data.frame")
他のヒント
data.tableパッケージzoo関数と組み合わせた追加のrollapplyrアプローチを提案したいです。
まず、独自のitems_boughtごとにuser列を集約します（ユーザーごとに複数の固有の日付がある可能性があると指摘したように）
library(data.table)
data <- setDT(data)[, lapply(.SD, sum), by = c("user", "date"), .SDcols = "items_bought"]
次に、マージンを隠すためにdateとrollapplyrを組み合わせて計算します（アドバイス @g。3日間隔でGrothendieck
library(zoo)
data[, cum_items_bought_3_days := lapply(.SD, rollapplyr, 3, sum, partial = TRUE), .SDcols = "items_bought", by = user]
# user date items_bought cum_items_bought_3_days
# 1: x 2013-01-01 2 2
# 2: x 2013-01-02 1 3
# 3: x 2013-01-03 0 3
# 4: x 2013-01-04 0 1
# 5: x 2013-01-05 3 3
# 6: x 2013-01-06 1 4
# 7: y 2013-01-01 1 1
# 8: y 2013-01-02 1 2
# 9: y 2013-01-03 0 2
# 10: y 2013-01-04 5 6
# 11: y 2013-01-05 6 11
# 12: y 2013-01-06 1 12
これは私が使ったデータセットです
data <- structure(list(date = structure(c(15706, 15707, 15708, 15709, 15710, 15711, 15706, 15707, 15708, 15709, 15710, 15711), class = "Date"), user = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c(" x", " y"), class = "factor"), items_bought = c(2L, 1L, 0L, 0L, 3L, 1L, 1L, 1L, 0L, 5L, 6L, 1L)), .Names = c("date", "user", "items_bought"), row.names = c(NA, -12L), class = "data.frame")
これはかなり簡単な方法です。
# replicate your data, shifting the days ahead by your required window,
# and rbind into a single data frame
d <- do.call(rbind,lapply(0:2, function(x) transform(data,date=date+x)))
# use aggregate to add it together, subsetting out "future" days
aggregate(items_bought~date+user,subset(d,date<=max(data$date)),sum)
date user items_bought
1 2013-01-01 x 2
2 2013-01-02 x 3
3 2013-01-03 x 3
4 2013-01-04 x 1
5 2013-01-05 x 3
6 2013-01-06 x 4
7 2013-01-01 y 1
8 2013-01-02 y 2
9 2013-01-03 y 2
10 2013-01-04 y 6
11 2013-01-05 y 11
12 2013-01-06 y 12
次のように見えます：
unlist(lapply(split(data, data$user),
function(x) {
ave(x$items_bought,
cumsum(c(0, diff(x$date)) >= 3), FUN = cumsum)
}))
#x1 x2 x3 x4 y1 y2 y3 y4
# 2 3 3 4 1 6 6 7
data：
data = structure(list(date = structure(c(15706, 15707, 15710, 15711,
15706, 15707, 15710, 15711), class = "Date"), user = structure(c(1L,
1L, 1L, 1L, 2L, 2L, 2L, 2L), .Label = c(" x", " y"), class = "factor"),
items_bought = c(2L, 1L, 3L, 1L, 1L, 5L, 6L, 1L)), .Names = c("date",
"user", "items_bought"), row.names = c(NA, -8L), class = "data.frame")
ここでは、cumsumを使用せずにネストされたアプローチを使用します lapply 代わりに。最初のものはユーザーの上に行き、次に各ユーザーのために2番目のものを行きます lapply 各日付の最後の2日以内に購入したすべてのアイテムを合計して、目的のデータフレームを構築します。以下の場合に注意してください data$date ソートされていない場合は、最初に昇順でソートする必要があります。
data <- structure(list(
date = structure(c(15706, 15707, 15708, 15709, 15710, 15711,
15706, 15707, 15708, 15709, 15710, 15711), class = "Date"),
user = c("x", "x", "x", "x", "x", "x", "y", "y", "y", "y", "y", "y"),
items_bought = c(2L, 1L, 0L, 0L, 3L, 1L, 1L, 1L, 0L, 5L, 6L, 1L)),
.Names = c("date", "user", "items_bought"),
row.names = c(NA, -12L),
class = "data.frame")
do.call(rbind, lapply(unique(data$user),
function(u) {
subd <- subset(data, user == u)
do.call(rbind, lapply(subd$date,
function(x) data.frame(date = x,
user = u, items_bought =
sum(subd[subd$date %in% (x - 2):x, "items_bought"]))))
}))
編集
各日に複数のタイムスタンプ（日付ごとに1行以上）があるという問題に対処するために、最初に同じ日に各時間に購入したすべてのアイテムを合計して集計します。あなたはそれを行うことができます。組み込み関数の使用 aggregate ただし、データが大きすぎる場合は、次のものを使用することもできます data.table スピードのために。元のデータフレームを呼び出します（日付ごとに1行以上） predata そして集計されたもの（日付ごとに1行） data.だから呼び出すことによって
predt <- data.table(predata)
setkey(predt, date, user)
data <- predt[, list(items_bought = sum(items_bought)), by = key(predt)]
日付ごとに1つの行と列date、user、items_boughtを含むデータフレームを取得します。今、私は次の方法がネストされたものよりも速くなると思います lapply 上記、しかし、私はあなたのデータでそれをテストすることができないので、私は確信していません。私はデータを使用しています。テーブルは高速であることを意図しているためです（正しい方法で使用されている場合、これが確実ではありません）。内側のループは関数に置き換えられます f.この関数を回避し、ダブルループをデータへの1つの呼び出しだけで置き換える、よりきれいな方法があるかどうかはわかりません。表、またはデータの書き込み方法。より速く実行されるテーブル呼び出し。
library(data.table)
dt <- data.table(data)
setkey(dt, user)
f <- function(d, u) {
do.call(rbind, lapply(d$date, function(x) data.frame(date = x,
items_bought = d[date %in% (x - 2):x, sum(items_bought)])))
}
data <- dt[, f(.SD, user), by = user]
データを使用しない別の方法。表は、十分なRAMがあると仮定して（データのサイズがわかりません）、1日前に購入したアイテムをベクトルに格納し、2日前に購入したアイテムを別のベク次のようなもの
sumlist <- vector("list", 2) # this will hold one vector, which contains items
# bought 1 or 2 days ago
for (i in 1:2) {
# tmpstr will be used to find the items that a given user bought i days ago
tmpstr <- paste(data$date - i, data$user, sep = "|")
tmpv <- data$items_bought[
match(tmpstr, paste(data$date, data$user, sep = "|"))]
# if a date is not in the original data, assume no purchases
tmpv[is.na(tmpv)] <- 0
sumlist[[i]] <- tmpv
}
# finally, add up items bought in the past as well as the present day
data$cum_items_bought_3_days <-
rowSums(as.data.frame(sumlist)) + data$items_bought
私がしようとする最後のことは、並列化することです lapply コール、例えば関数を使用することにより、 mclapply 代わりに、またはの並列機能を使用してコードを書き直すことによって foreach または plyr.PCの強度とタスクのサイズによっては、これがデータよりも優れている可能性があります。表シングルコアのパフォーマンス。..
Packages xtsとzooのように思えますが、@ARexis_LAZの答えと同じように実際のデータセットのサイズと同じ問題があるかもしれませんが、あなたが望むものを含む関数が含まれています。 xtsの答えからこの質問トリックをしているようです。
最初に私は私が上記にリンクしている回答からコードを取り出し、それが1つのuserだけでうまくいったことを確認しました。私はあなたの編集/コメントと私が一部のユーザーに複数の観察を持っているあなたの編集/コメントとを信じています - 私はこれを反映するために玩具データセットに余分な行を追加しました。
# Make dataset with two observations for one date for "y" user
dat <- structure(list(
date = structure(c(15706, 15707, 15708, 15709, 15710, 15711,
15706, 15707, 15708, 15709, 15710, 15711, 15711), class = "Date"),
user = c("x", "x", "x", "x", "x", "x", "y", "y", "y", "y", "y", "y", "y"),
items_bought = c(2L, 1L, 0L, 0L, 3L, 1L, 1L, 1L, 0L, 5L, 6L, 1L, 0L)),
.Names = c("date", "user", "items_bought"),
row.names = c(NA, -13L),
class = "data.frame")
# Load xts package (also loads zoo)
require(xts)
# See if this works for one user
dat1 = subset(dat, user == "y")
# Create "xts" object for use with apply.daily()
dat1.1 = xts(dat1$items_bought, dat1$date)
dat2 = apply.daily(dat1.1, sum)
# Now use rollapply with a 3-day window
# The "partial" argument appears to only work with zoo objects, not xts
sum.itemsbought = rollapply(zoo(dat2), 3, sum, align = "right", partial = TRUE)
私は、出力がニカサル（あなたの質問からの出力例のように）見ることができると思いました。私はapply.dailyオブジェクトを大いに働いていませんでしたが、この質問は私に情報をzooに入れるためのいくつかのポインタを与えました。
data.frame(Date=time(sum.itemsbought), sum.itemsbought, row.names=NULL)
これを1つのdata.frameで取り出したら、これをおもちゃのデータセット全体に拡張することが簡単でした。これはスピードが問題になる可能性がある場所です。この手順のuserとlapplyを使用します。
allusers = lapply(unique(dat$user), function(x) {
dat1 = dat[dat$user == x,]
dat1.1 = xts(dat1$items_bought, dat1$date)
dat2 = apply.daily(dat1.1, sum)
sum.itemsbought = rollapply(zoo(dat2), 3, sum, align = "right", partial = TRUE)
data.frame(Date=time(sum.itemsbought), user = x, sum.itemsbought, row.names=NULL)
} )
do.call(rbind, allusers)
私はJamesの答えがより良いですが、これが代替案です：
with(data,{
sapply(split(data,user),function(x){
sapply(x$date,function(y) sum(x$items_bought[x$date %in% c(y,y-1,y-2)]))
})
})
