ensure updated documentation, moved eiExpand features to rpv_coef_plot and rpv_toDF, moved example_rpvDF for test of new functions

Author: Sean Long

NAMESPACE

@@ -40,7 +40,9 @@ export(predict_race_multi_barreled)
 export(race_cand_cors)
 export(race_check_2_3)
 export(resolve_missing_vals)
+export(rpv_coef_plot)
 export(rpv_density)
+export(rpv_toDF)
 export(stdize_votes)
 export(stdize_votes_all)
 export(strip_special_characters)

R/data.R

@@ -339,3 +339,7 @@
 #' @usage data(gwinnett_ei)
 "gwinnett_ei"
 
+#' Example RPV analysis results in Washington State
+#'
+"example_rpvDF"
+

R/ei_rxc.R

@@ -164,10 +164,9 @@ ei_rxc <- function(
       chain = seq_len(n_chains),
       .inorder = TRUE,
       .packages = c("ei"),
-      .options.snow = opts
-    ) %myinfix% {
-      # Bayes model estimation
-      suppressWarnings(
+      .options.snow = opts) %myinfix% 
+      {
+        suppressWarnings(
         md_out <- ei.MD.bayes(
           formula = formula,
           sample = samples,
@@ -301,7 +300,7 @@ ei_rxc <- function(
       )
     } else {
       colnames(results_table) <- c(
-        "cand", "race", "mean", "sd", "ci_95_lower", "ci_95_upper"
+        "cand", "race", "mean", "sd", "ci_lower", "ci_upper"
       )
     }
 

R/rpv_coef_plot.R

@@ -1,62 +1,161 @@
-rpv_coef_plot <- function (rpvDF = NULL, 
-                            title = "Racially Polarized Voting Analysis Estimates", 
-                            caption = "Data: eiCompare RPV estimates", 
-                            ylab = "Pct. Voting Black-Preferred Candidate", 
-                            colors = NULL, 
-                            race_order = c("Black", "White")
-) 
-  
-{
+#' @export
+#' @import ggplot2
+#' @importFrom rlang .data
+#'
+#' @author Rachel Carroll <rachelcarroll4@gmail.com>
+#' @author Stephen El-Khatib <stevekhatib@gmail.com>
+#' @author Loren Collingwood <lcollingwood@unm.edu>
+#'
+#' @title Racially Polarized Voting Analysis (RPV) Coefficient Plot
+#' @description Creates a coefficient plot showing of RPV results estimate ranges
+#' of all contests by voter race
+#' @param rpvDF A data.frame containing RPV results
+#' @param title The plot title
+#' @param caption The plot caption
+#' @param ylab Label along y axis
+#' @param colors Character vector of colors, one for each racial group. The order
+#' of colors will be respective to the order of racial groups.
+#' @param race_order Character vector of racial groups from the \code{voter_race} column of
+#' \code{rpvDF} in the order they should appear in the plot. If not specified,
+#' the race groups will appear in alphabetical order.
+#'
+#' @return Coefficient plot of RPV analysis as a ggplot2 object
+#'
+#' @examples
+#'library(eiCompare)
+#'data(example_rpvDF)
+#'
+#'dem_rpv_results <- example_rpvDF %>% dplyr::filter(Party == "Democratic")
+#'rpv_coef_plot(dem_rpv_results)
+#'
+rpv_coef_plot <- function(
+    rpvDF = NULL,
+    title = "Racially Polarized Voting Analysis Estimates",
+    caption = "Data: eiCompare RPV estimates",
+    ylab = NULL,
+    colors = NULL,
+    race_order = NULL
+  ) {
+
+  # -----------------------------    QC CHECKS    -----------------------------
+
   colnames(rpvDF) <- stringr::str_to_lower(colnames(rpvDF))
-  
-  rpvDF$voter_race <- factor(rpvDF$voter_race, levels = race_order)
+
+  ##### new code (copied from eiExpand lines 40-58)
+  # make sure rpvDF argument is defined
+  if(is.null(rpvDF)){stop("you must include rpvDF argument")}
+
+  # make sure necessary columns are included
+  dif <- setdiff(c("party", "voter_race", "estimate", "lower_bound", "upper_bound"),
+          colnames(rpvDF))
+
+  if( length(dif) > 0 ) {
+    stop(paste("rpvDF is missing the following fields:",
+               paste(dif, collapse = ", ")))
+  }
+
+  # make sure only one party is in rpvDF
+  if( length(unique(rpvDF$party)) > 1 ){
+    stop("rpvDF should only contain one unique values in column Party")}
+  ##### end QC checks
+
+  # ----------------------   Prep Data and Plot Inputs   ----------------------
+
+  ##### Voter Race Order #####
+  ##### old code (from Updates_7_1_2024.R)
+  # rpvDF$voter_race <- factor(rpvDF$voter_race, levels = race_order)
+  ##### new code (copied from eiExpand lines 64-69)
+  # proper case for plot
+  rpvDF$voter_race <- stringr::str_to_title(rpvDF$voter_race)
+  #get factor order if not specified
+  if( is.null(race_order) ) { race_order <- sort(unique(rpvDF$voter_race)) }
+  #set factor
+  rpvDF$voter_race <- factor(rpvDF$voter_race,
+                             levels = race_order)
+
+  ##### Colors #####
   len_race <- length(unique(rpvDF$voter_race))
-  if (is.null(colors)) {
-    if (len_race == 2) {
+  ##### old code (from Updates_7_1_2024.R)
+  # if (is.null(colors)) {
+  #   if (len_race == 2) {
+  #     race_colors <- c(viridis::viridis(10)[4], viridis::viridis(10)[7])
+  #     names(race_colors) <- race_order
+  #     ggplot_color_obj <- scale_color_manual(values = race_colors)
+  #   }
+  #   else {
+  #     ggplot_color_obj <- viridis::scale_color_viridis(drop = FALSE,
+  #                                                      discrete = TRUE, option = "turbo", alpha = 0.8)
+  #   }
+  # }
+  ##### new code (copied from eiExpand lines 71-85)
+  if( is.null(colors) ){
+    if( len_race == 2 ){
       race_colors <- c(viridis::viridis(10)[4], viridis::viridis(10)[7])
       names(race_colors) <- race_order
+
       ggplot_color_obj <- scale_color_manual(values = race_colors)
+
+    } else {
+      ggplot_color_obj <- viridis::scale_color_viridis(drop = FALSE,
+                                                       discrete = TRUE,
+                                                       option = "turbo",
+                                                       alpha = .8)
     }
-    else {
-      ggplot_color_obj <- viridis::scale_color_viridis(drop = FALSE, 
-                                                       discrete = TRUE, option = "turbo", alpha = 0.8)
-    }
-  }
-  if (is.null(ylab)) {
+  } # END  if( is.null(colors) )
+
+  ##### ylab #####
+  if( is.null(ylab) ){
     prty <- unique(rpvDF$party) %>% stringr::str_to_title()
-    ylab <- paste("Percent Voting for", prty, "Candidate")
+    ylab <- paste("Percent Voting for", prty,  "Candidate")
   }
-  
-  coef_plot <- ggplot(rpvDF, aes(x = 0, y = 0:100)) + 
-    scale_y_continuous(breaks = seq(0, 100, by = 10), 
-                       limits = c(0, 100), 
-                       labels = sprintf("%0.1f%%", seq(0, 100, by = 10)), 
-                       expand = c(0, 0)) + geom_hline(yintercept = 50, 
-                                                      colour = "#000000", size = 0.75) + 
-    geom_pointrange(aes(y = .data$estimate, 
-                        ymin = .data$lower_bound, 
-                        ymax = .data$upper_bound, 
+
+  ##### mean percent vote for label #####
+  mean <- rpvDF %>%
+    dplyr::group_by(.data$voter_race) %>%
+    dplyr::summarize(avg = mean(.data$estimate))
+
+  rpvDF <- dplyr::left_join(rpvDF, mean, by = "voter_race")
+  rpvDF$panelLab <- paste0(rpvDF$voter_race, "\n(mean: ", round(rpvDF$avg,1), "%)")
+
+  # --------------------------      Build Plot       --------------------------
+
+  coef_plot <- ggplot(rpvDF,
+                      aes(x = 0, y = 0:100)) +
+    scale_y_continuous(breaks = seq(0,100, by = 10),
+                       limits = c(0, 100),
+                       labels = sprintf("%0.1f%%", seq(0,100, by = 10)),
+                       expand = c(0, 0)) +
+    geom_hline(yintercept = 50, colour = "#000000", size = 0.75) +  # Line at 0
+    geom_pointrange(aes(y = .data$estimate,
+                        ymin = .data$lower_bound,
+                        ymax = .data$upper_bound,
                         color = .data$voter_race),
-                    position = position_jitter(width = 0.1), 
-                    linewidth = .5, fatten = 1.5, 
-                    show.legend = F) + 
-    ggplot_color_obj + 
-    facet_grid(~panellab) + 
-    labs(y = ylab, title = title, caption = caption) + theme_minimal() + 
-    theme(legend.title = element_blank(), axis.title.x = element_blank(), 
-          axis.ticks.x = element_blank(), axis.text.x = element_blank(), 
-          panel.border = element_rect(fill = NA, colour = "grey"), 
-          panel.grid.major.x = element_blank(), 
-          panel.grid.minor.x = element_blank(), 
-          panel.grid.minor.y = element_blank(), 
-          axis.text.y = element_text(size = 20, face = "bold", 
-                                     family = "serif"), 
-          axis.title.y = element_text(size = 24, 
-                                      face = "bold", family = "serif"), 
-          strip.text.x = element_text(size = 15, 
-                                      face = "bold", family = "serif"), 
-          title = element_text(size = 25, hjust = 0.5, face = "bold", family = "serif"), 
-          plot.caption = element_text(size = 12, face = "italic", 
-                                      family = "serif"))
+                    position = position_jitter(width = 0.1),
+                    size = 2,
+                    fatten = 1.5,
+                    show.legend = F) +  # Ranges for each coefficient
+    ggplot_color_obj +
+    facet_grid(~panelLab) +
+        labs(y = ylab,
+         title = title,
+         caption = caption) +  # Labels
+    theme_minimal() +
+    theme(legend.title = element_blank(),
+          axis.title.x = element_blank(),
+          axis.ticks.x = element_blank(),
+          axis.text.x  = element_blank(),
+          panel.border = element_rect(fill = NA, colour = "grey"),
+          panel.grid.major.x = element_blank(),
+          panel.grid.minor.x = element_blank(),
+          panel.grid.minor.y = element_blank(),
+          axis.text.y = element_text(size = 20, face = "bold", family = "serif"),
+          axis.title.y = element_text(size = 24, face = "bold", family = "serif"),
+          strip.text.x = element_text(size = 15, face = "bold", family = "serif"),
+          #strip.text.x = element_blank(),
+          title = element_text(size = 30, hjust = .5, face = "bold", family = "serif"),
+          plot.caption = element_text(size = 12, face = "italic", family = "serif")
+          )
+
+# --------------------------        Return         --------------------------
   return(coef_plot)
 }

R/rpv_toDF.R

@@ -1,3 +1,73 @@
+#' @export
+#' 
+#'@author Rachel Carroll <rachelcarroll4@@gmail.com>
+#'@author Kassra Oskooii  <kassrao@@gmail.com>
+
+#' @title Transform RPV results from \code{eiCompare} into a simple dataframe
+#' object 
+#' 
+#' @description Create a dataframe from RPV analysis output to facilitate 
+#' RPV visualizations. The output dataframe of this function can be used directly 
+#' in \code{rpv_plot()}.
+#'
+#' @param rpv_results RPV analysis results either from the output of 
+#' \code{ei_iter()} or \code{ei_rxc()} from the \code{eiCompare} package or from 
+#' the internal function \code{ci_cvap_full()}.
+#' @param model A string indicating the model used to create \code{rpv_results}. 
+#' Examples include "ei", "rxc", "ei cvap", etc. 
+#' @param candidate A character vector of candidate names written as they would 
+#' appear on a visualization. The candidate names must be listed in the same order
+#' as the candidate estimates appear in \code{rpv_results}, i.e the same order 
+#' as the \code{cands} argument in \code{eiCompare::ei_iter()} or 
+#' \code{eiCompare::ei_rxc()}.
+#' @param preferred_candidate A character vector of races indicating racial
+#' preference of each candidate. The racial preferences must be listed 
+#' in the correct order with respect to \code{candidate}.
+#' @param party A character vector containing the political parties of the 
+#' candidates. Must be listed in the correct order with respect to 
+#' \code{candidate}.
+#' @param jurisdiction A string of the jurisdiction.
+#' @param election_type A string on the election type (usually "General" or 
+#' "Primary")
+#' @param year The year of the contest
+#' @param contest A string of contest name as it would appear in an rpv visualization
+#' (e.g. "President" or "Sec. of State")
+#' 
+#' @return rpv results in a data.frame
+#' 
+#' @examples
+#' \donttest{
+#' #library(eiCompare)
+#' #data("south_carolina")
+#' #prec_election_demog <- south_carolina[1:50,]
+#' 
+#' ## run rpv analysis
+#' #eiVote <- eiCompare::ei_iter(
+#'  # data = prec_election_demog,
+#'  # cand_cols = c('pct_mcmaster', 'pct_smith'),
+#'  # race_cols = c('pct_white', 'pct_black'),
+#'  # totals_col = "total_vap"
+#' #) %>%
+#'  # rpv_normalize(
+#'  #   cand_cols = c('pct_mcmaster', 'pct_smith'), 
+#'  #   race_cols = c('pct_white', 'pct_black')
+#'  # )
+#' 
+#' ## use function to create dataframe from rpv results
+#' #plotDF <- rpv_toDF(
+#'#   rpv_results = eiVote,
+#'#   model = "ei vap", #since we used ei_iter model normalized with vap denominator       
+#'#   jurisdiction = "Statewide",
+#'#   candidate = c("McMaster", "Smith"), #must be in correct order relative to rpv_results                             
+#'#   preferred_candidate = c("White", "Black"), #must be in correct order rpv_results  
+#'#   party = c("Republican", "Democratic"),
+#'#   election_type = "General",  
+#'#   year = "2020",
+#'#   contest = "Governor"
+#'# )
+#' }
+
+
 rpv_toDF <- function (rpv_results = NULL, model = NULL, jurisdiction = "", 
                        preferred_candidate = "", party = "", election_type = "", 
                        year = "", contest = "", candidate = "") 
@@ -26,8 +96,11 @@ rpv_toDF <- function (rpv_results = NULL, model = NULL, jurisdiction = "",
   rownames(rpv_data) <- 1:nrow(rpv_data)
   colnames(rpv_data) <- colnames(rpv_data) %>% stringr::str_to_lower()
   newcols <- gsub("mean", "Estimate", colnames(rpv_data))
+  # Handle both ci_95_lower and ci_lower naming conventions
   newcols <- gsub("ci_95_lower", "Lower_Bound", newcols)
   newcols <- gsub("ci_95_upper", "Upper_Bound", newcols)
+  newcols <- gsub("ci_lower", "Lower_Bound", newcols)
+  newcols <- gsub("ci_upper", "Upper_Bound", newcols)
   colnames(rpv_data) <- newcols
   plotDF <- rpv_data %>% dplyr::mutate(Model = model, Jurisdiction = jurisdiction, 
                                        Election_Type = election_type, Year = as.numeric(year),