From 7de4132973386ba82b46756d71212bd57e8549e0 Mon Sep 17 00:00:00 2001 From: Alex Date: Fri, 24 Oct 2025 18:16:55 -0600 Subject: [PATCH] Corrected data shift, used Correlation of age and migration --- Birth_Rate_Regression.r | 16 +- .../Wyoming_County_Population.Rds | Bin 11960 -> 12584 bytes .../Wyoming_County_Population.csv | 2434 ++++++++--------- Migration_Regression.r | 105 +- Scripts/Data_Load.r | 3 +- 5 files changed, 1257 insertions(+), 1301 deletions(-) diff --git a/Birth_Rate_Regression.r b/Birth_Rate_Regression.r index 676aa16..73c4fce 100644 --- a/Birth_Rate_Regression.r +++ b/Birth_Rate_Regression.r @@ -15,15 +15,19 @@ ###Predict the number of Births - MOD_BIRTHS <- feols(log(Births)~log(PREV_BIRTH)+log(PREV_TWO_BIRTH)+log(Min_Birth_Group)+Year*County,cluster=~Year+County, data=REG_DATA ) - #Optional: Review the ACF and PACF for validity. Model made on October 22nd appears to have uncorrelated lags of residuals. - #RES_DATA <- REG_DATA #Data to create visuals with, without changing the main file. Can be used for ggplot, or residual tests - #RES_DATA$RESID <- resid(MOD_BIRTHS) - #acf(RES_DATA %>% pull(RESID)) - #pacf(RES_DATA %>% pull(RESID)) +MOD_BIRTHS <- feols(log(Births)~log(PREV_BIRTH)+log(PREV_TWO_BIRTH)+log(Min_Birth_Group)+Year*County,cluster=~Year+County, data=REG_DATA ) #Lower AIC + #AIC(MOD_BIRTHS) +#MOD_BIRTHS <- feols(log(Births)~log(PREV_BIRTH)+log(Min_Birth_Group)+Year*County,cluster=~Year+County, data=REG_DATA ) + #AIC(MOD_BIRTHS) + #Optional: Review the ACF and PACF for validity. Model made on October 24nd appears to have uncorrelated lags of residuals accept year three. + RES_DATA <- REG_DATA #Data to create visuals with, without changing the main file. Can be used for ggplot, or residual tests + RES_DATA$RESID <- resid(MOD_BIRTHS) + acf(RES_DATA %>% pull(RESID)) + pacf(RES_DATA %>% pull(RESID)) saveRDS(MOD_BIRTHS,BIRTH_RATE_REG_RESULTS) saveRDS(FIRST_PREDICT_YEAR_POPULATION_DATA,START_DEMOGRAPHIC_DATA) #Save the cleaned data set for later use when starting the simulation. #Cleanup data no longer needed, and save some RAM rm(POP_DATA,DEMOGRAPHIC_DATA,REG_DATA) gc() + diff --git a/Data/Cleaned_Data/Wyoming_County_Population.Rds b/Data/Cleaned_Data/Wyoming_County_Population.Rds index 4d9d8cfd3a3cd07f81859987b9ee8f27403317e6..06915736ef27a0007dc7de45824e1ba574d53c59 100644 GIT binary patch literal 12584 zcmYMa2T&7T)IP4Ff+CiiM&tAkq>M6%ZjJ3R0t@0-}I)l8}ffASgjvUKI#c zP?|KUNhl&s354DfdI%6gLLfc)^L_ts=C?C@XZGy5&vWnIJ+tRLcL51fJO1~Opk?k0 zP9LhL;~fj06=wXTOlD(r>B;xe+km=5+9@8M??S&DA!uYvoyDz|uY#geUqva?*jycWu#Z zzVt%^t~4qAv?Y2vXu7<`Z~e)-!8$4ibTg{sbw@N^Vxt-L3a|$xyBLkxiQj?Pr?msW z7a=du`EM^_7h#X?Zt0eu=Hlj+=6?cqT$WPV@AztH`b>b*i_*S;QTfd*U(Hw*`i zdjIzx@ZWpP!+#Mm3J&eKS!rI-rOuwTjr3W{a3^MBAz&3)eOFh-(Y=e zZ##GMW~{93(i^*_u#B~kr!SvaM>tnEL z8oxkC8CgN+Y+}>U_cR}0Jv|QrZ}AWjL)pa2ZI(C7IV6~0L{O>leVvs(nfV9NN!){n_Hc41STI96`h>Y z(F*?uuZCnyGn2cs=CpIR2Sa|z8*QEKR_`Krk;Q1yRB?d!%a9PC{~0tEhh(eXbukLR z^74PDC{|tioSai2ra*7~?+oLC74%LbartBWP(hlt)#2nfg6LS4FlV0{&y#A0wlZX84JW_I9d)hei-wjWV~Lgl;@S@+vBE6ULLi$! zR%})s&JtpN1oJ_+M8_XAz6I%Z6V0lQ^1@=q*j^v99xQydr z8?0~T_G<|b6dCL*pgqjJODT%4EY6}0wJ~+%CC#;0xLs~`;h?s^_&v3*0-`X+=02t; z+#%?=fAXau*-JsB(plTS^j&Q=gL#p6S3)-a4o=vbIFGoNoe*dcH!n^8a?MxHs^xT4 zrNT;QcnZ^|v#_Y|_``o(ID1JNQ@14|Pj`k*G_$8}-!R^am1+7m&fAw1tn4s-q|Mfe zxc&UUf(GP%`)+LB05Nok6?A`+x#_0gBlxAiyCZr+2Gj!7Ia*w@++S1YzL9nNttrch zDpvoQ&j;AJjsS?y5jOJp z8*xO8=!p?oHefA`SY9UI;-I7r*JDT~94K^wdu8=Y`uz-+yxdW>E-};qxY66GZ zdq2sw*3RqAC|@#_x`s9s5(4h3;%XqeH;*p-(3TNn%2eD zRw_acRHC$_FwU)YI@Zx09}|Ou4)J?D&!L5$EjKPmtnD~n_!eHcXH`xbw6Av;edkP` z;tz~2XJ==V%N4$2GuxEcai2qJ@of%Ww?2q?q|R??CETFyS-&Vf9jn;fq5HtY?0YCy z_eM~n&MScPE7Qt2VZTO!FlAcwl@# zzCMQ`C5jh`m5g|XO?$+GYk83ACfJNlUgH?K5r6nV`6-q9T$ru!5S-y~J!Zu4IPjwZ z{O3e~ljsnfnvlL$(4#$NQUw<+ZaH;G`udI|E)?)NrDcqiZBy_+yh&n^K~RFTgp0o-AO; z0V+>~ks%)=%bg(Ag7U~;vk-pP0_??(nXsDUB!BWu4Zs;UqE-R*n0PWePG**h5zA6# zd_au$RwtrikLbcbHL|3Sn0v;ma-gnO+Tf94iW+!U3v!p<|799aevcGd8S%b?nOuDBOr7UJ=x zEr$<&5bx0_mGO(em|;JVrfk~kA;BK}A%^rYTNfeGN*5<@aGcg7@lPi)mO$uEGe<+_ zpM=f{U3Zsq70t8kQ02r*USs1KujCpr*ZKxX?30I#7Amf5>d?wH z`4Ze3>b}|3o<2;Eq3IYgjP3VtQ_T9yX;i|2FjqkWpmJT2P_?dzBtGS6N+YRzrIGt0 z|JZD33D&Jo1a>^+AvuHxDK+%&|{uF?Me8iJ4r!ya<%$Ty2 zHZHR%IgqRl#3e-|sLm##RPr72V8paJVrAaEmo3RDd+~=~TJ3p0P~h0RQc8HWS~xLH zp7;ow7y}moh8jqst_M=&AD-`qs^mpMn!J)s+jKuKukrPSzEwSw`(hKdYJrJMoOnNV z}m?k@(M^6n--j*2dh0O`uvve37Q;vS|^6I_#SW)d|7b)&3RWI zEOf!n1kR%rxG}`4Jsg$H6k|ohfHh#E8bVbt=(0#tV)^;n89q1f^_ek|WC?PJ0h^8q z5L=K0uV($?kKGwND*bEb?SZ_Sbl@AYJPY}1{cjX~_;r>>)2)al%hvPLc0Xk1oA#|Y zYL70skiZdzR|<2;w$R0}R|MHr-(HH^>8Yw|r62vXwYD~ZmeNk4Ysae+lhWE3EkA@i z+hpfEX{(YZeKxc=<>AmbGi7XNZllYAusq6Gr2UU|qoX2yXjNg2$a|!haCLy3*~vAj z0GSC55|BL2!B{gtMgCIR#XeTp$fNbzX^0krJz~D9->AE@pS((Xz{+wcaffAHn1t=Q zOeE5th$p2%HT1lrIC^8cA35U904{R$-Bu20DmE)b%+?knR!(VQ^X_wa^eW-X5v`G;3`+g#Q}SC)M~g}D1=^;=>UGyVKE(|j_GUS`ckXfDbo6jioiX6Xhv8)QGhDTii8V`_P7H&8!c3EiN2)Q9Q0sN_f=BLT7dblZ@R1qQv;IGn9{ zKVj;zDt_wcnzc9Um#?8S$7Qk2m^Hi7CsAezu0nh%AUBJq_KR!Yt^ZwjaurQ^k1?{Y zB8M*xk<>T8`2&%#t> z`|p2!I~-OEY1mQ`ZAm)pM3}#SZKyxlm!T@b@#9!NclDzF%zVO_P`mWplH@1e9W2A` z)B8C<3hgb}GO==!{YTCpw#OI~jO~og%vXgW_|$yY2UKIAHEfJvy!Q6D-Ppy1;8ji4 z^-R?#eSgrhy?j}mE1zCOk^5!iC)VlY4lsNY{LKkJ4hw(XoNu|e4pK6lc{Xf4Jvq=2 zbZzZ^8`M=A&~UVo;?kQ_Gmry%Q1|-)ka~3aMSb5=GjCsp+)m)7^~_z&n-B0ZOKH1S zPBl|@FPaza{YZBV5|uAzxP6$cSE_$xun}w!nlQB5F=LVHu;->YLORY}Cz~#{&Ykg0 ztx|U(oWqH~Cme9X?T``UzVCPpa@&Xbu^$(Hma>+dSlhgx_z@BcN9*3lpXaFcFu?b_ z>TBaeD&jf!mbx76d%FQC0DR)pZr>Yr&U-St12=2W&+%A4syv>zGa^N^M z^wIC)PeHlIMb{R&@rIe)*A7J&!GD+9zO2Yt8Ym^6hCh~P_#7M` zJot^Jy(i}QIMU|m=dHvpJr#^PrrRmv+p$mwU6vK`LoPP2#Xi;FFV@V;&iqX+ zy)cD=-aK2F8t9*&VLoUW7vQOThuZQ6JwS@zm9!nlIJOjYb5gQ=biM+)<}H}3)$HYE}&`vvV|-q4y_E7~ct z%plAx++b$p$v?tgBLr`4VX&BSws2}FdwA~tvNGi1{hs>E$AL?i=9_$$6u#z;e6kbV z?Z*5O8Sea(Z}^1xBD3nzRfqLJ$d?;{?r4eoch$k)}A{R(CaB=cHwh<%oZkUUfD{pW3~q3 zji>rk0~5(1gJIgjB^#6YE0MKPsV48CH6X`mgX+8(xWQ)r$;c{#_4j<=-LK^oE@Hf#fvuCa-%#?vZET+imhuj3$bNdm+X7ZP7Pbd5RBP_|w z4Ed1n09vB#Ue3G%^EDdLtJY0PR9_&MY`I>6zE4XD68sU)Eg|gpFAEN0E?-tC5Kd+T zEQ;8t$8&^;3)Q`nnXVFN!F>FdZ6;X4JGNJkhS^WIM9>OPee#A<_?=E}N3JuX$7`!W zaUkuzH3+!)t6HY+h*vIcT?hgxl?ko*xUHO(fqtmJ)%Dq+M9fyl)#bDK8CP3%3nL?Q zwig#v9|Ipbh?JN?A1aGvo@4sp6GvdO)m!+WmY~is_3+Sh@np@WT4Hg=t!kA55QN)I zKMRz+ z+}OCk;lO;~yXQmI78m%&H!Ixa2qymPfPg5lhi0PCcf{OzT@4S)@^walcc#}lOXg_W z8{f>hVWZF|T7v!Sfw$pp3WJ5*??F!RnDNpeOz6A{esAxmPfI>Z>xJIUpvs-F=36YH z3?%+H;ReV!Hpo*J+HRC;5*zeVmbYd!|D`SB-^Tucqm-2rzivyEp>(~^rLB+7^S)O+ zKEH$5NIx_4H0sc$aBhlog92|~P`L_5R4!rHKZIvRiIk*phx)?do}nK0qV4$MgU7n;_`rSCY_Y#nM1HYmQx?yQxb|tkr5pt1P6?&SujHyZW~Rj4(jD8AAx{z-%3WlUAMeI;ZQS%jMgY-9QWJs=w6?NjUc7e3}>ljfl~xl z&)zgT05sC#|C+oDoY3FRmPwOFn55ekG50s?zJ^GE_kwrgm28kMT2sg<2&!hzqyjpm zTf?rtA8v{r2R8<;SXQMY!c%fSS-`exZ?tvq^6pL};lEA7e5868w3n<6FYe?(N4SZjA=dhZd!`=x6;NPAu z7eWLnEGXafNHz^L;AS9C31r|9Estu>SaB*?pZlvL9?!!gaxsnSiaJ^W+|Zz z$dP0rmt>5dJv;gtVb^V#N_x3#bL37rD_MRCqRRE<%6@7+Gkk}<`!>&=>fBLlFS|J$ z8f`mh+0c~=dWW#lHLd?BSZ|b{fjn_4nd1-kt6e>XQD zw7#MHq9_Q=3mVG{PTW`El{$5eIsd^q31K6f;&G4HSEu@yrkAQ2S-J{}zSA!-hRjhl z3>)B5-HDn;FODtTO$LYFp*UC-Zrl)%ZWEo7JSa)?4e@K<+{AC*Ccg}qCa>E4HA0-K zwn4}c4Q;YmTQ%4Dc|kV<>jlpqD<);uCvN$Qo^;Yh7x%<4k^K?>z77nQeFqK^C5I;9 z9h#U+a`NAv~UAmwfZ{dULp=Yy>ZK?E5 z90QH(3cs>m6Un|1c7&Z-rGq!N2*KLB1`aw|&AB~h9<0-e`X#)cU4S2n$P2QVF-C{< z#-mt4mlSB=NzvEfS;=j!kd|ePN`(kYIFE-`Xx5e!#k@Je_hp)L?wQC7aPMA*1M*jF zUF02_Ixa47$|Ko8>(r!B>4@wz%mBwH(+0A-l@N{`^jBvn{%UP6Tv9oc4`j^EHf|#( z&F^67&i4GG)J>kab$#MECGQt%3HIG|VMCOkOLIi(yjKrRs8y=HJ4p!Gu}M|wuj^FP z6icwZ988N|hT!#x=-XMVPp;>OfhvFBufP6=V%hT&FTw1fTyGLSL$6ruLnH1X0?QN& zJh%=^Dlf%{H__V)#w^b>a|J;+)6ET_z&}QgC}K|x3pT@!9L=YtSc)d!XBa`#gf0kt?Y*b z34`ozkd`eznU zl-;Y4>1Aw~3L#r8cq2#ZzrD0?T5KGCG3f`|F+Kv|+7vm#tIM6d83}DU?a0)R;?w>4 zDUrGV5N^Z2t{z~@%Y)8DPR04PDV^7?#rOk-yH3d!Va99q0hy2j5sEL4 zgJ~9PVU{3$%n+Dcdm!#nFJr*?Tt1xTZ|Cb?uj+1P%z%`k)N$qA?+ReiSsw$~jVJKE z{L6ssP%GpT{DJXjV3r*%2(-hy6iHi&d_*H6rs3L*@h}6temOkrP#HJpWJ(RdWzp7E1+p$S}N$nlJq0)0_8Bp>s}er2BQhAldE1Vo;ExAtT_#P z7YUsMzfM4yG6kTdOcHHq&?JLZxnfm*g8zXvNOZFDOLs4y)6<+3PYZDk4feogX&x?AWD zD&usvR~tdkP;A{;4Q^DCdFJ5_itA|~$7hgtOc841m{xR()Qqw2EG37oo6T_<$_q`P z2Ll~v2J?hHAH%yY-lT{osNS$9cv`Wb8bWzueR|wq7bIOOV2uc?x+uJ>vmarB8<_bp z{Ke%V?rkfqF>)5+xdyUr;y9+A1YO|T`a%w2&hxQbIns|9>fjFmrB%ru6AdDW^_c+q-G=DEQ&~qmWX%D3lEbpjlsPoo1e)HWUX>;`foo z1NMUmxf&7lPj6pi>e>e? zaO`obrh_PTSKBw1D_h2|Aj^mI!d4R_`1bT6`isvl3VGG*jL3DROqXm4Zy0{JICH8Z z7~SsOMOD-J98O^m^uz5smV?9|-Hgb%U>8XpaFQKAwbvf+^=&)zjGo&X0GFyl_NFErG_zccTm1nYx3X~-K|WJ6EJel+CaB)NP?Dj74r z@!>vnh+lfYiTTYV4YuW)&kxmdBU^6%1ECC;Khch?2w{C-4{YQW1u#}B&v*K%V^h7U z_0^y{)y!aG4>!_=$;ED$ha}-_rzY1CilAyP#A=)63$XsV$Vzlixy#m0v{yndRf8aF zW9h?Q=}m~~DR&PnXJz}bwJ)SXas(Y3x;S@X(S~Prk8o=V#k%wMO~cvnKgnt?TbgVf5{l(M{Qw zJ{tFER**nIvcu&JM=#b0%0uKjMm{j3a5@RO3ri~Tc$16&u|#Fp&ME1LmAJ(|kuagU z3#M0FuF$m96+&4C5BH6zp1~V{M$VC%n!=5_4pe~yFcZnFD$k8%MiY(M?C2$onIsw} z$ncjiK;e|7Q4{LFK-egh27a5dVz_v*e6eP@aB+oO0r%?g?!vfe5((CbG}5UuP>RZN zHvT2nHZF#(jvcP*Y0I9!H)cl4#;CgsJc{OhGUqBM5|BxP?)pzbf=Q8iJpy1dTwcpG ziJy?3!pCwrLTQTRb_KXak%IDIgg)X1G)$%`bHh#4Vw+um1f%aK>)ide#LA`47}#U@GP@D z)g(tlt@Nach`01T=E?%$*eekEJOj*>*w(5ZLEr7Np^m_}&+Q8Xy3BkB({_;q%FP@x zWPFYrqnIiA2)CdD8k5sU7=ttAc1(d#TTKs5uj)5lPy?I?Z}LQz#+meS$P>st&f5yX zxaMr=2O!nEi8sgNAEY@ofy&qpW)*=`YA5f4(sWfzov6ahth?3N+=7ujQSFM?vEbg; zu)U00PU9XbhUKRYcj^l}_K+LRv1GJ0tsK4#vXEIAQaH|3b7{tFc7pesSs%ol09wu= zZO&bd1%J#6QS3V(yTA3LIC?Ewer>KStSY8ZJ9A#RG6*DE<3VYn9JVyE_{c{!P-`=G zquF%7=NYHK{%`qc_vyLRJoW^s45J?Ck%TTzPn3tJ$h&4oxX^3uswXI zV^ z-qknTaw`ZE*+RWb&ogu@B%?N^HZBN*kWBrI!} zz4UsEni+opDzqLhW6_rSy&jRT_U<2L@1jHB>{TY*_NN2hm{^5tU*FVS7dbWSEc1&w8a0@plWdNC`PNx7AUg!ICObTHV0hyBn#8g&Zfw;0 zha?~O)f8hu}J7-3#^+ohXkmqx34o8-;Il9vVI72M9(TT!LQ#=xvQCbaN z*ei1=K($>>uYzvGH4!7Zkx{$f7@#3(h3|lAnA4M&OerM9G3N(okPf&iRPFDbID-++ z9<*X7D)VBT?vN;(FIAb+iHVH_v2w)Y<&Q0+==(e8qPR1g4D*eIR$P7EhyoKrsj*qHE9mk2=4Vx#P^`+&1784W~d_NA81VW2F=d3HVTG} z;x|4_#2U)4eFZeZj{FGQyQUg*e3fjm@gW_A=3Jk$cnI_ruSeYCHJi$Ip2rbh0$M21 zi(l6I-=CP$wvB1%aPy_TH2buAU=|+^IP>_jTt`1(>)nO2FTpHVe${F`)N78$#H=fr z3+e@wyIF$k{RAIKsK`Dvbc%mOJZgB1wx#Y}3Q^v=`+&S3PI#qu6%IdvCFso?{B=5S z5OSBUBRVYfJ1CAr^s>!*^%w+V$8PM&yhzs-Tag?Q-3hYd?Wl=`*?6Ehww#hzS*~PF zD@dNu4xzd<5|{{JyGFW|-Q^CJhrOtyFH>MUXHG5=0(hE6$|j}6J&WJw57RZ73ZS;W zlWcq7iWcjuX{6kyyx4}ZP)6^=6$u@L50D2s$JFHp>kC5{9TIuk{5s+c{Ts4OG959O z;SE0sI*GjqRYp4%Y%3d5CJ_ws5M<7q zW%^bd#z8)M+*q;QunoOjV?hSP<5sVZe%cnW^f}!oGbia5z`6<2kaTS>@*_5eCuqw2 z3q)$t@7;O>8iHr~38grayRrUJKuzz=-WUM(OVEA#x6K8UB`n^gM1?I8h_BS&JaWwO zsg@i6`@}@?8cqO=ewQ_OYg#)vz^wqcVW+C?N1YK;|tZXaU^Vi zBW0HsSEQkP&vN^R}=!KwxUt9VqVzwSbZj!r29@d8kM$ zeg|g4k`)K~G8z$xcyWq{H7z-#Xd|5$*rUjGRO7$na8AIawj{B-8bCd>%D=biy7kB_ zZy%~s^4EkTeRhJ#CTvpz;4;4TjPI2zqW!ZcgXvlpkx z;L(NcWRjOho+CoPFJBtudu?XG=Jp@(YOWp5!=uR!EatlItZyX#vxj%M37n?EAzJ@5 zkF8+!(AynI$9gD;El-YY-ipkEQxW}Jm?SH6p(CHGEA}9Ra|$}jo=GUnR76MMXXzH5 zx&!2ICorp{%-DVt>txRw+yd(ITjoqvP!_U+obuA>Mrh@u^AH}0`*5#VxOW+ivkANM>WYIbr<3=Si-Rn>j#BO&cDKZ^q^Vp2W5k35_?HGvb7h< z6_Pi}DnFvTNUC*U)o|U5w-)&C2}*W48l?H@Y<63LTp$SIi{eWxv-?^5*lVQoPZtwgzyywf?TG^dP}JC|hX7e)|h)1t}z_^f&sa zxX9eYtTnEX4u)Q5Bl{ZOlGCTUHjju%>I=TYVQ0`lP5uafaTGI2-etz@hh4As|0i^6 z-~5OPnE54@BpF$`@@`W$fz{R^)`h_iok84zYD~42Xt+VuA|WlD7@YG@@tDRxbCmcjBr zw*lFb+FHqm(Vpod7*Xu!uYd0p{if~6z&zAiu#tUe5lkYzSGeOcVHe%6 zG0TJY03NKio3yZhos#TSK$azft;(ZKlY<10#h&ha))cr+MEXEiZx<{{2e2$kCg~9y z7l@ucB2D4X;ZxjQ{IF@W_*ZU$gSaa~Ca8~ld&f=8NwYlG-{j&SEA?23#z$9>%0R{I z6sLl)bhE3X4P(q4^clnJed9=R#4gbC+<90Ws|9@r$8q3omkaBFFd=sSGy|yw5vxkK zhCpmW?WW}Vu?K4a{P%1y?>3_#kGj1VM#3{UAn>MD?5yQuc0ce8HkzYDRbWL{)4Rxy zh|d*d?EqLTD{EG|M((EEdE|ky5Bww#=#I4W2q$K|z>CwX(doZ=%Y@|?O)(~e7nC}T4dh8?_sZ3T?Y+__%sWX zD=SgEduq9aIGZ=PPf-R}K|E~fYnD?9pYQt46`G03La3LRi6-M!{5`}u?f0IME`HB% ocpfs_y;qK@|--MQoc1DJ0l82|tP literal 11960 zcmYj$c{mha^!HaPm91U&cA-ehZYC*`GL@oilO$;|*_YWWMM=gMDPtEBBawAxk{C;7 z>|-BmgE7WzW}kWc{oePF_x^XEd+s^s-gBPwd_L#szTNWQ|1NntdTW^5Py>%*^{BSz z36w#l)3I0RrR0Y->%%I;?%CA+#9dDNFK$dte(AJ*YWrsYyW3)bQ^{!JmIUYg3t(JX?S>`&T?(AyNKcXTI#xCLPvOZhr&Zq4u6iU^IRG*6oY z`6sp@xGfOhHP7ARy$bjvEs(&q&=$-A{s~1ycPu4gy6zO;R!!`-3Ew_lXT`7Big*-D zX`HSD@NIR)W*hOJr^#Akv(5O7X|jgcY!kkx1>(F0J-~mWj2M4GS)Z;u#HTAEnqE*= zr!!R$&=+9OwMVK5Xe)#qciP{ul78(b8O$)9Dm&Alb?WHbEhEs)D=pR~j} z5`}$`|Nl_!|4PfQ%{kxGuF=$aZy}Ypp5261WW7~ryK%Yg##wE0*3cic_wqk!c3;R`;OQGAc790g#J@Uju)-UdAR62J2>%L_0wOe~je(MK!mDnsS(i9DwliogFwg zarK5*ita8G=F-8WCVhN!0K!UQJoZl8 zCe6JVG&!xrJFGJMW1z+O#n5!yv}fEnNkOEs+Oe5kF@=^r%~ZtIA+~j_P!-ov=G@$+bcn zc7V&Nj_FV9z@xTBnL(`sjCj{@rduY=Ddb{ zFFr7RZh737Taz1DziiXGU_;oG7HgM5xxRc=UsUV zXoUF|O$g>}d9$S20(kGR7!0>^+n4gh0Bg!ze6sG+#BG)-(O0zjxjIC+4@wu&t zlUw}{Ts(n%;qJ=V_jJ#abw1b^2K0x?Hs&}s=E%18I$jUb;c{O1oR^NSv9;W6A9E() zapjnAoHLQX+#ilanMYO5eDsf_jVpapRPtO_HosyrQ9Z2vn-228HkoV ziOk|!fSxAy`w%NK=W+cUxp#D0co^o!sKnfA@c#3CGC-5E`l%%#P!?4X)_{iZq5^!@t)gK;lMj&575*45yZ?Z5=pJApql@f$jsT@_*W4d7WfYT@bgjgv9=Zi;V9b7V)Y-D>?@HhrO;99Gk(`GKc7 zJb?c;9eYQYrA}u5_%DrQ{LIM23rOiFV`A?EZ(*W691v#~Zq<=YLFU=^SjY?dJa8jc z4)&a5*fKR}{d+MSrGX9FzpElfyxgxeu6ZiL0ESi~Yx&nNhj$~5u3+obE4?-X?4%}nW5)6W8MtNZ zL9(jwTr%}X0=4POKEQhXO{hA--Hz|3_p>kVQBZ;G&-XLP`&!MI+Q@y_RnxU^49w(Z z0KIZX@-=G0bWM1<;H8Ie%8}@{fyFzo)hE4xYAPN3`Ci{KqiOMk`h$d;Ug~ ze6d8!I~I`}EfmC-w>Ijs@4EoF;?3eS_1R*i0`hY7d{IMy<8nZDXtYjfod!{)6{gIo zJDVf2S^p#$otBSNJO(BqzORXsb8J^>qrqBu@}BqOI1pI z%ETyThMk$Xg#STSU$q#18sNJx60Y_yFMIg?*$}7&Z+xG-XzTRt+6-KV7#khucN~AB zd(oD+kD^0lo@SkoIZ98rXdQdp8gO=g!L}J?>wX;^DZKd@1|2cxrQ4O{Iaf^Cy7tF` z4l8Hc%lcU3BjB+S>ey6W#2EW4g`e&m5NM{KB!7&|n!a@&B>xFZxm()~ zf}5ViDd#FgS1JdnOUBT(3e21BGEdGTx$=~dyTbwB63uImb%?COM`kZ6K@MqS3;b?# z?O^P5n^x;(C33Mcc=_bSNBDML?tPdDauO#AXps@TTIuu1DPa>nAq115^IIOB$T*u) z3%!%d)Qyg#G%GQqZn##tJr|AXx1vYqtC4K<0OR7vg(rIF00rM!j>BJ)Cc? zja0|(l?2c?E=DSouaPu3JwucljsyDpAI6aR^X%?NNv1J9LCcyOjEd2sd_9d5(Maux zr10;`e@SSoiB|MA=7$-Ldhvd|L(uT; zSJ#v5%@WT-Poi0)e}=DN%!5b9hLkQTlZEP6V44%uC7Q!Lh>v^<4?JUo*wetMYvz&r zP*XpXhMoi1M}_NB+9hRkH_hR{x1>obtHmkw2BE$ z>X61=J(|VT7>%D=JCGtTsd(IKnusrSMbA_escy<8noisoKoBkcl;(+kir7DGCigg8 zhR(q0LjOqhj!S-)?T;bIwIioVchFqMPwp`B`FHKGjG5M6cm-Y|#z7mZ;AI3<5Q_ z!+by{FWxpHe;%2YqY#1s0d23V(gAT;?zf};WxU{d0s$nK;`iA!XNiLpUVUnCD}cW- z;+>uaFZU--yiqh7##vmd0b(@{%Yr%22^a-Sitb#4nF-_5lA~!1%#<3=4oa4U9b!Qh zg#n79vXw#)@+aJ1r4&sw()WlT`;kE{Ikm+^{*Rg?%AnZ$xubuC6mk7~%EVb|)|#=Y z@RiPfZu3t>E%#JmT{R=9r&{=&s5!-HNH<5hf!Ov}Kv!k1on#QZy%9_2Q8c{?QYrLVU*Vto$ zvwBG@?k`Sh@3U6B^@_OT%LLqTZx#pnLaMsGVU#(cQI%F-SE?#{4b`03VD>!QTqU|r z4)4|KG#I%zY^QJwKZ~MbIsOe3ZOQu&X8gSSr$;x%!Yq3Gr#{gqh1jpw6?N~3RSPDq zZk&!QD+-^!IX|(hjLOH)4DYItRw&1fSFs;AjolXRc1FrIjVgK|Igh%{^VJ!9IpP!i zTptSp3(P-4pFxdx0UE2rGVc#*6VzZF{S?1oK z&HeOB0v|41(<@VeBUC~Lv{r&b`#{vYdLO!Bx$(Jobg1*N;hR_v*`u{>gq&Hx=&r;o z;i)0Zo>IN1Rvpk=IccX5E9(YzE8`C4H(soOl}Em5SQu-%ymUZ3J{ttt7xZ8p@(j`x zTN*wrEXW@oG9%7-kKDwKh5A2DkRvU zIQj^B9CW6UUQyFGf*I>m94oKDtsC@<{57Q|zMAXIA8wCIlx@r3A%1B4OCC494E74* z)?V4jY^~!J;i&^8u;!|!qs;i*`uabfNxLIP{)pif&*(|-=rV#SW$kr5|GDw*=q5GM z(v(pR&pSsGfyPpPtmphnGE0+qMVOBI{`EtpA_EVw`e&_Li=FI&#@`}Ow7OJj;X4z8 zGjOxf4_1D6lWz$_{?0&XS3@0tjwch2i#&1bF;znPmDXk@>h`j*K3 zp=B9ni6AXx+jkS}ki@51matUin(?Ra`;xeG7P?v?U*{|>IeQ2QT9u*Y@LPLg@E>`1 zxdO_G1u?kGvSBwiR6nNe`roDN;=RtJs7bZb60LLz+h;pIyLDi1dtZVh3=h?CJ3y3dQ(uK6Hf7;qIrjcK!YXKvMpP{>x=-K_%W zsR?PoSkd0Is>#gPD7^eT4*Pg{c6GQ+t1Z?ry7wY>P_c}T@7 zYvVgek7uyPXTgJ}3^kPveUW=jFg2hPuwCbg-W@pH7FlP(BfGzpbHXLb?`BL4@lDLU z-YAvEWDI)(cl}mZq4B5j1c1?HmF_dRmMd|*8=5L#&uE<&KC@z_?XSr?w6hZ$s^pqD zH+A~7L?_$d;`jy2A&hY6j+H#`MY%QQB7E%6=Yx=$c)5O*^jsHD4Xkq!x%pI*++ZZg zjH_4{`I=Qm%{j_ar{*O+6+kbNLp9GgNz@%T%`tLcRGJ-+$Nb_KFbvy4YDb+z0esNG z+o@)!O-|;ql?=~TIPPM+2*2_0R;R#XTl6A=gZ(z5)_#Yg?kL^2tlI{#(7N1Wp1yuP zUH9XrerZ+F%$;TR%QD6R+0^4I`9H-rbDG=G=SUUzv|3%`ZidGl%6F{Jopb~ePA2u$ zn0~a#60IpFeg+pVk>LNfY)nG1a*6KE!~lNcN$5ueNN z>hrl~@W=hUz-Ntn5Noj`(Eaqn8QI(ZnGkF#Mqwc)nSvH?Xdl1w0H#i%&}$+!=N8Wa zS!ZqQbOy)cBShCLH>@}Uh1V*hA_NhY9%j^I)ILVzKBel+9f^LuecbQ-=3v{G6&6> zND~>1m@e;4KF-$USo7qmSL;EsxOY;@Rtmj0CP?t+WCb-Gddf?Blpj=-^XPmlIg3L( zpGL9#2of%6C`5%DB&s>^UwtuGYknhyypnBR^z6Woz7m~~dLD$u7=59-u_U31HKDHc z*hB^*zO_wPT)0TRxLh%tt(Al;3q8GwPHNLi zMyM1@p=AMEB*P6h=@IcM3=-*a*Yo>sTbFxOP@WQXV#ApYxE+b#6A*4gze<8n5@%|x zv!!k!l_iT{19iJ)yrZP<<@}v;y*bhMlgaj?3kOQsg(sifO5ZXdow%cgeZUJ6=1Xu} zJgBk63Z20c30U-*ShC8or)I5#iX)4g*9TtQ_yFbx0=r0xemP^sI&@WU{Y=$|629b9 zL>O)&WgD-RAsd|uqdSiAYE>swlAyAU`~(EXVUA z{!LiLu0AV5P(l%9%hZ3Dg6dP&Lxxmp=9RdfRDh&|FMVhcaP%&w>_BBfoJFUGc*Cx5 zAab@2F*gw%wvF1pd*!WbY2-HQ?CzB**JI|d*!MyzW)2g{PTGSgTgc9sfqUY^X~*1S zai>%G85%3}Gb2k!XQ>~fZd)Ml>Yqk*YY=%(LpAn-&cyKvqTFyx=22ZJ<#4<0Rv_Zh8(0WpI@E)ki~;c0n==k@Wjp>VwKw5qWqH?&F8qYc*E+m zUEQlgKurz6Qmka!{5$o4_4PpSdhJf?HQU1m6i4nUuIG}EtX#Q-mxpW8*R!oLm!#y3 zWpb*oSG|#D#IfHlflL-+Tp=d6Je03A!Kc$~@;N>n%m)PJ2{!oxw;H|Dfj%(o~klA`(vtw3Co z6s`H0;GaUY(zX|vaFCbvVd6}xwXa=C!g*GYB2dqHi=d+`ImK140}KQ%zdF23zRdKGj>-0l6^HMi}S~8E#V>@ zeciYD8HasHVxcBJ5asjItwFccXU%a3Ab+`A4kS;KBmGC(fLEIV8vo*fr+J4Y{NN(* zcg_-9<5ZmmciEErebIw4zGzteqvz=n%0uPuki0VY2pK{i~uRqVoAG}KnYT*rIaQy~5Rm;s!Z5uhtGHHe(M;Uja;00LYKk{RxEzp(3r z3ePb@k7R6RnCheUS#%u?9-2G*UjD>{0bA6R#XL_}t-Fp{IhN|^kLnW?gce3tWvwKwf03GkQg|O&#+$aI2&|PX|AhIwMVRYv}iSz&hess!cbPOqb_*R}>-=K~k)A z`k4nyy=3K=N9I^&4YHKNVn0AKMH<|UR(niBLB-VaA)Yng}862>v6Hwj4q

