Wednesday, January 7, 2015

Is there a relationship between turnout and voter updates?

Is there a relationship between turnout and voter updates?
This is code to chart relationships between voter last updates and turnout per precinct. Political piece here. Under Construction 9:31 AM 1/7/2015 -RMF
## Under Construction: Code to chart relationships between voters updates and turnout
# not designed for dplyr
# removed function calls to 'jpeg_create()' to have the charts print to the screen
# instead of local directory

library(plyr)
library(lubridate)
setwd("C:/Politics")
par(new=F)
par(mfrow=c(1,1))
jpeg_create <- function() {
 systime <- as.numeric(Sys.time())
 # dev.new()
 jpeg(filename = systime,
          width = 1024, height = 768, units = "px", pointsize = 12,
          quality = 100, bg = "white", res = NA, family = "", restoreConsole = TRUE,
          type = c("windows"))
 Sys.sleep(2)
   }

# 4:49 PM 1/3/2015
# December 29, 2014 voterdb history
voterdb121914 <- read.delim("C:/Politics/12.19.14.txt", header = TRUE, strip.white = TRUE, sep = "\t", quote = "", stringsAsFactors = FALSE)    
voterdb <- voterdb121914

# Last updates from 2014 only until certification date
voterdb2014 <- subset(voterdb,year(ymd_hms(as.character(voterdb$LastUpdateDate))) == "2014")
voterdb2014_year <- voterdb2014
voterdb2014$LastUpdateDate <- as.Date(voterdb2014$LastUpdateDate)
voterdb2014 <- subset(voterdb2014,LastUpdateDate >= "2014-01-01" & LastUpdateDate <= "2014-11-24")

# Last updates from 2014 in AllWC and the 42nd only
t1P <- data.frame(xtabs(~PrecinctID,data=voterdb2014))
ld42 <- read.csv("Precinct42.csv")
t2P <- data.frame(xtabs(~PrecinctID,data=subset(voterdb2014,PrecinctID %in% ld42$precincts42)))
t3P <- merge(t1P,t2P,by="PrecinctID",all=TRUE)
colnames(t3P) <- c("PrecinctID","AllWC","x42nd")
t3P$PrecinctID <- as.integer(as.character(t3P$PrecinctID))
t3P <- arrange(t3P,desc(AllWC))

# Matchbacks from 2014 Consolidated
MB_2014_Consolidated <- read.delim("MB_2014_Consolidated.txt", header = TRUE, strip.white = TRUE, sep = "\t", quote = "", stringsAsFactors = FALSE)
MB_2014_Consolidated_status <- subset(MB_2014_Consolidated, select = c(RegistrationNumber,PrecinctID,AVReturnStatus,AVReturnChallenge))
MB_2014_Consolidated_Good <- subset(MB_2014_Consolidated_status, AVReturnStatus == "Good")
MB2014TO <- arrange(data.frame(with(MB_2014_Consolidated_Good,(table(PrecinctID)))),(PrecinctID))

# Summarizing  those who Voted and Not
Voted <- as.data.frame.matrix(xtabs(~PrecinctID + AVReturnStatus, data=MB_2014_Consolidated_status))
dimnames(Voted)[[2]][1] <- "NoVote"
Voted <- as.data.frame(Voted)
Voted$PrecinctID <- rownames(Voted)
Voted <- arrange(Voted[,c("PrecinctID","Good","NoVote","Challenged","Undeliverable","Void")],PrecinctID)
# Voted <- with(Voted,cbind(Voted,
# "Undel_Void" = Undeliverable + Void,
# "PctGood_nC"=(Good/(NoVote + Good + Undeliverable + Void)) * 100,
# "PctUndelVoid_nC"=(Undeliverable/(NoVote + Good + Undeliverable + Void))* 100)) 
Voted42 <- arrange(subset(Voted, PrecinctID %in% ld42$precincts42),desc(NoVote))

# Voted vs Not Voted in the 42nd
jpeg_create()
with(Voted42,(barplot(Good,names.arg=PrecinctID,cex.names=.6,las=2,xlab="PrecinctID",ylim=c(0,800))));par(new=T)
with(Voted42,(barplot(NoVote,names.arg=PrecinctID,col=rgb(1,1,1,.5),cex.names=.6,las=2,ylim=c(0,800))));par(new=T)
lines(stats::lowess(with(Voted42,Good,PrecinctID)),col="white")
lines(stats::lowess(with(Voted42,NoVote,PrecinctID)),col="black")
mtext("Good Ballots (gray) and Not Voting (white) for the 2014 42nd LD GE Sorted By those Not Voting.") 

