Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Update reorder messaging #104

Merged
merged 9 commits into from
May 12, 2023
Merged
5 changes: 3 additions & 2 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,7 +1,8 @@
# xportr 0.3.0
* Fixed an issue where xportr_type would overwrite column labels, widths, and "sas.formats"
* Add new argument to `xportr_write` to allow users to specify how xpt validation checks are handled.

* Fixed an issue where `xportr_type` would overwrite column labels, widths, and "sas.formats"
* Fixed messaging of `xportr_order`to give better visability of the number of variables being reordered.
* Add new argument to `xportr_write` to allow users to specify how xpt validation checks are handled.
* Fixed bug where character_types were case sensitive. They are now case insensitive.
* Updated `xportr_type` to make type coercion more explicit.

Expand Down
17 changes: 14 additions & 3 deletions R/messages.R
Original file line number Diff line number Diff line change
Expand Up @@ -134,19 +134,30 @@ label_log <- function(miss_vars, verbose) {

#' Utility for Ordering
#'
#' @param moved_vars Variables moved in the dataset
#' @param reordered_vars Number of variables reordered
#' @param moved_vars Number of variables moved in the dataset
#' @param verbose Provides additional messaging for user
#'
#' @return Output to Console
#' @export
var_ord_msg <- function(moved_vars, verbose) {
var_ord_msg <- function(reordered_vars, moved_vars, verbose) {
if (length(moved_vars) > 0) {
cli_h2("{ length(moved_vars) } variables not in spec and moved to end")
message <- glue(
"Variable reordered in `.df`: { encode_vars(moved_vars) }"
"Variable moved to end in `.df`: { encode_vars(moved_vars) }"
)
xportr_logger(message, verbose)
} else {
cli_h2("All variables in specification file are in dataset")
}

if (length(reordered_vars) > 0) {
cli_h2("{ length(reordered_vars) } reordered in dataset")
message <- glue(
"Variable reordered in `.df`: { encode_vars(reordered_vars) }"
)
xportr_logger(message, verbose)
} else {
cli_h2("All variables in dataset are ordered")
}
}
9 changes: 4 additions & 5 deletions R/order.R
Original file line number Diff line number Diff line change
Expand Up @@ -63,14 +63,13 @@ xportr_order <- function(.df, metacore, domain = NULL, verbose = getOption("xpor
drop_vars <- .df %>%
select(!any_of(vars_in_spec_ds))

# Used in warning message for how many vars have been moved
moved_vars <- ncol(drop_vars)
ordered_vars <- ncol(ord_vars)

df_re_ord <- bind_cols(ord_vars, drop_vars)

# Used in warning message for how many vars have been moved
reorder_vars <- names(df_re_ord)[names(df_re_ord) != names(.df)]

# Function is located in messages.R
var_ord_msg(moved_vars, verbose)
var_ord_msg(reorder_vars, names(drop_vars), verbose)

df_re_ord
}
6 changes: 4 additions & 2 deletions man/var_ord_msg.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

17 changes: 0 additions & 17 deletions tests/testthat/test-messages.R
Original file line number Diff line number Diff line change
Expand Up @@ -44,23 +44,6 @@ test_that("length_log: Missing variables messages are shown", {
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))
Expand Down
38 changes: 38 additions & 0 deletions tests/testthat/test-order.R
Original file line number Diff line number Diff line change
Expand Up @@ -90,3 +90,41 @@ test_that("xportr_order: Expect error if domain is not a character", {
expect_error(xportr_order(df, df_meta, domain = NA, verbose = "none"))
expect_error(xportr_order(df, df_meta, domain = 1, verbose = "none"))
})

test_that("xportr_order: Variable ordering messaging is correct", {
output_file <- tempfile()

df <- data.frame(c = 1:5, a = "a", d = 5:1, b = LETTERS[1:5])
df2 <- data.frame(a = "a", z = "z")
df_meta <- data.frame(
dataset = "df",
variable = letters[1:4],
order = 1:4
)

capture.output(xportr_order(df, df_meta, verbose = "message"), file = output_file, type = "message")

expect_equal(
readLines(output_file),
c(
"-- All variables in specification file are in dataset --",
"",
"-- 4 reordered in dataset --",
"",
"Variable reordered in `.df`: `a`, `b`, `c`, and `d`"
)
)

capture.output(xportr_order(df2, df_meta, verbose = "message"), file = output_file, type = "message")

expect_equal(
readLines(output_file),
c(
"-- 2 variables not in spec and moved to end --",
"",
"Variable moved to end in `.df`: `a` and `z`",
"-- All variables in dataset are ordered --",
""
)
)
})