rollapply () за n месяцев

Question

Я ищу способ использовать rollapply для разбиения ряда на последовательности по n-месяцам.Предположим, у вас есть следующее:

z <- zoo(101:465, as.Date(1:365))
as.data.frame(z)

Я хотел бы получить список векторов (или списков) значений индекса для каждого n-месяцев, чтобы я мог работать с данными ... Во многом как ширинапараметр реализован в rollapply, за исключением того, что ширина в этом случае является переменной (в зависимости от дней в месяце).

ПРИМЕЧАНИЕ: предпочел бы решение base-R, но было бы интересно увидеть другие библиотеки, которые можно использовать

Answer 1

Закончилось сворачивать мой собственный rollapply () для объекта зоопарка:

ФУНКЦИЯ ПОМОЩИ

   get.months.elapsed <- function(start.date, end.date) {
      ed <- as.POSIXlt(end.date)
      sd <- as.POSIXlt(start.date)
      12 * (ed$year - sd$year) + (ed$mon - sd$mon)
    }

1.ОКНО ВПЕРЕДНЕГО РОЛИКА:

rollapply.list.date.range <- function(data, num.of.months, FUN) 
{
  dates.list <- index(data)
  seq.list <- sapply(dates.list, FUN = function(x) {
     dt <- as.integer(x[1])
     cur.seq.list <- separate.by.months(dt, dates.list, num.of.months)
     names(cur.seq.list) <- dt
     return(cur.seq.list)
  })

  lapply(seq.list, FUN)
}

separate.by.months <- function(dt, dates.list, num.of.months) 
{
  date.seq.indexes <- sapply(dates.list, function(x) { 
    date.diff <- as.integer(x) - dt
    date.normalized <- get.months.elapsed(as.Date(0), as.Date(date.diff))
    floor(date.normalized  / num.of.months)
  })

  seq.list <- split(dates.list, date.seq.indexes)
  seq.list["0"]
}

2.ОБРАТНОЕ ОКНО В РОЛИКЕ:

rollapply.date.range <- function(data, num.of.months, FUN) 
{
  dates.list <- rev(index(data))
  seq.list <- sapply(dates.list, FUN = function(x) {
     dt <- x[1]
     cur.seq.list <- separate.by.months(dt, dates.list, num.of.months)
     names(cur.seq.list) <- dt
     return(cur.seq.list)
  })

  lapply(seq.list, FUN)
}

separate.by.months <- function(dt, dates.list, num.of.months) 
{
  date.seq.indexes <- sapply(dates.list, function(x) { 
    date.diff <- as.integer(x) - as.integer(dt)
    date.normalized <- ifelse(sign(date.diff) == 1, -9999, -get.months.elapsed(as.Date(0), as.Date(date.diff)))
    floor(date.normalized  / num.of.months)
  })

  seq.list <- split(dates.list, date.seq.indexes)
  seq.list["0"]
}

И тогда вы бы назвали его следующим образом:

rollapply.list.date.range(z, 3, mean)

Answer 2

1.агрегат

Если то, что вы ищете, - это обработка, описанная кодом в вашем ответе на ваш вопрос, то то, что вы ищете, лучше всего описать как агрегацию, а не как скользящее приложение функции.

Чтобы получить среднее значение каждого месяца, каждого квартала и каждого n месяцев, используйте aggregate.zoo:

myfun <- mean
aggregate(z, as.yearmon, myfun)
## Jan 1970 Feb 1970 Mar 1970 Apr 1970 May 1970 Jun 1970 Jul 1970 Aug 1970 
##    115.5    144.5    174.0    204.5    235.0    265.5    296.0    327.0 
## Sep 1970 Oct 1970 Nov 1970 Dec 1970 Jan 1971 
##    357.5    388.0    418.5    449.0    465.0 

aggregate(z, as.yearqtr, myfun)
## 1970 Q1 1970 Q2 1970 Q3 1970 Q4 1971 Q1 
##   145.0   235.0   326.5   418.5   465.0 

n <- 3
aggregate(z, as.Date(cut(index(z), paste(n, "months"))), myfun)
## 1970-01-01 1970-04-01 1970-07-01 1970-10-01 1971-01-01 
##      145.0      235.0      326.5      418.5      465.0 

