R - Выполнить Zoo rollapply / rollmean на нескольких столбцах - PullRequest
Новая
       45

R - Выполнить Zoo rollapply / rollmean на нескольких столбцах

0 голосов
/ 12 июня 2019

Я хочу рассчитать скользящее среднее (назад и вперед) за 15 дней каждый.Вот тестовый кадр: 

date_list = seq(ymd('2000-01-15'),ymd('2010-09-18'),by='day')
testframe = data.frame(Date = date_list)
testframe$Day = substr(testframe$Date, start = 6, stop = 10)
testframe$V1 = runif(3900, 2.0, 35.0)
testframe$V2 = runif(3900, 5.0, 40.0)
testframe$V3 = runif(3900, -10.0, 10.0)
testframe$V4 = seq(from = 5, to = 45, length.out = 3900)

Я знаю, как рассчитать его для каждого отдельного столбца: 

library(zoo)
rollmean(testframe$V4, 31)
rollapply(testframe$V4, 31, mean)

Но как я могу сделать это для каждого столбца одновременно?Я думаю, что для этого нужно исключить столбец «День и дата», но как я могу это сделать в команде?И как я могу получить результаты в моем старом тестовом фрейме с NA за первые и последние 15 дней?

Я пробовал это: 

testframe[paste0("new_col",1:4)] <- lapply(testframe[,3:6], rollapply, FUN = mean, width = 31)

Но это не работает!

Ответы [ 2 ]

2 голосов
/ 12 июня 2019

Операции по умолчанию rollmean и rollapply действуют на каждый столбец.Пожалуйста, просмотрите ?rollapply. 

library(zoo)
rollmeanr(BOD, 2, fill = NA)

, указав следующее, в котором rollmean применяется к каждому столбцу встроенного BOD: 

     Time demand
[1,]   NA     NA
[2,]  1.5   9.30
[3,]  2.5  14.65
[4,]  3.5  17.50
[5,]  4.5  15.80
[6,]  6.0  17.70

Если вы хотите применить среднее к некоторымзатем в столбцах укажите, что: 

if (exists("BOD", .GlobalEnv)) rm(BOD)
BOD[1:2] <- rollmeanr(BOD[1:2], 2, fill = NA)

Обратите внимание, что если у вас есть все числовые столбцы, кроме столбца индекса, было бы проще просто использовать объекты zoo, а не пытаться принудительно вписать все в data.frames, которыене очень хорошо работает с временными рядами. 

if (exists("BOD", .GlobalEnv)) rm(BOD)
z <- read.zoo(BOD)
rollmeanr(z, 2)
1 голос
/ 12 июня 2019

Хотя ответ @ G.Grothendieck лучше во многих отношениях, вот некоторый контекст для того, что может пойти не так в вашем случае: 

testframe[paste0("new_col",1:4)] <- lapply(testframe[,3:6], rollapply, FUN = mean, width = 31)
# Error in mean.default(X[[i]], ...) : 'trim' must be numeric of length one

Это отчасти потому, что вы передаете FUN=, но это также имя аргумента для lapply, поэтому вместо него он используется эффективно: 

testframe[paste0("new_col",1:4)] <- lapply(testframe[,3:6], function(a) mean(a, trim=rollapply, width = 31))

Второй аргумент mean - это trim=, которому в данном случае передается функция rollapply, явно не правильная.

Следующим шагом будет 

testframe[paste0("new_col",1:4)] <- lapply(testframe[,3:6], function(a) rollapply(a, FUN = mean, width = 31))
# Error in `[<-.data.frame`(`*tmp*`, paste0("new_col", 1:4), value = list( : 
#   replacement element 1 has 3870 rows, need 3900

, потому что один rollapply не возвращает первые / последние 15 значений (в результате на 30 наблюдений меньше). Вы можете исправить это с помощью fill=NA: 

testframe[paste0("new_col",1:4)] <- lapply(testframe[,3:6], function(a) rollapply(a, FUN = mean, width = 31, fill = NA))
# (no warnings/errors)
...