Skip to content

Commit

Permalink
Merge pull request #89 from atorus-research/82-messages-expand_test_s…
Browse files Browse the repository at this point in the history
…uite

Add tests for `R/messages.R`
  • Loading branch information
bms63 committed Apr 28, 2023
2 parents d217dec + eab8dff commit 5b45d1c
Show file tree
Hide file tree
Showing 4 changed files with 137 additions and 29 deletions.
2 changes: 2 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,7 @@ export(xportr_type)
export(xportr_write)
import(haven)
import(rlang)
importFrom(cli,cli_alert_danger)
importFrom(cli,cli_alert_info)
importFrom(cli,cli_alert_success)
importFrom(cli,cli_div)
Expand Down Expand Up @@ -47,6 +48,7 @@ importFrom(purrr,map2_chr)
importFrom(purrr,map_chr)
importFrom(purrr,map_dbl)
importFrom(purrr,pluck)
importFrom(purrr,walk)
importFrom(purrr,walk2)
importFrom(readr,parse_number)
importFrom(stringr,str_detect)
Expand Down
64 changes: 38 additions & 26 deletions R/messages.R
Original file line number Diff line number Diff line change
Expand Up @@ -11,11 +11,13 @@
#' @export
xportr_logger <- function(message, type = "none", ...) {

log_fun <- switch(type,
stop = abort,
warn = warn,
message = inform,
return())
log_fun <- switch(
type,
stop = abort,
warn = warn,
message = inform,
return()
)

do.call(log_fun, list(message, ...))

Expand All @@ -30,30 +32,42 @@ xportr_logger <- function(message, type = "none", ...) {
#' @export
var_names_log <- function(tidy_names_df, verbose) {


only_renames <- tidy_names_df %>%
filter(original_varname != renamed_var) %>%
mutate(renamed_msg = paste0("Var ", col_pos, ": '", original_varname,
"' was renamed to '", renamed_var, "'"))
mutate(
renamed_msg = glue(
"Var {col_pos} : '{original_varname}' was renamed to 'renamed_var'"
)
)

# Message regarding number of variables that were renamed/ modified
num_renamed <- nrow(only_renames)
tot_num_vars <- nrow(tidy_names_df)
message("\n")
cli::cli_h2(paste0(num_renamed, " of ", tot_num_vars, " (",
round(100 * (num_renamed / tot_num_vars), 1), "%) variables were renamed"))

cli_h2(glue(
.sep = " ",
"{num_renamed} of {tot_num_vars}",
"({round(100*(num_renamed/tot_num_vars), 1)}%)",
"variables were renamed"
))

# Message stating any renamed variables each original variable and it's new name
if (nrow(only_renames) > 0) message(paste0(paste(only_renames$renamed_msg, collapse = "\n"), "\n"))
if (nrow(only_renames) > 0) {
walk(only_renames$renamed_msg, ~xportr_logger(.x, verbose))
}

# Message checking for duplicate variable names after renamed (Pretty sure
# this is impossible) but good to have a check none-the-less.
dups <- tidy_names_df %>% filter(renamed_n > 1)
if (nrow(dups) != 0) {
cli::cli_alert_danger(
paste("Duplicate renamed term(s) were created. Consider creating dictionary terms for:",
paste(unique(dups$renamed_var), collapse = ", ")
))
cli_alert_danger(
glue(
.sep = " ",
"Duplicate renamed term(s) were created.",
"Consider creating dictionary terms for:",
encode_vars(unique(dups$renamed_var))
)
)
}
}

Expand All @@ -71,8 +85,7 @@ type_log <- function(meta_ordered, type_mismatch_ind, verbose) {

message <- glue(
"Variable type(s) in dataframe don't match metadata: ",
paste0(glue("{encode_vars(meta_ordered[type_mismatch_ind, 'variable'])}"),
collapse = "", sep = " ")
"{encode_vars(meta_ordered[type_mismatch_ind, 'variable'])}"
)

xportr_logger(message, verbose)
Expand All @@ -97,8 +110,10 @@ length_log <- function(miss_vars, verbose) {
cli_alert_success("{ length(miss_vars) } lengths resolved")

xportr_logger(
c("Variable(s) present in dataframe but doesn't exist in `metadata`.",
x = glue("Problem with {encode_vars(miss_vars)}")),
glue(
"Variable(s) present in dataframe but doesn't exist in `metadata`.",
"Problem with {encode_vars(miss_vars)}"
),
type = verbose
)
}
Expand All @@ -112,6 +127,7 @@ length_log <- function(miss_vars, verbose) {
#' @return Output to Console
#' @export
label_log <- function(miss_vars, verbose) {

if (length(miss_vars) > 0) {

cli_h2("Variable labels missing from metadata.")
Expand All @@ -125,7 +141,6 @@ label_log <- function(miss_vars, verbose) {
}
}


#' Utility for Ordering
#'
#' @param moved_vars Variables moved in the dataset
Expand All @@ -135,16 +150,13 @@ label_log <- function(miss_vars, verbose) {
#' @export
var_ord_msg <- function(moved_vars, verbose) {

if (moved_vars > 0) {
if (length(moved_vars) > 0) {
cli_h2("{ length(moved_vars) } variables not in spec and moved to end")
message <- glue(
"Variable reordered in `.df`: ",
paste0(glue("{ encode_vars(moved_vars) }"),
collapse = "", sep = " ")
"Variable reordered in `.df`: { encode_vars(moved_vars) }"
)
xportr_logger(message, verbose)
} else {
cli_h2("All variables in specification file are in dataset")
}

}
6 changes: 3 additions & 3 deletions R/xportr-package.R
Original file line number Diff line number Diff line change
Expand Up @@ -9,13 +9,13 @@
#' everything arrange group_by summarize mutate ungroup case_when distinct
#' tribble all_of
#' @importFrom glue glue glue_collapse
#' @importFrom cli cli_alert_info cli_h2 cli_alert_success cli_alert_info
#' cli_div cli_alert_success cli_text cli_h2
#' @importFrom cli cli_alert_info cli_h2 cli_alert_success cli_div cli_text
#' cli_alert_danger
#' @importFrom tidyselect all_of any_of
#' @importFrom utils capture.output str tail packageVersion
#' @importFrom stringr str_detect str_extract str_replace str_replace_all
#' @importFrom readr parse_number
#' @importFrom purrr map_chr map2_chr walk2 map map_dbl pluck
#' @importFrom purrr map_chr map2_chr walk walk2 map map_dbl pluck
#' @importFrom janitor make_clean_names
#' @importFrom tm stemDocument
#' @importFrom graphics stem
Expand Down
94 changes: 94 additions & 0 deletions tests/testthat/test-messages.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,94 @@
#' Test `R/messages.R` functions

test_that("xportr_logger: Type parameter will create correct message type", {
xportr_logger("A message", type = "none") %>%
expect_silent()

xportr_logger("A message", type = "message") %>%
expect_message("A message")

xportr_logger("A message", type = "warn") %>%
expect_warning("A message")

xportr_logger("A message", type = "stop") %>%
expect_error("A message")

# Supports additional parameters to rlang::stop
xportr_logger("A message", type = "stop", footer = "A footer") %>%
expect_error("A message", class = "rlang_error")
})

test_that("length_log: Missing lengths messages are shown", {
# Remove empty lines in cli theme
withr::local_options(list(cli.user_theme = cli_theme_tests))
app <- cli::start_app(output = "message", .auto_close = FALSE)
withr::defer(cli::stop_app(app))

length_log(c("var1", "var2", "var3"), "message") %>%
expect_message("Variable lengths missing from metadata.") %>%
expect_message("lengths resolved") %>%
expect_message("Problem with `var1`.*`var2`.*`var3`")
})

test_that("length_log: Missing variables messages are shown", {
# Remove empty lines in cli theme
withr::local_options(list(cli.user_theme = cli_theme_tests))
app <- cli::start_app(output = "message", .auto_close = FALSE)
withr::defer(cli::stop_app(app))

label_log(c("var1", "var2", "var3"), "message") %>%
# cli messages
expect_message("Variable labels missing from metadata.") %>%
expect_message("labels skipped") %>%
# xportr_logger messages
expect_message("Problem with `var1`.*`var2`.*`var3`")
})

test_that("var_ord_msg: Reordered variables messages are shown", {
# Remove empty lines in cli theme
withr::local_options(list(cli.user_theme = cli_theme_tests))
app <- cli::start_app(output = "message", .auto_close = FALSE)
withr::defer(cli::stop_app(app))

moved_vars <- c("var1", "var2", "var3")
message_regexp <- "Variable reordered in.+`var1`.+`var2`.+`var3`$"

var_ord_msg(moved_vars, "message") %>%
expect_message("variables not in spec and moved to end") %>%
expect_message(message_regexp)

var_ord_msg(c(), "message") %>%
expect_message("All variables in specification file are in dataset")
})

test_that("var_names_log: Renamed variables messages are shown", {
# Remove empty lines in cli theme
withr::local_options(list(cli.user_theme = cli_theme_tests))
app <- cli::start_app(output = "message", .auto_close = FALSE)
withr::defer(cli::stop_app(app))

tidy_names_df <- data.frame(
original_varname = c("var1", "var2", "var3", "var4", "VAR5", "VAR6"),
renamed_var = c("VAR1", "VAR2", "VAR3", "VAR4", "VAR5", "VAR6"),
col_pos = seq(1, 6),
renamed_msg = glue("renamed message {seq(1, 6)}"),
renamed_n = 0
)

tidy_names_df %>%
mutate(
renamed_n = c(
2,
sample(c(0, 1, 2), size = NROW(.data$renamed_n) - 1, replace = TRUE)
)
) %>%
var_names_log("message") %>%
expect_message(
".*[0-9]+ of [0-9]+ \\([0-9]+(\\.[0-9]+)%\\) variables were renamed.*"
) %>%
expect_message("Var . : '.*' was renamed to '.*'") %>%
expect_message("Var . : '.*' was renamed to '.*'") %>%
expect_message("Var . : '.*' was renamed to '.*'") %>%
expect_message("Var . : '.*' was renamed to '.*'") %>%
expect_message("Duplicate renamed term\\(s\\) were created")
})

0 comments on commit 5b45d1c

Please sign in to comment.