#################################Simulate data #A function used only inside the OUT_MIGRATION_SIMULATION function (see below). This creates a data set which has one entry for every individual in the county, with a assigned probability of moving out of the county. This allows the migration simulation to extract individuals based on true population distribution. When migration is net positive this does not matter, as anyone age-sex group can move in. #PROB_AGE_DIST <- Migration_Age_Distribution #DEMOGRAPHIC_DATA <- START_DETAILED_DATA MAKE_SET <- function(PROB_AGE_DIST,DEMOGRAPHIC_DATA){ # if(nrow(DEMOGRAPHIC_DATA)==86){DEMOGRAPHIC_DATA<- DEMOGRAPHIC_DATA[-1,]} #Drop age zero if it was included SINGLE_AGE_RET <- function(x,PROB,DEMO_DATA){ C_PROB<- PROB[x] C_LOOP <- DEMO_DATA[x+1,] NUM_MALE <- pull(C_LOOP,Num_Male) NUM_FEMALE <- pull(C_LOOP,Num_Female) C_AGE <- C_LOOP$Age MEN <- cbind(rep(C_AGE,NUM_MALE),rep("Male",NUM_MALE),rep(C_PROB,NUM_MALE)) WOMEN <- cbind(rep(C_AGE,NUM_FEMALE),rep("Female",NUM_FEMALE),rep(C_PROB,NUM_FEMALE)) RES <- rbind(MEN,WOMEN) # colnames(RES) <- c("Age","Sex","Probability") return(RES) } FINAL_OUT <-do.call(rbind,sapply(1:85,function(x){SINGLE_AGE_RET(x,PROB_AGE_DIST,DEMOGRAPHIC_DATA) })) %>% as_tibble colnames(FINAL_OUT ) <- c("Age","Sex","Probability") FINAL_OUT$Age <- as.numeric(FINAL_OUT$Age) return(FINAL_OUT) } #A function to find the number of migrants leaving the county (net out), accounting for the fact that fewer or more people in any one age-sex bracket will decrease the odds of being the person to leave even if they are 18-19 and likely to leave. #DEMO_DATA <- START_DETAILED_DATA #NUM_MIGRATED <- 29 #MIG_AGE_DIST <- Migration_Age_Distribution OUT_MIGRATION_SIMULATION <- function(NUM_MIGRATED,MIG_AGE_DIST,DEMO_DATA){ MIG_AGE_DIST CURRENT_POP <- MAKE_SET(MIG_AGE_DIST,DEMO_DATA) NUM_POP <- nrow(CURRENT_POP) #Rank all individuals to easily combine with the ordinal data set ORD <- sample(1:NUM_POP,prob=pull(CURRENT_POP,Probability),size=NUM_POP,replace=FALSE) #Set the migration out status of all individuals to zero (staying in the county) CURRENT_POP$Migrated <- 0 #The people drawn first are assumed to migrate up to the point where all migration is filled. CURRENT_POP[ORD[1:NUM_MIGRATED],"Migrated"] <- -1 MIG_STATUS <- CURRENT_POP %>% group_by(Age,Sex) %>% summarize(Migrated=sum(Migrated), .groups = 'drop')%>% arrange(desc(Sex),Age) return(MIG_STATUS) } #Function to find the number of migrants to a county, by age-sex when coming from outside the county. #NUM_MIGRATED <- TOTAL_MIGRATION; #NUM_MIGRATED <- 0 IN_MIGRATION_SIMULATION <- function(NUM_MIGRATED,MIG_AGE_DIST){ NUM_MIGRATED <- abs(NUM_MIGRATED) NUM_AGES <- 85 EMPTY_SET <- cbind(rep(1:NUM_AGES,2), c(rep("Male",NUM_AGES),rep("Female",NUM_AGES)),rep(0,2*NUM_AGES)) colnames(EMPTY_SET) <- c("Age","Sex","Migrated") if(NUM_MIGRATED==0){return(EMPTY_SET)} MIGRATED_AGE <- sample(1:NUM_AGES,prob=MIG_AGE_DIST,size=NUM_MIGRATED,replace=TRUE) MIGRATED_SEX <- sample(c("Male","Female"),size=NUM_MIGRATED,replace=TRUE) MIGRATED_GROUP <- cbind(MIGRATED_AGE,MIGRATED_SEX,rep(1,NUM_MIGRATED)) MIGRATED_DATA <- rbind(EMPTY_SET,MIGRATED_GROUP) %>% as_tibble colnames(MIGRATED_DATA) <- c("Age","Sex","Migrated") MIGRATED_DATA$Age <- as.numeric(MIGRATED_DATA$Age) MIGRATED_DATA$Migrated <- as.numeric(MIGRATED_DATA$Migrated) MIGRATED_DATA <- MIGRATED_DATA %>% group_by(Age,Sex) %>% summarize(Migrated=sum(Migrated),.groups = 'drop') %>% arrange(desc(Sex),Age) return(MIGRATED_DATA) } # MIG_AGE_DIST <- Migration_Age_Distribution;DEMO_DATA <- START_DETAILED_DATA;NET_MIGRATION <- TOTAL_MIGRATION MIGRATION_SIMULATION <- function(MIG_AGE_DIST,DEMO_DATA,NET_MIGRATION){ #MIG_AGE_DIST: A distribution of probabilities of any one age of person to migrate to or out of a county used to grab a reasonable rate of in/out migration by age from a total migration number #DEMO_DATA: A data set which contains the number of people in each sex-age category (ex Male 30, or Female 82) #TOTAL_MIGRATION_ARIMA_SIM: A single simulated path of a ARIMA simulation of net migration in the county. #YEARS_AHEAD_OF_SIMULATION: The number of years forward from the start of the ARIMA to extract as total migration. if(NET_MIGRATION<0){ RES <- OUT_MIGRATION_SIMULATION(abs(NET_MIGRATION),MIG_AGE_DIST,DEMO_DATA) } else{ RES <- IN_MIGRATION_SIMULATION(NET_MIGRATION,MIG_AGE_DIST)} return(RES %>% pivot_wider(values_from=Migrated,names_from=Sex,names_prefix="Num_")) }