Demographic split Kem/Lin and start sim files made
This commit is contained in:
Alex Gebben Work
parent
7e43123840
commit
9b28cf518f
2
.gitignore
vendored
2
.gitignore
vendored
@ -1,6 +1,8 @@
|
||||
# ---> R
|
||||
#
|
||||
*.png
|
||||
*.csv
|
||||
|
||||
Results/
|
||||
#Don't save any major data files on the server, can be regenerated after pulling
|
||||
*.Rds
|
||||
|
||||
@ -31,6 +31,8 @@ if(RERUN_MIGRATION_SIMULATION ){source("Migration_Regression.r")}
|
||||
START_DEM_DATA <- readRDS("Data/Cleaned_Data/Lincoln_Demographic_Data.Rds") %>% group_by(County) %>% filter(Year==2023) %>% ungroup %>% select(-County)
|
||||
MORTALITY_SIMULATION <- readRDS("./Data/Simulated_Data_Sets/MORTALITY_MONTE_CARLO.Rds") #Load the Mortality simulation to speed up simulation
|
||||
MIGRATION_ARIMA_SIMULATION <- readRDS("./Data/Simulated_Data_Sets/Migration_ARIMA.Rds") #Load the Migration simulation to speed up simulation
|
||||
|
||||
#####################!!!!!!!!!!!!!!!!!!!Working on pulling in data from the Data/Cleaned_Data/Intiate_Simulation/ directory which stores a starting point for all groups. Make data much more clean
|
||||
if(KEMMER_SIM){
|
||||
LN_POP_ST <- FIRST_PREDICT_YEAR_POPULATION_DATA$Population #Population of Lincoln County
|
||||
START_DEM_DATA <- readRDS("Data/Cleaned_Data/Kemmerer_Demographic_Data.Rds") %>% select(-County) %>% mutate(County='Lincoln')
|
||||
|
||||
@ -1,87 +1,87 @@
|
||||
County,Year,Age,Num_Male,Num_Female
|
||||
Kemmerer,2024,0,10.464965521092157,18.53827755476956
|
||||
Kemmerer,2024,1,10.73329797035093,26.12211837262983
|
||||
Kemmerer,2024,2,9.838856472821687,22.330197963699696
|
||||
Kemmerer,2024,3,11.717183617633099,26.3327806175704
|
||||
Kemmerer,2024,4,10.464965521092157,24.015495923224204
|
||||
Kemmerer,2024,5,15.460982984335295,16.925040008171884
|
||||
Kemmerer,2024,6,19.09886133359066,18.773993958644443
|
||||
Kemmerer,2024,7,20.78787628145922,22.045220178711276
|
||||
Kemmerer,2024,8,17.409846385722098,19.34290286648215
|
||||
Kemmerer,2024,9,21.17764896173658,20.05403900127929
|
||||
Kemmerer,2024,10,23.313248886019743,19.837665883519023
|
||||
Kemmerer,2024,11,24.63286674749256,19.692865402617425
|
||||
Kemmerer,2024,12,25.0727393679835,18.534461555404636
|
||||
Kemmerer,2024,13,24.19299412700162,23.023276463354193
|
||||
Kemmerer,2024,14,26.53898143628663,23.74727886786219
|
||||
Kemmerer,2024,15,13.763908906585888,13.325834953286826
|
||||
Kemmerer,2024,16,14.400390243306624,12.585510789215336
|
||||
Kemmerer,2024,17,15.116431747117451,11.919219041550994
|
||||
Kemmerer,2024,18,8.11409091515564,8.11283185840708
|
||||
Kemmerer,2024,19,6.633417390492201,5.672882427307205
|
||||
Kemmerer,2024,20,8.976744186046512,27.571428571428573
|
||||
Kemmerer,2024,21,0,6.411960132890365
|
||||
Kemmerer,2024,22,10.007317017094115,16.00986295681063
|
||||
Kemmerer,2024,23,9.285139500396603,13.795732973421927
|
||||
Kemmerer,2024,24,10.523158100449484,13.795732973421927
|
||||
Kemmerer,2024,25,14.229527197897555,14.473076411960134
|
||||
Kemmerer,2024,26,12.94653704071007,15.057847176079733
|
||||
Kemmerer,2024,27,13.179807978380522,13.888305647840532
|
||||
Kemmerer,2024,28,9.214202037982844,13.74211295681063
|
||||
Kemmerer,2024,29,12.94653704071007,15.935003322259135
|
||||
Kemmerer,2024,30,9.841972541328104,16.16915622314293
|
||||
Kemmerer,2024,31,10.64539887123244,16.16915622314293
|
||||
Kemmerer,2024,32,9.339831085137893,17.360567734321886
|
||||
Kemmerer,2024,33,10.24368570628027,17.360567734321886
|
||||
Kemmerer,2024,34,9.942400832566145,21.10500391231288
|
||||
Kemmerer,2024,35,23.090047712195066,13.797127159737228
|
||||
Kemmerer,2024,36,24.414886515353803,15.316076938790872
|
||||
Kemmerer,2024,37,21.386683536705274,16.20213097657216
|
||||
Kemmerer,2024,38,23.2793103983606,16.835026717844507
|
||||
Kemmerer,2024,39,29.33571635565767,16.07555182831769
|
||||
Kemmerer,2024,40,17.783950233132593,12.477327826165036
|
||||
Kemmerer,2024,41,17.654140377416297,12.581305558049745
|
||||
Kemmerer,2024,42,16.615661531685927,13.413127413127413
|
||||
Kemmerer,2024,43,18.30318965599778,15.388704318936878
|
||||
Kemmerer,2024,44,19.73109806887704,15.388704318936878
|
||||
Kemmerer,2024,45,9.96622215641455,21.42182039512059
|
||||
Kemmerer,2024,46,10.86595054553531,17.354386142882504
|
||||
Kemmerer,2024,47,10.796740669449097,16.812061575917422
|
||||
Kemmerer,2024,48,9.96622215641455,16.405318150693617
|
||||
Kemmerer,2024,49,8.097555502086824,16.812061575917422
|
||||
Kemmerer,2024,50,11.910119959416715,17.094436330798903
|
||||
Kemmerer,2024,51,12.541717229991843,18.692047202836182
|
||||
Kemmerer,2024,52,13.443999045099172,20.928702423688375
|
||||
Kemmerer,2024,53,12.000348140927445,20.928702423688375
|
||||
Kemmerer,2024,54,10.37624087373426,17.57371959241009
|
||||
Kemmerer,2024,55,27.330581312705572,17.79318936877076
|
||||
Kemmerer,2024,56,28.04355299912398,19.075581395348838
|
||||
Kemmerer,2024,57,24.71635179583808,19.716777408637874
|
||||
Kemmerer,2024,58,30.1824680583792,21.640365448504983
|
||||
Kemmerer,2024,59,33.034354804052825,21.80066445182724
|
||||
Kemmerer,2024,60,24.58166576527853,13.547851248526417
|
||||
Kemmerer,2024,61,25.752221277910838,15.305969349480229
|
||||
Kemmerer,2024,62,23.212805992871722,17.31788012362568
|
||||
Kemmerer,2024,63,23.212805992871722,16.868065055479555
|
||||
Kemmerer,2024,64,24.42654748269508,17.430333890662205
|
||||
Kemmerer,2024,65,17.826584994462902,31.169037340601193
|
||||
Kemmerer,2024,66,20.324577796234774,32.30936797501343
|
||||
Kemmerer,2024,67,31.745589072282296,31.707002858013322
|
||||
Kemmerer,2024,68,31.745589072282296,32.5413976700663
|
||||
Kemmerer,2024,69,29.161645775701185,31.289805451986826
|
||||
Kemmerer,2024,70,27.118003770017854,15.476896504155697
|
||||
Kemmerer,2024,71,25.59022890973516,15.122463759785719
|
||||
Kemmerer,2024,72,21.579819901493085,13.114011541689177
|
||||
Kemmerer,2024,73,20.43398875628106,12.405146052949224
|
||||
Kemmerer,2024,74,20.052045041210388,12.168857556702571
|
||||
Kemmerer,2024,75,27.418452872826624,9.03148043108338
|
||||
Kemmerer,2024,76,32.273803902389666,9.305161656267725
|
||||
Kemmerer,2024,77,19.421404118252187,5.199943278502552
|
||||
Kemmerer,2024,78,17.422141929608582,5.0174891283796565
|
||||
Kemmerer,2024,79,15.994097509148864,5.108716203441104
|
||||
Kemmerer,2024,80,7.746694691165502,5.8689063665333245
|
||||
Kemmerer,2024,81,5.325852600176282,5.103396840463761
|
||||
Kemmerer,2024,82,3.7523052410332904,5.358566682486948
|
||||
Kemmerer,2024,83,3.510221031934368,4.465472235405791
|
||||
Kemmerer,2024,84,3.389178927384908,4.2103023933826025
|
||||
Kemmerer,2024,85,20.83887043189369,18.274086378737543
|
||||
Kemmerer,2024,0,10,19
|
||||
Kemmerer,2024,1,11,26
|
||||
Kemmerer,2024,2,10,22
|
||||
Kemmerer,2024,3,12,26
|
||||
Kemmerer,2024,4,10,24
|
||||
Kemmerer,2024,5,15,17
|
||||
Kemmerer,2024,6,19,19
|
||||
Kemmerer,2024,7,21,22
|
||||
Kemmerer,2024,8,17,19
|
||||
Kemmerer,2024,9,21,20
|
||||
Kemmerer,2024,10,23,20
|
||||
Kemmerer,2024,11,25,20
|
||||
Kemmerer,2024,12,25,19
|
||||
Kemmerer,2024,13,24,23
|
||||
Kemmerer,2024,14,27,24
|
||||
Kemmerer,2024,15,14,13
|
||||
Kemmerer,2024,16,14,13
|
||||
Kemmerer,2024,17,15,12
|
||||
Kemmerer,2024,18,8,8
|
||||
Kemmerer,2024,19,7,6
|
||||
Kemmerer,2024,20,9,28
|
||||
Kemmerer,2024,21,0,6
|
||||
Kemmerer,2024,22,10,16
|
||||
Kemmerer,2024,23,9,14
|
||||
Kemmerer,2024,24,11,14
|
||||
Kemmerer,2024,25,14,14
|
||||
Kemmerer,2024,26,13,15
|
||||
Kemmerer,2024,27,13,14
|
||||
Kemmerer,2024,28,9,14
|
||||
Kemmerer,2024,29,13,16
|
||||
Kemmerer,2024,30,10,16
|
||||
Kemmerer,2024,31,11,16
|
||||
Kemmerer,2024,32,9,17
|
||||
Kemmerer,2024,33,10,17
|
||||
Kemmerer,2024,34,10,21
|
||||
Kemmerer,2024,35,23,14
|
||||
Kemmerer,2024,36,24,15
|
||||
Kemmerer,2024,37,21,16
|
||||
Kemmerer,2024,38,23,17
|
||||
Kemmerer,2024,39,29,16
|
||||
Kemmerer,2024,40,18,12
|
||||
Kemmerer,2024,41,18,13
|
||||
Kemmerer,2024,42,17,13
|
||||
Kemmerer,2024,43,18,15
|
||||
Kemmerer,2024,44,20,15
|
||||
Kemmerer,2024,45,10,21
|
||||
Kemmerer,2024,46,11,17
|
||||
Kemmerer,2024,47,11,17
|
||||
Kemmerer,2024,48,10,16
|
||||
Kemmerer,2024,49,8,17
|
||||
Kemmerer,2024,50,12,17
|
||||
Kemmerer,2024,51,13,19
|
||||
Kemmerer,2024,52,13,21
|
||||
Kemmerer,2024,53,12,21
|
||||
Kemmerer,2024,54,10,18
|
||||
Kemmerer,2024,55,27,18
|
||||
Kemmerer,2024,56,28,19
|
||||
Kemmerer,2024,57,25,20
|
||||
Kemmerer,2024,58,30,22
|
||||
Kemmerer,2024,59,33,22
|
||||
Kemmerer,2024,60,25,14
|
||||
Kemmerer,2024,61,26,15
|
||||
Kemmerer,2024,62,23,17
|
||||
Kemmerer,2024,63,23,17
|
||||
Kemmerer,2024,64,24,17
|
||||
Kemmerer,2024,65,18,31
|
||||
Kemmerer,2024,66,20,32
|
||||
Kemmerer,2024,67,32,32
|
||||
Kemmerer,2024,68,32,33
|
||||
Kemmerer,2024,69,29,31
|
||||
Kemmerer,2024,70,27,15
|
||||
Kemmerer,2024,71,26,15
|
||||
Kemmerer,2024,72,22,13
|
||||
Kemmerer,2024,73,20,12
|
||||
Kemmerer,2024,74,20,12
|
||||
Kemmerer,2024,75,27,9
|
||||
Kemmerer,2024,76,32,9
|
||||
Kemmerer,2024,77,19,5
|
||||
Kemmerer,2024,78,17,5
|
||||
Kemmerer,2024,79,16,5
|
||||
Kemmerer,2024,80,8,6
|
||||
Kemmerer,2024,81,5,5
|
||||
Kemmerer,2024,82,4,5
|
||||
Kemmerer,2024,83,4,4
|
||||
Kemmerer,2024,84,3,4
|
||||
Kemmerer,2024,85,21,18
|
||||
|
||||
|
@ -1,2 +1,2 @@
|
||||
Year,County,Population,Births,Deaths,Migration,Min_Birth_Group,PREV_BIRTH,PREV_TWO_BIRTH
|
||||
2024,Kemmerer,2895,NA,NA,NA,125.89845094664372,29,37
|
||||
2024,Kemmerer,2895,NA,NA,NA,126,29,37
|
||||
|
||||
|
@ -4,6 +4,7 @@ ACS_FILE_LOC <- "Data/Cleaned_Data/ACS_Census_Demographic_Data.Rds"
|
||||
ACS_YEAR <- 2023 #Year of the ACS data
|
||||
if(!file.exists(ACS_FILE_LOC)){source("Scripts/Load_ACS_Census_Data.r")}else{AGE_DATA <- readRDS(ACS_FILE_LOC)}
|
||||
LIN_DEMOGRAPHICS <- readRDS("Data/Cleaned_Data/Lincoln_Demographic_Data.Rds") %>% filter(Year==ACS_YEAR)
|
||||
|
||||
for(i in 1:nrow(AGE_DATA)){
|
||||
if(i==1 & exists("RES")){rm(RES)}
|
||||
C_DEMO <- AGE_DATA[i,]
|
||||
@ -20,7 +21,7 @@ for(i in 1:nrow(AGE_DATA)){
|
||||
}
|
||||
RES <- RES %>% group_by(IN_KEM) %>% mutate(Per_Pop=Population/sum(Population)) %>% mutate(Region=ifelse(IN_KEM,'Kemmerere & Diamondville','Rest of the County')) %>% select(-Population) %>% ungroup
|
||||
CURRENT_KEM_POP <- readRDS("Data/Cleaned_Data/Wyoming_City_Population.Rds") %>% filter(City %in% c('Kemmerer','Diamondville'),Year==max(Year)) %>% mutate(Population=as.numeric(Population)) %>% pull(Population) %>% sum()
|
||||
KEM_DEMOGRAPHICS <- RES %>% filter(IN_KEM==1) %>% select(Age,Sex,Per_Pop) %>% mutate(Year=ACS_YEAR+1,County='Kemmerer',Population=Per_Pop*CURRENT_KEM_POP ) %>% select(-Per_Pop) %>% pivot_wider(values_from=Population,names_from=c(Sex),names_prefix="Num_") %>% select(County,Year,Age,Num_Male,Num_Female)
|
||||
KEM_DEMOGRAPHICS <- RES %>% filter(IN_KEM==1) %>% select(Age,Sex,Per_Pop) %>% mutate(Year=ACS_YEAR+1,County='Kemmerer',Population=round(Per_Pop*CURRENT_KEM_POP) ) %>% select(-Per_Pop) %>% pivot_wider(values_from=Population,names_from=c(Sex),names_prefix="Num_") %>% select(County,Year,Age,Num_Male,Num_Female)
|
||||
saveRDS(KEM_DEMOGRAPHICS,"Data/Cleaned_Data/Intiate_Simulation/Kemmerer_Demographic_Data.Rds")
|
||||
write_csv(KEM_DEMOGRAPHICS,"Data/Cleaned_Data/Intiate_Simulation/Kemmerer_Demographic_Data.csv")
|
||||
|
||||
@ -30,6 +31,40 @@ KEM_DEMOGRAPHICS <- RES %>% filter(IN_KEM==1) %>% select(Age,Sex,Per_Pop) %>% mu
|
||||
INTIATE_KEMMER <- KEM_DEMOGRAPHICS %>% mutate(Male_Window=Age>=18 & Age<=30,Female_Window=Age>=18 & Age<=28) %>% group_by(County,Year) %>% summarize(Female_Birth_Group=sum(Num_Female*Female_Window),Male_Birth_Group=sum(Num_Male*Male_Window),Min_Birth_Group=ifelse(Female_Birth_Group<Male_Birth_Group,Female_Birth_Group,Male_Birth_Group),PREV_BIRTH=ST_BIRTH_KEM,PREV_TWO_BIRTH=ST_BIRTH_TWO_PREV_KEM,Population=CURRENT_KEM_POP) %>% mutate(Births=NA,Deaths=NA,Migration=NA) %>% select(Year,County,Population,Births,Deaths,Migration,Min_Birth_Group,PREV_BIRTH,PREV_TWO_BIRTH) %>% ungroup
|
||||
saveRDS(INTIATE_KEMMER ,"Data/Cleaned_Data/Intiate_Simulation/Kemmerer_Summary_Start_Data.Rds")
|
||||
write_csv(INTIATE_KEMMER ,"Data/Cleaned_Data/Intiate_Simulation/Kemmerer_Summary_Start_Data.csv")
|
||||
###Create data sets that contain all people not in Loncoln but not Kemmerer or Diamondville, for a seperate comparison run
|
||||
LIN_DEMOGRAPHICS_RECENT <- readRDS("Data/Cleaned_Data/Lincoln_Demographic_Data.Rds") %>% filter(Year==max(Year)) #Grab the most recent year of data for all of the county
|
||||
LIN_OTHER_DEMOGRAPHICS <- LIN_DEMOGRAPHICS_RECENT %>% left_join(KEM_DEMOGRAPHICS %>% select(-County,ADJ_MALE=Num_Male,ADJ_FEMALE=Num_Female)) %>% mutate(Num_Male=Num_Male-ADJ_MALE,Num_Female=Num_Female-ADJ_FEMALE) %>% select(-ADJ_MALE,-ADJ_FEMALE) %>% ungroup#Deduct the populaiton estimates of Kemmerer to create a "Other Lincoln" data set
|
||||
#Data sets needed to start a simulation for all but Kemmerer/Diamondville but in the county
|
||||
ST_BIRTH_OTHER <- round(sum((LIN_OTHER_DEMOGRAPHICS%>% filter(Age==0))[4:5]))
|
||||
ST_BIRTH_TWO_PREV_OTHER <- round(sum((LIN_OTHER_DEMOGRAPHICS%>% filter(Age==1))[4:5]))
|
||||
INTIATE_OTHER <- LIN_OTHER_DEMOGRAPHICS %>% mutate(Male_Window=Age>=18 & Age<=30,Female_Window=Age>=18 & Age<=28) %>% group_by(County,Year) %>% summarize(Female_Birth_Group=sum(Num_Female*Female_Window),Male_Birth_Group=sum(Num_Male*Male_Window),Min_Birth_Group=ifelse(Female_Birth_Group<Male_Birth_Group,Female_Birth_Group,Male_Birth_Group),PREV_BIRTH=ST_BIRTH_OTHER,PREV_TWO_BIRTH=ST_BIRTH_TWO_PREV_OTHER,Population=CURRENT_KEM_POP) %>% mutate(Births=NA,Deaths=NA,Migration=NA) %>% select(Year,County,Population,Births,Deaths,Migration,Min_Birth_Group,PREV_BIRTH,PREV_TWO_BIRTH) %>% ungroup
|
||||
#Save detailed demographics for start of analysis
|
||||
saveRDS(LIN_OTHER_DEMOGRAPHICS,"Data/Cleaned_Data/Intiate_Simulation/Lincoln_Rest_of_County_Demographic_Data.Rds")
|
||||
write_csv(LIN_OTHER_DEMOGRAPHICS,"Data/Cleaned_Data/Intiate_Simulation/Lincoln_Rest_of_County_Demographic_Data.csv")
|
||||
|
||||
#Save summary information for start of analysis
|
||||
|
||||
saveRDS(INTIATE_OTHER ,"Data/Cleaned_Data/Intiate_Simulation/Lincoln_Rest_of_County_Summary_Start_Data.Rds")
|
||||
write_csv(INTIATE_OTHER ,"Data/Cleaned_Data/Intiate_Simulation/Lincoln_Rest_of_County_Summary_Start_Data.csv")
|
||||
|
||||
|
||||
#Data sets needed to start a simulation for all the county (includes Kemmerer)
|
||||
ST_BIRTH_ALL <- round(sum((LIN_DEMOGRAPHICS_RECENT %>% filter(Age==0))[4:5]))
|
||||
ST_BIRTH_TWO_PREV_ALL <- round(sum((LIN_DEMOGRAPHICS_RECENT %>% filter(Age==1))[4:5]))
|
||||
INTIATE_ALL <- LIN_DEMOGRAPHICS_RECENT %>% mutate(Male_Window=Age>=18 & Age<=30,Female_Window=Age>=18 & Age<=28) %>% group_by(County,Year) %>% summarize(Female_Birth_Group=sum(Num_Female*Female_Window),Male_Birth_Group=sum(Num_Male*Male_Window),Min_Birth_Group=ifelse(Female_Birth_Group<Male_Birth_Group,Female_Birth_Group,Male_Birth_Group),PREV_BIRTH=ST_BIRTH_ALL,PREV_TWO_BIRTH=ST_BIRTH_TWO_PREV_ALL,Population=CURRENT_KEM_POP) %>% mutate(Births=NA,Deaths=NA,Migration=NA) %>% select(Year,County,Population,Births,Deaths,Migration,Min_Birth_Group,PREV_BIRTH,PREV_TWO_BIRTH) %>% ungroup
|
||||
#Save detailed demographics for start of analysis
|
||||
saveRDS(LIN_DEMOGRAPHICS_RECENT,"Data/Cleaned_Data/Intiate_Simulation/Lincoln_All_County_Demographic_Data.Rds")
|
||||
write_csv(LIN_DEMOGRAPHICS_RECENT,"Data/Cleaned_Data/Intiate_Simulation/Lincoln_All_County_Demographic_Data.csv")
|
||||
|
||||
#Save summary information for start of analysis
|
||||
|
||||
saveRDS(INTIATE_ALL ,"Data/Cleaned_Data/Intiate_Simulation/Lincoln_All_County_Summary_Start_Data.Rds")
|
||||
write_csv(INTIATE_ALL ,"Data/Cleaned_Data/Intiate_Simulation/Lincoln_All_County_Summary_Start_Data.csv")
|
||||
|
||||
|
||||
#sum(LIN_OTHER_DEMOGRAPHICS[,4:5] )+sum(KEM_DEMOGRAPHICS[,4:5])
|
||||
|
||||
|
||||
###Make a population Pyramid Graph
|
||||
PY_KEM_DATA <- KEM_DEMOGRAPHICS %>% mutate(County='Kemmerer') %>% pivot_longer(cols=c(Num_Male,Num_Female),names_to="Sex",values_to="Population") %>% mutate(Sex=ifelse(Sex=='Num_Male','Male','Female'))
|
||||
PY_LN_DATA <- readRDS("Data/Cleaned_Data/Wyoming_County_Demographic_Data.Rds") %>% filter(County=='Lincoln',Year==max(Year))%>% pivot_longer(cols=c(Num_Male,Num_Female),names_to="Sex",values_to="Population") %>% mutate(Sex=ifelse(Sex=='Num_Male','Male','Female'))
|
||||
@ -44,13 +79,23 @@ PY_LN_DATA$Percent <- PY_LN_DATA$Population/LN_ONLY_POP
|
||||
KEM_ONLY_POP <- sum(PY_KEM_DATA$Population)
|
||||
PY_KEM_DATA$Percent <- PY_KEM_DATA$Population/KEM_ONLY_POP
|
||||
|
||||
PY_DATA <- rbind(PY_LN_DATA,PY_KEM_DATA) %>% mutate(Population=ifelse(County=='Kemmerer',Population,-Population),'Percent Population'=ifelse(County=='Kemmerer',Percent,-Percent),Age_Numeric=Age,Age=as.character(Age))
|
||||
PY_DATA <- rbind(PY_LN_DATA,PY_KEM_DATA) %>% mutate(Population=ifelse(County=='Kemmerer',Population,-Population),'Percent of Population'=ifelse(County=='Kemmerer',Percent,-Percent),Age_Numeric=Age,Age=as.character(Age))
|
||||
PY_DATA[PY_DATA$Age=='85',"Age"] <- ">84"
|
||||
ORD <- PY_DATA[,c("Age_Numeric","Age")] %>% unique %>% arrange(Age_Numeric) %>% pull(Age)
|
||||
PY_DATA$Age <- factor(PY_DATA$Age,levels=ORD)
|
||||
|
||||
RANGE <- c(pretty(range(PY_DATA$`Percent Population`),n=8))
|
||||
RANGE <- c(pretty(range(PY_DATA$`Percent of Population`),n=4))
|
||||
LAB <- percent(abs(RANGE),accuracy=0.1 )
|
||||
POP_PYRAMID <- ggplot(PY_DATA,aes(y=factor(Age),x=`Percent Population`,fill=County))+geom_col() +scale_x_continuous(breaks = RANGE,labels = LAB)+facet_grid(~Sex)
|
||||
POP_PYRAMID
|
||||
PY_DATA
|
||||
PY_DATA <- PY_DATA %>% mutate(Region=ifelse(County=='Lincoln',"Rest of Lincoln County","Kemmerer & Diamondville"))
|
||||
PY_DATA$Sex <- ifelse(PY_DATA$Sex=='Male','Men','Women')
|
||||
ORDER <- PY_DATA$Sex %>% unique
|
||||
PY_DATA$Sex <- factor(PY_DATA$Sex,levels=ORDER)
|
||||
POP_PYRAMID <- ggplot(PY_DATA,aes(y=factor(Age),x=`Percent of Population`,fill=Region))+geom_col() +scale_x_continuous(breaks = RANGE,labels = LAB)+facet_grid(~Sex)+ylab("Age")+ theme_bw()+ theme(axis.text = element_text(size = 10),legend.position = "top",legend.text=element_text(size=14),legend.title = element_blank(),axis.title=element_text(size=18),strip.text = element_text(size = 14))
|
||||
|
||||
|
||||
dir.create(FIG_DIR ,showWarnings=FALSE)
|
||||
png(paste0(FIG_DIR,"/Population_Pyramid.png"), res = 600, width = 8.27, height = 11, units = "in")
|
||||
POP_PYRAMID
|
||||
dev.off()
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user