R/elect_algebra.R

In eiCompare: Compares Different Ecological Inference Methods

#' Election Algebra for 2x2 Case
#'
#' Creates data.frame() table of algebraically defined white/non-white 
#' preferences for candidates. Typically used when analyst has high confidence 
#' in white turnout and voting behavior but needs to deduce minority voting 
#' behavior when only CVAP available. First, estimate white/non-white turnout 
#' using ei/rxc. Second, gather overall CVAP numbers. Third, estimate candidate 
#' preference by white/non-white using ei/rxc. Then enter values into function.
#' 
#' elect_algebra
#'
#' @param totals data.frame(), dimensions 2x2. Row 1 is white, row 2 is 
#' minority. First column is turnout (probably estimated from ei or rxc; 
#' e.g.: c(.2876, .1529)); second column is Citizen Voting Age 
#' Population (CVAP); e.g.: c(36472, 23851)  
#' @param c1_ei_res numeric vector of 2x2 EI candidate results by white voters, 
#' estimated from ei or rxc; e.g. c(0.2796, 0.7204) = whites voted 28\% for 
#' candidate-a and 72\% for candidate-b
#' @param c2_ei_res numeric vector of 2x2 EI candidate results by non-white 
#' voters, estimated from ei or rxc
#' @param cand_names Character vector of candidate names used for output, e.g.: 
#' c("Collingwood", "Barreto")
#' 
#' @return Table with estimated candidate A/B votes by race, with columns for 
#' percent vote too
#' @author Loren Collingwood <loren.collingwood@@ucr.edu>; 
#' <loren.collingwood@@gmail.com>
#' @author Matt Barreto <barretom@@ucla.edu>
#' 
#' @examples
#' 
#'toy <- data.frame(
#'precinct = 1:10,
#'cvap_white = c(3669, 3349, 5726, 5229, 3862, 2079, 6109, 2098, 2397, 1954),
#'cvap_non_white = c(398, 2313, 449, 176, 3138, 6887, 3987, 831, 1493, 4179),
#'voted = c(1028, 829, 2350, 1473, 2552, 1029, 2207, 723, 1053, 878),
#'novote = c(3039, 4833, 3825, 3932, 4448, 7937, 7889, 2206, 2837, 5255),
#'total = c(4067, 5662, 6175, 5405, 7000, 8966, 10096, 2929, 3890, 6133),
#'pct_voted = c(0.2527662, 0.1464147, 0.3805668, 0.2725254, 0.3645714, 
#'              0.1147669, 0.2186014, 0.2468419, 0.2706941, 0.1431600),
#'pct_novote = c(0.7472338, 0.8535853, 0.6194332, 0.7274746, 0.6354286, 
#'               0.8852331, 0.7813986, 0.7531581, 0.7293059, 0.8568400),
#'pct_white = c(0.9021392, 0.5914871, 0.9272874, 0.9674376, 0.5517143, 
#'              0.2318760, 0.6050911, 0.7162854, 0.6161954, 0.3186043),
#'pct_nonwhite = c(0.0978608, 0.4085129, 0.0727126, 0.0325624, 0.4482857, 
#'                 0.7681240, 0.3949089, 0.2837146, 0.3838046, 0.6813957),
#'cand_a = c(326, 745, 46, 66, 620, 830, 534, 388, 792, 617),
#'cand_b = c(702, 84, 2304, 1407, 1932, 199, 1673, 335, 261, 261),
#'pct_cand_a_voters = c(0.31712062, 0.89867310, 0.01957447, 0.04480652, 
#'                      0.24294671, 0.80660836, 0.24195741, 0.53665284, 
#'                      0.75213675, 0.70273349),
#'pct_cand_b_voters = c(0.6828794, 0.1013269, 0.9804255, 0.9551935, 0.7570533, 
#'                      0.1933916, 0.7580426, 0.4633472, 0.2478632, 0.2972665)
#')
#'
#'# NOT RUN: Estimate white/non-white Turnout #
#'#summary(ei_rxc(data = toy,
#'#        cand_cols = c("pct_voted","pct_novote"),
#'#        race_cols = c("pct_white", "pct_nonwhite"),
#'#        totals = "total", 
#'#        seed = 973472)
#'#        )
#'
#'# Turnout by Race, Estimated: 27-28% White Turnout; 16-17% Minority Turnout
#'# Citizen Voting Age Population for Whole Jurisdiction; White, Non-White
#'totals <- data.frame(turnout = c(0.2786, 0.1663), cvap = c(36472, 23851))
#'
#'# Not Run: Estimate Vote Choice 
#'# set.seed(197485)
#'#summary(ei_rxc(data = toy,
#'#       cand_cols = c("pct_cand_a_voters", "pct_cand_b_voters"),
#'#       race_cols = c("pct_white", "pct_nonwhite"),
#'#       totals_col = "total") 
#'#       )
#' #Extract Results 
#' c1_ei_res <- c(0.2796, 0.7204)
#' c2_ei_res <- c(0.7013, 0.2987)
#' #Set up vectors for function #
#' cand_names <- c("Cand A", "Cand B")
#' # Execute elect_algebra()
#' elect_algebra(totals = totals, c1_ei_res, c2_ei_res, cand_names)
#'
#' @export elect_algebra

elect_algebra <- function(totals, 
                          c1_ei_res, 
                          c2_ei_res, 
                          cand_names) {
    
    df <- totals
    
    # Set Column Output Names #
    cnames <- c("White_Vote", "NonWhite_Vote")
    
    # 1 is whites, 2 is non-whites
    votes <- round(apply(df, 1, prod), 0) 
    votes <- c(votes, sum(votes))
    
    # White Vote (for 2 candidates)
    wv <- round(votes[1] * c1_ei_res, 0)
    
    # Non-White Vote (for 2 candidates)
    nwv <- round(votes[2] * c2_ei_res, 0)
    out <- data.frame (wv, nwv, total = wv + nwv, stringsAsFactors = F) 
    out <- rbind(out, votes)
    
    # Collect column/row names 
    colnames(out) <- c(cnames, "Total")
    row.names(out) <- c(cand_names, "Total")
    
    # Add back on Percentages #
    out$Pct_White <- c(round(out$White_Vote[1] / out$White_Vote[3],3),
                       round(out$White_Vote[2] / out$White_Vote[3],3), "")
    
    out$Pct_NonWhite <- c(round(out$NonWhite_Vote[1] / out$NonWhite_Vote[3],3),
                          round(out$NonWhite_Vote[2] / out$NonWhite_Vote[3],3), "")
    
    # Return Table #
    return(out)
    
}