Простая скользящая средняя на несбалансированной панели в 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 полагаются на равномерное распределение рядов для создания индексной переменной, в то время как rollapply требует, чтобы количество наблюдений (размер окна) было одинаковым для всех субъектов.

На StackExchange есть решение с data.table, которое намекает на решение моей проблемы: Получение скользящего среднего несбалансированного набора панельных данных

Возможно, это решение можно модифицировать для получения скользящего среднего фиксированной длины вместо «скользящего кумулятивного среднего».


r data.table plyr panel-data split-apply-combine
person user27636    schedule 10.11.2013    source источник
comment
См. Также stackoverflow.com/questions/16111242/ и stackoverflow.com/questions/743812/   -  person Michael Ohlrogge    schedule 22.08.2016

Ответы (2)


arrow_upward
2
arrow_downward

Дает ли это желаемый результат?

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)
person Henrik    schedule 11.11.2013
comment
Ответ требует регуляризации ряда. В моем случае это повлечет за собой добавление большого количества NA в ряд и приведет к тому, что скользящее среднее (с na.rm = TRUE) будет вести себя хаотично. Однако я буду использовать некоторые из ваших идей, чтобы дополнить серию АН, а не вставлять АН. Поэтому +1 за то, что поделился полезным кодом. - person user27636; 16.11.2013

arrow_upward
1
arrow_downward

Итак, чтобы ответить на мой собственный вопрос, один из способов сделать это - использовать split-lapply (Rollingaverage) -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)

Затем вектор "QuantityMA" должен быть добавлен обратно в основной фрейм "panelUNB". Кажется, работает. Отставание может быть выполнено на несбалансированной панели с помощью ddply.

Если у кого-то есть другое, возможно, более элегантное решение, пожалуйста, поделитесь им.

person user27636    schedule 11.11.2013