Простая скользящая средняя на несбалансированной панели в R
Я работаю с неуравновешенными, нерегулярно расположенными временными рядами поперечного сечения. Моя цель - получить вектор отстающей скользящей средней для вектора "Количество", сегментированный "Предметом".
Другими словами, скажем, что следующие субъекты были обнаружены для субъекта_1: [1,2,3,4,5]. Сначала мне нужно отставать на 1, получая [NA,1,2,3,4].
Затем мне нужно взять скользящую среднюю порядка 3, получая [NA,NA,NA,(3+2+1)/3,(4+3+2)/3]
Вышеуказанное должно быть сделано для всех предметов.
# Construct example balanced panel DF
panel <- data.frame(
as.factor(sort(rep(1:6,5))),
rep(1:5,6),
rnorm(30)
)
colnames(panel)<- c("Subject","Day","Quantity")
#Make panel DF unbalanced
panelUNB <- subset(panel,as.numeric(Subject)!= Day)
panelUNB <- panelUNB[-c(15,16),]
Если бы панель была сбалансирована, я бы сначала отставал переменную "Количество", используя пакет plm
и функцияlag
, Тогда я бы взял скользящую среднюю отстающих "Quanatity", как и так, используя функцию rollmean
из пакета zoo
:
panel$QuantityMA <- ave(panel$Quantity, panel$Subject, FUN = function(x) rollmean(
x,3,align="right",fill=NA,na.rm=TRUE))
Это даст правильный результат при применении к сбалансированной "панели" DF.
Проблема в том, что plm
а также lag
полагаться на то, что ряды равномерно распределены, чтобы создать индексную переменную, в то время как роллаппли требует, чтобы количество наблюдений (размер окна) было одинаковым для всех субъектов.
На StackExchange есть решение с data.table, которое намекает на решение моей проблемы: получение скользящего среднего из несбалансированного набора данных панели
Возможно, это решение можно модифицировать для получения скользящего среднего фиксированной длины вместо "скользящего кумулятивного среднего".
2 ответа
Итак, чтобы ответить на мой собственный вопрос, один из способов сделать это - через split-lapply(rollaverage)-unlist:
Temp <-with(panelUNB, split(Quantity, Subject))
Temp <- lapply(Temp, FUN=function (x) rollapplyr(
x,2,align="right",fill=NA,na.rm=TRUE, FUN=mean))
QuantityMA <-unlist(Temp)
Затем необходимо будет добавить вектор "Количество" обратно к основному кадру "панельУНБ". Кажется, работает. Отставание может быть выполнено на несбалансированной панели с помощью ddply.
Если у кого-то есть другое, возможно, более элегантное решение, вы можете поделиться им.
Дает ли это желаемый результат?
library(reshape2)
library(zoo)
# create time series where each subject have an observation at each time step
d1 <- data.frame(subject = rep(letters[1:4], each = 5),
day = rep(1:5, 4),
quantity = sample(x = 1:4, size = 20, replace = TRUE))
d1
# select some random observations
d2 <- d1[sample(x = seq_len(nrow(d1)), size = 15), ]
d2
# reshape to wide format with dcast
# -> 'automatic' extension from irregular to regular series for each subject,
# _given_ that all time steps are represented.
# Alternative method below more explicit
# fill for structural missings defaults to NA
d3 <- dcast(d2, day ~ subject, value.var = "quantity")
d3
# convert to zoo time series
z1 <- zoo(x = d3[ , -1], order.by = d3$day)
################################
# alternative method to extend time series
# time steps to include are given explicitly
# create a zero-dimensional zoo series
z0 <- zoo(, min(d1$day):max(d1$day))
# extend z1 to contain the same time indices as z0
z1 <- merge(z1, z0)
################################
# lag, defaults to one unit
z2 <- lag(x = z1)
z2
# calculate rolling mean with window width 3
rollmeanr(x = z2, k = 3)
# Handling of NAs:
# from ?rollmean:
# "The default method of rollmean does not handle inputs that contain NAs.
# In such cases, use rollapply instead.":
rollapplyr(data = z2, width = 3, FUN = mean, na.rm = TRUE)