Thursday, August 7, 2014

Time Series Analysis - Multivariate Autoregressive State-Space Models

memory.limit()
memory.size(max = TRUE)
rm(list=ls(all=TRUE))
sessionInfo()

require(data.table)
require(stringr)
require(lubridate)
require(scales)

require(ggplot2)
require(gridExtra)
require(ggthemes)

require(MARSS)

## Read in individual data;
setwd("~/Desktop/R/KLAB/11_18_2016/individual")

## Copy results from one directory to current directory
dir.create(file.path("/Users/tkmaemd/Desktop/R/KLAB/11_18_2016/individual", "results"))
file.copy(from="/Users/tkmaemd/Desktop/R/KLAB/11_18_2016/batch/results",
          to="/Users/tkmaemd/Desktop/R/KLAB/11_18_2016/individual",
          recursive = TRUE, copy.mode = TRUE)

## Read-in raw data
files <- list.files(pattern = ".csv")
files
temp <- lapply(files, fread, sep=",")
data <- rbindlist( temp )
dim(data)


tmp=data[theme=='Dresses' & category=='Details']
Sample = dcast.data.table(tmp, Date + theme + category ~ keyword,value.var="ankle jeans")
names(Sample)=str_replace_all(names(Sample), " ", "_")
Sample <- Sample[, theme:=NULL]
Sample <- Sample[, category:=NULL]
Sample <- Sample[-1]

n=nrow(Sample)
dat = Sample[(n-51):n]
dat = dat[, Date:=NULL]

## model 1: one hidden state and i.i.d obs - R is diagonal and equal
## Fit the single state model, where the time series are assumed to be from the same population.
model1=list()
model1$R="diagonal and equal"
model1$Z=matrix(1,8,1) #matrix of 2 rows and 1 column
model1$A="scaling" #the default

kemfit = MARSS(bb, model=list(Z=matrix(1,2,1),R ="diagonal and equal")) ##2 is used because we have 2 signals
#kemfit = MARSS(bb, model.list)
print(kemfit$model)
summary(kemfit$model)
kem1 = MARSS(t(dat), model=model1)
kem1$AIC
kem1$AICc

# model 2: Fit the single state model, where the time series are assumed to be from the same population with different variance
model2=list()
model2$R="diagonal and unequal"
model2$Z=matrix(1,8,1) #matrix of 2 rows and 1 column
model2$A="scaling" #the default

kem2 = MARSS(t(dat), model=model2)
kem2$AIC
kem2$AICc

output <- Sample[(n-51):n]
output$Date <- as.Date(output$Date,"%Y-%m-%d")
b <- t(kem2$states)####b is the combined index
output$COMBINED <- round(100*b/max(b))
colors=rainbow(8)
ggplot(output, aes(x=Date, y=COMBINED, group = 1)) +
  geom_line(aes(x=Date, y=COMBINED), col = 'red', size = 2, linetype=1) +
  geom_line(aes(x=Date, y=bandana_print_dress), col = colors[1], size = 1, linetype=4) +
  geom_line(aes(x=Date, y=bohemian_dress), col =  colors[2], size = 1, linetype=4) +
  geom_line(aes(x=Date, y=embroidered_dress), col =  colors[3], size = 1, linetype=4) +
  geom_line(aes(x=Date, y=floral_dress), col =  colors[4], size = 1, linetype=4) +
  geom_line(aes(x=Date, y=fringe_dress), col =  colors[5] , size = 1, linetype=4) +
  geom_line(aes(x=Date, y=paisley_print_dress), col = colors[6], size = 1, linetype=4) +
  geom_line(aes(x=Date, y=ruffle_dress), col =  colors[7], size = 1, linetype=4) +
  geom_line(aes(x=Date, y=tie_dye_dress), size=1, linetype=4, color= colors[8]) +
  scale_x_date(labels=date_format("%b %y"), breaks=date_breaks("4 week")) +
  xlab("Search Index") +
  ylab("Date") +
  ggtitle("Combined 8 Index of 52 Weeks from STATE SPACE Model for Dress Detail Category") +
  theme(plot.title = element_text(face = "bold", size = 20)) +
  theme(axis.text.x = element_text(face = "bold", size = 14)) +
  theme(axis.text.y = element_text(face = "bold", size = 14)) +
  theme(axis.title.x = element_text(face = "bold", size = 16)) +
  theme(strip.text.x = element_text(face = "bold", size = 16)) +
  theme(axis.title.y = element_text(face = "bold", size = 16, angle=90)) +
  guides(fill=FALSE)


# model 3:  Fit a model with different population process with the same process parameters
model3=list()
model3$Q="diagonal and equal"
model3$R="diagonal and equal"
model3$U="equal"
model3$Z="identity"
model3$A="zero"
kem3 = MARSS(t(dat), model=model3)
kem3$AIC
kem3$AICc


No comments:

Post a Comment