или используйте as.yearmon вместо as.Date.В приведенном выше тексте mean можно заменить произвольной функцией.

2.rollapply

a) Если вы действительно хотите пролонгировать n месяцев, создайте объект зоопарка ag с одной строкой в ​​месяц и 31 столбцом, заполняющим дополнительные столбцы за короткие месяцы с помощью NA,Затем запустите rollapplyr с функцией, которая распределяет данные для каждой итерации в один длинный вектор, удаляя NA, которые были добавлены в конце коротких месяцев, и вставляя их в нашу произвольную функцию.

n <- 3
myfun <- mean

ag <- aggregate(z, as.yearmon, "length<-", value = 31)
rollapplyr(ag, n, function(x) myfun(na.omit(c(t(x)))), fill = NA, by.column = FALSE)
## Jan 1970 Feb 1970 Mar 1970 Apr 1970 May 1970 Jun 1970 Jul 1970 Aug 1970 
##       NA       NA    145.0    175.0    204.5    235.0    265.5    296.5 
## Sep 1970 Oct 1970 Nov 1970 Dec 1970 Jan 1971 
##    326.5    357.5    388.0    418.5    434.5 

b) Другая возможность:

s <- split(z, as.yearmon(index(z)))
r <- rollapplyr(seq_along(s), n, function(ix) myfun(unlist(s[ix])), fill = NA)
zoo(r, as.yearmon(names(s), "%b %Y"))   
## Jan 1970 Feb 1970 Mar 1970 Apr 1970 May 1970 Jun 1970 Jul 1970 Aug 1970 
##       NA       NA    145.0    175.0    204.5    235.0    265.5    296.5 
## Sep 1970 Oct 1970 Nov 1970 Dec 1970 Jan 1971 
##    326.5    357.5    388.0    418.5    434.5 

3.rollapply со средним значением

Следующая работа со средним значением, но в зависимости от вашей произвольной функции они могут изменяться для работы с ней.

a) Сначала создайте 2столбец объекта зоопарка ag, строки которого представляют собой сумму и длину каждого месяца, а затем используйте rollapplyr для этого.

n <- 3
ag2 <- aggregate(z, as.yearmon, function(x) c(sum(x), length(x)))
rollapplyr(ag2, 3, function(x) sum(x[, 1]) / sum(x[, 2]), fill = NA, by.column = FALSE)
## Jan 1970 Feb 1970 Mar 1970 Apr 1970 May 1970 Jun 1970 Jul 1970 Aug 1970 
##       NA       NA    145.0    175.0    204.5    235.0    265.5    296.5 
## Sep 1970 Oct 1970 Nov 1970 Dec 1970 Jan 1971 
##    326.5    357.5    388.0    418.5    434.5 

b) Или еще одна альтернатива - создатькомплексный зоопарк ag3, чьи действительные и мнимые части представляют собой сумму и количество дней в каждом месяце и использование rollapplyr для этого:

ag3 <- aggregate(z, as.yearmon, function(x) complex(real = sum(x), imag = length(x)))
rollapplyr(ag3, 3, function(x) sum(Re(x)) / sum(Im(x)), fill = NA)
## Jan 1970 Feb 1970 Mar 1970 Apr 1970 May 1970 Jun 1970 Jul 1970 Aug 1970 
##       NA       NA    145.0    175.0    204.5    235.0    265.5    296.5 
## Sep 1970 Oct 1970 Nov 1970 Dec 1970 Jan 1971 
##    326.5    357.5    388.0    418.5    434.5

Answer 3

Не уверен, я правильно понял.Но, может быть, это сработает:

# create data
z <- zoo::zoo(101:465, as.Date(1:365))

# everything you need is cut it by quarter
quarters <- cut(as.Date(index(z)), breaks = 'quarter', labels = F)
# but if you want list of indices, you make them this way
idxs <- split(seq_along(z), quarters)

# to see what you've got
dplyr::glimpse(idxs)
List of 5
 $ 1: int [1:89] 1 2 3 4 5 6 7 8 9 10 ...
 $ 2: int [1:91] 90 91 92 93 94 95 96 97 98 99 ...
 $ 3: int [1:92] 181 182 183 184 185 186 187 188 189 190 ...
 $ 4: int [1:92] 273 274 275 276 277 278 279 280 281 282 ...
 $ 5: int 365