diff --git a/old/BVAR_Pop.r b/old/BVAR_Pop.r deleted file mode 100644 index a49ede8..0000000 --- a/old/BVAR_Pop.r +++ /dev/null @@ -1,74 +0,0 @@ -library(BVAR) -library(tidyverse) - -source("Scripts/Functions.r") -#source("Scripts/Load_Wyoming_Web_Data.r") -DATA_TO_GATHER <- list() -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c("WYPOP","WY_POP",TRUE) - -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c("WYNQGSP","WY_GDP",TRUE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c("MEHOINUSWYA646N","WY_MED_INCOME",TRUE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c("BUSAPPWNSAWY","WY_BUISNESS_APPLICATIONS",FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('ACTLISCOUWY','WY_HOUSES_FOR_SALE',FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('WYRVAC','WY_RENTAL_VACANCY_RATE',FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('WYBPPRIVSA','WY_PRIVATE_HOUSING',FALSE) -#New Private Housing Units Authorized by Building Permits for Wyoming -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('B03002006E056023','LN_FIVE_YEAR_POP',FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('GDPALL56023','LN_GDP',TRUE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('WYLINC3POP','LN_POP',FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('LAUCN560230000000005','LN_EMPLOYMENT',FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('BPPRIV056023','LN_PRIVE_HOUSING',FALSE) - -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('ENU5602320510','LN_NUM_ESTABLISHMENTS',FALSE) - -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('GDPALL56041','UINTA_GDP',TRUE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('WYUINT1POP','UINTA_POP',FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('WYSUBL5POP','SUBLETTE_POP',FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('WYSWEE7POP','SWEETWATER_POP',FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('WYTETO9POP','TETON_POP',FALSE) -##Idaho Counties -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('IDBEAR7POP','BEAR_LAKE_POP',FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('IDCARI9POP','CARIBOU_POP',FALSE) - -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('IDBONN0POP','BONNEVILLE_POP',FALSE) -###US Population -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('POPTOTUSA647NWDB','US_POP',FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('CE16OV','US_EMP',FALSE) - - - - -for(x in 1:length(DATA_TO_GATHER)){ - CURRENT <- DATA_TO_GATHER[[x]] - - if(CURRENT[3]){C_DATA <- CPI_ADJUST(FRED_GET(CURRENT[1],CURRENT[2]))}else{C_DATA <- FRED_GET(CURRENT[1],CURRENT[2])} - if(x==1){RES <- C_DATA}else{RES <- RES %>% full_join(C_DATA)} - rm(CURRENT,C_DATA) -} - -DATA <- RES %>% mutate(US_POP=US_POP-WY_POP,WY_POP=WY_POP-LN_POP-UINTA_POP-SUBLETTE_POP-SWEETWATER_POP-TETON_POP) -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) -TS_DATA <- log(ts(TS_DATA_ORIG,start=c(1970),end=c(2024),frequency=1)) - -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")) -plot(irf(MOD,opt_irf,conf_bands = c(0.05, 0.1,0.15)),area=TRUE,vars_impulse = c("LN_EMP"),vars_response = c("TETON_POP","BEAR_LAKE_POP","CARIBOU_POP","BONNEVILLE_POP")) - -plot(irf(MOD,opt_irf,conf_bands = c(0.05, 0.1,0.15)),area=TRUE,vars_impulse = c("LN_POP"),vars_response = c("WY_POP","LN_POP","UINTA_POP","SUBLETTE_POP","SWEETWATER_POP")) -plot(irf(MOD,opt_irf,conf_bands = c(0.05, 0.1,0.15)),area=TRUE,vars_impulse = c("LN_POP"),vars_response = c("TETON_POP","BEAR_LAKE_POP","CARIBOU_POP","BONNEVILLE_POP")) - -DATA2 <- RES %>% mutate(US_POP=US_POP-WY_POP,WY_POP=WY_POP-LN_POP-UINTA_POP-SUBLETTE_POP-SWEETWATER_POP-TETON_POP) -TS_DATA2 <- DATA2 %>% select(YEAR,LN_POP,US_POP,WY_POP,UINTA_POP,SUBLETTE_POP,SWEETWATER_POP,TETON_POP,BEAR_LAKE_POP,CARIBOU_POP,BONNEVILLE_POP) %>% - dplyr::filter(!is.na(LN_POP)) %>% - arrange(YEAR) %>% select(-YEAR) %>% ts %>% log -MOD2 <- bvar(TS_DATA2,lags=5, n_draw=15000) -plot(irf(MOD2,opt_irf,conf_bands = c(0.05, 0.1,0.15)),area=TRUE,vars_response = c("LN_POP")) -?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)) diff --git a/old/Bayes_Pop.r b/old/Bayes_Pop.r deleted file mode 100644 index 21e7a70..0000000 --- a/old/Bayes_Pop.r +++ /dev/null @@ -1,35 +0,0 @@ -library(tidyverse) -library(bayesPop) -library(bayesMig) - - -DAT <- read_tsv(us.mig.file) -DAT[,2] %>% t -sum(DAT$`2001`) - -# Toy simulation for US states -dir.create("Output") -sim.dir <- "./Output" -us.mig.file <- file.path(find.package("bayesMig"), "extdata", "USmigrates.txt") -m <- run.mig.mcmc(nr.chains = 2, iter = 100000, thin = 1, my.mig.file = us.mig.file, - output.dir = sim.dir, present.year = 2017, annual = TRUE) -pred <- mig.predict(sim.dir = sim.dir, burnin = 5, end.year = 2050) -mig.trajectories.plot(pred, "Wyoming", pi = 80, ylim = c(-0.03, 0.03)) - -load("./Output/bayesMig.mcmc.meta.rda") -############# -#subnat example -data.dir <- "./extdata" -dir.create("Pop_Output") -sim.dir <- "./Pop_Output" -dir.create("Output") -example(pop.predict.subnat) -read_tsv(file.path(data.dir, "CANlocations.txt")) -pred <- pop.predict.subnat(output.dir = sim.dir, locations = file.path(data.dir, "CANlocations.txt"), - inputs = list(popM = file.path(data.dir, "CANpopM.txt"),popF = file.path(data.dir, "CANpopF.txt")), - verbose = TRUE) -pop.pyramid(pred, "Ontario") -?pop.pyramid -summary(pred) -write.pop.trajectories(pred) -load("Pop_Output/predictions/prediction.rda") \ No newline at end of file diff --git a/old/County_Data.png b/old/County_Data.png deleted file mode 100644 index 15834d2..0000000 Binary files a/old/County_Data.png and /dev/null differ diff --git a/old/Popultaion.R b/old/Popultaion.R deleted file mode 100644 index ab08874..0000000 --- a/old/Popultaion.R +++ /dev/null @@ -1,106 +0,0 @@ -library(tidyverse) -library(fixest) -source("Scripts/Functions.r") -#source("Scripts/Load_Wyoming_Web_Data.r") -DATA_TO_GATHER <- list() -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c("WYPOP","WY_POP",TRUE) - -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c("WYNQGSP","WY_GDP",TRUE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c("MEHOINUSWYA646N","WY_MED_INCOME",TRUE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c("BUSAPPWNSAWY","WY_BUISNESS_APPLICATIONS",FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('ACTLISCOUWY','WY_HOUSES_FOR_SALE',FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('WYRVAC','WY_RENTAL_VACANCY_RATE',FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('WYBPPRIVSA','WY_PRIVATE_HOUSING',FALSE) -#New Private Housing Units Authorized by Building Permits for Wyoming -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('B03002006E056023','LN_FIVE_YEAR_POP',FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('GDPALL56023','LN_GDP',TRUE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('WYLINC3POP','LN_POP',FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('LAUCN560230000000005','LN_EMPLOYMENT',FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('BPPRIV056023','LN_PRIVE_HOUSING',FALSE) - -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('ENU5602320510','LN_NUM_ESTABLISHMENTS',FALSE) - -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('GDPALL56041','UINTA_GDP',TRUE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('WYUINT1POP','UINTA_POP',FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('WYSUBL5POP','SUBLETTE_POP',FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('WYSWEE7POP','SWEETWATER_POP',FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('WYTETO9POP','TETON_POP',FALSE) -##Idaho Counties -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('IDBEAR7POP','BEAR_LAKE_POP',FALSE) -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('IDCARI9POP','CARIBOU_POP',FALSE) - -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('IDBONN0POP','BONNEVILLE_POP',FALSE) -###US Population -DATA_TO_GATHER[[length(DATA_TO_GATHER)+1]] <- c('POPTOTUSA647NWDB','US_POP',FALSE) - - - - -for(x in 1:length(DATA_TO_GATHER)){ - CURRENT <- DATA_TO_GATHER[[x]] - - if(CURRENT[3]){C_DATA <- CPI_ADJUST(FRED_GET(CURRENT[1],CURRENT[2]))}else{C_DATA <- FRED_GET(CURRENT[1],CURRENT[2])} - if(x==1){RES <- C_DATA}else{RES <- RES %>% full_join(C_DATA)} - rm(CURRENT,C_DATA) -} -DATA <- RES %>% mutate(US_POP=US_POP-WY_POP,WY_POP=WY_POP-LN_POP-UINTA_POP-SUBLETTE_POP-SWEETWATER_POP-TETON_POP) -colnames(DATA) -feols(log(LN_POP) ~log(US_POP)+log(UINTA_POP)+log(WY_POP)+log(SUBLETTE_POP)+log(SWEETWATER_POP)+log(TETON_POP)+log(BEAR_LAKE_POP)+log(CARIBOU_POP)+log(BONNEVILLE_POP)+YEAR,data=DATA) -TS_DATA_ORIG <- DATA %>% select(YEAR,LN_POP,US_POP,WY_POP,UINTA_POP,SUBLETTE_POP,SWEETWATER_POP,TETON_POP,BEAR_LAKE_POP,CARIBOU_POP,BONNEVILLE_POP) %>% filter(!is.na(LN_POP)) %>% arrange(YEAR) %>% select(-YEAR) - -TS_DATA <- diff(log(ts(TS_DATA_ORIG,start=c(1970),end=c(2024),frequency=1))) -library("forecast") -library("vars") -VARselect(TS_DATA,lag.max=4,type="const") -VAR1 <- VAR(TS_DATA,p=3,type="const",season=NULL,exog=NULL) -plot(irf(VAR1,response="LN_POP")) -plot(forecast(VAR1,)) -RES <- (predict(VAR1, n.ahead = 20, ci = 0.95)) -names(RES ) -names(RES$fcst) -RES$fcst$LN_POP %>% as_tibble -CURRENT_POP <- max(DATA$LN_POP,na.rm=TRUE) -0.0157*CURRENT_POP*1000 -0.083*CURRENT_POP*1000 --0.0489*CURRENT_POP*1000 - - - - -# View the forecasted values and confidence intervals -print(forecast_results) - -# You can also plot the forecasts -plot(forecast_results) - - -install.packages("sparsegl") -plot(VAR1) - - - -#Check a VAR it looks like lags on changes to Private industry could affect other variables - #Idea check a SVAR placing limits on which shocks are first -feols((LINC_POP)~(WY_POP)+log(LINC_PRIV_IND)+Year,data=DF) -feols(log(1000*LINC_POP)~log(LINC_GDP)+log(LINC_PRIV_IND)+log(LINC_LABOR_FORCE)+log(LINC_PRIV_IND)+Year,DF) -RES -ggplot(data=RES) +geom_point(aes(x=YEAR,y=WY_POP),color="red")+geom_point(aes(x=YEAR,y=30*LN_POP),color="blue")+geom_point(aes(x=YEAR,y=LN_GDP/1700),color="black")+geom_point(aes(x=YEAR,y=LN_LABOR_FORCE/20),color="orange") -itial information and data that will be required from Kemmerer-Diamondville Water & -Wastewater Joint Powers Board includes names of key stakeholders that can be interviewed -regarding future developments, new businesses, and business closures. -version -install.packages("pbkrtest") -install.packages("bayesPop") -update.packages(ask=FALSE ) -library("bayesMig") -help("bayesPop") -library(bayesMig) -?mig.predict -example(mig.predict) -mig.predict(51) -library("bayesPop") -example(bayesMig) -?bayesMig - - -