unit test match funs
Gitea Organization/civilyticsR/pipeline/head This commit looks good

This commit is contained in:
Jared Knowles
2023-07-19 17:37:18 -04:00
parent a0b4abdb9e
commit 9acebb5133
8 changed files with 138 additions and 1 deletions
+48
View File
@@ -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("******************************************")
}
+16
View File
@@ -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))
}