---
title: "Analysis of prediction of the results of United States congressional elections of 2018"
output: html_document
---
Prediction of the results of events that have yet to occur is one of the cornerstones of science. Elections present opportunities to utilize polling and other data to develop forecasts that can then be assessed by comparison with election results. Such election forecasts have become quite visible in recent years with efforts such as those from statistician Nate Silver and his colleagues at FiveThirtyEight (link to https://fivethirtyeight.com). One of the most important aspects of forecasts such as those at FiveThirtyEight is that they explicitly present distributions of likely outcomes with estimated probabilities rather than single predicted results.
Elections for the House of Representatives are particularly useful because they involve a large number of separate but somewhat correlated elections across 435 congressional districts across the United States. FiveThirtyEight (link to https://projects.fivethirtyeight.com/2018-midterm-election-forecast/house/) produced three forecasts (link to https://fivethirtyeight.com/methodology/how-fivethirtyeights-house-and-senate-models-work/) for the recent congressional elections: one based on polls only (Lite); one based on polls plus fundraising, district history, and historical trends (Classic); and one that added ratings from experts to the Classic forecast (Deluxe). I begin by examining how these forecasts compare to one another using the final forecasts before results from the elections were available.
The fundamental basis for these forecasts is the estimation of the probabilities for the percentages of votes for each candidate. For the polls only (Lite) forecast, available polls are used as primary data, combining various polls using corrections and weighting factors based on the polling methodology used and the historical accuracy of different pollsters. The distribution for the percentages of votes from the Lite forecast for Democratic candidates is shown in Figure 1. Note that some races had candidates running unopposed, one congressional race in California paired two Republican candidates, one race in Washington paired two Democratic candidates, races in Louisiana had numerous candidates from various parties, and many races included third-party candidates.
```{r Read election prediction and results file, echo = FALSE}
suppressWarnings(suppressMessages(library(dplyr)))
suppressWarnings(suppressMessages(library(ggplot2)))
Election_data <- read.csv(file="Congressional election results and forecasts.csv", header=TRUE, sep=",", stringsAsFactors = FALSE)
Election_data <- mutate(Election_data, Difference_L = Election_results - Predicted_Lite)
Election_data <- mutate(Election_data, Difference_C = Election_results - Predicted_Classic)
Election_data <- mutate(Election_data, Difference_D = Election_results - Predicted_Deluxe)
```
```{r plot histogram for Lite forecast, echo = FALSE}
suppressWarnings(suppressMessages(library(dplyr)))
suppressWarnings(suppressMessages(library(ggplot2)))
#Plot histogram of predicted percentages
pL <- ggplot(data = Election_data, aes(Election_data$Predicted_Lite)) + geom_histogram(breaks=seq(-1, 100, by = 1))
pL <- pL + labs(title="Figure 1. Histogram for 538 Lite forecast vote % for Democratic candidates")
pL <- pL + labs(x="Forecast from 538 Lite % for Democratic candidates", y="Number of Congressional races")
pL
suppressMessages(ggsave("Forecast_histogram.png", dpi = 600))
```
In almost exactly half of the 435 races, the Democratic candidate was forecast to receive 50% or more of the vote, with an additional 106 forecast to receive between 40 and 50%.
##Comparison of different FiveThirtyEight congressional forecasts
I now consider the more elaborate forecasts from FiveThirtyEight. The predicted percentages for Democratic candidates for the Lite and Classic forecasts are compared in Figure 2.
```{r Compare forecasts, echo = FALSE}
pLC <- ggplot(data = Election_data, aes(x = Predicted_Lite, y = Predicted_Classic)) + geom_point()
pLC <- pLC + labs(title="Figure 2. Comparison of the forecast vote % for Democratic candidates")
pLC <- pLC + labs(x="Forecast from 538 Lite forecast % for Democratic candidates", y="Forecast from 538 Classic forecast % for Democratic candidates")
pLC
suppressMessages(ggsave("Lite_vs_Classic_plot.png", dpi = 600))
Election_data <- mutate(Election_data, Difference_LC = Predicted_Lite - Predicted_Classic)
Election_data <- mutate(Election_data, Difference_CD = Predicted_Classic - Predicted_Deluxe)
```
The average difference between the Lite and Classic forecasts is `r round(mean(Election_data$Difference_LC), 2)`% (with the Lite forecast on average higher) with a standard deviation of `r round(sd(Election_data$Difference_LC), 2)`% and the correlation coefficient between the two forecasts is `r round(cor(Election_data$Predicted_Lite, Election_data$Predicted_Classic), 4)`.
The Deluxe forecast is only slightly different from the Classic forecast with an average difference between the Classic and Deluxe forecasts of `r round(mean(Election_data$Difference_CD), 2)`% (with the Classic forecast on average higher) with a standard deviation of `r round(sd(Election_data$Difference_CD), 2)`%. The correlation coefficient between these two forecasts is `r round(cor(Election_data$Predicted_C, Election_data$Predicted_Deluxe), 4)`.
##Comparisons between forecast percentages and election results
I now compare the percentages from the FiveThirtyEight forecasts with the results from the election. These results were obtained from politico.com (link to https://www.politico.com/election-results/2018/ ) on 15 November. Although these results were not certified at the time of this writing, the percentages are very unlikely to change enough to affect the analysis below. I will focus on the FiveThirtyEight Deluxe forecast.
The actual percentages from the election are compared with those from the Deluxe forecast in Figure 3.
```{r Compare Actual and Deluxe forecast, echo = FALSE}
#Plot actual versus Deluxe
p2D <- ggplot(data = Election_data, aes(x = Predicted_Deluxe, y = Election_results)) + geom_point()
p2D <- p2D + labs(title="Figure 3. Comparison of the actual % with those from the Deluxe forecast")
p2D <- p2D + labs(x="Forecast from 538 Deluxe forecast % for Democratic candidates", y="Actual % for Democratic candidates from the election")
p2D
suppressMessages(ggsave("Deluxe_vs_Actual_plot.png", dpi = 600))
```
Overall, the correlation coefficient between the actual results and those from the forecast is `r round(cor(Election_data$Election_results, Election_data$Predicted_Deluxe), 4)`.
The differences between the actual percentages and those from the Deluxe forecast are shown in Figure 4, and a histogram of these differences is shown in Figure 5.
```{r Continue comparison of differences betweeen actual and Deluxe, echo = FALSE}
#Plot differences Actual minus Deluxe
p2Diff <- ggplot(data = Election_data, aes(x = Election_results, y = Difference_D, group = 1)) + geom_point()
p2Diff <- p2Diff + labs(title="Figure 4. Differences in % from the election and those from the Deluxe forecast")
p2Diff <- p2Diff + labs(x="Actual % for Democratic candidates", y="Actual % - Deluxe forecast %")
p2Diff
suppressMessages(ggsave("Differences_Deluxe_vs_Actual_plot.png", dpi = 600))
#Plot histogram of differences
p2Hist <- ggplot(data = Election_data, aes(Election_data$Difference_D)) + geom_histogram(breaks=seq(-20, 20, by = 0.5))
p2Hist <- p2Hist + labs(title="Figure 5. Histogram for differences between actual % and Deluxe forecast %")
p2Hist <- p2Hist + labs(x="Actual % - Deluxe forecast %", y="Number of races")
p2Hist
suppressMessages(ggsave("Deluxe_vs_Actual_histogram.png", dpi = 600))
```
The average difference between the actual percentage and that from the Deluxe forecast is `r round(mean(Election_data$Difference_D), 2)`% (Deluxe forecast higher) with a standard deviation of `r round(sd(Election_data$Difference_D), 2)`%.
How do these results compare with those for the other two forecasts? For the Lite forecast, the correlation coefficient with the election results is `r round(cor(Election_data$Election_results, Election_data$Predicted_Lite), 4)` and the average difference is `r round(mean(Election_data$Difference_L), 2)`% with a standard deviation of `r round(sd(Election_data$Difference_L), 2)`%. Similarly, for the Classic forecast, the correlation coefficient with the election results is `r round(cor(Election_data$Election_results, Election_data$Predicted_Classic), 4)` and the average difference is `r round(mean(Election_data$Difference_C), 2)`% with a standard deviation of `r round(sd(Election_data$Difference_C), 2)`%. Thus, the Lite forecast performed substantially worse than did the Deluxe and Classic forecasts. The Deluxe forecast performed very slightly better than did the Classic forecast.
##Success in predicting election winners
Although the success in estimating voting percentages is impressive, elections are decided by which candidate receives the most votes. Correctly predicting that one candidate is likely to receive 75% of the vote compared with 65% is of no importance because this candidate will win the election in either case. Thus, the accuracy and precision of predictions in the vicinity of 50% (in a two-person race) are of critical importance. If these predictions were highly accurate and precise, then predicting elections would be straightforward by simply determining which candidate was predicted to get a higher percentage of votes.
Winners have been declared in 429 out of 435 Congressional races as of this writing with the remaining races too close to call. For the purpose of this analysis, I am assuming that the current vote leader will eventually be declared the winner in the remaining races. Overall, the candidate predicted in the Deluxe forecast to receive the most votes won in `r sum(Election_data$Correct)` races, corresponding to `r round((sum(Election_data$Correct)/435)*100, 1)`%.
However, predictions from polls and other data are imprecise, with uncertainties of several percentage points or more. Forecasts such as those performed by FiveThirtyEight (link to https://fivethirtyeight.com/methodology/how-fivethirtyeights-house-and-senate-models-work/) deal with these uncertainties by performing thousands of election simulations in which each candidate’s percentage is allowed to vary from its predicted value. These variations can have multiple components: independent variations that affect only one race; broader variations that can affect multiple races (reflecting, for example, overall national trends at the time of the election) or regional effects; and variations that reflect other factors such as incumbency that can influence polling accuracy. Once thousands of such simulations are performed, the probability that any given candidate will win can be estimated by determining the fraction of simulations in which she or he received a higher percentage of votes than her or his opponents. For example, if a candidate is predicted in the baseline prediction to receive 70% of the votes, then the uncertainties will accumulate to cause this candidate to lose in no or very few simulations, and this candidate can be forecast to win with high probability. On the other hand, if a candidate is predicted to receive 50% of the vote in a two-person race, then this candidate might win in half of the similations and lose in the others, yielding a probability of winning of 50%. Given the uncertainty, a forecast may predict that each of the candidates in a certain number of races has a probability of winning of 50%. The forecast is deemed to be accurate if half of these candidates win their races, even if the forecast is silent about which half.
```{r Calculate moving averages across races,echo = FALSE}
Election_data_sorted <- arrange(Election_data, desc(Predicted_probability_Deluxe))
Election_data_sorted <- mutate(Election_data_sorted, Running_ave = 0, Running_prob = 0)
window_size <- 15
for (i in 1:(435 - window_size + 1)) {
Election_data_sorted$Running_ave[i] <- mean(Election_data_sorted$Predicted_probability_Deluxe[i:(i + window_size - 1)])
Election_data_sorted$Running_prob[i] <- sum(Election_data_sorted$Democratic_win[i:(i + window_size - 1)]) / window_size
}
Election_data_sorted_middle <- filter(Election_data_sorted, Predicted_probability_Deluxe > 25.0 & Predicted_probability_Deluxe < 75.0)
Election_data_sorted_middle_L <- filter(Election_data_sorted, Predicted_probability_Deluxe > 25.0 & Predicted_probability_Deluxe <= 50.0)
Election_data_sorted_middle_H <- filter(Election_data_sorted, Predicted_probability_Deluxe > 50.0 & Predicted_probability_Deluxe < 75.0)
Election_data_sorted_low <- filter(Election_data_sorted, Predicted_probability_Deluxe >= 0.0 & Predicted_probability_Deluxe <= 25.0)
Election_data_sorted_high <- filter(Election_data_sorted, Predicted_probability_Deluxe >= 75.0 & Predicted_probability_Deluxe <= 100.0)
```
First, consider elections for which one candidate was strongly favored to win in the Deluxe forecast. There were `r nrow(Election_data_sorted_low)` races for which the probability of the Democratic candidate winning was between 0% and 25%. The average probability across this pool was `r round(mean(Election_data_sorted_low$Predicted_probability_Deluxe), 1)`%. Among these, there were `r sum(Election_data_sorted_low$Democratic_win)` races where the Democratic candidate won, corresponding to `r round((sum(Election_data_sorted_low$Democratic_win)/nrow(Election_data_sorted_low))*100, 1)`%, lower than but in reasonable agreement with the expectation. Similarly, there were `r nrow(Election_data_sorted_high)` races for which the probability of the Democratic candidate winning was between 75% and 100%. The average probability across this pool was `r round(mean(Election_data_sorted_high$Predicted_probability_Deluxe), 1)`%. Among these, the Democratic candidate won in all races. Thus, elections produced somewhat fewer major upsets than were predicted by the forecast although this observation would have been affected by changes in only a few races.
Now, let us consider the `r nrow(Election_data_sorted_middle)` races for which the probability of the Democratic candidate winning was between 25% and 75%. Of these, there were `r nrow(Election_data_sorted_middle_L)` races for which the probability was between 25% and 50%. The average probability across this window was `r round(mean(Election_data_sorted_middle_L$Predicted_probability_Deluxe), 1)`%. Among these, the Democratic candidate won in `r sum(Election_data_sorted_middle_L$Democratic_win)` or `r round((sum(Election_data_sorted_middle_L$Democratic_win)/nrow(Election_data_sorted_middle_L))*100, 1)`% of them. Similarly, there were `r nrow(Election_data_sorted_middle_H)` races for which the probability was between 50% and 75%. The average probability across this window was `r round(mean(Election_data_sorted_middle_H$Predicted_probability_Deluxe), 1)`%. Among these, the Democratic candidate won in `r sum(Election_data_sorted_middle_H$Democratic_win)` or `r round((sum(Election_data_sorted_middle_H$Democratic_win)/nrow(Election_data_sorted_middle_H))*100, 1)`% of them.
An alternative way of displaying the results is as follows. Races are sorted based on the Deluxe forecast probability of a Democratic winner from lowest to highest. Starting with a window from race 1 to race n (with n empirically set at 15), two parameters are calculated. The first is the average probability calculated over all races in the window. Second, the fraction of Democratic winners across races in the window is calculated by dividing the number of wins by the window size. The window is then moved to races 2 to n+1 and the calculations are repeated. This is repeated as the window is moved across the entire set of races. These results are shown in Figure 6.
```{r Running average plot, echo = FALSE}
p3 <- ggplot(data = Election_data_sorted, aes(x = Predicted_probability_Deluxe, y = value, color = variable))
p3 <- p3 + geom_point(y = Election_data_sorted$Running_prob, color = "red", size = 2, alpha = 0.3)
p3 <- p3 + geom_point(y = Election_data_sorted$Democratic_win, color = "black", size = 1)
p3 <- p3 + geom_path(y = Election_data_sorted$Running_prob, color = "red", size = 2, alpha = 0.3)
p3 <- p3 + labs(title="Figure 6. Moving average of fraction of successfully predicted races")
p3 <- p3 + labs(x="Congressional races ordered by forecast probability of win")
p3 <- p3 + labs(y="Democratic wins (black circles)/Probability of win (red)")
p3
suppressMessages(ggsave("Outcomes_Moving_Average_plot.png", dpi = 600))
```
If the results of the election perfectly matched the forecast probabilities, this plot would be a straight line although some variation is anticipated because of the probabilistic nature of the forecast. The curve does approximately pass through the center of the plot, reflecting the fact that the forecast did quite well in predicting races with probabilities near 50%. The slight S-shape of the curve is due to the fact that a lower number of major upsets that occurred than would have been expected from those probabilities.
##Conclusions
The FiveThirtyEight forecasts of the 2018 Congressional elections were quite accurate in predicting the percentages of votes received by the candidates and in estimating the probabilities for particular election outcomes. The inclusion of data in addition to weighted and corrected polling data improved the accuracy of the predictions. As with all scientific analyses, it is important to keep in mind both the core predictions and the associated uncertainties in these predictions.