ActivityTypeの21日のローリング合計を行う最速の方法

Question

私は大きなデータフレーム（3M +行）を持っています。私は特定のActivityTypeが21日のウィンドウに表示される回数を数えようとしています。私はRolling Sum by Another Variable in Rから私のソリューションをモデル化しました。しかし、1つのActivityTypeには長い時間がかかります。私は、3M +の行が過度の時間を要するものだとは思わなかった。以下は私が試したものです：

dt <- read.table(text=' 

         Name  ActivityType  ActivityDate     
         John  Email   1/1/2014   
         John  Email   1/3/2014     
         John  Webinar   1/5/2014   
         John  Webinar   1/20/2014   
         John  Webinar   3/25/2014   
         John  Email   4/1/2014   
         John  Email   4/20/2014   
         Tom  Email   1/1/2014   
         Tom  Webinar   1/5/2014   
         Tom  Webinar   1/20/2014   
         Tom  Webinar   3/25/2014   
         Tom  Email    4/1/2014   
         Tom  Email    4/20/2014   

         ', header=T, row.names = NULL) 

     library(data.table) 
     library(reshape2) 
     dt$ActivityType <- factor(dt$ActivityType) 
     dt$ActivityDate <- as.Date(dt$ActivityDate, "%m/%d/%Y") 
     dt <- dt[order(dt$Name, dt$ActivityDate),] 

    dt <- dcast(dt, Name + ActivityDate ~ ActivityType, fun.aggregate=length) 
    setDT(dt) 
    #Build reference table 
     Ref <- dt[,list(Compare_Value=list(I(Email)),Compare_Date=list(I(ActivityDate))), by=c("Name")] 
    #Use mapply to get last 21 days of value by Name  
    dt[,Email_RollingSum := mapply(ActivityDate=ActivityDate,Name=Name, function(ActivityDate, Name) { 
      d <- as.numeric(Ref$Compare_Date[[Name]] - ActivityDate) 
      sum((d <= 0 & d >= -21)*Ref$Compare_Value[[Name]])})] 

これはActivityType = Emailの場合だけで、他のActivityTypeレベルでも同じことをしなければなりません。私が解決策を得たリンクは、「mapply」ではなく「mcapply」を使って話しました。 mcapplyや他のどのようなソリューションを使ってより速くできるのか教えてください。

以下は予想される出力です。各行について、私はActivityDateを21日前に取って、21日の期間は私のタイムウィンドウです。私はその時間枠内にActivityType = "Email"と表示されます。

   Name  ActivityType  ActivityDate Email_RollingSum    
       John  Email   1/1/2014   1 
       John  Email   1/3/2014   2  
       John  Webinar   1/5/2014   2 
       John  Webinar   1/20/2014  2 
       John  Webinar   3/25/2014  0 
       John  Email   4/1/2014   1 
       John  Email   4/20/2014  2 
       Tom  Email   1/1/2014   1 
       Tom  Webinar   1/5/2014   1 
       Tom  Webinar   1/20/2014  1 
       Tom  Webinar   3/25/2014  0 
       Tom  Email    4/1/2014   1 
       Tom  Email    4/20/2014  2 

Answer 1

名前と日付のリストと電子メールの数のソースの両方にデータテーブルを使用するアプローチを試してください。これはDTのi引数をDTとし、by = .EACHIを使用してdata.tableで行われます。

library(data.table) 
# convert character dates to Date types 
dt$ActivityDate <- as.Date(dt$ActivityDate, "%m/%d/%Y") 
# convert to a 'data.table' and define key 
setDT(dt, key = "Name") 
# count emails and webinars 
dt <- dt[dt[,.(Name, type = ActivityType, date = ActivityDate)], 
     .(type, date, 
      Email = sum(ActivityType == "Email" & between(ActivityDate, date-21, date)), 
      Webinar = sum(ActivityType == "Webinar" & between(ActivityDate, date-21, date))), 
     by=.EACHI] 

以下は上記と同じアプローチを使用していますが、あなたのデータに応じて、30から40パーセントで速度を向上させることがあり、いくつかの変更が含まれています。コードは次のようになります。

setDT(dt, key = "Name") 
    dt[, ":="(ActivityDate = as.Date(dt$ActivityDate, "%m/%d/%Y"), 
      ActivityType = as.character(ActivityType))] 
    dt4 <- dt[.(Name=Name, type=ActivityType, date=ActivityDate), {z=between(ActivityDate, date-21, date); 
                    .(type, date, 
                    Email=sum((ActivityType %chin% "Email") & z), 
                    Webinar=sum((ActivityType %chin% "Webinar") & z)) } 
      , by=.EACHI] 

Answer 2

setDT(dt) 
dt[, ActivityDate := as.Date(ActivityDate, '%m/%d/%Y')] 

# add index to keep track of rows 
dt[, idx := .I] 

# match the dates we're looking for using a rolling join and extract the row numbers 
rr = dt[.(Name = Name, ActivityDate = ActivityDate - 21, refIdx = idx), 
     .(idx, refIdx), on = c('Name', 'ActivityDate'), roll = -Inf] 
# idx refIdx 
# 1: 1  1 
# 2: 1  2 
# 3: 1  3 
# 4: 1  4 
# 5: 5  5 
# 6: 5  6 
# 7: 6  7 
# 8: 8  8 
# 9: 8  9 
#10: 8  10 
#11: 11  11 
#12: 11  12 
#13: 12  13 

# extract the above rows and count occurrences using dcast 
dcast(rr[, {seq = idx:refIdx; dt[seq]}, by = 1:nrow(rr)], nrow ~ ActivityType) 
# nrow Email Webinar 
#1  1  1  0 
#2  2  2  0 
#3  3  2  1 
#4  4  2  2 
#5  5  0  1 
#6  6  1  1 
#7  7  2  0 
#8  8  1  0 
#9  9  1  1 
#10 10  1  2 
#11 11  0  1 
#12 12  1  1 
#13 13  2  0