jpeg_create()
with(Voted42,(barplot(Good/(Good+NoVote),names.arg=PrecinctID,cex.names=.6,las=2,xlab="PrecinctID",ylim=c(0,.8))));par(new=T)
with(Voted42,(barplot(NoVote/(Good+NoVote),names.arg=PrecinctID,col=rgb(1,1,1,.5),cex.names=.6,las=2,ylim=c(0,.8))));par(new=T)
lines(stats::lowess(with(Voted42,(Good/(Good+NoVote)),PrecinctID)),col="white")
lines(stats::lowess(with(Voted42,(NoVote/(Good+NoVote)),PrecinctID)),col="black")
mtext("Good Ballots and Not Voting as a percentages Sorted By those Not Voting:")
mtext("'Good/(Good + Not Voting)' (gray) and 'Not Voting/(Good + Not Voting)' (white) for the 2014 42nd LD GE.",line=-1) 

jpeg_create()
par(mfrow=c(2,1))
with(subset(Voted42,Good/(Good+NoVote) < .6),(barplot(Good/(Good+NoVote),names.arg=PrecinctID,cex.names=.6,las=2,xlab="PrecinctID",ylim=c(0,.8))))
lines(stats::lowess(with(Voted42,(subset(Voted42,Good/(Good+NoVote) < .6)),PrecinctID)),col="white")
mtext("Good Ballots and Not Voting as a percentages Sorted By those Not Voting where")
mtext("'Not Voting/(Good + Not Voting) < .6' (gray) and 'Good/(Good + Not Voting) < .6' (white) for the 2014 42nd LD GE.",line=-1)
with(subset(Voted42,NoVote/(Good+NoVote) < .6),(barplot(NoVote/(Good+NoVote),names.arg=PrecinctID,col=rgb(1,1,1,.5),cex.names=.6,las=2,xlab="PrecinctID",ylim=c(0,.8))))
lines(stats::lowess(with(Voted42,(subset(Voted42,NoVote/(Good+NoVote) < .6)),PrecinctID)),col="black")
par(mfrow=c(1,1))

jpeg_create()
par(mfrow=c(2,1))
with(subset(Voted42,Good/(Good+NoVote) > .6),(barplot(Good/(Good+NoVote),names.arg=PrecinctID,cex.names=.6,las=2,xlab="PrecinctID",ylim=c(0,.8))))
lines(stats::lowess(with(Voted42,(subset(Voted42,Good/(Good+NoVote) < .6)),PrecinctID)),col="white")
with(subset(Voted42,NoVote/(Good+NoVote) > .6),(barplot(NoVote/(Good+NoVote),names.arg=PrecinctID,col=rgb(1,1,1,.5),cex.names=.6,las=2,xlab="PrecinctID",ylim=c(0,.8))))
mtext("Good Ballots and Not Voting as a percentages Sorted By those Not Voting where")
mtext("'Not Voting/(Good + Not Voting) > .6' (white) and 'Good/(Good + Not Voting) > .6' (gray) for the 2014 42nd LD GE.",line=-1)
lines(stats::lowess(with(Voted42,(subset(Voted42,NoVote/(Good+NoVote) > .6)),PrecinctID)),col="black")
par(mfrow=c(1,1))

# Merge those precincts that voted (e.g. "good ballots" in 2014 with those that were updated
MBvsVU <-  merge(arrange(t3P,PrecinctID),MB2014TO)
MBvsVU$Diff42nd <- cbind(MBvsVU$Freq - MBvsVU$x42nd)
# Chart to compare those who voted vs. those who were updated in each precinct  for all Whatcom County sorted by Precincts
jpeg_create()
with(MBvsVU,(barplot(Freq,names.arg=PrecinctID,col="red",las=2,cex.names=.4,xlab="PrecinctID",ylim=c(0,800)))); par(new=T)
with(MBvsVU,(barplot(AllWC,names.arg=PrecinctID,col="blue",las=2,cex.names=.4,ylim=c(0,800)))); par(new=F)
mtext("Good Ballots (red) and Last Updates (blue) for the 2014 GE (All Whatcom County) Sorted by Precinct.") 

