#r #dataframe #dplyr
Вопрос:
Я хочу получить скользящую 7-дневную сумму по идентификатору. Предположим, мои данные выглядят так:
datalt;-as.data.frame(matrix(NA,42,3)) data$V1lt;-seq(as.Date("2014-05-01"),as.Date("2014-09-01"),by=3) data$V2lt;-rep(1:6,7) data$V3lt;-rep(c(1,2),21) colnames(data)lt;-c("Date","USD","ID") Date USD ID 1 2014-05-01 1 1 2 2014-05-04 2 2 3 2014-05-07 3 1 4 2014-05-10 4 2 5 2014-05-13 5 1 6 2014-05-16 6 2 7 2014-05-19 1 1 8 2014-05-22 2 2 9 2014-05-25 3 1 10 2014-05-28 4 2 Как я могу добавить новый столбец, который будет содержать скользящую 7-дневную сумму по идентификатору?
Комментарии:
1. Это может помочь вам начать:
library(xts); lapply(split(data, data$ID), function(x) apply.weekly(xts(x[, 2:3], x$Date), sum))2. @jbaums
apply.weekly(который является оболочкой дляperiod.apply) применяет функцию к неперекрывающимся периодам, что отличается от скользящего периода.
Ответ №1:
Если ваши данные большие, вы можете проверить это решение, которое использует data.table . Это довольно быстро. Если вам нужна большая скорость, вы всегда можете переключиться mapply на mcmapply несколько ядер и использовать их.
#Load data.table and convert to data.table object require(data.table) setDT(data)[,ID2:=.GRP,by=c("ID")] #Build reference table Ref lt;- data[,list(Compare_Value=list(I(USD)),Compare_Date=list(I(Date))), by=c("ID2")] #Use mapply to get last seven days of value by id data[,Roll.Val := mapply(RD = Date,NUM=ID2, function(RD, NUM) { d lt;- as.numeric(Ref$Compare_Date[[NUM]] - RD) sum((d lt;= 0 amp; d gt;= -7)*Ref$Compare_Value[[NUM]])})] Комментарии:
1. @Майк. Гаан, это хорошо работает, но я не знаю, что нужно, чтобы понять это. Я хотел бы посмотреть, каким будет код, если вы уберете сложность идентификатора. Как бы вы это сделали, если бы вам просто нужна была скользящая 7-дневная сумма или скользящая 9-дневная сумма?
2. Если идентификатор одинаков для каждого наблюдения, то он работает так, как вы хотите. Таким образом, решение обобщается на вашу проблему. Я бы предположил, что rollapply также хорошо работает для упрощенной версии этой проблемы.
3. @Майк. Гаан, я видел rollapply, где люди просто берут последние 7 строк, но у вас все по-другому, так как вы на самом деле вычисляете, каков диапазон, так как на каждый день может не быть строки. Где я теряюсь (потому что на самом деле я не программист), так это в том, как вы вычисляете позиции индекса, соответствующие диапазону каждого диапазона. Не могли бы вы, пожалуйста, написать код, в котором не учитывается сложность идентификатора? Возможно, я смогу проследить за этим… Я надеюсь.
4. Это будет намного быстрее, если у вас есть
d lt;- as.integer(Ref$Compare_Date[[NUM]]) - as.integer(RD)
Ответ №2:
Набор данных, предоставленный OP, не раскрывает сложность задачи. С точки зрения решения вопроса OP до сих пор только ответ Майка был правильным.
На самом деле в течение 8 рабочих дней вместо 7 рабочих дней из-за d lt;= 0 amp; d gt;= -7 .
zoo решение @G. Гротендик почти действителен, только если merge бы он был внесен в каждую группу ID .
Ниже второго решения data.table, на этот раз действительные результаты, используя dev RcppRoll, который позволяет na.rm=TRUE .
И слегка отформатированный вывод решения Майка.
datalt;-as.data.frame(matrix(NA,42,3)) data$V1lt;-seq(as.Date("2014-05-01"),as.Date("2014-09-01"),by=3) data$V2lt;-rep(1:6,7) data$V3lt;-rep(c(1,2),21) colnames(data)lt;-c("Date","USD","ID") library(microbenchmark) library(RcppRoll) # install_github("kevinushey/RcppRoll") library(data.table) # install_github("Rdatatable/data.table") correct_jan_dt = function(n, partial=TRUE){ DT = as.data.table(data) # this can be speedup by setDT() date.range = DT[,range(Date)] all.dates = seq.Date(date.range[1],date.range[2],by=1) setkey(DT,ID,Date) r = DT[CJ(unique(ID),all.dates)][, c("roll") := as.integer(roll_sumr(USD, n, normalize = FALSE, na.rm = TRUE)), by="ID"][!is.na(USD)] # This could be simplified when `partial` arg will be implemented in [kevinushey/RcppRoll](https://github.com/kevinushey/RcppRoll) if(isTRUE(partial)){ r[is.na(roll), roll := cumsum(USD), by="ID"][] } return(r[order(Date,ID)]) } correct_mike_dt = function(){ data = as.data.table(data)[,ID2:=.GRP,by=c("ID")] #Build reference table Ref lt;- data[,list(Compare_Value=list(I(USD)),Compare_Date=list(I(Date))), by=c("ID2")] #Use mapply to get last seven days of value by id data[, c("roll") := mapply(RD = Date,NUM=ID2, function(RD, NUM){ d lt;- as.numeric(Ref$Compare_Date[[NUM]] - RD) sum((d lt;= 0 amp; d gt;= -7)*Ref$Compare_Value[[NUM]])})][,ID2:=NULL][] } identical(correct_mike_dt(), correct_jan_dt(n=8,partial=TRUE)) # [1] TRUE microbenchmark(unit="relative", times=5L, correct_mike_dt(), correct_jan_dt(8)) # Unit: relative # expr min lq mean median uq max neval # correct_mike_dt() 274.0699 273.9892 267.2886 266.6009 266.2254 256.7296 5 # correct_jan_dt(8) 1.0000 1.0000 1.0000 1.0000 1.0000 1.0000 5 С нетерпением ждем новостей от @Khashaa.
Изменить (20150122.2): Приведенные ниже контрольные показатели не отвечают на вопрос OP.
Синхронизация для большего (все еще очень маленького) набора данных, 5439 строк:
library(zoo) library(data.table) library(dplyr) library(RcppRoll) library(microbenchmark) datalt;-as.data.frame(matrix(NA,5439,3)) data$V1lt;-seq(as.Date("1970-01-01"),as.Date("2014-09-01"),by=3) data$V2lt;-sample(1:6,5439,TRUE) data$V3lt;-sample(c(1,2),5439,TRUE) colnames(data)lt;-c("Date","USD","ID") zoo_f = function(){ z lt;- read.zoo(data) z0 lt;- merge(z, zoo(, seq(start(z), end(z), "day")), fill = 0) # expand to daily roll lt;- function(x) rollsumr(x, 7, fill = NA) transform(data, roll = ave(z0$USD, z0$ID, FUN = roll)[time(z)]) } dt_f = function(){ DT = as.data.table(data) # this can be speedup by setDT() date.range = DT[,range(Date)] all.dates = seq.Date(date.range[1],date.range[2],by=1) setkey(DT,Date) DT[.(all.dates) ][order(Date), c("roll") := rowSums(setDT(shift(USD, 0:6, NA, "lag")),na.rm=FALSE), by="ID" ][!is.na(ID)] } dp_f = function(){ data %gt;% group_by(ID) %gt;% mutate(roll=roll_sum(c(rep(NA,6), USD), 7)) } dt2_f = function(){ # this can be speedup by setDT() as.data.table(data)[, c("roll") := roll_sum(c(rep(NA,6), USD), 7), by="ID"][] } identical(as.data.table(zoo_f()),dt_f()) # [1] TRUE identical(setDT(as.data.frame(dp_f())),dt_f()) # [1] TRUE identical(dt2_f(),dt_f()) # [1] TRUE microbenchmark(unit="relative", times=20L, zoo_f(), dt_f(), dp_f(), dt2_f()) # Unit: relative # expr min lq mean median uq max neval # zoo_f() 140.331889 141.891917 138.064126 139.381336 136.029019 137.730171 20 # dt_f() 14.917166 14.464199 15.210757 16.898931 16.543811 14.221987 20 # dp_f() 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000 20 # dt2_f() 1.536896 1.521983 1.500392 1.518641 1.629916 1.337903 20 Тем не менее, я не уверен, что мой код data.table уже является оптимальным.
Вышеуказанные функции не ответили на вопрос OP. Прочтите начало поста для обновления. Решение Майка было правильным.
Ответ №3:
1) Предполагая, что вы имеете в виду каждые последовательные перекрывающиеся 7 строк для этого идентификатора:
library(zoo) transform(data, roll = ave(USD, ID, FUN = function(x) rollsumr(x, 7, fill = NA))) 2) Если вы действительно имели в виду 7 дней, а не 7 строк, попробуйте это:
library(zoo) z lt;- read.zoo(data) z0 lt;- merge(z, zoo(, seq(start(z), end(z), "day")), fill = 0) # expand to daily roll lt;- function(x) rollsumr(x, 7, fill = NA) transform(data, roll = ave(z0$USD, z0$ID, FUN = roll)[time(z)]) Обновлено Добавлено (2) и внесены некоторые улучшения.
Комментарии:
1. Это хорошее, простое и (я нахожу) довольно быстрое решение
Ответ №4:
library(data.table) data lt;- data.table(Date = seq(as.Date("2014-05-01"), as.Date("2014-09-01"), by = 3), USD = rep(1:6, 7), ID = rep(c(1, 2), 21)) data[, Rolling7DaySum := { d lt;- data$Date - Date sum(data$USD[ID == data$ID amp; d lt;= 0 amp; d gt;= -7]) }, by = list(Date, ID)] Ответ №5:
Я обнаружил, что с Майком возникла какая-то проблема.Предложенный Гааном код и исправьте его, как показано ниже, после тестирования.
require(data.table) setDT(data)[,ID2:=.GRP,by=c("ID")] Ref lt;-data[,list(Compare_Value=list(I(USD)),Compare_Date=list(I(Date))),by=c("ID2")] data[,Roll.Val := mapply(RD = Date,NUM=ID2, function(RD, NUM) { d lt;- as.numeric(Ref[ID2 == NUM,]$Compare_Date[[1]] - RD) sum((d lt;= 0 amp; d gt;= -7)*Ref[ID2 == NUM,]$Compare_Value[[1]])})]