From ff64e72a6515f0851748b6d8754e25127555ed03 Mon Sep 17 00:00:00 2001 From: Ben Varick Date: Mon, 8 Apr 2024 13:16:11 -0500 Subject: [PATCH] added crash summary charts --- figures/crash_summaries/counties_year.pdf | Bin 7490 -> 7588 bytes scripts/crash_summary_charts.R | 44 +++++++++++++++++++--- 2 files changed, 39 insertions(+), 5 deletions(-) diff --git a/figures/crash_summaries/counties_year.pdf b/figures/crash_summaries/counties_year.pdf index ef1418f56a3a6cc51224b7ccc9ba7091a81f7686..a11600e5642ffac21b9f96384a6f72561414c217 100644 GIT binary patch delta 3827 zcmZXUX*AT07sp8=OH+1YhGfY;jF4rNErdvA-?u2nl6A(9B3lUAvZZ8?Y}toqEF*iw z*o|G0ZLDL=zvp@JfAidP?m6G{z28@#bMM96Do}o-NT&#ullj|8aQ6R8%Nd%RFr^gx z%j_xlsX>6g7jO5Ku&q;eUxw@aJclIjR6aWIc^s6RKAeEnvobGxqaWEEYtIi?+t02L zxDogD{5fjBp)N>sVRKVqQ&UsnVv(0HyfyO-wcAM`!QnYJV8hdm?5vF~!tz;%foG{I zl~Lyi#mcMbu?P?)vOKr6T}kxS-#)IT3{g#=0?X@s{YAEC%oK~FJfqN~D?~;3&WOVH zR)0(p0j(OeEA9xlW_#^z`0RU7!jn>^0V#ut@x~KNv8Ki-nF(9doyU2=em-}DQa6+) z!12O#03yind6P=X=RPG-+wAOE^}c8Rq4e~ia3;PLmGcqCcF*o`9Oe&xWA-Kt+q#8T z06lIUD(6k^`MPPSbJ6mMZgtwE>#=VLpVTHKPgW?Nzmr%q7#Fs1Il6T~O5$9s2EVdG zJv3tBvZz%5bEbU7^Q9iX+!~^ns1=H4+jZTswx?dm3HyT;=e<#shp)e5A-Yg$p*J-q za@sX<%VgyWD%Y2eqYfp8{~hUmgKS-F0_X$9rUu-jH<-!wT1I+RJk%V~3hogMMhYJ< zM0cu<($5YyGRa>nFMsojM__p(D!&U;ti4rCCBbpjFK|`f!N(V;5pRZ>j+bX4roAv0 z+*fib)7A>O>Q00yIL3cMwSvD1SA)&t&tokP^;P$Rjpc*$%C5R!=aTHm*S=6!4)By< z=!1%rtg|hzctnITT>k>5e_o~?(K#B=qlU?g=K=E#6%)QG#LA)bH{F?uk)BAJ!sTo< z8`ouQ!gI47W<<$+ygdI|18g+9qPns;PArax8lxlUF0pxH(jKXAWmWs~9Q3iNi!<|9 z@5aJ?n%dn?E}B{08(mz~!d|m6KtQD9TPe1{?j9~0UiA7c-6ht=aZzJ&^l_CTiyued zt&8(YT^!UMAIvNA+wXF)tC3Zr0aS_tdgx6ILIE|PaUS*j-jOTMB1-6LAVP6A`cpLZz zMB^175;`{J8Abw`9|*7T!~l*gp1B!&+D@ZIj(3hiFQjyys2z0tOn9uEH)onR8Ktru z`o{i|9AqBckIcfdA@DSc7aXPM-@aB2ui=!M&Mkol!PE2=cH5z!r}z@Pxh0Qa1sE9G zr?10LTf={Ppix93w`*?^%Odm3cA4#EHjDTDgrtq}CK*0!!deM=7;rERVU*s|S&Dnh z&hhH3dL3f6(z{4Qav{=Cp8Q+`WjAL+5PdFZ?S2mTN$=Z&9pOY*58HjpxRulif<7eJ zC4IJERGap5CBaEHr}f>5N!AAl=AGLeuwmR6!vU!x2w1fh9n7@aus%FU>V_M-&Sjsj zZzTAhmYN=rFd{8Lsca;@NUPx$fuZ$?;};EVy-9a2A&8iyWk=RmpI-EJ(%aFi;j{!9 z8m`HPT$UM2N9N+T`XAnfyVbqAKp`$*DBD`-LM%<$DJDTIsEJ7g=nNL}PY zr1l(G%Tnbv=|_f5EIOgv8+k&UN>WN%!z|?w&i~Qfux`u&1j}0>y@3{1OW_)Io9r5_ zRh+Lr-Cn#wH&)5Eb2PBYo6pLZmh@6PgZIhV58&IUc&lWD9ZA#rcKGI09efh`bN2g5 zsOc=B_7U&9b+~&+>P~o^+zH{*pVw#YQW?kLZ9iRB63-@Hqrx7*4m5y-F7z)7i1Ui* z^{6H99Cgh=fcVp;4W*LPN>E4CBp+Nn7v6oaR>h$e{{Ca+-(9j#yj@|)_4ScM@J<6= zwaQhVLs6aS9E8R}vKUNEU2reXg9tJ1jl;om(?3&Z{0g)`c-Ro^Fe}!;65oQG>lDC^ z`ErIh%zk%LnIC(tCU7Zelry8=CKH6{cR{zeT#bd9UxMoT1(ve?L01@4iZI;iRyU!ym}((WIHaSp63Z zpyFBH6}mP!_AeLu;>%zZhDx*Kn=Qns#~|@5sSNwOKbd!0$^$^&i{|D87GhU~j-N_? z-@txpyrN@G6K+0!-zlil!}NqvY%Y_vo{s4Nx8WNvR)@=$pc)B$cj+9q;#FVI1s@Sl z-3B_bN$K4HgulU$b!Dy-jTQNCi-7aEccKOH_JFqS5=R$u`{NYLo*f#e-zVNz!W<&N zsj#724lU4Ao_IMo7;B#n-c3pn>@YAR68e>e-&KaPX-ehpdt;KOUREz2`^Vl+N@&CV zfb(IJocndAt&)VaHLYsgjLbj!ls*cPOFYEx;;PEc$5i$cx0*+xYCiWg0Ju}kjRN?| zgMPtg^r`Z&F)3B!^wnnTKor5VPtdjQRX0HRsbbfh4wYb z(ihQi{CSrW^TUugoku`?cyD zC8$e?z_`jr%ruNrIz79vjly2+wblTS>sj|=&-BOv_IQdLawRN=Pj*$OJ#*@#EI1-N z{U!GoeVFZfo}miP%A!5kT;RZZA_b-7@1bh2`MG>cXE~?i4EUC9>rFXAJELK0vfUPA zpiFYgz7FM=XCEjNq^ANbnZ82dY{_5pR*eedP@EK?0k57HiaJzO0rTdzDtm@bTK(Br zCv=I-86kpk4V~S0i_-MP-rjz>9m(;XX{0Iv&&ZiHeh1>>)uUTb$v*PPDFNJ`5ic@R zvi)14es2mm_Xk;~&XCG1j=Ykr*z@(O_Wh-WR7U95(=9@IQEIay3#T#|jLjMrp-Xi| z{k`oyYR}F-PQH#wn!p?7A6moG?+8t@Dn22MdWZbLaH1i-87S#pGeyR)ISeTs7SS|O zpLS|5uU&&y=4z&TjJApQA{&MnU)SFXTgF46JOV(7b9tm=<_i+Y?MU%Ei|t=Gk6&Oq&E3DzWV$igj{o#G@mcXP11^Yarpa^ zqm)(Irqu)uyNzK-p?f~Aj29Iut&zzZG{grtTBL%g7n3=d3apuo73%I{Yz|fMNUC(U ze1KIr#o964MBzyDv-RLP#rtnJBkNt;%QKZXX2T2=Jj`s&dVRM#IqGB)jQQg2E*IQ` z`&{IyYK&PBO7Gj*EYeg{M4}Zc`iMJcx{xkviO`Ho#=j*~ErjX{>t(*!wOB;t*F~nv zNYtb~FY7g9qFvHsa=Iju4ZATg%ELy}9}RG-72=tz+&IF&{`jqv@%D{(_MiMWePQdr zs+|k%&5n5ry}~2+A5Eznwl%nxfBg#ew2oyjcxdg;ULcod@jK(ndnaL-t-3A@$Fr95 z49}oCW@bV@7BHe3l|NDAqssL)wsWFjEI=6gzpZ&aE+@Ph)j<(eCkfqQFs#w z<286jr8I%$YRH(R@{x1hykC1+`uHXSR!6<$?oN|0kred^>hrV>^RxGoKb<3RwDM0r z^KZ89!iq`H}k#YUt+@92eSgJ)r8d;5Ve<5Ihk^|CdBA!0~DkF%Vh z)6!#@H7Gv0O0(!h*jb{*v0V}am}OL2z-beng3e@K%vCc&Ni@|WB>znioK50j%xmr> zR1>V2F0XI3a26NpmbBCB6KYS6&27`9eBl1rSLuebT(KoSD96*0>$ynzfF-Gv0=IJF zr@JWRV1?nM9DBCSq4B4FpR&-6pMWjEC1~;Rr3G#5dZ1j*9*}>%L>9jjmDgd} zW9N^oo;lPtf_!3a;lxR9>q0y&+BMtN2NUL|DAF%21BgBLY2tfjSBZXnIedCveU(x} zi3iJ=(_d#TRy3{SZHez9tguCnxaD85=++eJ{xb2C13h$YrRUnz)#D%NruSabOZuc= zq3G5`>CLj=#|O92z~AYrC2MHGA?79{RBAZqsb9f7vbCObVJ4<2^k`O!m!EU@2^rD0 zg{>Nvq$42^hbYD8!R%#GWE5mTwaOza3X6hBnf15k`=3hY|5iAE|CH+qyIn$#l%V>2 zw23u&b+KneB)xw>`2jhB(8p!eH>9?Z_KLEaI~~{}#|3~=8p;+|9D;+GBT8ln`v)?u zGd4zTcVp`tg^2^?E8R`AVE@%A@(x13J2CE{tvjNnSAO!|6FpmauB_oXms;gNcGt4V z$9@cS#)^aR6VN?TY=j--Y42ITa>h2Rg!4x{P*q@-_l6Z2vA$EYpx5s<+HrzLT9Vwk zLx$JwfVp;0%1G@Lq_TZ`bqed9G`j&BffRB!r?<7V;Q11wLeLreOh^8MM`SxYjIZiU zI>v!+-ODs*;2VCV>~~r3I%Kd&P7R_$`s3GxZ^_6FGtnSjtt23Qb{M||elXA8s;HMv zY%U}F?YrMXzmjkcIQqpM5O7l!70^1F&2n>l7d_V22!I$l6vvYT9Q94di zjmtoWtz8Ks{s7j^nT0*@*-I<(51!86x;f`LTdkuS(may~uB@LDJbiMq>kbz_e(|`! zS+M2Dl=#vTU}=+WU2_X0#;gvLfy(jA{8Rj%{0#pJ8JLXH&Hs3^GK&B8V9=BTUL{T? bx&P!9ph|KnL|#n>StS_;At5azZHE5=lQ4fF delta 3733 zcmZXVc{tSV+r}-4lqMn`+gK8nWsoh5ElbH#$(m)duY*a1@g*Y5ShA(Dq>+6adok7w zJu^rcWf?q-UG`zDulG6LBZB4k2xX}ansIl$%R41rt7Z50U?1B)7Wkrd zf_#-T^PonmCpw%VY~wyuCNR27%+=t}n2fzl80{5pV30dz{bb8aMV+5EqSE+ls%wdo zVl(kLgw8Im==9loriK1#xGH7fpAGoZLgI8hWea(AgCdg$Od)8rOrWc+f>5PDbxIf9 zqP9gC-B?%zeQ%o>WcNT0N3Q0j^(OM>3;vAJr2&~ z)8|*&K50##G&y0t?eAx1V}-b)rV%Wisl(#Az5R8A^Q~A#g)#li&174vkPi%<64mvP z_`}uFu|lA!da$^sK5H|oNHgx$nhz@rMw8&V^}PS$XI2-A*db~32R@+tW;lYTc8;@1 zb2T6U#v)-Hu{tp}&l&gRV^frgCexW7;4OtbG!d&oSEmmIF}TX4tN!6{wWRa-Di|mDzrrU`2%OOQ@~lq zKCKeb22%JG@5%NAWy%|TWF{Kf@<=qQl`1#FVmzmdx*{T9I;eV!4tuUm#R;SL0#?yq zs--rv=+5R>%FeIOfYGzmQSd1En&B~$yfW^~gf?i3(>Q2x!RQ$a;DU-%V3yXnV)kYm zAo7u@m~WuQh=FXyprvSf;&U(571M}wdy%}8rR;Gwj(1w={RCRD=Xn&Yr!+CHvwZ#A z0lRFbLjkjVfA5$&Xiub`78|`+6I-Itu8Z4bTX$di%i~TXaDkJjz*@|Ky+e(IMgF%Oj5f!yJsN%A2AOv^ zDuH(#63e59*BBaGses&9e8>-{c(6k1i#I=FR%(B^<_~D+y@6gtUOUj><_${_daj7DKf3sxtjSQcCyExmkVGq8&%MQ%;hW}06A6y0@9F^E2oKf1W0c02F6R=_ zHWTIaP=t2DHn5Jvm@7KG@Ujq$b!^<3<3gVxM#!L4v`U&-C zqZk5Vy>-d)+|jGtS*3Vu!m>&T5Ma!+twMB(hx9QI-5NER*g1*b`hXP{|3?@AW5)h? zC!}*HWcG!&f8j%xUf(Q*kJLRSMFO_O;0Qx`YP)+4mfIJO&#m|WQcTq^+?=CXN>BDO z_SE4Ljm>XT?)5Jk-pTVPeye9yZ8c68K5yc9T#})E?b!LKuJ9hU*h(3w!Tkb5_Ia^G zn-V-DlBnEzh3{Owwc_PIBt}Wq8&%v*=Nv)PV<=pB2!wj?&vW>)9iaSMmO`^E?6jgp2zL^9 zAH>+C6<(5Cb?Y@!sSe|K#Kf%Kuhp~_tj*Q0mYZO|Sp3b-jQg@zUa{)qjc>+1m@bPo zDYe|BUdGI?6rR5QjiXo0>9hz##RK{tuN~%>Bjuo@3fPfvjs zf&AL3C!=&PfvDN4mzjs+gzp0_>=Ql($k(X$RAGStRbSD?AU&46t6f=bu%J)hc0QuJ zFeyzJyRPa<2jgTBLU)!mm@R&sW?@8KdKe37ar^@9i~H@_ymXQEk!2Gvg^j;`X^q6D z&rRVWf@KiwLpdz4WLm4Ux$(uQa+H!3}k-9qw-J>Tv%=0K~67z|834Im#c<`@7 zx&^>%b)n#U<-dP|5^?~`YGUd9v`aed^CW#q{OdARm#YFrRhq^}PWIJ>U0#sQ7T54h zG)Xlt7!~%bp6v;{Ub!r%Rql{{!c9S$;!szYJa_s?P?l2Q^tVy5d4_?^>sD?%cQ0ju zWaf+|Wv~5U{wV<_cUtbwH9`_&RJ4?UZJ0S21ywM4HO$@QTq{`4+hQeCI8G9LpQ!36 zBPsqG>neo+m4xPi;IE(=`JLHYDSxN*1q>GX5^vbS2YDV^_6Tq1Cd$a{2b;cZu_M>E z(`M zjFyEuvCK8EZRHUAox00N$nBwOovz`-7Nj?!CJC1OCK=k!%0I% zVLxdHy-BQyD!d&oc0E=-0ylp(z3T8Ta>`e`%ZO&6Rh`m9VywYu1ge1%?f2++XK+`P zRsZ>PiTsARAXe>|v8kTkqwFPa3`kF39$0`@IKzBQZnJ#kSwSs@!iIu9lsg28HP0TR0E%a<|^h!lx!y z!^Uj0e=pCF_@+!u)t$00+kZ85OyRxVxiBUnPjnXWzalMCg;FMxH^iV8d};HdXVY_x zX0AUi%bNgiAwx&(R;UqQBwM4Kle^?QG;?uH0oDK(p*FWZJ5iSs1nLU<;^~;Oz?gv- zSz(;O4K^x!hin9gKapLLGUki-0-ZtTj41L{NxL%U1`WAP%2BAKBUOD4>vwH6z~do@ zCkDiyG5;jmo8F2ye)x-C2LAc*u7RWMWAP@%Q;1s>O0pMsWQo*u@X4M z|G7vK)!lJ6+l;W4+ZI1I*WF<>CNJi_P)gesn>=V@83UsYhH+h!O8{OKV}vAhON z1+Ur}ULsD+jVAYl&J*W%&U@Y1tSYQ*iZ?>z1KFcJ{GN!mH-J0M7)|Ig*9Aq~rRfp8 zO5AU6qO8LB1i0ib-%!4hukE#c1Q+EhDuSdWb_idxu=&MO^uQusXqae(rY5UYS96l; zG8Fw^Sl+BC_WVH4KK@V-NNjjeE95Yn5KPzErYmJ4(Hjk;c)y1-T|1u;5GhSe!H$p3 zw@i2mSdU29_1twVtMBKcpNEWI?2Q$%VMNv#+2r@|8kTBkxG-tzVAh||Z@fk`$R9T1 zBAUU9$k!0i@Ou|@qB5up&%YS`-Bt&MHq~#yCi0uL%8$G0H_QNuUbE`qI={m88`zV) zbf6AW>*Nkaf4F?&=+4v6#27yq1NgTdw1y3Nbnp{@c7{3e9rr38#Tp%nTJ%}WN=chT zf9@sEe=WiX-u^HU?2(|f*2XY<;kO>pSJJBWmx)1nV=07s+lG|W{s=F-tPq-M`}VV9 z;P5{DpwxsM0DwYPn&C*Oh<)uJ=16Cq=}j8jN;Y^e$!n*J?fPHG9eD+LOT(v57Sp@4 z8UG29#`?41on5<>a?t-?Xe&OF+ch)u5FDssyOa-aodGuTD$ECG#$#xQb`{lSm%6zM zXNRkm6OHRTQlprDSHfEd8mDFnyL}5ZQWSWpZNDQjQXeBT`+9q~!_E>|vR$5^ zr~W`QI_W^Y;eS9lm4*lQH?z=Pk&)s7Cm$!ttKeY7pIF=R34Xy~#1d+(nmWHPj2>n7 z$|u9Q91?LDzOIbRuCkvkPJq2h6QiUce!MZ(l0+VrnxF3Fs~X0S%wFQ}r8jh|4waa`k)F zaO?NOdd)UTW`hsk(U?s zI0HOj45+GWsGdFCZDNgepD%}YNbdXGUO2XKTg=NU`9vmAsTrV*?2dGA4R8}KxKgK1 zj%og_hkg%F$ot(uGra;xG0pAA%JH+slkXg`hxPpgu`v3i8-v02xwh*j@cv5a%rXl? zpJ(rb{>%1A!h>wd0rIo;K={VHuf-pBw>Ah|#^L@-s=U**KU^ktZM3yYL&0NE|I=V^ zXCEiT3x8*rckO48Fq@{limZYVEn|JLrvr=Ay3;Z~Oa auYDzmibATnz&%!36**QhF% select(InjSevName, code), mutate(InjSevName = factor(InjSevName, levels = injury_severity$InjSevName)) %>% rename(InjSevName2 = InjSevName) -TOPS_data <- TOPS_data %>% mutate(ped_inj = ifelse(ROLE1 %in% c("BIKE", "PED"), +# add bike or pedestrian roles ---- + +bike_roles <- c("BIKE", "O BIKE") +ped_roles <- c("PED", "O PED", "PED NO") +vuln_roles <- c(bike_roles, ped_roles) + +TOPS_data <- TOPS_data %>% mutate(ped_inj = ifelse(ROLE1 %in% vuln_roles, INJSVR1, - ifelse(ROLE2 %in% c("BIKE", "PED"), + ifelse(ROLE2 %in% vuln_roles, INJSVR2, NA))) +# bike or ped +TOPS_data <- TOPS_data %>% mutate(vulnerable_role = ifelse(ROLE1 %in% bike_roles | ROLE2 %in% bike_roles, + "Bicyclist", + ifelse(ROLE1 %in% ped_roles | ROLE2 %in% ped_roles, + "Pedestrian", + NA))) + TOPS_data <- left_join(TOPS_data, injury_severity %>% select(InjSevName, code), join_by(ped_inj == code)) %>% mutate(InjSevName = factor(InjSevName, levels = injury_severity$InjSevName)) %>% rename(ped_inj_name = InjSevName) @@ -69,7 +82,7 @@ TOPS_data <- TOPS_data %>% County = CNTYNAME, Street = ONSTR, CrossStreet = ATSTR) %>% - mutate(PedestrianAge = ifelse(ROLE1 %in% c("BIKE", "PED"), age1, age2)) + mutate(PedestrianAge = ifelse(ROLE1 %in% vuln_roles, age1, age2)) # add population census data ---- census_api_key(key = substr(read_file(file = "api_keys/census_api_key"), 1, 40)) @@ -87,6 +100,7 @@ county_focus <- unique(TOPS_data %>% TOPS_data %>% + filter(ped_inj %in% c("A", "K")) %>% group_by(CNTYNAME, Year) %>% summarise(TotalCrashes = n()) %>% mutate(County = CNTYNAME) %>% @@ -100,6 +114,7 @@ TOPS_data %>% group = CNTYNAME), size = 1) + geom_label_repel(data = TOPS_data %>% + filter(ped_inj %in% c("A", "K")) %>% group_by(CNTYNAME, Year) %>% summarise(TotalCrashes = n()) %>% mutate(County = CNTYNAME) %>% @@ -120,7 +135,7 @@ TOPS_data %>% scale_fill_brewer(type = "qual", guide = NULL) + scale_x_discrete(expand = expansion(add = c(0.5,0.75))) + labs(title = "Drivers crashing into pedestrians & bicyclists per 100,000 residents", - subtitle = "2017-2023", + subtitle = "Fatalities and Severe Injuries | 2017-2023", x = "Year", y = "Total crashes per year per 100,000 residents", color = "County", @@ -134,4 +149,23 @@ ggsave(file = paste0("figures/crash_summaries/counties_year.pdf"), height = 8.5, width = 11, units = "in") -e \ No newline at end of file + +TOPS_data %>% + filter(County %in% county_focus) %>% + group_by(County, vulnerable_role) %>% + summarise(count = n()) %>% + ggplot() + + geom_col(aes(x = County, + y = count, + fill = vulnerable_role)) + + +TOPS_data %>% + filter(County %in% "DANE") %>% + group_by(County, vulnerable_role, year) %>% + summarise(count = n()) %>% + ggplot() + + geom_col(aes(x = year, + y = count, + fill = vulnerable_role), + position = position_dodge())