# Sorted Chart to compare those who voted vs. those who were updated in each precinct  for all Whatcom County
MBvsVU <-  merge(arrange(t3P,PrecinctID),MB2014TO)
MBvsVUbyFreq <- arrange(MBvsVU,desc(Freq))
jpeg_create()
with((arrange(MBvsVU,desc(Freq))),(barplot(Freq,names.arg=PrecinctID,cex.names=.6,col="red",las=2,xlab="PrecinctID",ylim=c(0,800)))); par(new=T)
with((arrange(MBvsVU,desc(Freq))),(barplot(AllWC,names.arg=PrecinctID,cex.names=.6,col="blue",las=2,ylim=c(0,800)))); par(new=T)
lines(stats::lowess(with((arrange(MBvsVU,desc(Freq))),AllWC)),col="light blue")
lines(stats::lowess(with((arrange(MBvsVU,desc(Freq))),Freq)),col=rgb(1,0,1,1))
mtext("Good Ballots (red) and Last Updates (blue) for the 2014 GE (All Whatcom County) Sorted by Good Ballots.") 

# Sorted Chart to compare those who voted vs. those who were updated in each precinct for the 42nd only
MBvsVU <-  merge(arrange(t3P,PrecinctID),MB2014TO)
MBvsVUbyFreq <- arrange(MBvsVU,desc(Freq))
MBvsVU42 <- subset(MBvsVU,x42nd != "NA")
jpeg_create()
with((arrange(MBvsVU42,desc(Freq))),(barplot(Freq,names.arg=PrecinctID,cex.names=.6,col="red",las=2,xlab="PrecinctID",ylim=c(0,800)))); par(new=T)
with((arrange(MBvsVU42,desc(Freq))),(barplot(x42nd,names.arg=PrecinctID,cex.names=.6,col="blue",las=2,ylim=c(0,800)))); par(new=T)
lines(stats::lowess(with((arrange(MBvsVU42,desc(Freq))),x42nd)),col="light blue")
lines(stats::lowess(with((arrange(MBvsVU42,desc(Freq))),Freq)),col=rgb(1,0,1,1))
mtext("Good Ballots (red) and Last Updates (blue) for the 2014 GE (42nd LD) Sorted by Good Ballots.") 

# Sorted Chart to compare those who voted vs. those who were updated in each precinct for the 42nd only of Updated/Good > .4
MBvsVU <-  merge(arrange(t3P,PrecinctID),MB2014TO)
MBvsVU$Diff42nd <- cbind(MBvsVU$Freq - MBvsVU$x42nd)
MBvsVU$Quotient42nd <- cbind(MBvsVU$x42nd / MBvsVU$Freq)
MBvsVU42.4 <- subset(MBvsVU,x42nd != "NA" & Quotient42nd > .4)
jpeg_create()
with((arrange(MBvsVU42.4,desc(Freq))),(barplot(Freq,names.arg=PrecinctID,cex.names=.6,col="red",las=2,xlab="PrecinctID",ylim=c(0,800)))); par(new=T)
with((arrange(MBvsVU42.4,desc(Freq))),(barplot(x42nd,names.arg=PrecinctID,cex.names=.6,col="blue",las=2,ylim=c(0,800)))); par(new=T)
lines(stats::lowess(with((arrange(MBvsVU42.4,desc(Freq))),x42nd)),col="light blue")
lines(stats::lowess(with((arrange(MBvsVU42.4,desc(Freq))),Freq)),col=rgb(1,0,1,1));par(new=F)
mtext("Good Ballots (red) and Last Updates (blue) for the 2014 GE (42nd) Sorted by Good Ballots")
mtext("where Last Updates / Good > .4",line=-1) 

