Background on DC Mayoral Primary

Muriel Bowser Declares Victory

On June 22nd, 2022, Muriel Bowser won her second term for DC Mayor. Bowser’s message: she is the next Marion Barry, the only mayor to serve three consecutive terms. During her election night victory, she said: “Tonight we choose a future where we won’t lose our Chocolate City, but we will invest in it, and we will continue to be a city for Black Washingtonians.” from DCist

Mayor Bowser also won with just 49.8% of the vote. Getting slightly less than 50% of the vote as an incumbent is not a great look. As someone who is interested in election data, I wanted to better understand the results of the elections through multiple visualizations.

Across the three visualizations, green will represent Mayor Bowser, blue will represent Robert White, and orange will represent Trayon White.

Cleaning the Data

Here is data from the DC Elections office of the 2022 Primary. I did some simple filtering to narrow it to the Mayor’s election.

dccsv <- read_csv("June_21_2022_Primary_Election_Certified_Results.csv")

candidates <- c("Muriel E. Bowser", 'Trayon "Washington DC" White', 
                "Robert White")

dc_filter <- dccsv %>% #Filter to Candidates, Ward Number, Precinct, & Votes
  select(PrecinctNumber, WardNumber, Candidate, Votes) 

dc_clean <- dc_filter %>% 
  filter(Candidate %in% candidates)

dc2 <- dc_clean %>% #better way to convert from long to wide
  group_by(PrecinctNumber) %>% # create sum by precinct
  mutate(nvotes = sum(Votes)) %>% 
  ungroup() %>% 
  pivot_wider(names_from = Candidate, values_from = Votes) %>% 
  rename(precinct = PrecinctNumber, ward = WardNumber, 
         bowser = `Muriel E. Bowser`, twhite = `Trayon "Washington DC" White`, rwhite = `Robert White`) %>% 
  mutate()

Election Result Table

dc2 %>% 
  kbl(align = "c") %>% 
  kable_styling(bootstrap_options = c("striped", "hover")) %>% 
  scroll_box(height = "300px")

precinct	ward	nvotes	bowser	twhite	rwhite
1	6	1364	608	167	589
2	2	90	34	2	54
3	2	571	380	17	174
4	2	714	467	14	233
5	2	721	552	8	161
6	2	669	502	10	157
7	3	570	366	9	195
8	3	1312	967	13	332
9	3	503	414	3	86
10	3	816	620	8	188
11	3	1292	688	19	585
12	3	238	179	4	55
13	2	549	361	5	183
14	2	945	488	16	441
15	2	1185	579	17	589
16	2	1324	734	34	556
17	2	1397	663	43	691
18	6	0	0	0	0
19	5	1426	621	105	700
20	1	276	120	21	135
21	6	0	0	0	0
22	1	1594	788	40	766
23	1	1045	455	49	541
24	1	1144	541	9	594
25	1	1797	883	19	895
26	3	1456	820	13	623
27	3	1301	838	18	445
28	3	1186	813	16	357
29	3	596	382	12	202
30	3	759	514	7	238
31	3	1415	938	15	462
32	3	1506	979	19	508
33	3	1562	963	16	583
34	3	1992	1041	42	909
35	1	1457	606	30	821
36	1	1341	508	102	731
37	1	1054	448	55	551
38	1	974	352	54	568
39	1	1578	696	52	830
40	1	1500	661	44	795
41	1	1078	434	48	596
42	1	691	284	22	385
43	1	616	248	50	318
44	5	761	371	104	286
45	4	850	362	56	432
46	4	1107	467	65	575
47	4	1287	533	45	709
48	4	1114	561	50	503
49	4	327	115	25	187
50	3	1088	673	14	401
51	4	1766	1205	22	539
52	4	797	582	4	211
53	4	488	291	22	175
54	4	845	406	44	395
55	4	847	388	66	393
56	4	1088	480	87	521
57	4	824	352	55	417
58	4	745	340	59	346
59	4	999	471	60	468
60	4	593	328	50	215
61	4	612	350	39	223
62	4	1766	1151	30	585
63	4	1576	783	68	725
64	4	924	503	48	373
65	4	1051	564	86	401
66	5	1881	922	185	774
67	5	1215	635	84	496
68	5	837	383	59	395
69	5	926	450	63	413
70	5	608	290	44	274
71	5	890	467	87	336
72	5	1108	483	166	459
73	5	857	375	61	421
74	5	1508	640	152	716
75	5	1265	463	114	688
76	5	463	162	52	249
77	5	899	371	105	423
78	5	687	256	122	309
79	5	379	144	84	151
80	7	2334	976	324	1034
81	6	872	382	50	440
82	6	982	427	59	496
83	6	1227	510	61	656
84	6	838	455	17	366
85	6	1127	622	20	485
86	6	631	323	9	299
87	6	129	69	9	51
88	6	965	507	19	439
89	6	1212	677	14	521
90	6	606	349	11	246
91	6	1478	669	98	711
92	7	293	107	94	92
93	7	398	191	93	114
94	7	507	213	115	179
95	7	340	135	79	126
96	7	491	203	132	156
97	7	311	146	83	82
98	7	499	244	122	133
99	7	344	166	74	104
100	7	519	204	180	135
101	7	481	221	84	176
102	7	564	245	161	158
103	7	799	327	240	232
104	7	741	285	230	226
105	7	572	253	145	174
106	7	775	377	175	223
107	7	295	133	104	58
108	7	408	215	44	149
109	7	419	220	24	175
110	7	1232	603	198	431
111	7	549	270	123	156
112	8	482	227	107	148
113	7	791	397	130	264
114	8	619	237	186	196
115	8	441	159	197	85
116	8	654	243	267	144
117	8	432	145	194	93
118	8	554	174	250	130
119	8	417	131	171	115
120	8	509	179	203	127
121	8	732	284	283	165
122	8	389	180	127	82
123	8	486	219	153	114
124	8	627	268	208	151
125	8	795	309	315	171
126	8	694	263	281	150
127	6	1534	778	128	628
128	6	707	325	51	331
129	2	2529	1300	148	1081
130	6	340	189	5	146
131	6	668	291	30	347
132	7	408	194	94	120
133	8	330	175	62	93
134	8	479	172	202	105
135	5	994	462	69	463
136	3	380	189	2	189
137	1	424	202	12	210
138	3	1075	665	19	391
139	5	1039	604	107	328
140	8	1279	588	166	525
141	2	892	429	13	450
142	6	798	413	51	334
143	2	226	130	3	93
144	6	897	294	44	559

