diff --git a/Migration_Regression.r b/Migration_Regression.r index e34081a..7329f64 100644 --- a/Migration_Regression.r +++ b/Migration_Regression.r @@ -134,32 +134,65 @@ PROB <- MIG_AGE_DIST MIG_SIM <- round(simulate(MOD,future=TRUE, nsim=50)) #Round up for whole numbers NUM_SIMS <- abs(MIG_SIM[[1]]) -INCREASE <- MIG_SIM[[1]]/abs(MIG_SIM[[1]]) #Check if positive or negative migration, as these are handled diffrently +INCREASE <- MIG_SIM[[1]]/abs(MIG_SIM[[1]]) #Check if positive or negative migration, as these are handled differently if(INCREASE==1){MF_SAMPLE <- sample(x=c("Male","Female"),NUM_SIMS,replace=TRUE)} sample(x=1:90,size=NUM_SIMS,prob=PROB,replace=TRUE) C_DEMO_DATA <- DEMOGRAPHIC_DATA %>% filter(County=='Lincoln',Year==max(Year)) NUM_MALE <- pull(C_DEMO_DATA ,"Num_Male") NUM_FEMALE <- pull(C_DEMO_DATA,"Num_Female") ####WORKING ON THE CASE WHEN WE ARE REMOVING INDIVIDUALS. IF THERE ARE NONE THEY SHOULD NOT MOVE. ON THE OTHER HAND IF MOVING IN THE AVERAGE VALUES WORK -MAKE_SET <- function(x){ - C_PROB <- MIG_AGE_DIST[x] - C_LOOP <- C_DEMO_DATA[x+1,] - NUM_MALE <- C_LOOP$Num_Male - NUM_FEMALE <- C_LOOP$Num_Female - C_AGE <- C_LOOP$Age - return(rbind(cbind(rep(C_AGE,NUM_MALE),rep("Male",NUM_MALE),rep(C_PROB,NUM_MALE)), - cbind(rep(C_AGE,NUM_FEMALE),rep("Female",NUM_FEMALE),rep(C_PROB,NUM_FEMALE)))) + +PROB <- MIG_AGE_DIST +LN_DEMO_DATA <- DEMOGRAPHIC_DATA %>% filter(County=='Lincoln',Year==max(Year)) +LN_DEMO_DATA$Age +MAKE_SET <- function(PROB_AGE_DIST,DEMOGRAPHIC_DATA){ + 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:84,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. +OUT_MIGRATION_SIMULATION <- function(NUM_MIGRATED,MIG_AGE_DIST,DEMO_DATA){ + 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,Probablity),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)) %>% arrange(desc(Sex),Age) %>% ungroup + return(MIG_STATUS) } -FULL_SET <- sapply(1:85,MAKE_SET) %>% as_tibble -FULL_SET[1] -sample(1:length(FULL_SET),prob=FULL_SET[,3],size=1) - -sample(x=0,size=NUM_SIMS,prob=c(NUM_MALE,NUM_FEMALE)*rep(PROB,2),replace=TRUE) -sample(x=c('a','a','b'),size=2,prob=c(2,2,0),replace=FALSE) - - - -mean(sample(x=c(1,0),2000000,prob=c(3,1),replace=TRUE)) +OUT_MIGRATION_SIMULATION(100,MIG_AGE_DIST,LN_DEMO_DATA) +#Function to find the number of migrants to a county, by age-sex when coming from outside the county. +IN_MIGRATION_SIMULATION <- function(NUM_MIGRATED,MIG_AGE_DIST,DEMO_DATA){ + EMPTY_SET <- cbind(rep(1:90,2), c(rep("Male",90),rep("Female",90)),rep(0,180)) + MIGRATED_AGE <- sample(1:90,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","Migration") + MIGRATED_DATA$Age <- as.numeric(MIGRATED_DATA$Age) + MIGRATED_DATA$Migration <- as.numeric(MIGRATED_DATA$Migration) + MIGRATED_DATA <- MIGRATED_DATA %>% group_by(Age,Sex) %>% summarize(Migration=sum(Migration)) %>% ungroup %>% arrange(desc(Sex),Age) + return(MIGRATED_DATA) +} +IN_MIGRATION_SIMULATION(100,MIG_AGE_DIST,LN_DEMO_DATA)