общее отставание в данных панели временных рядов

Question

У меня есть набор данных сродни этому

User    Date        Value
A       2012-01-01  4
A       2012-01-02  5   
A       2012-01-03  6
A       2012-01-04  7
B       2012-01-01  2
B       2012-01-02  3   
B       2012-01-03  4
B       2012-01-04  5

Я хочу создать лаг Value, уважая User.

User    Date        Value   Value.lag
A       2012-01-01  4       NA
A       2012-01-02  5       4
A       2012-01-03  6       5
A       2012-01-04  7       6
B       2012-01-01  2       NA
B       2012-01-02  3       2   
B       2012-01-03  4       3
B       2012-01-04  5       4

Я сделал это очень неэффективно в цикле

df$value.lag1<-NA
levs<-levels(as.factor(df$User))
levs
  for (i in 1:length(levs)) {
    temper<- subset(df,User==as.numeric(levs[i]))
    temper<- rbind(NA,temper[-nrow(temper),])  
df$value.lag1[df$User==as.numeric(as.character(levs[i]))]<- temper
      }

Но это очень медленно. Я смотрел на использование by и tapply, но не понял, как заставить их работать.

Я не думаю, что XTS или TS будут работать из-за элемента User.

Есть предложения?

Answer 1

Вы можете использовать ddply: он разбивает data.frame на части и преобразует каждый кусок.

d <- data.frame( 
  User = rep( LETTERS[1:3], each=10 ),
  Date = seq.Date( Sys.Date(), length=30, by="day" ),
  Value = rep(1:10, 3)
)
library(plyr)
d <- ddply( 
  d, .(User), transform,
  # This assumes that the data is sorted
  Value = c( NA, Value[-length(Value)] ) 
)

Answer 2

Я думаю, что самый простой способ, особенно с учетом дальнейшего анализа, - преобразовать ваш фрейм данных в класс pdata.frame из пакета plm.

После преобразования из операторов diff() и lag()может использоваться для создания лагов и отличий.

df<-pdata.frame(df,index=c("id","date")
df<-transofrm(df, l_value=lag(value,1))

Answer 3

Я наткнулся на похожую проблему и написал функцию.

#df needs to be a structured balanced paneldata set sorted by id and date
#OBS the function deletes the row where the NA value would have been.

df <- data.frame(id = c(1, 1, 1, 1, 1, 2, 2,2,2,2), 
                 date = c(1992, 1993, 1991, 1990, 1994, 1992, 1991
                          ,1994,1990,1993), 
                 value = c(4.1, 4.5, 3.3, 5.3, 3.0, 3.2, 5.2,5.3,3.4,5.6))
# sort paneldata set
library(dplyr)
df<-arrange(df,id,date)

#Function
# a=df
# b=colname of variable/variables that you want to lag
# q=number of lag years
# t=colname of date/time column
retraso<-function(a,b,q,t){

  sto<-max(as.numeric(unique(a[[t]])))
  sta<-min(as.numeric(unique(a[[t]])))

  yo<-a[which(a[[t]]>=(sta+q)),]

  la<-function(a,d,t,sto,sta){


    ja<-data.frame(a[[d]],a[[t]])
    colnames(ja)<-c(d,t)


    ja<-ja[which(ja[[t]]<=(sto-q)),1]
    return(ja)
  }

  for (i in 1:length(b)){

    yo[[b[i]]] <-la(a,b[i],t,sto,sta)

    }
    return(yo)

  }

#lag df 1 year
df<-retraso(df,"value",1,"date")

Answer 4

Для панели без отсутствующих объектов это интуитивное решение:

df <- data.frame(id = c(1, 1, 1, 1, 1, 2, 2), 
                 date = c(1992, 1993, 1991, 1990, 1994, 1992, 1991), 
                 value = c(4.1, 4.5, 3.3, 5.3, 3.0, 3.2, 5.2))

df<-df[with(df, order(id,date)), ]  # sort by id and then by date
df$l_value=c(NA,df$value[-length(df$value)]) # create a new var with data displaced by 1 unit
df$l_value[df$id != c(NA, df$id[-length(df$id)])] =NA # NA data with different current and lagged id.
df

id date value l_value
4  1 1990   5.3      NA
3  1 1991   3.3     5.3
1  1 1992   4.1     3.3
2  1 1993   4.5     4.1
5  1 1994   3.0     4.5
7  2 1991   5.2      NA
6  2 1992   3.2     5.2

Answer 5

Если у вас нет пропусков в переменной времени, выполните

df %>% group_by(User) %>% mutate(value_lag = lag(value, order_by =Date)

Если у вас есть пробелы в переменной времени, посмотрите этот ответ https://stackoverflow.com/a/26108191/3662288

Answer 6

При условии, что таблица упорядочена пользователем и датой, это можно сделать с помощью zoo.Хитрость заключается в том, чтобы не указывать индекс в этой точке.

library(zoo)
df <-read.table(text="User Date Value
A 2012-01-01 4
A 2012-01-02 5
A 2012-01-03 6
A 2012-01-04 7
B 2012-01-01 2
B 2012-01-02 3
B 2012-01-03 4
B 2012-01-04 5", header=TRUE, as.is=TRUE,sep = " ")

out <-zoo(df)

Value.lag <-lag(out,-1)[out$User==lag(out$User)]
res <-merge.zoo(out,Value.lag)
res <-res[,-(4:5)]  # to remove extra columns

  User.out Date.out   Value.out Value.Value.lag
1 A        2012-01-01 4         <NA>           
2 A        2012-01-02 5         4              
3 A        2012-01-03 6         5              
4 A        2012-01-04 7         6              
5 B        2012-01-01 2         <NA>           
6 B        2012-01-02 3         2              
7 B        2012-01-03 4         3              
8 B        2012-01-04 5         4 

Answer 7

Аналогично, вы можете использовать tapply

# Create Data
user = c(rep('A',4),rep('B',4))
date = rep(seq(as.Date('2012-01-01'),as.Date('2012-01-04'),1),2)
value = c(4:7,2:5) 
df = data.frame(user,date,value)
# Get lagged values
df$value.lag = unlist(tapply(df$value, df$user, function(x) c(NA,x[-length(df$value)])))

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