77 lines
4.4 KiB
R
77 lines
4.4 KiB
R
#################################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_"))
|
|
}
|
|
|
|
|