Lunch checkin added migreation sim functions

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]
+PROB <- MIG_AGE_DIST
-	C_LOOP <- C_DEMO_DATA[x+1,]
+LN_DEMO_DATA <- DEMOGRAPHIC_DATA %>% filter(County=='Lincoln',Year==max(Year)) 
-	NUM_MALE <- C_LOOP$Num_Male
+LN_DEMO_DATA$Age
-	NUM_FEMALE <- C_LOOP$Num_Female
+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
-	return(rbind(cbind(rep(C_AGE,NUM_MALE),rep("Male",NUM_MALE),rep(C_PROB,NUM_MALE)),
+		MEN <- 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))))
+		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)
+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.
-sample(x=0,size=NUM_SIMS,prob=c(NUM_MALE,NUM_FEMALE)*rep(PROB,2),replace=TRUE)
+IN_MIGRATION_SIMULATION <- function(NUM_MIGRATED,MIG_AGE_DIST,DEMO_DATA){
-sample(x=c('a','a','b'),size=2,prob=c(2,2,0),replace=FALSE)
+	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))
-mean(sample(x=c(1,0),2000000,prob=c(3,1),replace=TRUE))
+	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)