R/ev.r

In marko363/ev:

#'Generalized electoral volatility
#'
#' Function that can be used to calculate several measures of electoral volatility.
#' Default settings calculate Pedersen volatility.
#'@param x a numeric dataframe or matrix providing voteshare of each party.
#'Columns are denote years and rows denote parties
#'@param c a constant that the output is multiplied by. Can be used to change the scale of the output
#'@param exp the exponent that the measure of disproportionality is raised to. Pedersen volatility is
#'produced when this is set to one
#'@param denom this parameter determines what is used as the denominator in calculating volatility.
#'can be either "mean" or "sum". If set to mean, then the output is divided by the number of parties.
#'If set to sum, it is left as one.
#'@param difference a logical variable. If true then the difference between voteshares from the current year
#'and the previous year is used
#'year is used
#'@param ratio a logical variable. If true then the ratio of voteshares from the current and previous year
#'is used.
#'@param max logical variable. If true then only the maximum ratio or difference is reported.
general.volatility <- function(x, c=1, exp=1, denom="sum", difference=T, ratio=F, max=F){
  if (is.matrix(x)|is.data.frame(x)){
    X2 <- cbind(x, rep(NA, nrow(x)))
    X1 <- cbind(rep(NA, nrow(x)), x)
    if (difference){
      disprorp <- abs(X1 - X2)

    }else if (ratio){
      disprorp <- X2/X1
    }
    if (max){
      disprorp <- max(disprorp, na.rm=T)
    }
    disprorp <- disprorp[-c(1,ncol(x)+1)]
    if(denom=="mean"){
      denominator <- nrow(disprorp)
    }

    if(denom=="sum"){
      denominator <- 1
    }

    measure <- (c*colSums(disprorp)^exp)/denominator
    mean.measure <- mean(measure, na.rm=T)
    return(list(measure=measure, mean=mean.measure))
  }
 else{
    return("x must be a matrix or dataframe")
  }
}





#Rae Index of Electoral Volatility or Disproportionality
#'
#'Implements Rae volatility or disproportionality.
#'@param x may be a matrix, dataframe, or vector. If x is a dataframe or matrix then the
#' entries denote'voteshare and the columns are election years and the rows are parties.
#'@param y a vector of fractions that x will be compared with (for example, a vector of
#'the fraction of legislative seats won by each party). If x is a vector then y must be supplied.
#' If x is a matrix or dataframe, y must be NA.
rae <- function(x, y=NA){
  if ((is.matrix(x) | is.data.frame(x)) & all(is.na(y))){
    X2 <- cbind(x, rep(NA, nrow(x)))
    X1 <- cbind(rep(NA, nrow(x)), x)
    measure <- (colSums(abs(X2 - X1))/nrow(x))[-c(1,ncol(x)+1)]
    mean.measure <- mean(measure)
    return(list(measure=measure, mean=mean.measure))
  }
  else if (is.vector(x) & !all(is.na(y))) {
    sum(abs(x - y))/length(x)
  }
  else {
    "If x is matrix like, y must be NA. If x is a vector. y must be be assigned a value"
  }
}

#Pedersen Index of Electoral Volatility or Disproportionality
#'
#'Implements pedersen volatility or disproportionality.
#'@param x May be a matrix, dataframe, or vector. If x is a dataframe or matrix then the entries denote voteshare and the columns are election years and the rows are parties.
#'@param y A vector of fractions that x will be compared with (for example, a vector of the fraction of legislative seats won by each party). If x is a vector then y must be supplied. If x is a matrix or dataframe, y must be NA.
pedersen <- function(x, y=NA){
  if ((is.matrix(x) | is.data.frame(x)) & all(is.na(y))){
    X2 <- cbind(x, rep(NA, nrow(x)))
    X1 <- cbind(rep(NA, nrow(x)), x)
    measure <- (colSums(abs(X2 - X1))/nrow(x))[-c(1,ncol(x)+1)]
    mean.measure <- mean(measure)
    list(measure=measure, mean=mean.measure)
  }
  else if (is.vector(x) & !all(is.na(y))) {
    sum(abs(y-x))/2
  }
  else {
    "If x is matrix like, y must be NA. If x is a vector. Y must be be assigned a value"
  }
}



find.second.largest <- function(x){
  sort(x, decreasing=F)[(length(x) - 1)]
}

