diff --git a/ARMA_Pop.r b/ARMA_Pop.r index 8f0b059..cafbd72 100644 --- a/ARMA_Pop.r +++ b/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 diff --git a/BVAR_Pop.r b/old/BVAR_Pop.r similarity index 84% rename from BVAR_Pop.r rename to old/BVAR_Pop.r index 07603a6..a49ede8 100644 --- a/BVAR_Pop.r +++ b/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,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") +MOD <- bvar(TS_DATA,lags=2, n_draw=15000) 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")) @@ -89,4 +71,4 @@ plot(irf(MOD2,opt_irf,conf_bands = c(0.05, 0.1,0.15)),area=TRUE,vars_response = ?plot.bvar_irf plot(predict(MOD,horizon=25,conf_bands = c(0.05, 0.1,0.15)),area=TRUE,vars=c("LN_POP")) exp(3.5)-exp(3) -acf(resid(MOD)) \ No newline at end of file +acf(resid(MOD)) diff --git a/Bayes_Pop.r b/old/Bayes_Pop.r similarity index 100% rename from Bayes_Pop.r rename to old/Bayes_Pop.r diff --git a/old/County_Data.png b/old/County_Data.png new file mode 100644 index 0000000..15834d2 Binary files /dev/null and b/old/County_Data.png differ diff --git a/Popultaion.R b/old/Popultaion.R similarity index 100% rename from Popultaion.R rename to old/Popultaion.R