R - быстрый способ расчета среднего значения прокатки с переменной шириной

У меня есть датафрейм, который содержит банковские активы на несколько дат (раз). Каждый банк имеет уникальный идентификатор:

# Sample Data
time <- c(51, 52, 53, 55, 56, 51, 52, 51, 52, 53)
id <- c(1234, 1234, 1234, 1234, 1234, 2345, 2345, 3456, 3456, 3456)
name <- c("BANK A", "BANK A", "BANK A", "BANK A", "BANK A", "BANK B", "BANK B", "BANK C", 
          "BANK C", "BANK C")
assets <- c(5000, 6000, 4000, 7000, 8000, 10000, 12000, 30000, 35000, 40000)
df <- data.frame(time, id, name, assets)

> df
   time   id   name assets
1    51 1234 BANK A   5000
2    52 1234 BANK A   6000
3    53 1234 BANK A   4000
4    55 1234 BANK A   7000
5    56 1234 BANK A   8000
6    51 2345 BANK B  10000
7    52 2345 BANK B  12000
8    51 3456 BANK C  30000
9    52 3456 BANK C  35000
10   53 3456 BANK C  40000

Для каждого банка я хочу рассчитать скользящее среднее активов, варьируя ширину в зависимости от количества последовательных значений времени. Таким образом, скользящее среднее должно включать все имеющиеся последовательные предыдущие значения активов банка. Если для одного банка не существует предыдущей стоимости, он равен активам. Для этого я добавляю столбец, который подсчитывает количество последовательных значений времени и затем использует rollapplyrиз пакета зоопарка, который дает мне желаемый результат, но с большим набором данных он слишком медленный:

# Calculate number of consecutive times
require(dplyr)
df <- df %>%
  mutate(number.time = 1) %>% # insert column for number.time, start value = 1
  group_by(id) %>%
  arrange(time) # correct order for moving average

for(i in 2:nrow(df)) # Start loop in second row, end in last row of df
  df$number.time[i] <- 
    ifelse(df$time[i] == df$time[i-1]+1,    # Is time consecutive?
           df$number.time[i - 1] + 1,       # If yes: add 1 to previous number.time
           1)                               # If no: set number.time = 1
# Moving Average
require(zoo)
df %>%
  mutate(mov.average = rollapplyr(data = assets,
                                  width = number.time, # use number.time for width
                                  FUN = mean, 
                                  fill = NA,
                                  na.rm = TRUE))
Source: local data frame [10 x 6]
Groups: id [3]

    time    id   name assets number.time mov.average
   (dbl) (dbl) (fctr)  (dbl)       (dbl)       (dbl)
1     51  1234 BANK A   5000           1        5000
2     52  1234 BANK A   6000           2        5500
3     53  1234 BANK A   4000           3        5000
4     55  1234 BANK A   7000           1        7000
5     56  1234 BANK A   8000           2        7500
6     51  2345 BANK B  10000           1       10000
7     52  2345 BANK B  12000           2       11000
8     51  3456 BANK C  30000           1       30000
9     52  3456 BANK C  35000           2       32500
10    53  3456 BANK C  40000           3       35000

Как я могу получить этот вывод, используя более быструю функцию? Я в курсе rollmean из зоопарка, а также SMA от TTR и maот прогноза, но они не допускают изменения ширины. Мой вопрос также может быть связан с этим вопросом и этим блогом, но я не знаком с C++ и не знаю много о написании функций, поэтому я не очень понимаю эти посты.

РЕДАКТИРОВАТЬ 1: Обратите внимание, что в моем коде выше это не for-Нет, но роллапплыр, который занимает много времени.

РЕДАКТИРОВАТЬ 2: Скользящее среднее должно включать не более 4 последних значений. Это столько последовательных значений, сколько существует в зависимости от переменной времени, но не более, чем последние 4 значения. Извините за неточный вопрос!:/ Моя формулировка основывалась на предположении использовать столбец "number.time", в котором было бы легко ограничить все значения максимумом = 4.

Источник

2 ответа

Решение

Сначала создайте группирующую переменную g и затем вычислите скользящее средство. Обратите внимание, что rollsum существенно быстрее, чем rollapply но не поддерживает partial Обходное решение показано:

library(zoo) # rollsum

g <- with(df, cumsum(ave(time, id, FUN = function(x) c(1, diff(x) != 1))))
roll4 <- function(x) rollsum(c(0, 0, 0, x), 4) / pmin(4, seq_along(x)) 
transform(df, avg = ave(assets, g, FUN = roll4))

давая:

   time   id   name assets   avg
1    51 1234 BANK A   5000  5000
2    52 1234 BANK A   6000  5500
3    53 1234 BANK A   4000  5000
4    55 1234 BANK A   7000  7000
5    56 1234 BANK A   8000  7500
6    51 2345 BANK B  10000 10000
7    52 2345 BANK B  12000 11000
8    51 3456 BANK C  30000 30000
9    52 3456 BANK C  35000 32500
10   53 3456 BANK C  40000 35000
Источник

Использование cumsum,

Если у вас есть только один банк, попробуйте:

cumsum(df$assets)/seq(nrow(df))

Что делать, если у вас более одного банка, я оставляю в качестве упражнения. Подсказка: вы можете полностью избежать петель, используя rle,

Вот функция "cumsum with restarts", которая должна вам помочь.

cumsum.r <- function(vals, restart) {
    if (!is.vector(vals) || !is.vector(restart)) stop("expect vectors")
    if (length(vals) != length(restart)) stop("different length")
    # assume restart = FFTFFFTFFFFT
    len = length(vals) # 12
    restart[1]=T # TFTFFFTFFFFT
    ind = which(restart) # (1,3,7,12)
    ind = rep(ind, c(ind[-1],len+1)-ind) # 1,1,3,3,3,3,7,7,7,7,7,12
    vals.c = cumsum(vals)
    vals.c - vals.c[ind] + vals[ind]
}
Источник
Другие вопросы по тегам