#Lijphart Index of Electoral Volatility or Disproportionality
#'
###'Implements Lijphart volatility or disproportionality.
#'@param x May be a matrix, dataframe, or vector. If x is a dataframe or matrix then the entries denote
#'voteshare and the columns are election years and the rows are parties.
#'@param y A vector of fractions that x will be compared with (for example, a vector of the fraction
#'of legislative seats won by each party). If x is a vector then y must be supplied. If x is a matrix or
#'dataframe, y must be NA.
Lijphart.two.largest <- function(x, y=NA){
  if ((is.matrix(x) | is.data.frame(x)) & all(is.na(y))){
    X2 <- cbind(x, rep(NA, nrow(x)))
    X1 <- cbind(rep(NA, nrow(x)), x)

    largest <- apply(X1,2, max, na.rm=T)[-c(1, ncol(X1))]
    second.largest <- apply(X1, 2, find.second.largest)[-c(1, ncol(X1))]

    staggered.largest <- apply(X2, 2, max, na.rm=T)[-c(1, ncol(X1))]
    staggered.second.largest <- apply(X2,2, find.second.largest)[-c(1, ncol(X1))]


    measure <- .5 * (abs(largest - staggered.largest) + abs(second.largest - staggered.second.largest))
    list(measure=measure, mean=mean(measure))

  }
  else if (is.vector(x) & !all(is.na(y))){
    n <- length(x)
    largest <- max(x, na.rm=T)
    largest.staggered <- y[x==largest]
    second <- sort(x,partial=n-1)[n-1]
    second.staggered <- y[x == second]
    (abs(largest - largest.staggered) + abs(second - second.staggered))/2
  }
  else {
    "If x is matrix like, y must be NA. If x is a vector. Y must be be assigned a value"
  }
}

#Chi Squared Index of Electoral Volatility or Disproportionality
#'
###'Implements Chi Squared volatility or disproportionality.
#'@param x May be a matrix, dataframe, or vector. If x is a dataframe or matrix then the entries denote
#'voteshare and the columns are election years and the rows are parties.
#'@param y A vector of fractions that x will be compared with (for example, a vector of the fraction
#'of legislative seats won by each party). If x is a vector then y must be supplied. If x is a matrix or
#'dataframe, y must be NA.
chi.sqrd.vol <- function(x){
  X2 <- cbind(x, rep(NA, nrow(x)))
  X1 <- cbind(rep(NA, nrow(x)), x)
  measure <- colMeans((X2 - X1)^2/X1)[-c(1,ncol(x)+1)]
  mean.measure <- mean(measure, na.rm=T)
  list(measure=measure, mean=mean.measure)
}
#Grofman Index of Electoral Volatility or Disproportionality
#'
###'Implements Grofman volatility or disproportionality.
#'@param x May be a matrix, dataframe, or vector. If x is a dataframe or matrix then the entries denote
#'voteshare and the columns are election years and the rows are parties.
#'@param y A vector of fractions that x will be compared with (for example, a vector of the fraction
#'of legislative seats won by each party). If x is a vector then y must be supplied. If x is a matrix or
#'dataframe, y must be NA.
grofman <- function(x, y=NA){
  if ((is.matrix(x) | is.data.frame(x)) & all(is.na(y))){
    X2 <- cbind(x, rep(NA, nrow(x)))
    X1 <- cbind(rep(NA, nrow(x)), x)
    measure <- (colSums(X1^2)*colSums(abs(X2 - X1)))[-c(1, ncol(x)+1)]
    mean.measure <- mean(measure, na.rm=T)
    list(measure=measure, mean=mean.measure)
  }
  else if (is.vector(x) & !all(is.na(y))) {
    sum(x^2)*sum(abs(y - x))
  }
  else {
    "If x is matrix like, y must be NA. If x is a vector. Y must be be assigned a value"
  }
}

#Gallagher Index of Electoral Volatility or Disproportionality
#'
###'Implements Gallagher or disproportionality.
#'@param x May be a matrix, dataframe, or vector. If x is a dataframe or matrix then the entries denote
#'voteshare and the columns are election years and the rows are parties.
#'@param y A vector of fractions that x will be compared with (for example, a vector of the fraction
#'of legislative seats won by each party). If x is a vector then y must be supplied. If x is a matrix or
#'dataframe, y must be NA.
gallagher <- function(x, y=NA){
  if ((is.matrix(x) | is.data.frame(x)) & all(is.na(y))){
    X2 <- cbind(x, rep(NA, nrow(x)))
    X1 <- cbind(rep(NA, nrow(x)), x)
    measure <- sqrt((colSums((X2 - X1)^2))/2)[-c(1,ncol(x)+1)]
    mean.measure <- mean(measure)
    return(list(measure=measure, mean=mean.measure))
  }
  else if (is.vector(x) & !all(is.na(y))) {
    (.5 * sum((y - x)^2))^.5
  }
  else {
      "If x is matrix like, y must be NA. If x is a vector. Y must be be assigned a value"
  }
}

