unit test match funs

DESCRIPTION

@@ -21,4 +21,4 @@ Encoding: UTF-8
 LazyData: true
 Suggests: 
     testthat
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.3

NAMESPACE

@@ -11,7 +11,9 @@ export(get_png)
 export(grade_level_to_num)
 export(has_caption)
 export(make_logo_grob)
+export(match_test)
 export(measure_caption)
+export(na_sum)
 export(na_zero)
 export(nvals)
 export(plot_jpeg)

R/join_utilities.R

@@ -0,0 +1,48 @@
+# Join utilities
+#' Test the join between two sets of identifiers
+#'
+#' @param x a vector of identifiers to check against y
+#' @param y a vector of identifiers to check against x
+#' @param distinct logical, should duplicate values of x and y be removed before testing
+#'
+#' @return
+#' @export
+#'
+#' @examples
+#' x <- LETTERS
+#' y <- c(letters, LETTERS)
+#' match_test(x, y)
+match_test <- function(x, y, distinct = TRUE) {
+  if (distinct) {
+    x <- unique(x)
+    y <- unique(y)
+    cat("**** Distinct Matches ****")
+    cat("\n")
+
+  }
+
+  # TODO: DO not report 100% if there is even 1 mismatch
+
+  xiny <- sum(x %in% y)
+  total_x <- length(x)
+
+  yinx <- sum(y %in% x)
+  total_y <- length(y)
+
+  cat("**** Match Summary ****")
+  cat("\n")
+  cat("X in Y")
+  cat("\n")
+  cat(paste0("Of the ", total_x, " X values, ", xiny, " (",
+             100*round(xiny/total_x, 2), "%) were matched."))
+  cat("\n")
+  cat("********************************************")
+  cat("\n")
+  cat("Y in X")
+  cat("\n")
+  cat(paste0("Of the ", total_y, " Y values, ", yinx, " (",
+             100*round(yinx/total_y, 2), "%) were matched."))
+  cat("\n")
+  cat("******************************************")
+
+}

R/utils.R

@@ -146,4 +146,20 @@ race_short_names <- function(x) {
   return(x)
 }
 
+#' Sum a numeric that contains missing values and ignore missing values
+#'
+#' @param x a numeric vector
+#'
+#' @return the sum, ignoring any missing values
+#' @export
+#'
+#' @examples
+#' x <- c(2, NA, 4, 9)
+#' na_sum(x) # 15
+na_sum <- function(x) {
+  stopifnot(is.numeric(x))
+  message("Taking a sum with missing values equal to 0, be careful 🐲")
+  x <- na_zero(x)
+  return(sum(x))
+}
 

man/match_test.Rd

@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/join_utilities.R
+\name{match_test}
+\alias{match_test}
+\title{Test the join between two sets of identifiers}
+\usage{
+match_test(x, y, distinct = TRUE)
+}
+\arguments{
+\item{x}{a vector of identifiers to check against y}
+
+\item{y}{a vector of identifiers to check against x}
+
+\item{distinct}{logical, should duplicate values of x and y be removed before testing}
+}
+\description{
+Test the join between two sets of identifiers
+}
+\examples{
+x <- LETTERS
+y <- c(letters, LETTERS)
+match_test(x, y)
+}

man/na_sum.Rd

@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{na_sum}
+\alias{na_sum}
+\title{Sum a numeric that contains missing values and ignore missing values}
+\usage{
+na_sum(x)
+}
+\arguments{
+\item{x}{a numeric vector}
+}
+\value{
+the sum, ignoring any missing values
+}
+\description{
+Sum a numeric that contains missing values and ignore missing values
+}
+\examples{
+x <- c(2, NA, 4, 9)
+na_sum(x) # 15
+}

tests/testthat/test_joins.R

@@ -0,0 +1,15 @@
+
+
+#' x <- LETTERS
+#' y <- c(letters, LETTERS)
+#' match_test(x, y)
+#'
+#'
+context("Test Basic Output for match_test")
+
+test_that("pretty_per respects rounding", {
+  x <- LETTERS
+  y <- c(letters, LETTERS)
+  testthat::expect_output(match_test(x, y))
+
+})

tests/testthat/test_utils.R

@@ -47,6 +47,18 @@ test_that("Function subs out NAs in numeric vectors with 0", {
   expect_equivalent(na_zero(c(1:10, NA)), c(1:10, 0))
 })
 
+# Test that na_sum works
+test_that("NA Sum takes sum setting NA values to 0", {
+  expect_equivalent(na_sum(c(1:10, NA)), sum(1:10, 0))
+  expect_message(na_sum(c(1:10, NA)), "Taking a sum with missing values equal to 0, be careful 🐲")
+})
+
+test_that("na_sum fails with non-numerics", {
+  expect_error(na_sum(LETTERS))
+  expect_error(na_sum(as.factor(1:10)))
+})
+
+
 context("Test Utilities - Pretty Count")