R/voting.R

In i3pack: Incentives for Inter- And Intra-Party Electoral Competition

#' Function to simulate the voting process
#'
#' Internal function.
#'
#' @param voters See [simulate_election()].
#' @param nominated See [simulate_election()].
#' @param n_votes See [simulate_election()].
#' @param gamma_val See [simulate_election()].
#' @param gamma_rank See [simulate_election()].
#' @param epsilon Numeric; maximum acceptable ideological distance used in voters' utility function
#' @param free See [simulate_election()]. Defaults to `TRUE`.
#' @param closed_primary Boolean: Are voters required to vote for a candidate in the party closest to them in the primary? Defaults to `FALSE`.
#' @param strategic See [simulate_election()].
#' @param strategic_error See [simulate_election()]. Defaults to 0.05
#' @param party_pos Locations of parties in the election in 1d space (-2, 2). 
#'
#'
#' @return List with two elements:
#' \describe{
#' \item{votes}{Matrix with `n_votes` rows and `length(voters)` columns, with cells populated with candidate IDs}
#' \item{max_utils}{Vector of maximum utilities received by each voter from among all candidates in the election}
#' } 
#' 
#'
voting <- function(voters,
                   nominated,
                   n_votes,
                   gamma_val,
                   gamma_rank,
                   epsilon,
                   free = TRUE,
                   closed_primary = FALSE,
                   strategic = FALSE,
                   strategic_error = 0.05,
                   party_pos = NULL
)
{
  spat_comp <- outer(nominated$pos,
                     voters,
                     FUN = function(x,y){(x - y)^2})
  tol <- array(epsilon, dim(spat_comp))
  if(!strategic){
    cand_utils <- gamma_rank * ifelse(nominated$rank > 0, 1/sqrt(nominated$rank), 0) +
      array(gamma_val, dim(spat_comp)) * nominated$val - 
      ifelse(spat_comp <= tol, spat_comp, Inf) - 
      ifelse(nominated$rank > 0, 0, Inf)
  } else {
    cand_utils <- gamma_rank * ifelse(nominated$rank > 0, 1/sqrt(nominated$rank), 0) + 
      array(gamma_val, dim(spat_comp)) * nominated$val - 
      ifelse(spat_comp <= tol, spat_comp, Inf) - 
      ifelse(nominated$rank > 0, 0, Inf)
    n_unviable <- length(cand_utils[nominated$safe_party==0,])
    summand_unviable <- sample(c(-Inf, 0), n_unviable, replace = TRUE, c(1-strategic_error, strategic_error))
    cand_utils[nominated$safe_party==0,] <- cand_utils[nominated$safe_party==0,] + summand_unviable
  }
  if(closed_primary){
    for(i in 1:ncol(cand_utils)){
      dists <- abs(party_pos[nominated$party] - voters[i])
      cand_utils[,i] <- ifelse(dists > min(dists), -Inf, cand_utils[,i])
    }
  }
  
  if(free){ 
    votes <- apply(cand_utils, 2,
                   function(x, n_votes, candidates){
                     if(all(is.infinite(x))){
                       return(rep(0, n_votes)) # Abstain
                     }  else {
                       return(candidates[max_n(x,n = n_votes)])
                     }#Find n_votes closest candidates for each voter (could be across parties if multiple votes)
                   }, n_votes = n_votes, candidates = nominated$candidate)
  } else {
    votes <- apply(cand_utils, 2, # restrict to candidates in the same party
                   function(x, parties, n_votes, candidates){
                     if(all(is.infinite(x))){
                       return(rep(0, n_votes)) # Abstain
                     } else {
                       pref_party <- parties[which.max(x)]
                       target_cands <- candidates[parties==pref_party]
                       return(target_cands[max_n(x[match(target_cands, candidates)], n_votes)])
                     }
                   }, parties = nominated$party, n_votes = n_votes, candidates = nominated$candidate)
  }
  votes <- array(votes, c(n_votes, length(voters)))
  max_utils <- apply(cand_utils, 2, max_ninf)
  return(list(votes = votes,# votes is n_votes x voters
              max_utils = max_utils))
}