我真的很喜欢政治和选举,我刚刚开始学习 R,我想用来自当地县的新数据重新创建这个博客中列出的过程。在进行区域分析之前,我已经能够使用修改后的代码可靠地完成博客中的大部分过程。
datas <- district.analyze(data)
作者分析了特定的住宅区,而我更愿意分析整个县。我修改了代码以使用 US House 作为我的目标区域,因为它包含整个县。
我想知道是否有人对我为什么无法从该县数据中获取辖区级别摘要提出建议。我收到这样的错误:
> Error in aggregate.data.frame(as.data.frame(x), ...) :
no rows to aggregate
In addition: Warning message:
In min(adf[, "rep_turnout_pct"], na.rm = TRUE) :
当我在数据中有“NA”时,我只会收到这个错误。当我用“0”代替空白时, District.analyze 起作用,但是“0”会抛出所有方程。
我可以重现的最少代码量是:
library(plyr)
major.party.bias <- function(adf) {
# aggregate base partisan vote - lowest non-zero turnout by party, given any election
abpv_rep <- min(adf[adf$rep_turnout_pct,"rep_turnout_pct"],na.rm=TRUE)
abpv_dem <- min(adf[adf$dem_turnout_pct,"dem_turnout_pct"],na.rm=TRUE)
# aggregate base partisan is combination of major parties worst scores
base_abpv = abpv_rep + abpv_dem
# swing is what is left after the aggregate base partisan support is removed
abpv_swing = 1.0 - base_abpv
# remove elections w/ no contender ie NA rep or NA dem turnout
tsa <- adf[which(!is.na(adf$dem_turnout) & !is.na(adf$rep_turnout)),]
# add a abs difference of rep v dem column
tsa[,"spread"] <- abs(tsa$dem_turnout_pct - tsa$rep_turnout_pct)
# average party performance - average of the top 3 best matched races (sorted by abs(rep-dem) performance)
app_dem <- mean(tsa[order(tsa$spread)[1:3],]$dem_turnout_pct)
app_rep <- mean(tsa[order(tsa$spread)[1:3],]$rep_turnout_pct)
# aggreage soft partisan vote - difference between the average worst over each year and the absolute worst (aggregate base partisan vote)
tsa <- adf[which(!is.na(adf$rep_turnout)),]
abpv_rep_soft <- mean(aggregate(tsa$rep_turnout_pct,tsa["year"],min)[,"x"]) - abpv_rep
tsa <- adf[which(!is.na(adf$dem_turnout)),]
abpv_dem_soft <- mean(aggregate(tsa$dem_turnout_pct,tsa["year"],min)[,"x"]) - abpv_dem
# tossup is everything left after we take out base and soft support for both major parties
abpv_tossup = abs(1.0 - abpv_rep_soft - abpv_rep - abpv_dem_soft - abpv_dem)
partisan.rep <- abpv_rep + abpv_rep_soft
partisan.dem <- abpv_dem + abpv_dem_soft
return (data.frame(partisan.base=base_abpv,partisan.swing=abpv_swing,tossup=abpv_tossup,
app.rep=app_rep,base.rep=abpv_rep,soft.rep=abpv_rep_soft,app.dem=app_dem,base.dem=abpv_dem,soft.dem=abpv_dem_soft,
partisan.rep=partisan.rep, partisan.dem=partisan.dem))
}
project.turnout <- function(adf,years=c(2012,2014,2016),target.district.type="U.S. House",similar.district.types=c('U.S. Senate','State Senate', 'State Auditor', 'Governor'),top.ballot.district.type="U.S. Senate") {
# look for good elections in years
case.type = 0
gl <- adf[which(adf$year %in% years & adf$district_type == target.district.type & !is.na(adf$dem_turnout) & !is.na(adf$rep_turnout)),]
# case 1 - major parties ran in 2001,2005 (governor + lt governor + HD)
# we'll calculate the average_turnout x downballot_turnout
proj.turnout <- 0.0
if(nrow(gl) >= 2 ){
down.ballot.turnout <- mean((gl$dem_turnout + gl$rep_turnout) / gl$total_registration)
gl <- adf[which(adf$year %in% years & adf$district_type == top.ballot.district.type),]
top.ticket.turnout <- mean(gl$total_turnout / gl$total_registration)
gl <- adf[which(adf$year %in% years & !is.na(adf$dem_turnout) & !is.na(adf$rep_turnout)),]
avg.turnout <- mean((gl$dem_turnout + gl$rep_turnout) / gl$total_registration)
runoff <- down.ballot.turnout / top.ticket.turnout
proj.turnout <- runoff * avg.turnout
case.type = 1
}
# case 2 - missing major party candidate in ''years'', so we 'll just take the average of what we've got walking backwards from the last known good year
# need more than one HD election
else {
gl <- adf[which(adf$district_type == target.district.type & !is.na(adf$dem_turnout) & !is.na(adf$rep_turnout)),]
if(nrow(gl) >= 1 ) {
# calculate the average turnout of at least one election
proj.turnout <- mean((gl$dem_turnout + gl$rep_turnout) / gl$total_registration)
case.type = 2
}
else {
# we dont have any evenly matched house races so we'll look at ''similar.district.types'' as a substitute
gl <- adf[which((adf$district_type %in% similar.district.types) & !is.na(adf$dem_turnout) & !is.na(adf$rep_turnout)),]
if(nrow(gl) >= 1) {
proj.turnout <- mean((gl$dem_turnout + gl$rep_turnout) / gl$total_registration)
case.type = 3
}
else {
proj.turnout <- 0
case.type = 4
}
}
}
# project the actual registration based on the known last registration in the df
reg <- adf[1,]$last_registration
proj.turnout.count <- proj.turnout * reg return(data.frame(proj.turnout.percent=proj.turnout,proj.turnout.count=proj.turnout.count,current.reg=reg,case.type=case.type))
}
# apply the major party bias to the projected turnout
apply.turnout <- function(adf) {
# take proj.turnout.count (from project.turnout) and combine it
with partisan percentages from major.party.bias
adf$proj.turnout.dem <- floor(adf$proj.turnout.count * adf$app.dem)
adf$proj.turnout.rep <- floor(adf$proj.turnout.count * adf$app.rep)
adf$votes.to.win <- floor(adf$proj.turnout.count/2)+1
return(adf)
}
district.analyze <- function(dis) {
ret <- ddply(dis, .(precinct_name), function(x) merge(project.turnout(x),major.party.bias(x)))
ret <- apply.turnout(ret)
return(ret)
}
我的数据是我从 .csv 读入 R 的大型数据集:
## Data given as Google Sheets
library(gsheet)
url <-"https://drive.google.com/file/d/1E4P0rfDVWEepbGHwX58qNSWN5vWd3iQU/view?usp=sharing"
df <- gsheet2tbl(url)