So what does this mean? It’s hard to make heads or tails of a bunch of numbers. Luckily, R allows us to visualize the data in multiple ways to tell different stories.

dc2 <- dc2 %>% 
  mutate(across(bowser:rwhite, .fns = ~ .x/nvotes, .names = "{.col}_percent"), # percent of vote
         across(bowser:rwhite, .fns = ~ .x - (nvotes-.x), .names = "{.col}_margin"), # this gives your "margin" above, but still not sure it's what you want
         across(bowser_margin:rwhite_margin, .fns = ~ .x/nvotes, .names = "{.col}pct")) # this gives your "percent" above...

Graphing Vote Totals in Lineplot

Let’s look at total number of votes per precinct in a simple linegraph.

d <- dc2 %>% 
  ggplot(aes(x = precinct)) +
  geom_line(aes(y = bowser), color = "mediumseagreen") +
  geom_line(aes(y = rwhite), color = "royalblue1") +
  geom_line(aes(y = twhite), color = "orange") +
  labs(
    title = "2022 DC Primary Election Results",
    subtitle = "Source: Department of Elections Website",
    x = "Precinct Number",
    y = "Number of votes") +
  theme(plot.title = element_text(hjust = 0.5)) +
  theme(plot.subtitle = element_text(hjust = 0.5)) 
print(d)

This would give us the impression that Mayor Bowser is the clear and consistent favorite. What if we looked at the percent point break down per precinct?

c <- dc2 %>% 
  ggplot(aes(x = precinct)) +
  geom_line(aes(y = bowser_percent), color = "mediumseagreen") +
  geom_line(aes(y = rwhite_percent), color = "royalblue1") +
  geom_line(aes(y = twhite_percent), color = "orange") +
  labs(
    title = "2022 DC Primary Election Results",
    subtitle = "Source: Department of Elections Website",
    x = "Precinct Number",
    y = "Percent Margin of Victory") +
  theme(plot.title = element_text(hjust = 0.5)) +
  theme(plot.subtitle = element_text(hjust = 0.5)) 
print(c)

It looks a little closer. Mayor Bowser and Robert White are neck and neck in a few precincts. Trayon White is the clear favorite in a few. The two gaps are the precincts that don’t report any votes.

Chloropleth Mapping

# Data from: https://opendata.dc.gov/datasets/DCGIS::voting-precinct-2019/about

# temp_shapefile <- tempfile()
# download.file("https://opendata.arcgis.com/api/v3/datasets/09f6810bb5a84ae6a07272b05bea6528_27/downloads/data?format=shp&spatialRefId=4326&where=1%3D1", temp_shapefile)
#unzip(temp_shapefile)

dcmapdata <- sf::st_read("Voting_Precinct_2019.shp")

Lines on a graph are great, but they don’t explain very well where these close precincts were in the city. In which precincts did each candidate perform well?

This is a map of dc precincts courtesy of the DC Department of Elections.

As we can see, there tends to be a geographic cluster where each candidate performed well. Unfortunately, these choropleths only explain where each candidate did well relative to their best performance. Trayon White’s best performance was with 40% of the vote, whereas Mayor Bowser won some with a blowout of close to 80%.

