Fix for wru (#140)

* add warning and force age-sex to be false

* bugfix for new wru

* docs for ei_homog, fix not in map_interactive

* bugfix map_interactive

* remove license note

* catch other uses of merge_surnames

DESCRIPTION

@@ -38,7 +38,7 @@ Authors@R:
              comment = c(ORCID = "0000-0003-2423-6395")))
 URL: https://github.com/RPVote/eiCompare
 Description: Compares estimates from three ecological inference routines, based on King (1997) <ISBN: 0691012407>, <https://gking.harvard.edu/eicamera/kinroot.html>; King et. al. (2004) <ISBN: 0521542804>, <https://gking.harvard.edu/files/abs/ecinf04-abs.shtml>.
-License: GPL-3
+License: GPL-3 + file LICENSE
 Depends: R (>= 3.5.0), eiPack, ei, wru
 Imports: censusxy, bayestestR, coda, data.table, doParallel, doSNOW,
         dplyr, foreach, ggplot2, graphics, magrittr, mcmcse, methods,
@@ -47,7 +47,7 @@ Imports: censusxy, bayestestR, coda, data.table, doParallel, doSNOW,
 NeedsCompilation: no
 Suggests: knitr, opencage, plyr, rmarkdown, reshape2, RColorBrewer,
         RJSONIO, testthat, tigris
-RoxygenNote: 7.1.1
+RoxygenNote: 7.2.1
 Encoding: UTF-8
 VignetteBuilder: knitr
 Packaged: 2020-09-08 07:00:35 UTC; lorencollingwood
