increased integration and use of utility functioning

### Patch to handle empty inputs on Mac OS & Solaris
* The LC environmental variables are concatenated using different characters.
* Simplifying the checking

### Intro of utilities functions
* `ifnull` to do the replacement if a value is null.
* `check_type` to do simple error checking based on type (a generalization of the R classes of objects).
* `get_locale` as way to do OS-agnostic language and location of a system locale.

NAMESPACE

@@ -1,4 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
+export(check_type)
 export(gendr)
 export(gendr_warning)
+export(get_locale)
+export(ifnull)
+importFrom(stats,setNames)

NEWS.md

@@ -7,6 +7,14 @@ Version numbers follow [Semantic Versioning](https://semver.org/).
 
 ### Minor editing to pkgdown site
 
+### Patch to handle empty inputs on Mac OS & Solaris
+* The LC environmental variables are concatenated using different characters.
+
+### Intro of utilities functions
+* `ifnull` to do the replacement if a value is null.
+* `check_type` to do simple error checking based on type (a generalization of the R classes of objects).
+* `get_locale` as way to do OS-agnostic language and location of a system locale.
+
 # [gendrendr 0.1.4](https://github.com/dapperstats/gendrendr/releases/tag/v0.1.4)
 *2019-11-02*
 

R/gendr.R

@@ -43,32 +43,18 @@
 gendr <- function(names = NULL, locations = NULL, languages = NULL, 
                   years = NULL, methods = "standard"){
 
-  system <- switch(Sys.info()[["sysname"]], 
-                   Windows = "Win", Darwin = "Mac", Linux = "Linux")
-  lc <- Sys.getlocale()
-  lc <- ifelse(system == "Mac", strsplit(lc, "/"), strsplit(lc, ";"))[[1]][1]
-  lc <- setNames(Reduce(c, strsplit(sub(".*=", "", lc), "_")), c("language", "location"))
+  locale <- get_locale()
+  names <- ifnull(names, Sys.info()[["user"]])
+  languages <- ifnull(languages, locale["language"])
+  locations <- ifnull(locations, locale["location"])
+  years <- ifnull(years, as.numeric(format(Sys.time(), "%Y")))
 
-  names <- names %||% Sys.info()[["user"]]
-  languages <- languages %||% lc["language"]
-  locations <- locations %||% lc["location"]
-  years <- years %||% as.numeric(format(Sys.time(), "%Y"))
-
-  if(!is.character(names)){
-    stop("`names` must be characters", call. = FALSE)
-  }
-  if(!is.character(languages)){
-    stop("`languages` must be characters", call. = FALSE)
-  }
-  if(!is.character(locations)){
-    stop("`locations` must be characters", call. = FALSE)
-  }
-  if(!is.character(methods)){
-    stop("`methods` must be characters", call. = FALSE)
-  }
-  if(!is.numeric(years) || any(years %% 1 != 0)){
-    stop("`years` must be integer conformable numbers", call. = FALSE)
-  }
+  check_type(names, "character")
+  check_type(languages, "character")
+  check_type(locations, "character")
+  check_type(methods, "character")
+  check_type(years, "integer")
+
   gendr_warning()
   expand.grid(name = names, location = locations, language = languages, 
               method = methods, year = years, gender = "?")
@@ -84,11 +70,7 @@ gendr_warning <- function(){
             "if it is important to know someone's gender, ask them",
             "assigning genders is inherently inaccurate",
             "gender is an evolving and variable human construct",
-            "consider the impact on individuals for whom your assumptions are wrong")
+     "consider the impact on individuals for whom your assumptions are wrong")
   warning(sample(msgs, 1), call. = FALSE, immediate. = TRUE)
 }
 
-
-#' @noRd
-#' 
-`%||%` <- function(lhs, rhs) {ifelse(!is.null(lhs), lhs, rhs)}

R/gendrendr.R

@@ -1,3 +1,5 @@
+#' @importFrom stats setNames
+
 #' @title Ending Gender Application
 #'
 #' @description This package contains a simple set of functions designed to

R/utilities.R

