Fixing code

Mortality_Rate_Analysis.r

@@ -35,12 +35,12 @@ SINGLE_MODS <- readRDS("Data/Intermediate_Inputs/Mortality_Regression_Data/Singl
 MIN_VALUES <-  readRDS("Data/Intermediate_Inputs/Mortality_Regression_Data/Single_Sex_Age_Min_Values_for_Bounding_Predictions.Rds")
 MAX_VALUES <-  readRDS("Data/Intermediate_Inputs/Mortality_Regression_Data/Single_Sex_Age_Max_Values_for_Bounding_Predictions.Rds")
 BASELINE_AGE_ADJUST_MEN <- readRDS("Data/Cleaned_Data/Mortality_Data/RDS/Single_Sex_Age_Population_in_2000.Rds") %>% filter(Sex=='Male') %>% pull(Percent_of_Population)
+BASELINE_AGE_ADJUST_MEN 
 BASELINE_AGE_ADJUST_WOMEN <- readRDS("Data/Cleaned_Data/Mortality_Data/RDS/Single_Sex_Age_Population_in_2000.Rds") %>% filter(Sex=='Female') %>% pull(Percent_of_Population)
 #Adjust to just women popualtion (Not all population percent
 BASELINE_AGE_ADJUST_WOMEN <- BASELINE_AGE_ADJUST_WOMEN/ sum(BASELINE_AGE_ADJUST_WOMEN )
 BASELINE_AGE_ADJUST_MEN <- BASELINE_AGE_ADJUST_MEN/ sum(BASELINE_AGE_ADJUST_MEN )
 
-
 ST_YEAR <- 2025
 END_YEAR <- 2025+40
 GAP <- END_YEAR-ST_YEAR
@@ -49,30 +49,28 @@ NUM_SIMS <- END_YEAR-ST_YEAR+1
 XREG <- cbind(rep(0,NUM_SIMS),rep(0,NUM_SIMS))
 #colnames(XREG) <- c("WUPI","L_WUPI")
 XREG <- ts(XREG,start=ST_YEAR,frequency=1)
-
 SIM_LIN_WOMEN <-simulate(MOD_LIN_WOMEN,xreg=simulate(MOD_US_WOMEN,xreg=XREG))
 SIM_LIN_MEN <- simulate(MOD_LIN_MEN,xreg=simulate(MOD_US_MEN,xreg=XREG))
 C_VAL <-  rbind(cbind(ST_YEAR:END_YEAR,rep("Female",NUM_SIMS),as.vector(SIM_LIN_MEN)), cbind(ST_YEAR:END_YEAR,rep("Male",NUM_SIMS),as.vector(SIM_LIN_WOMEN))) %>% as_tibble
 colnames(C_VAL) <- c("Year","Sex","US_Adj_Death_Rate")
 C_VAL$Year <- as.numeric(pull(C_VAL,Year))
 C_VAL$US_Adj_Death_Rate <- as.numeric(pull(C_VAL,US_Adj_Death_Rate))
-C_VAL
+as.numeric(pull(C_VAL,US_Adj_Death_Rate))
 ###Pedict
-RES <- do.call(rbind,lapply(1:86,function(x){return(predict(SINGLE_MODS[[x]],C_VAL))}))#For each data frame containing each year and sex combination of the forecast, predict the data for each age 0-85. Bind these by row to create a result with ages by row, and year by column
+RES <- do.call(rbind,lapply(1:86,function(x){return(predict(SINGLE_MODS[[x]],newdata=C_VAL))}))#For each data frame containing each year and sex combination of the forecast, predict the data for each age 0-85. Bind these by row to create a result with ages by row, and year by column
-ncol(RES)
+FEMALE <-RES[,1:(ncol(RES)/2)]
-#RES1 <- RES
+FEMALE <- ifelse(FEMALE<MIN_VALUES[1:86],MIN_VALUES[1:86],FEMALE)
-#Rows Year, Column Age
+MALE <- ifelse(MALE<MIN_VALUES[87:(86*2)],MIN_VALUES[87:(86*2)],MALE)
-MIN_MAT <- matrix(rep(MIN_VALUES,ncol(RES)),ncol=ncol(RES))
+FEMALE <- ifelse(FEMALE>MAX_VALUES[1:86],MAX_VALUES[1:86],FEMALE)
-RES <- ifelse(RES<MIN_VALUES,MIN_VALUES,RES)
+MALE <- ifelse(MALE>MAX_VALUES[87:(86*2)],MAX_VALUES[87:(86*2)],MALE)
-RES <- ifelse(RES>MAX_VALUES,MIN_VALUES,RES)
-FEMALE_RES <- t(RES[,1:NUM_SIMS])
-MALE_RES <- t(RES[,(NUM_SIMS+1):(2*NUM_SIMS)])
-PRED_ADJ_RATE_WOMEN <- rowSums(FEMALE_RES*BASELINE_AGE_ADJUST_WOMEN)
-PRED_ADJ_RATE_MEN <- rowSums(MALE_RES*BASELINE_AGE_ADJUST_MEN)
-MALE_RES <- MALE_RES*C_VAL[1:(nrow(C_VAL)/2),]$US_Adj_Death_Rate/PRED_ADJ_RATE_MEN 
-FEMALE_RES <- MALE_RES*C_VAL[(nrow(C_VAL)/2+1):(nrow(C_VAL)),]$US_Adj_Death_Rate/PRED_ADJ_RATE_WOMEN 
-#Testing looks good so far
-FEMALE_RES[,20:30]
-MALE_RES[,20:30]
 
+MALE_PRED <- pull(C_VAL[C_VAL$Sex=='Male',],US_Adj_Death_Rate)
+FEMALE_PRED <- pull(C_VAL[C_VAL$Sex=='Female',],US_Adj_Death_Rate)
+MALE <- MALE*(MALE_PRED/colSums(MALE*BASELINE_AGE_ADJUST_MEN))
+FEMALE <- FEMALE*(FEMALE_PRED/colSums(FEMALE*BASELINE_AGE_ADJUST_WOMEN))
+RES <- list(MALE,FEMALE)
+MALE
+MALE[,1]
+qbinom(MALE
 
+?qbinom

START_HERE_Causes.r

@@ -10,23 +10,15 @@ dir.create(SAVE_DATA_LOC, recursive = TRUE, showWarnings = FALSE)
 
 
 #####################Model all ages and sex
-MOD <- feols(Age_.[0:85]~US_Adj_Death_Rate+Sex*Year,REG_DATA)
+MOD <- feols(Age_.[0:85]~US_Adj_Death_Rate+Sex*Year,REG_DATA, data.save = TRUE)
 ###Simulate each age-sex death rate over time with the models
 #########When project far into the future some death rate values become negative. Make bounds to limit the forecast to a reasonable range. In this case I select half of the historic minimum, or double the historic maximum as upper an lower bounds in the study period.
-BOUNDS <- readRDS("Data/Cleaned_Data/Mortality_Data/RDS/Single_Sex_Age_US_Mortality_Rate_Data_Long.Rds") %>% group_by(Age) %>% summarize(MAX_RATE=2*max(Mortality_Rate),MIN_RATE=min(Mortality_Rate)/2)
+#BOUNDS <- readRDS("Data/Cleaned_Data/Mortality_Data/RDS/Single_Sex_Age_US_Mortality_Rate_Data_Long.Rds") %>% group_by(Age) %>% summarize(MAX_RATE=2*max(Mortality_Rate),MIN_RATE=min(Mortality_Rate)/2)
+BOUNDS <- readRDS("Data/Cleaned_Data/Mortality_Data/RDS/Single_Sex_Age_US_Mortality_Rate_Data_Long.Rds") %>% group_by(Sex,Age) %>% summarize(MAX_RATE=2*max(Mortality_Rate),MIN_RATE=min(Mortality_Rate)/2) %>% arrange(Sex,Age)
+
 MAX_BOUND <- BOUNDS %>% pull(MAX_RATE)
 MIN_BOUND <- BOUNDS %>% pull(MIN_RATE)
 saveRDS(MOD,paste0(SAVE_DATA_LOC,"Single_Sex_Age_Time_Series_Regression.Rds"))
 saveRDS(MAX_BOUND,paste0(SAVE_DATA_LOC,"Single_Sex_Age_Max_Values_for_Bounding_Predictions.Rds"))
 saveRDS(MIN_BOUND,paste0(SAVE_DATA_LOC,"Single_Sex_Age_Min_Values_for_Bounding_Predictions.Rds"))
 
-
-	#Create a proxy data set to simulate with
-C_VAL <- REG_DATA %>% mutate(Year=Year+(2025-1999))  %>% select(Year,Sex,US_Adj_Death_Rate)
-#################NOTE YOU NEED TO ADJUST THE SINGLE AGE DEATH RATE DOWN TO MATCH LINCOLN IN SOME WAY
-###Mostly Working: Pass in a data frame, with year, sex, and US age adjusted mortality rate. The years should go from the simulation start 2025, to the end roughly 2045. WHAT IS MISSING is to pass the arima results of the US age adjusted mortality rates as applied in Lincoln to replace the age adjusted mortality term. Once that is done, a new simulation will give the age specific mortality rates based on the forecasted Lincoln average rates.
-RES <- do.call(rbind,lapply(1:86,function(x){return(predict(MOD[[x]],C_VAL))}))#For each data frame containing each year and sex combination of the forecast, predict the data for each age 0-85. Bind these by row to create a result with ages by row, and year by column
-RES <- ifelse(TEMP<MIN_BOUND,MIN_BOUND,TEMP) #Make sure the values are not too low to be reasonable estimates
-RES <- ifelse(TEMP>MAX_BOUND,MAX_BOUND,TEMP)#Make sure the values are not too high to be reasonable estimates
-RES <- RES/10^5 #Chance of death per person
-