library(lubridate)
library(PointFore)
library(xlsx)


# load observations
#Y<- read.csv("./data-raw/observations.csv", sep=";", dec=",", header=TRUE)
Y <- read.xlsx2("./data-raw/routput_first_second_third_all.xlsx",
                sheetIndex = 2,startRow = 5)

#convert to numeric
Y[,-1] <- t(apply(Y[,-1], 1,function(x) as.numeric(as.character(x))))


# read forecasts
#X<- read.csv("./data-raw/forecasts.csv", sep=";", dec=",", header=TRUE)
X <- read.xlsx2("./data-raw/GBweb_Row_Format.xls", 2)[,c("DATE","gRGDPF1", "GBdate")]

X$gRGDPF1 <- as.numeric(as.character(X$gRGDPF1))

# format date
X$date <- as.Date(as.character(X$GBdate),"%Y%m%d")

X$date.target <- X$date+days(90)

X$date.target <- paste0(year(X$date.target),".",quarter(X$date.target))


####### Choose one forecast for each quarter

# Choose first forecast
# X$comparison <-as.Date("01012000","%m%d%Y")
# X$comparison[(month(X$date)>3)] <- as.Date("04012000","%m%d%Y")
# X$comparison[(month(X$date)>6)] <- as.Date("07012000","%m%d%Y")
# X$comparison[(month(X$date)>9)] <- as.Date("10012000","%m%d%Y")


# # Choose forecast closest to middle of quarter
year(X$date)<-2000
X$comparison <-as.Date("02152000","%m%d%Y")
X$comparison[(month(X$date)>3)] <- as.Date("05152000","%m%d%Y")
X$comparison[(month(X$date)>6)] <- as.Date("08152000","%m%d%Y")
X$comparison[(month(X$date)>9)] <- as.Date("11152000","%m%d%Y")

# # Choose last forecast in quarter
# X$comparison <-as.Date("04012000","%m%d%Y")
# X$comparison[(month(X$date)>3)] <- as.Date("07012000","%m%d%Y")
# X$comparison[(month(X$date)>6)] <- as.Date("10012000","%m%d%Y")
# X$comparison[(month(X$date)>9)] <- as.Date("12312000","%m%d%Y")

X$diff<-abs(X$comparison-X$date)

#drop incomplete cases
X <- X[complete.cases(X),]

X<-transform(X,
             date.rank = ave(diff, DATE,
                             FUN = function(x) rank(x, ties.method = "first")))
#drop other forecasts
X.new <- X[X$date.rank==1,]


####### merge observations and forecasts
Y$Date <-gsub(":Q",".",Y$Date)
X.new$t <- 0
X.new$t[1:(dim(X.new)[1]-1)] <- X.new$DATE[-1]
#Y<-merge(X.new,Y,by = 'DATE',by.y = 'Date')
Y <- merge(X.new,Y, by = 'date.target', by.y = 'Date')
# drop unnecessary variables
Y.full<-Y[,c('DATE','GBdate','gRGDPF1','First','Second','Most_Recent')]




#Y.full$date <- as.Date(as.character(Y.full$GBdate),"%Y%m%d")




###### Choose second or most recent vintage as robustness check
#Y<-Y.full[,c('Second','gRGDPF1')]
#Y<-Y.full[,c('Most_Recent','gRGDPF1')]
#Y<-Y.full[,c('First','gRGDPF1')]
Y<-Y.full[,c('First',"Second","Most_Recent",'gRGDPF1')]


GDP <- Y

colnames(GDP)<-c("observation","observation_second","observation_recent","forecast")

rownames(GDP)<-Y.full$DATE
GDP$date <-as.Date(as.character(Y.full$GBdate),"%Y%m%d")



GDP <- GDP[rownames(GDP)>=1969,]

GDP


# NEW STORY ---------------------------------------------------------------

# load observations
Y <- read.xlsx2("./data-raw/routput_first_second_third_all.xlsx",
                sheetIndex = 2,startRow = 5)
#convert to numeric
Y[,-1] <- t(apply(Y[,-1], 1,function(x) as.numeric(as.character(x))))
# read forecasts
X <- read.xlsx2("./data-raw/GBweb_Row_Format.xls", 2)[,c("DATE","gRGDPF1", "GBdate")]
X$gRGDPF1 <- as.numeric(as.character(X$gRGDPF1))
# format date
X$date <- as.Date(as.character(X$GBdate),"%Y%m%d")
X$date.target <- X$date+days(90)
X$date.target <- paste0(year(X$date.target),".",quarter(X$date.target))