#Taagepera-Shugart Index of Electoral Volatility or Disproportionality
#'
###'Implements Taagepera-Shugart volatility or disproportionality.
#'@param x May be a matrix, dataframe, or vector. If x is a dataframe or matrix then the entries denote
#'voteshare and the columns are election years and the rows are parties.
#'@param y A vector of fractions that x will be compared with (for example, a vector of the fraction
#'of legislative seats won by each party). If x is a vector then y must be supplied. If x is a matrix or
#'dataframe, y must be NA.
taagepera.shugart <- function(x, y=NA){
  if ((is.matrix(x) | is.data.frame(x)) & all(is.na(y))){
    X2 <- cbind(x, rep(NA, nrow(x)))
    X1 <- cbind(rep(NA, nrow(x)), x)
    measure <- (1 - colSums(X2^2)/colSums(X1^2))[-c(1,ncol(x)+1)]
    mean.measure <- mean(measure)
    list(measure=measure, mean=mean.measure)
  }
  else if (is.vector(x) & !all(is.na(y))) {
    1 - sum(x^2)/sum(y^2)
  }
  else {
    "If x is matrix like, y must be NA. If x is a vector. Y must be be assigned a value"
  }
}

#Cox-Shugart Index of Electoral Volatility or Disproportionality
#'
###'Implements Cox-Shugart volatility or disproportionality.
#'@param x May be a matrix, dataframe, or vector. If x is a dataframe or matrix then the entries denote
#'voteshare and the columns are election years and the rows are parties.
#'@param y A vector of fractions that x will be compared with (for example, a vector of the fraction
#'of legislative seats won by each party). If x is a vector then y must be supplied. If x is a matrix or
#'dataframe, y must be NA.
cox.shugart <- function(x, y=NA){
  if ((is.matrix(x) | is.data.frame(x)) & all(is.na(y))){
      X2 <- cbind(x, rep(NA, nrow(x)))
      X1 <- cbind(rep(NA, nrow(x)), x)

      measure <- colSums(sweep(X2, 2, colMeans(X2)) * sweep(X1, 2, colMeans(X1)))/
        colSums(sweep(X1, 2, colMeans(X1))^2)[-c(1, ncol(X2))]
      mean.measure <- mean(measure, na.rm=T)
      list(measure=measure, mean=mean.measure)
  }
  else if (is.vector(x) & !all(is.na(y))) {
    y.diff <- y -mean(y, na.rm=T)
    x.diff <- x- mean(x, na.rm=T)
    sum(y.diff * x.diff)/sum(x.diff^2)
  }
  else{
      "If x is matrix like, y must be NA. If x is a vector. Y must be be assigned a value"
  }
}

#Galeotti Index of Electoral Volatility or Disproportionality
#'
###'Implements Galeotti volatility or disproportionality.
#'@param x May be a matrix, dataframe, or vector. If x is a dataframe or matrix then the entries denote
#'voteshare and the columns are election years and the rows are parties.
#'@param y A vector of fractions that x will be compared with (for example, a vector of the fraction
#'of legislative seats won by each party). If x is a vector then y must be supplied. If x is a matrix or
#'dataframe, y must be NA.
galeotti  <- function(x, y=NA){
  if ((is.matrix(x) | is.data.frame(x)) & all(is.na(y))){
    X2 <- cbind(x, rep(NA, nrow(x)))
    X1 <- cbind(rep(NA, nrow(x)), x)

    largest <- apply(X1,2, max, na.rm=T)
    second.largest <- apply(X1,2, find.second.largest)

    staggered.largest <- apply(X2, 2, max, na.rm=T)
    staggered.second.largest <- apply(X2,2, find.second.largest)

    first.ratio <- log(largest/second.largest)
    second.ratio <- log(staggered.largest/staggered.second.largest)

    measure <- first.ratio/second.ratio
    list(measure=measure, mean=mean(measure, na.rm=T))
  }
  else if (is.vector(x) & !all(is.na(y))) {
    n <- length(x)
    largest.x <- max(x, na.rm=T)
    second.x <- sort(x,partial=n-1)[n-1]

    largest.y <- max(y)
    second.y <- sort(y,partial=n-1)[n-1]

    log(largest.x/second.x)/log(largest.y/second.y)
  }
  else{
    "If x is matrix like, y must be NA. If x is a vector. Y must be be assigned a value"
  }
}