@@ -60,3 +60,4 @@ Author: Loren Collingwood [aut, cre] (<https://orcid.org/0000-0002-4447-8204>),
   Spencer Wood [ctb] (<https://orcid.org/0000-0002-5794-2619>),
   Matt Barreto [ctb] (<https://orcid.org/0000-0003-2423-6395>)
 Maintainer: Loren Collingwood <[email protected]>
+LazyData: true

NAMESPACE

@@ -28,7 +28,6 @@ export(lambda_two_compare)
 export(latlong2fips)
 export(map_interactive)
 export(map_shape_file)
-export(map_shape_points)
 export(mbd_two)
 export(mbd_two_minority)
 export(md_bayes_draw)
@@ -116,7 +115,6 @@ importFrom(stats,na.omit)
 importFrom(stats,quantile)
 importFrom(stats,sd)
 importFrom(stats,setNames)
-importFrom(stats,weighted.mean)
 importFrom(stringr,str_c)
 importFrom(stringr,str_count)
 importFrom(stringr,str_detect)
@@ -131,6 +129,7 @@ importFrom(tidyr,replace_na)
 importFrom(tidyr,separate)
 importFrom(tidyselect,all_of)
 importFrom(utils,capture.output)
+importFrom(utils,getFromNamespace)
 importFrom(utils,read.table)
 importFrom(utils,setTxtProgressBar)
 importFrom(utils,tail)

R/ei_homog.R

@@ -11,11 +11,12 @@
 #' @param race_cols A character vector listing the column names for turnout by race
 #' @param totals_col The name of the column containing total votes cast in each precinct
 #' @param cp numeric; homogeneous precinct cut-point, e.g., 0.80; default = 0.80
-#' @warn_row = numeric; threshold number of precincts racial group must be above to 
+#' @param warn_row = numeric; threshold number of precincts racial group must be above to 
 #' conduct analysis; default = 5. For example, with three groups, whites, blacks, Hispanics, 
 #' each group must have at least 5 precincts with at least 80% share of the population for 
 #' that group. All racial groups need to have at least n number of precincts at or above 
 #' warn_row level or error will be thrown.
+#' @param verbose A boolean indicating whether to print out status messages.
 #' @return matrix with homogeneous precinct results, columns = race groups, rows = candidates
 #' @author Loren Collingwood <loren.collingwood@@ucr.edu>; <loren.collingwood@@gmail.com>
 #' @author Stephen Popick

R/map_interactive.R

@@ -42,7 +42,7 @@ map_interactive <-  function(voter_file,
          latitude = "lat",
          longitude = "lon") {
 
-    if (class(voter_file) == "data.frame" & any(colnames(voter_file) == "geometry")) {
+    if (is.data.frame(voter_file) & any(colnames(voter_file) == "geometry")) {
         voter_file <- tidyr::extract(voter_file,
                                      .data$geometry,
                                      into = c("lat", "lon"), "\\((.*),(.*)\\)",

R/surname_utils.R

@@ -132,6 +132,7 @@ get_multi_barreled_surnames <- function(voter_file,
 #' @return A vector of logicals denoting a match or not.
 #'
 #' @export surname_match
+#' @importFrom utils getFromNamespace
 surname_match <- function(voter_file,
                           surname_col = "last_name",
                           strip_special = FALSE) {
@@ -142,6 +143,7 @@ surname_match <- function(voter_file,
       replace = ""
     )
   }
+
   # Determine if there's a surname match
   surname_match <- voter_file[[surname_col]] %in% wru::surnames2010$surname
   return(surname_match)
@@ -224,6 +226,7 @@ surname_summary <- function(voter_file, surname_col) {
 #' @return A vector of probabilities for each surname.
 #'
 #' @export predict_race_multi_barreled
+#' @importFrom utils getFromNamespace
 predict_race_multi_barreled <- function(voter_file,
                                         surname_col = "last_name",
                                         surname_only = TRUE,
@@ -248,12 +251,15 @@ predict_race_multi_barreled <- function(voter_file,
     surnames <- surnames[!(surnames %in% remove_patterns)]
   }
 
+  # Get merge_surnames function out from wru
+  merge_surnames_copy <- utils::getFromNamespace("merge_surnames", "wru")
+
   # Use surname only
   if (surname_only) {
     new_voter_file <- data.frame(surname = surnames)
     # Calculate probabilities using surnames only
     probabilities <- suppressWarnings(
-      wru::merge_surnames(
+      merge_surnames_copy(
         voter.file = new_voter_file,
         surname.year = 2010,
         clean.surname = FALSE,
@@ -270,7 +276,7 @@ predict_race_multi_barreled <- function(voter_file,
       tract = voter_file[[tract]],
       block = voter_file[[block]]
     )
-
+    
     # Predict race using full BISG
     invisible(capture.output(
       bisg <- suppressWarnings(

R/wru_predict_race_wrapper.R

@@ -40,6 +40,7 @@
 #' @export wru_predict_race_wrapper
 #' @import wru
 #' @importFrom dplyr relocate
+#' @importFrom utils getFromNamespace
 wru_predict_race_wrapper <- function(voter_file,
                                      census_data,
                                      voter_id = NULL,
@@ -67,14 +68,27 @@ wru_predict_race_wrapper <- function(voter_file,
     tract = tract,
     block = block
   )
-
+
+  # Temporary check to force use_sex and use_age into FALSE
+  if (use_age) {
+    warning("age is currently disabled in wru... forcing use_age to be FALSE")
+    use_age <- FALSE
+  }
+  if (use_sex) {
+    warning("sex is currently disabled in wru... forcing use_sex to be FALSE")
+    use_sex <- FALSE
+  }
+
+  # Get merge_surnames function out from wru
+  merge_surnames_copy <- utils::getFromNamespace("merge_surnames", "wru")
+
   # If necessary, check which surnames matched
   if (return_surname_flag) {
     if (verbose) {
       message("Matching surnames.")
     }
     merged_surnames <- suppressWarnings(
-      wru::merge_surnames(
+      merge_surnames_copy(
         voter.file = wru_voter_file,
         surname.year = surname_year,
         clean.surname = TRUE,
@@ -167,7 +181,7 @@ wru_predict_race_wrapper <- function(voter_file,
     # Use probabilities from surnames only for those that don't match
     invisible(capture.output(
       no_match_surnames <- suppressWarnings(
-        wru::merge_surnames(
+        merge_surnames_copy(
           voter.file = wru_voter_file[no_match_final, ],
           surname.year = surname_year,
           clean.surname = TRUE,

tests/testthat/test_wru_predict_race_wrapper.R

@@ -14,7 +14,7 @@ test_that("WRU wrapper correctly calculates probabilities.", {
 
   # Load Rockland county Census information
   data(rockland_census)
-
+  rockland_census$NY$year <- 2010
   # Run predict race wrapper function
   bisg <- wru_predict_race_wrapper(
     voter_file = voter_file,

vignettes/bisg.Rmd

@@ -51,7 +51,7 @@ suppressPackageStartupMessages({
 })
 ```
 
-Load in census data, the shape file and geocoded voter registation data with latitude and longitude coordinates.
+Load in census data, the shape file and geocoded voter registration data with latitude and longitude coordinates.
 ```{r}
 # Load Georgia census data
 data(georgia_census)
@@ -123,6 +123,8 @@ class(voter_file_complete)
 ```
 
 ```{r}
+georgia_census$GA$year <- 2010
+
 # Perform BISG
 bisg_df <- eiCompare::wru_predict_race_wrapper(
   voter_file = voter_file_complete,

vignettes/performance_analysis.Rmd

@@ -165,6 +165,8 @@ Since New York state does not report race on the voter file, we need to estimate
 # Load Rockland County Census information
 data(rockland_census)
 
+rockland_census$NY$year <- 2010
+
 # Apply BISG to the voter file to get race predictions
 voter_file_with_race <- eiCompare::wru_predict_race_wrapper(
   voter_file = as.data.frame(voter_file_w_ward),