bloc weighted cleavage salience index

gistfile1.txt

#' Compute the Block-WeightedCleavage Saliance Index
#'
#'
#'
#' @param data A crosstab of cell percentages.
#' @param cleavage A character vector containing the names of the parties in the cleavage bloc.
#' @param opposition A character vector containing the names of the parties in the opposition bloc.
#' @param elec_1 The name of the column containing vote shares at time 1.
#' @param elec_2 The name of the column containing vote shares at time 2.
#' @return A numeric vector
#' @references Alford, R.R. (1962). A Suggested Index of the Association of Social Class and Voting, \emph{Public Opinion Quarterly}. 26(3), pp. 417-425.
#'
#' @export

bw_cleavage_saliance <-
  function(
    data = NULL,
    cleavage = NULL,
    opposition = NULL,
    elec_1 = "elec_1",
    elec_2 = "elec_2"
  ){

    # 1. Housekeeping and Transformation --------------------------------------

    # Throw error if the user supplies no data

    if(is.null(data) == T){
      rlang::abort(
        message =
          c(
            "You did not supply any data to the function. You can solve this in one of two ways:",
            "i" = "Pipe some data into the function, e.g. your_data |> alford()",
            "i" = "Use the function's data argument, e.g. alford(data = your_data)"
          )
      )
    }


    # Throw error if the user-supplied data is not a data frame or matrix

    if(is.data.frame(data) == F && is.matrix(data) == F){
      rlang::abort(
        message =
          c(
            "The data you supplied is not a valid data frame, tibble, or matrix.",
            "i" = "To see what class of object your data is, use class(your_data)",
            "i" = "To coerce your data to a data frame or tibble, use as.data.frame(your_data) or as_tibble(your_data)",
            "i" = "To coerce your data to a matrix, use as.matrix(your_data)"
          )
      )
    }


    # Throw error if the user supplies no groups

    if(is.null(groups) == T){
      rlang::abort(
        message =
          c(
            "You did not supply a list of groups to the function. To solve this:",
            "i" = "Use the function's groups argument, e.g. alignment(data = your_data, party = 'X', groups = list(A = 'X', B = 'Y))"
          )
      )
    }


    # Convert data to matrix if necessary

    if(is.matrix(data) == F){

      data <- table_to_matrix(data)

    }



    # 2. Compute cleavage saliance index --------------------------------------

    # Compute total volatility

    tv <- pedersen(data)


    # Collapse data into blocs and remove non-aligned bloc

    bloc_data <- data
    rownames(bloc_data)[rownames(bloc_data) %in% c(cleavage, opposition)] <-
      c(rep("cleavage", length(cleavage)), rep("opposition", length(opposition)))
    bloc_data <- t(sapply(by(bloc_data,rownames(bloc_data),colSums),identity))
    bloc_data <- bloc_data[rownames(bloc_data) %in% c("cleavage", "opposition"), ]


    # Compute bloc volatility

    bv <- bloc_data[, elec_2] - bloc_data[, elec_1]
    bv <- abs(bv)
    bv <- sum(bv)
    bv <- bv/2


    # Compute bloc electoral support

    bes <- bloc_data["cleavage", elec_2]


    # Compute block-weighted cleavage saliance

    bw_cleavage_saliance <- (1-(bv/tv))*bes


    # Return the index to the user

    return(bw_cleavage_saliance)

  }
  
  
# Example

data <-
  tibble(
    bloc = c("left1", "left2", "right1", "right2", "other"),
    elec_1 = c(0.20, 0.10, 0.50, 0.15, 0),
    elec_2 = c(0.16, 0.16, 0.34, 0.34, 0)
  )

bw_cleavage_saliance(
  data = data,
  cleavage = c("left1", "left2"),
  opposition = c("right1", "right2")
)