eiCompare/R/overlay_density_plot.R at master · RPVote/eiCompare · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
#' overlay_density_plot
#'
#' Internal
#'
#' @param agg_betas Output for RxC and iterative ei
#' @param results_table Summary table for candidate race pair means and se's
#' @param race_cols A character vector listing the column names for turnout by race
#' @param cand_cols A character vector listing the column names for turnout for each candidate
#' @param plot_path Path to save
#' @param ei_type Specify whether the data comes from iterative ei ("ei") or rxc ("rxc")
#' @return Prep and run density plot creation iteratively
#' @author Loren Collingwood <lcollingwood@@unm.edu>
#' @author Hikari Murayama
#'
#' @importFrom foreach %dopar% %do%
#'
#' @export
#'


overlay_density_plot <- function(agg_betas, results_table, race_cols, cand_cols, plot_path, ei_type) {
  # Set new variables to NULL
  k <- Candidate <- value <- m <- NULL


  race <- race_cols
  cands <- cand_cols

  if (tolower(ei_type) == "ei") {
    # Extract beta bs
    agg_betas <- agg_betas[, grep("bbgg", colnames(agg_betas))]
    colnames(agg_betas) <- gsub("bbgg_", "", colnames(agg_betas))
  } else if (tolower(ei_type) == "rxc") {
    colnames(agg_betas) <- gsub("betas.", "", colnames(agg_betas))
    colnames(agg_betas) <- gsub("\\.", "_", colnames(agg_betas))
  } else {
    stop("Specify ei_type as ei or rxc")
  }


  # Designate colors for each candidate
  # Designate color blind friendly scale
  # from Color University Design at University of Tokyo
  color_scale <- c("#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7", "#999999")
  # Repeat twice so can accomodate up to 16 candidates (with repeating colors)
  color_scale <- c(color_scale, color_scale)
  color_choice <- as.list(color_scale[1:length(unique(cands))])
  cand_colors <- stats::setNames(color_choice, as.list(gsub("pct_", "", cands)))

  # go through each
  # Iterate through every race...
  pb <- utils::txtProgressBar(
    min = 0,
    max = length(race),
    style = 3
  )
  progress <- function(n) setTxtProgressBar(pb, n)
  opts <- list(progress = progress)

  out_all <- foreach::foreach(
    k = 1:length(race),
    .combine = rbind,
    .inorder = TRUE,
    .packages = c("overlapping", "ggplot2"),
    .options.snow = opts
  ) %do% {
    # Keep columns for race[k]
    race_comb <- agg_betas[, grep(race[k], colnames(agg_betas))]

    # Column titles
    colnames(race_comb) <- gsub(paste(race[k], "_", sep = ""), "", colnames(race_comb))

    # Set up data to create graphs
    dens_data <- reshape2::melt(race_comb, id.vars = NULL)

    if (ncol(dens_data) == 3) {
      dens_data <- dens_data[, c(2:3)]
    }
    colnames(dens_data) <- c("Candidate", "value")

    out <- dens_data %>%
      dplyr::group_by(Candidate) %>%
      dplyr::summarize(
        sd_size = sd(value * 100, na.rm = TRUE),
        min_size = min(value * 100, na.rm = TRUE),
        max_size = max(value * 100, na.rm = TRUE),
        .groups = "drop",
      )
    out <- data.frame(out)

    # Join with mean from results_table
    if (ei_type == "ei") {
      rt_sub <- results_table[!(results_table$Candidate %in% c("se", "Total")), c("Candidate", race[k])]
      colnames(rt_sub) <- c("Candidate", "mean_size")
    } else if (ei_type == "rxc") {
      dens_data <- as.data.frame(dens_data[, c("Candidate", "value")])

      rt_sub <- as.data.frame(results_table[race[k]][[1]])
      rt_sub$Candidate <- rownames(rt_sub)
      rt_sub <- dplyr::rename(rt_sub, mean_size = mean)
      rt_sub <- rt_sub[, c("Candidate", "mean_size")]
    }


    out <- dplyr::inner_join(rt_sub, out, by = "Candidate")
    out$sd_minus <- out$mean_size - out$sd_size
    out$sd_plus <- out$mean_size + out$sd_size

    dens_data$Candidate <- gsub("pct_", "", dens_data$Candidate)
    out$Candidate <- gsub("pct_", "", out$Candidate)

    # Create pairs of candidates to comapre
    cand_comb <- utils::combn(cands, 2)

    # Make density plot for each pair
    dens_plots <- foreach::foreach(m = 1:ncol(cand_comb)) %do% {
      dens_plot <- od_plot_create(
        race = race[k], cand_pair = c(cand_comb[1, m], cand_comb[2, m]),
        dens_data, out, plot_path = plot_path, cand_colors
      )
    }

    setTxtProgressBar(pb, k)
  }
  # close progress bar
  close(pb)

  # Change functionalist to return plots later if needed
  return(out_all)
}