#Lijphart Index of Max Electoral Disproportionality
#'
#'Implements Lijphart Max disproportionality -- reports the max difference between x and y.
#'@param x vector containing voteshare
#'@param y A vector of fractions that x will be compared with (for example, a vector of the fraction
#'of legislative seats won by each party).
Lijphart.max <- function(x,y){
  max(abs(y-x), na.rm=T)
}


#Lijphart of Max Electoral Volatility
#'
#'Implements Lijphart Max volatility .
#'@param x Matrix like object where columns are year, rows are parties, and entries are voteshare
Lijphart.max.vol <- function(x){
  X2 <- cbind(x, rep(NA, nrow(x)))
  X1 <- cbind(rep(NA, nrow(x)), x)

  max.na.rm <- function(y){
    max(y, na.rm=T)
  }

  measure <- apply(abs(X1 - X2), 2, max.na.rm)[-c(1,ncol(x)+1)]
  mean.measure <- mean(measure)
  list(measure=measure, mean=mean.measure)
}

#'Advantage Ratio
#'
#'Calculate Advantage Ratio.
#'@param x Matrix like object where columns are year, rows are parties, and entries are voteshare
advantage.ratio <- function(x){
  X2 <- cbind(x, rep(NA, nrow(x)))
  X1 <- cbind(rep(NA, nrow(x)), x)

  (X1/X2)[,-c(1,ncol(X1))]
}

#'Max Advantage Ratio
#'
#'Calculates Max Advantage Ratio.
#'@param x Matrix like object where columns are year, rows are parties, and entries are voteshare
max.advantage.ratio <- function(x){
  ratio <- advantage.ratio(x)
  max.na.rm <- function(y){
    max(y, na.rm=T)
  }
  apply(ratio, 2, max.na.rm)
}

#'Differenc Matrix
#'
#'function to construct difference matrix
#'@param x matrix like object where columns are years, rows are parties, and entries are voteshares won
difference.matrix <- function(x){
  X2 <- cbind(x, rep(NA, nrow(x)))
  X1 <- cbind(rep(NA, nrow(x)), x)

  abs((X2 - X1)[,-c(1,ncol(x)+1)])
}

#'Max Difference Volatility
#'
#'function to find the max change in partisan voteshare in each year
#'@param x matrix like object where columns are years, rows are parties, and entries are voteshares won
max.difference <- function(x){
  diffs <- difference.matrix(x)
  measure <- apply(diffs, 2, max.na.rm)
  mean.measure <- mean(measure)
  list(measure=measure, mean=mean.measure)
}

#'l one index
#'
#'function to calculate the l one index - this is just one minus the advantage ratio
#'@param x matrix or dataframe where columns are years, rows are parties, and entries are voteshare
l.one <- function(X){
  ratio <- advantage.ratio(x)

  measure <- colSums(abs(ratio - 1))
  mean.measure <- mean(measure)
  list(measure=measure, mean=mean.measure)
}


#'l two index
#'
#'function to calculate the l two index - this is the l one index squared
#'@param x matrix or dataframe where columns are years, rows are parties, and entries are voteshare
l.two <- function(X){
  ratio <- advantage.ratio(x)

  measure <- colSums(abs(ratio - 1)^2)
  mean.measure <- mean(measure)
  list(measure=measure, mean=mean.measure)
}

#'l three index
#'
#'function to calculate the l one index - this is just one minus the advantage ratio
#'@param x matrix or dataframe where columns are years, rows are parties, and entries are voteshare
l.three <- function(x){
  ratio <- advantage.ratio(x)

  measure <- (ratio - 1)
  measure <- apply(measure, 2, max, na.rm=T)
  mean.measure <- mean(measure)
  list(measure=measure, mean=mean.measure)
}

#'entropy
#'
#'function to calculate entropy - this is just one minus the advantage ratio
#'@param x matrix or dataframe where columns are years, rows are parties, and entries are voteshare
entropy <- function(x){
  X2 <- cbind(x, rep(NA, nrow(x)))
  X1 <- cbind(rep(NA, nrow(x)), x)

  measure <- colSums(X1*log(X1/X2))
  mean.measure <- mean(measure)
  list(measure=measure, mean=mean.measure)
}