Z;|x7TWS1uE{R8pJ-Yu_2@dpNIHvn5B`=wb#3E+Nv4)BB9DlxV?STagp(P5 zaaodG>1mRmxkx8_G_*RmTemp$@-gc|@zH)g#--Rq&zKJ@U#jCBBoC&5_V8+Qmu$dv zhY^N-rb`doM~lxBNA(W~uY%MU=JmKC+hA6Z!wha5em4Sb-%q<_{fi5|{8DtF!H&8& z=3zU}{VbkU=DvP^DGi6bGQ(WVPVuR%*AQ%)52!4VeMIVaiTEG1?A!2*HcKE|tN6nu zF@jWtGtL#)G(E@g8TChxErN70Q3v5NEI7ET=LSUWJST4i>v;OJl*OTj?fj&qD ze?k>$R=kOUl6K?toAOq8V`Paa58C9E%C5jt6~d(#Bso^78$PVB^Y?0LqBJF*JKb^NX6<;}t843b z=6e$vpt%&SSxMTmsvvrhCOHz=dafVt729t|4~;>3P^;Bw(SZ{P8;!bTvEiYmRM#+- z`Tm^w;7)G?s2h-a%yctSUzb1}Noy;T@G=o(boTyJNw@yAsUTxPMb}v?~b&?W+JQ;{u60 zzS%ZCY}6fkKb{@#W0-S}`Wj{27o}e!Irb1Z+^|aWWHnu22Ra5@E`zo%G<%Qm0f9ib zL?oCaLJ{TgjAPo3iZ$z7>55a*|0vqMV|okJ44@~gV#V0XJuGKw;%YQH_KTyaiFgG~ z?jpm;jqil?CVLUrQLtg`y%wEpSTo;->rDkF=p*YM@aJ=n^_)u2)(6JU{ywbQ+}#f6{uJ^;H)qymfo z9#kMZA?QPre#G>G2kS`uLqwpDAljkvZ~WBv^-W6yF{qD754Atv|EUj-bn5Cx#XkQ@ z1#8VT?H0bcXeoF!zH zg#jtbVK%cLYci>)c|mw=Sr_eR5f@CuwfrLv8TA#x>8>_Ihs7bguFQx(kxS+w6-`Dq zx}8fNdLQG-4*W_~Z~p+i@c|3loU4?{4lAT=WAg*Cu)k1Q3%kyWHcbzISJ9} z_br8X*iVxs{*&hE;xoq-ix5csM?@F?^lRy|PCY8VE7mQV@5;}Ne?2VO*Vh<%Pke=slmvUH&_Kp1a>dMbm_@dOvpobu8(*J446bb$qVkulyedKebu3X$TdV5|6V4WcS4`auq|#C0F07C`XT<*O!)QSk!pK`DN#_n z9vK9SZn!4>Mw)0A#Zml}FoW~NqIsGHqKE-8BRp3AE#;Ax6ZYSK~Kv!V2h~1XnllOP+i$ZuU3~c4%P_>X;}M z^)_GD$3NSqX;}H9-b*)rmTsH3`nFUeZSeKr4J-UY*&dq{xn@V*qi}=&_VGj7@@ZcE z4FzzU7@x(7%SV5S(Jza-iKXld)GQPO^s>7XpkWJKKxTRm69j2SqKcJ_FW~jdON3PU z!6acxNalsL)Eo8MOFfw-0Ik}jVn^M*z`&({-46lP^&ta6*q8F7+%RNQkFEz@2UGss_j?B7T>lF1PZdq zhLYdOm!8I-#@DJegWsIze*vZRiT+izu!H!Q#mZ!Vv^0siRa zFl?O(Ik(K^x#XSEE#P^=082heZjEEE_@Aw-wT@$K9;DQr^=0;07UW+LR#Rw_B^z$Y ze~WYMMUpS0_0>RVp&&&#SV@sh4+ttHH>Ed=!F%*E@N*X6rX;+50UW8M3MKuOmu+k{Uxt-h1mW zEy`SYElxa!H>GF!(`mqxsIDBj)`@OC(&sUUiDDlmm{ zd;X-4VAu7LEIpQYLj3fA?PtQD{g`@rJme~V09VY2o27=#MXQLhTJaJJx4?UrHnC6q zbb|7aWQVCb^DNp=tzHt}ku2rnTvL8k0{eyUVgFeR&x<`5Z>z|1=9+XW+owv(e=v0G zx2{b>xJ?E^QskEj>}?xW{%-0Eoz>T|gV3<({ShvX%{BI*neY8uOX~NncC!QKH@wWH zF4g3Ax*W269d$4sx10>l#sQzBTl3v5SKlt@&WXS(_)-e^h+dg2TQiHIOJBB0MjW!P zUG2VdM>{D1d*v@652tIQ4%{le6R$N}^|nD&kzIaDmZ14Wb#Tb*e53wG>BPS4PmVR% zhu9*{W?pGrS?+gE*5iLSj$d)i(Eh6SV3vs;RJlAKz~5wIcC@JPz2p2zFlY^ zyn~gyJaGqmxTJbYXWr{KaXJilr8b;a&!g7kX`e@U_a{!bw?v|}q%H)ky?KtLDe^~O z0yVX{6ngAW09_ZM)5`cjP=U8GLMO^uY&-T9-UDH4Bm|wmYU1vJY(`&3Y!(BO81fCf zsWVsGTLCk15kCp_wZLvnDdVyD6{|!na$z;hQg7tWUid}|1V{XaS_wwO8EMe3m2XYQ zMDcmG2zsramMCK`+G=Hc>YTP1k&}-J#CcS_v5$yc-DA1Z+>!V4=2C3GZyZ-_wuZZ>bfh9CGHW9oqn)fkC>O_(C$E8;LA)xkyP;%?pm?4!T!1f6y;t?RA*$isG3)fcVQ*0obrJD7Fh{q232i= zod;NoGXX@twEdvF%Y`J^M#-IzaCg#VyySvZV~kCu-&+@y!7z6>vdZQgg3VMMVb2D5 zC#t9xv-%VF=KBJ(TZK6uYB{kuo_WhMGx#i^^0In7_-Tqt zI@IRah5uY%Br1(eUBbKY+;y&7wi`BGGwA-;ceP)4h4UPEat^7W>>qw$=_j&Y@GT!q zs?8zf$94=}vj7@dow+PhX+*{VLr@&+S)c5GgXKdV%%JRd1MlL8ZIY!%mbX~(M18I^ z;=FhWG5JW^4cRX%Bmz5`jpjuRCLcd=Rw88-o(!7x&^D>U=^tt2E3e@qK3eV7i=ZE9Qk2;MHp) zKw0^BX@efl-=dKC^hbrg`Q*y}pz6^J6MP%t`)>Ze5?s7V9P|EdAR32nkuLI^c6tE& z&BeGGyr~nskx~%VHH#IdxWHPUYO0AuwStT`oRj(3$!Nf zGaP7?ndAra{-A0KNsQ39u0yF_dc`hwyw?(WY9F`T36g<)&hFkpm|Ocdk5p+OQJr%K z1)uppUDEAw+!${aaf$sLG9!n^+|W0#H|;LoG{>Z!r_P*73CkZFXwZY3Z0%{FkwAjm z_uQ}Ji}aS8i?M%%7k&&85C<)%I(1*j>?mp>{qdVmt1pY30f4;0s)W$%JgLBXcT$ut z1&n*ku)t58r9HEkg`^$|V;sK#73%B?ZgXLu7kyeL+gkSQqG$Hg_LK}|3HK0Y@P1po zU2GSh0}$thMYsU_<~MbI7j=%yU+@EkG^CSp6^zws(!YXT6yKRM&&VwK#Yt{H>Gloj zV%hcd%O-=Sz6=H*@wNPX(6mlLtIK{_O6J=)uEE*zF4R89whKf(@8cn-Js4j_VIA+&43#_&qWv9C|r`M4?!6%w}v{Mk%j$x^hVZ=waGnw80Fo2H4 z)~KR{rD6}4ef<~;d5|;{H9!1tg_q!&>8&HU5K=+Gv@d7?o_SgCYzQlQ(i^m8j>VfT zgH*j|2d~FQtHgd${s&a4Wek-?OT#25HkgS;0AFQjH#Kkldgd$4*rsxkcVKts628gF zQt)k$Y9ZrrC$5BB5%s%o5S5K)irD^ODu-Al{#Gd0< znS&F^@Izm-{lH=W+HW#Z)X_1r;0rXZPekgA^2e(6$hU1;Zc0lyG(@Q#pv+uv{yeWV zS<-9k+1ZqeKcd!wI4avjp@s0n7cj}liE;N)Su=J^(~Wknd3HEQQG7S;vHV4Vy)FJ! zOAnI#R6_z+0^aGd+)s%|euz0t0^EHO2TcuD?wD&htuA@#y**-pE@y?ar>_R!=2X+M zqcaL=`0?P}F(&rBc^uXB_!A3*OxQpy8mCLNVhZzSr}wCq;^RLvrf2}(J@LI2piA%% zv8@)tDy($@mDL{Q@>xrwQ{cI7R&e_8Bq-b%s;E9b`VSJ{g!U>xy^Wad_gOMhTG#{ zj4?2Bmu_hz(O~zz1@#7<0nL$=%D-D#rARz0zC#D5&2Gg#@>r~9)+IbRSLfvajVU*12UnG7?rz$nfG2YOvs(Fgu*{DUh>(yZ4U}@ zJKq#0ZIQCGeqVbtCvVeefd|bfxId|WK`}Y36YlJbP?rJ!{z^r(?TO8E={TWJCtKqS zN{em@&% filter(Year==C_YEAR,County==C_COUNTY) -sum((DEMOGRAPHIC_DATA %>% filter(Year==C_YEAR,County==C_COUNTY))[,4:5])+34 + DEMO1 <- DEMOGRAPHIC_DATA + DEMO2 <- DEMOGRAPHIC_DATA %>% mutate(Year=Year+1,Age=Age+1) %>% rename(PREV_MALE=Num_Male,PREV_FEMALE=Num_Female) +DEMO_DATA <- inner_join(DEMO1,DEMO2) %>% mutate(Male=Num_Male-PREV_MALE,Female=Num_Female-PREV_FEMALE) %>% select(County,Year,Age,Male,Female) %>% arrange(County,Year,Age) +COR_MAT_DATA_FULL <- pivot_wider(DEMO_DATA,values_from=c(Male,Female),names_from=Age) +COR_MAT_DATA_FULL <- POP_DATA %>% left_join(COR_MAT_DATA_FULL ) +COR_DATA <- COR_MAT_DATA_FULL %>% filter(Year>2010) %>% select(-County,-Year,-Births,-Deaths,-Population) +COR <- cor(COR_DATA,use="pairwise.complete.obs") +COR_RES <- COR["Migration",2:(ncol(COR))] +COR_RES <- cbind(rep(1:90,2),c(rep("Male",ncol(COR)/2),rep("Female",ncol(COR)/2)),as.numeric(COR_RES)) %>% as_tibble +colnames(COR_RES) <- c("Age","Sex","Cor") +COR_RES <- COR_RES %>% mutate(Age=as.integer(Age),Cor=as.numeric(Cor)) +ggplot(COR_RES,aes(x=Age,y=Cor,group=Sex,color=Sex))+geom_smooth(span=0.25)+geom_point() +########################Combine Male and Female Since they look similar +DEMO_DATA <- inner_join(DEMO1,DEMO2) %>% mutate(Male=Num_Male-PREV_MALE,Female=Num_Female-PREV_FEMALE,Change=Male+Female) %>% select(County,Year,Age,Change) %>% arrange(County,Year,Age) +COR_MAT_DATA_FULL <- pivot_wider(DEMO_DATA,values_from=c(Change),names_from=Age) +COR_MAT_DATA_FULL <- POP_DATA %>% left_join(COR_MAT_DATA_FULL ) +COR_DATA <- COR_MAT_DATA_FULL %>% filter(Year>2010) %>% select(-County,-Year,-Births,-Deaths,-Population) +COR <- cor(COR_DATA,use="pairwise.complete.obs") +COR_RES <- COR["Migration",2:(ncol(COR))] +COR_RES <- cbind(1:90,as.numeric(COR_RES)) %>% as_tibble +colnames(COR_RES) <- c("Age","Cor") +ggplot(COR_RES,aes(x=Age,y=Cor))+geom_smooth(span=0.3)+geom_point() +data.frame(COR_RES) %>% as_tibble +MIGRATION_AGE_COR <- predict(loess(Cor~Age,span=0.3,data=as.data.frame(COR_RES))) +plot(MIGRATION_AGE_COR) -sum((DEMOGRAPHIC_DATA %>% filter(Year==C_YEAR-1,County==C_COUNTY,Age==0))[,4:5]) -sum((DEMOGRAPHIC_DATA %>% filter(Year==C_YEAR,County==C_COUNTY,Age==1))[,4:5]) - -sum((DEMOGRAPHIC_DATA %>% filter(Year==C_YEAR,County==C_COUNTY,Age==0))[,4:5]) - - - - - - - - - - -#############################OTHER TESTING -DATA <- POP_DATA %>% left_join(DEMOGRAPHIC_DATA) %>% filter(!is.na(Births)) -DATA$Age_Group <- NA -DATA <- DATA %>% mutate(Age_Group=ifelse(Age<=5,"Infant",Age_Group)) -DATA <- DATA %>% mutate(Age_Group=ifelse(Age>5 & Age<18,"Child",Age_Group)) -DATA <- DATA %>% mutate(Age_Group=ifelse(Age>=18 & Age<25,"Young_Adult",Age_Group)) -DATA <- DATA %>% mutate(Age_Group=ifelse(Age>=25 & Age<35,"Young_Working_Adult",Age_Group)) -DATA <- DATA %>% mutate(Age_Group=ifelse(Age>=35 & Age<60,"Mid_Adult",Age_Group)) -DATA <- DATA %>% mutate(Age_Group=ifelse(Age>=60,"Retired_Adult",Age_Group)) -DATA %>% filter(Age_Group=="Retired_Adult") -DATA <- DATA %>% ungroup %>% group_by(Year,County,Population,Births,Deaths,Migration,Age_Group) %>% summarize(Num_Male=sum(Num_Male,na.omit=TRUE),Num_Female=sum(Num_Female,na.omit=TRUE)) %>% ungroup -TEMP <- DATA %>% select(-County) %>% pivot_wider(values_from=c(Num_Male,Num_Female),names_from=Age_Group) - -corrplot(cor(TEMP,use="pairwise.complete.obs")) - -REG_TEMP <- DATA %>% pivot_wider(values_from=c(Num_Male,Num_Female),names_from=Age_Group) %>% mutate(Population=Population-Births+Deaths) -REG_TEMP %>% arrange(County,Year) %>% filter(County!='Albany',Year>2015) -#############Looks like Births deaths and migration should be shifted back (or population forward) -POP_DATA %>% group_by(County) %>% arrange(Year) %>% mutate(PREV=Population-Births+Deaths-Migration) %>% arrange(County,Year) %>% filter(Year>2018) -(26500)-501+166+266 -35836+541-184+1137-36209 -(11831-13324)-259+83 -DIFF <- 26519-26165 -DIFF-501+166 -(27380-26633)-413+146 -C_YEAR <-1980 -REG_TEMP %>% filter(Year==C_YEAR-1) -TEMP <- DEMOGRAPHIC_DATA %>% filter(County=='Albany', Year==C_YEAR) -sum(TEMP[1,4:5] ) -TEMP[,4:5] <-DEMOGRAPHIC_DATA %>% filter(County=='Albany', Year==C_YEAR) %>% select(Num_Male,Num_Female)-DEMOGRAPHIC_DATA %>% filter(County=='Albany', Year==C_YEAR-1) %>% select(Num_Male,Num_Female) -TEMP - - -REG_TEMP -REG_TEMP$UPWARD <- ifelse(REG_TEMP$Migration>0,1,0) -REG_TEMP[,5:16] <- log(((REG_TEMP[,5:16]))) -REG_TEMP$Migration <- log(abs(REG_TEMP$Migration)) - -summary(feols(Migration~UPWARD*(Num_Male_Infant+Num_Male_Child+Num_Male_Young_Adult+Num_Male_Young_Working_Adult+Num_Male_Retired_Adult+Num_Female_Infant+Num_Female_Child+Num_Female_Young_Adult+Num_Female_Young_Working_Adult+Num_Female_Retired_Adult)+Population+Population+Year|County,data=REG_TEMP)) -summary(feols(Migration~UPWARD*(Num_Male_Infant+Num_Male_Child+Num_Male_Young_Adult+Num_Male_Young_Working_Adult+Num_Male_Retired_Adult+Num_Female_Infant+Num_Female_Child+Num_Female_Young_Adult+Num_Female_Young_Working_Adult+Num_Female_Retired_Adult)+Population+Population+Year|County,data=REG_TEMP)) - -summary(lm(Migration~.,data=REG_TEMP)) - - - ,Young_Adult=Age>=18,"Child",Age_Group)) -%>% mutate(Child=Age<18,Young_Adult=Age>=18 & Age<35,Mid_Adult=Age>=35 & Age<=60,Retired_Adult=Age>60) %>% group_by(Year,County,Population,Births,Deaths,Migration,Child,Young_Adult,Mid_Adult,Retired_Adult) %>% summarize(Num_Male=sum(Num_Male),Num_Female =sum(Num_Female)) -TEST <- POP_DATA %>% left_join(DEMOGRAPHIC_DATA) %>% filter(!is.na(Births)) %>% pivot_wider(names_from=Age,values_from=c(Num_Male,Num_Female)) -TEST -head(colnames(TEST)) -TEST <- TEST -corrplot(cor(TEST,use="pairwise.complete.obs")) - #Merger the two data sets and drop any records that cannot be used in the regression (this makes the "predict" function output the right number of records) - REG_DATA <- POP_DATA %>% left_join(DEMOGRAPHIC_DATA) %>% filter(!is.na(Births)) - - REG_DATA <- REG_DATA %>% group_by(County) %>% mutate(PREV_MIG=lag(Migration),PREV_TWO_MIG=lag(Migration,2),PREV_POP=lag(Population),PREV_BIRTHS=lag(Births)) %>% ungroup - REG_DATA$County <- factor(REG_DATA$County) -feols((Migration)~(PREV_MIG)+(PREV_TWO_MIG)+PREV_BIRTHS+PREV_POP|Year+County,data=REG_DATA) -REG_DATA %>% filter(!is.na(Births)) +#### NEXT STEPS!!!! USE CORRELATION TO DRAW FROM EACH MIGRANT IN A GIVEN YEAR diff --git a/Scripts/Data_Load.r b/Scripts/Data_Load.r index ff3e726..658b7ff 100644 --- a/Scripts/Data_Load.r +++ b/Scripts/Data_Load.r @@ -30,7 +30,8 @@ TBL <- TBL %>% filter(!is.na(Type)) %>% select(County,Type,everything()) GROUP <- colnames(TBL)[-1:-2] Data <- pivot_longer(TBL,all_of(GROUP),names_to="Year",values_to="Pop_Change") Data$County <- ifelse(toupper(Data$County)=="TOTAL","Wyoming",Data$County) -WY_COUNTY_DATA_SET <- pivot_wider(Data,names_from=Type,values_from=Pop_Change) %>% rename("Migration"=`Net Migration`) %>% mutate(Year=as.integer(Year),Births=parse_number(Births),Deaths=parse_number(Deaths),Migration=parse_number(Migration)) +WY_COUNTY_DATA_SET <- pivot_wider(Data,names_from=Type,values_from=Pop_Change) %>% rename("Migration"=`Net Migration`) %>% mutate(Year=as.integer(Year),Births=parse_number(Births),Deaths=parse_number(Deaths),Migration=parse_number(Migration)) %>% mutate(Year=Year-1) #Data apears to be one off from populaiton +WY_COUNTY_DATA_SET[,"County"] <- gsub(" ","_",WY_COUNTY_DATA_SET %>% pull(County)) ########################City and County Population Data 2020 to 2024 PAGE <- read_html('http://eadiv.state.wy.us/pop/Place-24EST.htm')