Remove old data
This commit is contained in:
Alex Gebben Work
parent
6ce9fd6bf8
commit
d66fa06536
@ -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))
|
||||
@ -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")
|
||||
Binary file not shown.
|
Before Width: | Height: | Size: 43 KiB |
106
old/Popultaion.R
106
old/Popultaion.R
@ -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
|
||||
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user