Cleanup, and granger test

ARMA_Pop.r

@@ -1,5 +1,6 @@
 library(tidyverse)
 library(forecast)
+library(lmtest)
 
 source("Scripts/Functions.r")
 #source("Scripts/Load_Wyoming_Web_Data.r")
@@ -10,13 +11,77 @@ TS <- 1000*ts(DF,start=c(1970),end=c(2024),frequency=1)
 BC <- BoxCox.lambda(TS)
 MODEL <- auto.arima(TS, lambda = BC)
 forecast(MODEL,h=20)
-plot(forecast(MODEL,h=35),main="Lincoln County Population Forecast")
+ARMA_POP <- forecast(MODEL,h=35,fan=TRUE,bootstrap = TRUE,npaths=100000,biasadj=FALSE)
+ARMA_POP
+plot(ARMA_POP,main="Lincoln County Population Forecast",xlab="Year",ylab="Population")
+help("forecast")
 ####Employment to pop ratio
 EMP <- FRED_GET('LAUCN560230000000005','EMP') %>% inner_join(FRED_GET('WYLINC3POP','LN_POP')) %>% mutate(LN_POP=1000*LN_POP)
+
 EMP <- EMP %>% mutate(RATIO=LN_POP/EMP)
 ggplot(aes(x=YEAR,y=RATIO),data=EMP)+geom_line()
 AVG_POP_RATIO <- mean(EMP$RATIO)
 SD_POP_RATIO <- sd(EMP$RATIO)
+##############
+TS <- EMP %>% select(EMP) %>% ts(start=c(1990),end=c(2024),frequency=1)
+BC <- BoxCox.lambda(TS)
+MODEL2 <- auto.arima(TS, lambda = BC)
+MODEL2
+ARMA_EMP <- forecast(MODEL2,h=35,fan=TRUE,bootstrap = TRUE,npaths=100000,biasadj=FALSE)
+plot(ARMA_EMP,main="Lincoln County Employment",xlab="Year",ylab="Employed")
+
+##########
+DATA <- FRED_GET('BPPRIV056023','PRIV_HOUSING') %>% inner_join(FRED_GET('WYLINC3POP','LN_POP')) %>% inner_join(FRED_GET('ATNHPIUS56023A','HOUSE_PRICE_INDEX')) %>% left_join(FRED_GET('LAUCN560230000000005','EMP')) %>%left_join(FRED_GET('DCOILWTICO','WTI'))  %>%left_join(FRED_GET('PCOALAUUSDM','COAL'))  %>% mutate(LN_POP=1000*LN_POP) %>% select(-YEAR) %>% ts() %>% log() %>% diff()
+grangertest(PRIV_HOUSING~HOUSE_PRICE_INDEX,data=DATA,order=1)
+grangertest(HOUSE_PRICE_INDEX~PRIV_HOUSING,data=DATA,order=2)
+grangertest(LN_POP~PRIV_HOUSING,data=DATA,order=1)
+grangertest(HOUSE_PRICE_INDEX~COAL,data=DATA,order=2) 
+grangertest(LN_POP~WTI,data=DATA,order=1)
+grangertest(COAL~WTI,data=DATA,order=2)
+grangertest(WTI~COAL,data=DATA,order=2)
+grangertest(LN_POP~COAL,data=DATA,order=1)
+grangertest(EMP~LN_POP,data=DATA,order=2)
+
+
+grangertest(PRIV_HOUSING~LN_POP,data=DATA,order=2) ## Signficant
+grangertest(EMP~LN_POP,data=DATA,order=2) ## Signficant
+grangertest(EMP~PRIV_HOUSING,data=DATA,order=2) ##Signficant
+grangertest(EMP~LN_POP,data=DATA,order=2) ##Signficant
+grangertest(PRIV_HOUSING~COAL,data=DATA,order=1) ##Signficant
+grangertest(PRIV_HOUSING~COAL,data=DATA,order=2) ##Signficant
+grangertest(PRIV_HOUSING~COAL,data=DATA,order=3) ##Signficant
+grangertest(EMP~COAL,data=DATA,order=1) ##Signficant
+
+
+
+
+
+
+grangertest(LN_POP~EMP,data=DATA,order=2)
+grangertest(PRIV_HOUSING~EMP,data=DATA,order=2)
+
+
+
+
+
+
+plot(DATA)
+library(BVAR)
+MOD <- bvar(DATA,lags=1, n_draw=40000)
+opt_irf <- bv_irf(horizon = 25, identification = TRUE)
+plot(irf(MOD,opt_irf,conf_bands = c(0.05, 0.1,0.15)),area=TRUE)
+
+
+
+head(DATA)
+
+
+
+
+DATA
+# ATNHPIUS56023A Housing price index
+# Median income MHIWY56023A052NCEN
+# Employed Persons in Lincoln LAUCN560230000000005
 
 #####Plan and ideas
 #1) Review IMPLAN for industry multipliers

old/BVAR_Pop.r

@@ -51,27 +51,9 @@ colnames(DATA)
 TS_DATA_ORIG <- DATA %>% select(YEAR,LN_POP,LN_EMPLOYMENT,US_EMP,US_POP,WY_POP,UINTA_POP,SUBLETTE_POP,SWEETWATER_POP,TETON_POP,BEAR_LAKE_POP,CARIBOU_POP,BONNEVILLE_POP) %>%
   filter(!is.na(LN_POP),!is.na(LN_EMPLOYMENT)) %>%
   arrange(YEAR) %>% select(-YEAR)
-TEST <- RES %>% filter(!is.na(LN_EMPLOYMENT)) %>% mutate(LAG_LN_EMP=lag(LN_EMPLOYMENT))
-TEST %>% select(LN_EMPLOYMENT,LAG_LN_EMP)
-feols(log(LN_POP)~log(LAG_LN_EMP)+lag(LN_POP)+YEAR,data=TEST )
-colnames(DATA)
 TS_DATA <- log(ts(TS_DATA_ORIG,start=c(1970),end=c(2024),frequency=1))
-tsplot(TS_DATA)
-library(fixest)
-TEMP <- feols(log(LN_POP) ~ lag(LN_POP)+log(US_EMP)+lag(log(US_EMP))+log(US_POP),data=DATA)
-TEM
 
-plot(TEMP$residuals)
+MOD <- bvar(TS_DATA,lags=2, n_draw=15000)
-MOD <- bvar(TS_DATA,exogen="sdfs",sdflkj=5,lags=2, n_draw=15000)
-plot(predict(MOD,horizon=25,value="LN_POP"),area=TRUE)
-forecast(MOD,variables=c("LN_POP"),horizon=25)
-?predict.bvar
-?bv_mh
-summary(MOD)
-plot(MOD)
-plot(fitted(MOD,type="mean"))
-plot(residuals(MOD,type="mean"),vars=c("LN_POP","UINTA_POP","SWEETWATER_POP"))
-plot(MOD, type = "dens", vars_response = "LN_POP", vars_impulse = "LN_POP-lag1")
 opt_irf <- bv_irf(horizon = 25, identification = TRUE)
 
 plot(irf(MOD,opt_irf,conf_bands = c(0.05, 0.1,0.15)),area=TRUE,vars_impulse = c("LN_EMP"),vars_response = c("WY_POP","LN_POP","UINTA_POP","SUBLETTE_POP","SWEETWATER_POP"))