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.

Sign up for GitHub

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

Jump to bottom

Closes #175 Adds assertions to exported functions #190

Merged
merged 36 commits into from
Jan 23, 2024
Merged

Closes #175 Adds assertions to exported functions #190

Show file tree
Hide file tree
Changes from 32 commits
Commits
Show all changes
36 commits
Select commit Hold shift + click to select a range
e074d2f
feat: introducing checkmate to label
averissimo Nov 23, 2023
be353a6
feat: checkmate support in df_label
averissimo Nov 23, 2023
9c0ab66
feat: checkmate support in format
averissimo Nov 23, 2023
7eee740
feat: checkmate support in length and messages
averissimo Nov 23, 2023
b778b78
feat: checkmate support in metadata
averissimo Nov 23, 2023
68bea69
feat: checkmate support in order
averissimo Nov 23, 2023
7913b21
feat: checkmate support in type
averissimo Nov 23, 2023
a6d565c
feat: checkmate support in write
averissimo Nov 23, 2023
f50346b
feat: adds assertion to exported functions
averissimo Nov 23, 2023
d59c241
fix: problem with xportr_logger
averissimo Nov 23, 2023
531f706
fix: move assert dataframe up
averissimo Nov 30, 2023
14b006d
styler: remove empty space
averissimo Nov 30, 2023
9c0b997
feat: assert parameters on xportr_domain_name
averissimo Dec 5, 2023
7c22c3d
Merge branch '182-remove-df-expr' into 175-assertions
averissimo Dec 7, 2023
facd4a4
docs: add news entry for this issue
averissimo Dec 15, 2023
58eba11
fix: consolidation on assertions
averissimo Dec 15, 2023
5d9c367
fix: use iwalk instead if walk2 with seq(...)
averissimo Dec 15, 2023
328c244
fix: change vname() in favor of string
averissimo Dec 15, 2023
7428e04
fix: revert test_r6() in favor of inherits()
averissimo Dec 15, 2023
ea59285
Merge branch '182-remove-df-expr' into 175-assertions
averissimo Dec 15, 2023
aaf1886
feat: change default parameter to be attribute
averissimo Dec 15, 2023
d4511f9
docs: update
averissimo Dec 15, 2023
5ab7ed5
Update NEWS.md
averissimo Dec 19, 2023
1242d08
Merge branch 'main' into 175-assertions
averissimo Jan 16, 2024
6830ffb
merge: revert some changes
averissimo Jan 17, 2024
fb1aa2b
minor bugfixes
averissimo Jan 17, 2024
8aa98d0
default value for domain is attribute
averissimo Jan 17, 2024
33cb7c8
tests: use strict checks to get ascii error
averissimo Jan 17, 2024
810f3b0
docs: update documentation and removes unused function
averissimo Jan 17, 2024
3f6ea8d
style: missing styler
averissimo Jan 17, 2024
06cd23a
Merge branch 'main' into 175-assertions
averissimo Jan 18, 2024
658b87f
Merge branch 'main' into 175-assertions
averissimo Jan 19, 2024
a7d6775
revert: default arguments take NULL
averissimo Jan 22, 2024
e3b35d6
docs: rename comment and move lifecycle check to top
averissimo Jan 22, 2024
dd5bdc3
fix: remove extra empty line
averissimo Jan 22, 2024
9836f8b
revert: no longer retrieve metadata attribute as default
averissimo Jan 22, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
15 changes: 14 additions & 1 deletion NAMESPACE
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,19 @@ export(xportr_write)
export(xpt_validate)
import(haven)
import(rlang)
importFrom(checkmate,assert)
importFrom(checkmate,assert_character)
importFrom(checkmate,assert_choice)
importFrom(checkmate,assert_data_frame)
importFrom(checkmate,assert_integer)
importFrom(checkmate,assert_logical)
importFrom(checkmate,assert_string)
importFrom(checkmate,check_data_frame)
importFrom(checkmate,check_r6)
importFrom(checkmate,makeAssertion)
importFrom(checkmate,test_data_frame)
importFrom(checkmate,test_string)
importFrom(checkmate,vname)
importFrom(cli,cli_alert_danger)
importFrom(cli,cli_alert_info)
importFrom(cli,cli_alert_success)
Expand Down Expand Up @@ -49,13 +62,13 @@ importFrom(janitor,make_clean_names)
importFrom(lifecycle,deprecated)
importFrom(magrittr,"%>%")
importFrom(magrittr,extract2)
importFrom(purrr,iwalk)
importFrom(purrr,map)
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)
importFrom(stringr,str_extract)
Expand Down
2 changes: 1 addition & 1 deletion NEWS.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,13 +7,13 @@
* Added a check for character variable lengths up to 200 bytes in `xpt_validate()`(#91, #189).
* File name check is moved to strict_checks condition to allow underscores in the file name. Underscores are allowed in xpt but not per FDA requirements. (#126)
* It is now possible to get and set the xportr options using the helper function `xportr_options()` (#130)
* Adds argument assertions to public functions using `{checkmate}` (#175)

## Deprecation and Breaking Changes

* The `domain` argument for xportr functions will no longer be dynamically
determined by the name of the data frame passed as the .df argument. This was
done to make the use of xportr functions more explicit. (#182)

* The `label` argument from the `xportr_write()` function is deprecated in favor of the `metadata` argument. (#179)
* The `metacore` argument, which was renamed to `metadata` in the following six xportr functions: (`xportr_df_label()`, `xportr_format()`, `xportr_label()`, `xportr_length()`, `xportr_order()`, and `xportr_type()`) in version `0.3.0` with a soft deprecation warning, has now been hard deprecated. Please update your code to use the new `metadata` argument in place of `metacore`.

Expand Down
28 changes: 9 additions & 19 deletions R/df_label.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -40,8 +40,8 @@
#'
#' adsl <- xportr_df_label(adsl, metadata, domain = "adsl")
xportr_df_label <- function(.df,
metadata = NULL,
domain = NULL,
metadata = attr(.df, "_xportr.df_metadata_"),
domain = attr(.df, "_xportr.df_arg_"),
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What do you folks feel about changing the default parameter value from NULL to the .df attribute.

Be aware that attr always returns NULL if it doesn't exist of if the first parameter is NULL/NA

attr(NULL, "_xportr.df_metadata_")
#> NULL
attr(NA, "_xportr.df_metadata_")
#> NULL

Created on 2023-12-15 with reprex v2.0.2

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Umm... I don't know. It looks really confusing to me to see , but I don't have a better alternative!! @atorus-research/xportr-development-team others have thoughts?

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@averissimo I worry that exposing the attribute structure may confuse people a bit. I'd prefer to keep the NULLs personally

metacore = deprecated()) {
if (!missing(metacore)) {
lifecycle::deprecate_stop(
Expand All @@ -50,34 +50,24 @@ xportr_df_label <- function(.df,
with = "xportr_df_label(metadata = )"
)
}
domain_name <- getOption("xportr.df_domain_name")
label_name <- getOption("xportr.df_label")
assert_data_frame(.df)
assert_string(domain, null.ok = TRUE)
assert_metadata(metadata)

## Common section to detect domain from argument or attribute

domain <- get_domain(.df, domain)
if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain

## End of common section

## Pull out correct metadata
metadata <- metadata %||%
attr(.df, "_xportr.df_metadata_") %||%
rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`")
domain_name <- getOption("xportr.df_domain_name")
label_name <- getOption("xportr.df_label")

if (inherits(metadata, "Metacore")) {
metadata <- metadata$ds_spec
}
if (inherits(metadata, "Metacore")) metadata <- metadata$ds_spec

label <- metadata %>%
filter(!!sym(domain_name) == domain) %>%
select(!!sym(label_name)) %>%
# If a dataframe is used this will also be a dataframe, change to character.
as.character()

label_len <- nchar(label)

if (label_len > 40) {
if (!test_string(label, max.chars = 40)) {
abort("Length of dataset label must be 40 characters or less.")
}

Expand Down
25 changes: 9 additions & 16 deletions R/format.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -42,8 +42,8 @@
#'
#' adsl <- xportr_format(adsl, metadata, domain = "adsl")
xportr_format <- function(.df,
metadata = NULL,
domain = NULL,
metadata = attr(.df, "_xportr.df_metadata_"),
domain = attr(.df, "_xportr.df_arg_"),
metacore = deprecated()) {
if (!missing(metacore)) {
lifecycle::deprecate_stop(
Expand All @@ -52,24 +52,17 @@ xportr_format <- function(.df,
with = "xportr_format(metadata = )"
)
}
domain_name <- getOption("xportr.domain_name")
format_name <- getOption("xportr.format_name")
variable_name <- getOption("xportr.variable_name")
assert_data_frame(.df)
assert_string(domain, null.ok = TRUE)
assert_metadata(metadata)

## Common section to detect domain from argument or attribute

domain <- get_domain(.df, domain)
if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain

## End of common section

metadata <- metadata %||%
attr(.df, "_xportr.df_metadata_") %||%
rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`")
domain_name <- getOption("xportr.domain_name")
format_name <- getOption("xportr.format_name")
variable_name <- getOption("xportr.variable_name")

if (inherits(metadata, "Metacore")) {
metadata <- metadata$var_spec
}
if (inherits(metadata, "Metacore")) metadata <- metadata$var_spec

if (domain_name %in% names(metadata) && !is.null(domain)) {
metadata <- metadata %>%
Expand Down
32 changes: 13 additions & 19 deletions R/label.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -57,8 +57,8 @@
#'
#' adsl <- xportr_label(adsl, metadata, domain = "adsl")
xportr_label <- function(.df,
metadata = NULL,
domain = NULL,
metadata = attr(.df, "_xportr.df_metadata_"),
domain = attr(.df, "_xportr.df_arg_"),
verbose = getOption("xportr.label_verbose", "none"),
metacore = deprecated()) {
if (!missing(metacore)) {
Expand All @@ -68,24 +68,18 @@ xportr_label <- function(.df,
with = "xportr_label(metadata = )"
)
}
domain_name <- getOption("xportr.domain_name")
variable_name <- getOption("xportr.variable_name")
variable_label <- getOption("xportr.label")
assert_data_frame(.df)
assert_string(domain, null.ok = TRUE)
assert_metadata(metadata)
assert_choice(verbose, choices = .internal_verbose_choices)

## Common section to detect domain from argument or attribute

domain <- get_domain(.df, domain)
if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain

## End of common section

metadata <- metadata %||%
attr(.df, "_xportr.df_metadata_") %||%
rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`")
domain_name <- getOption("xportr.domain_name")
variable_name <- getOption("xportr.variable_name")
variable_label <- getOption("xportr.label")

if (inherits(metadata, "Metacore")) {
metadata <- metadata$var_spec
}
if (inherits(metadata, "Metacore")) metadata <- metadata$var_spec

if (domain_name %in% names(metadata) && !is.null(domain)) {
metadata <- metadata %>%
Expand Down Expand Up @@ -117,10 +111,10 @@ xportr_label <- function(.df,
}

for (i in names(.df)) {
if (i %in% miss_vars) {
attr(.df[[i]], "label") <- ""
attr(.df[[i]], "label") <- if (i %in% miss_vars) {
""
} else {
attr(.df[[i]], "label") <- label[[i]]
label[[i]]
}
}

Expand Down
27 changes: 10 additions & 17 deletions R/length.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -64,8 +64,8 @@
#'
#' adsl <- xportr_length(adsl, metadata, domain = "adsl")
xportr_length <- function(.df,
metadata = NULL,
domain = NULL,
metadata = attr(.df, "_xportr.df_metadata_"),
domain = attr(.df, "_xportr.df_arg_"),
verbose = getOption("xportr.length_verbose", "none"),
metacore = deprecated()) {
if (!missing(metacore)) {
Expand All @@ -75,24 +75,18 @@ xportr_length <- function(.df,
with = "xportr_length(metadata = )"
)
}
domain_name <- getOption("xportr.domain_name")
variable_length <- getOption("xportr.length")
variable_name <- getOption("xportr.variable_name")
assert_data_frame(.df)
assert_string(domain, null.ok = TRUE)
assert_metadata(metadata)
assert_choice(verbose, choices = .internal_verbose_choices)

## Common section to detect domain from argument or attribute

domain <- get_domain(.df, domain)
if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain

## End of common section

metadata <- metadata %||%
attr(.df, "_xportr.df_metadata_") %||%
rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`")
domain_name <- getOption("xportr.domain_name")
variable_length <- getOption("xportr.length")
variable_name <- getOption("xportr.variable_name")

if (inherits(metadata, "Metacore")) {
metadata <- metadata$var_spec
}
if (inherits(metadata, "Metacore")) metadata <- metadata$var_spec

if (domain_name %in% names(metadata) && !is.null(domain)) {
metadata <- metadata %>%
Expand All @@ -102,7 +96,6 @@ xportr_length <- function(.df,
check_multiple_var_specs(metadata, variable_name)
}


# Check any variables missed in metadata but present in input data ---
miss_vars <- setdiff(names(.df), metadata[[variable_name]])

Expand Down
20 changes: 20 additions & 0 deletions R/messages.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,9 @@
#' @return Output to Console
#' @export
xportr_logger <- function(message, type = "none", ...) {
assert_character(message)
assert_choice(type, choices = .internal_verbose_choices)

log_fun <- switch(type,
stop = abort,
warn = warn,
Expand All @@ -28,6 +31,9 @@ xportr_logger <- function(message, type = "none", ...) {
#' @return Output to Console
#' @export
var_names_log <- function(tidy_names_df, verbose) {
assert_data_frame(tidy_names_df)
assert_choice(verbose, choices = .internal_verbose_choices)

only_renames <- tidy_names_df %>%
filter(original_varname != renamed_var) %>%
mutate(
Expand Down Expand Up @@ -76,6 +82,10 @@ var_names_log <- function(tidy_names_df, verbose) {
#' @return Output to Console
#' @export
type_log <- function(meta_ordered, type_mismatch_ind, verbose) {
assert_data_frame(meta_ordered)
assert_integer(type_mismatch_ind)
assert_choice(verbose, choices = .internal_verbose_choices)

if (length(type_mismatch_ind) > 0) {
cli_h2("Variable type mismatches found.")
cli_alert_success("{ length(type_mismatch_ind) } variables coerced")
Expand All @@ -97,6 +107,9 @@ type_log <- function(meta_ordered, type_mismatch_ind, verbose) {
#' @return Output to Console
#' @export
length_log <- function(miss_vars, verbose) {
assert_character(miss_vars)
assert_choice(verbose, choices = .internal_verbose_choices)

if (length(miss_vars) > 0) {
cli_h2("Variable lengths missing from metadata.")
cli_alert_success("{ length(miss_vars) } lengths resolved")
Expand All @@ -119,6 +132,9 @@ length_log <- function(miss_vars, verbose) {
#' @return Output to Console
#' @export
label_log <- function(miss_vars, verbose) {
assert_character(miss_vars)
assert_choice(verbose, choices = .internal_verbose_choices)

if (length(miss_vars) > 0) {
cli_h2("Variable labels missing from metadata.")
cli_alert_success("{ length(miss_vars) } labels skipped")
Expand All @@ -141,6 +157,10 @@ label_log <- function(miss_vars, verbose) {
#' @return Output to Console
#' @export
var_ord_msg <- function(reordered_vars, moved_vars, verbose) {
assert_character(reordered_vars)
assert_character(moved_vars)
assert_choice(verbose, choices = .internal_verbose_choices)

if (length(moved_vars) > 0) {
cli_h2("{ length(moved_vars) } variables not in spec and moved to end")
message <- glue(
Expand Down
11 changes: 6 additions & 5 deletions R/metadata.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -41,15 +41,16 @@
#' xportr_order()
#' }
xportr_metadata <- function(.df, metadata = NULL, domain = NULL) {
assert_data_frame(.df)
if (is.null(metadata) && is.null(domain)) {
stop("Must provide either metadata or domain argument")
stop("Assertion failed on `metadata` and `domain`: Must provide either `metadata` or `domain` argument")
}
assert_metadata(metadata, include_fun_message = FALSE, null.ok = TRUE)
assert_string(domain, null.ok = TRUE)

## Common section to detect domain from argument or attribute

domain <- get_domain(.df, domain)
if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain

## End of common section

structure(.df, `_xportr.df_metadata_` = metadata)
structure(.df, "_xportr.df_metadata_" = metadata)
}
26 changes: 10 additions & 16 deletions R/order.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -60,8 +60,8 @@
#'
#' adsl <- xportr_order(adsl, metadata, domain = "adsl")
xportr_order <- function(.df,
metadata = NULL,
domain = NULL,
metadata = attr(.df, "_xportr.df_metadata_"),
domain = attr(.df, "_xportr.df_arg_"),
verbose = getOption("xportr.order_verbose", "none"),
metacore = deprecated()) {
if (!missing(metacore)) {
Expand All @@ -71,24 +71,18 @@ xportr_order <- function(.df,
with = "xportr_order(metadata = )"
)
}
domain_name <- getOption("xportr.domain_name")
order_name <- getOption("xportr.order_name")
variable_name <- getOption("xportr.variable_name")
assert_data_frame(.df)
assert_string(domain, null.ok = TRUE)
assert_metadata(metadata)
assert_choice(verbose, choices = .internal_verbose_choices)

## Common section to detect domain from argument or attribute

domain <- get_domain(.df, domain)
if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain

## End of common section

metadata <- metadata %||%
attr(.df, "_xportr.df_metadata_") %||%
rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`")
domain_name <- getOption("xportr.domain_name")
order_name <- getOption("xportr.order_name")
variable_name <- getOption("xportr.variable_name")

if (inherits(metadata, "Metacore")) {
metadata <- metadata$ds_vars
}
if (inherits(metadata, "Metacore")) metadata <- metadata$ds_vars

if (domain_name %in% names(metadata) && !is.null(domain)) {
metadata <- metadata %>%
Expand Down
Loading
Loading