|
| 1 | +#' @export |
| 2 | +#' @import ggplot2 |
| 3 | +#' @importFrom rlang .data |
| 4 | +#' |
| 5 | +#' @author Rachel Carroll <rachelcarroll4@gmail.com> |
| 6 | +#' @author Stephen El-Khatib <stevekhatib@gmail.com> |
| 7 | +#' @author Loren Collingwood <lcollingwood@unm.edu> |
| 8 | +#' |
| 9 | +#' @title Racially Polarized Voting Analysis (RPV) Coefficient Plot |
| 10 | +#' @description Creates a coefficient plot showing of RPV results estimate ranges |
| 11 | +#' of all contests by voter race |
| 12 | +#' @param rpvDF A data.frame containing RPV results |
| 13 | +#' @param title The plot title |
| 14 | +#' @param caption The plot caption |
| 15 | +#' @param ylab Label along y axis |
| 16 | +#' @param colors Character vector of colors, one for each racial group. The order |
| 17 | +#' of colors will be respective to the order of racial groups. |
| 18 | +#' @param race_order Character vector of racial groups from the \code{voter_race} column of |
| 19 | +#' \code{rpvDF} in the order they should appear in the plot. If not specified, |
| 20 | +#' the race groups will appear in alphabetical order. |
| 21 | +#' |
| 22 | +#' @return Coefficient plot of RPV analysis as a ggplot2 object |
| 23 | +#' |
| 24 | +#' @examples |
| 25 | +#'library(eiCompare) |
| 26 | +#'data(example_rpvDF) |
| 27 | +#' |
| 28 | +#'dem_rpv_results <- example_rpvDF %>% dplyr::filter(Party == "Democratic") |
| 29 | +#'rpv_coef_plot(dem_rpv_results) |
| 30 | +#' |
| 31 | +rpv_coef_plot <- function( |
| 32 | + rpvDF = NULL, |
| 33 | + title = "Racially Polarized Voting Analysis Estimates", |
| 34 | + caption = "Data: eiCompare RPV estimates", |
| 35 | + ylab = NULL, |
| 36 | + colors = NULL, |
| 37 | + race_order = NULL |
| 38 | + ) { |
| 39 | + |
| 40 | + # ----------------------------- QC CHECKS ----------------------------- |
| 41 | + |
| 42 | + colnames(rpvDF) <- stringr::str_to_lower(colnames(rpvDF)) |
| 43 | + |
| 44 | + ##### new code (copied from eiExpand lines 40-58) |
| 45 | + # make sure rpvDF argument is defined |
| 46 | + if(is.null(rpvDF)){stop("you must include rpvDF argument")} |
| 47 | + |
| 48 | + # make sure necessary columns are included |
| 49 | + dif <- setdiff(c("party", "voter_race", "estimate", "lower_bound", "upper_bound"), |
| 50 | + colnames(rpvDF)) |
| 51 | + |
| 52 | + if( length(dif) > 0 ) { |
| 53 | + stop(paste("rpvDF is missing the following fields:", |
| 54 | + paste(dif, collapse = ", "))) |
| 55 | + } |
| 56 | + |
| 57 | + # make sure only one party is in rpvDF |
| 58 | + if( length(unique(rpvDF$party)) > 1 ){ |
| 59 | + stop("rpvDF should only contain one unique values in column Party")} |
| 60 | + ##### end QC checks |
| 61 | + |
| 62 | + # ---------------------- Prep Data and Plot Inputs ---------------------- |
| 63 | + |
| 64 | + ##### Voter Race Order ##### |
| 65 | + ##### old code (from Updates_7_1_2024.R) |
| 66 | + # rpvDF$voter_race <- factor(rpvDF$voter_race, levels = race_order) |
| 67 | + ##### new code (copied from eiExpand lines 64-69) |
| 68 | + # proper case for plot |
| 69 | + rpvDF$voter_race <- stringr::str_to_title(rpvDF$voter_race) |
| 70 | + #get factor order if not specified |
| 71 | + if( is.null(race_order) ) { race_order <- sort(unique(rpvDF$voter_race)) } |
| 72 | + #set factor |
| 73 | + rpvDF$voter_race <- factor(rpvDF$voter_race, |
| 74 | + levels = race_order) |
| 75 | + |
| 76 | + ##### Colors ##### |
| 77 | + len_race <- length(unique(rpvDF$voter_race)) |
| 78 | + ##### old code (from Updates_7_1_2024.R) |
| 79 | + # if (is.null(colors)) { |
| 80 | + # if (len_race == 2) { |
| 81 | + # race_colors <- c(viridis::viridis(10)[4], viridis::viridis(10)[7]) |
| 82 | + # names(race_colors) <- race_order |
| 83 | + # ggplot_color_obj <- scale_color_manual(values = race_colors) |
| 84 | + # } |
| 85 | + # else { |
| 86 | + # ggplot_color_obj <- viridis::scale_color_viridis(drop = FALSE, |
| 87 | + # discrete = TRUE, option = "turbo", alpha = 0.8) |
| 88 | + # } |
| 89 | + # } |
| 90 | + ##### new code (copied from eiExpand lines 71-85) |
| 91 | + if( is.null(colors) ){ |
| 92 | + if( len_race == 2 ){ |
| 93 | + race_colors <- c(viridis::viridis(10)[4], viridis::viridis(10)[7]) |
| 94 | + names(race_colors) <- race_order |
| 95 | + |
| 96 | + ggplot_color_obj <- scale_color_manual(values = race_colors) |
| 97 | + |
| 98 | + } else { |
| 99 | + ggplot_color_obj <- viridis::scale_color_viridis(drop = FALSE, |
| 100 | + discrete = TRUE, |
| 101 | + option = "turbo", |
| 102 | + alpha = .8) |
| 103 | + } |
| 104 | + } # END if( is.null(colors) ) |
| 105 | + |
| 106 | + ##### ylab ##### |
| 107 | + if( is.null(ylab) ){ |
| 108 | + prty <- unique(rpvDF$party) %>% stringr::str_to_title() |
| 109 | + ylab <- paste("Percent Voting for", prty, "Candidate") |
| 110 | + } |
| 111 | + |
| 112 | + ##### mean percent vote for label ##### |
| 113 | + mean <- rpvDF %>% |
| 114 | + dplyr::group_by(.data$voter_race) %>% |
| 115 | + dplyr::summarize(avg = mean(.data$estimate)) |
| 116 | + |
| 117 | + rpvDF <- dplyr::left_join(rpvDF, mean, by = "voter_race") |
| 118 | + rpvDF$panelLab <- paste0(rpvDF$voter_race, "\n(mean: ", round(rpvDF$avg,1), "%)") |
| 119 | + |
| 120 | + # -------------------------- Build Plot -------------------------- |
| 121 | + |
| 122 | + coef_plot <- ggplot(rpvDF, |
| 123 | + aes(x = 0, y = 0:100)) + |
| 124 | + scale_y_continuous(breaks = seq(0,100, by = 10), |
| 125 | + limits = c(0, 100), |
| 126 | + labels = sprintf("%0.1f%%", seq(0,100, by = 10)), |
| 127 | + expand = c(0, 0)) + |
| 128 | + geom_hline(yintercept = 50, colour = "#000000", size = 0.75) + # Line at 0 |
| 129 | + geom_pointrange(aes(y = .data$estimate, |
| 130 | + ymin = .data$lower_bound, |
| 131 | + ymax = .data$upper_bound, |
| 132 | + color = .data$voter_race), |
| 133 | + position = position_jitter(width = 0.1), |
| 134 | + size = 2, |
| 135 | + fatten = 1.5, |
| 136 | + show.legend = F) + # Ranges for each coefficient |
| 137 | + ggplot_color_obj + |
| 138 | + facet_grid(~panelLab) + |
| 139 | + labs(y = ylab, |
| 140 | + title = title, |
| 141 | + caption = caption) + # Labels |
| 142 | + theme_minimal() + |
| 143 | + theme(legend.title = element_blank(), |
| 144 | + axis.title.x = element_blank(), |
| 145 | + axis.ticks.x = element_blank(), |
| 146 | + axis.text.x = element_blank(), |
| 147 | + panel.border = element_rect(fill = NA, colour = "grey"), |
| 148 | + panel.grid.major.x = element_blank(), |
| 149 | + panel.grid.minor.x = element_blank(), |
| 150 | + panel.grid.minor.y = element_blank(), |
| 151 | + axis.text.y = element_text(size = 20, face = "bold", family = "serif"), |
| 152 | + axis.title.y = element_text(size = 24, face = "bold", family = "serif"), |
| 153 | + strip.text.x = element_text(size = 15, face = "bold", family = "serif"), |
| 154 | + #strip.text.x = element_blank(), |
| 155 | + title = element_text(size = 30, hjust = .5, face = "bold", family = "serif"), |
| 156 | + plot.caption = element_text(size = 12, face = "italic", family = "serif") |
| 157 | + ) |
| 158 | + |
| 159 | +# -------------------------- Return -------------------------- |
| 160 | + return(coef_plot) |
| 161 | +} |
0 commit comments