# Define a safe, always-present temp directory
my_tempdir <- file.path(getwd(), "temp_r_exports")
dir.create(my_tempdir, recursive = TRUE, showWarnings = FALSE)
Sys.setenv(TMPDIR = my_tempdir)



library(maps)
library(Hmisc)
library(weights)
library(openxlsx)
library(parallel)
library(stringr)
library(data.table)
library(usa)
library(tigris)
library(sf)
library(RColorBrewer)
library(scales)
library(sandwich)
library(lmtest)



options(tigris_use_cache = TRUE)
#tigris::tigris_cache_dir(my_tempdir)

#options(tigris_use_cache = TRUE)
options(tigris_cache_dir = my_tempdir)


load("../DataAccess/primarydataset.rdata")

table(fs2$election_date[fs2$stage=="general" & !grepl("-11-", fs2$election_date) & !is.na(fs2$election_date)])
fs2$stage[fs2$stage=="general" & !grepl("-11-", fs2$election_date) & !is.na(fs2$election_date)] <- "special"

#fs2$cycle[fs2$cycle==2021 & fs2$office=="president"] <- 2020
#fs2$cycle[fs2$cycle==2019 & fs2$office=="president"] <- 2020
#fs2$cycle[fs2$cycle==2022 & fs2$office=="president"] <- 2024
#fs2$cycle[fs2$cycle==2023 & fs2$office=="president"] <- 2024

#fs2$cycle[fs2$cycle==2024 & as.Date(fs2$eddt)<as.Date("2020-11-03")] <- 2020
#fs2$cycle[fs2$cycle==2020 & as.Date(fs2$eddt)<as.Date("2016-11-08")] <- 2016
dfuse <- fs2[!fs2$potentialforduplication,]
dfuse$bestweight <- dfuse$bestweight*dfuse$conservativepollsetweight

updatedpollid <- dfuse$updatedpollid
studycontest <- dfuse$studycontest
dfuse$contestpoll <- paste(updatedpollid, studycontest)

table(dfuse$match_name[dfuse$year=="2024" & !grepl("538", dfuse$status)])

pollidNs <- table(dfuse$updatedpollid[dfuse$conservativepollset])
surveywt <- unlist(mclapply(dfuse$updatedpollid, function(x) 1/pollidNs[x]))
dfuse$surveymet <- surveywt
dfuse$surveymet[is.na(dfuse$surveywt)] <- 0
dfuse$surveymet[!dfuse$conservativepollset] <- 0
dfuse$bwkeeps <- dfuse$bestweight>0



#dfuse$simplifiedmode <- NA
#dfuse$simplifiedmode[grepl("probability panel", dfuse$methodology)] <- "Prob Panel"
#dfuse$simplifiedmode[grepl('live phone', dfuse$methodology)] <- "Mixed w/ Live Phone"
#dfuse$simplifiedmode[grepl('ivr', dfuse$methodology)] <- "At least some IVR"
#dfuse$simplifiedmode[grepl("mail", dfuse$methodology)] <- "Mail/mixed mail/Email"
#dfuse$simplifiedmode[grepl('text', dfuse$methodology)] <- "Mixed w/ text"
#dfuse$simplifiedmode[grepl('online', dfuse$methodology)] <- "Online Opt-in"
#dfuse$simplifiedmode[dfuse$methodology=="live phone"] <- "Live Phone Only"
#dfuse$simplifiedmode[dfuse$methodology=="probability panel"] <- "Prob Panel"
#dfuse$simplifiedmode[dfuse$methodology=="online panel"] <- "Online Opt-in"
#dfuse$simplifiedmode[dfuse$methodology=="email"] <- "Mail/mixed mail/Email"
#dfuse$simplifiedmode[dfuse$methodology=="app panel"] <- "Online Opt-in"
#dfuse$simplifiedmode[dfuse$methodology=="face-to-face"] <- "Face-to-Face"
#dfuse$simplifiedmode[dfuse$methodology=="text"] <- "Text/Text-to-Web"
#dfuse$simplifiedmode[dfuse$methodology=="text-to-web"] <- "Text/Text-to-Web"

dfuse$methodology[dfuse$methodology==""] <- NA
dfuse$anyonlineoptin <- grepl('online', dfuse$methodology) | dfuse$methodology=="app panel" | dfuse$methodology=="online panel"
dfuse$anytext <- grepl('text', dfuse$methodology)
dfuse$anylivephone <- grepl('live phone', dfuse$methodology)
dfuse$anymailemail <- grepl('mail', dfuse$methodology)
dfuse$anyivr <- grepl('ivr', dfuse$methodology)
dfuse$anyprobpanel <- grepl('probability panel', dfuse$methodology)
dfuse$anyf2f <- grepl('face-to-face', dfuse$methodology)
dfuse$multimethodindicator <- with(dfuse, as.factor(anyonlineoptin+anytext+anylivephone+anymailemail+anyivr+anyprobpanel+anyf2f))
dfuse$eachmethodnum <- with(dfuse, as.factor(anyonlineoptin+2*anytext+4*anylivephone+8*anymailemail+16*anyivr+32*anyprobpanel+64*anyf2f))

dfuse$anyonlineoptinIMP <- dfuse$anyonlineoptin
dfuse$anytextIMP <- dfuse$anytext
dfuse$anylivephoneIMP <- dfuse$anylivephone
dfuse$anymailemailIMP <- dfuse$anymailemail
dfuse$anyivrIMP <- dfuse$anyivr
dfuse$anyprobpanelIMP <- dfuse$anyprobpanel
dfuse$anyf2fIMP <- dfuse$anyf2f
dfuse$multimethodindicatorIMP <- dfuse$multimethodindicator
dfuse$eachmethodnumIMP <- dfuse$eachmethodnum

countsval <- .5
dfuse$anyonlineoptinIMP[is.na(dfuse$methodology)] <- with(dfuse[is.na(dfuse$methodology),], (rowSums(data.frame(imp_methodft8_online_opt_in_panel, imp_methodft8_online_ad, imp_methodft8_app_panel, imp_methodft8_online_panel, imp_methodft8_online_matched_sample))-imp_methodft8_probability_panel)>countsval)
dfuse$anytextIMP[is.na(dfuse$methodology)] <- with(dfuse[is.na(dfuse$methodology),], rowSums(data.frame(imp_methodft8_text_to_web, imp_methodft8_text))>countsval)
dfuse$anylivephoneIMP[is.na(dfuse$methodology)] <- with(dfuse[is.na(dfuse$methodology),], imp_methodft8_live_phone>.5)
dfuse$anymailemailIMP[is.na(dfuse$methodology)] <- with(dfuse[is.na(dfuse$methodology),], rowSums(data.frame(imp_methodft8_mail_to_web, imp_methodft8_email, imp_methodft8_mail))>countsval)
dfuse$anyivrIMP[is.na(dfuse$methodology)] <- with(dfuse[is.na(dfuse$methodology),], imp_methodft8_ivr>.5)
dfuse$anyprobpanelIMP[is.na(dfuse$methodology)] <- with(dfuse[is.na(dfuse$methodology),], imp_methodft8_probability_panel>.5)
dfuse$anyf2fIMP[is.na(dfuse$methodology)] <- with(dfuse[is.na(dfuse$methodology),], imp_methodft8_face_to_face>.5)
dfuse$multimethodindicatorIMP[is.na(dfuse$methodology)] <- with(dfuse[is.na(dfuse$methodology),], as.factor(anyonlineoptinIMP+anytextIMP+anylivephoneIMP+anymailemailIMP+anyivrIMP+anyprobpanelIMP+anyf2fIMP))
dfuse$eachmethodnumIMP[is.na(dfuse$methodology)] <- with(dfuse[is.na(dfuse$methodology),], as.factor(anyonlineoptinIMP+2*anytextIMP+4*anylivephoneIMP+8*anymailemailIMP+16*anyivrIMP+32*anyprobpanelIMP+64*anyf2fIMP))
dfuse$anyonlineoptinIMP[is.na(dfuse$multimethodindicatorIMP)] <- dfuse$anytextIMP[is.na(dfuse$multimethodindicatorIMP)] <- dfuse$anylivephoneIMP[is.na(dfuse$multimethodindicatorIMP)] <- dfuse$anymailemailIMP[is.na(dfuse$multimethodindicatorIMP)] <- dfuse$anyivrIMP[is.na(dfuse$multimethodindicatorIMP)] <- dfuse$anyprobpanelIMP[is.na(dfuse$multimethodindicatorIMP)] <- dfuse$anyf2fIMP[is.na(dfuse$multimethodindicatorIMP)] <- dfuse$multimethodindicatorIMP[is.na(dfuse$multimethodindicatorIMP)] <- dfuse$eachmethodnumIMP[is.na(dfuse$multimethodindicatorIMP)] <- NA

dfuse$firmactivein24 <- paste(dfuse$match_name, "2024") %in% dfuse$pollstercycle
dfuse$firmactivein20 <- paste(dfuse$match_name, "2020") %in% dfuse$pollstercycle

#table(dfuse$methodology[dfuse$multimethod==0])


#dfuse$simplifiedrlsample <- NA
#dfuse$simplifiedrlsample[dfuse$rlmethods_sampledrdd %in% c("probably", "definitely")] <- "rdd"
#dfuse$simplifiedrlsample[dfuse$rlmethods_sampledabs %in% c("probably", "definitely")] <- "abs"
#dfuse$simplifiedrlsample[dfuse$rlmethods_panelist %in% c("probably", "definitely")] <- "nonprobability panel"
#dfuse$simplifiedrlsample[dfuse$rlmethods_panelistnonprob %in% c("probably", "definitely")] <- "nonprobability panel"
#dfuse$simplifiedrlsample[dfuse$rlmethods_panelistprob %in% c("probably", "definitely")] <- "probability panel"
#dfuse$simplifiedrlsample[dfuse$rlmethods_sampledemail %in% c("probably", "definitely")] <- "probability panel"
#dfuse$simplifiedrlsample[dfuse$rlmethods_sampledapp %in% c("probably", "definitely")] <- "nonprobability panel"



impconstrainer <- dfuse[,grepl("^imp_", colnames(fs2))]
impconstrainer[impconstrainer>1] <- 1
impconstrainer[impconstrainer<0] <- 0
colnames(impconstrainer) <- gsub("^imp_", "imC_", colnames(impconstrainer))
dfuse <- data.frame(dfuse, impconstrainer)





#stateornat <- rep("State", nrow(dfuse))
#stateornat[dfuse$state=="national"] <- "National"
#dfuse$officebylevel <- paste(dfuse$office, stateornat, sep="_")

stagemin <- dfuse$stage
stagemin[dfuse$stage %in% c("jungle primary", "primary", "caucus")] <- "primary"
stagemin[dfuse$stage %in% c("runoff", "recall", "special")] <- "other"
#dfuse$stagemin <- stagemin

Nsforfilter <- function(filter, data=dfuse){
    tempdf <- data[filter & !is.na(filter),]
    with(tempdf, data.frame(results=nrow(tempdf), surveys=length(na.omit(unique(updatedpollid[data$bestweight>0]))), contests=length(na.omit(unique(contest))), contestpolls=length(na.omit(unique(contestpoll[data$bestweight>0]))), firms=length(na.omit(unique(match_name)))))
}

pastevars <- function(x, y, z=NULL, a=NULL){
    dropcase <- is.na(x) | is.na(y)
    out <- paste(x, y)
    if(!is.null(z)){
        dropcase[is.na(z)] <- TRUE
        out <- paste(out, z)
    }
    if(!is.null(a)){
        dropcase[is.na(a)] <- TRUE
        out <- paste(out, a)
    }
    out[dropcase] <- NA
    out
}

logicaltolab <- function(x, nom){
    out <- rep(NA, length(x))
    out[x==TRUE | x=="true"] <- nom
    out[x==FALSE | x=="false"] <- paste("Not", nom)
    out
}

## Key Variables to Report in Section 3.1


# Results are rows in dfuse, contest-polls are sum of dfuse$bestweight, surveys are unique of dfuse$updatedpollid[dfuse$bestweight>0]


#total="Total", cycle, year, office, stagemin, 
#keycats <- with(dfuse, data.frame(simplifiedmode, simplifiedrlsample, tracking=logicaltolab(fulltracking, "Tracking"), swingstates=logicaltolab(swingstates, "Swing State"), firmtype_university=factor(firmtype_university, 0:1, c("Non-University", "University")), firmtype_media=factor(firmtype_media, 0:1, c("Non-Media", "Media")), firmtype_political=factor(firmtype_political, 0:1, c("Non-Political", "Political")),
#                                  firmtype_corporate=factor(firmtype_corporate, 0:1, c("Non-Corporate", "Corporate")), firmtype_nonpartisan=factor(firmtype_nonpartisan, 0:1, c("PartisanFirm", "NonpartisanFirm")), firmtype_democratic=factor(firmtype_democratic, 0:1, c("Non-DemocraticFirm", "Democraticfirm")), firmtype_republican=factor(firmtype_republican, 0:1, c("Non-RepublicanFirm", "RepublicanFirm")), populationmin, hypothetical=logicaltolab(hypothetical, "Hypothetical"), status,
#                                  AnyOpt=logicaltolab(anyonlineoptin, "AnyOptIn"), AnyText=logicaltolab(anytext, "AnyText"), AnyLivePhone=logicaltolab(anylivephone, "AnyLivePhone"), AnyMailEmail=logicaltolab(anymailemail, "AnyMailEmail"), AnyIVR=logicaltolab(anyivr, "AnyIVR"), AnyProbPanel=logicaltolab(anyprobpanel, "AnyProbPanel"), AnyF2F=logicaltolab(anyf2f, "AnyF2F"), multimethodindicator))
#for(i in 1:length(keycats))
#    keycats[[i]] <- as.factor(keycats[[i]])

dfuse$closerace <- abs(dfuse$votedemminusrep)<.05
dfuse$closestates <- dfuse$closerace & dfuse$office=="president" & dfuse$stateornat!="National" & dfuse$stage=="general"

dfuse$swingstates <- dfuse$closestates
dfuse$swingstates[dfuse$office=="president" & dfuse$stateornat!="National" & dfuse$stage=="general" & dfuse$cycle==2024] <- dfuse$state[dfuse$office=="president" & dfuse$stateornat!="National" & dfuse$stage=="general" & dfuse$cycle==2024] %in% c("arizona", "georgia", "michigan", "nevada", "north carolina", "wisconsin", "pennsylvania")
dfuse$octnov <- ((dfuse$distfromelection<50)*grepl("-10-|-11-", dfuse$month))==1



keycats <- with(dfuse, data.frame(simplifiedmode=dummify(as.factor(simplifiedmode)), simplifiedrlsample=dummify(as.factor(simplifiedrlsample)), swingstates, firmtype_university=(firmtype_university==1), firmtype_media=(firmtype_media==1), firmtype_political=(firmtype_political==1),
                                  firmtype_corporate=(firmtype_corporate==1), firmtype_nonpartisan=(firmtype_nonpartisan==1), firmtype_democratic=(firmtype_democratic==1), firmtype_republican=(firmtype_republican==1), populationmin=dummify(as.factor(populationmin)), hypothetical=(hypothetical=="true"), status=dummify(status),
                                  anyonlineoptin, anytext, anylivephone, anymailemail, anyivr, anyprobpanel, anyf2f, multimethodindicator=(as.numeric(as.character(multimethodindicator))>1)))
for(i in 1:length(keycats))
    if(is.numeric(keycats[[i]]))
        keycats[[i]] <- keycats[[i]]==1

with(dfuse[dfuse$year==2024 & dfuse$office=="president" & dfuse$stage=="general",], table(state, abs(votedemminusrep)<.05))





crosskeys <- with(dfuse, data.frame(total="Total", cycle, stagemin, stateornat, office))
timekeys <- with(dfuse, data.frame(AllTime=TRUE, ElectionYear=(dfuse$year==dfuse$cycle), last2weeks, lastweek, last3days=(distfromelection<3.5), octnov=((distfromelection<50)*grepl("-10-|-11-", dfuse$month))==1))

ckperms2 <- as.data.frame(mclapply(1:(ncol(crosskeys)-1), function(x) as.data.frame(lapply(max(c(x+1, 2)):(ncol(crosskeys)), function(y) pastevars(crosskeys[,x], crosskeys[,y])))))
ckperms3 <- as.data.frame(mclapply(1:(ncol(crosskeys)-2), function(x) as.data.frame(lapply(max(c(x+1, 2)):(ncol(crosskeys)-1), function(y) as.data.frame(lapply((y+1):(ncol(crosskeys)), function(z) pastevars(crosskeys[,x], crosskeys[,y], crosskeys[,z])))))))
ckperms4 <- as.data.frame(mclapply(1:2, function(x) pastevars(crosskeys[,x], pastevars(crosskeys[,3], crosskeys[,4], crosskeys[,5]))))
names(ckperms2) <- as.data.frame(mclapply(1:(ncol(crosskeys)-1), function(x) as.data.frame(lapply(max(c(x+1, 2)):(ncol(crosskeys)), function(y) paste(names(crosskeys)[x], names(crosskeys)[y])))))
names(ckperms3) <- as.data.frame(mclapply(1:(ncol(crosskeys)-2), function(x) as.data.frame(lapply(max(c(x+1, 2)):(ncol(crosskeys)-1), function(y) as.data.frame(lapply((y+1):(ncol(crosskeys)), function(z) paste(names(crosskeys)[x], names(crosskeys)[y], names(crosskeys)[z])))))))
names(ckperms4) <- as.data.frame(mclapply(1:2, function(x) paste(names(crosskeys)[x], names(crosskeys)[3], names(crosskeys)[4], names(crosskeys)[5])))
allckperms <- data.frame(crosskeys, ckperms2, ckperms3, ckperms4)
for(i in 1:length(allckperms))
    allckperms[[i]] <- as.factor(allckperms[[i]])


y <- ckperms4[,2]=="2024 general State president"
f <- timekeys$last3days

table(y, f)

head(with(dfuse, data.frame(contest, bestweight, dfuse$updatedpollid, dfuse$bwkeeps, dfuse$contestpoll)[y & f,]))

xtabs(dfuse$bestweight[f]~y[f])
xtabs(dfuse$bestweight[f]~y[f])

sum(dfuse$bestweight[y & f & !is.na(y) & !is.na(f)], na.rm=TRUE)
sum(dfuse$bestweight[y & f], na.rm=TRUE)
length(na.omit(unique(dfuse$updatedpollid[y & f & !is.na(y) & !is.na(f) & dfuse$bestweight>0])))

keyvars <- allckperms



#glob1 <- data.frame(Results=unlist(mclapply(keyvars, function(y) xtabs(~y))), ContestPolls=unlist(mclapply(keyvars, function(y) xtabs(dfuse$bestweight~y))), Surveys=unlist(mclapply(keyvars, function(x) mclapply(levels(x), function(y) length(unique(dfuse$updatedpollid[dfuse$bestweight>0 & x==y]))))), Firms=unlist(mclapply(keyvars, function(x) mclapply(levels(x), function(y) length(unique(dfuse$match_name[dfuse$bestweight>0 & x==y]))))))
timeglob <- lapply(timekeys, function(f) data.frame(Results=unlist(mclapply(keyvars[f,], function(y) xtabs(~y))), ContestPolls=unlist(mclapply(keyvars[f,], function(y) xtabs(dfuse$bestweight[f]~y))), Surveys=unlist(mclapply(keyvars[f,], function(x) mclapply(levels(x), function(y) length(na.omit(unique(dfuse$updatedpollid[f][dfuse$bwkeeps[f] & x==y & !is.na(x)])))))), Firms=unlist(mclapply(keyvars[f,], function(x) mclapply(levels(x), function(y) length(na.omit(unique(dfuse$match_name[f][dfuse$bwkeeps[f] & x==y & !is.na(x)])))))), Contests=unlist(mclapply(keyvars[f,], function(x) mclapply(levels(x), function(y) length(na.omit(unique(dfuse$contest[f][dfuse$bwkeeps[f] & x==y & !is.na(x)])))))), sp=""))

overallNs <- data.frame(timeglob)

write.csv(overallNs[grepl("Total|2020|2024", rownames(overallNs)) & !grepl("Total 19|Total 200|Total 201", rownames(overallNs)),], "../Report/LinkedResults/Section_3_1/simplenums.csv")


keycatglob <- lapply(keycats, function(k) lapply(timekeys, function(f) data.frame(Results=unlist(mclapply(keyvars[f & k,], function(y) xtabs(~y))), ContestPolls=unlist(mclapply(keyvars[f & k,], function(y) xtabs(dfuse$bestweight[f & k]~y))), Surveys=unlist(mclapply(keyvars[f & k,], function(x) mclapply(levels(x), function(y) length(na.omit(unique(dfuse$updatedpollid[f & k][dfuse$bwkeeps[f & k] & x==y & !is.na(x)])))))), Firms=unlist(mclapply(keyvars[f & k,], function(x) mclapply(levels(x), function(y) length(na.omit(unique(dfuse$match_name[f & k][dfuse$bwkeeps[f & k] & x==y & !is.na(x)])))))), Contests=unlist(mclapply(keyvars[f & k,], function(x) mclapply(levels(x), function(y) length(na.omit(unique(dfuse$contest[f & k][dfuse$bwkeeps[f & k] & x==y & !is.na(x)])))))), sp="")))

statedummies <- as.data.frame(dummify(as.factor(dfuse$state))==1)

statesglob <- lapply(statedummies, function(k) lapply(timekeys, function(f) data.frame(Results=unlist(mclapply(keyvars[f & k,], function(y) xtabs(~y))), ContestPolls=unlist(mclapply(keyvars[f & k,], function(y) xtabs(dfuse$bestweight[f & k]~y))), Surveys=unlist(mclapply(keyvars[f & k,], function(x) mclapply(levels(x), function(y) length(na.omit(unique(dfuse$updatedpollid[f & k][dfuse$bwkeeps[f & k] & x==y & !is.na(x)])))))), Firms=unlist(mclapply(keyvars[f & k,], function(x) mclapply(levels(x), function(y) length(na.omit(unique(dfuse$match_name[f & k][dfuse$bwkeeps[f & k] & x==y & !is.na(x)])))))), Contests=unlist(mclapply(keyvars[f & k,], function(x) mclapply(levels(x), function(y) length(na.omit(unique(dfuse$contest[f & k][dfuse$bwkeeps[f & k] & x==y & !is.na(x)])))))), sp="")))

perkeycatNs <- mclapply(keycatglob, data.frame)
statesNs <- mclapply(statesglob, data.frame)

names(perkeycatNs) <- gsub("rlsample", "rlsamp", gsub("probability", "prob", gsub("\\.|simplified|At\\.least\\.some", "", names(perkeycatNs))))

wbpollingNs <- createWorkbook("InformationOnNumbersOfPolls")

addWorksheet(wbpollingNs, paste0("Overall Ns"))
writeData(wbpollingNs, sheet = "Overall Ns", cbind(variable=rownames(overallNs), (overallNs)))

for(i in names(perkeycatNs)){
    addWorksheet(wbpollingNs, paste0("NsFor", gsub("\\.", "", i)))
    writeData(wbpollingNs, sheet = paste0("NsFor", gsub("\\.", "", i)), cbind(variable=rownames(perkeycatNs[[i]]), (perkeycatNs[[i]])))
}

for(i in names(statesNs)){
    addWorksheet(wbpollingNs, paste0("NsForState", gsub("\\.", "", i)))
    writeData(wbpollingNs, sheet = paste0("NsForState", gsub("\\.", "", i)), cbind(variable=rownames(statesNs[[i]]), (statesNs[[i]])))
}

saveWorkbook(wbpollingNs, "../Report/LinkedResults/Section_3_1/InformationOnNumbersOfPolls.xlsx", overwrite = TRUE)
rm(wbpollingNs)




## Number of interviews per cycle (uses fs2 to capture non-LV estimates)

keepablesamplesizepollspre <- fs2[!is.na(fs2$sample_size),]
keepablesamplesizepolls <- keepablesamplesizepollspre[order(keepablesamplesizepollspre$sample_size*keepablesamplesizepollspre$conservativepollsetweight, decreasing=TRUE),] # get the largest sample size from each poll (in case some things have smaller sample sizes) -- note that bestweight may already downweight these slightly
uniqueinterviewspercycle <- sapply(seq(2000, 2024, 4), function(y) with(keepablesamplesizepolls[!duplicated(keepablesamplesizepolls$updatedpollid) & keepablesamplesizepolls$cycle==y,], sum(sample_size*conservativepollsetweight)))
uniqueinterviewspercycleelectionyear <- sapply(seq(2000, 2024, 4), function(y) with(keepablesamplesizepolls[!duplicated(keepablesamplesizepolls$updatedpollid) & keepablesamplesizepolls$cycle==y & keepablesamplesizepolls$year==y,], sum(sample_size*conservativepollsetweight)))

samps <- data.frame(Cycle=uniqueinterviewspercycle, Year=uniqueinterviewspercycleelectionyear)
rownames(samps) <- seq(2000, 2024, 4)
write.csv(samps, "../Report/LinkedResults/Section_3_2/SampleSizes.csv")


# To calculate proportion of surveys estimated
sum(((dfuse$conservativepollsetweight>0)*(is.na(dfuse$sample_size)))[dfuse$cycle==2024 & !duplicated(dfuse$updatedpollid)])
sum(((keepablesamplesizepollspre$conservativepollsetweight>0)*(!is.na(keepablesamplesizepollspre$sample_size)))[keepablesamplesizepollspre$cycle==2024 & !duplicated(keepablesamplesizepollspre$updatedpollid)])
sum(((keepablesamplesizepollspre$conservativepollsetweight>0)*keepablesamplesizepollspre$sample_size)[keepablesamplesizepollspre$cycle==2024 & !duplicated(keepablesamplesizepollspre$updatedpollid)], na.rm=TRUE)

sum((dfuse$conservativepollsetweight*(is.na(dfuse$sample_size)))[dfuse$cycle==2024 & (!duplicated(dfuse$updatedpollid))])
sum((keepablesamplesizepollspre$conservativepollsetweight*(!is.na(keepablesamplesizepollspre$sample_size)))[keepablesamplesizepollspre$cycle==2024 & !duplicated(keepablesamplesizepollspre$updatedpollid)])
sum((keepablesamplesizepollspre$conservativepollsetweight*keepablesamplesizepollspre$sample_size)[keepablesamplesizepollspre$cycle==2024 & !duplicated(keepablesamplesizepollspre$updatedpollid)], na.rm=TRUE)

sum((dfuse$conservativepollsetweight*(is.na(dfuse$sample_size)))[dfuse$cycle==2020 & !duplicated(dfuse$updatedpollid)])
sum((keepablesamplesizepollspre$conservativepollsetweight*(!is.na(keepablesamplesizepollspre$sample_size)))[keepablesamplesizepollspre$cycle==2020 & !duplicated(keepablesamplesizepollspre$updatedpollid)])
sum((keepablesamplesizepollspre$conservativepollsetweight*keepablesamplesizepollspre$sample_size)[keepablesamplesizepollspre$cycle==2020 & !duplicated(keepablesamplesizepollspre$updatedpollid)], na.rm=TRUE)



# Load counties and extract centroids
#states <- states(cb = TRUE, year = 2020)  # Use cb = TRUE for simplified shapes
statesdf <- as.data.frame(sf::st_read("tl_2024_us_state/tl_2024_us_state.shp"))
statesdf$lat <- as.numeric(gsub("+", "", statesdf$INTPTLAT))
statesdf$long <- as.numeric(gsub("+", "", statesdf$INTPTLON))

#manualshifts
statesdf$lat[statesdf$NAME=="Michigan"] <- statesdf$lat[statesdf$NAME=="Michigan"]-1.5
statesdf$lat[statesdf$NAME=="Massachusetts"] <- statesdf$lat[statesdf$NAME=="Massachusetts"]+.5
statesdf$lat[statesdf$NAME=="Vermont"] <- statesdf$lat[statesdf$NAME=="Vermont"]+1
statesdf$long[statesdf$NAME=="Michigan"] <- statesdf$long[statesdf$NAME=="Michigan"]+.5
statesdf$long[statesdf$NAME=="Maine"] <- statesdf$long[statesdf$NAME=="Maine"]-.5
statesdf$long[statesdf$NAME=="Florida"] <- statesdf$long[statesdf$NAME=="Florida"]+.5
statesdf$long[statesdf$NAME=="Delaware"] <- statesdf$long[statesdf$NAME=="Delaware"]+.25
statesdf$lat[statesdf$NAME=="Maryland"] <- statesdf$lat[statesdf$NAME=="Maryland"]+.5
statesdf$lat[statesdf$NAME=="Connecticut"] <- statesdf$lat[statesdf$NAME=="Connecticut"]+.5
statesdf$lat[statesdf$NAME=="West Virginia"] <- statesdf$lat[statesdf$NAME=="West Virginia"]+.5



dfuse$officestage <- gsub("caucus", "primary", gsub("jungle ", "", paste(dfuse$office, dfuse$stage)))
dfuse$officestage[is.na(dfuse$office)] <- NA
dfuse$officestage[is.na(dfuse$stage)] <- NA
dfuse$officestage[grepl("other office", dfuse$officestage)] <- NA
dfuse$statemin <- gsub(" cd-1| cd-2| cd-3", "", dfuse$state)
dfuse$statemin[grepl("puerto|islands", dfuse$state)] <- NA
stateNtypespre <- with(dfuse[dfuse$cycle==2024,], as.matrix(xtabs(bestweight~officestage+statemin)))
stateNtypes <- t(stateNtypespre)

sossortpre <- stateNtypes[,order(colSums(stateNtypes), decreasing=TRUE)]
sossort <- sossortpre[,colSums(sossortpre)>10]

stateNtypesprecalyr <- with(dfuse[dfuse$cycle==2024 & dfuse$year==2024,], as.matrix(xtabs(bestweight~officestage+statemin)))
stateNtypescalyr <- t(stateNtypesprecalyr)

sossortcalpre <- stateNtypescalyr[,order(colSums(stateNtypes), decreasing=TRUE)]
sossortcal <- sossortcalpre[,colSums(sossortpre)>10]


pdf("../Report/LinkedResults/Section_3_2/2024SurveysByLocationTypeOLD.pdf", width=12, height=8)
colman1 <- brewer.pal(ncol(sossort), "Set2")
colman2 <- brewer.pal(ncol(sossort), "Dark2")
map('state', xlim=c(-131, -65), ylim=c(23, 52))
for(i in tolower(statesdf$NAME)){
    if(i %in% rownames(sossort)){
        stlat <- statesdf$lat[tolower(statesdf$NAME)==i]
        stlong <- statesdf$long[tolower(statesdf$NAME)==i]
        segments(stlong-1, stlat-.5, stlong+1.5, stlat-.5, lwd=.5, col="gray")
        segments(seq(stlong-1, stlong+1.5, length.out=ncol(sossort)), stlat-.5, seq(stlong-1, stlong+1.5, length.out=ncol(sossort)), stlat-.5+(sossort[i,]/65), col=colman1, lwd=(3*(sossort[i,]>0)), density=50, angle=45)
        segments(seq(stlong-1, stlong+1.5, length.out=ncol(sossort)), stlat-.5, seq(stlong-1, stlong+1.5, length.out=ncol(sossort)), stlat-.5+(sossortcal[i,]/65), col=colman2, lwd=(3*(sossortcal[i,]>0)))
    }
    segments(-128, 24.5, -126, 24.5, lwd=.5, col="gray")
    segments(-128.5, 24.5+seq(250, 1250, 250)/65, -125.5, 24.5+seq(250, 1250, 250)/65, lwd=.5, lty=3, col="gray")
    text(-128.5, 24.5+seq(0, 1250, 250)/65, seq(0, 1250, 250), pos=2, cex=.7)
    segments(seq(-128, -126, length.out=ncol(sossort)), 24.5, seq(-128, -126, length.out=ncol(sossort)), 24.5+(sossort["national",]/65), col=colman1, lwd=(3*(sossort["national",]>0)))
    segments(seq(-128, -126, length.out=ncol(sossort)), 24.5, seq(-128, -126, length.out=ncol(sossort)), 24.5+(sossortcal["national",]/65), col=colman2, lwd=(3*(sossortcal["national",]>0)))
}
text(-124, 25, "National")
legend(x="bottom", str_to_title(colnames(sossort)), col=colman2, lwd=3, cex=.7, horiz=TRUE, bg="white")
dev.off()
write.csv(sossortcal, "../Report/LinkedResults/Section_3_2/2024SurveysByLocationType.csv")

#jpeg("../Report/LinkedResults/Section_3_2/2024SurveysByLocationType.jpg", width=12, height=8, units="in", res=1#200)
#colman <- brewer.pal(ncol(sossort), "Dark2")
#map('state', xlim=c(-131, -65), ylim=c(23, 52), main="Number of 2024 Election Surveys Conducted By Location Surveyed and Election Type")
#map('state', regions=c("michigan", "pennsylvania", "wisconsin", "georgia", "arizona", "north carolina", "nevada"), col="gray92", add=TRUE, fill=TRUE)
#for(i in tolower(statesdf$NAME)){
#    if(i %in% rownames(sossort)){
#        stlat <- statesdf$lat[tolower(statesdf$NAME)==i]
#        stlong <- statesdf$long[tolower(statesdf$NAME)==i]
#        segments(stlong-.75, stlat-.5, stlong+1.25, stlat-.5, lwd=.5, col="gray")
#        segments(seq(stlong-.75, stlong+1.25, length.out=ncol(sossort)), stlat-.5, seq(stlong-.75, stlong+1.25, length.out=ncol(sossort)), stlat-.5+(sossort[i,]/65), col=colman1, lwd=(3*(sossort[i,]>0)))
#        segments(seq(stlong-.75, stlong+1.25, length.out=ncol(sossort)), stlat-.5, seq(stlong-.75, stlong+1.25, length.out=ncol(sossort)), stlat-.5+(sossortcal[i,]/65), col=colman2, lwd=(3*(sossortcal[i,]>0)))
#    }
#}
#segments(-128, 24.5, -126, 24.5, lwd=.5, col="gray")
#segments(-128.5, 24.5+seq(250, 1250, 250)/65, -125.5, 24.5+seq(250, 1250, 250)/65, lwd=.5, lty=3, col="gray")
#text(-128.5, 24.5+seq(0, 1250, 250)/65, seq(0, 1250, 250), pos=2, cex=.7)
#segments(seq(-128, -126, length.out=ncol(sossort)), 24.5, seq(-128, -126, length.out=ncol(sossort)), 24.5+(sossort["national",]/65), col=colman1, lwd=(3*(sossort["national",]>0)))
#segments(seq(-128, -126, length.out=ncol(sossort)), 24.5, seq(-128, -126, length.out=ncol(sossort)), 24.5+(sossortcal["national",]/65), col=colman2, lwd=(3*(sossortcal["national",]>0)))
#text(-124, 25, "National")
#legend(x="bottom", str_to_title(colnames(sossort)), col=colman2, lwd=3, cex=.7, horiz=TRUE, bg="white")
#dev.off()

jpeg("../Report/LinkedResults/Section_3_2/2024SurveysByLocationType.jpg", width=12, height=8, units="in", res=1200)
colman <- brewer.pal(ncol(sossort), "Dark2")
map('state', xlim=c(-131, -65), ylim=c(23, 52), main="Number of 2024 Election Surveys Conducted By Location Surveyed and Election Type")
map('state', regions=c("michigan", "pennsylvania", "wisconsin", "georgia", "arizona", "north carolina", "nevada"), col="gray92", add=TRUE, fill=TRUE)
for(i in tolower(statesdf$NAME)){
    if(i %in% rownames(sossort)){
        stlat <- statesdf$lat[tolower(statesdf$NAME)==i]
        stlong <- statesdf$long[tolower(statesdf$NAME)==i]
        segments(stlong-1.2, stlat-.5, stlong+1.7, stlat-.5, lwd=.5, col="gray")
        edges <- seq(-1.2, +1.37, length.out=(ncol(sossort)+1))
        for(j in 1:ncol(sossort)){
            polygon(x=(stlong+c(edges[j], edges[j], edges[j+1], edges[j+1])), y=(stlat+c(-.5, -.5+(sossort[i,j]/65), -.5+(sossort[i,j]/65), -.5)), col=colman1[j], lwd=.25)
            polygon(x=(stlong+c(edges[j], edges[j], edges[j+1], edges[j+1])), y=(stlat+c(-.5, -.5+(sossortcal[i,j]/65), -.5+(sossortcal[i,j]/65), -.5)), col=colman2[j], lwd=.25)
            polygon(x=(-127+c(edges[j], edges[j], edges[j+1], edges[j+1])), y=(24.5+c(0, (sossort["national",j]/65), (sossort["national",j]/65), 0)), col=colman1[j], lwd=.25)
            polygon(x=(-127+c(edges[j], edges[j], edges[j+1], edges[j+1])), y=(24.5+c(0, (sossortcal["national",j]/65), (sossortcal["national",j]/65), 0)), col=colman2[j], lwd=.25)
        }
    }
}
segments(-128, 24.5, -126, 24.5, lwd=.5, col="gray")
segments(-128.5, 24.5+seq(250, 1250, 250)/65, -125.5, 24.5+seq(250, 1250, 250)/65, lwd=.5, lty=3, col="gray")
text(-128.5, 24.5+seq(0, 1250, 250)/65, seq(0, 1250, 250), pos=2, cex=.7)
text(-123.5, 25, "National")
legend(x="bottom", str_to_title(colnames(sossort)), fill=colman2, cex=.8, horiz=TRUE, bg="white")
dev.off()




# Dynamic Data Export for Plotting in Shiny
# List of years to include (federal election years)
years <- sort(na.omit(unique(dfuse$cycle)))

# Prepare export object
master_offices <- names(sort(tapply(dfuse$bestweight, dfuse$officestage, sum, na.rm=TRUE), decreasing=TRUE))
sossort_list <- list()
for (yr in years) {
  stateNtypes <- with(dfuse[dfuse$cycle == yr, ], as.matrix(xtabs(bestweight ~ officestage + statemin)))
  stateNtypescalyr <- with(dfuse[dfuse$cycle == yr & dfuse$year == yr, ], as.matrix(xtabs(bestweight ~ officestage + statemin)))
  shared_cols <- intersect(colnames(t(stateNtypes)), colnames(t(stateNtypescalyr)))
  shared_cols <- shared_cols[colSums(t(stateNtypes)[, shared_cols, drop=FALSE]) > 10]
  sossortpre <- t(stateNtypes)[, shared_cols, drop = FALSE]
  sossortcalpre <- t(stateNtypescalyr)[, shared_cols, drop = FALSE]
# Reorder columns by master_offices
  reorder_cols <- intersect(master_offices, colnames(sossortpre))
  sossortpre <- sossortpre[, reorder_cols, drop = FALSE]
  sossortcalpre <- sossortcalpre[, reorder_cols, drop = FALSE]
  # Pad sossortcalpre with zeros if needed to match rownames
  missing_rows <- setdiff(rownames(sossortpre), rownames(sossortcalpre))
  if (length(missing_rows) > 0) {
    fill_mat <- matrix(0, nrow = length(missing_rows), ncol = ncol(sossortcalpre),
                       dimnames = list(missing_rows, colnames(sossortcalpre)))
    sossortcalpre <- rbind(sossortcalpre, fill_mat)
  }
  sossortcalpre <- sossortcalpre[rownames(sossortpre), , drop = FALSE]  # ensure row order match
  sossort_list[[as.character(yr)]] <- list(
    sossort = sossortpre,
    sossortcal = sossortcalpre
  )
}
save(sossort_list, statesdf, file = "Interactive/fig_3_2_1/sossort_list.RData")




#keyvarscheckertry <- with(dfuse, data.frame(cycle, year, bestweight, officestage, statemin))




#            polygon(x=(stlong+c(edges[j], edges[j], edges[j+1], edges[j+1])), y=(stlat+c(-.5, -.5+(sossort[i,j]/65), -.5+(sossort[i,j]/65), -.5)), col=colman1[j], lwd=.25)
 #           polygon(x=(stlong+c(edges[j], edges[j], edges[j+1], edges[j+1])), y=(stlat+c(-.5, -.5+(sossortcal[i,j]/65), -.5+(sossortcal[i,j]/65), -.5)), col=colman2[j], lwd=.25)




    #
  #      segments(seq(stlong-.75, stlong+1.25, length.out=ncol(sossort)), stlat-.5, seq(stlong-.75, stlong+1.25, length.out=ncol(sossort)), stlat-.5+(sossort[i,]/65), col=colman1, lwd=(3*(sossort[i,]>0)))
                                        #        segments(seq(stlong-.75, stlong+1.25, length.out=ncol(sossort)), stlat-.5, seq(stlong-.75, stlong+1.25, length.out=ncol(sossort)), stlat-.5+(sossortcal[i,]/65), col=colman2, lwd=(3*(sossortcal[i,]>0)))

#segments(seq(-128, -126, length.out=ncol(sossort)), 24.5, seq(-128, -126, length.out=ncol(sossort)), 24.5+(sossort["national",]/65), col=colman1, lwd=(3*(sossort["national",]>0)))
#segments(seq(-128, -126, length.out=ncol(sossort)), 24.5, seq(-128, -126, length.out=ncol(sossort)), 24.5+(sossortcal["national",]/65), col=colman2, lwd=(3*(sossortcal["national",]>0)))


rownames(sossort)[sossort[,1]!=apply(sossort, 1, max)]




## Volume of Polls By Type Throughout the Cycle

dfuse$officestageplsnat <- gsub("caucus", "primary", gsub("jungle ", "", dfuse$officestage))
dfuse$officestageplsnat[dfuse$stateornat=="National"] <- paste("national", dfuse$officestage[dfuse$stateornat=="National"])
dfuse$officestageplsnat[dfuse$stateornat!="National" & grepl("president", dfuse$officestage)] <- paste("state", dfuse$officestage[dfuse$stateornat!="National" & grepl("president", dfuse$officestage)])

officefreqspre <- wtd.table(dfuse$officestageplsnat, dfuse$bestweight)
officefreqs <- officefreqspre$sum.of.weights
names(officefreqs) <- officefreqspre$x
officefreqsord <- rev(sort(officefreqs))

dfuse$distfromelectionrev <- 0-dfuse$distfromelection
dfuse$distfromelectionrev[dfuse$distfromelection<0] <- NA

eventbars <- c('2024 Begins'="2024-01-01", 'Iowa Caucus'="2024-01-15", 'Trump Presumptive Nominee'="2024-03-12", 'Trump Guilty Verdict'="2024-05-30", 'First Debate'="2024-06-27", 'Trump Assasination Attempt'="2024-07-13", 'Harris Replaces Biden'="2024-07-22", 'Second Debate'="2024-09-10")

ebdists <- as.Date(eventbars)-as.Date("2024-11-05")

jpeg("../Report/LinkedResults/Section_3_2/2024DistToElection.jpg", width=10, height=7, units="in", res=1200)
par(mfrow=c(2,3))
for(i in (names(officefreqsord)[1:5])){
    with(dfuse[dfuse$cycle==2024 & dfuse$distfromelection<365 & dfuse$distfromelection>0 & (dfuse$officestageplsnat==i),], wtd.hist(distfromelectionrev, weight=bestweight, breaks=seq(-371, 0, 7)+.5, xlab="Distance From Election", ylab="Number of Matchups Reported", main=paste(str_to_title(i)), col="gray", ylim=c(0,175)))
    abline(v=ebdists, col="dark green")
    abline(v=0, col="red")
    text(ebdists+4+c(rep(0, 6), 14,0), 175, names(ebdists), srt=90, pos=2, cex=.7)
    text(0, 175, "Election Day", srt=90, pos=2, cex=.7)
    with(dfuse[dfuse$cycle==2024 & dfuse$distfromelection<365 & dfuse$distfromelection>0 & (dfuse$officestageplsnat==i),], wtd.hist(distfromelectionrev, weight=bestweight, breaks=seq(-371, 0, 7)+.5, xlab="Distance From Election", ylab="Number of Matchups Reported", main=paste(str_to_title(i)), col="gray", ylim=c(0,175), add=TRUE))
    }
dev.off()


monthofficetypes24pre <- with(dfuse[dfuse$cycle==2024,], xtabs(bestweight~gsub("caucus", "primary", officestageplsnat)+month))
mot24pre <- as.data.frame.matrix(t(monthofficetypes24pre[order(rowSums(monthofficetypes24pre), decreasing=TRUE),]))
mot24 <- mot24pre[as.Date(rownames(mot24pre))>as.Date("2020-10-01"),]

omon <- mot24

logomon <- log(omon+2)
logomon[omon==0] <- NA
i <- 1
logaxispre <- c(0, 1, 2, 5, 10, 20, 50, 100, 200, 500)
logaxis <- log(logaxispre+2)

jpeg("../Report/LinkedResults/Section_3_2/2024cyclemonthlypollsbytype.jpg", width=10, height=7, units="in", res=1200)
newcolset <- brewer.pal(ncol(omon), "Dark2")
plot(range(as.Date(rownames(omon))), range(cbind(log(2), logomon), na.rm=TRUE), type="n", ylab="Monthly Polls Fielded (log scale)", xlab="Date", main="Monthly Polls by Type", axes=FALSE)
axis(1, as.numeric(as.Date(rownames(omon))), labels=rep("", nrow(omon)))
axis(1, as.numeric(as.Date(rownames(omon)))[grepl("-11-|-02-|-05-|-08-", rownames(omon))], format(as.Date(rownames(omon))[grepl("-11-|-02-|-05-|-08-", rownames(omon))], "%b-%y"))
axis(1, as.numeric(as.Date(rownames(omon)))[grepl("-01-", rownames(omon))], rep("", 5), lwd=2)
axis(2, logaxis, logaxispre, las=2)
abline(h=logaxis, lty=3, col="light gray")
for(i in 1:ncol(logomon))
    lines(as.Date(rownames(logomon)), logomon[,i], type="b", lwd=1, col=newcolset[i], pch=14+i, cex=.7)
legend(x="topleft", str_to_title(colnames(omon)), col=newcolset, pch=15:(14+ncol(omon)), lwd=2, bg="white")
dev.off()

write.csv(omon, "../Report/LinkedResults/Section_3_2/2024cyclemonthlypollsbytype.csv")


## Number of polls per firm
pollstervolumespre <- with(dfuse[dfuse$cycle==2024,], as.matrix(xtabs(bestweight~match_name+year)))


pollstervolumespre <- with(dfuse[dfuse$cycle==2024 & dfuse$office=="president",], as.matrix(xtabs(bestweight~match_name+year)))
pollstervolumespre <- with(dfuse[dfuse$year==2024 & dfuse$office=="president",], as.matrix(xtabs(bestweight~match_name+year)))
pollstervolumes <- pollstervolumespre[rowSums(pollstervolumespre)>0,]
pv <- rev(sort(pollstervolumes))
summary(pv)

rm(pollstervolumespre)


yearvol2024pre <- as.vector(with(dfuse[dfuse$year==2024 & dfuse$office=="president",], as.matrix(xtabs(bestweight~match_name))))
yearvol2024 <- yearvol2024pre[yearvol2024pre>0]

jpeg("../Report/LinkedResults/Section_3_2/NumberofPollsByPollster2024Year.jpg", width=12, height=8, units="in", res=1200)
hist(yearvol2024, breaks=seq(-.5, 309.5, 5), xlab="Number of Presidential Matchups Reported", ylab="Number of Polling Firms", main="Presidential Polls Conducted by Firms in 2024")
dev.off()

mean(yearvol2024)
median(yearvol2024)
range(yearvol2024)
quantile(yearvol2024, .75)

## Firm Types

ftypes <- c("firmtype_university", "firmtype_media", "firmtype_political", "firmtype_corporate", "firmtype_nonpartisan", "firmtype_democratic", "firmtype_republican")

ftypessets <- c(list(Overall=timeglob), keycatglob[ftypes])
cycletotals24firmtypes <- lapply(ftypessets, function(g) sapply(g, function(x) x["cycle.2024",]))


firmkeymat <- sapply(cycletotals24firmtypes, function(x) x[c("Results", "ContestPolls", "Surveys", "Firms", "Contests"), "AllTime"])[,-1]
fkm <- apply(firmkeymat, 2, as.numeric)
rownames(fkm) <- c("Results", "Matchups", "Polls", "Firms", "Contests")
colnames(fkm) <- c("University", "Media", "Political", "Corporate", "Nonpartisan", "Democratic", "Republican")

bigbrew <- c(brewer.pal(8, "Set2"), brewer.pal(8, "Set1"), brewer.pal(8, "Set3"))

jpeg("../Report/LinkedResults/Section_3_2/NumberofPollsByFirmType2024Cycle.jpg", width=20, height=7, units="in", res=1200)
par(mfrow=c(1,2))
barplot(fkm[1:3,], beside=TRUE, col=bigbrew[1:3], ylab="Number of Reports/Matchups/Surveys", xlab="Firm Type", legend=TRUE)
abline(h=seq(0,10000, 2000), col="gray")
barplot(fkm[1:3,], beside=TRUE, col=bigbrew[1:3], ylab="Number of Reports/Matchups/Surveys", xlab="Firm Type", legend=TRUE, add=TRUE, args.legend=c(bg="white"))
barplot(fkm[4:5,], beside=TRUE, col=bigbrew[4:5], ylab="Number of Firms/Contests Polled", xlab="Firm Type", legend=TRUE, ylim=c(0,250))
abline(h=seq(0,1000, 50), col="gray")
barplot(fkm[4:5,], beside=TRUE, col=bigbrew[4:5], ylab="Number of Firms/Contests Polled", xlab="Firm Type", legend=TRUE, add=TRUE, args.legend=c(bg="white"))
dev.off()


wbpollingfirmtypeNs <- createWorkbook("FirmTypeNs")
for(i in names(cycletotals24firmtypes)){
    addWorksheet(wbpollingfirmtypeNs, paste0("NsFor", gsub("\\.", "", i)))
    writeData(wbpollingfirmtypeNs, sheet = paste0("NsFor", gsub("\\.", "", i)), cbind(variable=rownames(cycletotals24firmtypes[[i]]), (cycletotals24firmtypes[[i]])))
}
saveWorkbook(wbpollingfirmtypeNs, "../Report/LinkedResults/Section_3_2/PollsByFirmTypes.xlsx", overwrite = TRUE)
rm(wbpollingfirmtypeNs)

## WHEN DID FIRMS USED THIS CYCLE START SURVEYING?

cyclefirm <- as.data.frame.matrix(xtabs(dfuse$bestweight~dfuse$cycle+dfuse$match_name))
yearfirm <- as.data.frame.matrix(xtabs(dfuse$bestweight~dfuse$year+dfuse$match_name))

firstcycles <- as.numeric(as.character(apply(cyclefirm, 2, function(x) rownames(cyclefirm)[x>0][1])))
firstyears <- as.numeric(as.character(apply(yearfirm, 2, function(x) rownames(yearfirm)[x>0][1])))
names(firstcycles) <- colnames(cyclefirm)
names(firstyears) <- colnames(yearfirm)


sum(cyclefirm["2024",]>0)

table(cut(as.numeric(firstcycles), c(0, 2016.5, 2020.5, 3000))[cyclefirm["2024",]>0])
wpct(cut(as.numeric(firstcycles), c(0, 2016.5, 2020.5, 3000))[cyclefirm["2024",]>0])


# Proportions of poll-cycles in groups
wtd.table(cut(as.numeric(firstyears), c(0, 2016.5, 2020.5, 3000)), yearfirm["2024",])

wpct(cut(as.numeric(firstyears), c(0, 2016.5, 2020.5, 3000)), yearfirm["2024",])

table(cyclefirm["2020",]>0, as.numeric(cyclefirm["2024",]>0))

firmstarts2024 <- table(firstcycles[cyclefirm["2024",]>0])

firmstartspercycle <- mclapply(rownames(cyclefirm), function(x) as.data.frame(t(as.matrix(table(firstcycles[cyclefirm[x,]>0])))))
firmstartsperyear <- mclapply(rownames(cyclefirm), function(x) as.data.frame(t(as.matrix(table(firstyears[cyclefirm[x,]>0])))))
names(firmstartsperyear) <- names(firmstartspercycle) <- rownames(cyclefirm)

startcycles <- as.data.frame(rbindlist(firmstartspercycle, fill=TRUE))
startyears <- as.data.frame(rbindlist(firmstartsperyear, fill=TRUE))

rownames(startcycles) <- rownames(startyears) <- paste("Cycle", rownames(cyclefirm))

wbpollingfirmcycles <- createWorkbook("FirmInformation")

addWorksheet(wbpollingfirmcycles, paste0("FirstCycle"))
writeData(wbpollingfirmcycles, sheet = "FirstCycle", cbind(variable=rownames(startcycles), (startcycles)))

addWorksheet(wbpollingfirmcycles, paste0("FirstYear"))
writeData(wbpollingfirmcycles, sheet = "FirstYear", cbind(variable=rownames(startyears), (startyears)))

saveWorkbook(wbpollingfirmcycles, "../Report/LinkedResults/Section_3_2/FirmStartCyclesYears.xlsx", overwrite = TRUE)

rm(wbpollingfirmcycles)


## Data collection methods used (out of all 2024 polls)

allmethodvarspre <- with(dfuse, data.frame(anyonlineoptin, anytext, anylivephone, anyivr, anymailemail, anyprobpanel, anyf2f, multiple=(as.numeric(as.character(multimethodindicator))>1), morethan2=(as.numeric(as.character(multimethodindicator))>2)))

method24varspre <- allmethodvarspre[dfuse$cycle==2024 & dfuse$year==2024 & !is.na(dfuse$methodology),]
method24vars <- method24varspre[,colSums(method24varspre)>0]

methods24 <- sapply(method24vars, function(m) with(dfuse[dfuse$cycle==2024 & dfuse$year==2024 & !is.na(dfuse$methodology),], xtabs(bestweight~m)))
methods24
colSums(methods24)
methods24[2,]/colSums(methods24)


methods24bymult <- lapply(method24vars, function(m) with(dfuse[dfuse$cycle==2024 & dfuse$year==2024 & !is.na(dfuse$methodology),], xtabs(bestweight~m+method24vars$multiple)))
lapply(methods24bymult, function(x) x/sum(x))

method24varsprelast2 <- allmethodvarspre[dfuse$cycle==2024 & dfuse$year==2024 & !is.na(dfuse$methodology) & dfuse$last2weeks,]
method24varslast2 <- method24varsprelast2[,colSums(method24varsprelast2)>0]

methods24last2 <- sapply(method24varslast2, function(m) with(dfuse[dfuse$cycle==2024 & dfuse$year==2024 & !is.na(dfuse$methodology) & dfuse$last2weeks,], xtabs(bestweight~m)))
methods24last2
colSums(methods24last2)
methods24last2[2,]/colSums(methods24last2)

methods24last2bymult <- lapply(method24varslast2, function(m) with(dfuse[dfuse$cycle==2024 & dfuse$year==2024 & !is.na(dfuse$methodology) & dfuse$last2weeks,], xtabs(bestweight~m+method24varslast2$multiple)))
lapply(methods24last2bymult, function(x) x/sum(x))


methodrankorder <- c("anyf2f", "anyprobpanel", "anylivephone", "anyonlineoptin", "anytext", "anymailemail", "anyivr")
methodranknames <- c("Face To Face", "Probability Panel", "Live Phone", "Opt-In Online", "Text", "Mail_Email", "IVR")
primarymethod <- apply(allmethodvarspre[,methodrankorder], 1, function(x) methodranknames[x][1])
primarymethod <- factor(primarymethod, c("Probability Panel", "Text", "Face To Face", "Opt-In Online", "Mail_Email", "Live Phone", "IVR"))
secondarymethod <- apply(allmethodvarspre[,methodrankorder], 1, function(x) c(methodranknames[x], "Only")[2])
othermethods <- apply(allmethodvarspre[,methodrankorder], 1, function(x) paste(c(methodranknames[x], "", "")[3:max(c(sum(x, na.rm=TRUE), 3))], collapse="/"))
othermethods[(secondarymethod %in% c("Live Phone", "Opt-In Online")) & othermethods!=""] <- "+ Other Methods"
fulladdmethods <- gsub("\\/\\+", " + ", gsub("\\/$", "", paste(secondarymethod, othermethods, sep="/")))
fulladdmethods[grepl("\\/", fulladdmethods)] <- "Other Methods"



## reset to 2024 for this


## Build a donut plot for Methods Used

source("doughnutplot.r")

dfinnersetpre <- as.data.frame(xtabs(dfuse$bestweight~primarymethod, subset=(dfuse$cycle==2024 & dfuse$year==2024 & !is.na(dfuse$methodology))))
dfinnerset <- dfinnersetpre[dfinnersetpre$Freq>0,]
dfsummerpre <- as.data.frame(xtabs(dfuse$bestweight~fulladdmethods+primarymethod, subset=(dfuse$cycle==2024 & dfuse$year==2024 & !is.na(dfuse$methodology))))
dfsummer <- dfsummerpre[dfsummerpre$Freq>0,]

dfinnersetnatprespre <- as.data.frame(xtabs(dfuse$bestweight~primarymethod, subset=(dfuse$cycle==2024 & dfuse$year==2024 & !is.na(dfuse$methodology) & dfuse$stateornat=="National" & dfuse$office=="president")))
dfinnersetnatpres <- dfinnersetnatprespre[dfinnersetnatprespre$Freq>0,]
dfsummerprenatpres <- as.data.frame(xtabs(dfuse$bestweight~fulladdmethods+primarymethod, subset=(dfuse$cycle==2024 & dfuse$year==2024 & !is.na(dfuse$methodology) & dfuse$stateornat=="National" & dfuse$office=="president")))
dfsummernatpres <- dfsummerprenatpres[dfsummerprenatpres$Freq>0,]

dfinnersetstateprespre <- as.data.frame(xtabs(dfuse$bestweight~primarymethod, subset=(dfuse$cycle==2024 & dfuse$year==2024 & !is.na(dfuse$methodology) & dfuse$stateornat=="State" & dfuse$office=="president")))
dfinnersetstatepres <- dfinnersetstateprespre[dfinnersetstateprespre$Freq>0,]
dfsummerprestatepres <- as.data.frame(xtabs(dfuse$bestweight~fulladdmethods+primarymethod, subset=(dfuse$cycle==2024 & dfuse$year==2024 & !is.na(dfuse$methodology) & dfuse$stateornat=="State" & dfuse$office=="president")))
dfsummerstatepres <- dfsummerprestatepres[dfsummerprestatepres$Freq>0,]

methcol <- as.numeric(as.factor(dfinnerset$primarymethod))
secondmethcolnames <- as.character(dfsummer$fulladdmethods)
secondmethcolnames[dfsummer$fulladdmethods=="Only"] <- as.character(dfsummer$primarymethod)[dfsummer$fulladdmethods=="Only"]
secondmethcolnums <- as.numeric(factor(secondmethcolnames, unique(c(levels(as.factor(dfinnerset$primarymethod)), unique(secondmethcolnames)))))

methcolnatpres <- as.numeric(factor(dfinnersetnatpres$primarymethod, levels=levels(dfinnerset$primarymethod)))
methcolstatepres <- as.numeric(factor(dfinnersetstatepres$primarymethod, levels=levels(dfinnerset$primarymethod)))
secondmethcolnamesnat <- as.character(dfsummernatpres$fulladdmethods)
secondmethcolnamesnat[dfsummernatpres$fulladdmethods=="Only"] <- as.character(dfsummernatpres$primarymethod)[dfsummernatpres$fulladdmethods=="Only"]
secondmethcolnamesnatfac <- factor(secondmethcolnamesnat, unique(c(levels(as.factor(dfinnerset$primarymethod)), unique(secondmethcolnames))))
secondmethcolnumsnat <- as.numeric(secondmethcolnamesnatfac)

secondmethcolnamesstate <- as.character(dfsummerstatepres$fulladdmethods)
secondmethcolnamesstate[dfsummerstatepres$fulladdmethods=="Only"] <- as.character(dfsummerstatepres$primarymethod)[dfsummerstatepres$fulladdmethods=="Only"]
secondmethcolnumsstate <- as.numeric(factor(secondmethcolnamesstate, unique(c(levels(as.factor(dfinnerset$primarymethod)), unique(secondmethcolnames)))))

## Build the actual plots
bigbrew <- c(brewer.pal(8, "Set2"), brewer.pal(8, "Set1"), brewer.pal(8, "Set3"))
darkbrew <- c(brewer.pal(8, "Dark2"), brewer.pal(8, "Set1"), brewer.pal(8, "Set3"))

# Which labels to put inside (less than 7% in category)
labposinner <- rep("on", nrow(dfinnerset))
labposinner[(dfinnerset$Freq/sum(dfinnerset$Freq))<.07] <- "inner"
labposinnernat <- rep("on", nrow(dfinnersetnatpres))
labposinnernat[(dfinnersetnatpres$Freq/sum(dfinnersetnatpres$Freq))<.07] <- "inner"
labposinnerstate <- rep("on", nrow(dfinnersetstatepres))
labposinnerstate[(dfinnersetstatepres$Freq/sum(dfinnersetstatepres$Freq))<.07] <- "inner"

secondarymethodwithpcts <- gsub("w\\/ Only", "Only", paste0("w/ ", gsub("  ", " ", gsub("_", "/", as.character(dfsummer$fulladdmethods))), " (", rd(100*(dfsummer$Freq/sum(dfsummer$Freq)), 1), "%)"))
secondarymethodwithpctsnat <- gsub("w\\/ Only", "Only", paste0("w/ ",  gsub("\\+", "\n+", gsub("  ", " ", gsub("_", "/", as.character(dfsummernatpres$fulladdmethods)))), " (", rd(100*(dfsummernatpres$Freq/sum(dfsummernatpres$Freq)), 1), "%)"))
secondarymethodwithpctsstate <- gsub("w\\/ Only", "Only", paste0("w/ ", gsub("\\+", "\n+", gsub("  ", " ", gsub("_", "/", as.character(dfsummerstatepres$fulladdmethods)))), " (", rd(100*(dfsummerstatepres$Freq/sum(dfsummerstatepres$Freq)), 1), "%)"))

titlemoveup2 <- (dfsummer$fulladdmethods=="IVR" & dfsummer$primarymethod=="Live Phone")
#titlemoveup1 <- (dfsummer$fulladdmethods=="Only" & dfsummer$primarymethod=="IVR")
titlemovedown1 <- (dfsummer$fulladdmethods=="Only" & dfsummer$primarymethod=="Text") | (dfsummer$fulladdmethods=="Mail_Email" & dfsummer$primarymethod=="Text") | (dfsummer$fulladdmethods=="Other Methods" & dfsummer$primarymethod=="Text") | (dfsummer$fulladdmethods=="Only" & dfsummer$primarymethod=="Mail_Email")
titlemovedown2 <- (dfsummer$fulladdmethods=="Mail_Email" & dfsummer$primarymethod=="Live Phone")
secondarymethodwithpcts[titlemoveup2] <- paste0(secondarymethodwithpcts[titlemoveup2], "\n\n")
secondarymethodwithpcts[titlemovedown2] <- paste0("\n\n", secondarymethodwithpcts[titlemovedown2])
secondarymethodwithpcts[titlemovedown1] <- paste0("\n\n", secondarymethodwithpcts[titlemovedown1], "\n")

#titlemoveup1nat <- dfsummernatpres$primarymethod=="IVR"
titlemoveup1nat <- (dfsummernatpres$fulladdmethods=="Live Phone" & dfsummernatpres$primarymethod=="Probability Panel")
titlemovedown1nat <- (dfsummernatpres$primarymethod=="Text" & dfsummernatpres$fulladdmethods=="IVR")
secondarymethodwithpctsnat[titlemoveup1nat] <- paste0(secondarymethodwithpctsnat[titlemoveup1nat], "\n")
secondarymethodwithpctsnat[titlemovedown1nat] <- paste0("\n", secondarymethodwithpctsnat[titlemovedown1nat])


titlemoveup1state <- (dfsummerstatepres$fulladdmethods=="Live Phone" & dfsummerstatepres$primarymethod=="Probability Panel") | (dfsummerstatepres$fulladdmethods=="Only" & dfsummerstatepres$primarymethod=="Mail/Email")
titlemovedown1state <- (dfsummerstatepres$primarymethod=="Only" & dfsummerstatepres$fulladdmethods=="IVR")
secondarymethodwithpctsstate[titlemoveup1state] <- paste0(secondarymethodwithpctsstate[titlemoveup1state], "\n")
secondarymethodwithpctsstate[titlemovedown1state] <- paste0("\n", secondarymethodwithpctsstate[titlemovedown1state])


mainmethodwithpcts <- paste0(gsub("_", "/", as.character(dfinnerset$primarymethod)))#, "\n(", rd(100*(dfinnerset$Freq/sum(dfinnerset$Freq)), 1), "%)")
natmethodwithpcts <- paste0(gsub("_", "/", gsub("\\/", "\n", gsub(" ", "\n", as.character(dfinnersetnatpres$primarymethod)))))#, "\n(", rd(100*(dfinnersetnatpres$Freq/sum(dfinnersetnatpres$Freq)), 1), "%)")
statemethodwithpcts <- paste0(gsub("Probability\nPanel", "Probability Panel", gsub("\\/", "\n", gsub(" ", "\n", gsub("_", "/", as.character(dfinnersetstatepres$primarymethod))))))#, "\n(", rd(100*(dfinnersetstatepres$Freq/sum(dfinnersetstatepres$Freq)), 1), "%)")

#innertitleup1nat <- dfinnersetnatpres$primarymethod=="Probability Panel"
innertitledown1state <- dfinnersetstatepres$primarymethod=="IVR"
#natmethodwithpcts[innertitleup1nat] <- paste0(natmethodwithpcts[innertitleup1nat], "\n")
statemethodwithpcts[innertitledown1state] <- paste0("\n", statemethodwithpcts[innertitledown1state])


jpeg("../Report/LinkedResults/Section_3_2/MethodProportionsEverything.jpg", width=14, height=12, units="in", res=1200)
par(mfrow=c(1,1), mar=c(2,4,5,8))
# Everything
doughnut(dfsummer$Freq, labels=secondarymethodwithpcts, inner.radius=.6, outer.radius=.8, col=bigbrew[secondmethcolnums], labeltype="outer", density=70, main="Distribution of Methods Used Across All 2024 Matchups")
doughnut(dfinnerset$Freq, labels=mainmethodwithpcts, inner.radius=.3, outer.radius=.6, labeltype=labposinner, font=2, col=bigbrew[methcol], add=TRUE)
dev.off()

jpeg("../Report/LinkedResults/Section_3_2/MethodProportions.jpg", width=26, height=12, units="in", res=1200)
par(mfrow=c(1,2), mar=c(2,4,5,9))
# Everything
#doughnut(dfsummer$Freq, labels=secondarymethodwithpcts, inner.radius=.6, outer.radius=.8, col=bigbrew[secondmethcolnums], labeltype="outer", density=70, main="Distribution of Methods Used Across All 2024 Matchups")
#doughnut(dfinnerset$Freq, labels=mainmethodwithpcts, inner.radius=.3, outer.radius=.6, labeltype=labposinner, font=2, col=bigbrew[methcol], add=TRUE)
#
# National Presidential
doughnut(dfsummernatpres$Freq, labels=secondarymethodwithpctsnat, inner.radius=.6, outer.radius=.8, col=bigbrew[secondmethcolnumsnat], labeltype="outer", density=70, main="Distribution of Methods Used for 2024 National Presidential Matchups")
doughnut(dfinnersetnatpres$Freq, labels=natmethodwithpcts, inner.radius=.3, outer.radius=.6, labeltype=labposinnernat, font=2, col=bigbrew[methcolnatpres], add=TRUE)
#
# State Presidential
doughnut(dfsummerstatepres$Freq, labels=secondarymethodwithpctsstate, inner.radius=.6, outer.radius=.8, col=bigbrew[secondmethcolnumsstate], labeltype="outer", density=70, main="Distribution of Methods for 2024 State Presidential Matchups")
doughnut(dfinnersetstatepres$Freq, labels=statemethodwithpcts, inner.radius=.3, outer.radius=.6, labeltype=labposinner, font=2, col=bigbrew[methcolstatepres], add=TRUE)
dev.off()





# Proportion of exclusive
apply(method24vars, 2, function(x) sum(x & (rowSums(method24vars)==1)))/colSums(methods24)

sum(method24vars[,"anylivephone"] & !method24vars[,"multiple"])/sum(!is.na(method24vars[,"anylivephone"] & !method24vars[,"multiple"]))

method24varsplusimputedpre <- with(dfuse[dfuse$cycle==2024 & dfuse$year==2024 & !is.na(dfuse$multimethodindicatorIMP),], data.frame(anyonlineoptinIMP, anytextIMP, anylivephoneIMP, anyivrIMP, anymailemailIMP, anyprobpanelIMP, multiple=(as.numeric(as.character(multimethodindicatorIMP))>1), morethan2=(as.numeric(as.character(multimethodindicatorIMP))>2)))#anyf2fIMP
method24varsplusimputed <- method24varsplusimputedpre

methods24pi <- sapply(method24varsplusimputed, function(m) with(dfuse[dfuse$cycle==2024 & dfuse$year==2024 & !is.na(dfuse$multimethodindicatorIMP),], xtabs(bestweight~m)))
methods24pi
colSums(methods24pi)
methods24pi[2,]/colSums(methods24pi)



method24varsprelast2weeks <- with(dfuse[dfuse$cycle==2024 & dfuse$year==2024 & !is.na(dfuse$methodology) & dfuse$last2weeks,], data.frame(anyonlineoptin, anytext, anylivephone, anyivr, anymailemail, anyprobpanel, anyf2f, multiple=(as.numeric(as.character(multimethodindicator))>1), morethan2=(as.numeric(as.character(multimethodindicator))>2)))
method24varslast2weeks <- method24varsprelast2weeks[,colSums(method24varsprelast2weeks)>0]

methods24last2weeks <- sapply(method24varslast2weeks, function(m) with(dfuse[dfuse$cycle==2024 & dfuse$year==2024 & !is.na(dfuse$methodology) & dfuse$last2weeks,], xtabs(bestweight~m)))
methods24last2weeks
colSums(methods24last2weeks)
methods24last2weeks[2,]/colSums(methods24last2weeks)


method24varsprepresstate <- with(dfuse[dfuse$cycle==2024 & dfuse$year==2024  & dfuse$office=="president" & dfuse$stateornat=="State" & !is.na(dfuse$methodology),], data.frame(anyonlineoptin, anytext, anylivephone, anyivr, anymailemail, anyprobpanel, anyf2f, multiple=(as.numeric(as.character(multimethodindicator))>1), morethan2=(as.numeric(as.character(multimethodindicator))>2)))
method24varspresstate <- method24varsprepresstate[,colSums(method24varsprepresstate)>0]



methods24presstate <- sapply(method24varspresstate, function(m) with(dfuse[dfuse$cycle==2024 & dfuse$year==2024 & dfuse$office=="president" & dfuse$stateornat=="State" & !is.na(dfuse$methodology),], xtabs(bestweight~m)))
methods24presstate
colSums(methods24presstate)
methods24presstate[2,]/colSums(methods24presstate)


method24varsprepresnational <- with(dfuse[dfuse$cycle==2024 & dfuse$year==2024  & dfuse$office=="president" & dfuse$stateornat=="National" & !is.na(dfuse$methodology),], data.frame(anyonlineoptin, anytext, anylivephone, anyivr, anymailemail, anyprobpanel, anyf2f, multiple=(as.numeric(as.character(multimethodindicator))>1), morethan2=(as.numeric(as.character(multimethodindicator))>2)))
method24varspresnational <- method24varsprepresnational[,colSums(method24varsprepresnational)>0]



methods24presnational <- sapply(method24varspresnational, function(m) with(dfuse[dfuse$cycle==2024 & dfuse$year==2024 & dfuse$office=="president" & dfuse$stateornat=="National" & !is.na(dfuse$methodology),], xtabs(bestweight~m)))
methods24presnational
colSums(methods24presnational)
methods24presnational[2,]/colSums(methods24presnational)

methods24allpres <- methods24presstate+methods24presnational
methods24allpres[2,]/colSums(methods24allpres)



#methods24IMPPRE <- sapply(method24varsplusimputed, function(m) with(dfuse[dfuse$cycle==2024 & dfuse$year==2024 & !is.na(dfuse$multimethodindicatorIMP),], xtabs(bestweight~m)))
#methods24IMP <- methods24IMPPRE[,colSums(method24varspre)>0]
#methods24IMP
#colSums(methods24IMP)
#methods24IMP[2,]/colSums(methods24IMP)

sum(wtd.mean(dfuse$sample_size, dfuse$bestweight))

summary(abs(rbinom(1000, 1000, prob=.5)-500))/1000

sum(dfuse$bestweight[!is.na(dfuse$mercermethods_frame_unknown)])



allmercermode <- dfuse[,grepl("mercer", colnames(dfuse)) & grepl("frame", colnames(dfuse)) & !grepl("altsamp", colnames(dfuse))]
allmercermode[is.na(dfuse$mercermethods_frame_unknown),] <- NA
allmercermode[dfuse$mercermethods_frame_unknown==1 & !is.na(dfuse$mercermethods_frame_unknown),] <- NA
ammnames <- c("Unknown", "Address-Based", "Voter File", "Random Digit Dialing")


colSums(!is.na(allmercermode))
colSums(allmercermode, na.rm=TRUE)

mercermode24vars <- allmercermode[dfuse$cycle==2024 & dfuse$year==2024,2:4] # & !is.na(dfuse$methodology)
mercermode24 <- sapply(mercermode24vars, function(m) with(dfuse[dfuse$cycle==2024 & dfuse$year==2024,], xtabs(bestweight~m)))# & !is.na(dfuse$methodology)
mercermode24
colSums(mercermode24)
mercermode24[2,]/colSums(mercermode24)


mercercombos <- apply(allmercermode, 1, function(x) paste(ammnames[x==1], collapse="+"))
mercercombos[!is.na(rowSums(allmercermode)) & rowSums(allmercermode)==0] <- "Non-Probability"
mercercombos[grepl("NA\\+", mercercombos)] <- NA
mercercombos[grepl("\\+", mercercombos)] <- "Multiple"


dfinnersetpreM <- as.data.frame(xtabs(dfuse$bestweight~primarymethod, subset=(dfuse$cycle==2024 & dfuse$year==2024 & !is.na(dfuse$methodology) & !is.na(mercercombos))))
dfinnersetM <- dfinnersetpreM[dfinnersetpreM$Freq>0,]
dfmercerpre <- as.data.frame(xtabs(dfuse$bestweight~mercercombos+primarymethod, subset=(dfuse$cycle==2024 & dfuse$year==2024 & !is.na(dfuse$methodology) & !is.na(mercercombos))))
dfmercer <- dfmercerpre[dfmercerpre$Freq>0,]

methcolM <- as.numeric(as.factor(dfinnersetM$primarymethod))
secondmethcolnamesM <- as.character(dfmercer$mercercombos)
#secondmethcolnamesM[dfmercer$mercercombos=="Only"] <- as.character(dfmercer$primarymethod)[dfmercer$mercercombos=="Only"]
secondmethcolnumsM <- as.numeric(factor(secondmethcolnamesM, unique(c(levels(as.factor(dfinnersetM$primarymethod)), unique(secondmethcolnamesM)))))


## Build the actual plots
bigbrew <- c(brewer.pal(8, "Set2"), brewer.pal(8, "Set1"), brewer.pal(8, "Set3"))
darkbrew <- c(brewer.pal(8, "Dark2"), brewer.pal(8, "Set1"), brewer.pal(8, "Set3"))

# Which labels to put inside (less than 7% in category)
labposinnerM <- rep("on", nrow(dfinnersetM))
labposinnerM[(dfinnersetM$Freq/sum(dfinnersetM$Freq))<.07] <- "inner"

secondarymethodwithpctsM <- gsub("w\\/ Only", "Only", paste0("w/ ", gsub("  ", " ", gsub("_", "/", as.character(dfmercer$mercercombos))), " (", rd(100*(dfmercer$Freq/sum(dfmercer$Freq)), 1), "%)"))

#titlemoveup2 <- (dfsummer$fulladdmethods=="IVR" & dfsummer$primarymethod=="Live Phone")
#titlemoveup1 <- (dfsummer$fulladdmethods=="Only" & dfsummer$primarymethod=="IVR")
#titlemovedown1 <- (dfsummer$fulladdmethods=="Only" & dfsummer$primarymethod=="Text") | (dfsummer$fulladdmethods=="Mail_Email" & dfsummer$primarymethod=="Text") | (dfsummer$fulladdmethods=="Other Methods" & dfsummer$primarymethod=="Text") | (dfsummer$fulladdmethods=="Only" & dfsummer$primarymethod=="Mail_Email")
#titlemovedown2 <- (dfsummer$fulladdmethods=="Mail_Email" & dfsummer$primarymethod=="Live Phone")
#secondarymethodwithpcts[titlemoveup2] <- paste0(secondarymethodwithpcts[titlemoveup2], "\n\n")
#secondarymethodwithpcts[titlemovedown2] <- paste0("\n\n", secondarymethodwithpcts[titlemovedown2])
#secondarymethodwithpcts[titlemovedown1] <- paste0("\n\n", secondarymethodwithpcts[titlemovedown1], "\n")

mainmethodwithpctsM <- paste0(gsub("_", "/", as.character(dfinnersetM$primarymethod)))#, "\n(", rd(100*(dfinnerset$Freq/sum(dfinnerset$Freq)), 1), "%)")

#innertitleup1nat <- dfinnersetnatpres$primarymethod=="Probability Panel"
#innertitledown1state <- dfinnersetstatepres$primarymethod=="IVR"
#natmethodwithpcts[innertitleup1nat] <- paste0(natmethodwithpcts[innertitleup1nat], "\n")
#statemethodwithpcts[innertitledown1state] <- paste0("\n", statemethodwithpcts[innertitledown1state])




jpeg("../Report/LinkedResults/Section_3_2/MethodSamplingProportionsEverything.jpg", width=14, height=12, units="in", res=1200)
par(mfrow=c(1,1), mar=c(2,4,5,8))
# Everything
doughnut(dfmercer$Freq, labels=secondarymethodwithpctsM, inner.radius=.6, outer.radius=.8, col=bigbrew[secondmethcolnumsM], labeltype="outer", density=70, main="Distribution of Sampling-Mode Combinations Across 2024 Matchups")
doughnut(dfinnersetM$Freq, labels=mainmethodwithpctsM, inner.radius=.3, outer.radius=.6, labeltype=labposinnerM, font=2, col=bigbrew[methcolM], add=TRUE)
dev.off()



with(dfuse[dfuse$cycle==2024 & dfuse$year==2024 & dfuse$stage=="general",], xtabs(bestweight~firmsurvey_weightvars_2020_election_choice_past_vote_))



## Information about coverage from firm survey

with(dfuse[dfuse$cycle==2024,], xtabs(bestweight~!is.na(firmsurvey_Did_you_use_quotas_or_stratification_when_sampling_for_any_of_your_2024_pre_election_polls.)))
with(dfuse[dfuse$cycle==2024,], xtabs(bestweight~cycle))

sum(dfuse$bestweight[!is.na(dfuse$firmsurvey_Did_you_use_quotas_or_stratification_when_sampling_for_any_of_your_2024_pre_election_polls.) & dfuse$cycle==2024])
sum(dfuse$bestweight[dfuse$cycle==2024])

sum(dfuse$bestweight[!is.na(dfuse$firmsurvey_Did_you_use_quotas_or_stratification_when_sampling_for_any_of_your_2024_pre_election_polls.) & dfuse$cycle==2024])/sum(dfuse$bestweight[dfuse$cycle==2024]) # proportion of 2024 cycle contet polls that answered survey


with(dfuse[dfuse$cycle==2024 & dfuse$year==2024,], xtabs(bestweight~!is.na(firmsurvey_Did_you_use_quotas_or_stratification_when_sampling_for_any_of_your_2024_pre_election_polls.)))
with(dfuse[dfuse$cycle==2024 & dfuse$year==2024,], xtabs(bestweight~cycle))

sum(dfuse$bestweight[!is.na(dfuse$firmsurvey_Did_you_use_quotas_or_stratification_when_sampling_for_any_of_your_2024_pre_election_polls.) & dfuse$cycle==2024 & dfuse$year==2024])
sum(dfuse$bestweight[dfuse$cycle==2024 & dfuse$year==2024])

sum(dfuse$bestweight[!is.na(dfuse$firmsurvey_Did_you_use_quotas_or_stratification_when_sampling_for_any_of_your_2024_pre_election_polls.) & dfuse$cycle==2024 & dfuse$year==2024])/sum(dfuse$bestweight[dfuse$cycle==2024 & dfuse$year==2024]) # proportion of 2024 year contet polls that answered survey


with(dfuse[dfuse$cycle==2024 & dfuse$year==2024 & dfuse$stage=="general",], xtabs(bestweight~firmsurvey_weightvars_2020_election_choice_past_vote_))




allmercerwtpre <- dfuse[,grepl("mercer", colnames(dfuse)) & grepl("wt", colnames(dfuse))]
allmercerwt <- allmercerwtpre
allmercerwt[dfuse$mercermethods_wt_unknown==1 & !is.na(dfuse$mercermethods_wt_unknown),] <- NA

colSums(!is.na(allmercerwt[dfuse$cycle==2024 & dfuse$year==2024,]))

mergerwtanypol <- allmercerwt[dfuse$mercermethods_wt_unknown!=1 & !is.na(dfuse$mercermethods_wt_unknown),grepl("part|votechoi", colnames(allmercerwt))]
length(rowSums(mergerwtanypol)>=1)
sum(rowSums(mergerwtanypol)>=1)
wpct(rowSums(mergerwtanypol)>=1)








## Trends in Sample Types

#monthNseach <- sapply(sort(unique(dfuse$month[dfuse$cycle==2024])), function(m) sapply(unique(dfuse$populationmin), function(x) length(na.omit(unique(dfuse$contestpoll[dfuse$cycle==2024 & dfuse$populationmin==x & dfuse$month==m & dfuse$conservativepollsetweight>0])))))# & dfuse$bestweight>0
#colnames(monthNseach) <- sort(unique(dfuse$month[dfuse$cycle==2024]))

monthNseach <- t(sapply(unique(dfuse$populationmin), function(p) with(dfuse[dfuse$populationmin==p & dfuse$cycle==2024,][!duplicated(dfuse$contestpoll[dfuse$populationmin==p & dfuse$cycle==2024]),], xtabs(conservativepollsetweight~month))))

colSums(monthNseach)

totmonths <- with(dfuse[dfuse$cycle==2024,][!duplicated(dfuse$contestpoll[dfuse$cycle==2024]),], xtabs(conservativepollsetweight~month))


#totmonths <- as.data.frame(with(dfuse[dfuse$cycle==2024,], xtabs(bestweight~droplevels(as.factor(month)))))

linecompare <- c("black", brewer.pal(8, "Dark2"))

jpeg("../Report/LinkedResults/Section_3_2/SurveyPopulationsPerMonth.jpg", width=12, height=8, units="in", res=1200)
plot(as.Date(as.character(names(totmonths))), totmonths, type="l", lwd=2, xlab="Date", ylab="Matchups Reported Per Month", las=1, xlim=as.Date(c("2020-11-01", "2024-11-01")), axes=FALSE)
axis(1, as.Date(as.character(names(totmonths))), rep("", length(totmonths)), lwd=.5)
axis(1, seq(as.Date("2016-01-01"), as.Date("2030-01-01"), "year"), seq(2016, 2030, 1), lwd=2)
axis(2, las=2)
axis(2, c(-9999,9999))
axis(3, c(-9999,9999999))
axis(4, c(-9999,9999))
abline(h=seq(200, 1000, 200), lty=3, col="gray")
lines(as.Date(as.character(names(totmonths))), totmonths, lwd=2)
lines(as.Date(colnames(monthNseach)), monthNseach["lv",], col=linecompare[2], lwd=2)
lines(as.Date(colnames(monthNseach)), monthNseach["rv",], col=linecompare[3], lwd=2)
lines(as.Date(colnames(monthNseach)), monthNseach["a",], col=linecompare[4], lwd=2)
legend(x="topleft", legend=c("Total Matchups Reported", "Likely Voter Matchups Reported", "Registered Voter Matchups Reported", "Adult Matchups Reported"), lwd=2, col=linecompare, bg="white")
dev.off()

rowSums(monthNseach)
sum(totmonths)
rowSums(monthNseach)/sum(totmonths)

monthNseach
totmonths

apply(monthNseach, 1, function(x) x/totmonths)

sum(monthNseach["lv",c("2024-09-01", "2024-10-01", "2024-11-01")])
sum(totmonths[c("2024-09-01", "2024-10-01", "2024-11-01")])
sum(monthNseach["lv",c("2024-09-01", "2024-10-01", "2024-11-01")])/sum(totmonths[c("2024-09-01", "2024-10-01", "2024-11-01")])

# 3.3.1 Historical numbers of polls and pollsters
colman1 <- brewer.pal(7, "Dark2")
colman2 <- brewer.pal(7, "Set2")

cyclechanges <- timeglob[[1]][paste0("cycle.stagemin.", seq(2000, 2024, 4), " general"),]#timeglob[[1]][paste("cycle", seq(2000, 2024, 4), sep="."),]
cycleyearchanges <- timeglob[[2]][paste0("cycle.stagemin.", seq(2000, 2024, 4), " general"),]#timeglob[[2]][paste("cycle", seq(2000, 2024, 4), sep="."),]

ccnums <- apply(cyclechanges[,1:5], 2, as.numeric)
ccynums <- apply(cycleyearchanges[,1:5], 2, as.numeric)
colnames(ccnums) <- colnames(ccynums) <- gsub("ContestPolls", "Matchups Reported", colnames(ccynums))

jpeg("../Report/LinkedResults/Section_3_3/GeneralElectionRecordsByCycle.jpg", width=12, height=6, units="in", res=1200)
par(mfrow=c(1,2))
barplot(ccnums[,3:1], beside=TRUE, col=colman2, ylim=c(0, 10000), ylab="Number of Unique Records")
abline(h=seq(2000, 12000, 2000), lty=3, col="gray")
barplot(ccnums[,3:1], beside=TRUE, col=colman2, add=TRUE)
barplot(ccynums[,3:1], beside=TRUE, col=colman1, add=TRUE)
legend(x="topleft", legend=seq(2000, 2024, 4), fill=colman1, bg="white", title="Cycle")
barplot(ccnums[,4:5], beside=TRUE, col=colman2, ylim=c(0,275), ylab="Number of Unique Records")
abline(h=seq(50, 300, 50), lty=3, col="gray")
barplot(ccnums[,4:5], beside=TRUE, col=colman2, add=TRUE)
barplot(ccynums[,4:5], beside=TRUE, col=colman1, add=TRUE)
#legend(x="topleft", legend=seq(2000, 2024, 4), fill=colman1, bg="white", title="Cycle")
dev.off()


samps

ccnums[7,]/ccnums[6,]
ccynums[7,]/ccynums[6,]


timeglob[[1]][paste0("cycle.stagemin.", seq(2000, 2024, 4), " primary"),] # Full cycle
timeglob[[1]][paste0("cycle.stagemin.", seq(2000, 2024, 4), " general"),] # Full cycle
timeglob[[2]][paste0("cycle.stagemin.", seq(2000, 2024, 4), " primary"),] # Calendar Year
timeglob[[2]][paste0("cycle.stagemin.", seq(2000, 2024, 4), " general"),] # Calendar Year


# 3.3.2 Polling Over Time Across States

stateNtypeseachcyc <- mclapply(seq(2000, 2024, 4), function(y) with(dfuse[dfuse$cycle==y & dfuse$stage=="general",], as.matrix(xtabs(bestweight~statemin))))
stateNscycles <- as.data.frame(rbindlist(lapply(stateNtypeseachcyc, function(x) as.data.frame(t(x))), fill=TRUE))
rownames(stateNscycles) <- seq(2000, 2024, 4)

stateNtypeseachcycyear <- mclapply(seq(2000, 2024, 4), function(y) with(dfuse[dfuse$cycle==y & dfuse$cycle==dfuse$year & dfuse$stage=="general",], as.matrix(xtabs(bestweight~statemin))))
stateNscycyears <- as.data.frame(rbindlist(lapply(stateNtypeseachcycyear, function(x) as.data.frame(t(x))), fill=TRUE))
rownames(stateNscycyears) <- seq(2000, 2024, 4)


stateNtypeseachlast2weeks <- mclapply(seq(2000, 2024, 4), function(y) with(dfuse[dfuse$cycle==y & dfuse$cycle==dfuse$year & dfuse$stage=="general" & dfuse$last2weeks==TRUE,], as.matrix(xtabs(bestweight~statemin))))
stateNscyclast2 <- as.data.frame(rbindlist(lapply(stateNtypeseachlast2weeks, function(x) as.data.frame(t(x))), fill=TRUE))
rownames(stateNscyclast2) <- seq(2000, 2024, 4)


stateNtypeseachlast2weekspres <- mclapply(seq(2000, 2024, 4), function(y) with(dfuse[dfuse$cycle==y & dfuse$cycle==dfuse$year & dfuse$stage=="general" & dfuse$last2weeks==TRUE & dfuse$office=="president",], as.matrix(xtabs(bestweight~statemin))))
stateNscyclast2pres <- as.data.frame(rbindlist(lapply(stateNtypeseachlast2weekspres, function(x) as.data.frame(t(x))), fill=TRUE))
rownames(stateNscyclast2pres) <- seq(2000, 2024, 4)



stateNtypeseachcycyearsurveys <- mclapply(seq(2000, 2024, 4), function(y) with(dfuse[dfuse$cycle==y & dfuse$cycle==dfuse$year & dfuse$stage=="general" & !duplicated(dfuse$updatedpollid),], as.matrix(xtabs(~statemin))))
stateNscycyearssurveys <- as.data.frame(rbindlist(lapply(stateNtypeseachcycyearsurveys, function(x) as.data.frame(t(x))), fill=TRUE))
rownames(stateNscycyearssurveys) <- seq(2000, 2024, 4)

jpeg("../Report/LinkedResults/Section_3_3/GenElecSurveysByLocationCycleOLD.jpg", width=12, height=8, units="in", res=1200)
colman1 <- brewer.pal(nrow(stateNscycles), "Dark2")
colman2 <- brewer.pal(nrow(stateNscycles), "Set2")
map('state', xlim=c(-131, -65), ylim=c(23, 52))
map('state', regions=c("michigan", "pennsylvania", "wisconsin", "georgia", "arizona", "north carolina", "nevada"), col="gray92", add=TRUE, fill=TRUE)
for(i in tolower(statesdf$NAME)){
    if(i %in% rownames(sossort)){
        stlat <- statesdf$lat[tolower(statesdf$NAME)==i]
        stlong <- statesdf$long[tolower(statesdf$NAME)==i]
        segments(stlong-.75, stlat-.5, stlong+1.25, stlat-.5, lwd=.5, col="gray")
        segments(seq(stlong-.75, stlong+1.25, length.out=nrow(stateNscycles)), stlat-.5, seq(stlong-.75, stlong+1.25, length.out=nrow(stateNscycles)), stlat-.5+(stateNscycles[,i]/100), col=colman2, lwd=3)
        segments(seq(stlong-.75, stlong+1.25, length.out=nrow(stateNscycyears)), stlat-.5, seq(stlong-.75, stlong+1.25, length.out=nrow(stateNscycyears)), stlat-.5+(stateNscycyears[,i]/100), col=colman1, lwd=3)
    }
}
segments(-128, 24.5, -126, 24.5, lwd=.5, col="gray")
segments(-128.5, seq(29.5, 45, 5)[1:3], -125.5, seq(29.5, 45, 5)[1:3], lwd=.5, lty=3, col="gray")
text(-128.5, seq(24.5, 45, 5)[1:4], seq(0, 2000, 500)[1:4], pos=2, cex=.7)
segments(seq(-128, -126, length.out=nrow(stateNscycles)), 24.5, seq(-128, -126, length.out=nrow(stateNscycles)), 24.5+(stateNscycles[,"national"]/100), col=colman2, lwd=3)
segments(seq(-128, -126, length.out=nrow(stateNscycyears)), 24.5, seq(-128, -126, length.out=nrow(stateNscycyears)), 24.5+(stateNscycyears[,"national"]/100), col=colman1, lwd=3)
text(-123.5, 25, "National")
legend(x="bottom", str_to_title(rownames(stateNscycles)), col=colman1, lwd=3, cex=.7, horiz=TRUE, bg="white")
dev.off()


jpeg("../Report/LinkedResults/Section_3_3/GenElecSurveysByLocationCycle.jpg", width=12, height=8, units="in", res=1200)
colman1 <- brewer.pal(nrow(stateNscycles), "Dark2")
colman2 <- brewer.pal(nrow(stateNscycles), "Set2")
map('state', xlim=c(-131, -65), ylim=c(23, 52))
map('state', regions=c("michigan", "pennsylvania", "wisconsin", "georgia", "arizona", "north carolina", "nevada"), col="gray92", add=TRUE, fill=TRUE)
segments(-128, 24.5, -125.5, 24.5, lwd=.5, col="gray")
segments(-128.5, seq(29.5, 45, 5)[1:3], -125, seq(29.5, 45, 5)[1:3], lwd=.5, lty=3, col="gray")
for(i in c(tolower(statesdf$NAME), "north carolina")){
    if(i %in% colnames(stateNscycles)){
        stlat <- statesdf$lat[tolower(statesdf$NAME)==i]
        stlong <- statesdf$long[tolower(statesdf$NAME)==i]
        segments(stlong-1.2, stlat-.5, stlong+1.3, stlat-.5, lwd=.5, col="gray")
        edges <- seq(-1.2, +1.3, length.out=(nrow(stateNscycles)+1))
        for(j in 1:nrow(stateNscycles)){
            polygon(x=(stlong+c(edges[j], edges[j], edges[j+1], edges[j+1])), y=(stlat+c(-.5, -.5+(stateNscycles[j,i]/100), -.5+(stateNscycles[j,i]/100), -.5)), col=colman2[j], lwd=.25)
            polygon(x=(stlong+c(edges[j], edges[j], edges[j+1], edges[j+1])), y=(stlat+c(-.5, -.5+(stateNscycyears[j,i]/100), -.5+(stateNscycyears[j,i]/100), -.5)), col=colman1[j], lwd=.25)
            polygon(x=(-127+c(edges[j], edges[j], edges[j+1], edges[j+1])), y=(24.5+c(0, (stateNscycles[j,"national"]/100), (stateNscycles[j,"national"]/100), 0)), col=colman2[j], lwd=.25)
            polygon(x=(-127+c(edges[j], edges[j], edges[j+1], edges[j+1])), y=(24.5+c(0, (stateNscycyears[j,"national"]/100), (stateNscycyears[j,"national"]/100), 0)), col=colman1[j], lwd=.25)
        }
    }
}
text(-128.5, seq(24.5, 45, 5)[1:4], seq(0, 2000, 500)[1:4], pos=2, cex=.7)
#segments(seq(-128, -126, length.out=nrow(stateNscycles)), 24.5, seq(-128, -126, length.out=nrow(stateNscycles)), 24.5+(stateNscycles[,"national"]/100), col=colman2, lwd=3)
#segments(seq(-128, -126, length.out=nrow(stateNscycyears)), 24.5, seq(-128, -126, length.out=nrow(stateNscycyears)), 24.5+(stateNscycyears[,"national"]/100), col=colman1, lwd=3)
text(-123, 25, "National")
legend(x="bottom", str_to_title(rownames(stateNscycles)), col=colman1, lwd=3, cex=.7, horiz=TRUE, bg="white")
dev.off()



dfuse$swingnonswingornat <- dfuse$stateornat
dfuse$swingnonswingornat[dfuse$state %in% c("nevada", "arizona", "michigan", "wisconsin", "pennsylvania", "georgia", "north carolina")] <- "Swing State in 2024"
dfuse$swingnonswingornat[dfuse$swingnonswingornat %in% c("Congressional District", "Other")] <- NA
dfuse$swingnonswingornat[dfuse$swingnonswingornat=="State"] <- "Non-Swing State in 2024"


statetypeNtypesprecalyr <- with(dfuse[dfuse$cycle %in% seq(2000, 2024, 4) & dfuse$year==dfuse$cycle & dfuse$stage=="general",], as.matrix(xtabs(bestweight~cycle+swingnonswingornat)))
statetypeNtypespre <- with(dfuse[dfuse$cycle %in% seq(2000, 2024, 4) & dfuse$stage=="general",], as.matrix(xtabs(bestweight~cycle+swingnonswingornat)))

jpeg("../Report/LinkedResults/Revised/GenElecSurveysByLocationTypeCycle.jpg", width=9, height=6, units="in", res=1200)
barplot(statetypeNtypespre, beside=TRUE, col=colman2[1:7], ylim=c(0,2500), las=1)
abline(h=seq(0,10000, 500), lty=3, col="gray")
barplot(statetypeNtypespre, beside=TRUE, col=colman2[1:7], add=TRUE, las=1)
barplot(statetypeNtypesprecalyr, beside=TRUE, add=TRUE, col=colman1[1:7], las=1)
legend(x="topright", str_to_title(rownames(stateNscycles)), fill=colman1, horiz=TRUE, bg="white", cex=.8)
legend(x="topleft", c("All general election matchups", "Calendar year general election matchups"), fill=c(colman2[7], colman1[7]), cex=.8)
dev.off()

ftnoms <- names(dfuse)[grepl("^firmtype_", names(dfuse))]

statetypeNtypesprecalyrfirmtype <- lapply(ftnoms, function(t) with(dfuse[dfuse$cycle %in% seq(2000, 2024, 4) & dfuse$year==dfuse$cycle & dfuse$stage=="general" & dfuse[,t]==1,], as.matrix(xtabs(bestweight~cycle+swingnonswingornat))))

eachtypeportswingers <- lapply(statetypeNtypesprecalyrfirmtype, function(x) apply(x, 1, function(g) g/sum(g)))

names(statetypeNtypesprecalyrfirmtype) <- ftnoms
names(eachtypeportswingers) <- ftnoms


# By matchups

colnames(stateNscycyears)[as.numeric(stateNscycyears["2024",])>as.numeric(stateNscycyears["2020",])] # not multistate
colnames(stateNscycyears)[as.numeric(stateNscycyears["2024",])<as.numeric(stateNscycyears["2020",])] # not national, but plus dc which had none in 2024

rowSums(stateNscycyears[,colnames(stateNscycyears) %in% c("arizona", "georgia", "nevada", "north carolina", "pennsylvania", "michigan", "wisconsin")])/(rowSums(stateNscycyears, na.rm=TRUE)-stateNscycyears[,"national"])


rowSums(stateNscyclast2[,colnames(stateNscyclast2) %in% c("arizona", "georgia", "nevada", "north carolina", "pennsylvania", "michigan", "wisconsin")])/(rowSums(stateNscyclast2, na.rm=TRUE)-stateNscyclast2[,"national"])

rowSums(stateNscyclast2pres[,colnames(stateNscyclast2pres) %in% c("arizona", "georgia", "nevada", "north carolina", "pennsylvania", "michigan", "wisconsin")])/(rowSums(stateNscyclast2pres, na.rm=TRUE)-stateNscyclast2pres[,"national"])




## Why extra surveys in these states?

sapply(na.omit(colnames(stateNscycyears)[as.numeric(stateNscycyears["2024",])>as.numeric(stateNscycyears["2020",])]), function(x) with(dfuse, table(paste(office, cycle)[(cycle %in% c(2020, 2024)) & cycle==year & stage=="general" & state==x])))

with(dfuse[with(dfuse, (cycle %in% c(2020, 2024)) & cycle==year & stage=="general" & (state %in% na.omit(colnames(stateNscycyears)[as.numeric(stateNscycyears["2024",])>as.numeric(stateNscycyears["2020",])]))),], xtabs(bestweight~state+paste(office, cycle)))

# Mass is odd -- see here -- tracking poll in 2020 but not 2024 but downweighted so that 2024 is higher matchups reported
massqs <- with(dfuse, data.frame(match_name, infoset, eddt, contest, bestweight, status)[(cycle %in% c(2020, 2024)) & cycle==year & stage=="general" & state=="massachusetts",])
massqs[!duplicated(massqs),]
massqs <- with(dfuse, data.frame(match_name, infoset, eddt, contest, bestweight, status)[(cycle %in% c(2020, 2024)) & cycle==year & stage=="general" & state=="massachusetts",])

               
# By Surveys

na.omit(colnames(stateNscycyearssurveys)[as.numeric(stateNscycyearssurveys["2024",])>as.numeric(stateNscycyearssurveys["2020",])]) # not multistate
na.omit(colnames(stateNscycyearssurveys)[as.numeric(stateNscycyearssurveys["2024",])<as.numeric(stateNscycyearssurveys["2020",])]) # not national, but plus dc which had non in 2024

write.csv(stateNscycles, "../Report/LinkedResults/Section_3_3/SurveysByLocationOverTimeFullCycle.csv")
write.csv(stateNscycyears, "../Report/LinkedResults/Section_3_3/SurveysByLocationOverTimeElectionYears.csv")


# 3.3.3 Firms that conducted polls

cycletotalsfirmtypes <- lapply(ftypessets, function(g) lapply(g, function(x) sapply(seq(2000, 2024, 4), function(y) x[paste0("cycle.stagemin.", y, " general"),])))

cpsbytype <- sapply(cycletotalsfirmtypes, function(x) as.numeric(sapply(x, function(y) y["ContestPolls",])[,"AllTime"]))
firmNbytype <- sapply(cycletotalsfirmtypes, function(x) as.numeric(sapply(x, function(y) y["Firms",])[,"AllTime"]))
cpsbytypecal <- sapply(cycletotalsfirmtypes, function(x) as.numeric(sapply(x, function(y) y["ContestPolls",])[,"ElectionYear"]))
firmNbytypecal <- sapply(cycletotalsfirmtypes, function(x) as.numeric(sapply(x, function(y) y["Firms",])[,"ElectionYear"]))
rownames(firmNbytype) <- rownames(cpsbytype) <- rownames(firmNbytypecal) <- rownames(cpsbytypecal) <- seq(2000, 2024, 4)

colman1 <- brewer.pal(ncol(cpsbytype)-1, "Dark2")
colman2 <- brewer.pal(ncol(cpsbytype)-1, "Set2")

jpeg("../Report/LinkedResults/Section_3_3/FirmTypesByCycle.jpg", width=12, height=12, units="in", res=1200)
par(mfrow=c(2,2))
barplot(t(as.matrix(cpsbytype[,2:5])), beside=TRUE, col=colman2[1:4], xlab="Election Cycle", ylab="Number of Matchups Reported", main="Number of Matchups Reported by Firm Type and Cycle\n(non-exclusive)")
abline(h=seq(500, 4000, 500), lty=3, col="gray")
barplot(t(as.matrix(cpsbytype[,2:5])), beside=TRUE, col=colman2[1:4], add=TRUE)
barplot(t(as.matrix(cpsbytypecal[,2:5])), beside=TRUE, col=colman1[1:4], add=TRUE)
legend(x="topleft", str_to_title(gsub("firmtype_", "", colnames(cpsbytype)[2:5])), fill=colman1, bg="white", title="Firm Type")
barplot(t(as.matrix(firmNbytype[,2:5])), beside=TRUE, col=colman2[1:4], xlab="Election Cycle", ylab="Number of Active Firms", main="Number of Active Firms by Firm Type and Cycle\n(non-exclusive)")
abline(h=seq(20, 200, 20), lty=3, col="gray")
barplot(t(as.matrix(firmNbytype[,2:5])), beside=TRUE, col=colman2[1:4], add=TRUE)
barplot(t(as.matrix(firmNbytypecal[,2:5])), beside=TRUE, col=colman1[1:4], add=TRUE)
legend(x="topleft", str_to_title(gsub("firmtype_", "", colnames(firmNbytype)[2:5])), fill=colman1[1:4], bg="white", title="Firm Type")
barplot(t(as.matrix(cpsbytype[,6:8])), beside=TRUE, col=colman2[5:7], xlab="Election Cycle", ylab="Number of Matchups Reported", main="Number of Matchups Reported by Firm Orientation and Cycle\n(non-exclusive)")
abline(h=seq(500, 4000, 500), lty=3, col="gray")
barplot(t(as.matrix(cpsbytype[,6:8])), beside=TRUE, col=colman2[5:7], add=TRUE)
barplot(t(as.matrix(cpsbytypecal[,6:8])), beside=TRUE, col=colman1[5:7], add=TRUE)
legend(x="topleft", str_to_title(gsub("firmtype_", "", colnames(cpsbytype)[6:8])), fill=colman1[5:7], bg="white", title="Firm Orientation")
barplot(t(as.matrix(firmNbytype[,6:8])), beside=TRUE, col=colman2[5:7], xlab="Election Cycle", ylab="Number of Active Firms", main="Number of Active Firms by Firm Orientation and Cycle\n(non-exclusive)")
abline(h=seq(20, 200, 20), lty=3, col="gray")
barplot(t(as.matrix(firmNbytype[,6:8])), beside=TRUE, col=colman2[5:7], add=TRUE)
barplot(t(as.matrix(firmNbytypecal[,6:8])), beside=TRUE, col=colman1[5:7], add=TRUE)
legend(x="topleft", str_to_title(gsub("firmtype_", "", colnames(firmNbytype)[6:8])), fill=colman1[5:7], bg="white", title="Firm Orientation")
dev.off()

cpsbytypecal/cpsbytypecal[,1] # Shift in Contests
firmNbytypecal/firmNbytypecal[,1] # Shift in Firms

cpsbytypecal["2024",]/cpsbytypecal["2020",]

firmNbytypecal

# 3.3.4 When in the cycle polls were conducted

cyclesbytime <- sapply(timeglob, function(x) sapply(rev(seq(2000, 2024, 4)), function(y) x[paste0("cycle.stagemin.", y, " general"),"ContestPolls"]))
rownames(cyclesbytime) <- rev(seq(2000, 2024, 4))

cbtreord <- cbtreordpre <- cyclesbytime[,order(colSums(cyclesbytime), decreasing=TRUE)]
for(i in 1:(ncol(cbtreord)-1))
    cbtreord[,i] <- cbtreord[,i]-cbtreord[,i+1]

colnames(cbtreord) <- c("Before Jan", "Jan-Sept", "Oct", "Last 2 Weeks", "Last Week", "Last 3 Days")

cbtportwhenspre <- apply(cbtreord, 1, function(x) x/sum(x[-1]))
cbtportwhens <- rbind(-cbtportwhenspre[1,], cbtportwhenspre)

jpeg("../Report/LinkedResults/Section_3_3/WhenPollsCycles.jpg", width=12, height=6, units="in", res=1200)
barplot(cbtportwhens*100, horiz=TRUE, las=1, col=brewer.pal(nrow(cbtportwhens), "YlGn"), ylim=c(-.5,8))
legend(x="bottomright", rownames(cbtportwhens)[-1], horiz=TRUE, fill=brewer.pal(nrow(cbtportwhens), "YlGn"), cex=.7)
dev.off()

apply(cbtreordpre[,-1], 1, function(x) x/x[1]) # this is of election year

firmsbytime <- sapply(timeglob, function(x) sapply(rev(seq(2000, 2024, 4)), function(y) x[paste0("cycle.stagemin.", y, " general"),"Firms"]))
rownames(firmsbytime) <- rev(seq(2000, 2024, 4))
fbtreordpre <- firmsbytime[,order(colSums(firmsbytime), decreasing=TRUE)]

fbtreordpre
apply(fbtreordpre[,-1], 1, function(x) x/x[1]) # this is of election year

# 3.3.5 Firm Types

wbpollingfirmtypeNs <- createWorkbook("FirmTypeNs")
for(i in names(cycletotals24firmtypes)){
    addWorksheet(wbpollingfirmtypeNs, paste0("NsFor", gsub("\\.", "", i)))
    writeData(wbpollingfirmtypeNs, sheet = paste0("NsFor", gsub("\\.", "", i)), cbind(variable=rownames(cycletotals24firmtypes[[i]]), (cycletotals24firmtypes[[i]])))
}
saveWorkbook(wbpollingfirmtypeNs, "../Report/LinkedResults/Section_3_2/PollsByFirmTypes.xlsx", overwrite = TRUE)
rm(wbpollingfirmtypeNs)


# 3.3.5 Data collection methods used

methodvarset <- with(dfuse, data.frame(anyonlineoptin, anytext, anylivephone, anyivr, anymailemail, anyprobpanel, multiple=(as.numeric(as.character(multimethodindicator))>1), morethan2=(as.numeric(as.character(multimethodindicator))>2)))  #anyf2f

methodsovertime <- sapply(seq(2000, 2024, 4), function(y) sapply(methodvarset[dfuse$cycle==y & dfuse$year==y & !is.na(dfuse$methodology) & dfuse$stage=="general",], function(m) with(dfuse[dfuse$cycle==y & dfuse$year==y & !is.na(dfuse$methodology) & dfuse$stage=="general",], sum(bestweight[m]))))
methodcodedovertime <- sapply(seq(2000, 2024, 4), function(y) sapply(methodvarset[dfuse$cycle==y & dfuse$year==y & !is.na(dfuse$methodology) & dfuse$stage=="general",], function(m) with(dfuse[dfuse$cycle==y & dfuse$year==y & !is.na(dfuse$methodology) & dfuse$stage=="general",], sum(bestweight[!is.na(m)]))))
colnames(methodsovertime) <- colnames(methodcodedovertime) <- seq(2000, 2024, 4)

methodports <- methodsovertime/methodcodedovertime
mppre <- methodports[grepl("any", rownames(methodports)),]
mp <- mppre[order(rowMeans(mppre), decreasing=TRUE),]
rownames(mp) <- gsub("any", "", gsub("onlineoptin", "Online Opt-in", gsub("livephone", "Live Phone", gsub("ivr", "Automated Phone", gsub("text", "Text/Text-to-Web", gsub("mailemail", "Mail/Email", gsub("anyprobpanel", "Probability Panel", gsub("anyf2f", "Face to Face", rownames(mp)))))))))

## Plot changing methods since 2000

jpeg("../Report/LinkedResults/Section_3_3/MethodsOverTime.jpg", width=12, height=8, units="in", res=1200)
newcolset <- brewer.pal(nrow(mp)+1, "Dark2")
plot(c(2000, 2024), 100*(0:1), type="n", ylab="Percentage of Matchups Using Method", xlab="Date", main="Survey Method Prevalence Over Time", las=1, axes=FALSE)
axis(1, c(-999,99999))
axis(2, c(-999,99999))
axis(3, c(-999,99999))
axis(4, c(-999,99999))
axis(1, seq(2000, 2024, 4))
axis(2)
abline(h=seq(0,100,20), lty=3, col="gray")
for(i in 1:nrow(mp))
    lines(seq(2000, 2024, 4), 100*mp[i,], type="b", lwd=2, col=newcolset[i], pch=(14+i))
lines(seq(2000, 2024, 4), 100*methodports["multiple",], type="l", lwd=3, col="black")
legend(x=2000, y=100, legend=rownames(mp)[1:4], lwd=2, pch=15:18, col=newcolset[1:4], box.lwd=0, bg="white")
legend(x=2006, y=100, legend=c(rownames(mp)[5:6], "Multiple Methods"), lwd=c(2,2,3), pch=c(19:21), pt.cex=c(1,1,.01), col=c(newcolset[5:6], "black"), box.lwd=0, bg="white")
dev.off()

## Duplicate with imputed version

methodvarsetIMP <- with(dfuse, data.frame(anyonlineoptinIMP, anytextIMP, anylivephoneIMP, anyivrIMP, anymailemailIMP, anyprobpanelIMP, multiple=(as.numeric(as.character(multimethodindicatorIMP))>1), morethan2=(as.numeric(as.character(multimethodindicatorIMP))>2)))#anyf2fIMP

methodsovertimeIMP <- sapply(seq(2000, 2024, 4), function(y) sapply(methodvarsetIMP[dfuse$cycle==y & dfuse$year==y & !is.na(dfuse$multimethodindicatorIMP) & dfuse$stage=="general",], function(m) with(dfuse[dfuse$cycle==y & dfuse$year==y & !is.na(dfuse$multimethodindicatorIMP) & dfuse$stage=="general",], sum(bestweight[m]))))
methodcodedovertimeIMP <- sapply(seq(2000, 2024, 4), function(y) sapply(methodvarsetIMP[dfuse$cycle==y & dfuse$year==y & !is.na(dfuse$multimethodindicatorIMP) & dfuse$stage=="general",], function(m) with(dfuse[dfuse$cycle==y & dfuse$year==y & !is.na(dfuse$multimethodindicatorIMP) & dfuse$stage=="general",], sum(bestweight[!is.na(m)]))))
colnames(methodsovertime) <- colnames(methodcodedovertime) <- seq(2000, 2024, 4)

methodportsIMP <- methodsovertimeIMP/methodcodedovertimeIMP
mppreIMP <- methodportsIMP[grepl("any", rownames(methodportsIMP)),]
mpIMP <- mppreIMP[order(rowMeans(mppre), decreasing=TRUE),] ## USING THE OLD ONE HERE SO THE ORDER IS THE SAME
rownames(mpIMP) <- gsub("IMP", "", gsub("any", "", gsub("onlineoptin", "Online Opt-in", gsub("livephone", "Live Phone", gsub("ivr", "Automated Phone", gsub("text", "Text/Text-to-Web", gsub("mailemail", "Mail/Email", gsub("anyprobpanel", "Probability Panel", gsub("anyf2f", "Face to Face", rownames(mpIMP))))))))))

## Plot changing methods since 2000

jpeg("../Report/LinkedResults/Section_3_3/MethodsOverTimeIMP.jpg", width=12, height=8, units="in", res=1200)
newcolset <- brewer.pal(nrow(mpIMP)+1, "Dark2")
plot(c(2000, 2024), 100*(0:1), type="n", ylab="Percentage of Matchups Using Method (incl. imputed)", xlab="Date", main="Survey Method Prevalence Over Time (Incl. Imputed)", las=1, axes=FALSE)
axis(1, c(-999,99999))
axis(2, c(-999,99999))
axis(3, c(-999,99999))
axis(4, c(-999,99999))
axis(1, seq(2000, 2024, 4))
axis(2)
abline(h=seq(0,100,20), lty=3, col="gray")
for(i in 1:nrow(mp))
    lines(seq(2000, 2024, 4), 100*mpIMP[i,], type="b", lwd=2, col=newcolset[i], pch=(14+i))
lines(seq(2000, 2024, 4), 100*methodportsIMP["multiple",], type="l", lwd=3, col="black")
legend(x=2000, y=100, legend=rownames(mpIMP)[1:4], lwd=2, pch=15:18, col=newcolset[1:4], box.lwd=0, bg="white")
legend(x=2006, y=100, legend=c(rownames(mpIMP)[5:6], "Multiple Methods"), lwd=c(2,2,3), pch=c(19:21), pt.cex=c(1,1,.01), col=c(newcolset[5:6], "black"), box.lwd=0, bg="white")
dev.off()


combinedmethodsset <- data.frame(dfuse[,grepl("^rlmethods_", colnames(dfuse))])
codecombinedmethods <- function(x){
    out <- rep(NA, length(x))
    out[grepl("^not used|^unlikely", x, ignore.case=TRUE)] <- 0
    out[grepl("^definitely|^probably", x, ignore.case=TRUE)] <- 1
    out
}

#table(combinedmethodsset$rlmethods_sampledrdd, dfuse$cycle)

#table(dfuse$match_name[combinedmethodsset$rlmethods_sampledrdd=="probably" & dfuse$cycle==2024])


cmspre <- as.data.frame(sapply(combinedmethodsset, function(x) codecombinedmethods(x)))
cmsuse <- cmspre[,colSums(!is.na(cmspre))>40000]
colnames(cmsuse) <- gsub("rl", "cm", colnames(cmsuse))

cmssamplesset <- cmsuse[,grepl("sample|_panelist$", colnames(cmsuse))]

cmsmethodsovertime <- sapply(seq(2000, 2024, 4), function(y) sapply(cmssamplesset[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], function(m) with(dfuse[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], sum(bestweight*m, na.rm=TRUE))))
cmsmethodcodedovertime <- sapply(seq(2000, 2024, 4), function(y) sapply(cmssamplesset[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], function(m) with(dfuse[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], sum(bestweight[!is.na(m)]))))
colnames(cmsmethodsovertime) <- colnames(cmsmethodcodedovertime) <- seq(2000, 2024, 4)

cmsmethodsovertimefirms <- sapply(seq(2000, 2024, 4), function(y) sapply(cmssamplesset[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], function(m) with(dfuse[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], length(na.omit(unique(updatedpollid[m==1]))))))

cmsmethodsovertimelong <- sapply(seq(1940, 2024, 4), function(y) sapply(cmssamplesset[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], function(m) with(dfuse[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], sum(bestweight*m, na.rm=TRUE))))
cmsmethodcodedovertimelong <- sapply(seq(1940, 2024, 4), function(y) sapply(cmssamplesset[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], function(m) with(dfuse[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], sum(bestweight[!is.na(m)]))))
colnames(cmsmethodsovertimelong) <- colnames(cmsmethodcodedovertimelong) <- seq(1940, 2024, 4)
cmsmethodsovertimelong/cmsmethodcodedovertimelong

cmsethodports <- cmsmethodsovertime/cmsmethodcodedovertime
cmsmp <- cmsethodports[order(rowMeans(cmsethodports), decreasing=TRUE),]
rownames(cmsmp) <- gsub("cmmethods_", "", gsub("sampledrdd", "Random Digit Dialing", gsub("panelist", "Online Panel", gsub("sampledfromvoterfile", "Voter File", gsub("riversample", "River Sample", gsub("sampledemail", "Email", gsub("sampledapp", "App", gsub("sampledabs", "Address-Based", gsub("sampledsocial", "Social Media", rownames(cmsmp))))))))))
cmsmp

jpeg("../Report/LinkedResults/Section_3_3/SamplingMethodsOverTime.jpg", width=12, height=8, units="in", res=1200)
newcolset <- brewer.pal(nrow(cmsmp), "Dark2")
plot(c(2000, 2024), 100*(0:1), type="n", ylab="Percentage of Matchups Using Sampling Strategy", xlab="Date", main="Sampling Method Prevalence Over Time", las=1, axes=FALSE)
axis(1, c(-999,99999))
axis(2, c(-999,99999))
axis(3, c(-999,99999))
axis(4, c(-999,99999))
axis(1, seq(2000, 2024, 4))
axis(2)
abline(h=seq(0,100,20), lty=3, col="gray")
for(i in 1:nrow(cmsmp))
    lines(seq(2000, 2024, 4), 100*cmsmp[i,], type="b", lwd=2, col=newcolset[i], pch=(14+i))
legend(x=2014, y=100, legend=rownames(cmsmp)[1:4], lwd=2, pch=15:18, col=newcolset[1:4], box.lwd=0, bg="white")
legend(x=2020, y=100, legend=rownames(cmsmp)[5:8], lwd=2, pch=19:22, col=newcolset[5:8], box.lwd=0, bg="white")
dev.off()



# who does it think was running panels in 2000? -- this seems right
table(dfuse$match_name[dfuse$cycle==2000 & dfuse$year==2000 & dfuse$stage=="general" & cmssamplesset$cmmethods_panelist==1])
table(dfuse$match_name[dfuse$cycle==2004 & dfuse$year==2004 & dfuse$stage=="general" & cmssamplesset$cmmethods_panelist==1])

wtd.table(dfuse$match_name[dfuse$cycle==2000 & dfuse$year==2000 & dfuse$stage=="general" & cmssamplesset$cmmethods_panelist==1], dfuse$bestweight[dfuse$cycle==2000 & dfuse$year==2000 & dfuse$stage=="general" & cmssamplesset$cmmethods_panelist==1])

wtd.table(dfuse$match_name[dfuse$cycle==2016 & dfuse$year==2016 & dfuse$stage=="general" & cmssamplesset$cmmethods_riversample==1], dfuse$bestweight[dfuse$cycle==2016 & dfuse$year==2016 & dfuse$stage=="general" & cmssamplesset$cmmethods_riversample==1])

wtd.table(dfuse$match_name[dfuse$cycle==2000 & dfuse$year==2000 & dfuse$stage=="general" & cmssamplesset$cmmethods_sampledfromvoterfile==1], dfuse$bestweight[dfuse$cycle==2000 & dfuse$year==2000 & dfuse$stage=="general" & cmssamplesset$cmmethods_sampledfromvoterfile==1])


## RDD appears to be slightly overstated, but really this appears to mostly be random sampling of phone numbers from a list when it is wrong
rev(sort(table(dfuse$match_name[dfuse$cycle==2024 & dfuse$year==2024 & dfuse$stage=="general" & cmssamplesset$cmmethods_sampledrdd==1])))
rev(sort(table(dfuse$match_name[dfuse$cycle==2024 & dfuse$year==2024 & dfuse$stage=="general" & cmssamplesset$cmmethods_sampledabs==1])))

rev(sort(table(dfuse$match_name[dfuse$cycle==2024 & dfuse$year==2024 & dfuse$stage=="general" & cmssamplesset$cmmethods_sampledrdd==1])))

rev(sort(table(dfuse$match_name[dfuse$cycle==2024 & dfuse$year==2024 & dfuse$stage=="general" & cmssamplesset$cmmethods_sampledrdd==1])))


with(dfuse[dfuse$cycle==2024 & dfuse$year==2024 & dfuse$stage=="general",], xtabs(bestweight~(cmssamplesset[dfuse$cycle==2024 & dfuse$year==2024 & dfuse$stage=="general",]$cmmethods_sampledrdd==1)+firmsurvey_samplingmethods_RDD_Random_digit_dialing+firmsurvey_samplingmethods_List_based_sampling_of_phone_numbers_from_voter_file_data))

#table(dfuse$cmmethods_sampledrdd, 

table(allmercermode$mercermethods_frame_abs, cmssamplesset$cmmethods_sampledrdd)
table(allmercermode$mercermethods_frame_abs, dfuse$firmsurvey_samplingmethods_List_based_sampling_of_phone_numbers_from_voter_file_data)
table(cmssamplesset$cmmethods_sampledrdd, dfuse$firmsurvey_samplingmethods_List_based_sampling_of_phone_numbers_from_voter_file_data)

table(dfuse$pewmethod_rdd, cmssamplesset$cmmethods_sampledrdd)
cor(dfuse$pewmethod_rdd, cmssamplesset$cmmethods_sampledrdd, use="pair")
xtabs(~dfuse$pewmethod_rdd+cmssamplesset$cmmethods_sampledrdd+dfuse$cycle)

## odd here that the predictions seem near perfect for early years, but something doesn't seem to be working with 2024



# API weighting variables
apiwtvars <- dfuse[,grepl("wt|wei", colnames(dfuse)) & grepl("^api_", colnames(dfuse)) & !grepl("uncert|vars", colnames(dfuse))]
for(i in names(apiwtvars))
    apiwtvars[[i]] <- as.logical(apiwtvars[[i]])

apiwtmethodsovertime <- sapply(seq(2000, 2024, 4), function(y) sapply(apiwtvars[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], function(m) with(dfuse[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], sum(bestweight[m], na.rm=TRUE))))
apiwtmethodcodedovertime <- sapply(seq(2000, 2024, 4), function(y) sapply(apiwtvars[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], function(m) with(dfuse[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], sum(bestweight[!is.na(m)]))))
colnames(apiwtmethodsovertime) <- colnames(apiwtmethodcodedovertime) <- seq(2000, 2024, 4)

apiwtmethodsovertimeNAT <- sapply(seq(2000, 2024, 4), function(y) sapply(apiwtvars[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general" & dfuse$stateornat=="National",], function(m) with(dfuse[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general" & dfuse$stateornat=="National",], sum(bestweight[m], na.rm=TRUE))))
apiwtmethodcodedovertimeNAT <- sapply(seq(2000, 2024, 4), function(y) sapply(apiwtvars[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general" & dfuse$stateornat=="National",], function(m) with(dfuse[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general" & dfuse$stateornat=="National",], sum(bestweight[!is.na(m)]))))
colnames(apiwtmethodsovertimeNAT) <- colnames(apiwtmethodcodedovertimeNAT) <- seq(2000, 2024, 4)

apiwtmethodsovertimeNAT/apiwtmethodcodedovertimeNAT


apiwtmethodports <- apiwtmethodsovertime/apiwtmethodcodedovertime
apiwtmp <- apiwtmethodports[order(rowMeans(apiwtmethodports), decreasing=TRUE),]
rownames(apiwtmp) <- str_to_title(gsub("api_|weight", "", gsub("^age", "Age", gsub("gendsex", "Sex", gsub("raceth", "Race/Ethnicity", gsub("educ$", "Education", gsub("^vote$", "Past Vote Choice", rownames(apiwtmp))))))))

#showwts <- apiwtmp[rownames(apiwtmp) %in% c("age", "

jpeg("../Report/LinkedResults/Section_3_3/WeightingMethodsOverTime.jpg", width=12, height=8, units="in", res=1200)
newcolset <- c(brewer.pal(7, "Dark2"), brewer.pal(nrow(apiwtmp)-7, "Set1"))
plot(c(2000, 2024), 100*(0:1), type="n", ylab="Percentage of Matchup Reports Using Weighting Strategy", xlab="Date", main="Weighting Method Prevalence Over Time", las=1, axes=FALSE)
axis(1, c(-999,99999))
axis(2, c(-999,99999))
axis(3, c(-999,99999))
axis(4, c(-999,99999))
axis(1, seq(2000, 2024, 4))
axis(2)
abline(h=seq(0,100,20), lty=3, col="gray")
for(i in 1:7)
    lines(seq(2000, 2024, 4), 100*apiwtmp[i,], type="b", lwd=2, col=newcolset[i], pch=(14+i))
legend(x=2007, y=100, legend=rownames(apiwtmp)[1:4], lwd=2, pch=15:18, col=newcolset[1:4], box.lwd=0, bg="white")
legend(x=2011, y=100, legend=rownames(apiwtmp)[5:7], lwd=2, pch=19:22, col=newcolset[5:8], box.lwd=0, bg="white")
dev.off()

#apiwtmethodsovertimesampleports <- lapply(cmssamplesset, function(s) sapply(seq(2000, 2024, 4), function(y) sapply(apiwtvars[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general" & s,], function(m) with(dfuse[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general" & s,], sum(bestweight[m], na.rm=TRUE)/sum(bestweight[!is.na(m)])))))


with(dfuse[dfuse$cycle==2024 & dfuse$year==2024 & dfuse$stage=="general",], xtabs(bestweight~firmsurvey_weightvars_2020_election_choice_past_vote_+api_voteweight))

# API quota variables
apiquotvars <- dfuse[,grepl("quota", colnames(dfuse)) & grepl("^api_", colnames(dfuse)) & !grepl("uncert|vars", colnames(dfuse))]
for(i in names(apiquotvars))
    apiquotvars[[i]] <- as.logical(apiquotvars[[i]])

apiquotasovertime <- sapply(seq(2000, 2024, 4), function(y) sapply(apiquotvars[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], function(m) with(dfuse[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], sum(bestweight[m], na.rm=TRUE))))
apiquotascodedovertime <- sapply(seq(2000, 2024, 4), function(y) sapply(apiquotvars[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], function(m) with(dfuse[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], sum(bestweight[!is.na(m)]))))
colnames(apiquotasovertime) <- colnames(apiquotascodedovertime) <- seq(2000, 2024, 4)

apiquotaports <- apiquotasovertime/apiquotascodedovertime
apiquotmp <- apiquotaports[order(rowMeans(apiquotaports), decreasing=TRUE),]
rownames(apiquotmp) <- str_to_title(gsub("api_|quota", "", gsub("^age", "Age", gsub("gendsex", "Sex", gsub("raceth", "Race/Ethnicity", gsub("educ$", "Education", gsub("^vote$", "Past Vote Choice", rownames(apiquotmp))))))))

jpeg("../Report/LinkedResults/Section_3_3/QuotaMethodsOverTime.jpg", width=12, height=8, units="in", res=1200)
newcolset <- c(brewer.pal(7, "Dark2"), brewer.pal(nrow(apiquotmp)-7, "Set1"))
plot(c(2000, 2024), 100*(0:1), type="n", ylab="Percentage of Matchups Using Quota Variable", xlab="Date", main="Quota Variable Prevalence Over Time", las=1, axes=FALSE)
axis(1, c(-999,99999))
axis(2, c(-999,99999))
axis(3, c(-999,99999))
axis(4, c(-999,99999))
axis(1, seq(2000, 2024, 4))
axis(2)
abline(h=seq(0,100,20), lty=3, col="gray")
for(i in 1:7)
    lines(seq(2000, 2024, 4), 100*apiquotmp[i,], type="b", lwd=2, col=newcolset[i], pch=(14+i))
legend(x=2007, y=100, legend=rownames(apiquotmp)[1:4], lwd=2, pch=15:18, col=newcolset[1:4], box.lwd=0, bg="white")
legend(x=2011, y=100, legend=rownames(apiquotmp)[5:7], lwd=2, pch=19:22, col=newcolset[5:8], box.lwd=0, bg="white")
dev.off()


quotaaddsonly <- as.data.frame(mclapply(names(apiwtvars), function(x) dfuse[,gsub("weight", "quota", x)] & !as.logical(dfuse[,x])))
colnames(quotaaddsonly) <- gsub("weight", "quotanoweight", names(apiwtvars))

apiquotaaddsovertime <- sapply(seq(2000, 2024, 4), function(y) sapply(quotaaddsonly[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], function(m) with(dfuse[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], sum(bestweight[m], na.rm=TRUE))))
apiquotaaddscodedovertime <- sapply(seq(2000, 2024, 4), function(y) sapply(quotaaddsonly[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], function(m) with(dfuse[dfuse$cycle==y & dfuse$year==y & dfuse$stage=="general",], sum(bestweight[!is.na(m)]))))
colnames(apiquotaaddsovertime) <- colnames(apiquotaaddscodedovertime) <- seq(2000, 2024, 4)

apiquotaaddports <- apiquotaaddsovertime/apiquotaaddscodedovertime
apiquotaddmp <- apiquotaaddports[order(rowMeans(apiquotaaddports), decreasing=TRUE),]
rownames(apiquotaddmp) <- str_to_title(gsub("api_|quotanoweight", "", gsub("^age", "Age", gsub("gendsex", "Sex", gsub("raceth", "Race/Ethnicity", gsub("educ$", "Education", gsub("^vote$", "Past Vote Choice", rownames(apiquotaddmp))))))))

jpeg("../Report/LinkedResults/Section_3_3/AddedQuotaMethodsOverTime.jpg", width=12, height=8, units="in", res=1200)
newcolset <- c(brewer.pal(7, "Dark2"), brewer.pal(nrow(apiquotaddmp)-7, "Set1"))
plot(c(2000, 2024), 100*(0:1), ylim=c(0,25), type="n", ylab="Percentage of Matchups Using Quota Variable (but no corresponding weight)", xlab="Date", main="Quota Variable Prevalence Over Time", las=1, axes=FALSE)
axis(1, c(-999,99999))
axis(2, c(-999,99999))
axis(3, c(-999,99999))
axis(4, c(-999,99999))
axis(1, seq(2000, 2024, 4))
axis(2)
abline(h=seq(0,100,20), lty=3, col="gray")
for(i in 1:7)
    lines(seq(2000, 2024, 4), 100*apiquotaddmp[i,], type="b", lwd=2, col=newcolset[i], pch=(14+i))
legend(x=2007, y=25, legend=rownames(apiquotaddmp)[1:4], lwd=2, pch=15:18, col=newcolset[1:4], box.lwd=0, bg="white")
legend(x=2011, y=25, legend=rownames(apiquotaddmp)[5:7], lwd=2, pch=19:22, col=newcolset[5:8], box.lwd=0, bg="white")
dev.off()




## SECTION 4


sum(dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$bestweight>0 & !is.na(dfuse$demerr)])
dfuse$contest[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & is.na(dfuse$demerr)]


# Total firms
length(na.omit(unique(dfuse$match_name[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$bestweight>0 & !is.na(dfuse$demerr)])))

# Presidential firms
length(na.omit(unique(dfuse$match_name[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$bestweight>0 & !is.na(dfuse$demerr)])))

# Total last 2 week polls
sum(dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$bestweight>0 & !is.na(dfuse$demerr)])


## THERE ARE ALSO 2 CONTESTS BETWEEN INDEPENDENTS AND REPUBLICANS -- VT SENATE AND NE SENATE (only one of the two for the latter) -- these don't have a demerr

dfuse$contest[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & is.na(dfuse$demerr)]

dfuse$reperr[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & is.na(dfuse$demerr)]
dfuse$leadererror[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & is.na(dfuse$demerr)]
dfuse$totalabserror[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & is.na(dfuse$demerr)]-abs(dfuse$reperr[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & is.na(dfuse$demerr)])

dfuse$results_top2marginvote[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & is.na(dfuse$demerr)]-abs(dfuse$reperr[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & is.na(dfuse$demerr)])


# Presidential Last 2 week polls by type
wtd.table(dfuse$stateornat[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$bestweight>0 & !is.na(dfuse$demerr)], dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$bestweight>0 & !is.na(dfuse$demerr)])

# Other last 2 week polls by office
wtd.table(dfuse$office[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$bestweight>0 & !is.na(dfuse$demerr)], dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$bestweight>0 & !is.na(dfuse$demerr)])

# All last 2 week polls by office/level
wtd.table(paste(dfuse$office, dfuse$stateornat)[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$bestweight>0 & !is.na(dfuse$demerr)], dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$bestweight>0 & !is.na(dfuse$demerr)])

# All last 2 week polls by office/level/swing
wtd.table(paste(dfuse$office, dfuse$stateornat, dfuse$swingstate)[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$bestweight>0 & !is.na(dfuse$demerr)], dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$bestweight>0 & !is.na(dfuse$demerr)])

wpct(paste(dfuse$office, dfuse$stateornat, dfuse$swingstate)[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$bestweight>0 & !is.na(dfuse$demerr)], dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$bestweight>0 & !is.na(dfuse$demerr)])



#checkprob <- with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president",], xtabs(bestweight~updatedpollid))
#isprob <- dfuse[dfuse$updatedpollid=="F_89134" & !is.na(dfuse$updatedpollid),]
#F_89134
#checkprob <- with(dfuse[dfuse$stage=="general",], xtabs(bestweight~updatedpollid+office+district))


errorsetsstatenat <- t(sapply(unique(dfuse$stateornat), function(x) with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat==x,], c(Surveys=length(na.omit(unique(updatedpollid[bestweight>0]))), ContestPolls=sum(bestweight), Firms=length(na.omit(unique(match_name[bestweight>0]))), HarrisError=wtd.mean(demerror, bestweight, na.rm=TRUE), TrumpError=wtd.mean(reperror, bestweight, na.rm=TRUE), HarrisErrorAbs=wtd.mean(abs(demerror), bestweight, na.rm=TRUE), TrumpAbs=wtd.mean(abs(reperror), bestweight, na.rm=TRUE), OverallError=wtd.mean(demrepmargin, bestweight, na.rm=TRUE), OverallAbsError=wtd.mean(abs(demrepmargin), bestweight, na.rm=TRUE)))))

errorsetsswing <- t(sapply(levels(as.factor(dfuse$swingstates)), function(x) with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$swingstates==x & dfuse$stateornat=="State",], c(Surveys=length(na.omit(unique(updatedpollid[!is.na(bestweight)]))), ContestPolls=sum(bestweight), Firms=length(na.omit(unique(match_name[!is.na(bestweight)]))), HarrisError=wtd.mean(demerror, bestweight, na.rm=TRUE), TrumpError=wtd.mean(reperror, bestweight, na.rm=TRUE), HarrisErrorAbs=wtd.mean(abs(demerror), bestweight, na.rm=TRUE), TrumpAbs=wtd.mean(abs(reperror), bestweight, na.rm=TRUE), OverallError=wtd.mean(demrepmargin, bestweight, na.rm=TRUE), OverallAbsError=wtd.mean(abs(demrepmargin), bestweight, na.rm=TRUE)))))

errorsetsstatenat2020 <- t(sapply(unique(dfuse$stateornat), function(x) with(dfuse[dfuse$cycle=="2020" & dfuse$year=="2020" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat==x,], c(Surveys=length(na.omit(unique(updatedpollid[bestweight>0]))), ContestPolls=sum(bestweight), Firms=length(na.omit(unique(match_name[!is.na(bestweight)]))), BidenError=wtd.mean(demerror, bestweight, na.rm=TRUE), TrumpError=wtd.mean(reperror, bestweight, na.rm=TRUE), BidenErrorAbs=wtd.mean(abs(demerror), bestweight, na.rm=TRUE), TrumpAbs=wtd.mean(abs(reperror), bestweight, na.rm=TRUE), OverallError=wtd.mean(demrepmargin, bestweight, na.rm=TRUE), OverallAbsError=wtd.mean(abs(demrepmargin), bestweight, na.rm=TRUE)))))

errorsetsswing2020 <- t(sapply(levels(as.factor(dfuse$swingstates)), function(x) with(dfuse[dfuse$cycle=="2020" & dfuse$year=="2020" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$swingstates==x & dfuse$stateornat=="State",], c(Surveys=length(na.omit(unique(updatedpollid[!is.na(bestweight)]))), ContestPolls=sum(bestweight), Firms=length(na.omit(unique(match_name[bestweight>0]))), BidenError=wtd.mean(demerror, bestweight, na.rm=TRUE), TrumpError=wtd.mean(reperror, bestweight, na.rm=TRUE), BidenErrorAbs=wtd.mean(abs(demerror), bestweight, na.rm=TRUE), TrumpAbs=wtd.mean(abs(reperror), bestweight, na.rm=TRUE), OverallError=wtd.mean(demrepmargin, bestweight, na.rm=TRUE), OverallAbsError=wtd.mean(abs(demrepmargin), bestweight, na.rm=TRUE)))))



## SPIT OUT ALL RESULTS

eachoutcomevariable <- with(dfuse, data.frame(demerror, reperror, demabs=abs(demerror), repabs=abs(reperror), demrepmargin, demrepabs=abs(demrepmargin), leadererror, leaderabs=abs(leadererror), meanabserror, totalabserror, moedifsdemrep, moedifsdemrepabs=abs(moedifsdemrep), correctwinner=as.numeric(correctwinner)))

eachtimemetrics <- data.frame(lapply(timekeys, function(f) data.frame(as.data.frame(rbindlist(lapply(keyvars[f,], function(y) data.frame(mclapply(eachoutcomevariable[f,], function(g) data.frame(Estimate=xtabs(eval(g*dfuse$bestweight[f])~y, na.rm=TRUE)/xtabs(eval((!is.na(g))*dfuse$bestweight[f])~y, na.rm=TRUE), N=xtabs(eval((!is.na(g))*dfuse$bestweight[f])~y, na.rm=TRUE))))), fill=TRUE), idcol="var"), sep="")))

colnames(eachtimemetrics)[1] <- "Level"
etmkeep <- eachtimemetrics[,!grepl("\\.N\\.y$|\\.Estimate\\.y$", colnames(eachtimemetrics))]
colnames(etmkeep) <- gsub("\\.Freq|\\.Estimate", "", colnames(etmkeep))

write.csv(etmkeep, "../Report/LinkedResults/Section_4_1/KeyAccuracyMetrics.csv")


keycatmetrics <- lapply(keycats, function(k) data.frame(lapply(timekeys, function(f) data.frame(as.data.frame(rbindlist(lapply(keyvars[f & k,], function(y) data.frame(mclapply(eachoutcomevariable[f & k,], function(g) data.frame(Estimate=xtabs(eval(g*dfuse$bestweight[f & k])~y, na.rm=TRUE)/xtabs(eval((!is.na(g))*dfuse$bestweight[f & k])~y, na.rm=TRUE), N=xtabs(eval((!is.na(g))*dfuse$bestweight[f & k])~y, na.rm=TRUE))))), fill=TRUE), idcol="var"), sep=""))))
for(i in 1:length(keycatmetrics)){
    colnames(keycatmetrics[[i]])[1] <- "Level"
    keycatmetrics[[i]] <- keycatmetrics[[i]][,!grepl("\\.N\\.y$|\\.Estimate\\.y$", colnames(keycatmetrics[[i]]))]
    colnames(keycatmetrics[[i]]) <- gsub("\\.Freq|\\.Estimate", "", colnames(keycatmetrics[[i]]))
}

names(keycatmetrics) <- gsub("rlsample", "rlsamp", gsub("probability", "prob", gsub("\\.|simplified|At\\.least\\.some", "", names(keycatmetrics))))

statesmetrics <- lapply(statedummies, function(k) data.frame(lapply(timekeys, function(f) data.frame(as.data.frame(rbindlist(lapply(keyvars[f & k,], function(y) data.frame(mclapply(eachoutcomevariable[f & k,], function(g) data.frame(Estimate=xtabs(eval(g*dfuse$bestweight[f & k])~y, na.rm=TRUE)/xtabs(eval((!is.na(g))*dfuse$bestweight[f & k])~y, na.rm=TRUE), N=xtabs(eval((!is.na(g))*dfuse$bestweight[f & k])~y, na.rm=TRUE))))), fill=TRUE), idcol="var"), sep=""))))
for(i in 1:length(statesmetrics)){
    colnames(statesmetrics[[i]])[1] <- "Level"
    statesmetrics[[i]] <- statesmetrics[[i]][,!grepl("\\.N\\.y$|\\.Estimate\\.y$", colnames(statesmetrics[[i]]))]
    colnames(statesmetrics[[i]]) <- gsub("\\.Freq|\\.Estimate", "", colnames(statesmetrics[[i]]))
}

wbpollingErrors <- createWorkbook("ErrorsByPolls")
addWorksheet(wbpollingErrors, paste0("Overall Errors"))
writeData(wbpollingErrors, sheet = "Overall Errors", etmkeep)
for(i in names(keycatmetrics)){
    addWorksheet(wbpollingErrors, paste0("Err_", gsub("\\.", "", i)))
    writeData(wbpollingErrors, sheet = paste0("Err_", gsub("\\.", "", i)), keycatmetrics[[i]])
}
for(i in names(statesmetrics)){
    addWorksheet(wbpollingErrors, paste0("Err_", gsub("\\.", "", i)))
    writeData(wbpollingErrors, sheet = paste0("Err_", gsub("\\.", "", i)), statesmetrics[[i]])
}
saveWorkbook(wbpollingErrors, "../Report/LinkedResults/Section_4_1/InformationOnPollingErrors.xlsx", overwrite = TRUE)
rm(wbpollingErrors)


## 

etmkeep[grepl("2024", etmkeep$Level) & grepl("general", etmkeep$Level),grepl("Level|demrep", colnames(etmkeep)) & grepl("Level|last2weeks", colnames(etmkeep))]

etmkeep[grepl("2024", etmkeep$Level) & grepl("general", etmkeep$Level),grepl("Level|err", colnames(etmkeep)) & grepl("Level|last2weeks", colnames(etmkeep))]

# Number of Firms
length(na.omit(unique(dfuse$match_name[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="National"])))


dfuse$cutptserrors <- cut(100*abs(dfuse$demrepmargin), c(0:14, 99)-.1, c("less than 1 point", paste(1:13, "-", 2:14), "14 points or more"))

wtd.quantile(100*abs(dfuse$demrepmargin)[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"], c(0,.05,.25,.33,.5,.66,.95,1), na.rm=TRUE, weight=dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"])

# Proportion less than 3pp
wpct(abs(dfuse$demrepmargin)[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"]<.03, weight=dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"])
wpct(abs(dfuse$demrepmargin)[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"]<.01, weight=dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"])






jpeg("../Report/LinkedResults/Section_4_1/AbsoluteErrorsInPercentagePointsPresidentialState.jpg", width=8, height=3, units="in", res=1200)
par(mfrow=c(1,3))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="State",], wtd.hist(100*abs(demrepmargin), breaks=c(0:99)-.1, weight=bestweight, xlim=c(0,17),  xlab="Polling Error", main="State Estimate Absolute Errors", col=brewer.pal(4, "Paired")[3]))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="State" & dfuse$swingstate,], wtd.hist(100*abs(demrepmargin), breaks=c(0:99)-.1, weight=bestweight, xlim=c(0,15), xlab="Polling Error", main="State Estimate Errors", add=TRUE,  col=brewer.pal(4, "Paired")[4]))
abline(v=with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="State",], wtd.mean(100*abs(demrepmargin), weight=bestweight, na.rm=TRUE)), col="red")
legend(x="topright", legend=c("Swing States", "Other States"), fill=brewer.pal(4, "Paired")[4:3])
legend("right", title="Not Shown", rd(with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="State",], (100*abs(demrepmargin))[(100*abs(demrepmargin)>17)]), 1), fill=brewer.pal(4, "Paired")[3])
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="National",], wtd.hist(100*abs(demrepmargin), breaks=c(0:99)-.1, weight=bestweight, xlim=c(0,17), xlab="Polling Error", main="National Estimate Absolute Errors",  col=brewer.pal(7, "Paired")[7]))
abline(v=with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="National",], wtd.mean(100*abs(demrepmargin), weight=bestweight, na.rm=TRUE)), col="red")
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="Congressional District",], wtd.hist(100*abs(demrepmargin), breaks=c(0:99)-.1, weight=bestweight, xlim=c(0,17), xlab="Polling Error", main="Absolute Errors in\nCongressional Districts (ME & NE)",  col=brewer.pal(4, "Set2")[4]))
abline(v=with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="Congressional District",], wtd.mean(100*abs(demrepmargin), weight=bestweight, na.rm=TRUE)), col="red")
dev.off()

dfuse$state[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"  & dfuse$demrepmargin>.1]
dfuse$demrepmargin[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"  & dfuse$demrepmargin>.1]


jpeg("../Report/LinkedResults/Section_4_1/AbsoluteErrorsInPercentagePointsOtherContests.jpg", width=8, height=3, units="in", res=1200)
par(mfrow=c(1,3))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="senate",], wtd.hist(100*abs(demrepmargin), breaks=c(0:99)-.1, weight=bestweight, xlim=c(0,17), xlab="Polling Error", main="U.S. Senate Absolute Errors",  col=brewer.pal(3, "Set2")[1]))
abline(v=with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="senate",], wtd.mean(100*abs(demrepmargin), weight=bestweight, na.rm=TRUE)), col="red")
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="senate",], sum(bestweight*((100*abs(demrepmargin))>17), na.rm=TRUE))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="governor",], wtd.hist(100*abs(demrepmargin), breaks=c(0:99)-.1, weight=bestweight, xlim=c(0,17), xlab="Polling Error", main="Governor Absolute Errors",  col=brewer.pal(3, "Set2")[2]))
abline(v=with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="governor",], wtd.mean(100*abs(demrepmargin), weight=bestweight, na.rm=TRUE)), col="red")
legend("topright", title="Not Shown", rd(with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="governor",], (100*abs(demrepmargin))[(100*abs(demrepmargin)>17)]), 1), fill=brewer.pal(3, "Set2")[2])
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="house",], wtd.hist(100*abs(demrepmargin), breaks=c(0:99)-.1, weight=bestweight, xlim=c(0,17), xlab="Polling Error", main="U.S. House Absolute Errors",  col=brewer.pal(3, "Set2")[3]))
abline(v=with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="house",], wtd.mean(100*abs(demrepmargin), weight=bestweight, na.rm=TRUE)), col="red")
legend("topright", title="Not Shown", rd(na.omit(with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="house",], sort((100*abs(demrepmargin))[(100*abs(demrepmargin)>17)]))), 1), fill=brewer.pal(3, "Set2")[3])
dev.off()




dfuse$demrepmargin[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="house" & dfuse$demrepmargin>.15 & !is.na(dfuse$demrepmargin)]

## The enormous error of the Dartmouth poll
dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$demrepmargin>.17 & !is.na(dfuse$demrepmargin),]

## What Happens to Errors When Removed?
monstererrorsurvey <- dfuse$updatedpollid[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$demrepmargin>.17 & !is.na(dfuse$demrepmargin)][1]
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="house",], wtd.mean(100*abs(demrepmargin), weight=bestweight))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="house" & dfuse$updatedpollid!=monstererrorsurvey,], wtd.mean(100*abs(demrepmargin), weight=bestweight))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="governor",], wtd.mean(100*abs(demrepmargin), weight=bestweight))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="governor" & dfuse$updatedpollid!=monstererrorsurvey,], wtd.mean(100*abs(demrepmargin), weight=bestweight))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="State",], wtd.mean(100*abs(demrepmargin), weight=bestweight))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="State" & dfuse$updatedpollid!=monstererrorsurvey,], wtd.mean(100*abs(demrepmargin), weight=bestweight))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="State" & !dfuse$swingstate,], wtd.mean(100*abs(demrepmargin), weight=bestweight))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="State" & !dfuse$swingstate & dfuse$updatedpollid!=monstererrorsurvey,], wtd.mean(100*abs(demrepmargin), weight=bestweight))


## Signed Error Distributions

jpeg("../Report/LinkedResults/Section_4_1/SignedErrorsInPercentagePoints.jpg", width=8, height=6, units="in", res=1200)
par(mfrow=c(2,3))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="State",], wtd.hist(100*demrepmargin, breaks=c(-99:99)-.1, weight=bestweight, xlim=c(-10,17),  xlab="Polling Error", main="State Estimate Signed Differences", col=brewer.pal(4, "Paired")[3]))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="State" & dfuse$swingstate,], wtd.hist(100*(demrepmargin), breaks=c(-99:99)-.1, weight=bestweight, xlim=c(-10,17), xlab="Polling Error", main="State Estimate Signed Differences", add=TRUE,  col=brewer.pal(4, "Paired")[4]))
abline(v=with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="State",], wtd.mean(100*(demrepmargin), weight=bestweight, na.rm=TRUE)), col="red")
legend(x="topright", legend=c("Swing States", "Other States"), fill=brewer.pal(4, "Paired")[4:3])
legend("right", title="Not Shown", rd(with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="State",], (100*(demrepmargin))[(100*abs(demrepmargin)>17)]), 1), fill=brewer.pal(4, "Paired")[3])
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="National",], wtd.hist(100*(demrepmargin), breaks=c(-99:99)-.1, weight=bestweight, xlim=c(-10,17), xlab="Polling Error", main="National Estimate Signed Differences",  col=brewer.pal(7, "Paired")[7]))
abline(v=with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="National",], wtd.mean(100*(demrepmargin), weight=bestweight, na.rm=TRUE)), col="red")
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="Congressional District",], wtd.hist(100*(demrepmargin), breaks=c(-99:99)-.1, weight=bestweight, xlim=c(-10,17), xlab="Polling Error", main="Signed Differences in\nCongressional Districts (ME & NE)",  col=brewer.pal(4, "Set2")[4]))
abline(v=with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="Congressional District",], wtd.mean(100*(demrepmargin), weight=bestweight, na.rm=TRUE)), col="red")
#dev.off()
#jpeg("../Report/LinkedResults/Section_4_1/SignedErrorsInPercentagePointsOtherContests.jpg", width=12, height=5, units="in", res=1200)
#par(mfrow=c(1,3))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="senate",], wtd.hist(100*(demrepmargin), breaks=c(-99:99)-.1, weight=bestweight, xlim=c(-10,17), xlab="Polling Error", main="U.S. Senate Signed Errors",  col=brewer.pal(3, "Set2")[1]))
abline(v=with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="senate",], wtd.mean(100*(demrepmargin), weight=bestweight, na.rm=TRUE)), col="red")
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="governor",], wtd.hist(100*(demrepmargin), breaks=c(-99:99)-.1, weight=bestweight, xlim=c(-10,17), xlab="Polling Error", main="Governor Signed Errors",  col=brewer.pal(3, "Set2")[2]))
abline(v=with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="governor",], wtd.mean(100*(demrepmargin), weight=bestweight, na.rm=TRUE)), col="red")
legend("topright", title="Not Shown", rd(with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="governor",], (100*(demrepmargin))[(100*abs(demrepmargin)>17)]), 1), fill=brewer.pal(3, "Set2")[2])
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="house",], wtd.hist(100*(demrepmargin), breaks=c(-99:99)-.1, weight=bestweight, xlim=c(-10,17), xlab="Polling Error", main="U.S. House Signed Errors",  col=brewer.pal(3, "Set2")[3]))
abline(v=with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="house",], wtd.mean(100*(demrepmargin), weight=bestweight, na.rm=TRUE)), col="red")
legend("topright", title="Not Shown", rd(na.omit(with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="house",], sort((100*(demrepmargin))[(100*abs(demrepmargin)>17)]))), 1), fill=brewer.pal(3, "Set2")[3])
dev.off()

with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="State",], wtd.mean(demrepmargin>0, weight=bestweight))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="State" & dfuse$swingstate,], wtd.mean(demrepmargin>0, weight=bestweight))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="National",], wtd.mean(demrepmargin>0, weight=bestweight))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="Congressional District",], wtd.mean(demrepmargin>0, weight=bestweight))

with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="governor",], wtd.mean(demrepmargin>0, weight=bestweight))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="senate",], wtd.mean(demrepmargin>0, weight=bestweight))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="house",], wtd.mean(demrepmargin>0, weight=bestweight))

## HOW OFTEN DID EACH TYPE OF POLL CORRECTLY IDENTIFY THE WINNER?

dfuse$correctwinner[is.na(dfuse$correctwinner)] <- ((as.numeric(as.character(dfuse$surveydemminusrep[is.na(dfuse$correctwinner)])))*(as.numeric(as.character(dfuse$surveydemminusrep[is.na(dfuse$correctwinner)]))))>0

with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="State",], wtd.mean(correctwinner, weight=bestweight))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="State" & dfuse$swingstate,], wtd.mean(correctwinner, weight=bestweight))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="National",], wtd.mean(correctwinner, weight=bestweight))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="Congressional District",], wtd.mean(correctwinner, weight=bestweight))

with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="governor",], wtd.mean(correctwinner, weight=bestweight))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="senate",], wtd.mean(correctwinner, weight=bestweight))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="house",], wtd.mean(correctwinner, weight=bestweight))


## PRESIDENTIAL CORRECT WINNER NATIONALLY AND BY STATE

bystatepres2024 <- with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$bestweight>0,], split(data.frame(bestweight, correctwinner, votedemminusrep, surveydemminusrep, state), state))
bystatepres2024 <- bystatepres2024[!(names(bystatepres2024) %in% "puerto rico")]
bystatepres2024 <- bystatepres2024[order(sapply(bystatepres2024, function(x) x$votedemminusrep[1]))]
voteportsstate <- sapply(bystatepres2024, function(x) x$votedemminusrep[1])
meaneststate <- sapply(bystatepres2024, function(x) wtd.mean(x$surveydemminusrep, x$bestweight, na.rm=TRUE))
correctwinnerstate <- sapply(bystatepres2024, function(x) wtd.mean(x$correctwinner, x$bestweight, na.rm=TRUE))
incorrectwinnerstate <- sapply(bystatepres2024, function(x) wtd.mean(((x$votedemminusrep*x$surveydemminusrep)<0), x$bestweight, na.rm=TRUE))
nstate <- sapply(bystatepres2024, function(x) sum((!is.na(x$votedemminusrep)*x$bestweight), na.rm=TRUE))
1-(correctwinnerstate+incorrectwinnerstate) # Proportions of ties

cwcol <- rep("black", length(correctwinnerstate))
cwcol[correctwinnerstate<1] <- "purple"
cwcol[incorrectwinnerstate>correctwinnerstate] <- "red"


colman1 <- brewer.pal(8, "Dark2")


jpeg("../Report/LinkedResults/Section_4_1/PresidentialErrorsByState.jpg", width=10, height=12, units="in", res=1200)
plot(c(-1.15, .45), c(1, length(bystatepres2024)), type="n", axes=FALSE, ylab="", xlab="Democratic Share - Republican Share", main="Presidential Survey Estimates and Results")
abline(v=seq(-.5,.4,.1), lty=3, col="light gray")
for(i in 1:length(bystatepres2024))
    lines(bystatepres2024[[i]]$surveydemminusrep, rep(i, length(bystatepres2024[[i]]$surveydemminusrep)), cex=sqrt(bystatepres2024[[i]]$bestweight)*.7, col="gray70", pch=20, type="p")
lines(voteportsstate, 1:length(voteportsstate), type="p", pch=18, col=colman1[1], cex=1.5)
lines(meaneststate, 1:length(voteportsstate), type="p", pch=20, col=colman1[2], cex=1)
text(-1.15, 1:(length(bystatepres2024)+1), gsub("Cd", "CD", str_to_title(c(names(bystatepres2024), "Location"))), pos=4, col=cwcol)
text(-.75, 1:(length(bystatepres2024)+1), c(paste0(rd(100*correctwinnerstate, 0), "%"), "Corr."), pos=2, col=cwcol)
text(-.65, 1:(length(bystatepres2024)+1), c(paste0(gsub(".000", "", rd(100*incorrectwinnerstate, 0)), "%"), "Inc."), pos=2, col=cwcol)
text(-.58, 1:(length(bystatepres2024)+1), c(nstate, "N"), pos=2, col=cwcol)
abline(v=0)
axis(1, seq(-.5,.4,.1), seq(-50,40,10))
legend("bottomright", c("Actual Votes", "Mean Poll", "Individual Results"), pch=c(18,20,20), col=c(colman1[1:2], "gray70"), pt.cex=c(1.5,1,.7))
dev.off()

# For other offices


bystatenonpres2024 <- with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office!="president" & dfuse$bestweight>0 & !is.na(dfuse$votedemminusrep) & !is.na(dfuse$surveydemminusrep),], split(data.frame(bestweight, correctwinner, votedemminusrep, surveydemminusrep, state, office, district), paste(state, office, district)))
bystatenonpres2024 <- bystatenonpres2024[!grepl("virgin", (names(bystatenonpres2024)))]
bystatenonpres2024 <- bystatenonpres2024[order(sapply(bystatenonpres2024, function(x) x$votedemminusrep[1]))]
names(bystatenonpres2024) <- gsub(" $| NA$", "", names(bystatenonpres2024))
voteportsstateNP <- sapply(bystatenonpres2024, function(x) x$votedemminusrep[1])
meaneststateNP <- sapply(bystatenonpres2024, function(x) wtd.mean(x$surveydemminusrep, x$bestweight, na.rm=TRUE))
correctwinnerstateNP <- sapply(bystatenonpres2024, function(x) wtd.mean(x$correctwinner, x$bestweight, na.rm=TRUE))
incorrectwinnerstateNP <- sapply(bystatenonpres2024, function(x) wtd.mean(((x$votedemminusrep*x$surveydemminusrep)<0), x$bestweight, na.rm=TRUE))
nstateNP <- sapply(bystatenonpres2024, function(x) sum((!is.na(x$votedemminusrep)*x$bestweight), na.rm=TRUE))
1-(correctwinnerstateNP+incorrectwinnerstateNP) # Proportions of ties

cwcolNP <- rep("black", length(correctwinnerstateNP))
cwcolNP[correctwinnerstateNP<1] <- "purple"
cwcolNP[incorrectwinnerstateNP>correctwinnerstateNP] <- "red"

jpeg("../Report/LinkedResults/Section_4_1/NonPresidentialErrorsByState.jpg", width=10, height=12, units="in", res=1200)
plot(c(-1.37, .45), c(1, length(bystatenonpres2024)), type="n", axes=FALSE, ylab="", xlab="Democratic Share - Republican Share", main="Non-Presidential Survey Estimates and Results")
abline(v=seq(-.6,.4,.1), lty=3, col="light gray")
for(i in 1:length(bystatenonpres2024))
    lines(bystatenonpres2024[[i]]$surveydemminusrep, rep(i, length(bystatenonpres2024[[i]]$surveydemminusrep)), cex=sqrt(bystatenonpres2024[[i]]$bestweight)*.7, col="gray70", pch=20, type="p")
lines(voteportsstateNP, 1:length(voteportsstateNP), type="p", pch=18, col=colman1[1], cex=1.5)
lines(meaneststateNP, 1:length(voteportsstateNP), type="p", pch=20, col=colman1[2], cex=1)
text(-1.37, 1:(length(bystatenonpres2024)+1), gsub("Cd", "CD", str_to_title(c(names(bystatenonpres2024), "Location"))), pos=4, col=cwcolNP)
text(-.79, 1:(length(bystatenonpres2024)+1), c(paste0(gsub(".000", "", rd(100*correctwinnerstateNP, 0)), "%"), "Corr."), pos=2, col=cwcolNP)
text(-.69, 1:(length(bystatenonpres2024)+1), c(paste0(gsub(".000", "", rd(100*incorrectwinnerstateNP, 0)), "%"), "Inc."), pos=2, col=cwcolNP)
text(-.62, 1:(length(bystatenonpres2024)+1), c(nstateNP, "N"), pos=2, col=cwcolNP)
abline(v=0)
axis(1, seq(-.6,.4,.1), seq(-60,40,10))
legend("bottomright", c("Actual Votes", "Mean Poll", "Individual Results"), pch=c(18,20,20), col=c(colman1[1:2], "gray70"), pt.cex=c(1.5,1,.7))
dev.off()

with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general",], xtabs((bestweight*correctwinner)~paste(office, stateornat), na.rm=TRUE)/xtabs(((!is.na(correctwinner))*bestweight)~paste(office, stateornat), na.rm=TRUE))

with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general",], xtabs((bestweight*((votedemminusrep*surveydemminusrep)<0))~paste(office, stateornat), na.rm=TRUE)/xtabs((bestweight*(!is.na((votedemminusrep*surveydemminusrep)<0)))~paste(office, stateornat), na.rm=TRUE))


## Margin of Error Estimates



#plot(abs(dfuse$demrepmargin[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"]), jitter(dfuse$combinedmarginoferror[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"]/100, amount=.02))



# Margins of Error

summary(dfuse$sample_size)
minmoe <- 1.5*sqrt((.5*.5)/dfuse$sample_size)
minmoe[dfuse$sample_size==0] <- NA

table(minmoe<(dfuse$combinedmarginoferror/100))

dfuse$moeuse <- dfuse$combinedmarginoferror
dfuse$moeuse[dfuse$combinedmarginoferror<1 & is.na(minmoe) & is.na(dfuse$combinedmarginoferror)] <- NA
dfuse$moeuse[minmoe>(dfuse$combinedmarginoferror/100) & !is.na(minmoe) & !is.na(dfuse$combinedmarginoferror)] <- NA#100*minmoe[minmoe>(dfuse$combinedmarginoferror/100) & !is.na(minmoe) & !is.na(dfuse$combinedmarginoferror)]
#dfuse$moeuse[!is.na(minmoe) & is.na(dfuse$combinedmarginoferror)] <- 100*minmoe[!is.na(minmoe) & is.na(dfuse$combinedmarginoferror) & !is.na(dfuse$minmoe)]

jpeg("../Report/LinkedResults/Section_4_1/ReportedMarginsOfError.jpg", width=8, height=8, units="in", res=1200)
wtd.hist(dfuse$moeuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & !is.na(dfuse$moeuse) & !is.na(dfuse$demrepmargin) & dfuse$bestweight>0], breaks=(seq(0,6,.5)), weight=dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & !is.na(dfuse$moeuse) & !is.na(dfuse$demrepmargin) & dfuse$bestweight>0], col="gray70", main="Distributions of Reported Margins of Error for Presidential Polls", xlab="Reported Margin of Error")
abline(v=wtd.mean(dfuse$moeuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & !is.na(dfuse$moeuse) & !is.na(dfuse$demrepmargin) & dfuse$bestweight>0], weight=dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & !is.na(dfuse$moeuse) & !is.na(dfuse$demrepmargin) & dfuse$bestweight>0]), col="red")
dev.off()

sum((!is.na(dfuse$moeuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & !is.na(dfuse$moeuse) & !is.na(dfuse$demrepmargin) & dfuse$bestweight>0]))*dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & !is.na(dfuse$moeuse) & !is.na(dfuse$demrepmargin) & dfuse$bestweight>0])

sum(dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & !is.na(dfuse$demrepmargin) & dfuse$bestweight>0])

presmoemean <- wtd.mean(dfuse$moeuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & !is.na(dfuse$moeuse) & !is.na(dfuse$demrepmargin) & dfuse$bestweight>0], weight=dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & !is.na(dfuse$moeuse) & !is.na(dfuse$demrepmargin) & dfuse$bestweight>0])
presmoemean


colman1 <- brewer.pal(8, "Dark2")

jpeg("../Report/LinkedResults/Section_4_1/SurveyErrorsvsMOE.jpg", width=12, height=6, units="in", res=1200)
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & !is.na(dfuse$moeuse) & !is.na(dfuse$demrepmargin) & dfuse$bestweight>0,],
     plot(abs(100*demrepmargin), jitter(moeuse, 20), type="p", pch=20, ylim=c(-1.5,6), ylab="Reported Margin of Error", xlab="Absolute Error", main="Presidential Poll Survey Errors vs. Margins of Error", col="gray50", cex=bestweight, axes=FALSE))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & is.na(dfuse$moeuse) & !is.na(dfuse$demrepmargin) & dfuse$bestweight>0,],
     lines(abs(100*demrepmargin), jitter(rep(-1, length(demrepmargin)), 10), type="p", pch=20, col="gray50", cex=bestweight))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & !is.na(dfuse$moeuse) & !is.na(dfuse$demrepmargin) & dfuse$bestweight>0,],
     abline(v=wtd.mean(moeuse, bestweight), col="blue", lty=3))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & !is.na(dfuse$moeuse) & !is.na(dfuse$demrepmargin) & dfuse$bestweight>0,],
     abline(v=2*wtd.mean(moeuse, bestweight), col="blue", lty=2))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & !is.na(dfuse$moeuse) & !is.na(dfuse$demrepmargin) & dfuse$bestweight>0,],
     segments(0, 0, 100, 100, col="red", lty=3))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & !is.na(dfuse$moeuse) & !is.na(dfuse$demrepmargin) & dfuse$bestweight>0,],
     segments(0,0,100,50, col="red", lty=2))
abline(h=0)
abline(v=0)
axis(1)
axis(2, -1:6, c("NR", 0:6), las=2)
axis(1, c(-99,99))
axis(2, c(-99,99))
axis(3, c(-99,99))
axis(4, c(-99,99))
dev.off()


wtd.table(!is.na(dfuse$moeuse)[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"  & !is.na(dfuse$demrepmargin) & dfuse$bestweight>0], dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"  & !is.na(dfuse$demrepmargin) & dfuse$bestweight>0])
wpct(!is.na(dfuse$moeuse)[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"  & !is.na(dfuse$demrepmargin) & dfuse$bestweight>0], dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & !is.na(dfuse$demrepmargin) & dfuse$bestweight>0])

summary(dfuse$moeuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"])

wtd.table(cut((100*dfuse$demrepmargin/dfuse$moeuse)[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"], breaks=c(0, 1, 2, 99)), dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"])
wpct(cut((100*dfuse$demrepmargin/dfuse$moeuse)[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"], breaks=c(0, 1, 2, 99)), dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"])

wtd.table(cut((100*dfuse$demrepmargin/presmoemean)[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"], breaks=c(0, 1, 2, 99)), dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"])
wpct(cut((100*dfuse$demrepmargin/presmoemean)[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"], breaks=c(0, 1, 2, 99)), dfuse$bestweight[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president"])




### Other Polling Error Measures
runaltmetrics <- function(x, moe, weight=NULL){
    if(is.null(weight))
        weight <- rep(1, length(x))
    rmse <- sqrt(wtd.mean(x^2, weights=weight, na.rm=TRUE))
    meanabserror <- wtd.mean(abs(x), weights=weight, na.rm=TRUE)
    outsideMoE <- wtd.mean(abs(x)>(moe/100), weights=weight, na.rm=TRUE)
    medianabserror <- wtd.quantile(abs(x), weight=weight, probs=.5, na.rm=TRUE)
    meansignederror <- wtd.mean(x, weights=weight, na.rm=TRUE)
    mediansignederror <- wtd.quantile(x, weight=weight, probs=.5, na.rm=TRUE)
    outset <- c(rmse=rmse, meanabserror=meanabserror, outsideMoE=outsideMoE, medianabserror=medianabserror, meansignederror=meansignederror, mediansignederror=mediansignederror)
    outset
}

ramby <- function(x, y, moe, weight)
    lapply(levels(y), function(q) try(runaltmetrics(x[y==q & f], moe[y==q & f], weight[y==q & f])))

f <- timekeys[,"lastweek"]
y <- keyvars[,"cycle.stagemin"]
q <- levels(y)[1]

x <- dfuse$demrepmargin
moe <- dfuse$moeuse
weight <- dfuse$bestweight

bystageyear <- ramby(dfuse$demrepmargin, y=keyvars[,"cycle.stagemin"], moe=moe, weight=weight)
names(bystageyear) <- levels(keyvars[,"cycle.stagemin"])


bystageyearoffice <- ramby(dfuse$demrepmargin, y=keyvars[,"cycle.stagemin.stateornat.office"], moe=moe, weight=weight)
names(bystageyearoffice) <- levels(keyvars[,"cycle.stagemin.stateornat.office"])











## Splitting Errors By Party of Candidate


demerrmn <- with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president",], 100*wtd.mean(demerror, bestweight, na.rm=TRUE))
reperrmn <- with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president",], 100*wtd.mean(reperror, bestweight, na.rm=TRUE))

jpeg("../Report/LinkedResults/Section_4_1/ErrorsByParty.jpg", width=12, height=8, units="in", res=1200)
par(mfrow=c(1,2))
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president",], plot(100*demerror, 100*reperror, pch=19, cex=sqrt(bestweight), col="gray70", xlab="Poll Difference for Harris (Survey - Vote)", ylab="Poll Difference for Trump (Survey - Vote)", main="Differences By Party\nAcross All Presidential Contests", ylim=c(-15,5)))
abline(v=seq(-40,40,5), col="gray", lty=3)
abline(h=seq(-40,40,5), col="gray", lty=3)
abline(h=0, col="gray", lty=1)
abline(v=0, col="gray", lty=1)
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president",], lines(100*demerror, 100*reperror, pch=19, cex=sqrt(bestweight), type="p", col="gray70"))
lines(demerrmn, reperrmn, col=colman1[1], type="p", pch=15, cex=2)
lines(0,0,type="p", pch=18, col=colman1[2], cex=3)
legend(x="bottomleft", legend=c("Survey Result", "Size ~ Unique Contribution", "Final Vote Share", "Average Estimate"), pch=c(19, 20, 18, 15), col=c("gray70", "gray70", colman1[2], colman1[1]), cex=1)
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office!="president",], plot(100*demerror, 100*reperror, pch=19, cex=sqrt(bestweight), col="gray70", xlab="Poll Difference for Democrat (Survey - Vote)", ylab="Poll Difference for Republican (Survey - Vote)", main="Differences By Party\nAcross Non-Presidential Contests", ylim=c(-15,5)))
abline(v=seq(-40,40,5), col="gray", lty=3)
abline(h=seq(-40,40,5), col="gray", lty=3)
abline(h=0, col="gray", lty=1)
abline(v=0, col="gray", lty=1)
with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office!="president",], lines(100*demerror, 100*reperror, pch=19, cex=sqrt(bestweight), type="p", col="gray70"))
lines(demerrmn, reperrmn, col=colman1[1], type="p", pch=15, cex=2)
lines(0,0,type="p", pch=18, col=colman1[2], cex=3)
legend(x="bottomleft", legend=c("Survey Result", "Size ~ Unique Contribution", "Final Vote Share", "Average Estimate"), pch=c(19, 20, 18, 15), col=c("gray70", "gray70", colman1[2], colman1[1]), cex=1)
dev.off()


demerrvar <- with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president",], 100*wtd.var(demerror, bestweight, na.rm=TRUE))
reperrvar <- with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president",], 100*wtd.var(reperror, bestweight, na.rm=TRUE))

bycontestdemreperrs <- with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general",], split(data.frame(demerror, reperror, bestweight), paste(office, state, district)))

demmnerconts <- sapply(bycontestdemreperrs, function(x) abs(x$demerror-wtd.mean(x$demerror, x$bestweight)))
repmnerconts <- sapply(bycontestdemreperrs, function(x) abs(x$reperror-wtd.mean(x$reperror, x$bestweight)))

dmcd <- data.frame(dem=unlist(demmnerconts[sapply(demmnerconts, length)>1]), rep=unlist(repmnerconts[sapply(repmnerconts, length)>1]), rbindlist(bycontestdemreperrs[sapply(demmnerconts, length)>1]))
dmcduse <- dmcd[!(dmcd$dem==0 & dmcd$rep==0),]

wtd.mean(dmcduse$dem, dmcduse$bestweight)
wtd.mean(dmcduse$rep, dmcduse$bestweight)
wtd.mean(dmcduse$rep>dmcduse$dem, dmcduse$bestweight)

# Generate binomial test equivalent
# Weighted counts
x <- sum((dmcduse$dem<dmcduse$rep)*dmcduse$bestweight, na.rm=TRUE)   # successes
n <- sum((!is.na(dmcduse$dem<dmcduse$rep))*dmcduse$bestweight, na.rm=TRUE)  # total

phat <- x / n
p0 <- 0.5   # null hypothesis

# Standard error under null
se <- sqrt(p0 * (1 - p0) / n)

# Z-score
z <- (phat - p0) / se
p_value <- 2 * pnorm(-abs(z))

z
p_value


## Polling Errors By Location

errslocationpres <- with(dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & dfuse$office=="president" & dfuse$stateornat=="State",], split(data.frame(demerror, reperror, demrepmargin, bestweight, results_reppctvote, swingstates), state))

stateerrsets <- mclapply(errslocationpres, function(x) with(x, data.frame(demmnerr=wtd.mean(demerror, bestweight), repmnerr=wtd.mean(reperror, bestweight), margmnerr=wtd.mean(demrepmargin, bestweight), margmnerrabs=wtd.mean(abs(demrepmargin), bestweight), votemean=results_reppctvote[1], n=sum(bestweight), isswing=swingstates[1])))
names(stateerrsets) <- names(errslocationpres)

sessets <- data.frame(rbindlist(stateerrsets))
rownames(sessets) <- names(stateerrsets)


repreg <- lm(eval(sessets$repmnerr*100)~eval((sessets$votemean)*100), weights=sqrt(sessets$n))
demreg <- lm(eval(sessets$demmnerr*100)~eval((sessets$votemean)*100), weights=sqrt(sessets$n))
differencereg <- lm(eval(-sessets$margmnerr*100)~eval((sessets$votemean)*100), weights=sqrt(sessets$n))



## Build the actual plots
bigbrew <- c(brewer.pal(8, "Set2"), brewer.pal(8, "Set1"), brewer.pal(8, "Set3"))
darkbrew <- c(brewer.pal(8, "Dark2"), brewer.pal(8, "Set1"), brewer.pal(8, "Set3"))


dotcol <- rep(bigbrew[1], nrow(sessets))
dotcol[sessets$isswing] <- bigbrew[2]
dotcoledge <- rep(darkbrew[1], nrow(sessets))
dotcoledge[sessets$isswing] <- darkbrew[2]





jpeg("../Report/LinkedResults/Section_4_1/ErrorsByPartyState.jpg", width=8, height=5, units="in", res=1600)
par(mfrow=c(1,3))
plot((sessets$votemean)*100, sessets$repmnerr*100, pch=21, cex=sqrt(sessets$n), ylim=c(-10,5), col=alpha(dotcoledge, .6), bg=alpha(dotcol, .6), main="Trump Poll Share", axes=FALSE, xlab="", ylab="Signed Error")
abline(h=seq(-100,100,2.5), col="light gray", lwd=.5)
abline(v=seq(-100,100,5), col="light gray", lwd=.5)
axis(1, seq(-100,100,10), lwd=0)
axis(2, seq(-100,100,5), lwd=0, las=2)
abline(h=0, lty=2)
abline(reg=repreg, lwd=3, col="blue")
legend("bottomleft", c("Swing state", "Other state"), pch=21, col=alpha(unique(dotcoledge), .6), pt.bg=alpha(unique(dotcol), .6), pt.cex=1.5, box.col="white")
plot((sessets$votemean)*100, sessets$demmnerr*100, pch=21, cex=sqrt(sessets$n), ylim=c(-10,5), col=alpha(dotcoledge, .6), bg=alpha(dotcol, .6), main="Harris Poll Share", axes=FALSE, xlab="2024 Trump Vote Share", ylab="")
abline(h=seq(-100,100,2.5), col="light gray", lwd=.5)
abline(v=seq(-100,100,5), col="light gray", lwd=.5)
axis(1, seq(-100,100,10), lwd=0)
abline(h=0, lty=2)
abline(reg=demreg, lwd=3, col="blue")
plot((sessets$votemean)*100, (-sessets$margmnerr)*100, pch=21, cex=sqrt(sessets$n), ylim=c(-10,5), col=alpha(dotcoledge, .6), bg=alpha(dotcol, .6), main="Margin (Trump - Harris)", axes=FALSE, xlab="", ylab="")
abline(h=seq(-100,100,2.5), col="light gray", lwd=.5)
abline(v=seq(-100,100,5), col="light gray", lwd=.5)
axis(1, seq(-100,100,10), lwd=0)
abline(h=0, lty=2)
abline(reg=differencereg, lwd=3, col="blue", xlab="")
legend("bottomright", c("  10 polls", "  20 polls"), pch=21, col=alpha(unique(dotcoledge[1]), .6), pt.bg=alpha(unique(dotcol[1]), .6), pt.cex=sqrt(c(10, 20)), box.col="white")
dev.off()






jpeg("../Report/LinkedResults/Section_4_1/ErrorsByPartyStateSingle.jpg", width=8, height=5, units="in", res=1600)
plot((sessets$votemean)*100, (-sessets$margmnerr)*100, pch=21, cex=sqrt(sessets$n), ylim=c(-10,5), col=alpha(dotcoledge, .6), bg=alpha(dotcol, .6), main="Error in Margin by State Margin (Trump - Harris)", axes=FALSE, xlab="2024 Trump Vote Share in State", ylab="Average Signed Error of State Polls")
abline(h=seq(-100,100,2.5), col="light gray", lwd=.5)
abline(v=seq(-100,100,5), col="light gray", lwd=.5)
axis(1, seq(-100,100,10), lwd=0)
axis(2, seq(-100,100,5), lwd=0, las=2)
abline(h=0, lty=2)
abline(reg=differencereg, lwd=3, col="blue", xlab="")
legend("topright", c("  10 polls", "  20 polls"), pch=21, col=alpha(unique(dotcoledge[1]), .6), pt.bg=alpha(unique(dotcol[1]), .6), pt.cex=sqrt(c(10, 20)), box.col="white")
dev.off()





drmargst <- sapply(statesmetrics, function(x) x$last2weeks.demrepmargin[x$Level=="2024 general State president"])
drmargstN <- sapply(statesmetrics, function(x) x$last2weeks.demrepmargin.N[x$Level=="2024 general State president"])

usemarg <- drmargst[!is.na(drmargst) & drmargstN>1]

um <- round(1000*usemarg, 0)+100

mcol <- colorRampPalette(brewer.pal(11, "RdYlBu"))
col200 <- mcol(200)
stcols <- mcol(200)[um]
names(stcols) <- str_to_title(names(usemarg))

jpeg("../Report/LinkedResults/Section_4_1/ErrorsByStateMap.jpg", width=12, height=8, units="in", res=1200)
map('state', xlim=c(-130, -65), ylim=c(23, 53), main="Magnitudes of Presidential Polling Errors By State", fill=TRUE, col="gray75", density=20)
for(i in names(stcols))
    map('state', regions=i, fill=TRUE, col=stcols[i], add=TRUE)
xstarts <- seq(-125,-70,length.out=(length(col200)+1))
for(i in 1:length(col200))
    polygon(c(xstarts[i],xstarts[i],xstarts[i+1],xstarts[i+1]), c(52, 51, 51, 52), col=col200[i], border=FALSE)
segments(mean(xstarts), 51, mean(xstarts), 52)
text(seq(-125,-70,length.out=11), 50.5, labels=abs(seq(-10,10, length.out=11)))
text(seq(-125,-70,length.out=5), 52.5, c("", "Republican Overestimate", "", "Democratic Overestimate", ""))
dev.off()





## Errors by time

overtime24s <- dfuse[dfuse$cycle=="2024" & dfuse$stage=="general",]
overtime24s$keydates <- cut(overtime24s$eddt, as.Date(c("2021-01-01", "2024-01-01", "2024-06-27", "2024-07-21", "2024-10-01", "2024-10-23", "2024-10-30", "2024-11-02", "2024-11-05"))-.5, c("Pre '24", "Early '24", "Debate Fallout", "Post- Harris", "October", "Last 2 Weeks", "Last Week", "Last 3 Days"))

dembylev <- with(overtime24s, xtabs(demerror*bestweight~paste(office, stateornat)+keydates, na.rm=TRUE)/xtabs((!is.na(demerror))*bestweight~paste(office, stateornat)+keydates, na.rm=TRUE))
repbylev <- with(overtime24s, xtabs(reperror*bestweight~paste(office, stateornat)+keydates, na.rm=TRUE)/xtabs((!is.na(reperror))*bestweight~paste(office, stateornat)+keydates, na.rm=TRUE))
marginbylev <- with(overtime24s, xtabs(demrepmargin*bestweight~paste(office, stateornat, na.rm=TRUE)+keydates)/xtabs((!is.na(demrepmargin))*bestweight~paste(office, stateornat)+keydates, na.rm=TRUE))
Nbylev <- with(overtime24s, xtabs((!is.na(demrepmargin))*bestweight~paste(office, stateornat)+keydates, na.rm=TRUE))
levs <- rownames(Nbylev)


nbl <- Nbylev[order(rowSums(Nbylev, na.rm=TRUE), decreasing=TRUE),]
newlevs <- levs[order(rowSums(Nbylev, na.rm=TRUE), decreasing=TRUE)][nbl[,ncol(nbl)]>0]

mbl <- -marginbylev[order(rowSums(Nbylev, na.rm=TRUE), decreasing=TRUE),][nbl[,ncol(nbl)]>0,]

dbl <- dembylev[order(rowSums(Nbylev, na.rm=TRUE), decreasing=TRUE),][nbl[,ncol(nbl)]>0,]
rbl <- repbylev[order(rowSums(Nbylev, na.rm=TRUE), decreasing=TRUE),][nbl[,ncol(nbl)]>0,]

mbl <- rbl-dbl

jpeg("../Report/LinkedResults/Section_4_1/ErrorsAcrossCycle.jpg", width=14, height=8, units="in", res=1600)
cols <- brewer.pal(nrow(mbl), "Dark2")
par(mfrow=c(1,3))
plot(c(1,ncol(dbl)), range(cbind(rbl, dbl, mbl),na.rm=TRUE), type="n", axes=FALSE, ylab="Difference From Final Margin", xlab="", main="Democratic Errors")
abline(h=seq(-1,1,.02), col="light gray", lwd=.5)
abline(h=0, lty=2)
axis(2, seq(-1,1,.02), seq(-100,100,2), las=2, lwd=0)
axis(1, 1:ncol(nbl), gsub("Last\n3", "Last 3",gsub("Last\n2", "Last 2", gsub(" ", "\n", colnames(nbl)))), lwd=0)
for(i in 1:nrow(dbl))
    lines(1:ncol(dbl), dbl[i,], type="b", pch=20-i, col=cols[i])
plot(c(1,ncol(rbl)), range(cbind(rbl, dbl, mbl),na.rm=TRUE), type="n", axes=FALSE, ylab="", xlab="Time Period", main="Republican Errors")
abline(h=seq(-1,1,.02), col="light gray", lwd=.5)
abline(h=0, lty=2)
axis(2, seq(-1,1,.02), seq(-100,100,2), las=2, lwd=0)
axis(1, 1:ncol(nbl), gsub("Last\n3", "Last 3",gsub("Last\n2", "Last 2", gsub(" ", "\n", colnames(nbl)))), lwd=0)
for(i in 1:nrow(rbl))
    lines(1:ncol(rbl), rbl[i,], type="b", pch=20-i, col=cols[i])
plot(c(1,ncol(mbl)), range(cbind(rbl, dbl, mbl),na.rm=TRUE), type="n", axes=FALSE, ylab="", xlab="", main="Difference")
abline(h=seq(-1,1,.02), col="light gray", lwd=.5)
abline(h=0, lty=2)
axis(2, seq(-1,1,.02), seq(-100,100,2), las=2, lwd=0)
axis(1, 1:ncol(nbl), gsub("Last\n3", "Last 3",gsub("Last\n2", "Last 2", gsub(" ", "\n", colnames(nbl)))), lwd=0)
for(i in 1:nrow(mbl))
    lines(1:ncol(mbl), mbl[i,], type="b", pch=20-i, col=cols[i])
legend("topright", legend=str_to_title(gsub("governor State", "governor", gsub("house State", "house", gsub("senate State", "senate", newlevs)))), pch=(19:(20-i)), col=(cols[1:i]), bg="white")
dev.off()


## Likely vs Registered Voter Models

last2wksds <- dfuse[dfuse$cycle=="2024" & dfuse$stage=="general" & dfuse$last2weeks,]

last2wksds$allshared <- last2wksds$nsurveycands==last2wksds$nsharedcands

last2wksds$twocands <- last2wksds$nsurveycands==2


compareinfo <- as.character(factor(last2wksds$populationmin, c("a", "rv", "lv"), c("Americans", "Registered Voters", "Likely Voters")))
compareinfo[last2wksds$twocands] <- paste("Two", compareinfo[last2wksds$twocands])
compareinfo[last2wksds$allshared] <- paste("All", compareinfo[last2wksds$allmeasured])
last2wksds$compareinfo <- compareinfo

Nbypop <- with(last2wksds, xtabs((!is.na(demrepmargin))*bestweight~paste(office, stateornat)+populationmin, na.rm=TRUE))

dembypop <- with(last2wksds, xtabs(demerror~paste(office, stateornat)+populationmin, na.rm=TRUE)/xtabs((!is.na(demerror))~paste(office, stateornat)+populationmin, na.rm=TRUE))
repbypop <- with(last2wksds, xtabs(reperror~paste(office, stateornat)+populationmin, na.rm=TRUE)/xtabs((!is.na(reperror))~paste(office, stateornat)+populationmin, na.rm=TRUE))
marginbypop <- with(last2wksds, xtabs(demrepmargin~paste(office, stateornat, na.rm=TRUE)+populationmin)/xtabs((!is.na(demrepmargin))~paste(office, stateornat)+populationmin, na.rm=TRUE))

absmarginbypop <- with(last2wksds, xtabs(abs(demrepmargin)~paste(office, stateornat)+populationmin, na.rm=TRUE)/xtabs((!is.na(demrepmargin))~paste(office, stateornat)+populationmin, na.rm=TRUE))
dembypop <- with(last2wksds, xtabs(demerror~paste(office, stateornat)+compareinfo, na.rm=TRUE)/xtabs((!is.na(demerror))~paste(office, stateornat)+compareinfo, na.rm=TRUE))

Nbypop
absmarginbypop

dbpreg <- lm(abs(demrepmargin)~paste(office, stateornat)+populationmin, data=last2wksds)


## Major party candidates vs more candidates measured

last2bycontest <- split(last2wksds, last2wksds$contest)

## USING ONES THAT ARE BEST, BUT NOT WEIGHTING BY BESTWEIGHT BECAUSE THAT DOWNWEIGHTS MULTIPLE COMPARISONS

demportsbyNcands <- mclapply(last2bycontest, function(x) as.data.frame(xtabs((x$demerror*(x$bestweight>0))~x$nsurveycands)/xtabs(((!is.na(x$demerror))*(x$bestweight>0))~x$nsurveycands)))
repportsbyNcands <- mclapply(last2bycontest, function(x) as.data.frame(xtabs((x$reperror*(x$bestweight>0))~x$nsurveycands)/xtabs(((!is.na(x$reperror))*(x$bestweight>0))~x$nsurveycands)))
marportsbyNcands <- mclapply(last2bycontest, function(x) as.data.frame(xtabs((x$demrepmargin*(x$bestweight>0))~x$nsurveycands)/xtabs(((!is.na(x$demrepmargin))*(x$bestweight>0))~x$nsurveycands)))
marportsbyNcandsabs <- mclapply(last2bycontest, function(x) as.data.frame(xtabs((abs(x$demrepmargin)*(x$bestweight>0))~x$nsurveycands)/xtabs(((!is.na(x$demrepmargin))*(x$bestweight>0))~x$nsurveycands)))


NsforNcands <- mclapply(last2bycontest, function(x) as.data.frame(xtabs(((!is.na(x$reperror))*(x$bestweight>0))~x$nsurveycands)))

NNcands <- lapply(NsforNcands, function(x) as.data.frame(t(x[,2])))
NNcandnoms <- lapply(NsforNcands, function(x) paste0("cands", x[,1]))
for(i in 1:length(NsforNcands))
    colnames(NNcands[[i]]) <- NNcandnoms[[i]]

NNsetpre <- as.data.frame(rbindlist(NNcands, fill=TRUE, use.names=TRUE))
Nncset <- NNsetpre[,sort(colnames(NNsetpre))]

dNcands <- lapply(demportsbyNcands, function(x) as.data.frame(t(x[,2])))
dNcandnoms <- lapply(demportsbyNcands, function(x) paste0("cands", x[,1]))
for(i in 1:length(dNcands))
    colnames(dNcands[[i]]) <- dNcandnoms[[i]]

dncsetpre <- as.data.frame(rbindlist(dNcands, fill=TRUE, use.names=TRUE))
dncset <- dncsetpre[,sort(colnames(dncsetpre))]

relvaldncset <- as.data.frame(t(apply(dncset, 1, function(x) x-x[1])))

rNcands <- lapply(repportsbyNcands, function(x) as.data.frame(t(x[,2])))
rNcandnoms <- lapply(repportsbyNcands, function(x) paste0("cands", x[,1]))
for(i in 1:length(rNcands))
    colnames(rNcands[[i]]) <- rNcandnoms[[i]]

rncsetpre <- as.data.frame(rbindlist(rNcands, fill=TRUE, use.names=TRUE))
rncset <- rncsetpre[,sort(colnames(rncsetpre))]

relvalrncset <- as.data.frame(t(apply(rncset, 1, function(x) x-x[1])))


marNcands <- lapply(marportsbyNcands, function(x) as.data.frame(t(x[,2])))
marNcandnoms <- lapply(marportsbyNcands, function(x) paste0("cands", x[,1]))
for(i in 1:length(marNcands))
    colnames(marNcands[[i]]) <- marNcandnoms[[i]]

marncsetpre <- as.data.frame(rbindlist(marNcands, fill=TRUE, use.names=TRUE))
marncset <- marncsetpre[,sort(colnames(marncsetpre))]
rownames(marncset) <- names(marNcands)

marNcandsabs <- lapply(marportsbyNcandsabs, function(x) as.data.frame(t(x[,2])))
marNcandnomsabs <- lapply(marportsbyNcandsabs, function(x) paste0("cands", x[,1]))
for(i in 1:length(marNcandsabs))
    colnames(marNcandsabs[[i]]) <- marNcandnomsabs[[i]]

marncsetpreabs <- as.data.frame(rbindlist(marNcandsabs, fill=TRUE, use.names=TRUE))
marncsetabs <- marncsetpreabs[,sort(colnames(marncsetpreabs))]
rownames(marncsetabs) <- names(marNcandsabs)

presmarns <- marncset[grepl("pres", rownames(marncset)),]
presmarnsabs <- marncset[grepl("pres", rownames(marncsetabs)),]


jpeg("../Report/LinkedResults/Section_4_1/NumberOfCandidatesInSurvey.jpg", width=12, height=8, units="in", res=1600)
plot(c(2,8), 100*range(relvaldncset, na.rm=TRUE), type="n", axes=FALSE, xlab="Number of Candidates in Survey", ylab="Relative Share Supporting Candidate (vs. 2-Candidate Polls in the Same Contest)", main="Implications of Number of Candidates Surveyed on Estimates")
axis(1, 1:10)
axis(2, seq(-100,100,5), las=2)
axis(3, c(-99,99))
axis(4, c(-99,99))
abline(h=0, lty=2)
abline(h=seq(-100, 100,5), col="light gray", lty=3)
for(i in 1:nrow(relvaldncset)){
    #lines((2:8)[!is.na(relvaldncset[i,])], relvaldncset[i,!is.na(relvaldncset[i,])], type="b", pch=20, lwd=.5, col="light gray")
    lines((2:8)[!is.na(relvaldncset[i,])], 100*relvaldncset[i,!is.na(relvaldncset[i,])], type="p", pch=20, col=alpha("light blue", .6), cex=unlist(sqrt(Nncset[i,!is.na(relvaldncset[i,])])))
    lines((2:8)[!is.na(relvalrncset[i,])], 100*relvalrncset[i,!is.na(relvalrncset[i,])], type="p", pch=20, col=alpha("pink", .6), cex=unlist(sqrt(Nncset[i,!is.na(relvalrncset[i,])])))
}
lines(2:8, 100*colMeans(relvaldncset*Nncset, na.rm=TRUE)/colMeans(Nncset, na.rm=TRUE), pch=18, type="b", col="dark blue", cex=1.4, lwd=2)
lines(2:8, 100*colMeans(relvalrncset*Nncset, na.rm=TRUE)/colMeans(Nncset, na.rm=TRUE), pch=17, type="b", col="red", cex=1.4, lwd=2)
legend("topright", legend=c("Democratic Contest Estimate", "Republican Contest Estimate", "Democratic Mean", "Republican Mean"), pch=c(20, 20, 18, 17), col=c("light blue", "pink", "dark blue", "red"), lwd=c(0,0,2,2), pt.cex=1.4)
dev.off()

100*colMeans(relvaldncset*Nncset, na.rm=TRUE)/colMeans(Nncset, na.rm=TRUE)
100*colMeans(relvalrncset*Nncset, na.rm=TRUE)/colMeans(Nncset, na.rm=TRUE)
100*colMeans(-marncset*Nncset, na.rm=TRUE)/colMeans(Nncset, na.rm=TRUE)

candscats <- factor((last2wksds$nsurveycands==2)+((last2wksds$nsurveycands==2) & (last2wksds$ncandsonballot==2))+3*(last2wksds$nsurveycands>2), 1:3, c("2 Cands", "2 is All", "3+ Cands"))

absmarginbyncands <- with(last2wksds, xtabs(abs(demrepmargin)~paste(office, stateornat)+candscats, na.rm=TRUE)/xtabs((!is.na(demrepmargin))~paste(office, stateornat)+candscats, na.rm=TRUE))

with(last2wksds[last2wksds$bestweight>0,], xtabs(demrepmargin~paste(office, stateornat, swingstates)+nsurveycands)/xtabs((!is.na(demrepmargin)~paste(office, stateornat, swingstates)+nsurveycands)))

cnpreg <- lm(abs(demrepmargin)~paste(office, stateornat)*(nsurveycands<2), data=last2wksds[last2wksds$bestweight>0,])
cnpregdir <- lm(demrepmargin~paste(office, stateornat)*(nsurveycands<2), data=last2wksds[last2wksds$bestweight>0,])

cnpregdemabs <- lm(abs(demerror)~paste(office, stateornat)+candscats, data=last2wksds)
cnpregrepabs <- lm(abs(reperror)~paste(office, stateornat)+candscats, data=last2wksds)

cnpregdem <- lm(demerror~paste(office, stateornat)+candscats, data=last2wksds)
cnpregrep <- lm(reperror~paste(office, stateornat)+candscats, data=last2wksds)

demerrbyncands <- with(last2wksds, xtabs(demerror~paste(office, stateornat)+nsurveycands, na.rm=TRUE)/xtabs((!is.na(demrepmargin))~paste(office, stateornat)+nsurveycands, na.rm=TRUE))

dbpreg <- lm(abs(demrepmargin)~paste(office, stateornat)+allshared*as.factor(nsurveycands)+populationmin, data=last2wksds)


## SECTION 4-2 ERRORS OVER TIME

## overall errors over time

#etmkeep$last2weeks.demrepmargin[grepl(

presrelerrs <- etmkeep[grepl(paste(seq(2000,2024,4), collapse="|"), etmkeep$Level) & grepl("general State pres", etmkeep$Level),grepl("Level|demrep", colnames(etmkeep)) & grepl("Level|last2weeks", colnames(etmkeep))]
presrelerrsNat <- etmkeep[grepl(paste(seq(2000,2024,4), collapse="|"), etmkeep$Level) & grepl("general National pres", etmkeep$Level),grepl("Level|demrep", colnames(etmkeep)) & grepl("Level|last2weeks", colnames(etmkeep))]
senrelerrs <- etmkeep[grepl(paste(seq(2006,2024,2), collapse="|"), etmkeep$Level) & grepl("general State sen", etmkeep$Level),grepl("Level|demrep", colnames(etmkeep)) & grepl("Level|last2weeks", colnames(etmkeep))]
govrelerrs <- etmkeep[grepl(paste(seq(2006,2024,2), collapse="|"), etmkeep$Level) & grepl("general State gov", etmkeep$Level),grepl("Level|demrep", colnames(etmkeep)) & grepl("Level|last2weeks", colnames(etmkeep))]
houserelerrs <- etmkeep[grepl(paste(seq(2006,2024,2), collapse="|"), etmkeep$Level) & grepl("general State hou", etmkeep$Level),grepl("Level|demrep", colnames(etmkeep)) & grepl("Level|last2weeks", colnames(etmkeep))]

overtimecols <- brewer.pal(10, "Paired")

jpeg("../Report/LinkedResults/Section_4_2/ErrorsOverTimeByOfficeFaceted.jpg", width=10, height=6, units="in", res=1600)
par(mfrow=c(2,3))
plot(seq(2000,2024,4), 100*presrelerrs$last2weeks.demrepabs, lwd=3, xlim=c(2000,2024), ylim=c(-4,8), type="n", pch=20, col=overtimecols[1], axes=FALSE, xlab="Year", ylab="Error", main="State Presidential")
abline(h=seq(-100,100,1), lty=3, col="gray")
axis(2, seq(-100,100,1), las=2)
axis(1, seq(2000,2024,2), gsub("^20", "", seq(2000,2024,2)), lwd=0, col.axis="gray", cex.axis=.9)
axis(1, seq(2000,2024,4), gsub("^20", "", seq(2000,2024,4)), lwd=0, cex.axis=.9)
abline(h=0, lty=2)
lines(seq(2000,2024,4), 100*presrelerrs$last2weeks.demrepmargin, lwd=3, col=overtimecols[1], type="b", pch=18)
lines(seq(2000,2024,4), 100*presrelerrs$last2weeks.demrepabs, lwd=3, col=overtimecols[2], type="b", pch=20)
#
plot(seq(2000,2024,4), 100*presrelerrsNat$last2weeks.demrepabs, lwd=3, xlim=c(2000,2024), ylim=c(-4,8), type="n", pch=20, col=overtimecols[1], axes=FALSE, xlab="Year", ylab="Error", main="National Presidential")
abline(h=seq(-100,100,1), lty=3, col="gray")
axis(2, seq(-100,100,1), las=2)
axis(1, seq(2000,2024,2), gsub("^20", "", seq(2000,2024,2)), lwd=0, col.axis="gray", cex.axis=.9)
axis(1, seq(2000,2024,4), gsub("^20", "", seq(2000,2024,4)), lwd=0, cex.axis=.9)
abline(h=0, lty=2)
lines(seq(2000,2024,4), 100*presrelerrsNat$last2weeks.demrepmargin, lwd=3, col=overtimecols[3], type="b", pch=18)
lines(seq(2000,2024,4), 100*presrelerrsNat$last2weeks.demrepabs, lwd=3, type="b", col=overtimecols[4], pch=20)
abline(h=0, lty=2)
#
plot(seq(2006,2024,2), 100*senrelerrs$last2weeks.demrepabs, lwd=3, xlim=c(2000,2024), ylim=c(-4,8), type="n", pch=20, col=overtimecols[1], axes=FALSE, xlab="Year", ylab="Error", main="U.S. Senate")
abline(h=seq(-100,100,1), lty=3, col="gray")
axis(2, seq(-100,100,1), las=2)
axis(1, seq(2000,2024,2), gsub("^20", "", seq(2000,2024,2)), lwd=0, col.axis="gray", cex.axis=.9)
axis(1, seq(2006,2024,2), gsub("^20", "", seq(2006,2024,2)), lwd=0, cex.axis=.9)
abline(h=0, lty=2)
lines(seq(2006,2024,2), 100*senrelerrs$last2weeks.demrepmargin, lwd=3, col=overtimecols[5], type="b", pch=c(18))
lines(seq(2006,2024,2), 100*senrelerrs$last2weeks.demrepabs, lwd=3, type="b", pch=c(20), col=overtimecols[6])
abline(h=0, lty=2)
#
plot(seq(2006,2024,2), 100*govrelerrs$last2weeks.demrepabs, lwd=3, xlim=c(2000,2024), ylim=c(-4,8), type="n", pch=20, col=overtimecols[1], axes=FALSE, xlab="Year", ylab="Error", main="Governor")
abline(h=seq(-100,100,1), lty=3, col="gray")
axis(2, seq(-100,100,1), las=2)
axis(1, seq(2000,2024,2), gsub("^20", "", seq(2000,2024,2)), lwd=0, col.axis="gray", cex.axis=.9)
axis(1, seq(2006,2024,2), gsub("^20", "", seq(2006,2024,2)), lwd=0, cex.axis=.9)
abline(h=0, lty=2)
lines(seq(2006,2024,2), 100*govrelerrs$last2weeks.demrepmargin, lwd=3, col=overtimecols[7], type="b", pch=c(18),)
lines(seq(2006,2024,2), 100*govrelerrs$last2weeks.demrepabs, lwd=3, type="b", pch=c(20), col=overtimecols[8])
abline(h=0, lty=2)
#
plot(seq(2006,2024,2), 100*houserelerrs$last2weeks.demrepabs, lwd=3, xlim=c(2000,2024), ylim=c(-4,8), type="n", pch=20, col=overtimecols[1], axes=FALSE, xlab="Year", ylab="Error", main="U.S. House")
abline(h=seq(-100,100,1), lty=3, col="gray")
axis(2, seq(-100,100,1), las=2)
axis(1, seq(2000,2024,2), gsub("^20", "", seq(2000,2024,2)), lwd=0, col.axis="gray", cex.axis=.9)
axis(1, seq(2006,2024,2), gsub("^20", "", seq(2006,2024,2)), lwd=0, cex.axis=.9)
abline(h=0, lty=2)
lines(seq(2006,2024,2), 100*houserelerrs$last2weeks.demrepmargin, lwd=3, col=overtimecols[9], type="b", pch=c(18))
lines(seq(2006,2024,2), 100*houserelerrs$last2weeks.demrepabs, lwd=3, type="b", pch=c(20), col=overtimecols[10])
abline(h=0, lty=2)
#
plot(0:1,0:1,type="n",axes=FALSE,xlab="",ylab="")
legend("topleft", c("Absolute Error", "Signed Error"), pch=c(20, 18), cex=2, col=c("black", "dark gray"), lwd=2)
dev.off()



jpeg("../Report/LinkedResults/Revised/ErrorsOverTimeByOfficeFacetedUpdated.jpg", width=10, height=8, units="in", res=1600)
par(mfrow=c(2,1), mar=c(2,4,5,2))
plot(seq(2000,2024,4), 100*presrelerrs$last2weeks.demrepabs, lwd=3, xlim=c(2000,2024), ylim=c(-7,7), type="n", pch=20, col=overtimecols[1], axes=FALSE, xlab="", ylab="Error", main="State Presidential")
abline(h=seq(-100,100,1), lty=3, col="gray")
axis(2, seq(-100,100,2), las=2)
#axis(1, seq(2000,2024,2), gsub("^20", "", seq(2000,2024,2)), lwd=0, col.axis="gray", cex.axis=.9)
#axis(1, seq(2000,2024,4), gsub("^20", "", seq(2000,2024,4)), lwd=0, cex.axis=.9)
abline(h=0, lty=2)
lines(seq(2000,2024,4), 100*presrelerrs$last2weeks.demrepmargin, lwd=3, col=overtimecols[1], type="b", pch=18)
lines(seq(2000,2024,4), 100*presrelerrs$last2weeks.demrepabs, lwd=3, col=overtimecols[2], type="b", pch=20)
#
par(mar=c(5,4,2,2))
plot(seq(2000,2024,4), 100*presrelerrsNat$last2weeks.demrepabs, lwd=3, xlim=c(2000,2024), ylim=c(-7,7), type="n", pch=20, col=overtimecols[1], axes=FALSE, xlab="Year", ylab="Error", main="National Presidential")
abline(h=seq(-100,100,1), lty=3, col="gray")
axis(2, seq(-100,100,2), las=2)
axis(1, seq(2000,2024,2), gsub("^20", "", seq(2000,2024,2)), lwd=0, col.axis="gray", cex.axis=.9)
axis(1, seq(2000,2024,4), gsub("^20", "", seq(2000,2024,4)), lwd=0, cex.axis=.9)
abline(h=0, lty=2)
lines(seq(2000,2024,4), 100*presrelerrsNat$last2weeks.demrepmargin, lwd=3, col=overtimecols[3], type="b", pch=18)
lines(seq(2000,2024,4), 100*presrelerrsNat$last2weeks.demrepabs, lwd=3, type="b", col=overtimecols[4], pch=20)
abline(h=0, lty=2)
legend("bottomright", c("Absolute Error", "Signed Error"), pch=c(20, 18), cex=1.1, col=c("black", "dark gray"), lwd=2, horiz=TRUE)
dev.off()



jpeg("../Report/LinkedResults/Section_4_2/AbsoluteErrorsOverTimeByOffice.jpg", width=12, height=8, units="in", res=1600)
plot(seq(2000,2024,2), seq(2000,2024,2), lwd=3, ylim=c(0,9), type="n", pch=20, col=overtimecols[1], axes=FALSE, xlab="Year", ylab="Absolute Errors in Percentage Points", main="Absolute Errors by Office Type in Recent Election Cycles")
abline(h=seq(-100,100,1), lty=3, col="gray")
axis(2, seq(-100,100,1), las=2)
axis(1, seq(2000,2024,2), lwd=0)
abline(h=0, lty=1)
lines(seq(2000,2024,4), 100*presrelerrs$last2weeks.demrepabs, lwd=3, col=overtimecols[2], type="b", pch=20)
lines(seq(2000,2024,4), 100*presrelerrsNat$last2weeks.demrepabs, lwd=3, type="b", col=overtimecols[4], pch=20)
lines(seq(2006,2024,2), 100*senrelerrs$last2weeks.demrepabs, lwd=3, type="b", pch=c(17,20), col=overtimecols[6])
lines(seq(2006,2024,2), 100*govrelerrs$last2weeks.demrepabs, lwd=3, type="b", pch=c(17,20), col=overtimecols[8])
lines(seq(2006,2024,2), 100*houserelerrs$last2weeks.demrepabs, lwd=3, type="b", pch=c(17,20), col=overtimecols[10])
legend("topleft", legend=c("State President", "National President", "U.S. Senate", "Governor", "U.S. House", "Midterm Election Year", "Presidential Election Year"), col=c(overtimecols[c(2,4,6,8,10)], "gray70", "gray70"), pch=c(rep(20,5), 17,20), bg="white", lwd=2, pt.cex=1.3, cex=1.2)
dev.off()

jpeg("../Report/LinkedResults/Section_4_2/SignedErrorsOverTimeByOffice.jpg", width=12, height=6, units="in", res=1600)
plot(seq(2000,2024,2), seq(2000,2024,2),, lwd=3, ylim=c(-4,8), type="n", pch=20, col=overtimecols[1], axes=FALSE, xlab="Year", ylab="Signed Errors in Percentage Points", main="Signed Errors by Office Type in Recent Election Cycles")
abline(h=seq(-100,100,1), lty=3, col="gray")
axis(2, seq(-100,100,1), las=2)
axis(1, seq(2000,2024,2), lwd=0)
abline(h=0, lty=1)
lines(seq(2000,2024,4), 100*presrelerrs$last2weeks.demrepmargin, lwd=3, col=overtimecols[2], type="b", pch=20)
lines(seq(2000,2024,4), 100*presrelerrsNat$last2weeks.demrepmargin, lwd=3, type="b", col=overtimecols[4], pch=20)
lines(seq(2006,2024,2), 100*senrelerrs$last2weeks.demrepmargin, lwd=3, type="b", pch=c(17,20), col=overtimecols[6])
lines(seq(2006,2024,2), 100*govrelerrs$last2weeks.demrepmargin, lwd=3, type="b", pch=c(17,20), col=overtimecols[8])
lines(seq(2006,2024,2), 100*houserelerrs$last2weeks.demrepmargin, lwd=3, type="b", pch=c(17,20), col=overtimecols[10])
legend("topleft", legend=c("State President", "National President", "U.S. Senate", "Governor", "U.S. House", "Midterm Election Year", "Presidential Election Year"), col=c(overtimecols[c(2,4,6,8,10)], "gray70", "gray70"), pch=c(rep(20,5), 17,20), bg="white", lwd=2, pt.cex=1.3, cex=1.2)
dev.off()




## Within Party Errors Over Time


presdemerrs <- etmkeep[grepl(paste(seq(2000,2024,4), collapse="|"), etmkeep$Level) & grepl("general State pres", etmkeep$Level),grepl("Level|demerr|reperr", colnames(etmkeep)) & grepl("Level|last2weeks", colnames(etmkeep))]
presdemerrsNat <- etmkeep[grepl(paste(seq(2000,2024,4), collapse="|"), etmkeep$Level) & grepl("general National pres", etmkeep$Level),grepl("Level|demerr|reperr", colnames(etmkeep)) & grepl("Level|last2weeks", colnames(etmkeep))]
sendemerrs <- etmkeep[grepl(paste(seq(2006,2024,2), collapse="|"), etmkeep$Level) & grepl("general State sen", etmkeep$Level),grepl("Level|demerr|reperr", colnames(etmkeep)) & grepl("Level|last2weeks", colnames(etmkeep))]
govdemerrs <- etmkeep[grepl(paste(seq(2006,2024,2), collapse="|"), etmkeep$Level) & grepl("general State gov", etmkeep$Level),grepl("Level|demerr|reperr", colnames(etmkeep)) & grepl("Level|last2weeks", colnames(etmkeep))]
housedemerrs <- etmkeep[grepl(paste(seq(2006,2024,2), collapse="|"), etmkeep$Level) & grepl("general State hou", etmkeep$Level),grepl("Level|demerr|reperr", colnames(etmkeep)) & grepl("Level|last2weeks", colnames(etmkeep))]

bluered <- rep(brewer.pal(10, "Paired")[c(2,6)], 5)

jpeg("../Report/LinkedResults/Section_4_2/PartisanErrorsOverTimeByOfficeFaceted.jpg", width=16, height=8, units="in", res=1600)
par(mfrow=c(2,3))
plot(seq(2000,2024,4), 100*presdemerrs$last2weeks.reperror, lwd=3, xlim=c(2000,2024), ylim=c(-10,4), type="n", pch=20, col=bluered[1], axes=FALSE, xlab="Year", ylab="Error", main="State Presidential")
abline(h=seq(-100,100,1), lty=3, col="gray")
axis(2, seq(-100,100,1), las=2)
axis(1, seq(2000,2024,2), lwd=0, col.axis="gray")
axis(1, seq(2000,2024,4), lwd=0)
abline(h=0, lty=2)
lines(seq(2000,2024,4), 100*presdemerrs$last2weeks.demerror, lwd=3, col=bluered[1], type="b", pch=18)
lines(seq(2000,2024,4), 100*presdemerrs$last2weeks.reperror, lwd=3, col=bluered[2], type="b", pch=20)
#
plot(seq(2000,2024,4), 100*presdemerrsNat$last2weeks.reperror, lwd=3, xlim=c(2000,2024), ylim=c(-10,4), type="n", pch=20, col=bluered[1], axes=FALSE, xlab="Year", ylab="Error", main="National Presidential")
abline(h=seq(-100,100,1), lty=3, col="gray")
axis(2, seq(-100,100,1), las=2)
axis(1, seq(2000,2024,2), lwd=0, col.axis="gray")
axis(1, seq(2000,2024,4), lwd=0)
abline(h=0, lty=2)
lines(seq(2000,2024,4), 100*presdemerrsNat$last2weeks.demerror, lwd=3, col=bluered[3], type="b", pch=18)
lines(seq(2000,2024,4), 100*presdemerrsNat$last2weeks.reperror, lwd=3, type="b", col=bluered[4], pch=20)
abline(h=0, lty=2)
#
plot(seq(2006,2024,2), 100*sendemerrs$last2weeks.reperror, lwd=3, xlim=c(2000,2024), ylim=c(-10,4), type="n", pch=20, col=bluered[1], axes=FALSE, xlab="Year", ylab="Error", main="U.S. Senate")
abline(h=seq(-100,100,1), lty=3, col="gray")
axis(2, seq(-100,100,1), las=2)
axis(1, seq(2000,2024,2), lwd=0, col.axis="gray")
axis(1, seq(2006,2024,2), lwd=0)
abline(h=0, lty=2)
lines(seq(2006,2024,2), 100*sendemerrs$last2weeks.demerror, lwd=3, col=bluered[5], type="b", pch=c(17,18))
lines(seq(2006,2024,2), 100*sendemerrs$last2weeks.reperror, lwd=3, type="b", pch=c(15,20), col=bluered[6])
abline(h=0, lty=2)
#
plot(seq(2006,2024,2), 100*govdemerrs$last2weeks.reperror, lwd=3, xlim=c(2000,2024), ylim=c(-10,4), type="n", pch=20, col=bluered[1], axes=FALSE, xlab="Year", ylab="Error", main="Governor")
abline(h=seq(-100,100,1), lty=3, col="gray")
axis(2, seq(-100,100,1), las=2)
axis(1, seq(2000,2024,2), lwd=0, col.axis="gray")
axis(1, seq(2006,2024,2), lwd=0)
abline(h=0, lty=2)
lines(seq(2006,2024,2), 100*govdemerrs$last2weeks.demerror, lwd=3, col=bluered[7], type="b", pch=c(17,18))
lines(seq(2006,2024,2), 100*govdemerrs$last2weeks.reperror, lwd=3, type="b", pch=c(15,20), col=bluered[8])
abline(h=0, lty=2)
#
plot(seq(2006,2024,2), 100*housedemerrs$last2weeks.reperror, lwd=3, xlim=c(2000,2024), ylim=c(-10,4), type="n", pch=20, col=bluered[1], axes=FALSE, xlab="Year", ylab="Error", main="U.S. House")
abline(h=seq(-100,100,1), lty=3, col="gray")
axis(2, seq(-100,100,1), las=2)
axis(1, seq(2000,2024,2), lwd=0, col.axis="gray")
axis(1, seq(2006,2024,2), lwd=0)
abline(h=0, lty=2)
lines(seq(2006,2024,2), 100*housedemerrs$last2weeks.demerror, lwd=3, col=bluered[9], type="b", pch=c(17,18))
lines(seq(2006,2024,2), 100*housedemerrs$last2weeks.reperror, lwd=3, type="b", pch=c(15,20), col=bluered[10])
abline(h=0, lty=2)
#
plot(0:1,0:1,type="n",axes=FALSE,xlab="",ylab="")
legend("topleft", c("Democratic Error - Presidential Years", "Democratic Error - Midterm Years", "Republican Error - Presidential Years", "Republican Error - Midterm Years"), pch=c(18,17,20,15), cex=1.3, col=bluered[c(1,1,2,2)])
dev.off()



jpeg("../Report/LinkedResults/Section_4_2/SignedErrorsOverTimeByOfficePartisan.jpg", width=12, height=6, units="in", res=1600)
#
plot(seq(2000,2024,2), seq(2000,2024,2),, lwd=3, ylim=c(-8,4), type="n", pch=20, col=overtimecols[1], axes=FALSE, xlab="Year", ylab="Signed Errors in Percentage Points", main="Signed Errors in Democratic Shares by Office Type in Recent Election Cycles")
abline(h=seq(-100,100,1), lty=3, col="gray")
axis(2, seq(-100,100,1), las=2)
axis(1, seq(2000,2024,2), lwd=0)
abline(h=0, lty=1)
lines(seq(2000,2024,4), 100*presdemerrs$last2weeks.demerror, lwd=3, col=overtimecols[2], type="b", pch=20)
lines(seq(2000,2024,4), 100*presdemerrsNat$last2weeks.demerror, lwd=3, type="b", col=overtimecols[4], pch=20)
lines(seq(2006,2024,2), 100*sendemerrs$last2weeks.demerror, lwd=3, type="b", pch=c(17,20), col=overtimecols[6])
lines(seq(2006,2024,2), 100*govdemerrs$last2weeks.demerror, lwd=3, type="b", pch=c(17,20), col=overtimecols[8])
lines(seq(2006,2024,2), 100*housedemerrs$last2weeks.demerror, lwd=3, type="b", pch=c(17,20), col=overtimecols[10])
legend("topleft", legend=c("State President", "National President", "U.S. Senate", "Governor", "U.S. House", "Midterm Election Year", "Presidential Election Year"), col=c(overtimecols[c(2,4,6,8,10)], "gray70", "gray70"), pch=c(rep(20,5), 17,20), bg="white", lwd=2, pt.cex=1.3, cex=1.2)
#
plot(seq(2000,2024,2), seq(2000,2024,2),, lwd=3, ylim=c(-10,4), type="n", pch=20, col=overtimecols[1], axes=FALSE, xlab="Year", ylab="Signed Errors in Percentage Points", main="Signed Errors in Democratic Shares by Office Type in Recent Election Cycles")
abline(h=seq(-100,100,1), lty=3, col="gray")
axis(2, seq(-100,100,1), las=2)
axis(1, seq(2000,2024,2), lwd=0)
abline(h=0, lty=1)
lines(seq(2000,2024,4), 100*presdemerrs$last2weeks.reperror, lwd=3, col=overtimecols[2], type="b", pch=20)
lines(seq(2000,2024,4), 100*presdemerrsNat$last2weeks.reperror, lwd=3, type="b", col=overtimecols[4], pch=20)
lines(seq(2006,2024,2), 100*sendemerrs$last2weeks.reperror, lwd=3, type="b", pch=c(17,20), col=overtimecols[6])
lines(seq(2006,2024,2), 100*govdemerrs$last2weeks.reperror, lwd=3, type="b", pch=c(17,20), col=overtimecols[8])
lines(seq(2006,2024,2), 100*housedemerrs$last2weeks.reperror, lwd=3, type="b", pch=c(17,20), col=overtimecols[10])
legend("topleft", legend=c("State President", "National President", "U.S. Senate", "Governor", "U.S. House", "Midterm Election Year", "Presidential Election Year"), col=c(overtimecols[c(2,4,6,8,10)], "gray70", "gray70"), pch=c(rep(20,5), 17,20), bg="white", lwd=2, pt.cex=1.3, cex=1.2)
#
dev.off()



## ERRORS IN PRESIDENTIAL POLLS BY STATE OVER TIME

statecyclesplits <- split(dfuse[dfuse$last2weeks==TRUE & dfuse$office=="president" & dfuse$stage=="general",], paste(dfuse$state, dfuse$cycle)[dfuse$last2weeks==TRUE & dfuse$office=="president" & dfuse$stage=="general"])

cyclesplits <- split(dfuse[dfuse$last2weeks==TRUE & dfuse$office=="president" & dfuse$stage=="general",], dfuse$cycle[dfuse$last2weeks==TRUE & dfuse$office=="president" & dfuse$stage=="general"])

incyclestatesplits <- mclapply(cyclesplits, function(x) split(x, x$state))

summary(incyclestatesplits[["2024"]])

cyclestaterset3 <- with(dfuse[dfuse$cycle==dfuse$year & dfuse$last2weeks==TRUE & dfuse$office=="president" & dfuse$stage=="general",], xtabs((bestweight*demrepmargin)~stateornat+cycle, na.rm=TRUE)/xtabs((bestweight * (!is.na(demrepmargin)))~stateornat+cycle, na.rm=TRUE))
cyclestaterset3swing <- with(dfuse[dfuse$cycle==dfuse$year & dfuse$last2weeks==TRUE & dfuse$office=="president" & dfuse$stage=="general" & dfuse$swingstates,], xtabs((bestweight*demrepmargin)~stateornat+cycle, na.rm=TRUE)/xtabs((bestweight * (!is.na(demrepmargin)))~stateornat+cycle, na.rm=TRUE))
cyclestatersetabs3 <- with(dfuse[dfuse$cycle==dfuse$year & dfuse$last2weeks==TRUE & dfuse$office=="president" & dfuse$stage=="general",], xtabs(abs(bestweight*demrepmargin)~stateornat+cycle, na.rm=TRUE)/xtabs((bestweight * (!is.na(demrepmargin)))~stateornat+cycle, na.rm=TRUE))
cyclestatersetabs3swing <- with(dfuse[dfuse$cycle==dfuse$year & dfuse$last2weeks==TRUE & dfuse$office=="president" & dfuse$stage=="general" & dfuse$swingstates,], xtabs(abs(bestweight*demrepmargin)~stateornat+cycle, na.rm=TRUE)/xtabs((bestweight * (!is.na(demrepmargin)))~stateornat+cycle, na.rm=TRUE))
cyclestaterset3N <- with(dfuse[dfuse$cycle==dfuse$year & dfuse$last2weeks==TRUE & dfuse$office=="president" & dfuse$stage=="general",], xtabs((bestweight * (!is.na(demrepmargin)))~stateornat+cycle, na.rm=TRUE))

cyclestatersetpre <- with(dfuse[dfuse$cycle==dfuse$year & dfuse$last2weeks==TRUE & dfuse$office=="president" & dfuse$stage=="general",], xtabs((bestweight*demrepmargin)~state+cycle, na.rm=TRUE)/xtabs((bestweight * (!is.na(demrepmargin)))~state+cycle, na.rm=TRUE))
cyclestaterNspre <- with(dfuse[dfuse$cycle==dfuse$year & dfuse$last2weeks==TRUE & dfuse$office=="president" & dfuse$stage=="general",], xtabs((bestweight * (!is.na(demrepmargin)))~state+cycle, na.rm=TRUE))
cyclestaterset <- rbind(cyclestatersetpre, AllStates=cyclestaterset3["State",])
cyclestaterNs <- rbind(cyclestaterNspre, AllStates=cyclestaterset3N["State",])
cyclestatersetsolid <- cyclestaterset
cyclestatersetsolid[cyclestaterNs<3] <- NA

cyclestatersetabspre <- with(dfuse[dfuse$last2weeks==TRUE & dfuse$office=="president" & dfuse$stage=="general",], xtabs(abs(bestweight*demrepmargin)~state+cycle, na.rm=TRUE)/xtabs((bestweight * (!is.na(demrepmargin)))~state+cycle, na.rm=TRUE))
cyclestatersetabs <- rbind(cyclestatersetabspre, AllStates=cyclestatersetabs3["State",])
cyclestatersetabssolid <- cyclestatersetabs
cyclestatersetabssolid[cyclestaterNs<3] <- NA

jpeg("../Report/LinkedResults/Section_4_2/SignedErrorsByStatesCycle.jpg", width=12, height=8, units="in", res=1600)
plot(range(colnames(cyclestaterset)), range(cyclestaterset, na.rm=TRUE), type="n", ylab="Error", xlab="Year", axes=FALSE, main="Average Signed Error for State and National Presidential General Election Polls By Cycle")
axis(2, seq(-1,1,.05), seq(-100, 100, 5), las=2)
axis(1, seq(1900, 2100, 4))
abline(h=seq(-1,1,.05), col="light gray", lty=2)
abline(h=0, col="red")
for(i in (1:nrow(cyclestaterset))[!grepl(" cd", rownames(cyclestaterset))]){
    lines(colnames(cyclestaterset), cyclestaterset[i,], col="gray", lwd=.7, lty=3)
    lines(colnames(cyclestaterset), cyclestaterset[i,], col="gray", lwd=.7, lty=3, type="p", pch=20, cex=.25)
    lines(colnames(cyclestatersetsolid), cyclestatersetsolid[i,], col="gray", lwd=1)
    lines(colnames(cyclestatersetsolid), cyclestatersetsolid[i,], col="dark gray", lty=3, type="p", pch=20, cex=.7)
}
lines(colnames(cyclestaterset), cyclestaterset["AllStates",], col="blue", lwd=2)
lines(colnames(cyclestaterset), cyclestaterset["AllStates",], col="blue", lwd=2, type="p", pch=20)
lines(colnames(cyclestaterset), cyclestaterset["national",], col="black", lwd=2)
lines(colnames(cyclestaterset), cyclestaterset["national",], col="black", lwd=2, type="p", pch=20)
legend(x="topleft", legend=c("National", "All States", "Each State (3+ polls)", "Each State (1-2 polls)"), lwd=c(2,2,1,.7), lty=c(1,1,1,3), pch=20, col=c("black", "blue", "gray", "gray"), bg="white")
dev.off()



colman2 <- brewer.pal(7, "Set2")

jpeg("../Report/LinkedResults/Section_4_2/SignedErrorsByStatesCycleSimple.jpg", width=12, height=5, units="in", res=1600)
plot(range(colnames(cyclestaterset)), range(cyclestaterset, na.rm=TRUE), type="n", ylab="Error in Margin (Dem - Rep)", xlab="Year", axes=FALSE, main="Average Signed Error for State and National Presidential General Election Polls By Cycle", ylim=c(-.10,.10))
axis(2, seq(-1,1,.02), seq(-100, 100, 2), las=2)
axis(1, seq(1900, 2100, 4))
abline(h=seq(-1,1,.02), col="light gray", lty=2)
abline(h=0, col="red")
lines(colnames(cyclestaterset), cyclestaterset["AllStates",], col=colman2[1], lwd=3)
lines(colnames(cyclestaterset), cyclestaterset["AllStates",], col=colman2[1], lwd=2, type="p", pch=18, cex=1.3)
lines(colnames(cyclestaterset), cyclestaterset["national",], col="gray40", lwd=3)
lines(colnames(cyclestaterset), cyclestaterset["national",], col="gray40", lwd=2, type="p", pch=20, cex=1.1)
legend(x="topright", legend=c("National", "All States"), lwd=c(2,2), lty=c(1,1), pch=c(20, 18), col=c("gray40", colman2[1]), bg="white", pt.cex=c(1.1,1.3))
dev.off()


jpeg("../Report/LinkedResults/Section_4_2/AbsoluteErrorsByStatesCycle.jpg", width=12, height=8, units="in", res=1600)
plot(range(colnames(cyclestatersetabs)), range(cyclestatersetabs, na.rm=TRUE), type="n", ylab="Error", xlab="Year", axes=FALSE, main="Average Absolute Error for State and National Presidential General Election Polls By Cycle")
axis(2, seq(-1,1,.05), seq(-100, 100, 5), las=2)
axis(1, seq(1900, 2100, 4))
abline(h=seq(-1,1,.05), col="light gray", lty=2)
abline(h=0, col="red")
for(i in (1:nrow(cyclestatersetabs))[!grepl(" cd", rownames(cyclestatersetabs))]){
    lines(colnames(cyclestatersetabs), cyclestatersetabs[i,], col="gray", lwd=.7, lty=3)
    lines(colnames(cyclestatersetabs), cyclestatersetabs[i,], col="gray", lwd=.7, lty=3, type="p", pch=20, cex=.25)
    lines(colnames(cyclestatersetabssolid), cyclestatersetabssolid[i,], col="gray", lwd=1)
    lines(colnames(cyclestatersetabssolid), cyclestatersetabssolid[i,], col="dark gray", lty=3, type="p", pch=20, cex=.7)
}
lines(colnames(cyclestatersetabs), cyclestatersetabs["AllStates",], col="blue", lwd=2)
lines(colnames(cyclestatersetabs), cyclestatersetabs["AllStates",], col="blue", lwd=2, type="p", pch=20)
lines(colnames(cyclestatersetabs), cyclestatersetabs["national",], col="black", lwd=2)
lines(colnames(cyclestatersetabs), cyclestatersetabs["national",], col="black", lwd=2, type="p", pch=20)
legend(x="topleft", legend=c("National", "All States", "Each State (3+ polls)", "Each State (1-2 polls)"), lwd=c(2,2,1,.7), lty=c(1,1,1,3), pch=20, col=c("black", "blue", "gray", "gray"), bg="white")
dev.off()


jpeg("../Report/LinkedResults/Section_4_2/AbsoluteErrorsByStatesCycleSimple.jpg", width=12, height=5, units="in", res=1600)
plot(range(colnames(cyclestatersetabs)), range(cyclestatersetabs, na.rm=TRUE), type="n", ylab="Error", xlab="Year", axes=FALSE, main="Average Absolute Error for State and National Presidential General Election Polls By Cycle", ylim=c(0,.10))
axis(2, seq(-1,1,.02), seq(-100, 100, 2), las=2)
axis(1, seq(1900, 2100, 4))
abline(h=seq(-1,1,.02), col="light gray", lty=2)
abline(h=0, col="red")
lines(colnames(cyclestatersetabs), cyclestatersetabs["AllStates",], col=colman2[1], lwd=2)
lines(colnames(cyclestatersetabs), cyclestatersetabs["AllStates",], col=colman2[1], lwd=2, type="p", pch=18, cex=1.3)
lines(colnames(cyclestatersetabs), cyclestatersetabs["national",], col="gray40", lwd=2)
lines(colnames(cyclestatersetabs), cyclestatersetabs["national",], col="gray40", lwd=2, type="p", pch=20, cex=1.1)
legend(x="topright", legend=c("National", "All States"), lwd=c(2,2), lty=c(1,1), pch=c(20, 18), col=c("gray40", colman2[1]), bg="white", pt.cex=c(1.1,1.3))
dev.off()


## PLOT A STATE-BY-STATE ERROR TREND ESTIMATE FOR RECENT YEARS

dfuse$usemoe <- dfuse$combinedmarginoferror
dfuse$usemoe[is.na(dfuse$combinedmarginoferror)] <- 3.4
errorbycontest <- with(dfuse[dfuse$cycle==dfuse$year & dfuse$last2weeks & dfuse$office=="president" & dfuse$stage=="general" & dfuse$cycle>1999,], split(data.frame(demrepmargin, bestweight, state, cycle, usemoe), contest))

#errorbycontest538 <- with(dfuse[dfuse$last2weeks & dfuse$office=="president" & dfuse$stage=="general" & grepl("538", dfuse$source) & dfuse$cycle>1999,], split(data.frame(demrepmargin, bestweight, state, cycle, usemoe), contest))



ebcmeans <- sapply(errorbycontest, function(x) wtd.mean(x$demrepmargin, x$bestweight, na.rm=TRUE))
ebcses <- sapply(errorbycontest, function(x) sqrt((na.omit(c(wtd.var(x$demrepmargin, x$bestweight, na.rm=TRUE), 0))[1]+wtd.mean((x$usemoe/196)^2, x$bestweight, na.rm=TRUE))/sum(x$bestweight, na.rm=TRUE)))
ebcN <- sapply(errorbycontest, function(x) sum(x$bestweight, na.rm=TRUE))
ebcstates <- sapply(errorbycontest, function(x) x$state[1])
ebccycles <- sapply(errorbycontest, function(x) x$cycle[1])

ebc <- data.frame(ebcmeans, ebcses, ebcN, ebcstates, ebccycles)
ebc$sig <- as.numeric((abs(ebcmeans)/ebcses)>1.96)

ebcstated <- split(ebc, ebcstates)
useyear <- seq(2000, 2024, 4)


#Updating for this plot type
statesdf <- as.data.frame(states())
statesdf$lat <- as.numeric(gsub("+", "", statesdf$INTPTLAT))
statesdf$long <- as.numeric(gsub("+", "", statesdf$INTPTLON))

#manualshifts
statesdf$lat[statesdf$NAME=="Michigan"] <- statesdf$lat[statesdf$NAME=="Michigan"]-1.5
statesdf$lat[statesdf$NAME=="Massachusetts"] <- statesdf$lat[statesdf$NAME=="Massachusetts"]
statesdf$lat[statesdf$NAME=="Vermont"] <- statesdf$lat[statesdf$NAME=="Vermont"]+.5
statesdf$long[statesdf$NAME=="Michigan"] <- statesdf$long[statesdf$NAME=="Michigan"]+.5
statesdf$long[statesdf$NAME=="Maine"] <- statesdf$long[statesdf$NAME=="Maine"]-.5
statesdf$long[statesdf$NAME=="Florida"] <- statesdf$long[statesdf$NAME=="Florida"]+.5
statesdf$long[statesdf$NAME=="Delaware"] <- statesdf$long[statesdf$NAME=="Delaware"]+.25
statesdf$lat[statesdf$NAME=="Maryland"] <- statesdf$lat[statesdf$NAME=="Maryland"]+.5
statesdf$lat[statesdf$NAME=="Connecticut"] <- statesdf$lat[statesdf$NAME=="Connecticut"]+.5
statesdf$lat[statesdf$NAME=="West Virginia"] <- statesdf$lat[statesdf$NAME=="West Virginia"]+.5


jpeg("../Report/LinkedResults/Section_4_2/SurveyErrorTrendsByState.jpg", width=12, height=8, units="in", res=1600)
colman <- brewer.pal(length(useyear), "Dark2")
#map('state', xlim=c(-130, -65), ylim=c(23, 52), main="State-Level Errors in Election Surveys Over Recent Cycles")
map('state', xlim=c(-130, -65), ylim=c(23, 52), main="State-Level Errors in Election Surveys Over Recent Cycles")
#map('state', regions=c("michigan", "pennsylvania", "wisconsin", "georgia", "arizona", "north carolina", "nevada"), col="gray92", add=TRUE, fill=TRUE)
for(i in tolower(statesdf$NAME)){
    if(i %in% names(ebcstated)){
        stlat <- statesdf$lat[tolower(statesdf$NAME)==i]
        stlong <- statesdf$long[tolower(statesdf$NAME)==i]
        segments(stlong-1.25, stlat, stlong+1.25, stlat, lwd=.5, col="dark gray")
        segments(stlong-1.25, stlat+10*.05, stlong+1.25, stlat+10*.05, lwd=.5, col="gray", lty=2)
        segments(stlong-1.25, stlat-10*.05, stlong+1.25, stlat-10*.05, lwd=.5, col="gray", lty=2)
        segments(stlong-1.25, stlat, stlong+1.25, stlat, lwd=.5, col="dark gray")
        segments(seq(stlong-1.25, stlong+1.25, length.out=length(useyear)), stlat+10*(ebcstated[[i]]$ebcmeans[match(useyear, ebcstated[[i]]$ebccycles)]), seq(stlong-1.25, stlong+1.25, length.out=length(useyear)), stlat, col="light gray", lwd=.5, lty=3)
        lines(seq(stlong-1.25, stlong+1.25, length.out=length(useyear)), stlat+10*ebcstated[[i]]$ebcmeans[match(useyear, ebcstated[[i]]$ebccycles)], type="l", col="gray")
        lines(seq(stlong-1.25, stlong+1.25, length.out=length(useyear)), stlat+10*ebcstated[[i]]$ebcmeans[match(useyear, ebcstated[[i]]$ebccycles)], type="p", pch=20-19*eval(ebcstated[[i]]$ebcN[match(useyear, ebcstated[[i]]$ebccycles)]<=1), col=colman, lwd=1+min(c(ebcstated[[i]]$sig[match(useyear, ebcstated[[i]]$ebccycles)], -.5, na.rm=TRUE)), cex=1-.3*eval(ebcstated[[i]]$ebcN[match(useyear, ebcstated[[i]]$ebccycles)]<=1))
        segments(seq(stlong-1.25, stlong+1.25, length.out=length(useyear)), stlat+10*(ebcstated[[i]]$ebcmeans[match(useyear, ebcstated[[i]]$ebccycles)]-1.96*ebcstated[[i]]$ebcses[match(useyear, ebcstated[[i]]$ebccycles)]), seq(stlong-1.25, stlong+1.25, length.out=length(useyear)), stlat+10*(ebcstated[[i]]$ebcmeans[match(useyear, ebcstated[[i]]$ebccycles)]+1.96*ebcstated[[i]]$ebcses[match(useyear, ebcstated[[i]]$ebccycles)]), col=colman, lwd=1+min(c(ebcstated[[i]]$sig[match(useyear, ebcstated[[i]]$ebccycles)], 0, na.rm=TRUE)))
    }
}
i <- "national"
segments(-126, 27.5, -110, 27.5, lwd=1, col="gray")
segments(-126, 25.5, -110, 25.5, lwd=1, col="gray", lty=2)
segments(-126, 29.5, -110, 29.5, lwd=1, col="gray", lty=2)
segments(seq(-125, -110, length.out=length(useyear)), 27.5+40*(ebcstated[[i]]$ebcmeans[match(useyear, ebcstated[[i]]$ebccycles)]), seq(-125, -110, length.out=length(useyear)), 27.5, col="light gray", lwd=1, lty=3)
lines(seq(-125, -110, length.out=length(useyear)), 27.5+40*ebcstated[[i]]$ebcmeans[match(useyear, ebcstated[[i]]$ebccycles)], type="l", col="gray")
lines(seq(-125, -110, length.out=length(useyear)), 27.5+40*ebcstated[[i]]$ebcmeans[match(useyear, ebcstated[[i]]$ebccycles)], type="p", pch=20-19*eval(ebcstated[[i]]$ebcN[match(useyear, ebcstated[[i]]$ebccycles)]<=1), col=colman, lwd=1+min(c(ebcstated[[i]]$sig[match(useyear, ebcstated[[i]]$ebccycles)], -.5, na.rm=TRUE)), cex=2*(1-.3*eval(ebcstated[[i]]$ebcN[match(useyear, ebcstated[[i]]$ebccycles)]<=1)))
text(-117.5, 30, "National")
text(seq(-125, -110, length.out=length(useyear)), 25, useyear, cex=.7)
text(-126, c(25.5, 27.5, 29.5), c("-5", "0", "+5"), pos=2, cex=.7)
#legend(x="bottom", useyear, col=colman, type="p", lwd=3, cex=.7, horiz=TRUE, bg="white")
dev.off()


## Change from 2020 by State Estimate


pres20or24 <- dfuse[(dfuse$cycle %in% c("2020", "2024")) & dfuse$cycle==dfuse$year & dfuse$last2weeks & dfuse$office=="president" & dfuse$stage=="general" & !is.na(dfuse$demrepmargin),]
statepres20or24 <- split(pres20or24, pres20or24$state)
eachstatedemrepchange <- mclapply(statepres20or24, function(x) coef(summary(lm(demrepmargin~(cycle=="2024"), data=x))))
interceptsbystatepre <- sapply(eachstatedemrepchange[sapply(eachstatedemrepchange, nrow)==2], function(x) x[1,])
changesbystatepre <- sapply(eachstatedemrepchange[sapply(eachstatedemrepchange, nrow)==2], function(x) x[2,])
endpointspre <- interceptsbystatepre[1,]+changesbystatepre[1,]
interceptsbystate <- interceptsbystatepre[,order(endpointspre)]
changesbystate <- changesbystatepre[,order(endpointspre)]
endpoints <- endpointspre[order(endpointspre)]
startpoints <- interceptsbystate[1,]
sigchanges <- changesbystate[4,]<.05

changetype <- factor((abs(endpoints)<abs(startpoints))+2*sigchanges, 0:3, c("Worse, n.s.", "Better, n.s.", "Worse, sig.", "Better, sig."))
changetypecol <- as.character(factor(eval((abs(endpoints)<abs(startpoints))+2*sigchanges), 0:3, c("pink", "light green", "red", "dark green")))

jpeg("../Report/LinkedResults/Section_4_2/SignedErrorChanges2020-2024ByState.jpg", width=8, height=12, units="in", res=1600)
plot(endpoints, 1:length(endpoints), xlim=range(c(-.09, startpoints, endpoints)), type="n", axes=FALSE, ylab="", xlab="Signed Error", main="Changes in Signed Presidential Errors By State from 2020 to 2024")
axis(1, seq(-.05, .15, .025))
abline(v=seq(-.05,.2,.025), lty=3, col="gray")
abline(v=0, lty=2)
arrows(startpoints, 1:length(endpoints), endpoints, 1:length(endpoints), length=.05, lwd=3, col=changetypecol)
text(-.05, 1:length(endpoints), str_to_title(names(endpoints)), col=gsub("pink|light green", "black", changetypecol), pos=2)
legend("bottomright", legend=unique(changetype), col=unique(changetypecol), lwd=3, bg="white")
dev.off()






## skipping this one for now:

## ON A POLL BY POLL LEVEL, HOW MUCH DO PRES AND OTHER ERRORS CORRESPOND?

genpolls2024 <- dfuse[dfuse$cycle=="2024" & dfuse$year=="2024" & dfuse$last2weeks & dfuse$stage=="general" & !is.na(dfuse$demrepmargin),]
eachpollresults <- split(genpolls2024, genpolls2024$updatedpollid)

multioffice <- sapply(eachpollresults, function(x) length(unique(x$office))>1)
multoffpolls <- eachpollresults[multioffice]

errsbyoffice <- mclapply(multoffpolls, function(x) as.data.frame(xtabs((x$demrepmargin*x$bestweight)~x$office)/xtabs(((!is.na(x$demrepmargin))*x$bestweight)~x$office)))
ebo <- mclapply(errsbyoffice, function(x) as.data.frame(t(x[,2])))
for(i in 1:length(errsbyoffice))
    colnames(ebo[[i]]) <- errsbyoffice[[i]][,1]
ebound <- as.data.frame(rbindlist(ebo, fill=TRUE))

jpeg("../Report/LinkedResults/Section_4_1/CorrelationsBetweenErrorsAcrossPolls.jpg", width=16, height=10, units="in", res=1600)
par(mfrow=c(2,3))
with(ebound, plot(president, senate, xlab="Presidential Margin Error", ylab="Senate Margin Error", xlim=c(-.1,.27), ylim=c(-.1,.27), pch=20))
abline(h=0, col="gray")
abline(v=0, col="gray")
abline(a=0,b=1, col="red")
legend(x="top", legend=with(ebound, c(paste("Cor =", rd(cor(president, senate, use="pair"))), paste("N =", sum(!is.na(president) & !is.na(senate))))), box.col="white")
with(ebound, plot(president, governor, xlab="Presidential Margin Error", ylab="Governor Margin Error", xlim=c(-.1,.27), ylim=c(-.1,.27), pch=20))
abline(h=0, col="gray")
abline(v=0, col="gray")
abline(a=0,b=1, col="red")
legend(x="top", legend=with(ebound, c(paste("Cor =", rd(cor(president, governor, use="pair"))), paste("N =", sum(!is.na(president) & !is.na(governor))))), box.col="white")
with(ebound, plot(president, house, xlab="Presidential Margin Error", ylab="House Margin Error", xlim=c(-.1,.27), ylim=c(-.1,.27), pch=20))
abline(h=0, col="gray")
abline(v=0, col="gray")
abline(a=0,b=1, col="red")
legend(x="top", legend=with(ebound, c(paste("Cor =", rd(cor(president, house, use="pair"))), paste("N =", sum(!is.na(president) & !is.na(house))))), box.col="white")
with(ebound, plot(senate, governor, xlab="Senate Margin Error", ylab="Governor Margin Error", xlim=c(-.1,.27), ylim=c(-.1,.27), pch=20))
abline(h=0, col="gray")
abline(v=0, col="gray")
abline(a=0,b=1, col="red")
legend(x="top", legend=with(ebound, c(paste("Cor =", rd(cor(governor, senate, use="pair"))), paste("N =", sum(!is.na(governor) & !is.na(senate))))), box.col="white")
with(ebound, plot(senate, house, xlab="Senate Margin Error", ylab="House Margin Error", xlim=c(-.1,.27), ylim=c(-.1,.27), pch=20))
abline(h=0, col="gray")
abline(v=0, col="gray")
abline(a=0,b=1, col="red")
legend(x="top", legend=with(ebound, c(paste("Cor =", rd(cor(senate, house, use="pair"))), paste("N =", sum(!is.na(senate) & !is.na(house))))), box.col="white")
with(ebound, plot(governor, house, xlab="Governor Margin Error", ylab="House Margin Error", xlim=c(-.1,.27), ylim=c(-.1,.27), pch=20))
abline(h=0, col="gray")
abline(v=0, col="gray")
abline(a=0,b=1, col="red")
legend(x="top", legend=with(ebound, c(paste("Cor =", rd(cor(governor, house, use="pair"))), paste("N =", sum(!is.na(governor) & !is.na(house))))), box.col="white")
dev.off()





## SECTION 5 -- WHICH METHODS HAVE WHICH EFFECTS

dfuse$keytypesofpolls <- with(dfuse, office)
dfuse$keytypesofpolls[dfuse$swingstates & !is.na(dfuse$swingstates) & dfuse$stateornat=="State" & dfuse$office=="president"] <- paste(dfuse$keytypesofpolls[dfuse$swingstates & dfuse$stateornat=="State" & !is.na(dfuse$swingstates) & dfuse$office=="president"], "Swing State")
dfuse$keytypesofpolls[(!dfuse$swingstates | is.na(dfuse$swingstates)) & dfuse$stateornat=="State" & dfuse$office=="president"] <- paste(dfuse$keytypesofpolls[(!dfuse$swingstates | is.na(dfuse$swingstates)) & dfuse$stateornat=="State" & dfuse$office=="president"], "Non-Swing State")
dfuse$keytypesofpolls[dfuse$stateornat=="Congressional District" & dfuse$office=="president"] <- paste(dfuse$keytypesofpolls[dfuse$stateornat=="Congressional District" & dfuse$office=="president"], "Congressional District")
dfuse$keytypesofpolls[dfuse$stateornat=="National" & dfuse$office=="president"] <- paste(dfuse$keytypesofpolls[dfuse$stateornat=="National" & dfuse$office=="president"], "National")
dfuse$keypolltypes <- factor(dfuse$keytypesofpolls, c("president National", "president Swing State", "president Non-Swing State", "president Congressional District", "senate", "governor", "house"), c("President\nNational", "President\nSwing State", "President\nOther State", "President\nCongressional", "U.S. Senate", "Governor", "U.S. House"))


basetopred24pre <- dfuse[dfuse$cycle==2024 & dfuse$year==2024 & dfuse$stage=="general" & dfuse$last2weeks==TRUE & !is.na(dfuse$demrepmargin),]
table(basetopred24pre$keypolltypes)

volmatchers <- data.frame(match_name=names(pollstervolumes), pollstervolumes, pollstervolcut=cut(pollstervolumes, c(0,2.5,9.5,50.5,999), c("1-2", "3-9", "10-50", "Over 50")))
basetopred24pre2 <- merge(basetopred24pre, volmatchers, all.x=TRUE)

firstyearmatchers <- data.frame(match_name=names(firstyears), firstyears, pollsteryearcut=cut(firstyears, c(1936, 1999.5, 2008.5, 2016.5, 2020.5, 2025), c("Pre-2000", "2000-2008", "2012-2016", "2020", "2024")))

basetopred24pre3 <- merge(basetopred24pre2, firstyearmatchers, all.x=TRUE)


basetopred24 <- basetopred24pre3

## Do this with 2022 to compare

basetopred22pre <- dfuse[dfuse$cycle==2022 & dfuse$year==2022 & dfuse$stage=="general" & dfuse$last2weeks==TRUE & !is.na(dfuse$demrepmargin),]
table(basetopred22pre$keypolltypes)

basetopred22pre2 <- merge(basetopred22pre, volmatchers, all.x=TRUE)

firstyearmatchers <- data.frame(match_name=names(firstyears), firstyears, pollsteryearcut=cut(firstyears, c(1936, 1999.5, 2008.5, 2016.5, 2020.5, 2025), c("Pre-2000", "2000-2008", "2012-2016", "2020", "2024")))

basetopred22pre3 <- merge(basetopred22pre2, firstyearmatchers, all.x=TRUE)

basetopred22 <- basetopred22pre3



typereg <- glm(demrepmargin~keypolltypes, weight=bestweight, data=basetopred24)
typeregabs <- glm(abs(demrepmargin)~keypolltypes, weight=bestweight, data=basetopred24)

typeregvol <- glm(demrepmargin~keypolltypes+pollstervolcut, weight=bestweight, data=basetopred24)
typeregvolabs <- glm(abs(demrepmargin)~keypolltypes+pollstervolcut, weight=bestweight, data=basetopred24)

coef(summary(typeregvol))

# x <- basetopred24$pollstervolcut
# ds <- basetopred24
#filter=(basetopred24$keypolltypes==levels(basetopred24$keypolltypes)[1])
#ds=basetopred24
#outcome=ds$demrepmargin
#abs=FALSE

runvarsig <- function(x, filter=NULL, ds=basetopred24, outcome=ds$demrepmargin, abs=FALSE){
    if(is.factor(x))
        x <- as.data.frame(dummify(as.factor(x)))
    if(!is.null(filter)){
        #dsuse <- ds[(filter==1 | filter==TRUE) & !is.na(filter) & !is.na(x),]
        xuse <- x[(filter==1 | filter==TRUE) & !is.na(filter) & !is.na(x),]
        outcomeuse <- outcome[(filter==1 | filter==TRUE) & !is.na(filter) & !is.na(x)]
    }
    if(abs==TRUE)
        outcomeuse <- abs(outcomeuse)
    fullreg <- lapply(xuse, function(g) try(coef(summary(lm(outcomeuse~g)))))
    regoutpres <- lapply(fullreg, function(g) try(c(g[2,], intercept=g[1,])))
    regoutpres[sapply(regoutpres, class)=="try-error"] <- rep(NA, 8)
    regouts <- try(as.data.frame(regoutpres))
    if(class(regouts)=="try-error")
        regouts <- data.frame(rep(NA, 8), rep(NA, 8), rep(NA, 8), rep(NA, 8))
    colnames(regouts) <- colnames(xuse)
    regouts
}        

runvarsig2 <- function(x, filter=NULL, ds=basetopred24, outcome=ds$demrepmargin, abs=FALSE){
    tot <- !is.na(x)
    if(is.factor(x))
        x <- as.data.frame(dummify(as.factor(x)))
    if(!is.null(filter)){
        dsuse <- ds[(filter==1 | filter==TRUE) & !is.na(filter) & !is.na(x),]
        xuse <- data.frame(tot, x)[(filter==1 | filter==TRUE) & !is.na(filter) & !is.na(x),]
        outcomeuse <- outcome[(filter==1 | filter==TRUE) & !is.na(filter) & !is.na(x)]
    }
    if(abs==TRUE)
        outcomeuse <- abs(outcomeuse)
    fullreg <- lapply(xuse, function(g) try(coef(summary(lm(outcomeuse~g)))))
    barlev <- sapply(fullreg, function(x) try(sum(x[,"Estimate"])))
    regoutpres <- lapply(fullreg, function(g) try(c(g[2,], intercept=g[1,])))
    regoutpres[sapply(regoutpres, class)=="try-error"] <- rep(NA, 8)
    regouts <- try(as.data.frame(regoutpres))
    if(class(regouts)=="try-error")
        regouts <- data.frame(rep(NA, 8), rep(NA, 8), rep(NA, 8), rep(NA, 8))
    colnames(regouts) <- colnames(xuse)
    regouts
}       



# Did the firms that conducted more polls have lower errors?


x <- basetopred24$pollstervolcut




buildplotnum <- function(x){
    (as.numeric(as.factor(basetopred24$keypolltypes))-1)*(1+length(unique(as.numeric(as.factor(na.omit(x))))))+as.numeric(as.factor(x))
}

tryreplace <- function(x, replacewith=NA){
    out <- try(x, silent=TRUE)
    out[class(out)=="try-error"] <- replacewith
    out
}


runtoplotfactor <- function(x, legendtitle="", ds=basetopred24){
    xnom <- levels(x)
#
    signedmns <- with(ds, xtabs(demrepmargin*bestweight~keypolltypes+x)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes+x, na.rm=TRUE))
    absmns <- with(ds, xtabs(abs(demrepmargin*bestweight)~keypolltypes+x)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes+x, na.rm=TRUE))
                                        #
    eachsigsigned <- with(ds, lapply(levels(as.factor(na.omit(x))), function(g) lapply(levels(keypolltypes), function(k) coef(summary(lm(demrepmargin~(x==g), weight=bestweight, subset=(keypolltypes==k)))))))
    sigsetsigned <- sapply(eachsigsigned, function(g) sapply(g, function(q) tryreplace(q[2,"Pr(>|t|)"]<.05, replacewith=FALSE)))
    eachsigabs <- with(ds, lapply(levels(as.factor(na.omit(x))), function(g) lapply(levels(keypolltypes), function(k) coef(summary(lm(abs(demrepmargin)~(x==g), weight=bestweight, subset=(keypolltypes==k)))))))
    sigsetabs <- sapply(eachsigabs, function(g) sapply(g, function(q) tryreplace(q[2,"Pr(>|t|)"]<.05, replacewith=FALSE)))
                                        #
    pvcx <- buildplotnum(x)
    nsetx <- xtabs(ds$bestweight[!is.na(x)]~ds$keypolltypes[!is.na(x)])
    bigbrew <- c(brewer.pal(8, "Set2"), brewer.pal(8, "Set1"))
    darkbrew <- c(brewer.pal(8, "Dark2"), brewer.pal(8, "Set1"))
    colx <- bigbrew[as.numeric(as.factor(x))]
    seps <- length(unique(as.numeric(as.factor(na.omit(x)))))
#
    par(mar=c(2,5,2,1))
    plot(pvcx, 100*ds$demrepmargin, cex=ds$bestweight, pch=20, axes=FALSE, ylab="Error in Margin (Dem-Rep)", xlab="", ylim=c(-12, max(100*ds$demrepmargin)), col=alpha(colx, .4))
    text(1:length(levels(ds$keypolltypes))*(seps+1)-(seps/2), min(100*ds$demrepmargin)-2, paste0(levels(ds$keypolltypes), "\n(", rd(nsetx, 0), ")"))
    abline(h=seq(-5,100,5), col="gray", lty=3)
    abline(h=0)
    axis(2, seq(-10,100,5), las=2)
    for(i in 1:ncol(signedmns)){
        lines(i+(seps+1)*((1:nrow(signedmns))-1), 100*signedmns[,i], pch=5+18*as.numeric(as.logical(sigsetsigned[,i])), bg=darkbrew[i], type="p", cex=1.3+.4*as.numeric(as.logical(sigsetsigned[,i])))
        lines(i+(seps+1)*((1:nrow(absmns))-1), 100*absmns[,i], pch=1+20*as.numeric(as.logical(sigsetabs[,i])), bg=darkbrew[i], type="p", cex=1.15+.1*as.numeric(as.logical(sigsetabs[,i])))
    }
    legend(x="topleft", c(xnom, "Mean Signed Error", "Mean Absolute Error", "Error Significantly Different\nFrom Contest Type Mean"), pch=c(rep(20, length(xnom)), 5, 1, 23), col=c(bigbrew[1:length(xnom)], rep("black", 3)), pt.bg=darkbrew[1], bg="white", title=legendtitle, pt.cex=1.2, cex=.9)
}




runtoplotseparate <- function(x, legendtitle="", ds=basetopred24){
    xnom <- names(x)
                                        #
    ds$keypolltypes <- droplevels(ds$keypol)
    signedmns <- as.data.frame(mclapply(x, function(g) with(ds[g,], as.vector(xtabs(demrepmargin*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))
    absmns <- as.data.frame(mclapply(x, function(g) with(ds[g,], as.vector(xtabs(abs(demrepmargin*bestweight)~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))
                                        #
    eachsigsigned <- with(ds, mclapply(x, function(g) lapply(levels(keypolltypes), function(k) try(coef(summary(lm(demrepmargin~g, weight=bestweight, subset=(keypolltypes==k))))))))
    sigsetsigned <- sapply(eachsigsigned, function(g) sapply(g, function(q) tryreplace(q[2,"Pr(>|t|)"]<.05, replacewith=FALSE)))
    eachsigabs <- with(ds,  mclapply(x, function(g) lapply(levels(keypolltypes), function(k) try(coef(summary(lm(abs(demrepmargin)~g, weight=bestweight, subset=(keypolltypes==k))))))))
    sigsetabs <- sapply(eachsigabs, function(g) sapply(g, function(q) tryreplace(q[2,"Pr(>|t|)"]<.05, replacewith=FALSE)))
                                        #
                                        #pvcx <- buildplotnum(x)
    bigbrew <- c(brewer.pal(8, "Set2"), brewer.pal(8, "Set1"))
    darkbrew <- c(brewer.pal(8, "Dark2"), brewer.pal(8, "Set1"))
    #colx <- bigbrew[as.numeric(as.factor(x))]
    seps <- ncol(x)
    nsetxpre <- sapply(x, function(g) xtabs(ds$bestweight[!is.na(g)]~ds$keypolltypes[!is.na(g)], na.rm=TRUE))
    nsetxpre2 <- apply(nsetxpre, 1, range)
    nsetx <- paste(rd(nsetxpre2[1,], 0, max=0), rd(nsetxpre2[2,], 0, max=0), sep="-")
    nsetx[nsetxpre2[1,]==nsetxpre2[2,]] <- rd(nsetxpre2[1,], 0, max=0)[nsetxpre2[1,]==nsetxpre2[2,]]
                                        #
    par(mar=c(2,5,2,1))
    plot(c(0, (seps+1)*length(levels(ds$keypolltypes))-1), range(100*ds$demrepmargin), type="n", cex=0, pch=20, axes=FALSE, ylab="Error in Margin (Dem-Rep)", xlab="", ylim=c(min(range(100*ds$demrepmargin)-3), max(100*ds$demrepmargin)))
    for(i in 1:ncol(x))
        lines((i)+(seps+1)*(as.numeric(ds$keypolltypes[x[,i]])-1)-1, 100*ds$demrepmargin[x[,i]], cex=ds$bestweight[x[,i]], type="p", pch=20, col=alpha(bigbrew[i], .4))
    text((1:length(levels(ds$keypolltypes)))*(seps+1)-((seps+1)/2)-1, min(100*ds$demrepmargin)-2, paste0(levels(ds$keypolltypes), "\n(", gsub("\\.", "", nsetx), ")"))
    abline(h=seq(-5,100,5), col="gray", lty=3)
    abline(h=0)
    #axis(1, (1:length(levels(ds$keypolltypes)))*(seps+1)-((seps+1)/2)-1, paste0(levels(ds$keypolltypes), "\n(", gsub("\\.", "", nsetx), ")"), ticks=0)
    axis(2, seq(-10,100,5), las=2)
    for(i in 1:ncol(signedmns)){
        lines(i+(seps+1)*((1:nrow(signedmns))-1)-1, 100*as.numeric(signedmns[,i]), pch=5+18*as.numeric(as.logical(sigsetsigned[,i])), bg=darkbrew[i], type="p", cex=1.3+.4*as.numeric(as.logical(sigsetsigned[,i])))
        lines(i+(seps+1)*((1:nrow(absmns))-1)-1, 100*as.numeric(absmns[,i]), pch=1+20*as.numeric(as.logical(sigsetabs[,i])), bg=darkbrew[i], type="p", cex=1.15+.1*as.numeric(as.logical(sigsetabs[,i])))
}
    legend(x="topleft", c(xnom, "Mean Signed Error", "Mean Absolute Error", "Error Significantly Different\nFrom Contest Type Mean"), pch=c(rep(20, length(xnom)), 5, 1, 23), col=c(bigbrew[1:length(xnom)], rep("black", 3)), pt.bg=darkbrew[1], bg="white", title=legendtitle, pt.cex=1.2, cex=.9)
}



jpeg("../Report/LinkedResults/Section_5_1/ErrorsByFirmNPolls.jpg", width=12, height=7, units="in", res=1600)
runtoplotfactor(basetopred24$pollstervolcut, "Number of Firm Polls")
dev.off()

#signed means
with(basetopred24, xtabs(demrepmargin*bestweight~keypolltypes+as.factor(basetopred24$pollstervolcut))/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes+as.factor(basetopred24$pollstervolcut), na.rm=TRUE))
#absmns <- with(basetopred24, xtabs(abs(demrepmargin*bestweight)~keypolltypes+x)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes+x, na.rm=TRUE))



jpeg("../Report/LinkedResults/Section_5_1/ErrorsByFirmStart.jpg", width=12, height=7, units="in", res=1600)
runtoplotfactor(basetopred24$pollsteryearcut, "First Presidential Cycle for Firm")
dev.off()


#signed means
with(basetopred24, xtabs(demrepmargin*bestweight~keypolltypes+as.factor(basetopred24$pollsteryearcut))/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes+as.factor(basetopred24$pollsteryearcut), na.rm=TRUE))
#absmns <- with(basetopred24, xtabs(abs(demrepmargin*bestweight)~keypolltypes+x)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes+x, na.rm=TRUE))


firmtypeset <- as.data.frame(basetopred24[,ftypes]==1)
colnames(firmtypeset) <- str_to_title(gsub("firmtype_", "", colnames(firmtypeset)))

jpeg("../Report/LinkedResults/Section_5_1/FirmTypes.jpg", width=12, height=8, units="in", res=1600)
runtoplotseparate(firmtypeset, legendtitle="Firm Type (non-exclusive)")
dev.off()


firmtypeset22 <- as.data.frame(basetopred22[,ftypes]==1)
colnames(firmtypeset22) <- str_to_title(gsub("firmtype_", "", colnames(firmtypeset)))

jpeg("../Report/LinkedResults/Section_5_1/FirmTypes2022.jpg", width=12, height=8, units="in", res=1600)
runtoplotseparate(firmtypeset22, legendtitle="Firm Type (non-exclusive)", ds=basetopred22)
dev.off()



#signed means

as.data.frame(mclapply(firmtypeset, function(g) with(basetopred24[g,], as.vector(xtabs(demrepmargin*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))
as.data.frame(mclapply(firmtypeset, function(g) with(basetopred24[g,], as.vector(xtabs(abs(demrepmargin*bestweight)~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))

methodvarset24use <- with(basetopred24, data.frame(anyonlineoptin, anytext, anylivephone, anyivr, anymailemail, anyprobpanel, multiple=(as.numeric(as.character(multimethodindicator))>1), morethan2=(as.numeric(as.character(multimethodindicator))>2))) # anyf2f -- no face to face in this period
names(methodvarset24use) <- c("Any Opt-In Online", "Any Text", "Any Live Phone", "Any IVR", "Any Mail/Email", "Any Probability Panel", "Multiple Methods", "3+ Methods")

jpeg("../Report/LinkedResults/Section_5_1/MethodsUsed.jpg", width=12, height=9, units="in", res=1600)
runtoplotseparate(methodvarset24use, legendtitle="Methods Used (non-exclusive)")
dev.off()

as.data.frame(mclapply(methodvarset24use, function(g) with(basetopred24[g,], as.vector(xtabs(demrepmargin*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))
as.data.frame(mclapply(methodvarset24use, function(g) with(basetopred24[g,], as.vector(xtabs(abs(demrepmargin*bestweight)~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))

methodvarset24useV2 <- with(basetopred24, data.frame(anyonlineoptin & (as.numeric(as.character(multimethodindicator))==1), anytext & (as.numeric(as.character(multimethodindicator))==1), anylivephone & (as.numeric(as.character(multimethodindicator))==1), anyprobpanel & (as.numeric(as.character(multimethodindicator))==1), anyonlineoptin & (as.numeric(as.character(multimethodindicator))>1), anytext & (as.numeric(as.character(multimethodindicator))>1), anylivephone & (as.numeric(as.character(multimethodindicator))>1), anyivr & (as.numeric(as.character(multimethodindicator))>1)))#, anyprobpanel & (as.numeric(as.character(multimethodindicator))>1)

names(methodvarset24useV2) <- c("Opt-In Online Only", "Text Only", "Live Phone Only", "Probability Panel Only", "Opt-In Online - Multiple", "Text - Multiple", "Live Phone - Multiple", "IVR - Multiple")#, "Probability Panel - Multiple"

jpeg("../Report/LinkedResults/Section_5_1/MethodsUsedAlone.jpg", width=12, height=9, units="in", res=1600)
runtoplotseparate(methodvarset24useV2, legendtitle="Methods Used (non-exclusive)")
dev.off()

as.data.frame(mclapply(methodvarset24useV2, function(g) with(basetopred24[g,], as.vector(xtabs(demrepmargin*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))
as.data.frame(mclapply(methodvarset24useV2, function(g) with(basetopred24[g,], as.vector(xtabs(abs(demrepmargin)*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))

## Methods over recent cycles -- come back to this after initial version of report

methodvarsetuse <- with(dfuse, data.frame(anyonlineoptin, anytext, anylivephone, anyivr, anyprobpanel, multiple=(as.numeric(as.character(multimethodindicator))>1), morethan2=(as.numeric(as.character(multimethodindicator))>2))) # anyf2f -- no face to face in this period anymailemail, 

signedmethodovertime <- as.data.frame(rbindlist(mclapply(methodvarsetuse, function(g) with(dfuse[(dfuse$cycle %in% seq(2000, 2024, 4)) & dfuse$stage=="general" & dfuse$stateornat=="State" & dfuse$office=="president" & dfuse$last2weeks & g,], as.data.frame(t(as.matrix(xtabs(demrepmargin*bestweight~cycle, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~cycle, na.rm=TRUE)))))), fill=TRUE))
absmethodovertime <- as.data.frame(rbindlist(mclapply(methodvarsetuse, function(g) with(dfuse[(dfuse$cycle %in% seq(2000, 2024, 4)) & dfuse$stage=="general" & dfuse$stateornat=="State" & dfuse$office=="president" & dfuse$last2weeks & g,], as.data.frame(t(as.matrix(xtabs(abs(demrepmargin)*bestweight~cycle, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~cycle, na.rm=TRUE)))))), fill=TRUE))
absmethodovertimenational <- as.data.frame(rbindlist(mclapply(methodvarsetuse, function(g) with(dfuse[(dfuse$cycle %in% seq(2000, 2024, 4)) & dfuse$stage=="general" & dfuse$stateornat=="National" & dfuse$office=="president" & dfuse$last2weeks & g,], as.data.frame(t(as.matrix(xtabs(abs(demrepmargin)*bestweight~cycle, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~cycle, na.rm=TRUE)))))), fill=TRUE))

rownames(signedmethodovertime) <- rownames(absmethodovertime) <- rownames(absmethodovertimenational) <- names(methodvarsetuse)

barplot(t(absmethodovertime), beside=TRUE)
barplot(t(signedmethodovertime), beside=TRUE, add=TRUE)
barplot(t(absmethodovertimenational), beside=TRUE)

## Alternate metrics for mode

apimode <- as.data.frame(basetopred24[,grepl("^api_", names(basetopred24)) & grepl("text|phonemode|web|ivr|live|onlinepanel|probpanel", names(basetopred24))]==TRUE)

jpeg("../Report/LinkedResults/Section_5_1/APImode.jpg", width=12, height=9, units="in", res=1600)
runtoplotseparate(apimode, legendtitle="API Mode Used (non-exclusive)")
dev.off()

rlmodepre <- as.data.frame(basetopred24[,grepl("^rl", names(basetopred24)) & grepl("_collec", names(basetopred24))])
rlmodepre2 <- as.data.frame(lapply(rlmodepre, function(x) x %in% c("probably", "definitely")))
rlmodepre2[is.na(rlmodepre)] <- NA
rlmode <- rlmodepre2[,colSums(rlmodepre2, na.rm=TRUE)>10]

colnames(rlmode) <- str_to_title(gsub("rlmethods_collect", "", colnames(rlmode)))

jpeg("../Report/LinkedResults/Section_5_1/RLmode.jpg", width=12, height=9, units="in", res=1600)
runtoplotseparate(rlmode, legendtitle="RL Mode Used (non-exclusive)")
dev.off()

as.data.frame(mclapply(methodvarset24use, function(g) with(basetopred24[g,], as.vector(xtabs(abs(demrepmargin)*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))
as.data.frame(mclapply(apimode, function(g) with(basetopred24[g,], as.vector(xtabs(abs(demrepmargin)*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))
as.data.frame(mclapply(rlmode, function(g) with(basetopred24[g,], as.vector(xtabs(abs(demrepmargin)*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))




# Errors by Sampling Strategies

allmercersamp24 <- basetopred24[,grepl("mercer", colnames(basetopred24)) & grepl("altsamp|panel", colnames(basetopred24))] # includes others we can figure out
allmercersamp24[basetopred24$mercermethods_frame_unknown==1 & !is.na(basetopred24$mercermethods_frame_unknown),] <- NA
allmercersamp24$otherframe <- basetopred24$otherframe <- as.numeric(rowSums(allmercersamp24)==0) ## Errors are on purpose here to drop unknowns 
allmercersamp24use <- as.data.frame(allmercersamp24[,-1]==1)

names(allmercersamp24use) <- c("Address-Based", "Voter File", "Random Digit Dial", "Something Else")

jpeg("../Report/LinkedResults/Section_5_1/SamplingMethodsUsed.jpg", width=12, height=7, units="in", res=1600)
runtoplotseparate(allmercersamp24use, legendtitle="Sampling Methods Used (non-exclusive)")
dev.off()

as.data.frame(mclapply(allmercersamp24use, function(g) with(basetopred24[g,], as.vector(xtabs(abs(demrepmargin)*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))

data.frame(dfuse$match_name, dfuse$mercermethods_altsamp_voterfile)[dfuse$last2weeks & dfuse$stage=="general" & dfuse$cycle==2024,] # includes others we can figure out








apisampling <- as.data.frame(basetopred24[,grepl("^api_", names(basetopred24)) & grepl("voterfilesamp|riversamp|abs|rdd|panel|probpanel", names(basetopred24))]==TRUE)

jpeg("../Report/LinkedResults/Section_5_1/APIsampling.jpg", width=12, height=9, units="in", res=1600)
runtoplotseparate(apisampling, legendtitle="API Sampling Used (non-exclusive)")
dev.off()

rlsamplingpre <- as.data.frame(basetopred24[,grepl("^rl", names(basetopred24)) & grepl("_samp", names(basetopred24))])
rlsamplingpre2 <- as.data.frame(lapply(rlsamplingpre, function(x) x %in% c("probably", "definitely")))
rlsamplingpre2[is.na(rlsamplingpre)] <- NA
rlsampling <- rlsamplingpre2[,colSums(rlsamplingpre2, na.rm=TRUE)>10]
colnames(rlsampling) <- str_to_title(gsub("rlmethods_sampled|from", "", colnames(rlsampling)))

jpeg("../Report/LinkedResults/Section_5_1/RLsampling.jpg", width=12, height=9, units="in", res=1600)
runtoplotseparate(rlsampling, legendtitle="RL Sampling Used (non-exclusive)")
dev.off()


## Weighting variables used

# start with mercer ones

mercerwt24 <- basetopred24[,grepl("mercer", colnames(basetopred24)) & grepl("wt_", colnames(basetopred24))]
mercerwt24[basetopred24$mercermethods_wt_unknown==1 & !is.na(basetopred24$mercermethods_wt_unknown),] <- NA
mercerwt24use <- mercerwt24[,colSums(mercerwt24, na.rm=TRUE)>50]

mercerwt24usepartpre <- as.data.frame(mercerwt24use[,grepl("2020|part|regis|vote", colnames(mercerwt24use))]==1)
mercerwt24usepart <- mercerwt24usepartpre
mercerwt24usepart[,"Any Party/Vote Weight"] <- rowSums(mercerwt24usepartpre>=1)>0
mercerwt24usepart[,"No Party/Vote Weight"] <- rowSums(mercerwt24usepartpre>=1)==0

names(mercerwt24usepart) <- gsub("Id", "ID", str_to_title(gsub("_|  | _|_ |   ", " ", gsub("vote|vote_", "vote ", gsub("vote|vote_", "vote ", gsub("2020", " 2020", gsub("mercermethods_wt_", "", names(mercerwt24usepart))))))))

jpeg("../Report/LinkedResults/Section_5_1/PolWeightsUsed.jpg", width=12, height=9, units="in", res=1600)
runtoplotseparate(mercerwt24usepart, legendtitle="Political Weights Used (non-exclusive)")
dev.off()


# weighted on it
as.data.frame(mclapply(mercerwt24usepart, function(g) with(basetopred24[g,], as.vector(xtabs(abs(demrepmargin)*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))

# did not weight on it
as.data.frame(mclapply(mercerwt24usepart, function(g) with(basetopred24[!g,], as.vector(xtabs(abs(demrepmargin)*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))

as.data.frame(mclapply(mercerwt24usepart, function(g) with(basetopred24[g,], as.vector(xtabs(abs(demrepmargin)*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))-as.data.frame(mclapply(mercerwt24usepart, function(g) with(basetopred24[!g,], as.vector(xtabs(abs(demrepmargin)*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))

## Signed error
# weighted on it
as.data.frame(mclapply(mercerwt24usepart, function(g) with(basetopred24[g,], as.vector(xtabs(demrepmargin*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))

# did not weight on it
as.data.frame(mclapply(mercerwt24usepart, function(g) with(basetopred24[!g,], as.vector(xtabs(demrepmargin*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))

as.data.frame(mclapply(mercerwt24usepart, function(g) with(basetopred24[g,], as.vector(xtabs(demrepmargin*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))-as.data.frame(mclapply(mercerwt24usepart, function(g) with(basetopred24[!g,], as.vector(xtabs(demrepmargin*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))



# Ns
as.data.frame(mclapply(mercerwt24usepart, function(g) with(basetopred24[g,], as.vector(xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))




## Other Weights Used

mercerwt24useotherpre <- as.data.frame(mercerwt24use[,!grepl("2020|part|regis|vote", colnames(mercerwt24use))]==1)
mercerwt24useother <- mercerwt24useotherpre
mercerwt24useother[,"Any Demographic Weight"] <- rowSums(mercerwt24useotherpre>=1)>0
mercerwt24useother[,"No Demographic Weight"] <- rowSums(mercerwt24useotherpre>=1)==0

names(mercerwt24useother) <- str_to_title(gsub("_|  | _|_ |   ", " ", gsub("pop_", "population ", gsub("race_ethn", "Race/Ethnicity", gsub("mercermethods_wt_", "", names(mercerwt24useother))))))

jpeg("../Report/LinkedResults/Section_5_1/OtherWeightsUsed.jpg", width=12, height=10, units="in", res=1600)
runtoplotseparate(mercerwt24useother, legendtitle="Demographic Weights Used (non-exclusive)")
dev.off()

# weighted on it
as.data.frame(mclapply(mercerwt24useother, function(g) with(basetopred24[g,], as.vector(xtabs(abs(demrepmargin)*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))

# did not weight on it
as.data.frame(mclapply(mercerwt24useother, function(g) with(basetopred24[!g,], as.vector(xtabs(abs(demrepmargin)*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))

as.data.frame(mclapply(mercerwt24useother, function(g) with(basetopred24[g,], as.vector(xtabs(abs(demrepmargin)*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))-as.data.frame(mclapply(mercerwt24useother, function(g) with(basetopred24[!g,], as.vector(xtabs(abs(demrepmargin)*bestweight~keypolltypes, na.rm=TRUE)/xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))


# Ns
as.data.frame(mclapply(mercerwt24useother, function(g) with(basetopred24[g,], as.vector(xtabs((!is.na(demrepmargin))*bestweight~keypolltypes, na.rm=TRUE)))))




## how about api weights?

apiwts <- as.data.frame(basetopred24[,grepl("^api_", names(basetopred24)) & grepl("weight$", names(basetopred24))]==TRUE)
apiusewts <- apiwts[,colSums(apiwts, na.rm=TRUE)>50]

colnames(apiusewts) <- str_to_title(gsub("weight|api_", "", gsub("raceeth", "Race/Ethnicity", gsub("gendsex", "Gender", gsub("educ", "Education", colnames(apiusewts))))))

jpeg("../Report/LinkedResults/Section_5_1/APIweights.jpg", width=12, height=9, units="in", res=1600)
runtoplotseparate(apiusewts, legendtitle="API Weights Used (non-exclusive)")
dev.off()


## Firm Survey Quota Variables

firmquotapre <- as.data.frame(basetopred24[,grepl("^firmsurvey_quotastratavars", names(basetopred24))])
firmquotapre2 <- apply(firmquotapre, 2, function(x) grepl("All|Some", x))
firmquotapre2[is.na(firmquotapre)] <- NA
firmquota <- as.data.frame(firmquotapre2[,colSums(firmquotapre2, na.rm=TRUE)>5])

jpeg("../Report/LinkedResults/Section_5_1/Firmquotas.jpg", width=12, height=9, units="in", res=1600)
runtoplotseparate(firmquota, legendtitle="Firm Survey Quotas Used (non-exclusive)")
dev.off()



## How did firms identify likely voters vs margin

firmLVvars <- with(basetopred24, data.frame(firmsurvey_LVvars_Self_reported_enthusiasm, firmsurvey_LVvars_Self_reported_likelihood_of_voting, firmsurvey_LVvars_Self_reported_past_vote, firmsurvey_LVvars_Demographic_attributes_of_prior_voters, firmsurvey_LVvars_Voter_file_match_on_past_voting))

firmLVspre <- as.data.frame(apply(firmLVvars, 2, function(x) grepl("All|Some", x)))
firmLVspre[is.na(firmLVvars)] <- NA

firmLVs <- firmLVspre
firmLVs[,"Voter or Nonvoter"] <- grepl("classified", basetopred24$"firmsurvey_Which_best_describes_how_your_Likely_Voter_model_worked._Selected_Choice")
firmLVs[,"Probability of Voting"] <- grepl("probability", basetopred24$"firmsurvey_Which_best_describes_how_your_Likely_Voter_model_worked._Selected_Choice")
firmLVs[,"Probability of Voting"][is.na(basetopred24$"firmsurvey_Which_best_describes_how_your_Likely_Voter_model_worked._Selected_Choice")] <- NA
firmLVs[,"Voter or Nonvoter"][is.na(basetopred24$"firmsurvey_Which_best_describes_how_your_Likely_Voter_model_worked._Selected_Choice")] <- NA
firmLVs[,"No LV Model"] <- basetopred24$"firmsurvey_Did_you_report_on_likely_voters_or_produce_a_likely_voter_model_for_at_least_some_of_your_polls."=="No"


names(firmLVs) <- str_to_title(gsub("_", " ", gsub("firmsurvey_LVvars_", "", names(firmLVs))))

jpeg("../Report/LinkedResults/Section_5_1/LVStrategyUsed.jpg", width=12, height=9, units="in", res=1600)
runtoplotseparate(firmLVs, legendtitle="Likely Voter Strategy Used (non-exclusive)")
dev.off()



## Additional Voter File Variables Analysis



eachvoterfileuse <- basetopred24$firmsurvey_Did_you_use_voter_file_data_for_any_of_the_following._select_all_that_apply_

evfu <- strsplit(eachvoterfileuse, ";")

voterfileuses <- as.data.frame(sapply(na.omit(unique(unlist(evfu))), function(x) grepl(x, eachvoterfileuse)))
voterfileuses[rowSums(!is.na(voterfileuses))==0,] <- NA

jpeg("../Report/LinkedResults/Section_5_1/VoterFileUse.jpg", width=12, height=9, units="in", res=1600)
runtoplotseparate(voterfileuses, legendtitle="Uses of Voter File Data")
dev.off()

# Past Vote
pastvoteoptions <- with(basetopred24, data.frame('Sampling'=firmsurvey_quotastratavars_2020_election_choice_past_vote_, 'Weighting'=firmsurvey_weightvars_2020_election_choice_past_vote_, 'LV Model'=firmsurvey_LVvars_Voter_file_match_on_past_voting))
firmPVusepre <- apply(pastvoteoptions, 2, function(x) grepl("All|Some", x))
firmPVusepreall <- apply(pastvoteoptions, 2, function(x) grepl("All|Some|No", x))
firmPVusepre[rowSums(firmPVusepreall)==0,] <- NA
firmPVuse <- as.data.frame(firmPVusepre[,colSums(firmPVusepre, na.rm=TRUE)>5])
firmPVuse$'No Past Vote' <- rowSums(firmPVuse, na.rm=TRUE)==0
firmPVuse$'No Past Vote'[rowSums(firmPVusepreall, na.rm=TRUE)==0] <- NA

firmPVussupplemented <- firmPVuse
firmPVussupplemented$Weighting[!is.na(basetopred24$mercermethods_wt_votechoice2020)] <- basetopred24$mercermethods_wt_votechoice2020[!is.na(basetopred24$mercermethods_wt_votechoice2020)]==1
firmPVussupplemented$Weighting[!is.na(basetopred24$mercermethods_wt_turnout2020) & !basetopred24$mercermethods_wt_votechoice2020] <- basetopred24$mercermethods_wt_turnout2020[!is.na(basetopred24$mercermethods_wt_turnout2020) & !basetopred24$mercermethods_wt_votechoice2020]==1
firmPVussupplemented$Weighting[is.na(firmPVussupplemented$Weighting) & !is.na(basetopred24$api_turnoutweight)] <- basetopred24$api_turnoutweight[is.na(firmPVussupplemented$Weighting) & !is.na(basetopred24$api_turnoutweight)]==TRUE
firmPVussupplemented$LV.Model[is.na(firmPVussupplemented$LV.Model) & !is.na(basetopred24$api_pastvotelikelihood)] <- basetopred24$api_pastvotelikelihood[is.na(firmPVussupplemented$LV.Model) & !is.na(basetopred24$api_pastvotelikelihood)]==1
firmPVussupplemented$Sampling[is.na(firmPVussupplemented$Sampling) & !is.na(basetopred24$api_turnoutquota)] <- basetopred24$api_turnoutquota[is.na(firmPVussupplemented$Sampling) & !is.na(basetopred24$api_turnoutquota)]==1
firmPVussupplemented$'No Past Vote'[rowSums(firmPVussupplemented[,1:3])==0 & !is.na(rowSums(firmPVussupplemented[,1:3]))] <- TRUE
                     

jpeg("../Report/LinkedResults/Section_5_1/FirmPVuse.jpg", width=12, height=9, units="in", res=1600)
runtoplotseparate(firmPVuse, legendtitle="Firm Survey Past Vote Strategy\n(non-exclusive)")
dev.off()

jpeg("../Report/LinkedResults/Section_5_1/PVuseMerged.jpg", width=12, height=9, units="in", res=1600)
runtoplotseparate(firmPVussupplemented, legendtitle="Use of Past Voting\n(non-exclusive)")
dev.off()


pvcombos <- as.factor(gsub("NoPastVote", "No Past Vote", gsub("&", " & ", gsub("NA &|& NA| |NA", "", apply(firmPVussupplemented, 1, function(x) paste(colnames(firmPVuse)[x==TRUE], collapse=" & "))))))
pvcombos[pvcombos==""] <- NA
pvcombodums <- as.data.frame(dummify(droplevels(pvcombos)))
pvcombodums[rowSums(firmPVusepreall, na.rm=TRUE)==0,] <- NA
colnames(pvcombodums)[!grepl("No|&|Only", colnames(pvcombodums))] <- paste(colnames(pvcombodums)[!grepl("No|&|Only", colnames(pvcombodums))], "Only")
pcd <- as.data.frame(pvcombodums==1)[,c(2:ncol(pvcombodums), 1)]
pcd[is.na(rowSums(firmPVussupplemented)),] <- NA

jpeg("../Report/LinkedResults/Section_5_1/FirmPVuse.jpg", width=12, height=9, units="in", res=1600)
runtoplotseparate(pcd, legendtitle="Use of Past Voting")
dev.off()


errorshiftmethodabs <- sapply(rev(methodvarset24useV2), function(g) with(basetopred24, coef(summary(lm(100*abs(demrepmargin)~g+keypolltypes, weight=bestweight)))[2,]))

errorshiftmodeabs <- sapply(rev(allmercersamp24use), function(g) with(basetopred24, coef(summary(lm(100*abs(demrepmargin)~g+keypolltypes, weight=bestweight)))[2,]))

errorshiftLVabs <- sapply(rev(firmLVs), function(g) try(with(basetopred24, coef(summary(lm(100*abs(demrepmargin)~as.numeric(g)+keypolltypes, weight=bestweight)))[2,])))

errorshiftNumPolls <- sapply(as.data.frame(dummify(basetopred24$pollstervolcut)), function(g) try(with(basetopred24, coef(summary(lm(100*abs(demrepmargin)~as.numeric(g)+keypolltypes, weight=bestweight)))[2,])))

errorshiftStartYear <- sapply(rev(as.data.frame(dummify(basetopred24$pollsteryearcut))), function(g) try(with(basetopred24, coef(summary(lm(100*abs(demrepmargin)~as.numeric(g)+keypolltypes, weight=bestweight)))[2,])))

errorshiftfirmtype <- sapply(rev(firmtypeset), function(g) try(with(basetopred24, coef(summary(lm(100*abs(demrepmargin)~as.numeric(g)+keypolltypes, weight=bestweight)))[2,])))


errorshiftpartweightabs <- sapply(rev(mercerwt24usepart), function(g) with(basetopred24, coef(summary(lm(100*abs(demrepmargin)~g+keypolltypes, weight=bestweight)))[2,]))

errorshiftothweightabs <- sapply(rev(mercerwt24useother), function(g) with(basetopred24, coef(summary(lm(100*abs(demrepmargin)~g+keypolltypes, weight=bestweight)))[2,]))

errorshiftpvuseabs <- sapply(rev(firmPVussupplemented), function(g) with(basetopred24, coef(summary(lm(100*abs(demrepmargin)~g+keypolltypes, weight=bestweight)))[2,]))

colnames(errorshiftmethodabs) <- gsub("- Multiple", "+ Other", gsub("Probability", "Prob", colnames(errorshiftmethodabs)))
colnames(errorshiftpartweightabs) <- gsub("Other Vote History", "Other Vote Hist", gsub("Party\\/Vote Weight", "Pol.", colnames(errorshiftpartweightabs)))
colnames(errorshiftothweightabs) <- gsub("Demographic Weight", "Demog.", colnames(errorshiftothweightabs))
colnames(errorshiftLVabs) <- gsub("On Past Voting", "", gsub("Self Reported", "SR", gsub("Demographic Attributes Of Prior Voters", "Past Voter Demos", colnames(errorshiftLVabs))))


bigbrew <- c(brewer.pal(8, "Set2"), brewer.pal(8, "Set1"))


jpeg("../Report/LinkedResults/Section_5_1/BoxPlotMethodSets.jpg", width=10, height=10, units="in", res=1600)
par(mar=c(5,8,5,2), mfrow=c(3,3))
#
barplot(errorshiftNumPolls[1,], horiz=TRUE, las=1, xlim=c(-5, 7.2), axes=FALSE, xlab="Change in Absolute Error", main="Number of Polls Fielded\nby Firm", col=bigbrew[1])
abline(v=seq(-5,10,1), col="light gray")
abline(v=0, col="blue")
axis(1, seq(-5,8,1), rep("", length(seq(-5,8,1))))
axis(1, seq(-6,8,2))
barplot(errorshiftNumPolls[1,], horiz=TRUE, las=1, xlim=c(-5, 7.2), axes=FALSE, xlab="Change in Absolute Error", main="FiveThirtyEight Method", add=TRUE, col=alpha(bigbrew[1], .6))
arrows(x0=(errorshiftNumPolls[1,]-1.96*errorshiftNumPolls[2,]), y0=1.2*(1:length(errorshiftNumPolls[1,]))-.5, x1=errorshiftNumPolls[1,]+1.96*errorshiftNumPolls[2,], y1=1.2*(1:length(errorshiftNumPolls[1,]))-.5, angle=90, length=.1)
arrows(x0=(errorshiftNumPolls[1,]+1.96*errorshiftNumPolls[2,]), y0=1.2*(1:length(errorshiftNumPolls[1,]))-.5, x1=errorshiftNumPolls[1,]-1.96*errorshiftNumPolls[2,], y1=1.2*(1:length(errorshiftNumPolls[1,]))-.5, angle=90, length=.1)
#
barplot(errorshiftStartYear[1,], horiz=TRUE, las=1, xlim=c(-5, 7.2), axes=FALSE, xlab="Change in Absolute Error", main="First Pres. Cycle\nby Firm", col=bigbrew[2])
abline(v=seq(-5,10,1), col="light gray")
abline(v=0, col="blue")
axis(1, seq(-5,8,1), rep("", length(seq(-5,8,1))))
axis(1, seq(-6,8,2))
barplot(errorshiftStartYear[1,], horiz=TRUE, las=1, xlim=c(-5, 7.2), axes=FALSE, xlab="Change in Absolute Error", main="FiveThirtyEight Method", add=TRUE, col=alpha(bigbrew[2], .6))
arrows(x0=(errorshiftStartYear[1,]-1.96*errorshiftStartYear[2,]), y0=1.2*(1:length(errorshiftStartYear[1,]))-.5, x1=errorshiftStartYear[1,]+1.96*errorshiftStartYear[2,], y1=1.2*(1:length(errorshiftStartYear[1,]))-.5, angle=90, length=.1)
arrows(x0=(errorshiftStartYear[1,]+1.96*errorshiftStartYear[2,]), y0=1.2*(1:length(errorshiftStartYear[1,]))-.5, x1=errorshiftStartYear[1,]-1.96*errorshiftStartYear[2,], y1=1.2*(1:length(errorshiftStartYear[1,]))-.5, angle=90, length=.1)
#
barplot(errorshiftfirmtype[1,], horiz=TRUE, las=1, xlim=c(-5, 7.2), axes=FALSE, xlab="Change in Absolute Error", main="Firm Type\n(hand coded)", col=bigbrew[3])
abline(v=seq(-5,10,1), col="light gray")
abline(v=0, col="blue")
axis(1, seq(-5,8,1), rep("", length(seq(-5,8,1))))
axis(1, seq(-6,8,2))
barplot(errorshiftfirmtype[1,], horiz=TRUE, las=1, xlim=c(-5, 7.2), axes=FALSE, xlab="Change in Absolute Error", main="FiveThirtyEight Method", add=TRUE, col=alpha(bigbrew[3], .6))
arrows(x0=(errorshiftfirmtype[1,]-1.96*errorshiftfirmtype[2,]), y0=1.2*(1:length(errorshiftfirmtype[1,]))-.5, x1=errorshiftfirmtype[1,]+1.96*errorshiftfirmtype[2,], y1=1.2*(1:length(errorshiftfirmtype[1,]))-.5, angle=90, length=.1)
arrows(x0=(errorshiftfirmtype[1,]+1.96*errorshiftfirmtype[2,]), y0=1.2*(1:length(errorshiftfirmtype[1,]))-.5, x1=errorshiftfirmtype[1,]-1.96*errorshiftfirmtype[2,], y1=1.2*(1:length(errorshiftfirmtype[1,]))-.5, angle=90, length=.1)
#
barplot(errorshiftmodeabs[1,], horiz=TRUE, las=1, xlim=c(-5, 7.2), axes=FALSE, xlab="Change in Absolute Error", main="Sampling Frame\n(hand coded)", col=alpha(bigbrew[5], 1))
abline(v=seq(-5,8,1), col="light gray")
abline(v=0, col="blue")
axis(1, seq(-5,8,1), rep("", length(seq(-5,8,1))))
axis(1, seq(-6,8,2))
barplot(errorshiftmodeabs[1,], horiz=TRUE, las=1, xlim=c(-5, 7.2), axes=FALSE, xlab="Change in Absolute Error", main="Coded Sampling Frame", add=TRUE, col=alpha(bigbrew[5], .6))
arrows(x0=(errorshiftmodeabs[1,]-1.96*errorshiftmodeabs[2,]), y0=1.2*(1:length(errorshiftmodeabs[1,]))-.5, x1=errorshiftmodeabs[1,]+1.96*errorshiftmodeabs[2,], y1=1.2*(1:length(errorshiftmodeabs[1,]))-.5, angle=90, length=.1)
arrows(x0=(errorshiftmodeabs[1,]+1.96*errorshiftmodeabs[2,]), y0=1.2*(1:length(errorshiftmodeabs[1,]))-.5, x1=errorshiftmodeabs[1,]-1.96*errorshiftmodeabs[2,], y1=1.2*(1:length(errorshiftmodeabs[1,]))-.5, angle=90, length=.1)
#
barplot(errorshiftmethodabs[1,], horiz=TRUE, las=1, xlim=c(-5, 7.2), axes=FALSE, xlab="Change in Absolute Error", main="Interview Method\n(FiveThirtyEight codes)", col=alpha(bigbrew[4]))
abline(v=seq(-5,8,1), col="light gray")
abline(v=0, col="blue")
axis(1, seq(-5,8,1), rep("", length(seq(-5,8,1))))
axis(1, seq(-6,8,2))
barplot(errorshiftmethodabs[1,], horiz=TRUE, las=1, xlim=c(-5, 7.2), axes=FALSE, xlab="Change in Absolute Error", main="FiveThirtyEight Method", add=TRUE, col=alpha(bigbrew[4], .6))
arrows(x0=(errorshiftmethodabs[1,]-1.96*errorshiftmethodabs[2,]), y0=1.2*(1:length(errorshiftmethodabs[1,]))-.5, x1=errorshiftmethodabs[1,]+1.96*errorshiftmethodabs[2,], y1=1.2*(1:length(errorshiftmethodabs[1,]))-.5, angle=90, length=.1)
arrows(x0=(errorshiftmethodabs[1,]+1.96*errorshiftmethodabs[2,]), y0=1.2*(1:length(errorshiftmethodabs[1,]))-.5, x1=errorshiftmethodabs[1,]-1.96*errorshiftmethodabs[2,], y1=1.2*(1:length(errorshiftmethodabs[1,]))-.5, angle=90, length=.1)
#
barplot(errorshiftLVabs[1,], horiz=TRUE, las=1, xlim=c(-5, 7.2), axes=FALSE, xlab="Change in Absolute Error", main="Likely Voter Mode\n(firm survey)", col=alpha(bigbrew[6], 1))
abline(v=seq(-5,8,1), col="light gray")
abline(v=0, col="blue")
axis(1, seq(-5,8,1), rep("", length(seq(-5,8,1))))
axis(1, seq(-6,8,2))
barplot(errorshiftLVabs[1,], horiz=TRUE, las=1, xlim=c(-5, 7.2), axes=FALSE, xlab="Change in Absolute Error", main="Coded Sampling Frame", add=TRUE, col=alpha(bigbrew[6], .6))
arrows(x0=(errorshiftLVabs[1,]-1.96*errorshiftLVabs[2,]), y0=1.2*(1:length(errorshiftLVabs[1,]))-.5, x1=errorshiftLVabs[1,]+1.96*errorshiftLVabs[2,], y1=1.2*(1:length(errorshiftLVabs[1,]))-.5, angle=90, length=.1)
arrows(x0=(errorshiftLVabs[1,]+1.96*errorshiftLVabs[2,]), y0=1.2*(1:length(errorshiftLVabs[1,]))-.5, x1=errorshiftLVabs[1,]-1.96*errorshiftLVabs[2,], y1=1.2*(1:length(errorshiftLVabs[1,]))-.5, angle=90, length=.1)
#
barplot(errorshiftpartweightabs[1,], horiz=TRUE, las=1, xlim=c(-5, 7.2), axes=FALSE, xlab="Change in Absolute Error", main="Political Weighting Variable Used\n(hand coded)", col=alpha(bigbrew[7], 1))
abline(v=seq(-5,8,1), col="light gray")
abline(v=0, col="blue")
axis(1, seq(-5,8,1), rep("", length(seq(-5,8,1))))
axis(1, seq(-6,8,2))
barplot(errorshiftpartweightabs[1,], horiz=TRUE, las=1, xlim=c(-5, 5), axes=FALSE, xlab="Change in Absolute Error", main="Political Weighting Variable Used (Coded)", add=TRUE, col=alpha(bigbrew[7], .6))
arrows(x0=(errorshiftpartweightabs[1,]-1.96*errorshiftpartweightabs[2,]), y0=1.2*(1:length(errorshiftpartweightabs[1,]))-.5, x1=errorshiftpartweightabs[1,]+1.96*errorshiftpartweightabs[2,], y1=1.2*(1:length(errorshiftpartweightabs[1,]))-.5, angle=90, length=.1)
arrows(x0=(errorshiftpartweightabs[1,]+1.96*errorshiftpartweightabs[2,]), y0=1.2*(1:length(errorshiftpartweightabs[1,]))-.5, x1=errorshiftpartweightabs[1,]-1.96*errorshiftpartweightabs[2,], y1=1.2*(1:length(errorshiftpartweightabs[1,]))-.5, angle=90, length=.1)
#
barplot(errorshiftothweightabs[1,], horiz=TRUE, las=1, xlim=c(-5, 7.2), axes=FALSE, xlab="Change in Absolute Error", main="Demographic Weighting Variable Used\n(hand coded)", col=alpha(bigbrew[8], 1))
abline(v=seq(-5,8,1), col="light gray")
abline(v=0, col="blue")
axis(1, seq(-5,8,1), rep("", length(seq(-5,8,1))))
axis(1, seq(-6,8,2))
barplot(errorshiftothweightabs[1,], horiz=TRUE, las=1, xlim=c(-5, 5), axes=FALSE, xlab="Change in Absolute Error", main="Demographic Weighting Variable Used (Coded)", add=TRUE, col=alpha(bigbrew[8], .6))
arrows(x0=(errorshiftothweightabs[1,]-1.96*errorshiftothweightabs[2,]), y0=1.2*(1:length(errorshiftothweightabs[1,]))-.5, x1=errorshiftothweightabs[1,]+1.96*errorshiftothweightabs[2,], y1=1.2*(1:length(errorshiftothweightabs[1,]))-.5, angle=90, length=.1)
arrows(x0=(errorshiftothweightabs[1,]+1.96*errorshiftothweightabs[2,]), y0=1.2*(1:length(errorshiftothweightabs[1,]))-.5, x1=errorshiftothweightabs[1,]-1.96*errorshiftothweightabs[2,], y1=1.2*(1:length(errorshiftothweightabs[1,]))-.5, angle=90, length=.1)
#
barplot(errorshiftpvuseabs[1,], horiz=TRUE, las=1, xlim=c(-5, 7.2), axes=FALSE, xlab="Change in Absolute Error", main="How Past Vote Used\n(Multiple strategies))", col=alpha(bigbrew[9], 1))
abline(v=seq(-5,8,1), col="light gray")
abline(v=0, col="blue")
axis(1, seq(-5,8,1), rep("", length(seq(-5,8,1))))
axis(1, seq(-6,8,2))
barplot(errorshiftpvuseabs[1,], horiz=TRUE, las=1, xlim=c(-5, 5), axes=FALSE, xlab="Change in Absolute Error", main="Demographic Weighting Variable Used (Coded)", add=TRUE, col=alpha(bigbrew[9], .6))
arrows(x0=(errorshiftpvuseabs[1,]-1.96*errorshiftpvuseabs[2,]), y0=1.2*(1:length(errorshiftpvuseabs[1,]))-.5, x1=errorshiftpvuseabs[1,]+1.96*errorshiftpvuseabs[2,], y1=1.2*(1:length(errorshiftpvuseabs[1,]))-.5, angle=90, length=.1)
arrows(x0=(errorshiftpvuseabs[1,]+1.96*errorshiftpvuseabs[2,]), y0=1.2*(1:length(errorshiftpvuseabs[1,]))-.5, x1=errorshiftpvuseabs[1,]-1.96*errorshiftpvuseabs[2,], y1=1.2*(1:length(errorshiftpvuseabs[1,]))-.5, angle=90, length=.1)
dev.off()



## How did firms use stratification and quotas

firmQSvarspre <- basetopred24[,grepl("firmsurvey_quotastrata", colnames(basetopred24)) & !grepl("specify", colnames(basetopred24))]

firmQSspre <- as.data.frame(apply(firmQSvarspre, 2, function(x) grepl("All|Some", x)))
firmQSspre[is.na(firmQSvarspre)] <- NA
firmQSs <- firmQSspre[,colSums(firmQSspre, na.rm=TRUE)>5]

names(firmQSs) <- gsub("Voter File Or Marketing Data On Likely Vote Choice", "Voter File Data", str_to_title(gsub("_", " ", gsub("firmsurvey_quotastratavars_", "", names(firmQSs)))))

DemogQSfactors <- firmQSs[,!grepl("Vote|Part", colnames(firmQSs))]
PartisanQSfactors <- firmQSs[,grepl("Vote|Part", colnames(firmQSs))]
PartisanQSfactors[,"Any Partisan Factor"] <- rowSums(firmQSs[,grepl("Vote|Part", colnames(firmQSs))])>=1
PartisanQSfactors[,"No Partisan Factors"] <- rowSums(firmQSs[,grepl("Vote|Part", colnames(firmQSs))])==0

jpeg("../Report/LinkedResults/Section_5_1/DemogQSStrategyUsed.jpg", width=12, height=9, units="in", res=1600)
runtoplotseparate(DemogQSfactors, legendtitle="Demographic Sampling Used (non-exclusive)")
dev.off()

jpeg("../Report/LinkedResults/Section_5_1/PartisanQSStrategyUsed.jpg", width=12, height=9, units="in", res=1600)
runtoplotseparate(PartisanQSfactors, legendtitle="Electoral Sampling Used (non-exclusive)")
dev.off()












## HOW DOES ERROR RELATE TO MIGRATION PATTERNS? OVERWEIGHTING TO LAST ELECTION?
fipscodes <- read.csv("../External Files/US_FIPS_Codes.csv", skip=1)
statefips <- with(fipscodes[!duplicated(fipscodes$State),], data.frame(State, FIPS.State))
cps2020 <- read.csv("../External Files/nov20pub.csv")
cps2020$state <- factor(cps2020$gestfips, levels=statefips$FIPS.State, labels=statefips$State)
cps2024 <- read.csv("../External Files/nov24pub.csv")
cps2024$state <- factor(cps2024$gestfips, levels=statefips$FIPS.State, labels=statefips$State)

# link to codebook: https://www2.census.gov/programs-surveys/cps/datasets/2024/basic/2024_Basic_CPS_Public_Use_Record_Layout_plus_IO_Code_list.txt

popin2020 <- with(cps2020[((cps2020$prcitshp) %in% 1:4) & cps2020$prtage>17,], xtabs(pwsswgt~state, na.rm=TRUE))
popin2024 <- with(cps2024[((cps2024$prcitshp) %in% 1:4) & cps2024$prtage>17,], xtabs(pwsswgt~state, na.rm=TRUE))
totpopin2024 <- with(cps2024, xtabs(pwsswgt~state, na.rm=TRUE))
totpopin2020 <- with(cps2020, xtabs(pwsswgt~state, na.rm=TRUE))

whiteloweduccitizen2024 <- with(cps2024[((cps2024$prcitshp) %in% 1:4) & cps2024$prtage>17 & (cps2024$pehspnon!=1 & cps2024$ptdtrace==1) & cps2024$peeduca<40,], xtabs(pwsswgt~state)) # No college degree white proportion

blackcitizen2024 <- with(cps2024[((cps2024$prcitshp) %in% 1:4) & cps2024$prtage>17 & (cps2024$pehspnon!=1 & (cps2024$ptdtrace %in% c(2,6,10,11,12))),], xtabs(pwsswgt~state)) # Black Citizens 18+

nonwhitecitizen2024 <- with(cps2024[((cps2024$prcitshp) %in% 1:4) & cps2024$prtage>17 & (cps2024$pehspnon==1 | cps2024$ptdtrace!=1),], xtabs(pwsswgt~state)) # Nonwhite Citizens 18+
hispcitizen2024 <- with(cps2024[((cps2024$prcitshp) %in% 1:4) & cps2024$prtage>17 & cps2024$pehspnon==1,], xtabs(pwsswgt~state)) # Hispanic Citizens 18+
hisppopin2024 <- with(cps2024[cps2024$pehspnon==1,], xtabs(pwsswgt~state)) # Hispanic Population
immigration2024 <- with(cps2024[((cps2024$prcitshp)==5),], xtabs(pwsswgt~state)) # Non-Citizens
immigration2020 <- with(cps2020[((cps2020$prcitshp)==5),], xtabs(pwsswgt~state)) # Non-Citizens

youngpopin2024 <- with(cps2024[((cps2024$prcitshp) %in% 1:4) & cps2024$prtage>17 & cps2024$prtage<25,], xtabs(pwsswgt~state)) # 18-24 Citizens

# Structural explanations for error -- changing populations and hard to survey groups
relpopchange <- as.numeric((popin2024-popin2020)/popin2020)
relwhiteloweduc24 <- as.numeric(whiteloweduccitizen2024/popin2024)
relnonwhite24 <- as.numeric(nonwhitecitizen2024/popin2024)
relhisppop24 <- as.numeric(hisppopin2024/totpopin2024)
relhispcitizens24 <- as.numeric(hispcitizen2024/popin2024)
relblackcitizens24 <- as.numeric(blackcitizen2024/popin2024)
relnonwhitenonhisp <- relnonwhite24-relhispcitizens24
relimmigrants24 <- as.numeric(immigration2024/totpopin2024)
relimmigrantschange <- as.numeric((immigration2024-immigration2020)/totpopin2020)
relyoungpop24 <- as.numeric(youngpopin2024/popin2024)
names(relpopchange) <- names(relhisppop24) <- names(relyoungpop24) <- names(popin2024)
structuralfeatures <- data.frame(state=tolower(names(popin2024)), relpopchange, relwhiteloweduc24, relnonwhite24, relhisppop24, relhispcitizens24,relnonwhitenonhisp, relblackcitizens24, relimmigrants24, relimmigrantschange, relyoungpop24)

rm(cps2020)
rm(cps2024)

sessets$state <- rownames(sessets)
stateerrpredspre <- merge(sessets, structuralfeatures, by="state", all.x=TRUE)
stateerrpreds <- stateerrpredspre[order(stateerrpredspre$margmnerr),]
stateerrpreds$st <- state.abb[match(stateerrpreds$state,tolower(state.name))]

pres24statematched <- merge(basetopred24[basetopred24$office=="president" & basetopred24$last2weeks & basetopred24$stateornat=="State",], structuralfeatures, by="state")


summary(with(pres24statematched, lm(demrepmargin~relpopchange+relwhiteloweduc24+relnonwhite24+relimmigrants24, weights=bestweight)))#relhisppop24+relimmigrantschange+relhispcitizens24+relyoungpop24


votercomposition <- with(pres24statematched, lm(eval(demrepmargin*100)~eval(relpopchange*100)+eval(relyoungpop24*100)+eval(relwhiteloweduc24*100)+eval(relhispcitizens24*100)+eval(relnonwhitenonhisp*100), weights=bestweight))
populationchanges <- with(pres24statematched, lm(eval(demrepmargin*100)~relpopchange+relyoungpop24+relhisppop24+relimmigrantschange, weights=bestweight))

populationchanges <- with(pres24statematched, lm(eval(demrepmargin*100)~eval(relpopchange*100)+eval(relyoungpop24*100)+eval(relwhiteloweduc24*100)+eval(relhispcitizens24*100)+eval(relnonwhitenonhisp*100)+eval(relimmigrantschange*100), weights=bestweight))



reginfototop <- function(x, placement="top"){
    x <- coeftest(x, vcov = vcovCL, cluster = ~state) # cluster by state
    legend(placement, legend=paste0("Intercept = ", rd(coef(x)[1]), starmaker(x[1,4]), " | Slope = ", rd(coef(x)[2]), starmaker(x[2,4])))
}

reginfototopSQ <- function(x, placement="top"){
    x <- coeftest(x, vcov = vcovCL, cluster = ~state) # cluster by state
    legend(placement, legend=paste0("Intercept = ", rd(coef(x)[1]), starmaker(x[1,4]), " | Linear = ", rd(coef(x)[2]), starmaker(x[2,4]), " | Quadratic = ", rd(coef(x)[3]), starmaker(x[3,4])))
}

regcitpop <- with(pres24statematched, lm(eval(demrepmargin*100)~eval(relpopchange*100), weights=bestweight))

regcitpopchoice <- with(pres24statematched, lm(eval(demrepmargin*100)~(eval(relpopchange*100)+eval(relpopchange^2*100))*swingstates, weights=bestweight))


rcpnd <- data.frame(relpopchange=seq(-2.5,7,.01)/100)

predcit <- predict(regcitpop, rcpnd)

jpeg("../Report/LinkedResults/Section_5_1/StateErrorsByStateCitizenPop.jpg", width=8, height=8, units="in", res=1600)
with(stateerrpreds, plot(100*relpopchange, 110*margmnerr, ylab="Signed Error", xlab="Change in Adult Citizen Population in Percentage Points, 2020-2024", type="n", main="Comparing Survey Error to\nChanges in the State Adult Citizen Population"))
abline(h=seq(-20,20,2), col="light gray", lty=3)
abline(v=seq(-20,20,2), col="light gray", lty=3)
abline(h=0, col="gray")
abline(v=0, col="gray")
#lines(rcpnd$relpopchange*100, predcit, col="red", lty=2)
with(stateerrpreds, text(100*relpopchange, 100*margmnerr, st, cex=sqrt(sqrt(n))/2))
reginfototop(regcitpop)
abline(reg=regcitpop, col="red", lty=2)
dev.off()

regcitpopabs <- with(pres24statematched, lm(eval(abs(demrepmargin)*100)~eval(relpopchange*100), weights=bestweight))

jpeg("../Report/LinkedResults/Section_5_1/StateABSErrorsByStateCitizenPop.jpg", width=8, height=8, units="in", res=1600)
with(stateerrpreds, plot(100*relpopchange, 110*margmnerrabs, ylab="Absolute Error", xlab="Change in Adult Citizen Population in Percentage Points, 2020-2024", type="n", main="Comparing Survey Error to\nChanges in the State Adult Citizen Population"))
abline(h=seq(-20,20,2), col="light gray", lty=3)
abline(v=seq(-20,20,2), col="light gray", lty=3)
abline(h=0, col="gray")
abline(v=0, col="gray")
#lines(rcpnd$relpopchange*100, predcit, col="red", lty=2)
with(stateerrpreds, text(100*relpopchange, 100*margmnerrabs, st, cex=sqrt(sqrt(n))/2))
reginfototop(regcitpopabs)
abline(reg=regcitpopabs, col="red", lty=2)
dev.off()

jpeg("../Report/LinkedResults/Section_5_1/StateErrorsByStateCitizenPopSideBySide.jpg", width=14, height=7, units="in", res=1600)
par(mfrow=c(1,2))
with(stateerrpreds, plot(100*relpopchange, 110*margmnerr, ylab="Signed Error", xlab="Change in Adult Citizen Population in Percentage Points, 2020-2024", type="n", main="State Signed Errors by\nChange in Adult Citizen Population", las=1))
abline(h=seq(-20,20,2), col="light gray", lty=3)
abline(v=seq(-20,20,2), col="light gray", lty=3)
abline(h=0, col="gray")
abline(v=0, col="gray")
#lines(rcpnd$relpopchange*100, predcit, col="red", lty=2)
with(stateerrpreds, text(100*relpopchange, 100*margmnerr, st, cex=sqrt(sqrt(n))/2))
reginfototop(regcitpop)
abline(reg=regcitpop, col="red", lty=2)
#
with(stateerrpreds, plot(100*relpopchange, 110*margmnerrabs, ylab="Absolute Error", xlab="Change in Adult Citizen Population in Percentage Points, 2020-2024", type="n", main="State Absolute Errors by\nChange in Adult Citizen Population", las=1))
abline(h=seq(-20,20,2), col="light gray", lty=3)
abline(v=seq(-20,20,2), col="light gray", lty=3)
abline(h=0, col="gray")
abline(v=0, col="gray")
#lines(rcpnd$relpopchange*100, predcit, col="red", lty=2)
with(stateerrpreds, text(100*relpopchange, 100*margmnerrabs, st, cex=sqrt(sqrt(n))/2))
reginfototop(regcitpopabs)
abline(reg=regcitpopabs, col="red", lty=2)
dev.off()

regyoungportpop <- with(pres24statematched, lm(eval(demrepmargin*100)~eval(relyoungpop24*100), weights=bestweight))
regyoungportpopabs <- with(pres24statematched, lm(eval(abs(demrepmargin)*100)~eval(relyoungpop24*100), weights=bestweight))

coeftest(regyoungportpop, vcov = vcovCL, cluster = ~state)

jpeg("../Report/LinkedResults/Section_5_1/StateErrorsByStateAgePortSideBySide.jpg", width=14, height=7, units="in", res=1600)
par(mfrow=c(1,2))
#jpeg("../Report/LinkedResults/Section_5_1/StateErrorsByStateAgePort.jpg", width=8, height=8, units="in", res=1600)
with(stateerrpreds, plot(100*relyoungpop24, 110*margmnerr, ylab="Signed Error", xlab="18-24 Year Olds as Proportion of State Adult Citizen Population", type="n", main="State Signed Errors by\nProportion of State Adult Citizen Population Aged 18-24", las=1))
abline(h=seq(-20,20,2), col="light gray", lty=3)
abline(v=seq(-20,20,2), col="light gray", lty=3)
abline(h=0, col="gray")
abline(v=0, col="gray")
with(stateerrpreds, text(100*relyoungpop24, 100*margmnerr, st, cex=sqrt(sqrt(n))/2))
reginfototop(regyoungportpop)
abline(reg=regyoungportpop, col="red", lty=2)
#dev.off()
#jpeg("../Report/LinkedResults/Section_5_1/StateABSErrorsByStateAgePort.jpg", width=8, height=8, units="in", res=1600)
with(stateerrpreds, plot(100*relyoungpop24, 110*margmnerrabs, ylab="Absolute Error", xlab="18-24 Year Olds as Proportion of State Adult Citizen Population", type="n", main="State Absolute Errors by\nProportion of State Adult Citizen Population Aged 18-24", las=1))
abline(h=seq(-20,20,2), col="light gray", lty=3)
abline(v=seq(-20,20,2), col="light gray", lty=3)
abline(h=0, col="gray")
abline(v=0, col="gray")
with(stateerrpreds, text(100*relyoungpop24, 100*margmnerrabs, st, cex=sqrt(sqrt(n))/2))
reginfototop(regyoungportpopabs)
abline(reg=regyoungportpopabs, col="red", lty=2)
dev.off()


regloweducwhitecitizenportpop <- with(pres24statematched, lm(eval(demrepmargin*100)~eval(relwhiteloweduc24*100), weights=bestweight))
regloweducwhitecitizenportpopabs <- with(pres24statematched, lm(eval(abs(demrepmargin)*100)~eval(relwhiteloweduc24*100), weights=bestweight))

jpeg("../Report/LinkedResults/Section_5_1/StateErrorsByStateWhiteLowEducPortofEligibleSideBySide.jpg", width=14, height=7, units="in", res=1600)
par(mfrow=c(1,2))
#jpeg("../Report/LinkedResults/Section_5_1/StateErrorsByStateWhiteLowEducPortofEligible.jpg", width=8, height=8, units="in", res=1600)
with(stateerrpreds, plot(100*relwhiteloweduc24, 110*margmnerr, ylab="Signed Error", xlab="White HS or Less Proportion of State Adult Citizen Population", type="n", main="State Signed Errors by Proportion of State Citizens\nWhite, Non-Hispanic and High School or Less", las=1))
abline(h=seq(-20,20,2), col="light gray", lty=3)
abline(v=seq(-20,100,5), col="light gray", lty=3)
abline(h=0, col="gray")
abline(v=0, col="gray")
with(stateerrpreds, text(100*relwhiteloweduc24, 100*margmnerr, st, cex=sqrt(sqrt(n))/2))
reginfototop(regloweducwhitecitizenportpop)
abline(reg=regloweducwhitecitizenportpop, col="red", lty=2)
#dev.off()
#jpeg("../Report/LinkedResults/Section_5_1/StateABSErrorsByStateWhiteLowEducPortofEligible.jpg", width=8, height=8, units="in", res=1600)
with(stateerrpreds, plot(100*relwhiteloweduc24, 110*margmnerrabs, ylab="Absolute Error", xlab="White HS or Less Proportion of State Adult Citizen Population", type="n", main="State Absolute Errors Proportion of State Citizens\nWhite, Non-Hispanic and High School or Less", las=1))
abline(h=seq(-20,20,2), col="light gray", lty=3)
abline(v=seq(-20,100,5), col="light gray", lty=3)
abline(h=0, col="gray")
abline(v=0, col="gray")
with(stateerrpreds, text(100*relwhiteloweduc24, 100*margmnerrabs, st, cex=sqrt(sqrt(n))/2))
reginfototop(regloweducwhitecitizenportpopabs)
abline(reg=regloweducwhitecitizenportpopabs, col="red", lty=2)
dev.off()



regblackcitizenportpop <- with(pres24statematched, lm(eval(demrepmargin*100)~eval(relblackcitizens24*100), weights=bestweight))
regblackcitizenportpopabs <- with(pres24statematched, lm(eval(demrepmargin*100)~eval(relblackcitizens24*100), weights=bestweight))

jpeg("../Report/LinkedResults/Section_5_1/StateErrorsByStateBlackPortofEligibleSideBySide.jpg", width=14, height=7, units="in", res=1600)
par(mfrow=c(1,2))
with(stateerrpreds, plot(100*relblackcitizens24, 110*margmnerr, ylab="Signed Error", xlab="Black Proportion of State Adult Citizen Population", type="n", main="State Signed Error by Proportion of\nAdult Citizen Population Identifying As Black, Non-Hispanic", las=1))
abline(h=seq(-20,20,2), col="light gray", lty=3)
abline(v=seq(-20,100,5), col="light gray", lty=3)
abline(h=0, col="gray")
abline(v=0, col="gray")
with(stateerrpreds, text(100*relblackcitizens24, 100*margmnerr, st, cex=sqrt(sqrt(n))/2))
reginfototop(regblackcitizenportpop)
abline(reg=regblackcitizenportpop, col="red", lty=2)
#
with(stateerrpreds, plot(100*relblackcitizens24, 110*margmnerrabs, ylab="Absolute Error", xlab="Black Proportion of State Adult Citizen Population", type="n", main="State Absolute Error By Proportion of\nAdult Citizen Population Identifying As Black, Non-Hispanic", las=1))
abline(h=seq(-20,20,2), col="light gray", lty=3)
abline(v=seq(-20,100,5), col="light gray", lty=3)
abline(h=0, col="gray")
abline(v=0, col="gray")
with(stateerrpreds, text(100*relblackcitizens24, 100*margmnerrabs, st, cex=sqrt(sqrt(n))/2))
reginfototop(regblackcitizenportpopabs)
abline(reg=regblackcitizenportpopabs, col="red", lty=2)
dev.off()


reghispcitizenportpop <- with(pres24statematched, lm(eval(demrepmargin*100)~eval(relhispcitizens24*100), weights=bestweight))
reghispcitizenportpopabs <- with(pres24statematched, lm(eval(abs(demrepmargin)*100)~eval(relhispcitizens24*100), weights=bestweight))

jpeg("../Report/LinkedResults/Section_5_1/StateErrorsByStateHispanicPortofEligibleSideBySide.jpg", width=14, height=7, units="in", res=1600)
par(mfrow=c(1,2))
with(stateerrpreds, plot(100*relhispcitizens24, 110*margmnerr, ylab="Signed Error", xlab="Hispanic Proportion of State Adult Citizen Population", type="n", main="State Signed Error by Proportion of\nAdult Citizen Population Identifying As Hispanic", las=1))
abline(h=seq(-20,20,2), col="light gray", lty=3)
abline(v=seq(-20,100,5), col="light gray", lty=3)
abline(h=0, col="gray")
abline(v=0, col="gray")
with(stateerrpreds, text(100*relhispcitizens24, 100*margmnerr, st, cex=sqrt(sqrt(n))/2))
reginfototop(reghispcitizenportpop)
abline(reg=reghispcitizenportpop, col="red", lty=2)
#
with(stateerrpreds, plot(100*relhispcitizens24, 110*margmnerrabs, ylab="Absolute Error", xlab="Hispanic Proportion of State Adult Citizen Population", type="n", main="State Absolute Error By Proportion of\nAdult Citizen Population Identifying As Hispanic", las=1))
abline(h=seq(-20,20,2), col="light gray", lty=3)
abline(v=seq(-20,100,5), col="light gray", lty=3)
abline(h=0, col="gray")
abline(v=0, col="gray")
with(stateerrpreds, text(100*relhispcitizens24, 100*margmnerrabs, st, cex=sqrt(sqrt(n))/2))
reginfototop(reghispcitizenportpopabs)
abline(reg=reghispcitizenportpopabs, col="red", lty=2)
dev.off()

reghispcitizenportpopSP <- with(pres24statematched, lm(eval(demrepmargin*100)~eval(relhispcitizens24*100)*api_spanishoffered, weights=bestweight))
reghispcitizenportpopabsSP <- with(pres24statematched, lm(eval(abs(demrepmargin)*100)~eval(relhispcitizens24*100)*api_spanishoffered, weights=bestweight))

reghispcitizenportpopabsSPon <- with(pres24statematched, lm(eval(abs(demrepmargin)*100)~api_spanishoffered, weights=bestweight))

reghispcitizenportpopabsSP <- with(pres24statematched[pres24statematched$api_spanishoffered,], lm(eval(abs(demrepmargin)*100)~eval(relhispcitizens24*100), weights=bestweight))
reghispcitizenportpopabsNSP <- with(pres24statematched[!pres24statematched$api_spanishoffered,], lm(eval(abs(demrepmargin)*100)~eval(relhispcitizens24*100), weights=bestweight))


## IMMIGRANTS

changeimmigrantportpop <- with(pres24statematched, lm(eval(demrepmargin*100)~eval(relimmigrantschange*100), weights=bestweight))
changeimmigrantportpopabs <- with(pres24statematched, lm(eval(abs(demrepmargin)*100)~eval(relimmigrantschange*100), weights=bestweight))

jpeg("../Report/LinkedResults/Section_5_1/StateErrorsByImmigrantPort.jpg", width=14, height=7, units="in", res=1600)
par(mfrow=c(1,2))
with(stateerrpreds, plot(100*relimmigrantschange, 110*margmnerr, ylab="Signed Error", xlab="Change in Non-Citizen Proportion of Total State Population (2020-2024)", type="n", main="Comparing Survey Error to\nChange in Non-Citizen Proportion of Total State Population"))
abline(h=seq(-20,20,2), col="light gray", lty=3)
abline(v=seq(-20,100,1), col="light gray", lty=3)
abline(h=0, col="gray")
abline(v=0, col="gray")
with(stateerrpreds, text(100*relimmigrantschange, 100*margmnerr, st, cex=sqrt(sqrt(n))/2))
reginfototop(changeimmigrantportpop)
abline(reg=changeimmigrantportpop, col="red", lty=2)
#
with(stateerrpreds, plot(100*relimmigrantschange, 110*margmnerrabs, ylab="Absolute Error", xlab="Change in Non-Citizen Proportion of Total State Population (2020-2024)", type="n", main="Comparing Survey Error to\nChange in Non-Citizen Proportion of Total State Population"))
abline(h=seq(-20,20,2), col="light gray", lty=3)
abline(v=seq(-20,100,1), col="light gray", lty=3)
abline(h=0, col="gray")
abline(v=0, col="gray")
with(stateerrpreds, text(100*relimmigrantschange, 100*margmnerrabs, st, cex=sqrt(sqrt(n))/2))
reginfototop(changeimmigrantportpopabs)
abline(reg=changeimmigrantportpopabs, col="red", lty=2)
dev.off()


allportpopabs <- with(pres24statematched, lm(eval(abs(demrepmargin)*100)~eval(relpopchange*100)+eval(relyoungpop24*100)+eval(relwhiteloweduc24*100)+eval(relblackcitizens24*100)+eval(relhispcitizens24*100)+eval(relimmigrantschange*100), weights=bestweight))

allportpop <- with(pres24statematched, lm(eval(demrepmargin*100)~eval(relpopchange*100)+eval(relyoungpop24*100)+eval(relwhiteloweduc24*100)+eval(relblackcitizens24*100)+eval(relhispcitizens24*100)+eval(relimmigrantschange*100), weights=bestweight))

coeftest(allportpopabs, vcov = vcovCL, cluster = ~state) # cluster by state
coeftest(allportpop, vcov = vcovCL, cluster = ~state) # cluster by state






## including spanish language -- not enough data here

populationchanges2 <- with(pres24statematched, lm(eval(demrepmargin*100)~eval(relpopchange*100)+eval(relyoungpop24*100)+eval(relwhiteloweduc24*100)+eval(relhispcitizens24*100)+eval(relnonwhitenonhisp*100)+eval(relimmigrantschange*100), weights=bestweight))

hispandspanishchanges <- with(pres24statematched, lm(eval(demrepmargin*100)~eval(relhispcitizens24*100)*api_spanishoffered, weights=bestweight))

with(pres24statematched, plot(eval(relhispcitizens24*100), eval(demrepmargin*100), pch=20, col="gray", cex=sqrt(bestweight)))
with(pres24statematched[pres24statematched$api_spanishoffered,], lines(eval(relhispcitizens24*100), eval(demrepmargin*100), type="p", pch=20, col="red", cex=sqrt(bestweight)))
with(pres24statematched, lines(eval(relhispcitizens24[!api_spanishoffered]*100), eval(demrepmargin[!api_spanishoffered]*100), type="p", pch=20, col="blue"))



spanpred <- with(basetopred24[basetopred24$office=="president" & basetopred24$last2weeks & basetopred24$stateornat=="State",], lm(demrepmargin~api_spanishoffered+state))





## VARIANCE AND HERDING


## FIRST, WHAT IS THE VARIANCE?

## Within contest variance of last 2 weeks

contests16 <- unique(dfuse$contest[dfuse$cycle==2016 & dfuse$stage=="general" & dfuse$last2weeks])
contests20 <- unique(dfuse$contest[dfuse$cycle==2020 & dfuse$stage=="general" & dfuse$last2weeks])
contests24 <- unique(dfuse$contest[dfuse$cycle==2024 & dfuse$stage=="general" & dfuse$last2weeks])

sharedcontests2024 <- contests24[gsub("2024", "2020", contests24) %in% contests20]
sharedcontests202416 <- contests24[gsub("2024", "2016", contests24) %in% contests16]

eachcontest24pre <- mclapply(sharedcontests2024, function(x) dfuse[dfuse$contest==x & dfuse$stage=="general" & dfuse$last2weeks,])
eachcontest20pre <- mclapply(gsub("2024", "2020", sharedcontests2024), function(x) dfuse[dfuse$contest==x & dfuse$stage=="general" & dfuse$last2weeks,])
names(eachcontest24pre) <- names(eachcontest20pre) <- gsub("2024-|-general", "", sharedcontests2024)

eachcontest24prefor16 <- mclapply(sharedcontests202416, function(x) dfuse[dfuse$contest==x & dfuse$stage=="general" & dfuse$last2weeks,])

eachcontest16pre <- mclapply(gsub("2024", "2016", sharedcontests202416), function(x) dfuse[dfuse$contest==x & dfuse$stage=="general" & dfuse$last2weeks,])



eachcontest24pre2 <- eachcontest24pre[sapply(eachcontest24pre, function(x) sum(x$bestweight))>5 & sapply(eachcontest20pre, function(x) sum(x$bestweight))>5]
eachcontest20pre2 <- eachcontest20pre[sapply(eachcontest24pre, function(x) sum(x$bestweight))>5 & sapply(eachcontest20pre, function(x) sum(x$bestweight))>5]

eachcontest24pre2for16 <- eachcontest24prefor16[sapply(eachcontest24prefor16, function(x) sum(x$bestweight))>5 & sapply(eachcontest16pre, function(x) sum(x$bestweight))>5]
eachcontest16pre2 <- eachcontest16pre[sapply(eachcontest24prefor16, function(x) sum(x$bestweight))>5 & sapply(eachcontest16pre, function(x) sum(x$bestweight))>5]

eachcontest24 <- eachcontest24pre2[order(sapply(eachcontest24pre2, nrow))]
eachcontest20 <- eachcontest20pre2[order(sapply(eachcontest24pre2, nrow))]# same order


eachcontest24for16 <- eachcontest24pre2for16[order(sapply(eachcontest24pre2for16, nrow))]
eachcontest16 <- eachcontest16pre2[order(sapply(eachcontest24pre2for16, nrow))]# same order

#bundle2024 <- lapply(names(eachcontest24), function(x) rbind(eachcontest24[[x]], eachcontest20[[x]]))

contestvars <- data.frame(Ns20=sapply(eachcontest20, function(x) sum(x$bestweight)), Ns24=sapply(eachcontest24, function(x) sum(x$bestweight)), meanerr20=sapply(eachcontest20, function(x) wtd.mean(x$demrepmargin, x$bestweight)), meanerr24=sapply(eachcontest24, function(x) wtd.mean(x$demrepmargin, x$bestweight)), var20=sapply(eachcontest20, function(x) sqrt(wtd.var(x$demrepmargin, weights=x$bestweight))), var24=sapply(eachcontest24, function(x) sqrt(wtd.var(x$demrepmargin, weights=x$bestweight))))

contestvars1624 <- data.frame(Ns16=sapply(eachcontest16, function(x) sum(x$bestweight)), Ns24=sapply(eachcontest24for16, function(x) sum(x$bestweight)), meanerr16=sapply(eachcontest16, function(x) wtd.mean(x$demrepmargin, x$bestweight)), meanerr24=sapply(eachcontest24for16, function(x) wtd.mean(x$demrepmargin, x$bestweight)), var16=sapply(eachcontest16, function(x) sqrt(wtd.var(x$demrepmargin, weights=x$bestweight))), var24=sapply(eachcontest24for16, function(x) sqrt(wtd.var(x$demrepmargin, weights=x$bestweight))))



contestvarwtdmeans20 <- wtd.mean(contestvars$var20, weights=(contestvars$Ns20))
contestvarwtdmeans24 <- wtd.mean(contestvars$var24, weights=(contestvars$Ns24))



contestvarwtdmeans16 <- wtd.mean(contestvars1624$var16, weights=(contestvars1624$Ns16))
contestvarwtdmeans24for16 <- wtd.mean(contestvars1624$var24, weights=(contestvars1624$Ns24))


contestvars$Fval <- with(contestvars, (var24^2)/(var20^2))

Fcomparesupper <- pf(contestvars$Fval, contestvars$Ns24, contestvars$Ns20, lower.tail = FALSE)
Fcompareslower <- pf(contestvars$Fval, contestvars$Ns24, contestvars$Ns20, lower.tail = TRUE)
Fvalp <- 2*Fcomparesupper
Fvalp[Fcompareslower<Fcomparesupper] <- 2*Fcompareslower[Fcompareslower<Fcomparesupper]

contestvars$fvalp <- Fvalp
contestvars$starry <- starmaker(Fvalp)

eacherr24 <- mclapply(eachcontest24, function(x) abs(x$demrepmargin-mean(x$demrepmargin))) # Absolute difference from mean value for contest in 2024 among last 2 weeks
eacherr20 <- mclapply(eachcontest20, function(x) abs(x$demrepmargin-mean(x$demrepmargin))) # Absolute difference from mean value for contest in 2020 among last 2 weeks
eacherr24bothyearfirms <- mclapply(eachcontest24, function(x) abs(x$demrepmargin-mean(x$demrepmargin))[gsub("2024", "2020", x$pollstercycle) %in% dfuse$pollstercycle])
eacherr20bothyearfirms <- mclapply(eachcontest20, function(x) abs(x$demrepmargin-mean(x$demrepmargin))[gsub("2020", "2024", x$pollstercycle) %in% dfuse$pollstercycle])
eacherr24onlyfirms <- mclapply(eachcontest24, function(x) abs(x$demrepmargin-mean(x$demrepmargin))[!(gsub("2024", "2020", x$pollstercycle) %in% dfuse$pollstercycle)])
eacherr20onlyfirms <- mclapply(eachcontest20, function(x) abs(x$demrepmargin-mean(x$demrepmargin))[!(gsub("2020", "2024", x$pollstercycle) %in% dfuse$pollstercycle)])
for(i in 1:length(eachcontest24)){
    eachcontest24[[i]]$diffrommean <- eacherr24[[i]]
    eachcontest20[[i]]$diffrommean <- eacherr20[[i]]
}

## Overall look at variance in 2020 vs 2024

alltogethercontests <- as.data.frame(rbindlist(c(eachcontest24, eachcontest20)))

reduced <- contestvars$Fval<1 & contestvars$fvalp<.05
increased <- contestvars$Fval>1 & contestvars$fvalp<.05

jpeg("../Report/LinkedResults/Section_5_3/ReductionsInVariance.jpg", width=10, height=10, units="in", res=1600)
par(mfrow=c(1,1))
plot(c(-.07,.2), c(.5, 18.5), type="n", axes=FALSE, xlab="Difference from Mean Value", ylab="Contest", main="Within-Contest Survey Variability\nLast 2 Weeks Surveys in 2020 and 2024")
axis(1, seq(0,1,.05), 100*seq(0,1,.05))
polygon(rep(c(-99,99,99,-99), 10), sort(c(1:20, 1:20)+.5), col="gray95", border=FALSE)
abline(v=0)
abline(v=seq(0,1,.05), lty=3, col="gray")
for(i in 1:length(eacherr24)){
    lines(eacherr24[[i]], rep(i-.15, length(eacherr24[[i]])), type="p", pch=20, col=alpha(brewer.pal(3, "Dark2")[1], .4), cex=eachcontest24[[i]]$bestweight)
    lines(eacherr20[[i]], rep(i+.15, length(eacherr20[[i]])), type="p", pch=20, col=alpha(brewer.pal(3, "Dark2")[2], .4), cex=eachcontest20[[i]]$bestweight)
}
lines(contestvars$var24, (1:length(eacherr24))-.15, pch=23, col=brewer.pal(3, "Dark2")[1], type="p", cex=1.5, bg=brewer.pal(3, "Pastel2")[1])
lines(contestvars$var20, (1:length(eacherr20))+.15, pch=23, col=brewer.pal(3, "Dark2")[2], type="p", cex=1.5, bg=brewer.pal(3, "Pastel2")[2])
text(-.005, 1:length(eacherr24), str_to_title(gsub("-", " ", names(eacherr24))), pos=2)
text(-.005, (1:length(eacherr24))[reduced], str_to_title(gsub("-", " ", names(eacherr24)))[reduced], pos=2, col="blue")
if(sum(increased)>0)
    text(-.005, (1:length(eacherr24))[increased], str_to_title(gsub("-", " ", names(eacherr24)))[increased], pos=2, col="red")
legend("topright", legend=c("2020 Estimate", "2024 Estimate", "2020 Std. Dev", "2024 Std. Dev"), pch=c(20, 20, 23, 23), col=c(brewer.pal(3, "Dark2")[2], brewer.pal(3, "Dark2")[1]), pt.bg=c(brewer.pal(3, "Pastel2")[2], brewer.pal(3, "Pastel2")[1]), bg="white")
dev.off()

wtd.mean(contestvars$var20, weight=sqrt(contestvars$Ns20))
wtd.mean(contestvars$var24, weight=sqrt(contestvars$Ns24))

wtd.mean(contestvars$var24, weight=sqrt(contestvars$Ns24))/wtd.mean(contestvars$var20, weight=sqrt(contestvars$Ns20))



## Calculate a similar within-contest variability for the entire cycle

dfuse$combinedpolldist <- (dfuse$distfromotherrecent+dfuse$distfromnearfuture)/2 # Only polls with both recent and future

eachcontest24fullcyclepre <- mclapply(sharedcontests2024, function(x) dfuse[dfuse$contest==x & dfuse$stage=="general",])
eachcontest20fullcyclepre <- mclapply(gsub("2024", "2020", sharedcontests2024), function(x) dfuse[dfuse$contest==x & dfuse$stage=="general",])
names(eachcontest24fullcyclepre) <- names(eachcontest20fullcyclepre) <- gsub("2024-|-general", "", sharedcontests2024)

eachcontest24fullcyclepre2 <- eachcontest24fullcyclepre[sapply(eachcontest24fullcyclepre, function(x) sum(x$bestweight*(!is.na(x$combinedpolldist))))>5 & sapply(eachcontest20fullcyclepre, function(x) sum(x$bestweight*(!is.na(x$combinedpolldist))))>5]
eachcontest20fullcyclepre2 <- eachcontest20fullcyclepre[sapply(eachcontest24fullcyclepre, function(x) sum(x$bestweight*(!is.na(x$combinedpolldist))))>5 & sapply(eachcontest20fullcyclepre, function(x) sum(x$bestweight*(!is.na(x$combinedpolldist))))>5]
eachcontest24fullcycle <- eachcontest24fullcyclepre2[order(sapply(eachcontest24fullcyclepre2, nrow))]
eachcontest20fullcycle <- eachcontest20fullcyclepre2[order(sapply(eachcontest24fullcyclepre2, nrow))]# same order

#bundle2024 <- lapply(names(eachcontest24), function(x) rbind(eachcontest24[[x]], eachcontest20[[x]]))

contestvarsfullcycle <- data.frame(Ns20=sapply(eachcontest20fullcycle, function(x) sum(x$bestweight)), Ns24=sapply(eachcontest24fullcycle, function(x) sum(x$bestweight)), meanerr20=sapply(eachcontest20fullcycle, function(x) wtd.mean(x$combinedpolldist, x$bestweight)), meanerr24=sapply(eachcontest24fullcycle, function(x) wtd.mean(x$combinedpolldist, x$bestweight)), var20=sapply(eachcontest20fullcycle, function(x) sqrt(wtd.var(x$combinedpolldist, weights=x$bestweight))), var24=sapply(eachcontest24fullcycle, function(x) sqrt(wtd.var(x$combinedpolldist, weights=x$bestweight))))

contestvarsfullcycle$Fval <- with(contestvarsfullcycle, (var24^2)/(var20^2))

Fcomparesupperfullcycle <- pf(contestvarsfullcycle$Fval, contestvarsfullcycle$Ns24, contestvarsfullcycle$Ns20, lower.tail = FALSE)
Fcompareslowerfullcycle <- pf(contestvarsfullcycle$Fval, contestvarsfullcycle$Ns24, contestvarsfullcycle$Ns20, lower.tail = TRUE)
Fvalpfullcycle <- 2*Fcomparesupperfullcycle
Fvalpfullcycle[Fcompareslowerfullcycle<Fcomparesupperfullcycle] <- 2*Fcompareslowerfullcycle[Fcompareslowerfullcycle<Fcomparesupperfullcycle]

contestvarsfullcycle$fvalp <- Fvalpfullcycle
contestvarsfullcycle$starry <- starmaker(Fvalpfullcycle)

eacherr24fullcycle <- mclapply(eachcontest24fullcycle, function(x) abs(x$combinedpolldist)) # Absolute difference from mean value for contest in 2024 among last 2 weeks
eacherr20fullcycle <- mclapply(eachcontest20fullcycle, function(x) abs(x$combinedpolldist)) # Absolute difference from mean value for contest in 2020 among last 2 weeks
eacherr24bothyearfirmsfullcycle <- mclapply(eachcontest24fullcycle, function(x) abs(x$combinedpolldist)[gsub("2024", "2020", x$pollstercycle) %in% dfuse$pollstercycle])
eacherr20bothyearfirmsfullcycle <- mclapply(eachcontest20fullcycle, function(x) abs(x$combinedpolldist)[gsub("2020", "2024", x$pollstercycle) %in% dfuse$pollstercycle])
eacherr24onlyfirmsfullcycle <- mclapply(eachcontest24fullcycle, function(x) abs(x$combinedpolldist)[!(gsub("2024", "2020", x$pollstercycle) %in% dfuse$pollstercycle)])
eacherr20onlyfirmsfullcycle <- mclapply(eachcontest20fullcycle, function(x) abs(x$combinedpolldist)[!(gsub("2020", "2024", x$pollstercycle) %in% dfuse$pollstercycle)])
#for(i in 1:length(eachcontest24fullcycle)){
#    eachcontest24fullcycle[[i]]$diffrommean <- eacherr24fullcycle[[i]]
#    eachcontest20fullcycle[[i]]$diffrommean <- eacherr20fullcycle[[i]]
#}


## Full cycle look at variance in 2020 vs 2024

alltogethercontestsfullcycle <- as.data.frame(rbindlist(c(eachcontest24fullcycle, eachcontest20fullcycle)))

reducedfullcycle <- contestvarsfullcycle$Fval<1 & contestvarsfullcycle$fvalp<.05
increasedfullcycle <- contestvarsfullcycle$Fval>1 & contestvarsfullcycle$fvalp<.05

jpeg("../Report/LinkedResults/Section_5_3/ReductionsInVarianceFullCycles.jpg", width=10, height=10, units="in", res=1600)
par(mfrow=c(1,1))
plot(c(-.07,.2), c(.5, nrow(contestvarsfullcycle)+.5), type="n", axes=FALSE, xlab="Difference from Mean Value", ylab="Contest", main="Within-Contest Survey Variability\nFull Cycle Surveys in 2020 and 2024")
axis(1, seq(0,1,.05), 100*seq(0,1,.05))
polygon(rep(c(-99,99,99,-99), 10), sort(c(1:20, 1:20)+.5), col="gray95", border=FALSE)
abline(v=0)
abline(v=seq(0,1,.05), lty=3, col="gray")
for(i in 1:length(eacherr24fullcycle)){
    lines(eacherr24fullcycle[[i]], rep(i-.15, length(eacherr24fullcycle[[i]])), type="p", pch=20, col=alpha(brewer.pal(3, "Dark2")[1], .4), cex=eachcontest24fullcycle[[i]]$bestweight)
    lines(eacherr20fullcycle[[i]], rep(i+.15, length(eacherr20fullcycle[[i]])), type="p", pch=20, col=alpha(brewer.pal(3, "Dark2")[2], .4), cex=eachcontest20fullcycle[[i]]$bestweight)
}
lines(contestvarsfullcycle$var24, (1:length(eacherr24fullcycle))-.15, pch=23, col=brewer.pal(3, "Dark2")[1], type="p", cex=1.5, bg=brewer.pal(3, "Pastel2")[1])
lines(contestvarsfullcycle$var20, (1:length(eacherr20fullcycle))+.15, pch=23, col=brewer.pal(3, "Dark2")[2], type="p", cex=1.5, bg=brewer.pal(3, "Pastel2")[2])
text(-.005, 1:length(eacherr24fullcycle), str_to_title(gsub("-", " ", names(eacherr24fullcycle))), pos=2)
text(-.005, (1:length(eacherr24fullcycle))[reducedfullcycle], str_to_title(gsub("-", " ", names(eacherr24fullcycle)))[reducedfullcycle], pos=2, col="blue")
text(-.005, (1:length(eacherr24fullcycle))[increasedfullcycle], str_to_title(gsub("-", " ", names(eacherr24fullcycle)))[increasedfullcycle], pos=2, col="red")
legend("topright", legend=c("2020 Estimate", "2024 Estimate", "2020 Std. Dev", "2024 Std. Dev"), pch=c(20, 20, 23, 23), col=c(brewer.pal(3, "Dark2")[2], brewer.pal(3, "Dark2")[1]), pt.bg=c(brewer.pal(3, "Pastel2")[2], brewer.pal(3, "Pastel2")[1]), bg="white")
dev.off()

wtd.mean(contestvarsfullcycle$var20, weight=sqrt(contestvarsfullcycle$Ns20))
wtd.mean(contestvarsfullcycle$var24, weight=sqrt(contestvarsfullcycle$Ns24))

wtd.mean(contestvarsfullcycle$var24, weight=sqrt(contestvarsfullcycle$Ns24))/wtd.mean(contestvarsfullcycle$var20, weight=sqrt(contestvarsfullcycle$Ns20))




## Firm by firm


firms24 <- unique(dfuse$match_name[dfuse$cycle==2024 & dfuse$stage=="general"])
firms20 <- unique(dfuse$match_name[dfuse$cycle==2020 & dfuse$stage=="general"])

eachfirm24pre <- mclapply(firms24, function(x) dfuse[dfuse$cycle==2024 & dfuse$match_name==x & dfuse$stage=="general",])
eachfirm20pre <- mclapply(firms20, function(x) dfuse[dfuse$cycle==2020 & dfuse$match_name==x & dfuse$stage=="general",])
names(eachfirm20pre) <- firms20
names(eachfirm24pre) <- firms24
for(i in names(eachfirm24pre))
    eachfirm24pre[[i]]$houseeffect <- wtd.mean(eachfirm24pre[[i]]$combinedpolldist, eachfirm24pre[[i]]$bestweight)
for(i in names(eachfirm20pre))
    eachfirm20pre[[i]]$houseeffect <- wtd.mean(eachfirm20pre[[i]]$combinedpolldist, eachfirm20pre[[i]]$bestweight)

eachfirm24pre2 <- eachfirm24pre[sapply(eachfirm24pre, function(x) sum(x$bestweight*(!is.na(x$combinedpolldist))))>5]
eachfirm20pre2 <- eachfirm20pre[sapply(eachfirm20pre, function(x) sum(x$bestweight*(!is.na(x$combinedpolldist))))>5]

eachfirmrecentdist <- sapply(eachfirm24pre2, function(x) wtd.mean(abs(x$distfromotherrecent), x$bestweight*(!is.na(x$combinedpolldist))))
eachfirmfuturedist <- sapply(eachfirm24pre2, function(x) wtd.mean(abs(x$distfromnearfuture), x$bestweight*(!is.na(x$combinedpolldist))))
eachfirmN <- sapply(eachfirm24pre2, function(x) sum(x$bestweight*(!is.na(x$combinedpolldist))))

eachfirmttest <- sapply(eachfirm24pre2, function(x) unlist(wtd.t.test(abs(x$distfromotherrecent[!is.na(x$distfromotherrecent) & !is.na(x$distfromnearfuture)]), abs(x$distfromnearfuture[!is.na(x$distfromotherrecent) & !is.na(x$distfromnearfuture)]), weight=x$bestweight[!is.na(x$distfromotherrecent) & !is.na(x$distfromnearfuture)], mean1=FALSE)))
eachfirmtpval <- as.numeric(eachfirmttest["coefficients.p.value",])
eachfirmrecentdist <- as.numeric(eachfirmttest["additional.Mean.x",])
eachfirmfuturedist <- as.numeric(eachfirmttest["additional.Mean.y",])

names(eachfirm24pre2)[eachfirmtpval<.05]


# Overall Firm Herding Test - Unadjusted

jpeg("../Report/LinkedResults/Section_5_3/PastVsFutureComparisons24Unadjusted.jpg", width=8, height=8, units="in", res=1600)
plot(100*eachfirmrecentdist[eachfirmtpval>.05], 100*eachfirmfuturedist[eachfirmtpval>.05], xlim=c(0,10), ylim=c(0,10), xlab="Mean Absolute Difference From Prior Surveys (Past 7 Day Average)", ylab="Mean Absolute Difference From Subsequent Surveys (Future 7 Day Average)", main=paste("Comparisons of Firm-Based Differences from Prior vs. Subsequent Surveys\nfor", length(eachfirmN), "Firms in 2024"), cex=sqrt(eachfirmN[eachfirmtpval>.05])/2, pch=21, bg=alpha("light blue", .6), col=alpha("blue", .8), las=1)
abline(v=seq(0,100,2), col="light gray", lty=3)
abline(h=seq(0,100,2), col="light gray", lty=3)
lines(100*eachfirmrecentdist[eachfirmtpval<=.05], 100*eachfirmfuturedist[eachfirmtpval<=.05], pch=21, bg=alpha("red", .7), col=alpha("dark red", .7), type="p", cex=sqrt(eachfirmN[eachfirmtpval<=.05])/2)
abline(a=0, b=1, col="orange")
legend(x="bottomright", legend=c("Firm average", "Significant pre vs. post t-test", paste0("within firm (N=", sum(eachfirmtpval<.05), ")"), "Sizes indicate harmonic mean of Ns"), pch=c(21, 21, -1, 21), pt.bg=alpha(c("light blue", "red", "white", "light blue"), .6), col=alpha(c("blue", "dark red", "white", "blue"), .6), bg="white", pt.cex=c(1.5,1.5,2,3))
dev.off()


# Add in House Effects
## Herding Plus House Effects

eachfirmttestHE <- sapply(eachfirm24pre2, function(x) unlist(wtd.t.test(abs(x$distfromotherrecent-x$houseeffect), abs(x$distfromnearfuture-x$houseeffect), weight=x$bestweight, mean1=FALSE)))
eachfirmtpvalHE <- as.numeric(eachfirmttestHE["coefficients.p.value",])
eachfirmrecentdistHE <- as.numeric(eachfirmttestHE["additional.Mean.x",])
eachfirmfuturedistHE <- as.numeric(eachfirmttestHE["additional.Mean.y",])

# Overall Firm Herding Test - House Effects

jpeg("../Report/LinkedResults/Section_5_3/PastVsFutureComparisons24HouseEffects.jpg", width=8, height=8, units="in", res=1600)
plot(100*eachfirmrecentdistHE[eachfirmtpvalHE>.05], 100*eachfirmfuturedistHE[eachfirmtpvalHE>.05], xlim=c(0,10), ylim=c(0,10), xlab="Mean Absolute Difference From Prior Surveys (Past 7 Day Average)", ylab="Mean Absolute Difference From Subsequent Surveys (Future 7 Day Average)", main=paste("Comparisons of Firm-Based Differences from Prior vs. Subsequent Surveys\nAccounting for House Effects for", length(eachfirmN), "Firms in 2024"), cex=sqrt(eachfirmN[eachfirmtpvalHE>.05])/2, pch=21, bg=alpha("light blue", .6), col=alpha("blue", .8), las=1)
abline(v=seq(0,100,2), col="light gray", lty=3)
abline(h=seq(0,100,2), col="light gray", lty=3)
lines(100*eachfirmrecentdistHE[eachfirmtpvalHE<=.05], 100*eachfirmfuturedistHE[eachfirmtpvalHE<=.05], pch=21, bg=alpha("red", .7), col=alpha("dark red", .7), type="p", cex=sqrt(eachfirmN[eachfirmtpvalHE<=.05])/2)
abline(a=0, b=1, col="orange")
legend(x="bottomright", legend=c("Firm average", "Significant pre vs. post t-test", paste0("within firm (N=", sum(eachfirmtpvalHE<.05), ")"), "Sizes indicate harmonic mean of Ns"), pch=c(21, 21, -1, 21), pt.bg=alpha(c("light blue", "red", "white", "light blue"), .6), col=alpha(c("blue", "dark red", "white", "blue"), .6), bg="white", pt.cex=c(1.5,1.5,2,3))
dev.off()

eachfirm24preoctnov <- mclapply(firms24, function(x) dfuse[dfuse$cycle==2024 & dfuse$match_name==x & dfuse$stage=="general" & dfuse$octnov & !is.na(dfuse$octnov),])
eachfirm24preearlier <- mclapply(firms24, function(x) dfuse[dfuse$cycle==2024 & dfuse$match_name==x & dfuse$stage=="general" & !dfuse$octnov & !is.na(dfuse$octnov),])
names(eachfirm24preoctnov) <- names(eachfirm24preearlier) <- firms24

eachfirm24pre2octnov <- eachfirm24preoctnov[sapply(eachfirm24preoctnov, function(x) sum(x$bestweight*(!is.na(x$combinedpolldist))))>5]
eachfirm24pre2earlier <- eachfirm24preearlier[sapply(eachfirm24preearlier, function(x) sum(x$bestweight*(!is.na(x$combinedpolldist))))>5]
eachfirm24pre2octnovN <- sapply(eachfirm24pre2octnov, function(x) sum(x$bestweight*(!is.na(x$combinedpolldist))))
eachfirm24pre2earlierN <- sapply(eachfirm24pre2earlier, function(x) sum(x$bestweight*(!is.na(x$combinedpolldist))))


eachfirmrecentdistoctnov <- sapply(eachfirm24preoctnov, function(x) wtd.mean(abs(x$distfromotherrecent), x$bestweight*(!is.na(x$combinedpolldist))))
eachfirmfuturedistoctnov <- sapply(eachfirm24preoctnov, function(x) wtd.mean(abs(x$distfromnearfuture), x$bestweight*(!is.na(x$combinedpolldist))))
eachfirmrecentdistearlier <- sapply(eachfirm24preearlier, function(x) wtd.mean(abs(x$distfromotherrecent), x$bestweight*(!is.na(x$combinedpolldist))))
eachfirmfuturedistearlier <- sapply(eachfirm24preearlier, function(x) wtd.mean(abs(x$distfromnearfuture), x$bestweight*(!is.na(x$combinedpolldist))))
eachfirmNoctnov <- sapply(eachfirm24preoctnov, function(x) sum(x$bestweight*(!is.na(x$combinedpolldist))))
eachfirmNearlier <- sapply(eachfirm24preearlier, function(x) sum(x$bestweight*(!is.na(x$combinedpolldist))))

eachfirmttestoctnov <- sapply(eachfirm24pre2octnov, function(x) unlist(wtd.t.test(abs(x$distfromotherrecent[!is.na(x$distfromotherrecent) & !is.na(x$distfromnearfuture)]), abs(x$distfromnearfuture[!is.na(x$distfromotherrecent) & !is.na(x$distfromnearfuture)]), weight=x$bestweight[!is.na(x$distfromotherrecent) & !is.na(x$distfromnearfuture)], mean1=FALSE)))
eachfirmttestearlier <- sapply(eachfirm24pre2earlier, function(x) unlist(wtd.t.test(abs(x$distfromotherrecent[!is.na(x$distfromotherrecent) & !is.na(x$distfromnearfuture)]), abs(x$distfromnearfuture[!is.na(x$distfromotherrecent) & !is.na(x$distfromnearfuture)]), weight=x$bestweight[!is.na(x$distfromotherrecent) & !is.na(x$distfromnearfuture)], mean1=FALSE)))

eachfirmtpvaloctnov <- as.numeric(eachfirmttestoctnov["coefficients.p.value",])
eachfirmtpvalearlier <- as.numeric(eachfirmttestearlier["coefficients.p.value",])
eachfirmrecentdistoctnov <- as.numeric(eachfirmttestoctnov["additional.Mean.x",])
eachfirmfuturedistoctnov <- as.numeric(eachfirmttestoctnov["additional.Mean.y",])
eachfirmrecentdistearlier <- as.numeric(eachfirmttestearlier["additional.Mean.x",])
eachfirmfuturedistearlier <- as.numeric(eachfirmttestearlier["additional.Mean.y",])


jpeg("../Report/LinkedResults/Section_5_3/PastVsFutureComparisons24EarlierSet.jpg", width=8, height=8, units="in", res=1600)
plot(100*eachfirmrecentdistearlier[eachfirmtpvalearlier>.05], 100*eachfirmfuturedistearlier[eachfirmtpvalearlier>.05], xlim=c(0,10), ylim=c(0,10), xlab="Mean Absolute Difference From Prior Surveys (Past 7 Day Average)", ylab="Mean Absolute Difference From Subsequent Surveys (Future 7 Day Average)", main=paste("Comparisons of Firm-Based Differences from Prior vs. Subsequent Surveys\nNOT Accounting for House Effects for", length(eachfirmN), "Firms in 2024"), cex=sqrt(eachfirmN[eachfirmtpvalearlier>.05])/2, pch=21, bg=alpha("light blue", .6), col=alpha("blue", .8), las=1)
abline(v=seq(0,100,2), col="light gray", lty=3)
abline(h=seq(0,100,2), col="light gray", lty=3)
lines(100*eachfirmrecentdistearlier[eachfirmtpvalearlier<=.05], 100*eachfirmfuturedistearlier[eachfirmtpvalearlier<=.05], pch=21, bg=alpha("red", .7), col=alpha("dark red", .7), type="p", cex=sqrt(eachfirmN[eachfirmtpvalearlier<=.05])/2)
abline(a=0, b=1, col="orange")
legend(x="bottomright", legend=c("Firm average", "Significant pre vs. post t-test", paste0("within firm (N=", sum(eachfirmtpvalearlier<.05), ")"), "Sizes indicate harmonic mean of Ns"), pch=c(21, 21, -1, 21), pt.bg=alpha(c("light blue", "red", "white", "light blue"), .6), col=alpha(c("blue", "dark red", "white", "blue"), .6), bg="white", pt.cex=c(1.5,1.5,2,3))
dev.off()

## Herding Toward Tie Results?


eachfirm24preswing <- mclapply(firms24, function(x) dfuse[dfuse$cycle==2024 & dfuse$match_name==x & dfuse$stage=="general" & dfuse$swingstate & !is.na(dfuse$bestweight),])
names(eachfirm24preswing) <- firms24

eachfirmrecentdistfrom0 <- eachfirm24preswing[sapply(eachfirm24preswing, function(x) sum(x$bestweight*(!is.na(x$svymargin))))>5]
dist0Ns <- sapply(eachfirmrecentdistfrom0, function(x) sum(x$bestweight*(!is.na(x$svymargin))))


# Distances from Zero vs. future surveys

eachfirmttestFROM0 <- sapply(eachfirmrecentdistfrom0, function(x) unlist(wtd.t.test(abs(x$svymargin), abs(x$distfromnearfuture), weight=x$bestweight, mean1=FALSE)))
eachfirmtpvalfrom0 <- as.numeric(eachfirmttestFROM0["coefficients.p.value",])
eachfirmdistfrom0est <- as.numeric(eachfirmttestFROM0["additional.Mean.x",])
eachfirmfuturedist <- as.numeric(eachfirmttestFROM0["additional.Mean.y",])

names(eachfirmrecentdistfrom0)[eachfirmtpvalfrom0<.05]

jpeg("../Report/LinkedResults/Section_5_3/PastVsFutureComparisons24From0.jpg", width=8, height=8, units="in", res=1600)
plot(100*eachfirmdistfrom0est[eachfirmtpvalfrom0>.05], 100*eachfirmfuturedist[eachfirmtpvalfrom0>.05], xlim=c(0,10), ylim=c(0,10), xlab="Mean Absolute Difference From Tie Result", ylab="Mean Absolute Difference From Subsequent Surveys (Future 7 Day Average)", main=paste("Comparisons of Firm-Based Differences from Tie vs. Subsequent Surveys\nin Swing States for", length(dist0Ns), "Firms in 2024"), cex=sqrt(eachfirmN[eachfirmtpvalfrom0>.05])/2, pch=21, bg=alpha("light blue", .6), col=alpha("blue", .8), las=1)
abline(v=seq(0,100,2), col="light gray", lty=3)
abline(h=seq(0,100,2), col="light gray", lty=3)
lines(100*eachfirmdistfrom0est[eachfirmtpvalfrom0<=.05], 100*eachfirmfuturedist[eachfirmtpvalfrom0<=.05], pch=21, bg=alpha("red", .7), col=alpha("dark red", .7), type="p", cex=sqrt(dist0Ns[eachfirmtpvalfrom0<=.05])/2)
abline(a=0, b=1, col="orange")
legend(x="bottomright", legend=c("Firm average", "Significant pre vs. post t-test", paste0("within firm (N=", sum(eachfirmtpvalfrom0<.05), ")"), "Sizes indicate harmonic mean of Ns"), pch=c(21, 21, -1, 21), pt.bg=alpha(c("light blue", "red", "white", "light blue"), .6), col=alpha(c("blue", "dark red", "white", "blue"), .6), bg="white", pt.cex=c(1.5,1.5,2,3))
dev.off()



## Estimating Partisan House Effects in 2024

## SKIPPING THIS SECTION FOR NOW -- NOT SUFFICIENTLY INTERESTING

eachfirmhouseeffects24 <- sapply(eachfirm24pre2, function(x) x$houseeffect[1])
eachfirmhouseeffects20 <- sapply(eachfirm20pre2, function(x) x$houseeffect[1])

ef24in20 <- names(eachfirmhouseeffects24) %in% names(eachfirmhouseeffects20)
ef20in24 <- names(eachfirmhouseeffects20) %in% names(eachfirmhouseeffects24)

house20Ns <- sapply(eachfirm20pre2, function(x) sum(x$bestweight))

plot(eachfirmhouseeffects24, log(eachfirmN))


#sigdifhouseeffects <- abs(combohouse/combohousevar)>1.96 & combohouseN>2 & combohousevar>0


jpeg("../Report/LinkedResults/Section_5_3/HouseEffects.jpg", width=14, height=8, units="in", res=1600)
par(mfrow=c(1,2))
plot(100*eachfirmhouseeffects24, log(eachfirmN), pch=20, axes=FALSE, xlab="Mean Signed Difference of Firm Polls from Average of Recent & Future Polls\nby Other Firms in the Same Contest (prior 7 days)", ylab="Number of Matchups Reported by Firm (Harmonic Means, log scale)", main=paste("House Effects Estimates for", length(eachfirmhouseeffects24), "Firms in 2024\n"), xlim=c(-6,6))
mtext("Differences from Other-Firm Polls for Same Office-Location", line=1)
axis(1, seq(-100,100,2), seq(-100, 100, 2))
axis(2, log(c(1,2,5,10,20,50,100,200,500,1000,2000)), c(1,2,5,10,20,50,100,200,500,1000,2000), las=2)
abline(v=seq(-100,100,2), lty=3, col="gray")
abline(v=0, col="blue")
lines(100*eachfirmhouseeffects24, log(eachfirmN), pch=20, type="p")
lines(100*eachfirmhouseeffects24[!ef24in20], log(eachfirmN[!ef24in20]), pch=20, type="p", col="green")
#lines(combohouse[pollstercyclecycle==2024 & sigdifhouseeffects], log(pollstercycleNs[pollstercyclecycle==2024 & sigdifhouseeffects]), pch=20, col="red", type="p")
#dev.off()
# House effects in 2020
#jpeg("../Report/LinkedResults/Section_5_3/HouseEffects2020.jpg", width=8, height=8, units="in", res=1600)
plot(100*eachfirmhouseeffects20, log(house20Ns), pch=20, axes=FALSE, xlab="Mean Signed Difference of Firm Polls from Average of Recent & Future Polls\nby Other Firms in the Same Contest (prior 7 days)", ylab="Number of Matchups Reported by Firm (Harmonic Means, log scale)", main=paste("House Effects Estimates for", length(eachfirmhouseeffects20), "Firms in 2020\n"), xlim=c(-6,6))
mtext("Differences from Other-Firm Polls for Same Office-Location", line=1)
axis(1, seq(-100,100,2), seq(-100, 100, 2))
axis(2, log(c(1,2,5,10,20,50,100,200,500,1000,2000)), c(1,2,5,10,20,50,100,200,500,1000,2000), las=2)
abline(v=seq(-100,100,2), lty=3, col="gray")
abline(v=0, col="blue")
lines(100*eachfirmhouseeffects20, log(house20Ns), pch=20, type="p")
lines(100*eachfirmhouseeffects20[!ef20in24], log(house20Ns[!ef20in24]), pch=20, type="p", col="red")
#lines(combohouse[pollstercyclecycle==2024 & sigdifhouseeffects], log(pollstercycleNs[pollstercyclecycle==2024 & sigdifhouseeffects]), pch=20, col="red", type="p")
dev.off()




#jpeg("../Report/LinkedResults/Section_5_3/InfluenceofHouseEffects.jpg", width=10, height=6, units="in", res=1600)
#par(mfrow=c(1,2))
#wtd.hist(100*abs(combohouse[pollstercyclecycle==2024 & combohouseN>8]), breaks=seq(0,9,.25), weight=combohouseN[pollstercyclecycle==2024 & combohouseN>8], col="gray")
#abline(v=wtd.mean(100*abs(combohouse[pollstercyclecycle==2024 & combohouseN>8]), weight=combohouseN[pollstercyclecycle==2024 & combohouseN>8]), col="red")
#legend(x="topright", legend=paste("Mean:", rd(wtd.mean(100*abs(combohouse[pollstercyclecycle==2024 & combohouseN>8]), weight=combohouseN[pollstercyclecycle==2024 & combohouseN>8]), 2)))
#wtd.hist(100*abs(combohouse[pollstercyclecycle==2020 & combohouseN>8]), breaks=seq(0,9,.25), weight=combohouseN[pollstercyclecycle==2020 & combohouseN>8], col="gray")
#abline(v=wtd.mean(100*abs(combohouse[pollstercyclecycle==2020 & combohouseN>8]), weight=combohouseN[pollstercyclecycle==2020 & combohouseN>8]), col="red")
#legend(x="topright", legend=paste("Mean:", rd(wtd.mean(100*abs(combohouse[pollstercyclecycle==2020 & combohouseN>8]), weight=combohouseN[pollstercyclecycle==2020 & combohouseN>8]), 2)))
#dev.off()




## Over time trend in margin across all surveys

## National Polls

allnatpres <- dfuse[dfuse$office=="president" & dfuse$cycle=="2024" & dfuse$year==dfuse$cycle & dfuse$stage=="general" & dfuse$state=="national",]
allpapres <- dfuse[dfuse$office=="president" & dfuse$cycle=="2024" & dfuse$year==dfuse$cycle & dfuse$stage=="general" & dfuse$state=="pennsylvania",]


library(mgcv)
bidenline <- with(allnatpres[allnatpres$demnom=="biden",], gam(demrepmargin~s(as.numeric(eddt), k=12)))
harrisline <- with(allnatpres[allnatpres$demnom=="harris" & allnatpres$eddt>"2024-07-21",], gam(demrepmargin~s(as.numeric(eddt), k=12)))

bidenlinepa <- with(allpapres[allpapres$demnom=="biden",], gam(demrepmargin~s(as.numeric(eddt), k=12)))
harrislinepa <- with(allpapres[allpapres$demnom=="harris" & allpapres$eddt>"2024-07-21",], gam(demrepmargin~s(as.numeric(eddt), k=12)))


bidendates <- data.frame(eddt=seq(as.Date("2024-03-01"), as.Date("2024-07-21"), "day"))
harrisdates <- data.frame(eddt=seq(as.Date("2024-07-21"), as.Date("2024-11-05"), "day"))

predbiden <- predict(bidenline, newdata=bidendates)
predharris <- predict(harrisline, newdata=harrisdates)

predbidenpa <- predict(bidenlinepa, newdata=bidendates)
predharrispa <- predict(harrislinepa, newdata=harrisdates)

jpeg("../Report/LinkedResults/Section_6/CampaignTrends.jpg", width=10, height=6, units="in", res=1600)
candcols <- brewer.pal(4, "Paired")
plot(allnatpres$eddt, allnatpres$demrepmargin, cex=100*allnatpres$bestweight, type="n", xlim=c(as.Date("2024-04-01"), as.Date("2024-11-05")), ylim=c(-12,10), xlab="Date", ylab="Poll Margin (Dem - Rep)", main="National Polls Showing Impacts of Democratic Candidate Change")
abline(h=seq(-100,100,5), lty=3, col="gray")
abline(v=as.Date(c("2024-06-27", "2024-07-21")), col="red", lwd=2)
abline(h=100*allnatpres$votedemminusrep[1], col="dark green")
lines(allnatpres$eddt[allnatpres$demnom=="biden"], 100*allnatpres$demrepmargin[allnatpres$demnom=="biden"], cex=allnatpres$bestweight[allnatpres$demnom=="biden"], col=alpha(candcols[1], .8), type="p", pch=20)
lines(allnatpres$eddt[allnatpres$demnom=="harris"], 100*allnatpres$demrepmargin[allnatpres$demnom=="harris"], cex=allnatpres$bestweight[allnatpres$demnom=="harris"], col=alpha(candcols[2], .6), type="p", pch=20)
lines(bidendates$eddt, 100*predbiden, col="blue", lwd=4, lty=2)
lines(harrisdates$eddt, 100*predharris, col="dark blue", lwd=4, lty=2)
text(as.Date("2024-06-27"), -12, "Biden-Trump Debate", pos=2, cex=1)
text(as.Date("2024-07-21"), -12, "Biden Drops Out", pos=4, cex=1)
dev.off()

jpeg("../Report/LinkedResults/Section_6/CampaignTrendsPA.jpg", width=10, height=6, units="in", res=1600)
candcols <- brewer.pal(4, "Paired")
plot(allpapres$eddt, allpapres$demrepmargin, cex=100*allpapres$bestweight, type="n", xlim=c(as.Date("2024-04-01"), as.Date("2024-11-05")), ylim=c(-12,10), xlab="Date", ylab="Poll Margin (Dem - Rep)", main="Pennsylvania Polls Showing Impacts of Democratic Candidate Change")
abline(h=seq(-100,100,5), lty=3, col="gray")
abline(v=as.Date(c("2024-06-27", "2024-07-21")), col="red", lwd=2)
abline(h=100*allpapres$votedemminusrep[1], col="dark green")
lines(allpapres$eddt[allpapres$demnom=="biden"], 100*allpapres$demrepmargin[allpapres$demnom=="biden"], cex=allpapres$bestweight[allpapres$demnom=="biden"], col=alpha(candcols[1], .8), type="p", pch=20)
lines(allpapres$eddt[allpapres$demnom=="harris"], 100*allpapres$demrepmargin[allpapres$demnom=="harris"], cex=allpapres$bestweight[allpapres$demnom=="harris"], col=alpha(candcols[2], .6), type="p", pch=20)
lines(bidendates$eddt, 100*predbidenpa, col="blue", lwd=4, lty=2)
lines(harrisdates$eddt, 100*predharrispa, col="dark blue", lwd=4, lty=2)
text(as.Date("2024-06-27"), -12, "Biden-Trump Debate", pos=2, cex=1)
text(as.Date("2024-07-21"), -12, "Biden Drops Out", pos=4, cex=1)
dev.off()










## APPENDIX I RESULTS

df24last2general <- dfuse[dfuse$cycle==2024 & dfuse$year==2024 & dfuse$stagemin=="general" & dfuse$last2weeks==TRUE & !is.na(dfuse$demrepmargin),]

bygroups <- with(df24last2general, data.frame(presnational=(office=="president" & stateornat=="National"), presallstates=(office=="president" & stateornat=="State"), presswingstates=(office=="president" & stateornat=="State" & swingstates), presotherstates=(office=="president" & stateornat=="State" & !swingstates), senate=(office=="senate" & stateornat=="State"), governor=(office=="governor" & stateornat=="State"), house=(office=="house" & stateornat=="State")
                                     ))

bystatepres <- as.data.frame(lapply(sort(unique(df24last2general$state)), function(x) with(df24last2general, office=="president" & state==x)))
names(bystatepres) <- sort(unique(df24last2general$state))

fullbygroups <- data.frame(bygroups, bystatepres)
usablegroups <- fullbygroups[,colSums(fullbygroups)>=5]

bgrun <- sapply(usablegroups, function(x) with(df24last2general, c(polls=sum(bestweight[x], na.rm=TRUE), abserr=wtd.mean(abs(demrepmargin[x]), bestweight[x], na.rm=TRUE), signederr=wtd.mean(demrepmargin[x], bestweight[x], na.rm=TRUE), rmse=sqrt(wtd.mean((demrepmargin[x])^2, bestweight[x], na.rm=TRUE)), medianerror=wtd.median(demrepmargin[x], bestweight[x], na.rm=TRUE), truemargin=wtd.mean(-truemargin[x], bestweight[x], na.rm=TRUE), avgpollmargin=wtd.mean(-svymargin[x], bestweight[x], na.rm=TRUE))))

t(bgrun)