From 8215ba04a8b7af7afaafd48686b5f590a40e3d77 Mon Sep 17 00:00:00 2001 From: DAPPERstats Date: Mon, 4 Nov 2019 00:28:40 -0800 Subject: [PATCH] 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 | 4 ++ NEWS.md | 8 +++ R/gendr.R | 42 ++++--------- R/gendrendr.R | 2 + R/utilities.R | 94 ++++++++++++++++++++++++++++++ README.md | 3 + inst/WORDLIST | 4 +- man/check_type.Rd | 33 +++++++++++ man/get_locale.Rd | 20 +++++++ man/ifnull.Rd | 26 +++++++++ tests/testthat/test-01-utilities.R | 23 ++++++++ 11 files changed, 228 insertions(+), 31 deletions(-) create mode 100644 R/utilities.R create mode 100644 man/check_type.Rd create mode 100644 man/get_locale.Rd create mode 100644 man/ifnull.Rd create mode 100644 tests/testthat/test-01-utilities.R diff --git a/NAMESPACE b/NAMESPACE index bd9adea..bbbaac2 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index 3c5b623..45bfa9d 100644 --- a/NEWS.md +++ b/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* diff --git a/R/gendr.R b/R/gendr.R index 0fee1b6..3e19ceb 100644 --- a/R/gendr.R +++ b/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)} diff --git a/R/gendrendr.R b/R/gendrendr.R index 7d63b0f..6edfaae 100644 --- a/R/gendrendr.R +++ b/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 diff --git a/R/utilities.R b/R/utilities.R new file mode 100644 index 0000000..e25fd67 --- /dev/null +++ b/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 +} + + + diff --git a/README.md b/README.md index 34f4b2c..fe5dd15 100644 --- a/README.md +++ b/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. diff --git a/inst/WORDLIST b/inst/WORDLIST index 833de2e..601cd56 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -3,9 +3,10 @@ Codecov culurues DOI ender -enders +Enders github Instantiation +Leong LGBTQIAinSTEM Lifecycle medicalized @@ -13,6 +14,7 @@ moreso NBinSTEM neutrois oppressions +pkgdown retraumatizing Rstats spatiotemporally diff --git a/man/check_type.Rd b/man/check_type.Rd new file mode 100644 index 0000000..3ff530d --- /dev/null +++ b/man/check_type.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.R +\name{check_type} +\alias{check_type} +\title{Verify that a value input is of appropriate type} +\usage{ +check_type(x, type) +} +\arguments{ +\item{x}{Focal input.} + +\item{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)/} +} +\value{ +\code{NULL} if \code{x} is proper, throwing an error otherwise. +} +\description{ +Throws an error if \code{x} isn't proper, based on the + \code{type}. +} +\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 + +} diff --git a/man/get_locale.Rd b/man/get_locale.Rd new file mode 100644 index 0000000..bd0bd31 --- /dev/null +++ b/man/get_locale.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.R +\name{get_locale} +\alias{get_locale} +\title{Get the language and location of a system locale} +\usage{ +get_locale() +} +\value{ +\code{character} vector with elements \code{"language"} and + \code{"location"}. +} +\description{ +OS-flexible approach to determining the system locale with + respect to language and location. +} +\examples{ + get_locale() + +} diff --git a/man/ifnull.Rd b/man/ifnull.Rd new file mode 100644 index 0000000..1ac3add --- /dev/null +++ b/man/ifnull.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.R +\name{ifnull} +\alias{ifnull} +\title{Replace a value with an alternative if it is NULL} +\usage{ +ifnull(x = NULL, alt = NULL) +} +\arguments{ +\item{x}{Focal input.} + +\item{alt}{Alternative value.} +} +\value{ +\code{x} if not \code{NULL}, \code{alt} otherwise. +} +\description{ +Replaces the focal input with the alternative value if it + is \code{NULL}. +} +\examples{ + ifnull(NULL, 123) + ifnull(TRUE, 123) + ifnull(FALSE, 123) + +} diff --git a/tests/testthat/test-01-utilities.R b/tests/testthat/test-01-utilities.R new file mode 100644 index 0000000..44cd6d8 --- /dev/null +++ b/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") +}) \ No newline at end of file