R data.table с rollapply

Существует ли идиома для вычисления скользящей статистики с использованием группировки data.table?

Например, учитывая следующий код:

DT = data.table(x=rep(c("a","b","c"),each=2), y=c(1,3), v=1:6)
setkey(DT, y)

stat.ror <- DT[,rollapply(v, width=1, by=1, mean, na.rm=TRUE), by=y];

Если его еще нет, как лучше всего это сделать?


r data.table
person user2718667    schedule 26.08.2013    source источник
comment
Я предполагаю, что для roll в data.table есть некоторая функциональность, но, может быть, вы хотели пометить это зоопарком?   -  person Frank    schedule 26.08.2013
comment
Здесь нет ТАКОГО вопроса, это открыто для обсуждения (не то, что ТАК нравится). Но да, data.table реализовал ОЧЕНЬ быстрый аргумент roll, который может помочь сделать несколько королей roll-join, window-join и т.д...   -  person statquant    schedule 26.08.2013
comment
Извиняюсь за путаницу. Я новичок ;). Я предполагаю, что мой вопрос в том, есть ли лучшие и более эффективные способы решения расчета статистики скользящих окон на основе определенной группировки.   -  person user2718667    schedule 27.08.2013
comment
@statquant: я внес изменения, чтобы сделать вопрос более конкретным, и добавил попытку ответа. @Frank: zoo круто, но было бы неплохо иметь для этого идиому data.table.   -  person bright-star    schedule 08.05.2014
comment
rollmean или rollmeanr в зоопарке — это версии rollapply, оптимизированные для mean: library(zoo); DT[, list(roll = rollmeanr(v, 2, fill = NA)), by = y]   -  person G. Grothendieck    schedule 08.05.2014

Ответы (1)


arrow_upward
3
arrow_downward

На самом деле я пытаюсь решить эту проблему прямо сейчас. Вот частичное решение, которое будет работать для группировки по одному столбцу:

Изменить: получил с помощью RcppRoll, я думаю:

windowed.average <- function(input.table,
                             window.width = 2,
                             id.cols = names(input.table)[3],
                             index.col = names(input.table)[1],
                             val.col = names(input.table)[2]) {
  require(RcppRoll)

  avg.with.group <- 
    input.table[,roll_mean(get(val.col), n = window.width),by=c(id.cols)]
  avg.index <- 
    input.table[,roll_mean(get(index.col), n = window.width),by=c(id.cols)]$V1

  output.table <- data.table(
    Group = avg.with.group,
    Index = avg.index)

  # rename columns to (sensibly) match inputs
  setnames(output.table, old=colnames(output.table),
           new = c(id.cols,val.col,index.col))

  return(output.table)
}

Модульный тест (плохо написанный), который пройдет вышеперечисленное:

require(testthat)
require(zoo)
test.datatable <- data.table(Time = rep(seq_len(10), times=2), 
                             Voltage = runif(20), 
                             Channel= rep(seq_len(2),each=10))
test.width <- 8

# first test: single id column
test.avgtable <- data.table(
  test.datatable[,rollapply(Voltage, width = test.width, mean, na.rm=TRUE),
                       by=c("Channel")],
  Time = test.datatable[,rollapply(Time, width = test.width, mean, na.rm=TRUE),
                         by=c("Channel")]$V1)
setnames(test.avgtable,old=names(test.avgtable),
         new=c("Channel","Voltage","Time"))

expect_that(test.avgtable,
            is_identical_to(windowed.average(test.datatable,test.width)))

Как это выглядит:

> test.datatable
    Time     Voltage Channel Class
 1:    1 0.310935570       1     1
 2:    2 0.565257533       1     2
 3:    3 0.577278573       1     1
 4:    4 0.152315111       1     2
 5:    5 0.836052122       1     1
 6:    6 0.655417230       1     2
 7:    7 0.034859642       1     1
 8:    8 0.572040136       1     2
 9:    9 0.268105436       1     1
10:   10 0.126484340       1     2
11:    1 0.139711248       2     1
12:    2 0.336316520       2     2
13:    3 0.413086486       2     1
14:    4 0.304146029       2     2
15:    5 0.399344631       2     1
16:    6 0.581641210       2     2
17:    7 0.183586025       2     1
18:    8 0.009775488       2     2
19:    9 0.449576242       2     1
20:   10 0.938517952       2     2

> test.avgtable
   Channel   Voltage Time
1:       1 0.4630195  4.5
2:       1 0.4576657  5.5
3:       1 0.4028191  6.5
4:       2 0.2959510  4.5
5:       2 0.3346841  5.5
6:       2 0.4099593  6.5

К сожалению, мне не удалось заставить его работать с несколькими группами (как показано во втором разделе):

Выглядит нормально для нескольких групп столбцов:

# second test: multiple id columns
# Depends on the first test passing to be meaningful.
test.width <- 4
test.datatable[,Class:= rep(seq_len(2),times=ceiling(nrow(test.datatable)/2))]
# windowed.average(test.datatable,test.width,id.cols=c("Channel","Class"))
test.avgtable <- rbind(windowed.average(test.datatable[Class==1,],test.width),
                       windowed.average(test.datatable[Class==2,],test.width))
# somewhat artificially attaching expected class labels
test.avgtable[,Class:= rep(seq_len(2),times=nrow(test.avgtable)/4,each=2)]
setkey(test.avgtable,Channel)
setcolorder(test.avgtable,c("Channel","Class","Voltage","Time"))

expect_that(test.avgtable,
            is_equivalent_to(windowed.average(test.datatable,test.width,
                                             id.cols=c("Channel","Class"))))
person bright-star    schedule 08.05.2014