@@ -0,0 +1,94 @@
+#' @title Replace a value with an alternative if it is NULL
+#'
+#' @description Replaces the focal input with the alternative value if it
+#'   is \code{NULL}. 
+#'
+#' @param x Focal input.
+#'
+#' @param alt Alternative value.
+#'
+#' @return \code{x} if not \code{NULL}, \code{alt} otherwise. 
+#' 
+#' @examples
+#'  ifnull(NULL, 123)
+#'  ifnull(TRUE, 123)
+#'  ifnull(FALSE, 123)
+#'
+#' @export 
+#'
+ifnull <- function(x = NULL, alt = NULL){
+  if(is.null(x)){
+    x <- alt
+  }
+  x
+}
+
+#' @title Verify that a value input is of appropriate type
+#'
+#' @description Throws an error if \code{x} isn't proper, based on the 
+#'  \code{type}. 
+#'
+#' @param x Focal input.
+#'
+#' @param type Type of input that \code{x} should be. Presently available 
+#'  are \code{"character"} (standard) and \code{"integer"} (conformable to
+#'  an integer if not explicitly classed as such)/
+#'
+#' @return \code{NULL} if \code{x} is proper, throwing an error otherwise.
+#' 
+#' @examples
+#'  names <- "sam"
+#'  check_type(x = names, type = "character")
+#'  names <- 2019
+#'  #check_type(x = names, type = "character") # throws error
+#'  years <- 2019
+#'  check_type(x = years, type = "integer")
+#'  years <- "sam"
+#'  #check_type(x = years, type = "integer") # throws error
+#'
+#' @export 
+#'
+check_type <- function(x, type){
+  xname <- as.character((match.call())[["x"]])
+  testexpr <- switch(type,
+                     "character" = !is.character(x),
+                     "integer" = !is.numeric(x) || any(x %% 1 != 0))
+  msg <- switch(type, 
+                "character" = paste0("'`", xname, "` must be characters'"),
+                "integer" = paste0("'`", xname, "` must be integers'"))
+  if(testexpr){
+    stop(msg, call. = FALSE)
+  }
+  invisible(NULL)
+}
+
+#' @title Get the language and location of a system locale
+#'
+#' @description OS-flexible approach to determining the system locale with 
+#'  respect to language and location.
+#'
+#' @return \code{character} vector with elements \code{"language"} and 
+#'  \code{"location"}. 
+#' 
+#' @examples
+#'  get_locale()
+#'
+#' @export 
+#'
+get_locale <- function(){
+  ismac <- Sys.info()["sysname"] == "Darwin"
+  issolaris <- Sys.info()["sysname"] == "SunOS"
+  splitchar <- ifelse(ismac | issolaris, "/", ";")
+  locale <- Sys.getlocale()
+  lc_type <- "LC_TIME"
+  locale <- strsplit(locale, splitchar)[[1]]
+  locale <- locale[grep(lc_type, locale)]
+  locale <- sub(".*=", "", locale)
+  locale <- strsplit(locale, "_")[[1]]
+  locale <- setNames(locale, c("language", "location"))
+  locale[["location"]] <- sub("\\..*", "", locale[["location"]])
+  locale
+}
+
+
+

README.md

@@ -57,6 +57,9 @@ gendr()
 
 If you are interested in contributing, see the [Contributor Guidelines](https://github.com/dapperstats/gendrendr/blob/master/CONTRIBUTING.md) and [Code of Conduct](https://github.com/dapperstats/gendrendr/blob/master/CODE_OF_CONDUCT.md).
 
+The following individuals made small contributions to the code:
+* Chuck Leong
+
 ## About the name and logo
 
 The package is a counter to and commentary on the perpetuation of gender stereotypes in the study of gender. 

inst/WORDLIST

@@ -3,16 +3,18 @@ Codecov
 culurues
 DOI
 ender
-enders
+Enders
 github
 Instantiation
+Leong
 LGBTQIAinSTEM
 Lifecycle
 medicalized
 moreso
 NBinSTEM
 neutrois
 oppressions
+pkgdown
 retraumatizing
 Rstats
 spatiotemporally

tests/testthat/test-01-utilities.R

@@ -0,0 +1,23 @@
+context("Test utility functions")
+
+test_that("ifnull", {
+  expect_equal(ifnull(NULL, 123), 123)
+  expect_equal(ifnull(TRUE, 123), TRUE)
+})
+
+
+test_that("check_type", {
+  names <- "sam"
+  expect_silent(check_type(x = names, type = "character"))
+  names <- 2019
+  expect_error(check_type(x = names, type = "character"))
+  years <- 2019
+  expect_silent(check_type(x = years, type = "integer"))
+  years <- "sam"
+  expect_error(check_type(x = years, type = "integer"))
+})
+
+test_that("get_locale", {
+  expect_equal(length(get_locale()), 2)
+  expect_is(get_locale(), "character")
+})