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