Передайте параметр `width`` zoo: rollapply` в качестве аргумента вызываемой функции - PullRequest
1 голос
/ 06 февраля 2020

Как передать аргумент width функции zoo:rollapply в функцию FUN, вызываемую в rollapply?

Я помещаю значения и ширину как столбцы одного и того же data.frame :

library(zoo)
a = data.frame(v = 1:10, w = c(2,1,3,5,2,7,3,2,1,3))
#     v w
# 1   1 2
# 2   2 1
# 3   3 3
# 4   4 5
# 5   5 2
# 6   6 7
# 7   7 3
# 8   8 2
# 9   9 1
# 10 10 3

Я могу сделать:

rollapply(a$v, a$w, function(x) sum(x), partial=T)

Что дает:

[1] 3 2 9 20 11 42 21 17 9 19

Теперь я хотел бы использовать для каждого скользящего окна a$v соответствующее значение a$w в вычислениях. Например:

rollapply(a$v, a$w, function(x) sum(x) + a$w[1], partial=T)

Но вместо того, чтобы иметь a$w[1] в качестве постоянного значения (здесь это просто добавляет 2 к значениям выше), я хотел бы использовать значение в a$w, соответствующее каждый раз в a$w (т. е. в той же строке a).

Следовательно, желаемый результат будет:

[1] 5 3 12 25 13 49 24 19 10 22 * ​​1034 *

1 Ответ

2 голосов
/ 06 февраля 2020

1) Ширина не обязательно должна быть в функции. Впоследствии его можно добавить:

rollapply(a$v, a$w, sum, partial = TRUE) + a$w
## [1]  5  3 12 25 13 49 24 19 10 22

Укажите align=, если вы хотите другое выравнивание.

2) Этот подход немного уродлив, но другой способ для поддержки внешнего индекса.

i <- 0
rollapply(a$v, a$w, function(x) sum(x) + a$w[i <<- i+1], partial = TRUE)
## [1]  5  3 12 25 13 49 24 19 10 22

2a) Это можно немного убрать за счет дополнительного кода, использующего объектно-ориентированные идеи для поддержания состояния. Здесь мы определяем объект прото p, имеющий внутренний счетчик и метод incr, который увеличивает и возвращает его каждый раз, когда incr вызывается для объекта.

library(proto)
p <- proto(counter = 0, incr = function(.) .$counter <- .$counter + 1)
rollapply(a$v, a$w, function(x) sum(x) + a$w[p$incr()], partial = TRUE)
## [1]  5  3 12 25 13 49 24 19 10 22

3) Пример в вопросе использовал выравнивание по центру, но если вам действительно нужно выравнивание по правому или левому краю, то это можно сделать, выполнив итерацию по a, а не по a$v. Вот это для правильного выравнивания.

Sum <- function(x) {
  x <- matrix(x,,2)
  v <- x[, 1]
  w <- tail(x[, 2], 1)
  sum(v) + w
}
rollapplyr(a, a$w, Sum, partial = TRUE, by.column = FALSE)
## [1]  3  3  9 15 11 28 21 17 10 30

# double check
rollapplyr(a$v, a$w, sum, partial = TRUE) + a$w
## [1]  3  3  9 15 11 28 21 17 10 30
...