R/fortified_pr.R

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

#' Fortified Proportional Representation
#'
#' @rdname ElecFuns
#' @param v Matrix with candidates/parties (the interpretation depends
#' on the function) in the columns. Each cell has the number of votes cast for
#' each candidate/party. For AV and STV, the matrix should have ranked votes, 
#' with each rank in a separate row. 
#' @param m Number of seats to be awarded. 
#' @param threshold Proportion of votes that a party (or candidate) needs to
#' surpass in order to be eligible to receive seats.
#' @param ... Additional optional arguments (currently ignored).
#' @param fpr_cutoff Included in the fortified_pr function. It is a percentage
#' of votes that a party needs to surpass in order to be eligible to receive the
#' "bonus" seats assigned to the winner of the election. 
#' @param pr_formula A character vector that specifies the quota implemented. 
#' In general, is equal to "hare". The Hare quota is the number of votes cast 
#' in a district divided by M.
#' @param include_first_party A logical value that indicates whether the 
#' top-voted list party participate in the distribution of the remaining seats 
#' or not. If TRUE, it does. 
#' 
#' 
#' @section Details: The fortified_pr function is used for proportional 
#' representation with a majority bonus. The seat allocation formula is 
#' different from other list PR systems. Under this set of rules, the list which 
#' receives the largest vote share receives a bonus in seats. Sometimes, that 
#' list needs to surpass a certain percentage of votes (the cutoff) in order to 
#' be eligible for that. In this case, the function assigns half the seats to 
#' the party with most votes and assigns the other half of the seats 
#' proportionally. 
#'  
#' @export
#'
#' @examples
#' 
#' ## Fortified PR without cutoff: 
#' 
#' fortified_pr(v=example, m=4, fpr_cutoff=0, include_first_party=TRUE, pr_formula="hare")
#' 
#' ## Fortified PR with a 50% cutoff (including first party): 
#' 
#' fortified_pr(v=example, m=4, fpr_cutoff=0.5, include_first_party=TRUE, pr_formula="hare")
#' 
#' ## Fortified PR with a 50% cutoff (without including first party): 
#' 
#' fortified_pr(v=example, m=4, fpr_cutoff=0.5, include_first_party=FALSE, pr_formula="hare")
#'
fortified_pr <- function(v,
                         m,
                         threshold = 0.0,
                         fpr_cutoff,
                         pr_formula,
                         include_first_party,
                         ...){
  if(nrow(v) > 1){
    stop("Fortified PR undefined for ranked votes.")
  }
  # apply threshold
  if(sum(prop.table(v) < threshold) != ncol(v)){
    v[1, prop.table(v) < threshold]  <- 0
  }
  ##Assign 50% of seats to first party over fpr_cutoff
  seats <- rep(0, ncol(v))
  names(seats) <- colnames(v)
  ##Proportion of votes
  pvotes <- prop.table(v)
  rest_m <- m
  if(any(pvotes>=fpr_cutoff)){
    first_p <- which(pvotes>=fpr_cutoff)
    if(length(first_p)>1){
      first_p <- which.max(pvotes)
    }
    seats[first_p] <- floor(m/2)
    if(!include_first_party){
      v[first_p] <- 0
    }
    rest_m <- rest_m - floor(m/2)
  }
  ## Set electoral system formula
  elec_fun <- get(as.character(pr_formula))
  rest_seats <- elec_fun(v, rest_m, threshold, ...)
  seats <- seats + rest_seats
  return (seats)
}