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

У меня есть набор данных, похожий на этот

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.

Любые предложения?

9
18 янв. '12 в 15:42
источник поделиться
7 ответов

Вы можете использовать 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)] ) 
)
8
18 янв. '12 в 16:05
источник

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

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

df<-pdata.frame(df,index=c("id","date")
df<-transofrm(df, l_value=lag(value,1))
2
14 марта '17 в 23:37
источник

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

#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 or 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")

1
12 янв. '19 в 0:33
источник

Для панели без пропущенного obs это интуитивное решение:

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
1
23 февр. '16 в 22:49
источник

При условии, что таблица упорядочена пользователем и датой, это можно сделать с помощью 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 
0
18 янв. '12 в 20:24
источник

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

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

Если у вас есть пробелы во временной переменной, см. этот ответ qaru.site/questions/548891/...

0
21 окт. '14 в 21:15
источник

Аналогично, вы можете использовать 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)])))

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

0
18 янв. '12 в 19:40
источник

Посмотрите другие вопросы по меткам или Задайте вопрос