I've updated the dataset.
(Which now includes turnout and population estimates).
Also, I've found some anomalous features in the data.
(Namely, more "straight lines" than what I would intuitively expect).
The dataset/description are on my website.
(Links at bottom).
####################################
#set PATH as required
####################################
data <- read.csv (PATH, header=TRUE)
head (data, 3)
I took a subset, where the Dem/Rep margins have reversed between the
2016 and 2020 elections.
rev.results <- (sign (data$RMARGIN_2016) + sign (data$RMARGIN_2020) == 0)
data2 <- data [data$SUBSV1 != 1 & rev.results,]
sc <- paste (data2$STATE, data2$EQCOUNTY, sep=": ")
head (data2, 3)
Then created two plots, attached.
(1) Republican margin vs voter turnout.
(2) Republican margin vs log (number of votes).
In both cases, there are near-straight lines.
Re-iterating, more than what I would intuitively expect.
library (probhat)
plot1 <- function ()
{ x <- with (data2, cbind (x1=RMARGIN_2020, x2=TURNOUT_2020) )
plot (pdfmv.cks (x, smoothness = c (1, 1) ), contours=FALSE,
hcv=TRUE, n=80,
xlim = c (-2.5, 10), ylim = c (40, 52.5),
main="US Counties\n(with reversed results, over 2016/2020
elections)",
xlab="Republican Margin, 2020", ylab="Voter Turnout,
2020")
points (x, pch=16, col="#000000")
abline (v=0, h=50, lty=2)
I1 <- (sc == "Colorado: Alamosa" | sc == "Georgia:
Burke" | sc
== "Ohio: Lorain")
I2 <- (sc == "South Carolina: Clarendon" | sc ==
"Ohio: Mahoning")
sc [! (I1 | I2)] <- ""
k <- lm (TURNOUT_2020 ~ RMARGIN_2020, data = data2 [I1,])$coef
abline (a = k [1], b = k [2])
points (x [I1 | I2,], col="white")
text (x [,1] + 0.2, x [,2], sc, adj = c (0, 0.5) )
}
plot2 <- function ()
{ x <- with (data2, cbind (x1=RMARGIN_2020, x2 = log (NVOTES_2020) ) )
plot (pdfmv.cks (x, smoothness = c (1, 1) ), contours=FALSE,
hcv=TRUE, n=80,
xlim = c (-2.5, 35),
main="US Counties\n(with reversed results, over 2016/2020
elections)",
xlab="Republican Margin, 2020", ylab="log (Number of
Votes), 2020")
points (x, pch=16, col="#000000")
abline (v=0, lty=2)
sc <- paste (data2$STATE, data2$EQCOUNTY, sep=": ")
I1 <- (sc == "Texas: Kenedy")
I2 <- (sc == "Texas: Reeves" | sc == "New York:
Rockland")
k <- lm (log (NVOTES_2020) ~ RMARGIN_2020, data = data2 [I1 |
I2,])$coef
abline (a = k [1], b = k [2])
points (x [I1 | I2,], col="white")
text (x [I1, 1] - 0.5, x [I1, 2], sc [I1], adj = c (1, 0.5) )
text (x [I2, 1] + 0.5, x [I2, 2], sc [I2], adj = c (0, 0.5) )
}
plot1 ()
plot2 ()
https://sites.google.com/site/spurdlea/us_election_2020
https://sites.google.com/site/spurdlea/exts/election_results_2.txt
On Sun, Nov 15, 2020 at 8:51 AM Rolf Turner <r.turner at auckland.ac.nz>
wrote:>
>
> On Fri, 13 Nov 2020 19:02:19 -0800
> Jeff Newmiller <jdnewmil at dcn.davis.ca.us> wrote:
>
> > It was explained in the video... his counts were so small that they
> > spanned the 1-9 and 10-99 ranges.
>
> Sorry, missed that. I'll have to watch the video again.
>
> Thanks.
>
> cheers,
>
> Rolf
-------------- next part --------------
A non-text attachment was scrubbed...
Name: plot1.png
Type: image/png
Size: 24878 bytes
Desc: not available
URL:
<https://stat.ethz.ch/pipermail/r-help/attachments/20201115/55684c86/attachment.png>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: plot2.png
Type: image/png
Size: 22769 bytes
Desc: not available
URL:
<https://stat.ethz.ch/pipermail/r-help/attachments/20201115/55684c86/attachment-0001.png>