# Choose last forecast in quarter
X$comparison <-as.Date("04012000","%m%d%Y")
X$comparison[(month(X$date)>3)] <- as.Date("07012000","%m%d%Y")
X$comparison[(month(X$date)>6)] <- as.Date("10012000","%m%d%Y")
X$comparison[(month(X$date)>9)] <- as.Date("12312000","%m%d%Y")

X$diff<-abs(X$comparison-X$date)
#drop incomplete cases
X <- X[complete.cases(X),]
X<-transform(X,
             date.rank = ave(diff, DATE,
                             FUN = function(x) rank(x, ties.method = "first")))
#drop other forecasts
X.new <- X[X$date.rank==1,]
Y$Date <-gsub(":Q",".",Y$Date)
X.new$t <- 0
X.new$t[1:(dim(X.new)[1]-1)] <- X.new$DATE[-1]
#Y<-merge(X.new,Y,by = 'DATE',by.y = 'Date')
Y <- merge(X.new,Y, by = 'date.target', by.y = 'Date')
# drop unnecessary variables
Y.full<-Y[,c('DATE','GBdate','gRGDPF1','First','Second','Most_Recent')]
###### Choose second or most recent vintage as robustness check
#Y<-Y.full[,c('Second','gRGDPF1')]
#Y<-Y.full[,c('Most_Recent','gRGDPF1')]
Y<-Y.full[,c('First','gRGDPF1')]
GDP2 <- Y
colnames(GDP2)<-c("observation","forecast")
rownames(GDP2)<-Y.full$DATE

GDP2 <- GDP2[rownames(GDP2)>=1969,]


GDP$forecast_late <- GDP2$forecast
#usethis::use_data(GDP,overwrite = TRUE)

instruments <- c("X","lag(Y,2)")

# late GDP optimal constant quantiles/expectiles --------------------------
res <- estimate.functional(iden.fct = expectiles,
                           model = constant,
                           instruments = instruments,
                           Y = GDP2$observation,X = GDP2$forecast,
                           stateVariable = GDP2$forecast)
summary(res)
car::linearHypothesis(res$gmm,"Theta[1]=0.5")
plot(res)

res <- estimate.functional(iden.fct = expectiles,
                           model = constant,
                           instruments = instruments,
                           Y = GDP2$observation,X = GDP2$forecast,
                           stateVariable = GDP2$forecast)
summary(res)
car::linearHypothesis(res$gmm,"Theta[1]=0.5")
plot(res)


# early GDP not optimal constant ------------------------------------------
res <- estimate.functional(iden.fct = expectiles,
                           model = constant,
                           instruments = instruments,
                           Y = GDP$observation,X = GDP$forecast,
                           stateVariable = GDP$forecast)
summary(res)
car::linearHypothesis(res$gmm,"Theta[1]=0.5")
plot(res)

res <- estimate.functional(iden.fct = quantiles,
                           model = constant,
                           instruments = instruments,
                           Y = GDP$observation,X = GDP$forecast,
                           stateVariable = GDP$forecast)
summary(res)
car::linearHypothesis(res$gmm,"Theta[1]=0.5")
plot(res)

res <- estimate.functional(iden.fct = quantiles,
                           model = constant,
                           instruments = instrumentsA,
                           Y = GDP$observation,X = GDP$forecast,
                           stateVariable = GDP$forecast)
summary(res)
car::linearHypothesis(res$gmm,"Theta[1]=0.5")
plot(res)


# early GDP optimal state-dependent ------------------------------------------
#expectiles
res <- estimate.functional(iden.fct = expectiles,
                           model = probit_linear,
                           instruments = instruments,
                           Y = GDP$observation,X = GDP$forecast,
                           stateVariable = GDP$forecast)
summary(res)
plot(res)

#quantiles
res <- estimate.functional(iden.fct = quantiles,
                           model = probit_linear,
                           instruments = instruments,
                           Y = GDP$observation,X = GDP$forecast,
                           stateVariable = GDP$forecast)
summary(res)
plot(res,hline = TRUE)

#quantiles with instruments X_t, X_t-1
res <- estimate.functional(iden.fct = quantiles,
                           model = probit_linear,
                           instruments = c("X","lag(X)"),
                           Y = GDP$observation,X = GDP$forecast,
                           stateVariable = GDP$forecast)
summary(res)
plot(res,hline = TRUE)

#quantiles with instruments X_t, Y_t-2
res <- estimate.functional(iden.fct = quantiles,
                           model = probit_linear,
                           instruments = c("X","lag(lag(Y))"),
                           Y = GDP$observation,X = GDP$forecast,
                           stateVariable = GDP$forecast)
summary(res)
plot(res,hline = TRUE)