# Sorted Chart to compare those who did not vote vs. those who were updated in each precinct for the 42nd only of Updated/Good > .4
VotevsVU <-  merge(arrange(t3P,PrecinctID),Voted,By="PrecinctID")
VotevsVU$Diff42nd <- cbind(VotevsVU$NoVote - VotevsVU$x42nd)
VotevsVU$Quotient42nd <- cbind(VotevsVU$x42nd / VotevsVU$NoVote)
VotevsVU42.4 <- subset(VotevsVU,x42nd != "NA" & Quotient42nd > .4)
jpeg_create()
with((arrange(VotevsVU42.4,desc(NoVote))),(barplot(NoVote,names.arg=PrecinctID,cex.names=.6,col="red",las=2,xlab="PrecinctID",ylim=c(0,800)))); par(new=T)
with((arrange(VotevsVU42.4,desc(NoVote))),(barplot(x42nd,names.arg=PrecinctID,cex.names=.6,col="blue",las=2,ylim=c(0,800)))); par(new=T)
lines(stats::lowess(with((arrange(VotevsVU42.4,desc(NoVote))),x42nd)),col="light blue")
lines(stats::lowess(with((arrange(VotevsVU42.4,desc(NoVote))),NoVote)),col=rgb(1,0,1,1));par(new=F)
mtext("Not Voting (red) and Last Updates (blue) for the 2014 GE (42nd LD) Sorted by Good Ballots")
mtext("where Last Updates / Not Voting > .4",line=-1) 

# write.csv(arrange(MBvsVU42.4,desc(Quotient42nd)),"GE2014GoodVU.csv")
# write.csv(arrange(VotevsVU42.4,desc(Quotient42nd)),"MB2014NoVote.csv")
MB2014.4NoVote <- arrange(VotevsVU42.4,desc(Quotient42nd))
GE2014.4GoodVU <- arrange(MBvsVU42.4,desc(Quotient42nd))
MBVU <- merge(MB2014.4NoVote,GE2014.4GoodVU,by = "PrecinctID")

jpeg_create()
with((arrange(MBVU,desc(Good))),(barplot(Good,names.arg=PrecinctID,cex.names=.6,col=rgb(0,0,1,.95),las=2,xlab="PrecinctID",ylim=c(0,800)))); par(new=T)
with((arrange(MBVU,desc(Good))),(barplot(NoVote,names.arg=PrecinctID,cex.names=.6,col=rgb(1,0,0,.75),las=2,ylim=c(0,800)))); par(new=T)
with((arrange(MBVU,desc(Good))),(barplot(x42nd.x,names.arg=PrecinctID,cex.names=.6,col=rgb(0,1,0,.55),las=2,ylim=c(0,800)))); par(new=T)
lines(stats::lowess(with((arrange(MBVU,desc(x42nd.x))),x42nd.x)),col=rgb(0,1,0,1))
lines(stats::lowess(with((arrange(MBVU,desc(Good))),Good)),col=rgb(0,0,1,1))
lines(stats::lowess(with((arrange(MBVU,desc(NoVote))),NoVote)),col=rgb(1,0,0,1))
mtext("Good Votes (blue) and Not Voting (red) and Last Updates (green) for the 2014 GE (42nd LD) Sorted by Good Ballots")
mtext("where Precinct is both of 'Last Updates / Not Voting > .4' and 'Last Updates / Good > .4'",line=-1) 

jpeg_create()
with((arrange(MBVU,desc(Good))),(barplot(Good,names.arg=PrecinctID,cex.names=.6,col=rgb(0,0,1,.95),las=2,xlab="PrecinctID",ylim=c(0,800)))); par(new=T)
with((arrange(MBVU,desc(Good))),(barplot(NoVote,names.arg=PrecinctID,cex.names=.6,col=rgb(1,0,0,.75),las=2,ylim=c(0,800)))); par(new=T)
with((arrange(MBVU,desc(Good))),(barplot(x42nd.y,names.arg=PrecinctID,cex.names=.6,col=rgb(0,1,0,.55),las=2,ylim=c(0,800)))); par(new=T)
lines(stats::lowess(with((arrange(MBVU,desc(x42nd.y))),x42nd.y)),col=rgb(0,1,0,1))
lines(stats::lowess(with((arrange(MBVU,desc(Good))),Good)),col=rgb(0,0,1,1))
lines(stats::lowess(with((arrange(MBVU,desc(NoVote))),NoVote)),col=rgb(1,0,0,1))
mtext("Good Votes (blue) and Not Voting (red) and Last Updates (green) for the 2014 GE (42nd LD) Sorted by Good Ballots")
mtext("where Precinct is both of 'Last Updates / Not Voting > .4' and 'Last Updates / Good > .4'" ,line=-1) 

No comments:

Post a Comment