dcmapclean <- dcmapdata %>%
   mutate(NAME = str_remove(NAME, "Precinct "),
          precinct = NAME)
 #sum(dc2$precinct %in% dcmapclean$precinct) #Code checks if the recoded
 #precinct variables worked

dc2$precinct <- as.character(dc2$precinct)

dc_join <- dcmapclean %>% 
  left_join(dc2, by = c("NAME" = "precinct"))

Robert White Votes

pal2 <- colorNumeric(
  palette = "Blues",
  domain = dc_join$rwhite_percent)

leaflet() %>% 
  addProviderTiles("CartoDB.Positron") %>% 
  addPolygons(data = dc_join,
              fillColor = ~pal2(rwhite_percent),
              fillOpacity = 0.6,
              weight = 1, 
              opacity = 2,
              color = "white",
              highlight = highlightOptions(
                weight = 2,
                fillOpacity = 0.8,
                bringToFront = T),
        popup = paste0("Precinct Name: ", dc_join$precinct, "<br>",
        "Votes per precinct: ", dc_join$rwhite, 2)) %>% 
  addLegend("bottomright", pal = pal2, values = dc_join$rwhite_percent, 
            title = "Robert White win percentage", opacity = 0.7)

Mayor Bowser Votes

pal2 <- colorNumeric(
  palette = "Greens",
  domain = dc_join$bowser_percent)

leaflet() %>% 
  addProviderTiles("CartoDB.Positron") %>% 
  addPolygons(data = dc_join,
              fillColor = ~pal2(bowser_percent),
              fillOpacity = 0.6,
              weight = 1, 
              opacity = 2,
              color = "white",
              highlight = highlightOptions(
                weight = 2,
                fillOpacity = 0.8,
                bringToFront = T),
        popup = paste0("Precinct Name: ", dc_join$precinct, "<br>",
        "Votes per precinct: ", dc_join$bowser, 2)) %>% 
  addLegend("bottomright", pal = pal2, values = dc_join$bowser_percent, 
            title = "Muriel Bowser win percentage", opacity = 0.7)

Trayon White Votes

pal2 <- colorNumeric(
  palette = "Oranges",
  domain = dc_join$twhite_percent)

leaflet() %>% 
  addProviderTiles("CartoDB.Positron") %>% 
  addPolygons(data = dc_join,
              fillColor = ~pal2(twhite_percent),
              fillOpacity = 0.6,
              weight = 1, 
              opacity = 2,
              color = "white",
              highlight = highlightOptions(
                weight = 2,
                fillOpacity = 0.8,
                bringToFront = T),
        popup = paste0("Precinct Name: ", dc_join$precinct, "<br>",
        "Votes per precinct: ", dc_join$twhite, 2)) %>% 
  addLegend("bottomright", pal = pal2, values = dc_join$twhite_percent, 
            title = "Trayon White win percentage", opacity = 0.7)

dc_t <- dccsv %>%  # turnout table
  filter(ContestName == "REGISTERED VOTERS - TOTAL", Party == "DEM") %>%
  select(PrecinctNumber, Votes) # Votes is total number of voters in precinct

dc_t$PrecinctNumber <- as.character(dc_t$PrecinctNumber)
dc2$precinct <- as.character(dc2$precinct)
class(dc_t$PrecinctNumber) # convert to character to merge

## [1] "character"

dc3 <- dc_t %>% 
 left_join(dc2, by = c("PrecinctNumber" = "precinct"))

Turnout Data

One final item to consider is turnout, which measures the share of registered voters per precinct who turned out to vote. As we can see in the graph below, turnout of each candidate’s voter base varied, but Bowser consistently had the highest percent of the vote per precinct, which is likely what brought her to victory.

dc4 <- dc3 %>% 
  mutate(turnout = (nvotes/Votes))

dc4 %>% 
  select(PrecinctNumber, turnout, bowser_percent, twhite_percent, rwhite_percent) %>% 
  pivot_longer(-c(PrecinctNumber, turnout), names_to = "candidate", 
               values_to = "vote_percent",
               names_pattern = "(.*)_percent") %>% 
  ggplot(aes(x = turnout, y = vote_percent, color = candidate)) +
  geom_point() +
  scale_color_manual(values = c(wes_palette("Darjeeling1")[2],
                               wes_palette("Darjeeling1")[5],
                                wes_palette("Darjeeling1")[4]),
                     guide = "none") +
    ggtitle("Win Percent of Candidate relative to Voter Turnout") +
  theme(plot.title = element_text(hjust = 0.5)) +
  labs(x = "Turnout", y = "Vote percent win per Candidate")

I hope to visualize the data from the next election cycle and compare it to these results to continue to look for trends within elections.

Wrangling Election Data

by Charlie Bruce

October 2022