2012-05-29 2 views
1

nberDates() В пакете tis приведен список дат начала и окончания рецессии.Изменение nberDates() в временном ряду в R для подмножества

Каков самый маленький, самый короткий способ превратить это в набор манекенов для подмножества существующих временных рядов?

Таким образом, само по себе дает nberDates ...

> nberDates() 
     Start  End 
[1,] 18570701 18581231 
[2,] 18601101 18610630 
[3,] 18650501 18671231 
[4,] 18690701 187
[5,] 18731101 18790331 
[6,] 18820401 18850531 

и str(nberDates()) говорит тип "Named num."

У меня есть еще один объект времени серии в XTS, который в настоящее время выглядит следующим образом ...

> head(mydata) 
       value 
1966-01-01   15 
1967-01-01   16 
1968-01-01   20 
1969-01-01   21 
1970-01-01   18 
1971-01-01   12 

Я хотел бы иметь вторую переменную, углубление, то есть 1 во время спадов:

> head(mydata) 
       value recess 
1966-01-01   15  0 
1967-01-01   16  0 
1968-01-01   20  0 
1969-01-01   21  0 
1970-01-01   18  1 
1971-01-01   12  0 

(Моя цель состоит в том, что я хотел бы, чтобы иметь возможность сравнивать значения в спадах со значениями из спадов.)

неуклюжих, что я пытаюсь, что не работает это ...

((index(mydata) > as.Date(as.character(nberDates()[,1]),format="%Y%m%d")) & (index(mydata) < as.Date(as.character(nberDates()[,2]),format="%Y%m%d"))) 

Но это дает ...

[1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE 
[13] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE 
[25] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE 
[37] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE 
Warning messages: 
1: In `>.default`(index(mydata), as.Date(as.character(nberDates()[, : 
    longer object length is not a multiple of shorter object length 
2: In `<.default`(index(mydata), as.Date(as.character(nberDates()[, : 
    longer object length is not a multiple of shorter object length 

Я знаю, что я могу решить эту проблему с неуклюжим для цикла, но это всегда подсказывает мне, что я делаю неправильно R.

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

ответ

1

Следующие должны сделать это:

sapply(index(mydata), function(x) any(((x >= as.Date(as.character(nberDates()[,1]),format="%Y%m%d") & (x <= as.Date(as.character(nberDates()[,2]),format="%Y%m%d")))))) 

sapply в основном идет через вектор и проверки для каждого элемента, если он попадает в один из интервалов NBER.

Обратите внимание, однако, что способ, которым это в настоящее время записывается, означает, что он будет преобразовывать необработанные данные NBER в даты (as.Date) один раз для каждого элемента в mydata, чтобы вы могли сделать преобразование один раз, сохраните его в каком-то временном фрейме данных, а затем запустите выше.

+0

Это то, что я искал. Я все еще не думаю о «применении» функций, и каждый раз спрашиваю себя. Благодаря! – Mittenchops

0

Ориентировочно, я использую вложенные петли следующим образом. Все еще ищете лучший ответ!

mydata$recess <- 0 
for (x in seq(1,dim(mydata)[1])){ 
    for (y in seq(1,dim(nberDates())[1])){ 
    if (index(mydata)[x] >= as.Date(as.character(nberDates()[y,1]),format="%Y%m%d") & 
     index(mydata)[x] <= as.Date(as.character(nberDates()[y,2]),format="%Y%m%d")){ 
     mydata$recess[x] <- 1 
    } 
    } 
} 
0

Вот еще одно решение, которое использует некоторое удобное поведение в merge.xts.

library(xts) 
library(tis) # for nberDates() 
# make two xts objects filled with ones 
# 1) recession start dates 
# 2) recession end dates 
rd <- apply(nberDates(),2,as.character) 
ones <- rep(1,nrow(rd)) 
rStart <- xts(ones, as.Date(rd[,1],"%Y%m%d")) 
rEnd <- xts(ones, as.Date(rd[,2],"%Y%m%d")) 
# merge recession start/end date objects with empty xts 
# object containing indexes from mydata, filled with zeros 
# and take the cumulative sum (by column) 
rx <- cumsum(merge(rStart,rEnd,xts(,index(mydata)),fill=0)) 
# the recess column = (cumulative # of recessions started at date D) - 
# (cumulative # of recessions ended at date D) 
mydata$recess <- (rx[,1]-rx[,2])[index(mydata)] 

В качестве альтернативы, вы можете просто использовать USREC series from FREDII.

library(quantmod) 
getSymbols("USREC",src="FRED") 
mydata2 <- merge(mydata, USREC, all=FALSE) 
Смежные вопросы