From 6ccbc1d852a9cf4854c4ca0f83e3348ba50de283 Mon Sep 17 00:00:00 2001 From: elimillera Date: Fri, 11 Aug 2023 20:16:20 +0000 Subject: [PATCH 001/267] Add xpt_validate to pkgdown --- _pkgdown.yml | 1 + cran-comments.md | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/_pkgdown.yml b/_pkgdown.yml index 6c035b09..b3a5cde5 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -39,6 +39,7 @@ reference: - var_names_log - var_ord_msg - xportr_logger + - xpt_validate - title: xportr example datasets and specification files - contents: diff --git a/cran-comments.md b/cran-comments.md index 72663610..095d4889 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,4 +1,4 @@ -## xportr 0.3.0 +## xportr 0.3.1 Check Results: 1 NOTE From 967f2fca14360782c98a6b7c85360d6c9d324f21 Mon Sep 17 00:00:00 2001 From: EeethB Date: Wed, 6 Sep 2023 22:07:03 +0000 Subject: [PATCH 002/267] Make `xportr_type()` drop factor levels --- R/type.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/type.R b/R/type.R index 0114309c..78cf6dca 100644 --- a/R/type.R +++ b/R/type.R @@ -168,6 +168,7 @@ xportr_type <- function(.df, if (!is_correct[i]) { orig_attributes <- attributes(.df[[i]]) orig_attributes$class <- NULL + orig_attributes$levels <- NULL if (correct_type[i] %in% characterTypes) { .df[[i]] <<- as.character(.df[[i]]) } else { From a496a7e51cccc107eb3f8c58e934be3c92fefb7e Mon Sep 17 00:00:00 2001 From: EeethB Date: Wed, 6 Sep 2023 22:26:34 +0000 Subject: [PATCH 003/267] Update NEWS.md --- NEWS.md | 4 ++++ R/type.R | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index c066e5e7..4b0d5d71 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# xportr 0.3.1 + +* Make `xportr_type()` drop factor levels when coercing variables + # xportr 0.3.0 ## New Features and Bug Fixes diff --git a/R/type.R b/R/type.R index 78cf6dca..56affea8 100644 --- a/R/type.R +++ b/R/type.R @@ -159,7 +159,7 @@ xportr_type <- function(.df, is_correct <- sapply(meta_ordered[["type.x"]] == meta_ordered[["type.y"]], isTRUE) # Use the original variable iff metadata is missing that variable correct_type <- ifelse(is.na(meta_ordered[["type.y"]]), meta_ordered[["type.x"]], meta_ordered[["type.y"]]) - +browser() # Walk along the columns and coerce the variables. Modifying the columns # Directly instead of something like map_dfc to preserve any attributes. walk2( From 6c58cdf7e77815245afe3578d436f4adf8e4218f Mon Sep 17 00:00:00 2001 From: vedhav Date: Thu, 16 Nov 2023 12:03:38 +0530 Subject: [PATCH 004/267] feat: extend `xportr_write` to accept `metadata` and deprecate `label` --- DESCRIPTION | 2 +- NEWS.md | 8 +++++++ R/df_label.R | 4 ++++ R/write.R | 43 +++++++++++++++++++++++++------------ man/xportr_write.Rd | 19 ++++++++++++++-- tests/testthat/test-write.R | 9 -------- 6 files changed, 59 insertions(+), 26 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 61e81239..28b9ff0b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1 +Version: 0.3.1.9001 Authors@R: c( person(given = "Eli", diff --git a/NEWS.md b/NEWS.md index c066e5e7..ad0b607b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,11 @@ +# xportr 0.3.1.9001 + +## New Features and Bug Fixes +* `xportr_write()` now accepts `metadata` argument which can be used to set the dataset label to stay consistent with the other `xportr_*` functions. It is noteworthy that the dataset label set using the `xportr_df_label()` function will be retained during the `xportr_write()`. + +## Deprecation and Breaking Changes +* The `label` argument from the `xportr_write()` function is deprecated with the `metadata` argument. + # xportr 0.3.0 ## New Features and Bug Fixes diff --git a/R/df_label.R b/R/df_label.R index 0b3b7194..df9d6b75 100644 --- a/R/df_label.R +++ b/R/df_label.R @@ -83,6 +83,10 @@ xportr_df_label <- function(.df, abort("Length of dataset label must be 40 characters or less.") } + if (stringr::str_detect(label, "[^[:ascii:]]")) { + abort("`label` cannot contain any non-ASCII, symbol or special characters.") + } + attr(.df, "label") <- label .df diff --git a/R/write.R b/R/write.R index 57367fc2..3921b803 100644 --- a/R/write.R +++ b/R/write.R @@ -7,10 +7,12 @@ #' @param .df A data frame to write. #' @param path Path where transport file will be written. File name sans will be #' used as `xpt` name. -#' @param label Dataset label. It must be <=40 characters. +#' @param label `r lifecycle::badge("deprecated")` Previously used to to set the Dataset label. +#' Use the `metadata` to set the dataset label. #' @param strict_checks If TRUE, xpt validation will report errors and not write #' out the dataset. If FALSE, xpt validation will report warnings and continue #' with writing out the dataset. Defaults to FALSE +#' @inheritParams xportr_length #' #' @details #' * Variable and dataset labels are stored in the "label" attribute. @@ -38,11 +40,36 @@ #' strict_checks = FALSE #' ) #' -xportr_write <- function(.df, path, label = NULL, strict_checks = FALSE) { +xportr_write <- function(.df, + path, + metadata = NULL, + domain = NULL, + strict_checks = FALSE, + label = deprecated()) { path <- normalizePath(path, mustWork = FALSE) name <- tools::file_path_sans_ext(basename(path)) + ## Common section to detect domain from argument or pipes + + df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) + domain <- get_domain(.df, df_arg, domain) + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + + ## End of common section + + if (!missing(label)) { + lifecycle::deprecate_warn( + when = "0.3.2", + what = "xportr_write(label = )", + with = "xportr_write(metadata = )" + ) + metadata <- data.frame(dataset = domain, label = label) + } + if (!is.null(metadata)) { + .df <- xportr_df_label(.df, metadata = metadata, domain = domain) + } + if (nchar(name) > 8) { abort("`.df` file name must be 8 characters or less.") } @@ -51,18 +78,6 @@ xportr_write <- function(.df, path, label = NULL, strict_checks = FALSE) { abort("`.df` cannot contain any non-ASCII, symbol or underscore characters.") } - if (!is.null(label)) { - if (nchar(label) > 40) { - abort("`label` must be 40 characters or less.") - } - - if (stringr::str_detect(label, "[^[:ascii:]]")) { - abort("`label` cannot contain any non-ASCII, symbol or special characters.") - } - - attr(.df, "label") <- label - } - checks <- xpt_validate(.df) if (length(checks) > 0) { diff --git a/man/xportr_write.Rd b/man/xportr_write.Rd index f1b89fc9..2387baf3 100644 --- a/man/xportr_write.Rd +++ b/man/xportr_write.Rd @@ -4,7 +4,14 @@ \alias{xportr_write} \title{Write xpt v5 transport file} \usage{ -xportr_write(.df, path, label = NULL, strict_checks = FALSE) +xportr_write( + .df, + path, + metadata = NULL, + domain = NULL, + strict_checks = FALSE, + label = deprecated() +) } \arguments{ \item{.df}{A data frame to write.} @@ -12,11 +19,19 @@ xportr_write(.df, path, label = NULL, strict_checks = FALSE) \item{path}{Path where transport file will be written. File name sans will be used as \code{xpt} name.} -\item{label}{Dataset label. It must be <=40 characters.} +\item{metadata}{A data frame containing variable level metadata. See +'Metadata' section for details.} + +\item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset +the metadata object. If none is passed, then name of the dataset passed as +.df will be used.} \item{strict_checks}{If TRUE, xpt validation will report errors and not write out the dataset. If FALSE, xpt validation will report warnings and continue with writing out the dataset. Defaults to FALSE} + +\item{label}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to to set the Dataset label. +Use the \code{metadata} to set the dataset label.} } \value{ A data frame. \code{xportr_write()} returns the input data invisibly. diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index ba165e3c..51b569b6 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -85,15 +85,6 @@ test_that("xportr_write: expect warning when an xpt validation fails with strict expect_warning(xportr_write(data_to_save, tmp, label = "label", strict_checks = FALSE)) }) -test_that("xportr_write: expect warning when an xpt validation fails with strict_checks set to FALSE", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") - attr(data_to_save$X, "format.sas") <- "foo" - - on.exit(unlink(tmpdir)) - - expect_warning(xportr_write(data_to_save, tmp, label = "label", strict_checks = FALSE)) -}) test_that("xportr_write: Capture errors by haven and report them as such", { tmpdir <- tempdir() From 399a4fd176e8383ac38e7a463db159353ac5a8b6 Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 21 Nov 2023 22:40:33 +0530 Subject: [PATCH 005/267] chore: update tests with metadata instead of label --- tests/testthat/test-write.R | 116 ++++++++++++++++++++++++++++++++---- 1 file changed, 106 insertions(+), 10 deletions(-) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index 51b569b6..4229c06e 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -10,13 +10,48 @@ test_that("xportr_write: exported data can be saved to a file", { expect_equal(read_xpt(tmp), data_to_save) }) -test_that("xportr_write: exported data can be saved to a file with a label", { +test_that("xportr_write: exported data can still be saved to a file with a label", { tmpdir <- tempdir() tmp <- file.path(tmpdir, "xyz.xpt") on.exit(unlink(tmpdir)) - xportr_write(data_to_save, path = tmp, label = "Lorem ipsum dolor sit amet") + suppressWarnings(xportr_write(data_to_save, path = tmp, label = "Lorem ipsum dolor sit amet")) + expect_output(str(read_xpt(tmp)), "Lorem ipsum dolor sit amet") +}) + +test_that("xportr_write: exported data can be saved to a file with a metadata", { + tmpdir <- tempdir() + tmp <- file.path(tmpdir, "xyz.xpt") + + on.exit(unlink(tmpdir)) + + xportr_write( + data_to_save, + path = tmp, + metadata = data.frame( + dataset = "data_to_save", + label = "Lorem ipsum dolor sit amet" + ) + ) + expect_output(str(read_xpt(tmp)), "Lorem ipsum dolor sit amet") +}) + +test_that("xportr_write: exported data can be saved to a file with a existing metadata", { + tmpdir <- tempdir() + tmp <- file.path(tmpdir, "xyz.xpt") + + on.exit(unlink(tmpdir)) + + df <- xportr_df_label( + data_to_save, + data.frame( + dataset = "data_to_save", + label = "Lorem ipsum dolor sit amet" + ) + ) + + xportr_write(df, path = tmp) expect_output(str(read_xpt(tmp)), "Lorem ipsum dolor sit amet") }) @@ -26,7 +61,16 @@ test_that("xportr_write: expect error when invalid multibyte string is passed in on.exit(unlink(tmpdir)) - expect_error(xportr_write(data_to_save, tmp, label = "Lorizzle ipsizzle dolizzl\xe7 pizzle")) + expect_error( + xportr_write( + data_to_save, + tmp, + metadata = data.frame( + dataset = "data_to_save", + label = "Lorizzle ipsizzle dolizzl\xe7 pizzle" + ) + ) + ) }) test_that("xportr_write: expect error when file name is over 8 characters long", { @@ -35,7 +79,7 @@ test_that("xportr_write: expect error when file name is over 8 characters long", on.exit(unlink(tmpdir)) - expect_error(xportr_write(data_to_save, tmp, label = "asdf")) + expect_error(xportr_write(data_to_save, tmp)) }) test_that("xportr_write: expect error when file name contains non-ASCII symbols or special characters", { @@ -44,7 +88,7 @@ test_that("xportr_write: expect error when file name contains non-ASCII symbols on.exit(unlink(tmpdir)) - expect_error(xportr_write(data_to_save, tmp, label = "asdf")) + expect_error(xportr_write(data_to_save, tmp)) }) test_that("xportr_write: expect error when label contains non-ASCII symbols or special characters", { @@ -53,7 +97,22 @@ test_that("xportr_write: expect error when label contains non-ASCII symbols or s on.exit(unlink(tmpdir)) - expect_error(xportr_write(data_to_save, tmp, label = "çtestç")) + expect_error( + xportr_write( + data_to_save, + tmp, + expect_error( + xportr_write( + data_to_save, + tmp, + metadata = data.frame( + dataset = "data_to_save", + label = "çtestç" + ) + ) + ) + ) + ) }) test_that("xportr_write: expect error when label is over 40 characters", { @@ -62,7 +121,16 @@ test_that("xportr_write: expect error when label is over 40 characters", { on.exit(unlink(tmpdir)) - expect_error(xportr_write(data_to_save, tmp, label = paste(rep("a", 41), collapse = ""))) + expect_error( + xportr_write( + data_to_save, + tmp, + metadata = data.frame( + dataset = "data_to_save", + label = paste(rep("a", 41), collapse = "") + ) + ) + ) }) test_that("xportr_write: expect error when an xpt validation fails with strict_checks set to TRUE", { @@ -72,7 +140,16 @@ test_that("xportr_write: expect error when an xpt validation fails with strict_c on.exit(unlink(tmpdir)) - expect_error(xportr_write(data_to_save, tmp, label = "label", strict_checks = TRUE)) + expect_error( + xportr_write( + data_to_save, tmp, + metadata = data.frame( + dataset = "data_to_save", + label = "label" + ), + strict_checks = TRUE + ) + ) }) test_that("xportr_write: expect warning when an xpt validation fails with strict_checks set to FALSE", { @@ -82,7 +159,16 @@ test_that("xportr_write: expect warning when an xpt validation fails with strict on.exit(unlink(tmpdir)) - expect_warning(xportr_write(data_to_save, tmp, label = "label", strict_checks = FALSE)) + expect_warning( + xportr_write( + data_to_save, tmp, + metadata = data.frame( + dataset = "data_to_save", + label = "label" + ), + strict_checks = FALSE + ) + ) }) @@ -93,8 +179,18 @@ test_that("xportr_write: Capture errors by haven and report them as such", { on.exit(unlink(tmpdir)) + expect_error( - suppressWarnings(xportr_write(data_to_save, tmp, label = "label", strict_checks = FALSE)), + suppressWarnings( + xportr_write( + data_to_save, tmp, + metadata = data.frame( + dataset = "data_to_save", + label = "label" + ), + strict_checks = FALSE + ) + ), "Error reported by haven" ) }) From 1fa2b56b77e9c189d857a40ee47365da049cc89a Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 21 Nov 2023 22:57:40 +0530 Subject: [PATCH 006/267] docs: replace the docs where label is used --- R/write.R | 3 ++- README.Rmd | 4 ++-- README.md | 4 ++-- man/xportr_write.Rd | 3 ++- vignettes/deepdive.Rmd | 10 +++++----- vignettes/xportr.Rmd | 2 +- 6 files changed, 14 insertions(+), 12 deletions(-) diff --git a/R/write.R b/R/write.R index 3921b803..f16f08cc 100644 --- a/R/write.R +++ b/R/write.R @@ -34,9 +34,10 @@ #' Param = c("param1", "param2", "param3") #' ) #' +#' var_spec <- data.frame(dataset = "adsl", label = "Subject-Level Analysis Dataset") #' xportr_write(adsl, #' path = paste0(tempdir(), "/adsl.xpt"), -#' label = "Subject-Level Analysis", +#' metadata = var_spec, #' strict_checks = FALSE #' ) #' diff --git a/README.Rmd b/README.Rmd index 6536ac6d..6c2830a7 100644 --- a/README.Rmd +++ b/README.Rmd @@ -133,7 +133,7 @@ adsl %>% xportr_label(var_spec, "ADSL", verbose = "warn") %>% xportr_order(var_spec, "ADSL", verbose = "warn") %>% xportr_format(var_spec, "ADSL") %>% - xportr_write("adsl.xpt", label = "Subject-Level Analysis Dataset") + xportr_write("adsl.xpt") ``` The `xportr_metadata()` function can reduce duplication by setting the variable specification and domain explicitly at the top of a pipeline. If you would like to use the `verbose` argument, you will need to set in each function call. @@ -146,7 +146,7 @@ adsl %>% xportr_label() %>% xportr_order() %>% xportr_format() %>% - xportr_write("adsl.xpt", label = "Subject-Level Analysis Dataset") + xportr_write("adsl.xpt") ``` That's it! We now have a xpt file created in R with all appropriate types, lengths, labels, ordering and formats. Please check out the [Get Started](https://atorus-research.github.io/xportr/articles/xportr.html) for more information and detailed walk through of each `xportr_` function. diff --git a/README.md b/README.md index bbd581f9..675ca401 100644 --- a/README.md +++ b/README.md @@ -140,7 +140,7 @@ adsl %>% xportr_label(var_spec, "ADSL", verbose = "warn") %>% xportr_order(var_spec, "ADSL", verbose = "warn") %>% xportr_format(var_spec, "ADSL") %>% - xportr_write("adsl.xpt", label = "Subject-Level Analysis Dataset") + xportr_write("adsl.xpt") ``` The `xportr_metadata()` function can reduce duplication by setting the @@ -156,7 +156,7 @@ adsl %>% xportr_label() %>% xportr_order() %>% xportr_format() %>% - xportr_write("adsl.xpt", label = "Subject-Level Analysis Dataset") + xportr_write("adsl.xpt") ``` That’s it! We now have a xpt file created in R with all appropriate diff --git a/man/xportr_write.Rd b/man/xportr_write.Rd index 2387baf3..8e19147b 100644 --- a/man/xportr_write.Rd +++ b/man/xportr_write.Rd @@ -57,9 +57,10 @@ adsl <- data.frame( Param = c("param1", "param2", "param3") ) +var_spec <- data.frame(dataset = "adsl", label = "Subject-Level Analysis Dataset") xportr_write(adsl, path = paste0(tempdir(), "/adsl.xpt"), - label = "Subject-Level Analysis", + metadata = var_spec, strict_checks = FALSE ) diff --git a/vignettes/deepdive.Rmd b/vignettes/deepdive.Rmd index 8f1ccac0..72af4bca 100644 --- a/vignettes/deepdive.Rmd +++ b/vignettes/deepdive.Rmd @@ -171,7 +171,7 @@ adsl %>% xportr_label(var_spec, "ADSL", "message") %>% xportr_order(var_spec, "ADSL", "message") %>% xportr_format(var_spec, "ADSL") %>% - xportr_write("adsl.xpt", label = "Subject-Level Analysis Dataset") + xportr_write("adsl.xpt") ``` To help reduce these repetitive calls, we have created `xportr_metadata()`. A user can just **set** the _metadata object_ and the Domain name in the first call, and this will be passed on to the other functions. Much cleaner! @@ -185,7 +185,7 @@ adsl %>% xportr_label() %>% xportr_order() %>% xportr_format() %>% - xportr_write("adsl.xpt", label = "Subject-Level Analysis Dataset") + xportr_write("adsl.xpt") ``` @@ -410,7 +410,7 @@ adsl %>% xportr_label() %>% xportr_order() %>% xportr_format() %>% - xportr_write(path = "adsl.xpt", label = "Subject-Level Analysis Dataset", strict_checks = FALSE) + xportr_write(path = "adsl.xpt", strict_checks = FALSE) ``` Success! We have applied types, lengths, labels, ordering and formats to our dataset. Note the messages written out to the console. Remember the `TRTDUR` and `DCREASCD` and how these are not present in the metadata, but in the dataset. This impacts the messaging for lengths and labels where `{xportr}` is printing out some feedback to us on the two issues. 5 types are coerced, as well as 36 variables re-ordered. Note that `strict_checks` was set to `FALSE`. @@ -419,7 +419,7 @@ The next two examples showcase the `strict_checks = TRUE` option in `xportr_writ ```{r, echo = TRUE, error = TRUE} adsl %>% - xportr_write(path = "adsl.xpt", label = "Subject-Level Analysis Dataset", strict_checks = TRUE) + xportr_write(path = "adsl.xpt", strict_checks = TRUE) ``` @@ -439,7 +439,7 @@ adsl %>% xportr_label() %>% xportr_type() %>% xportr_format() %>% - xportr_write(path = "adsl.xpt", label = "Subject-Level Analysis Dataset", strict_checks = TRUE) + xportr_write(path = "adsl.xpt", strict_checks = TRUE) ``` diff --git a/vignettes/xportr.Rmd b/vignettes/xportr.Rmd index 1c6acdb0..2e39f386 100644 --- a/vignettes/xportr.Rmd +++ b/vignettes/xportr.Rmd @@ -278,7 +278,7 @@ adsl %>% xportr_label(var_spec, "ADSL", "message") %>% xportr_order(var_spec, "ADSL", "message") %>% xportr_format(var_spec, "ADSL") %>% - xportr_write("adsl.xpt", label = "Subject-Level Analysis Dataset") + xportr_write("adsl.xpt") ``` That's it! We now have a `xpt` file created in R with all appropriate types, lengths, labels, ordering and formats from our specification file. If you are interested in exploring more of the custom From dc751f33a406bc711c118e711ab50f6e4a8859a7 Mon Sep 17 00:00:00 2001 From: elimillera Date: Mon, 27 Nov 2023 16:02:40 +0000 Subject: [PATCH 007/267] CRAN Changes --- R/df_label.R | 2 +- R/xportr-package.R | 2 -- README.Rmd | 1 - cran-comments.md | 13 +------------ man/xportr-package.Rd | 2 -- man/xportr_df_label.Rd | 2 +- 6 files changed, 3 insertions(+), 19 deletions(-) diff --git a/R/df_label.R b/R/df_label.R index 0b3b7194..932bbf58 100644 --- a/R/df_label.R +++ b/R/df_label.R @@ -20,7 +20,7 @@ #' function. #' #' 2) Label Name - passed as the 'xportr.df_label' option. Default: -#' "format". Character values to update the 'format.sas' attribute of the +#' "label". Character values to update the 'label' attribute of the #' dataframe This is passed to `haven::write_xpt` to note the label. #' #' @export diff --git a/R/xportr-package.R b/R/xportr-package.R index c3804b20..701c4a52 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -89,8 +89,6 @@ #' options update in the `.Rprofile.site` file in the R home directory.} #' } #' -#' See [Managing R with .Rprofile, .Renviron, Rprofile.site, Renviron.site, rsession.conf, and repos.conf](https://support.posit.co/hc/en-us/articles/360047157094-Managing-R-with-Rprofile-Renviron-Rprofile-site-Renviron-site-rsession-conf-and-repos-conf) # nolint -#' #' #' @keywords internal #' diff --git a/README.Rmd b/README.Rmd index 6536ac6d..7af50e6d 100644 --- a/README.Rmd +++ b/README.Rmd @@ -19,7 +19,6 @@ library(fontawesome) # xportr -[](https://RValidationHub.slack.com) [![R build status](https://github.com/atorus-research/xportr/workflows/R-CMD-check/badge.svg)](https://github.com/atorus-research/xportr/actions?workflow=R-CMD-check) [](https://app.codecov.io/gh/atorus-research/xportr) [](https://github.com/atorus-research/xportr/blob/master/LICENSE) diff --git a/cran-comments.md b/cran-comments.md index 095d4889..def3213b 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,17 +1,6 @@ ## xportr 0.3.1 -Check Results: - 1 NOTE - -### Notes: - -Found the following (possibly) invalid URLs: - URL: https://support.posit.co/hc/en-us/articles/360047157094-Managing-R-with-Rprofile-Renviron-Rprofile-site-Renviron-site-rsession-conf-and-repos-conf - From: man/xportr-package.Rd - Status: 403 - Message: Forbidden - -This is a valid URL that is failing due to the website not allowing the site to be scraped by pipelines/robots. +No notes, warnings, or errors ### Tested on: diff --git a/man/xportr-package.Rd b/man/xportr-package.Rd index cf9ff450..64eaed80 100644 --- a/man/xportr-package.Rd +++ b/man/xportr-package.Rd @@ -97,8 +97,6 @@ update in the \code{.Rprofile} file in the users home directory.} \item{To change an option for all users in an R environment, place the options update in the \code{.Rprofile.site} file in the R home directory.} } - -See \href{https://support.posit.co/hc/en-us/articles/360047157094-Managing-R-with-Rprofile-Renviron-Rprofile-site-Renviron-site-rsession-conf-and-repos-conf}{Managing R with .Rprofile, .Renviron, Rprofile.site, Renviron.site, rsession.conf, and repos.conf} # nolint } \seealso{ diff --git a/man/xportr_df_label.Rd b/man/xportr_df_label.Rd index e0a461fd..e5adca40 100644 --- a/man/xportr_df_label.Rd +++ b/man/xportr_df_label.Rd @@ -37,7 +37,7 @@ For data.frame 'metadata' arguments two columns must be present: "dataset". This is the column subset by the 'domain' argument in the function. \item Label Name - passed as the 'xportr.df_label' option. Default: -"format". Character values to update the 'format.sas' attribute of the +"label". Character values to update the 'label' attribute of the dataframe This is passed to \code{haven::write_xpt} to note the label. } } From d75aefa74b844d138ace5dce62ded01a42ec6b05 Mon Sep 17 00:00:00 2001 From: Vedha Viyash <49812166+vedhav@users.noreply.github.com> Date: Tue, 28 Nov 2023 03:44:44 +0530 Subject: [PATCH 008/267] Update NEWS.md Co-authored-by: Eli Miller --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index ad0b607b..b1ef4a4d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,7 +4,7 @@ * `xportr_write()` now accepts `metadata` argument which can be used to set the dataset label to stay consistent with the other `xportr_*` functions. It is noteworthy that the dataset label set using the `xportr_df_label()` function will be retained during the `xportr_write()`. ## Deprecation and Breaking Changes -* The `label` argument from the `xportr_write()` function is deprecated with the `metadata` argument. +* The `label` argument from the `xportr_write()` function is deprecated in favor of the `metadata` argument. # xportr 0.3.0 From c6725b1fa9039c44c350e4f62dbc46b8ee56dfc7 Mon Sep 17 00:00:00 2001 From: Vedha Viyash <49812166+vedhav@users.noreply.github.com> Date: Tue, 28 Nov 2023 03:44:51 +0530 Subject: [PATCH 009/267] Update R/write.R Co-authored-by: Eli Miller --- R/write.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/write.R b/R/write.R index f16f08cc..0dd13541 100644 --- a/R/write.R +++ b/R/write.R @@ -8,7 +8,7 @@ #' @param path Path where transport file will be written. File name sans will be #' used as `xpt` name. #' @param label `r lifecycle::badge("deprecated")` Previously used to to set the Dataset label. -#' Use the `metadata` to set the dataset label. +#' Use the `metadata` argument to set the dataset label. #' @param strict_checks If TRUE, xpt validation will report errors and not write #' out the dataset. If FALSE, xpt validation will report warnings and continue #' with writing out the dataset. Defaults to FALSE From 25c7bc4cb1d99cf34151e0b091c09f8b8184959e Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 28 Nov 2023 03:46:43 +0530 Subject: [PATCH 010/267] docs: update roxygen docs --- man/xportr_write.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/xportr_write.Rd b/man/xportr_write.Rd index 8e19147b..b59e61bd 100644 --- a/man/xportr_write.Rd +++ b/man/xportr_write.Rd @@ -31,7 +31,7 @@ out the dataset. If FALSE, xpt validation will report warnings and continue with writing out the dataset. Defaults to FALSE} \item{label}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to to set the Dataset label. -Use the \code{metadata} to set the dataset label.} +Use the \code{metadata} argument to set the dataset label.} } \value{ A data frame. \code{xportr_write()} returns the input data invisibly. From 2404325e24f71dbbe805eaf10384ce27bbe0f837 Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 28 Nov 2023 04:16:20 +0530 Subject: [PATCH 011/267] docs: make some minor corrections to the deep dive vignette --- vignettes/deepdive.Rmd | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/vignettes/deepdive.Rmd b/vignettes/deepdive.Rmd index 8f1ccac0..ab900da0 100644 --- a/vignettes/deepdive.Rmd +++ b/vignettes/deepdive.Rmd @@ -143,20 +143,19 @@ options( One final note on `options()`. 4 of the core `{xportr}` functions have the ability to set messaging as `"none", "message", "warn", "stop"`. Setting each of these in all your calls can be a bit repetitive. You can use `options()` to set these at a higher level and avoid this repetition. ```{r, eval = FALSE} -# Default +# Default verbose is set to `none` options( xportr.format_verbose = "none", xportr.label_verbose = "none", xportr.length_verbose = "none", - xportr.type_verbose = "none", + xportr.type_verbose = "none" ) -# Will send Warning Message to Console options( - xportr.format_verbose = "warn", - xportr.label_verbose = "warn", - xportr.length_verbose = "warn", - xportr.type_verbose = "warn", + xportr.format_verbose = "none", # Disables any messaging, keeping the console output clean + xportr.label_verbose = "message", # Sends a standard message to the console + xportr.length_verbose = "warn", # Sends a warning message to the console + xportr.type_verbose = "stop" # Stops execution and sends an error message to the console ) ``` @@ -279,7 +278,7 @@ glimpse(adsl_type_glimpse) Note that `xportr_type(verbose = "warn")` was set so the function has provided feedback, which would show up in the console, on which variables were converted as a warning message. However, you can set `verbose = "stop"` so that the types are not applied if the data does not match what is in the specification file. Using `verbose = "stop"` will instantly stop the processing of this function and not create the object. A user will need to alter the variables in their R script before using `xportr_type()` ```{r, echo = TRUE, error = TRUE} -adsl_type <- xportr_type(.df = adsl, metadata = var_spec, domain = "ADSL", verbose = "stop") +adsl_type <- xportr_type(.df = adsl_fct, metadata = var_spec, domain = "ADSL", verbose = "stop") ``` ## `xportr_length()` From 251ac9a8fc4f0d81f385c3da3cc871dc24097522 Mon Sep 17 00:00:00 2001 From: elimillera Date: Mon, 27 Nov 2023 23:11:03 +0000 Subject: [PATCH 012/267] Remove dynamic domain determination --- NAMESPACE | 1 + R/df_label.R | 7 +-- R/format.R | 5 +- R/label.R | 5 +- R/length.R | 5 +- R/metadata.R | 22 +++++++- R/order.R | 5 +- R/support-test.R | 1 + R/type.R | 3 +- R/utils-xportr.R | 7 +-- man/{xportr_metadata.Rd => metadata.Rd} | 6 ++ man/xportr_df_label.Rd | 2 +- man/xportr_format.Rd | 2 +- man/xportr_label.Rd | 2 +- man/xportr_length.Rd | 2 +- man/xportr_order.Rd | 2 +- tests/testthat/test-depreciation.R | 22 ++++---- tests/testthat/test-length.R | 45 +++------------ tests/testthat/test-metadata.R | 73 ++++++++++--------------- tests/testthat/test-order.R | 11 ++-- tests/testthat/test-pipe.R | 44 ++++----------- tests/testthat/test-type.R | 26 +++++---- 22 files changed, 123 insertions(+), 175 deletions(-) rename man/{xportr_metadata.Rd => metadata.Rd} (91%) diff --git a/NAMESPACE b/NAMESPACE index 2b7d1412..723f0e11 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,6 +6,7 @@ export(type_log) export(var_names_log) export(var_ord_msg) export(xportr_df_label) +export(xportr_domain_name) export(xportr_format) export(xportr_label) export(xportr_length) diff --git a/R/df_label.R b/R/df_label.R index 932bbf58..5009335d 100644 --- a/R/df_label.R +++ b/R/df_label.R @@ -38,7 +38,7 @@ #' label = c("Subject-Level Analysis", "Adverse Events Analysis") #' ) #' -#' adsl <- xportr_df_label(adsl, metadata) +#' adsl <- xportr_df_label(adsl, metadata, domain = "adsl") xportr_df_label <- function(.df, metadata = NULL, domain = NULL, @@ -54,10 +54,9 @@ xportr_df_label <- function(.df, domain_name <- getOption("xportr.df_domain_name") label_name <- getOption("xportr.df_label") - ## Common section to detect domain from argument or pipes + ## Common section to detect domain from argument or attribute - df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) - domain <- get_domain(.df, df_arg, domain) + domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section diff --git a/R/format.R b/R/format.R index 17e15183..864faaf4 100644 --- a/R/format.R +++ b/R/format.R @@ -40,7 +40,7 @@ #' format = c(NA, "DATE9.") #' ) #' -#' adsl <- xportr_format(adsl, metadata) +#' adsl <- xportr_format(adsl, metadata, domain = "adsl") xportr_format <- function(.df, metadata = NULL, domain = NULL, @@ -59,8 +59,7 @@ xportr_format <- function(.df, ## Common section to detect domain from argument or pipes - df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) - domain <- get_domain(.df, df_arg, domain) + domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section diff --git a/R/label.R b/R/label.R index e412e9fc..3d422f1b 100644 --- a/R/label.R +++ b/R/label.R @@ -55,7 +55,7 @@ #' label = c("Unique Subject Identifier", "Study Site Identifier", "Age", "Sex") #' ) #' -#' adsl <- xportr_label(adsl, metadata) +#' adsl <- xportr_label(adsl, metadata, domain = "adsl") xportr_label <- function(.df, metadata = NULL, domain = NULL, @@ -75,8 +75,7 @@ xportr_label <- function(.df, ## Common section to detect domain from argument or pipes - df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) - domain <- get_domain(.df, df_arg, domain) + domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section diff --git a/R/length.R b/R/length.R index 17627268..81864c2b 100644 --- a/R/length.R +++ b/R/length.R @@ -62,7 +62,7 @@ #' length = c(10, 8) #' ) #' -#' adsl <- xportr_length(adsl, metadata) +#' adsl <- xportr_length(adsl, metadata, domain = "adsl") xportr_length <- function(.df, metadata = NULL, domain = NULL, @@ -82,8 +82,7 @@ xportr_length <- function(.df, ## Common section to detect domain from argument or pipes - df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) - domain <- get_domain(.df, df_arg, domain) + domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section diff --git a/R/metadata.R b/R/metadata.R index 1fdabc28..926de49e 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -10,6 +10,8 @@ #' @return `.df` dataset with metadata and domain attributes set #' @export #' +#' @rdname metadata +#' #' @examples #' #' metadata <- data.frame( @@ -33,6 +35,7 @@ #' library(magrittr) #' #' adlb %>% +#' xportr_domain_name("adlb") %>% #' xportr_metadata(metadata, "test") %>% #' xportr_type() %>% #' xportr_order() @@ -40,11 +43,26 @@ xportr_metadata <- function(.df, metadata, domain = NULL) { ## Common section to detect domain from argument or pipes - df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) - domain <- get_domain(.df, df_arg, domain) + 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) } + + +#' Update Metadata Domain Name +#' +#' @inheritParams xportr_length +#' +#' @return `.df` dataset with domain argument set +#' @export +#' +#' @rdname metadata +xportr_domain_name <- function(.df, domain) { + + attr(.df, "_xportr.df_arg_") <- domain + + .df +} diff --git a/R/order.R b/R/order.R index 0f7e1b30..43ea130d 100644 --- a/R/order.R +++ b/R/order.R @@ -58,7 +58,7 @@ #' order = 1:4 #' ) #' -#' adsl <- xportr_order(adsl, metadata) +#' adsl <- xportr_order(adsl, metadata, domain = "adsl") xportr_order <- function(.df, metadata = NULL, domain = NULL, @@ -78,8 +78,7 @@ xportr_order <- function(.df, ## Common section to detect domain from argument or pipes - df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) - domain <- get_domain(.df, df_arg, domain) + domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section diff --git a/R/support-test.R b/R/support-test.R index e12a6650..b81fba3d 100644 --- a/R/support-test.R +++ b/R/support-test.R @@ -180,6 +180,7 @@ multiple_vars_in_spec_helper2 <- function(FUN) { local_cli_theme() adsl %>% + xportr_domain_name("adsl") %>% FUN(metadata) %>% testthat::expect_no_message(message = "There are multiple specs for the same variable name") } diff --git a/R/type.R b/R/type.R index 0114309c..c04ac317 100644 --- a/R/type.R +++ b/R/type.R @@ -99,8 +99,7 @@ xportr_type <- function(.df, ## Common section to detect domain from argument or pipes - df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) - domain <- get_domain(.df, df_arg, domain) + domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section diff --git a/R/utils-xportr.R b/R/utils-xportr.R index 06e1684f..f97bb346 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -309,17 +309,14 @@ xpt_validate <- function(data) { #' #' @return A string representing the domain #' @noRd -get_domain <- function(.df, df_arg, domain) { +get_domain <- function(.df, domain) { if (!is.null(domain) && !is.character(domain)) { abort(c("`domain` must be a vector with type .", x = glue("Instead, it has type <{typeof(domain)}>.") )) } - if (identical(df_arg, ".")) { - df_arg <- get_pipe_call() - } - result <- domain %||% attr(.df, "_xportr.df_arg_") %||% df_arg + result <- domain %||% attr(.df, "_xportr.df_arg_") result } diff --git a/man/xportr_metadata.Rd b/man/metadata.Rd similarity index 91% rename from man/xportr_metadata.Rd rename to man/metadata.Rd index 592c6f45..d1f5d30b 100644 --- a/man/xportr_metadata.Rd +++ b/man/metadata.Rd @@ -2,9 +2,12 @@ % Please edit documentation in R/metadata.R \name{xportr_metadata} \alias{xportr_metadata} +\alias{xportr_domain_name} \title{Set variable specifications and domain} \usage{ xportr_metadata(.df, metadata, domain = NULL) + +xportr_domain_name(.df, domain) } \arguments{ \item{.df}{A data frame of CDISC standard.} @@ -18,6 +21,8 @@ the metadata object. If none is passed, then name of the dataset passed as } \value{ \code{.df} dataset with metadata and domain attributes set + +\code{.df} dataset with domain argument set } \description{ Sets metadata for a dataset in a way that can be accessed by other xportr @@ -48,6 +53,7 @@ if (rlang::is_installed("magrittr")) { library(magrittr) adlb \%>\% + xportr_domain_name("adlb") \%>\% xportr_metadata(metadata, "test") \%>\% xportr_type() \%>\% xportr_order() diff --git a/man/xportr_df_label.Rd b/man/xportr_df_label.Rd index e5adca40..691de990 100644 --- a/man/xportr_df_label.Rd +++ b/man/xportr_df_label.Rd @@ -55,5 +55,5 @@ metadata <- data.frame( label = c("Subject-Level Analysis", "Adverse Events Analysis") ) -adsl <- xportr_df_label(adsl, metadata) +adsl <- xportr_df_label(adsl, metadata, domain = "adsl") } diff --git a/man/xportr_format.Rd b/man/xportr_format.Rd index a4f06222..c6fd6e85 100644 --- a/man/xportr_format.Rd +++ b/man/xportr_format.Rd @@ -58,5 +58,5 @@ metadata <- data.frame( format = c(NA, "DATE9.") ) -adsl <- xportr_format(adsl, metadata) +adsl <- xportr_format(adsl, metadata, domain = "adsl") } diff --git a/man/xportr_label.Rd b/man/xportr_label.Rd index a74137ed..4cd7d18c 100644 --- a/man/xportr_label.Rd +++ b/man/xportr_label.Rd @@ -84,5 +84,5 @@ metadata <- data.frame( label = c("Unique Subject Identifier", "Study Site Identifier", "Age", "Sex") ) -adsl <- xportr_label(adsl, metadata) +adsl <- xportr_label(adsl, metadata, domain = "adsl") } diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index 89fb5703..4c4dd224 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -81,5 +81,5 @@ metadata <- data.frame( length = c(10, 8) ) -adsl <- xportr_length(adsl, metadata) +adsl <- xportr_length(adsl, metadata, domain = "adsl") } diff --git a/man/xportr_order.Rd b/man/xportr_order.Rd index e8ea269c..44f283cf 100644 --- a/man/xportr_order.Rd +++ b/man/xportr_order.Rd @@ -88,5 +88,5 @@ metadata <- data.frame( order = 1:4 ) -adsl <- xportr_order(adsl, metadata) +adsl <- xportr_order(adsl, metadata, domain = "adsl") } diff --git a/tests/testthat/test-depreciation.R b/tests/testthat/test-depreciation.R index 157f59b1..eb63cafe 100644 --- a/tests/testthat/test-depreciation.R +++ b/tests/testthat/test-depreciation.R @@ -3,10 +3,10 @@ test_that("xportr_df_label: deprecated metacore argument still works and gives w df <- data.frame(x = "a", y = "b") df_meta <- data.frame(dataset = "df", label = "Label") - df_spec_labeled_df <- xportr_df_label(df, metacore = df_meta) + df_spec_labeled_df <- xportr_df_label(df, metacore = df_meta, domain = "df") expect_equal(attr(df_spec_labeled_df, "label"), "Label") - xportr_df_label(df, metacore = df_meta) %>% + xportr_df_label(df, metacore = df_meta, domain = "df") %>% lifecycle::expect_deprecated("Please use the `metadata` argument instead.") }) @@ -19,10 +19,10 @@ test_that("xportr_format: deprecated metacore argument still works and gives war format = "date9." ) - formatted_df <- xportr_format(df, metacore = df_meta) + formatted_df <- xportr_format(df, metacore = df_meta, domain = "df") expect_equal(attr(formatted_df$x, "format.sas"), "DATE9.") - xportr_format(df, metacore = df_meta) %>% + xportr_format(df, metacore = df_meta, domain = "df") %>% lifecycle::expect_deprecated("Please use the `metadata` argument instead.") }) @@ -33,14 +33,14 @@ test_that("xportr_label: deprecated metacore argument still works and gives warn df_meta <- data.frame(dataset = "df", variable = "x", label = "foo") df_labeled_df <- suppressMessages( - xportr_label(df, metacore = df_meta) + xportr_label(df, metacore = df_meta, domain = "df") ) expect_equal(attr(df_labeled_df$x, "label"), "foo") # Note that only the deprecated message should be caught (others are ignored) suppressMessages( - xportr_label(df, metacore = df_meta) %>% + xportr_label(df, metacore = df_meta, domain = "df") %>% lifecycle::expect_deprecated("Please use the `metadata` argument instead.") ) }) @@ -55,11 +55,11 @@ test_that("xportr_length: deprecated metacore argument still works and gives war length = c(1, 2) ) - df_with_width <- xportr_length(df, metacore = df_meta) + df_with_width <- xportr_length(df, metacore = df_meta, domain = "df") expect_equal(c(x = 1, y = 2), map_dbl(df_with_width, attr, "width")) - xportr_length(df, metacore = df_meta) %>% + xportr_length(df, metacore = df_meta, domain = "df") %>% lifecycle::expect_deprecated("Please use the `metadata` argument instead.") }) @@ -81,7 +81,7 @@ test_that("xportr_order: deprecated metacore argument still works and gives warn # Note that only the deprecated message should be caught (others are ignored) suppressMessages( - xportr_order(df, metacore = df_meta) %>% + xportr_order(df, metacore = df_meta, domain = "df") %>% lifecycle::expect_deprecated("Please use the `metadata` argument instead.") ) }) @@ -102,12 +102,12 @@ test_that("xportr_type: deprecated metacore argument still works and gives warni ) df2 <- suppressMessages( - xportr_type(df, metacore = df_meta) + xportr_type(df, metacore = df_meta, domain = "df") ) # Note that only the deprecated message should be caught (others are ignored) suppressMessages( - xportr_type(df, metacore = df_meta) %>% + xportr_type(df, metacore = df_meta, domain = "df") %>% lifecycle::expect_deprecated("Please use the `metadata` argument instead.") ) }) diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index e749684d..dd8b531f 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -13,7 +13,9 @@ test_that("xportr_length: Accepts valid domain names in metadata object", { withr::local_options(list(xportr.length_verbose = "message")) # Test minimal call with valid data and without domain - xportr_length(adsl, metadata) %>% + adsl %>% + xportr_domain_name("adsl") %>% + xportr_length(metadata) %>% expect_silent() %>% expect_attr_width(metadata$length) @@ -27,7 +29,7 @@ test_that("xportr_length: Accepts valid domain names in metadata object", { # Test minimal call without datasets metadata_without_dataset <- metadata %>% select(-"dataset") - xportr_length(adsl, metadata_without_dataset) %>% + xportr_length(adsl, metadata_without_dataset, domain = "adsl") %>% expect_silent() %>% expect_attr_width(metadata_without_dataset$length) %>% NROW() %>% @@ -59,39 +61,6 @@ test_that("xportr_length: CDISC data frame is being piped after another xportr f expect_equal("adsl") }) -test_that("xportr_length: CDISC data frame domain is being recognized from pipe", { - adsl <- minimal_table(30) - metadata <- minimal_metadata(dataset = TRUE, length = TRUE, var_names = colnames(adsl)) - - # Setup temporary options with `verbose = "message"` - withr::local_options(list(xportr.length_verbose = "message")) - - # Remove empty lines in cli theme - local_cli_theme() - - # With domain manually set - not_adsl <- adsl - result <- not_adsl %>% - xportr_length(metadata) %>% - expect_message("Variable lengths missing from metadata") %>% - expect_message("lengths resolved") %>% - expect_message("Variable\\(s\\) present in dataframe but doesn't exist in `metadata`") - - suppressMessages({ - result <- not_adsl %>% - xportr_length(metadata, verbose = "none") - }) - - expect_no_match(attr(result, "_xportr.df_arg_"), "^adsl$") - - # Test results with piping - result <- adsl %>% - xportr_length(metadata) - - attr(result, "_xportr.df_arg_") %>% - expect_equal("adsl") -}) - test_that("xportr_length: Impute character lengths based on class", { adsl <- minimal_table(30, cols = c("x", "b")) metadata <- minimal_metadata( @@ -109,7 +78,7 @@ test_that("xportr_length: Impute character lengths based on class", { # Test length imputation of character and numeric (not valid character type) result <- adsl %>% - xportr_length(metadata) %>% + xportr_length(metadata, domain = "adsl") %>% expect_silent() expect_attr_width(result, c(7, 199)) @@ -124,7 +93,7 @@ test_that("xportr_length: Impute character lengths based on class", { ) adsl %>% - xportr_length(metadata) %>% + xportr_length(metadata, domain = "adsl") %>% expect_message("Variable lengths missing from metadata") %>% expect_message("lengths resolved") %>% expect_attr_width(c(7, 199, 200, 200, 8)) @@ -140,7 +109,7 @@ test_that("xportr_length: Throws message when variables not present in metadata" local_cli_theme() # Test that message is given which indicates that variable is not present - xportr_length(adsl, metadata) %>% + xportr_length(adsl, metadata, domain = "adsl") %>% expect_message("Variable lengths missing from metadata") %>% expect_message("lengths resolved") %>% expect_message(regexp = "Problem with `y`") diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index b232ea2d..c74f906e 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -14,7 +14,7 @@ test_that("xportr_label: Correctly applies label from data.frame spec", { df <- data.frame(x = "a", y = "b") df_meta <- data.frame(dataset = "df", variable = c("x", "y"), label = c("foo", "bar")) - df_labeled_df <- xportr_label(df, df_meta) + df_labeled_df <- xportr_label(df, df_meta, domain = "df") expect_equal(extract_var_label(df_labeled_df), c("foo", "bar")) @@ -36,7 +36,7 @@ test_that("xportr_label: Correctly applies label when data is piped", { df <- data.frame(x = "a", y = "b") df_meta <- data.frame(dataset = "df", variable = c("x", "y"), label = c("foo", "bar")) - df_labeled_df <- df %>% xportr_label(df_meta) + df_labeled_df <- df %>% xportr_label(df_meta, domain = "df") expect_equal(extract_var_label(df_labeled_df), c("foo", "bar")) expect_equal( @@ -92,7 +92,7 @@ test_that("xportr_label: Correctly applies label from metacore spec", { )) metacoes_labeled_df <- suppressMessages( - xportr_label(df, metacore_meta) + xportr_label(df, metacore_meta, domain = "df") ) expect_equal(extract_var_label(metacoes_labeled_df), c("X Label", "Y Label", "")) @@ -119,7 +119,7 @@ test_that("xportr_label: Expect error if any variable does not exist in metadata label = "foo" ) suppressMessages( - xportr_label(df, df_meta, verbose = "stop") + xportr_label(df, df_meta, verbose = "stop", domain = "df") ) %>% expect_error() }) @@ -132,7 +132,7 @@ test_that("xportr_label: Expect error if label exceeds 40 characters", { label = strrep("a", 41) ) - suppressMessages(xportr_label(df, df_meta)) %>% + suppressMessages(xportr_label(df, df_meta, domain = "df")) %>% expect_warning("variable label must be 40 characters or less") }) @@ -158,7 +158,7 @@ test_that("xportr_df_label: Correctly applies label from data.frame spec", { df <- data.frame(x = "a", y = "b") df_meta <- data.frame(dataset = "df", label = "Label") - df_spec_labeled_df <- xportr_df_label(df, df_meta) + df_spec_labeled_df <- xportr_df_label(df, df_meta, domain = "df") expect_equal(attr(df_spec_labeled_df, "label"), "Label") expect_equal( @@ -178,6 +178,7 @@ test_that("xportr_df_label: Correctly applies label when data is piped", { df_meta <- data.frame(dataset = "df", label = "Label") df_spec_labeled_df <- df %>% + xportr_domain_name("df") %>% xportr_df_label(df_meta) %>% xportr_df_label(df_meta) @@ -221,7 +222,7 @@ test_that("xportr_df_label: Correctly applies label from metacore spec", { ) )) - metacore_spec_labeled_df <- xportr_df_label(df, metacore_meta) + metacore_spec_labeled_df <- xportr_df_label(df, metacore_meta, domain = "df") expect_equal(attr(metacore_spec_labeled_df, "label"), "Label") expect_equal( @@ -243,7 +244,7 @@ test_that("xportr_df_label: Expect error if label exceeds 40 characters", { ) expect_error( - xportr_df_label(df, df_meta), + xportr_df_label(df, df_meta, domain = "df"), "dataset label must be 40 characters or less" ) }) @@ -273,7 +274,7 @@ test_that("xportr_format: Set formats as expected", { format = c("date9.", "datetime20.") ) - formatted_df <- xportr_format(df, df_meta) + formatted_df <- xportr_format(df, df_meta, domain = "df") expect_equal(extract_format(formatted_df), c("DATE9.", "DATETIME20.")) expect_equal(formatted_df, structure( @@ -293,7 +294,7 @@ test_that("xportr_format: Set formats as expected when data is piped", { format = c("date9.", "datetime20.") ) - formatted_df <- df %>% xportr_format(df_meta) + formatted_df <- df %>% xportr_format(df_meta, domain = "df") expect_equal(extract_format(formatted_df), c("DATE9.", "DATETIME20.")) expect_equal(formatted_df, structure( @@ -321,7 +322,7 @@ test_that("xportr_format: Set formats as expected for metacore spec", { ) )) - formatted_df <- xportr_format(df, metacore_meta) + formatted_df <- xportr_format(df, metacore_meta, domain = "df") expect_equal(extract_format(formatted_df), c("DATE9.", "DATETIME20.")) expect_equal(formatted_df, structure( @@ -361,7 +362,7 @@ test_that("xportr_format: Handle NA values without raising an error", { format = c("date9.", "datetime20.", NA, "text") ) - formatted_df <- xportr_format(df, df_meta) + formatted_df <- xportr_format(df, df_meta, domain = "df") expect_equal(extract_format(formatted_df), c("DATE9.", "DATETIME20.", "", "")) expect_equal(formatted_df, structure( @@ -402,7 +403,7 @@ test_that("xportr_length: Check if width attribute is set properly", { length = c(1, 2) ) - df_with_width <- xportr_length(df, df_meta) + df_with_width <- xportr_length(df, df_meta, domain = "df") expect_equal(c(x = 1, y = 2), map_dbl(df_with_width, attr, "width")) expect_equal(df_with_width, structure( @@ -423,7 +424,7 @@ test_that("xportr_length: Check if width attribute is set properly when data is length = c(1, 2) ) - df_with_width <- df %>% xportr_length(df_meta) + df_with_width <- df %>% xportr_length(df_meta, domain = "df") expect_equal(c(x = 1, y = 2), map_dbl(df_with_width, attr, "width")) expect_equal(df_with_width, structure( @@ -451,7 +452,7 @@ test_that("xportr_length: Check if width attribute is set properly for metacore ) )) - df_with_width <- xportr_length(df, metacore_meta) + df_with_width <- xportr_length(df, metacore_meta, domain = "df") expect_equal(c(x = 1, y = 2), map_dbl(df_with_width, attr, "width")) expect_equal(df_with_width, structure( @@ -494,7 +495,7 @@ test_that("xportr_length: Expect error when a variable is not present in metadat ) suppressMessages( - xportr_length(df, df_meta, verbose = "stop") + xportr_length(df, df_meta, domain = "df", verbose = "stop") ) %>% expect_error("doesn't exist") }) @@ -509,7 +510,7 @@ test_that("xportr_length: Check if length gets imputed when a new variable is pa ) df_with_width <- suppressMessages( - xportr_length(df, df_meta) + xportr_length(df, df_meta, domain = "df") ) # 200 is the imputed length for character and 8 for other data types as in impute_length() @@ -558,68 +559,50 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { rlang::set_names(tolower) expect_equal( - structure(xportr_type(adsl, var_spec), `_xportr.df_metadata_` = var_spec), + structure(xportr_type(adsl, var_spec, domain = "adsl"), `_xportr.df_metadata_` = var_spec), suppressMessages( - xportr_metadata(adsl, var_spec) %>% xportr_type() + xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_type() ) ) expect_equal( structure( - suppressMessages(xportr_length(adsl, var_spec)), + suppressMessages(xportr_length(adsl, var_spec, domain = "adsl")), `_xportr.df_metadata_` = var_spec ), suppressMessages( - xportr_metadata(adsl, var_spec) %>% xportr_length() + xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_length() ) ) expect_equal( structure( - suppressMessages(xportr_label(adsl, var_spec)), + suppressMessages(xportr_label(adsl, var_spec, domain = "adsl")), `_xportr.df_metadata_` = var_spec ), suppressMessages( - xportr_metadata(adsl, var_spec) %>% xportr_label() + xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_label() ) ) expect_equal( structure( - suppressMessages(xportr_order(adsl, var_spec)), + suppressMessages(xportr_order(adsl, var_spec, domain = "adsl")), `_xportr.df_metadata_` = var_spec ), suppressMessages( - xportr_metadata(adsl, var_spec) %>% xportr_order() + xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_order() ) ) expect_equal( structure( - suppressMessages(xportr_format(adsl, var_spec)), + suppressMessages(xportr_format(adsl, var_spec, domain = "adsl")), `_xportr.df_metadata_` = var_spec ), suppressMessages( - xportr_metadata(adsl, var_spec) %>% xportr_format() + xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_format() ) ) }) - -test_that("xportr_metadata: Correctly extract domain from var name", { - metadata <- data.frame( - dataset = "adlb", - variable = c("Subj", "Param", "Val", "NotUsed"), - type = c("numeric", "character", "numeric", "character"), - order = c(1, 3, 4, 2) - ) - - adlb <- data.frame( - Subj = as.character(123, 456, 789), - Different = c("a", "b", "c"), - Val = c("1", "2", "3"), - Param = c("param1", "param2", "param3") - ) - - expect_equal(attr(xportr_metadata(adlb, metadata), "_xportr.df_arg_"), "adlb") -}) # end diff --git a/tests/testthat/test-order.R b/tests/testthat/test-order.R index 801108c4..941a7d04 100644 --- a/tests/testthat/test-order.R +++ b/tests/testthat/test-order.R @@ -6,7 +6,7 @@ test_that("xportr_order: Variable are ordered correctly for data.frame spec", { order = 1:4 ) - ordered_df <- suppressMessages(xportr_order(df, df_meta)) + ordered_df <- suppressMessages(xportr_order(df, df_meta, domain = "df")) expect_equal(names(ordered_df), df_meta$variable) }) @@ -21,6 +21,7 @@ test_that("xportr_order: Variable are ordered correctly when data is piped", { ordered_df <- suppressMessages( df %>% + xportr_domain_name("df") %>% xportr_order(df_meta) %>% xportr_order(df_meta) ) @@ -67,7 +68,7 @@ test_that("xportr_order: Variable are ordered correctly for metacore spec", { )) ordered_df <- suppressMessages( - xportr_order(df, metacore_meta) + xportr_order(df, metacore_meta, domain = "df") ) expect_equal(names(ordered_df), ordered_columns) @@ -127,12 +128,12 @@ test_that("xportr_order: Variable ordering messaging is correct", { # Remove empty lines in cli theme local_cli_theme() - xportr_order(df, df_meta, verbose = "message") %>% + xportr_order(df, df_meta, verbose = "message", domain = "df") %>% expect_message("All variables in specification file are in dataset") %>% expect_condition("4 reordered in dataset") %>% expect_message("Variable reordered in `.df`: `a`, `b`, `c`, and `d`") - xportr_order(df2, df_meta, verbose = "message") %>% + xportr_order(df2, df_meta, verbose = "message", domain = "df2") %>% expect_message("2 variables not in spec and moved to end") %>% expect_message("Variable moved to end in `.df`: `a` and `z`") %>% expect_message("All variables in dataset are ordered") @@ -147,7 +148,7 @@ test_that("xportr_order: Metadata order columns are coersed to numeric", { ) ordered_df <- suppressMessages( - xportr_order(df, df_meta) + xportr_order(df, df_meta, domain = "df") ) expect_equal(names(ordered_df), df_meta$variable) diff --git a/tests/testthat/test-pipe.R b/tests/testthat/test-pipe.R index c4d18d83..6f9bafb5 100644 --- a/tests/testthat/test-pipe.R +++ b/tests/testthat/test-pipe.R @@ -1,36 +1,3 @@ -test_that("xportr_*: Domain is obtained from a call without pipe", { - adsl <- minimal_table(30) - - metadata <- minimal_metadata( - dataset = TRUE, length = TRUE, label = TRUE, type = TRUE, format = TRUE, - order = TRUE - ) - - # Divert all messages to tempfile, instead of printing them - # note: be aware as this should only be used in tests that don't track - # messages - withr::local_message_sink(tempfile()) - - xportr_metadata(adsl, metadata) %>% - attr("_xportr.df_arg_") %>% - expect_equal("adsl") - xportr_label(adsl, metadata) %>% - attr("_xportr.df_arg_") %>% - expect_equal("adsl") - xportr_length(adsl, metadata) %>% - attr("_xportr.df_arg_") %>% - expect_equal("adsl") - xportr_order(adsl, metadata) %>% - attr("_xportr.df_arg_") %>% - expect_equal("adsl") - xportr_format(adsl, metadata) %>% - attr("_xportr.df_arg_") %>% - expect_equal("adsl") - xportr_type(adsl, metadata) %>% - attr("_xportr.df_arg_") %>% - expect_equal("adsl") -}) - test_that("xportr_*: Domain is kept in between calls", { # Divert all messages to tempfile, instead of printing them @@ -46,6 +13,7 @@ test_that("xportr_*: Domain is kept in between calls", { ) df2 <- adsl %>% + xportr_domain_name("adsl") %>% xportr_type(metadata) df3 <- df2 %>% @@ -57,7 +25,7 @@ test_that("xportr_*: Domain is kept in between calls", { expect_equal(attr(df3, "_xportr.df_arg_"), "adsl") df4 <- adsl %>% - xportr_type(metadata) + xportr_type(metadata, domain = "adsl") df5 <- df4 %>% xportr_label(metadata) %>% @@ -83,6 +51,7 @@ test_that("xportr_*: Can use magrittr pipe and aquire domain from call", { non_standard_name <- adsl result <- non_standard_name %>% + xportr_domain_name("non_standard_name") %>% xportr_type(metadata) %>% xportr_label(metadata) %>% xportr_length(metadata) %>% @@ -94,6 +63,7 @@ test_that("xportr_*: Can use magrittr pipe and aquire domain from call", { # Different sequence call by moving first and last around result2 <- non_standard_name %>% + xportr_domain_name("non_standard_name") %>% xportr_label(metadata) %>% xportr_length(metadata) %>% xportr_order(metadata) %>% @@ -119,6 +89,7 @@ test_that("xportr_*: Can use magrittr pipe and aquire domain from call (metadata non_standard_name <- adsl result <- non_standard_name %>% + xportr_domain_name("non_standard_name") %>% xportr_metadata(metadata) %>% xportr_type() %>% xportr_label() %>% @@ -131,6 +102,7 @@ test_that("xportr_*: Can use magrittr pipe and aquire domain from call (metadata # Different sequence call by moving first and last around result2 <- non_standard_name %>% + xportr_domain_name("non_standard_name") %>% xportr_metadata(metadata) %>% xportr_label() %>% xportr_length() %>% @@ -162,6 +134,7 @@ test_that("xportr_*: Can use R native pipe (R>4.1) and aquire domain from call", non_standard_name_native <- adsl result <- non_standard_name_native |> + xportr_domain_name("non_standard_name_native") |> xportr_type(metadata) |> xportr_label(metadata) |> xportr_length(metadata) |> @@ -173,6 +146,7 @@ test_that("xportr_*: Can use R native pipe (R>4.1) and aquire domain from call", # Different sequence call by moving first and last around result2 <- non_standard_name_native |> + xportr_domain_name("non_standard_name_native") |> xportr_label(metadata) |> xportr_length(metadata) |> xportr_order(metadata) |> @@ -203,6 +177,7 @@ test_that("xportr_*: Can use R native pipe (R>4.1) and aquire domain from call ( non_standard_name_native <- adsl result <- non_standard_name_native |> + xportr_domain_name("non_standard_name_native") |> xportr_metadata(metadata) |> xportr_type() |> xportr_label() |> @@ -215,6 +190,7 @@ test_that("xportr_*: Can use R native pipe (R>4.1) and aquire domain from call ( # Different sequence call by moving first and last around result2 <- non_standard_name_native |> + xportr_domain_name("non_standard_name_native") |> xportr_metadata(metadata) |> xportr_label() |> xportr_length() |> diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index d5841a63..a865b6cb 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -29,7 +29,7 @@ test_that("xportr_type: NAs are handled as expected", { ) df2 <- suppressMessages( - xportr_type(df, meta_example) + xportr_type(df, meta_example, domain = "df") ) expect_equal( @@ -52,7 +52,7 @@ test_that("xportr_type: Variable types are coerced as expected and can raise mes # Remove empty lines in cli theme local_cli_theme() - (df2 <- xportr_type(df, meta_example)) %>% + (df2 <- xportr_type(df, meta_example, domain = "df")) %>% expect_message("Variable type mismatches found.") %>% expect_message("[0-9+] variables coerced") @@ -61,9 +61,9 @@ test_that("xportr_type: Variable types are coerced as expected and can raise mes Val = "numeric", Param = "character" )) - expect_error(xportr_type(df, meta_example, verbose = "stop")) + expect_error(xportr_type(df, meta_example, verbose = "stop", domain = "df")) - (df3 <- suppressMessages(xportr_type(df, meta_example, verbose = "warn"))) %>% + (df3 <- suppressMessages(xportr_type(df, meta_example, verbose = "warn", domain = "df"))) %>% expect_warning() expect_equal(purrr::map_chr(df3, class), c( @@ -73,7 +73,7 @@ test_that("xportr_type: Variable types are coerced as expected and can raise mes # Ignore other messages suppressMessages( - (df4 <- xportr_type(df, meta_example, verbose = "message")) %>% + (df4 <- xportr_type(df, meta_example, verbose = "message", domain = "df")) %>% expect_message("Variable type\\(s\\) in dataframe don't match metadata") ) @@ -88,7 +88,7 @@ test_that("xportr_metadata: Var types coerced as expected and raise messages", { local_cli_theme() ( - df2 <- xportr_metadata(df, meta_example) %>% + df2 <- xportr_metadata(df, meta_example, domain = "df") %>% xportr_type() ) %>% expect_message("Variable type mismatches found.") %>% @@ -100,12 +100,12 @@ test_that("xportr_metadata: Var types coerced as expected and raise messages", { )) suppressMessages( - xportr_metadata(df, meta_example) %>% xportr_type(verbose = "stop") + xportr_metadata(df, meta_example, domain = "df") %>% xportr_type(verbose = "stop") ) %>% expect_error() suppressMessages( - df3 <- xportr_metadata(df, meta_example) %>% xportr_type(verbose = "warn") + df3 <- xportr_metadata(df, meta_example, domain = "df") %>% xportr_type(verbose = "warn") ) %>% expect_warning() @@ -116,7 +116,7 @@ test_that("xportr_metadata: Var types coerced as expected and raise messages", { suppressMessages({ ( - df4 <- xportr_metadata(df, meta_example) %>% + df4 <- xportr_metadata(df, meta_example, domain = "df") %>% xportr_type(verbose = "message") ) %>% expect_message("Variable type\\(s\\) in dataframe don't match metadata: `Subj` and `Val`") @@ -155,12 +155,14 @@ test_that("xportr_type: Variables retain column attributes, besides class", { withr::local_message_sink(tempfile()) df_type_label <- adsl %>% + xportr_domain_name("adsl") %>% xportr_type(metadata) %>% xportr_label(metadata) %>% xportr_length(metadata) %>% xportr_format(metadata) df_label_type <- adsl %>% + xportr_domain_name("adsl") %>% xportr_label(metadata) %>% xportr_length(metadata) %>% xportr_format(metadata) %>% @@ -200,7 +202,7 @@ test_that("xportr_type: works fine from metacore spec", { ) )) processed_df <- suppressMessages( - xportr_type(df, metacore_meta) + xportr_type(df, metacore_meta, domain = "df") ) expect_equal(processed_df$x, "1") }) @@ -228,7 +230,7 @@ test_that("xportr_type: date variables are not converted to numeric", { ) expect_message( { - processed_df <- xportr_type(df, metacore_meta) + processed_df <- xportr_type(df, metacore_meta, domain = "df") }, NA ) @@ -262,7 +264,7 @@ test_that("xportr_type: date variables are not converted to numeric", { adsl_original$RFICDTM <- as.POSIXct(adsl_original$RFICDTM) expect_message( - adsl_xpt2 <- adsl_original %>% xportr_type(metadata), + adsl_xpt2 <- adsl_original %>% xportr_type(metadata, domain = "adsl_original"), NA ) From f490414accf48a8764fdec02176256fdb909e6eb Mon Sep 17 00:00:00 2001 From: Kangjie Zhang Date: Tue, 28 Nov 2023 00:11:14 +0000 Subject: [PATCH 013/267] add length check <=200 bytes --- NEWS.md | 5 +++++ R/utils-xportr.R | 10 ++++++++++ tests/testthat/test-utils-xportr.R | 8 ++++++++ 3 files changed, 23 insertions(+) diff --git a/NEWS.md b/NEWS.md index c066e5e7..83d5529a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,8 @@ +# xportr 0.3.1.9001 + +## New Features and Bug Fixes +* Added a check for character variable lengths up to 200 bytes in `xpt_validate()`(#91, #189). + # xportr 0.3.0 ## New Features and Bug Fixes diff --git a/R/utils-xportr.R b/R/utils-xportr.R index 06e1684f..8086ffa4 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -302,6 +302,16 @@ xpt_validate <- function(data) { glue("{fmt_fmts(names(chk_formats))} must have a valid format.") ) } + + # 4.0 max length of Character variables <= 200 bytes + max_nchar <- data %>% + summarise(across(where(is.character), ~ max(nchar(., type = "bytes")))) + nchar_gt_200 <- max_nchar[which(max_nchar > 200)] + err_cnd <- c( + err_cnd, + glue("Character variables must have lengths <= 200 bytes, max length of {names(nchar_gt_200)} is {nchar_gt_200} bytes.") + ) + return(err_cnd) } diff --git a/tests/testthat/test-utils-xportr.R b/tests/testthat/test-utils-xportr.R index 4167b698..0a679e46 100644 --- a/tests/testthat/test-utils-xportr.R +++ b/tests/testthat/test-utils-xportr.R @@ -111,3 +111,11 @@ test_that("xpt_validate: Get error message when the label contains non-ASCII, sy "Label 'A=fooçbar' cannot contain any non-ASCII, symbol or special characters." ) }) + +test_that("xpt_validate: Get error message when the length of a character variable is > 200 bytes ", { + df <- data.frame(A = paste(rep("A", 201), collapse = "")) + expect_equal( + xpt_validate(df), + "Character variables must have lengths <= 200 bytes, max length of A is 201 bytes." + ) +}) From bf1fc3e1cf0c60ef54adece227920e5a23e8f48a Mon Sep 17 00:00:00 2001 From: Kangjie Zhang Date: Tue, 28 Nov 2023 00:27:18 +0000 Subject: [PATCH 014/267] update length check --- R/utils-xportr.R | 4 ++-- tests/testthat/test-utils-xportr.R | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/utils-xportr.R b/R/utils-xportr.R index 8086ffa4..5e21c7e9 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -305,11 +305,11 @@ xpt_validate <- function(data) { # 4.0 max length of Character variables <= 200 bytes max_nchar <- data %>% - summarise(across(where(is.character), ~ max(nchar(., type = "bytes")))) + dplyr::summarise(across(where(is.character), ~ max(nchar(., type = "bytes")))) nchar_gt_200 <- max_nchar[which(max_nchar > 200)] err_cnd <- c( err_cnd, - glue("Character variables must have lengths <= 200 bytes, max length of {names(nchar_gt_200)} is {nchar_gt_200} bytes.") + glue("Length of {names(nchar_gt_200)} must be 200 bytes or less.") ) return(err_cnd) diff --git a/tests/testthat/test-utils-xportr.R b/tests/testthat/test-utils-xportr.R index 0a679e46..7c272fe0 100644 --- a/tests/testthat/test-utils-xportr.R +++ b/tests/testthat/test-utils-xportr.R @@ -116,6 +116,6 @@ test_that("xpt_validate: Get error message when the length of a character variab df <- data.frame(A = paste(rep("A", 201), collapse = "")) expect_equal( xpt_validate(df), - "Character variables must have lengths <= 200 bytes, max length of A is 201 bytes." + "Length of A must be 200 bytes or less." ) }) From cd65f029e14d3dc1abac24f2905f3ddb43f04b12 Mon Sep 17 00:00:00 2001 From: EeethB Date: Tue, 28 Nov 2023 18:10:08 +0000 Subject: [PATCH 015/267] Fix tests --- R/type.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/type.R b/R/type.R index 56affea8..78cf6dca 100644 --- a/R/type.R +++ b/R/type.R @@ -159,7 +159,7 @@ xportr_type <- function(.df, is_correct <- sapply(meta_ordered[["type.x"]] == meta_ordered[["type.y"]], isTRUE) # Use the original variable iff metadata is missing that variable correct_type <- ifelse(is.na(meta_ordered[["type.y"]]), meta_ordered[["type.x"]], meta_ordered[["type.y"]]) -browser() + # Walk along the columns and coerce the variables. Modifying the columns # Directly instead of something like map_dfc to preserve any attributes. walk2( From a0d653fe9e8864fdc3a3423ae9a01b4e36fe7484 Mon Sep 17 00:00:00 2001 From: EeethB Date: Tue, 28 Nov 2023 19:26:09 +0000 Subject: [PATCH 016/267] Add test --- tests/testthat/test-type.R | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index d5841a63..c593fdb1 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -280,3 +280,23 @@ test_that("xportr_type: Gets warning when metadata has multiple rows with same v # Checks that message doesn't appear when xportr.domain_name is valid multiple_vars_in_spec_helper2(xportr_type) }) + +test_that("xportr_type: Drops factor levels", { + metadata <- data.frame( + dataset = "test", + variable = c("Subj", "Param", "Val", "NotUsed"), + type = c("numeric", "character", "numeric", "character"), + format = NA + ) + + .df <- data.frame( + Subj = as.character(123, 456, 789), + Different = c("a", "b", "c"), + Val = factor(c("1", "2", "3")), + Param = c("param1", "param2", "param3") + ) + + df2 <- xportr_type(.df, metadata, "test") + + expect_null(attributes(df2$Val)) +}) From f8ce580a963edc9f7e07792310fd13cbfeafd77d Mon Sep 17 00:00:00 2001 From: bs832471 Date: Thu, 30 Nov 2023 14:17:36 +0000 Subject: [PATCH 017/267] docs: #187 dev version for site --- DESCRIPTION | 2 +- NEWS.md | 4 ++++ _pkgdown.yml | 3 +++ 3 files changed, 8 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 61e81239..4e813ef9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1 +Version: 0.3.1.9000 Authors@R: c( person(given = "Eli", diff --git a/NEWS.md b/NEWS.md index 4b0d5d71..2f83cdf2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# xportr (development version) + +* Work for 0.4 goes here! + # xportr 0.3.1 * Make `xportr_type()` drop factor levels when coercing variables diff --git a/_pkgdown.yml b/_pkgdown.yml index b3a5cde5..28abfbf0 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -9,6 +9,9 @@ search: news: cran_dates: true +development: + mode: auto + navbar: structure: right: [slack, github] From d3069ffb87d21b128409dd5e3281f1b70b268727 Mon Sep 17 00:00:00 2001 From: bs832471 Date: Thu, 30 Nov 2023 14:18:49 +0000 Subject: [PATCH 018/267] Increment version number to 0.3.1.9000 --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 2f83cdf2..72c54587 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,6 @@ # xportr (development version) -* Work for 0.4 goes here! +* Work for 0.4 goes here!1 # xportr 0.3.1 From fa97f3b391e92ae0604f0e2d96f9f58082fac8d7 Mon Sep 17 00:00:00 2001 From: bs832471 Date: Thu, 30 Nov 2023 14:24:49 +0000 Subject: [PATCH 019/267] docs: #187 news entry --- NEWS.md | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 72c54587..07babb71 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,12 @@ # xportr (development version) -* Work for 0.4 goes here!1 +## New Features and Bug Fixes + +## Documentation + +* Set up Development version of Website (#187) + +## Deprecation and Breaking Changes # xportr 0.3.1 From 9f67d13f5e2222522e8f221b6f6a0fab2bda0aca Mon Sep 17 00:00:00 2001 From: bs832471 Date: Thu, 30 Nov 2023 14:29:40 +0000 Subject: [PATCH 020/267] docs: #187 clean up PR template --- .github/PULL_REQUEST_TEMPLATE/release.md | 22 ---------------------- .github/pull_request_template.md | 1 - 2 files changed, 23 deletions(-) delete mode 100644 .github/PULL_REQUEST_TEMPLATE/release.md diff --git a/.github/PULL_REQUEST_TEMPLATE/release.md b/.github/PULL_REQUEST_TEMPLATE/release.md deleted file mode 100644 index d15938a3..00000000 --- a/.github/PULL_REQUEST_TEMPLATE/release.md +++ /dev/null @@ -1,22 +0,0 @@ -# Release Description - - -## Milestone - - -Milestone: - -# Release Checklist - - -- [ ] DESCRIPTION File version number has been updated -- [ ] DESCRIPTION file updated with New Developers (if applicable) -- [ ] NEWS.md has been updated and issues numbers linked -- [ ] README.md has been updated (if applicable) -- [ ] Vignettes have been updated (if applicable) -- [ ] Ensure all unit tests are passing -- [ ] Review https://r-pkgs.org/release.html for additional checks and guidance -- [ ] Use `rhub::check_for_cran()` for checking CRAN flavors before submission -- [ ] Use `usethis::use_revdep()` to check for any reverse dependencies -- [ ] GitHub actions on this PR are all passing -- [ ] Draft GitHub release created using automatic template and updated with additional details. Remember to click "release" after PR is merged. \ No newline at end of file diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index a4786bff..747fdd1c 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -17,7 +17,6 @@ _(descriptions of changes)_ - [ ] The spirit of xportr is met in your Pull Request - [ ] Place Closes # into the beginning of your Pull Request Title (Use Edit button in top-right if you need to update) - [ ] Summary of changes filled out in the above Changes Description. Can be removed or left blank if changes are minor/self-explanatory. -- [ ] Check that your Pull Request is targeting the `devel` branch, Pull Requests to `main` should use the [Release Pull Request Template](https://github.com/atorus-research/xportr/tree/94_pr_template/.github/PULL_REQUEST_TEMPLATE) - [ ] Code is formatted according to the [tidyverse style guide](https://style.tidyverse.org/). Use `styler` package and functions to style files accordingly. - [ ] Updated relevant unit tests or have written new unit tests. See our [Wiki](https://github.com/atorus-research/xportr/wiki/Style-Guide-for-Unit-Tests) for conventions used in this package. - [ ] Creation/updated relevant roxygen headers and examples. See our [Wiki](https://github.com/atorus-research/xportr/wiki/Style-Guide-for-Roxygen-Headers) for conventions used in this package. From e074d2fa4c9e42eda650737b6dda071eb0d19b0c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 23 Nov 2023 16:28:51 +0100 Subject: [PATCH 021/267] feat: introducing checkmate to label --- NAMESPACE | 6 ++++++ R/label.R | 15 ++++++++++++--- R/utils-xportr.R | 10 +++++----- R/xportr-package.R | 2 ++ tests/testthat/test-metadata.R | 16 ++++++++-------- 5 files changed, 33 insertions(+), 16 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 723f0e11..6e6bf6e0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,6 +18,12 @@ export(xportr_write) export(xpt_validate) import(haven) import(rlang) +importFrom(checkmate,assert) +importFrom(checkmate,assert_choice) +importFrom(checkmate,assert_data_frame) +importFrom(checkmate,assert_string) +importFrom(checkmate,check_data_frame) +importFrom(checkmate,check_r6) importFrom(cli,cli_alert_danger) importFrom(cli,cli_alert_info) importFrom(cli,cli_alert_success) diff --git a/R/label.R b/R/label.R index 3d422f1b..19497d9f 100644 --- a/R/label.R +++ b/R/label.R @@ -69,6 +69,14 @@ xportr_label <- function(.df, ) metadata <- metacore } + assert( + combine = "or", + check_r6(metadata, "Metacore", null.ok = TRUE), + check_data_frame(metadata, null.ok = TRUE) + ) + assert_string(domain, null.ok = TRUE) + assert_choice(verbose, choices = .internal_verbose_choices) + domain_name <- getOption("xportr.domain_name") variable_name <- getOption("xportr.variable_name") variable_label <- getOption("xportr.label") @@ -79,6 +87,7 @@ xportr_label <- function(.df, if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section + assert_data_frame(.df) # deferred after `enexpr` call metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") %||% @@ -118,10 +127,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]] } } diff --git a/R/utils-xportr.R b/R/utils-xportr.R index f97bb346..bb490ec5 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -310,11 +310,7 @@ xpt_validate <- function(data) { #' @return A string representing the domain #' @noRd get_domain <- function(.df, domain) { - if (!is.null(domain) && !is.character(domain)) { - abort(c("`domain` must be a vector with type .", - x = glue("Instead, it has type <{typeof(domain)}>.") - )) - } + assert_string(domain, null.ok = TRUE) result <- domain %||% attr(.df, "_xportr.df_arg_") result @@ -372,3 +368,7 @@ check_multiple_var_specs <- function(metadata, ) } } + +#' Internal choices for verbose option +#' @noRd +.internal_verbose_choices <- c("none", "warn", "message", "stop") diff --git a/R/xportr-package.R b/R/xportr-package.R index 701c4a52..e0626484 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -108,6 +108,8 @@ #' @importFrom tm stemDocument #' @importFrom graphics stem #' @importFrom magrittr %>% extract2 +#' @importFrom checkmate assert assert_string assert_choice assert_data_frame +#' check_r6 check_data_frame #' "_PACKAGE" diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index c74f906e..573f11df 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -146,11 +146,11 @@ test_that("xportr_label: Expect error if domain is not a character", { expect_error( xportr_label(df, df_meta, domain = 1), - "`domain` must be a vector with type ." + "Assertion on 'domain' failed: Must be of type 'string' \\(or 'NULL'\\), not '.*'\\." ) expect_error( xportr_label(df, df_meta, domain = NA), - "`domain` must be a vector with type ." + "Assertion on 'domain' failed: May not be NA\\." ) }) @@ -258,11 +258,11 @@ test_that("xportr_df_label: Expect error if domain is not a character", { expect_error( xportr_df_label(df, df_meta, domain = 1), - "`domain` must be a vector with type ." + "Assertion on 'domain' failed: Must be of type 'string' \\(or 'NULL'\\), not '.*'\\." ) expect_error( xportr_df_label(df, df_meta, domain = NA), - "`domain` must be a vector with type ." + "Assertion on 'domain' failed: May not be NA\\." ) }) @@ -386,11 +386,11 @@ test_that("xportr_format: Expect error if domain is not a character", { expect_error( xportr_format(df, df_meta, 1), - "`domain` must be a vector with type ." + "Assertion on 'domain' failed: Must be of type 'string' \\(or 'NULL'\\), not '.*'\\." ) expect_error( xportr_format(df, df_meta, NA), - "`domain` must be a vector with type ." + "Assertion on 'domain' failed: May not be NA\\." ) }) @@ -536,11 +536,11 @@ test_that("xportr_length: Expect error if domain is not a character", { expect_error( xportr_length(df, df_meta, 1), - "`domain` must be a vector with type ." + "Assertion on 'domain' failed: Must be of type 'string' \\(or 'NULL'\\), not '.*'\\." ) expect_error( xportr_length(df, df_meta, NA), - "`domain` must be a vector with type ." + "Assertion on 'domain' failed: May not be NA\\." ) }) From be353a6e9497e000112a55817e905acf67242192 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 23 Nov 2023 16:44:16 +0100 Subject: [PATCH 022/267] feat: checkmate support in df_label --- NAMESPACE | 1 + R/df_label.R | 12 +++++++++--- R/xportr-package.R | 2 +- 3 files changed, 11 insertions(+), 4 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 6e6bf6e0..ed9a76ca 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -24,6 +24,7 @@ importFrom(checkmate,assert_data_frame) importFrom(checkmate,assert_string) importFrom(checkmate,check_data_frame) importFrom(checkmate,check_r6) +importFrom(checkmate,test_string) importFrom(cli,cli_alert_danger) importFrom(cli,cli_alert_info) importFrom(cli,cli_alert_success) diff --git a/R/df_label.R b/R/df_label.R index 5009335d..5d2239e8 100644 --- a/R/df_label.R +++ b/R/df_label.R @@ -51,6 +51,13 @@ xportr_df_label <- function(.df, ) metadata <- metacore } + assert( + combine = "or", + check_r6(metadata, "Metacore", null.ok = TRUE), + check_data_frame(metadata, null.ok = TRUE) + ) + assert_string(domain, null.ok = TRUE) + domain_name <- getOption("xportr.df_domain_name") label_name <- getOption("xportr.df_label") @@ -60,6 +67,7 @@ xportr_df_label <- function(.df, if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section + assert_data_frame(.df) # deferred after `enexpr` call ## Pull out correct metadata metadata <- metadata %||% @@ -76,9 +84,7 @@ xportr_df_label <- function(.df, # 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.") } diff --git a/R/xportr-package.R b/R/xportr-package.R index e0626484..e5aa2cde 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -109,7 +109,7 @@ #' @importFrom graphics stem #' @importFrom magrittr %>% extract2 #' @importFrom checkmate assert assert_string assert_choice assert_data_frame -#' check_r6 check_data_frame +#' check_r6 check_data_frame test_string #' "_PACKAGE" From 9c0ab66fc4e593875e23801169141ac0820d3edb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 23 Nov 2023 16:46:43 +0100 Subject: [PATCH 023/267] feat: checkmate support in format --- R/format.R | 10 +++++++++- R/xportr-package.R | 2 +- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/R/format.R b/R/format.R index 864faaf4..884a731c 100644 --- a/R/format.R +++ b/R/format.R @@ -53,6 +53,13 @@ xportr_format <- function(.df, ) metadata <- metacore } + assert( + combine = "or", + check_r6(metadata, "Metacore", null.ok = TRUE), + check_data_frame(metadata, null.ok = TRUE) + ) + assert_string(domain, null.ok = TRUE) + domain_name <- getOption("xportr.domain_name") format_name <- getOption("xportr.format_name") variable_name <- getOption("xportr.variable_name") @@ -63,12 +70,13 @@ xportr_format <- function(.df, if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section + assert_data_frame(.df) # deferred after `enexpr` call metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") %||% rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`") - if (inherits(metadata, "Metacore")) { + if (test_r6(metadata, "Metacore")) { metadata <- metadata$var_spec } diff --git a/R/xportr-package.R b/R/xportr-package.R index e5aa2cde..e239af12 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -109,7 +109,7 @@ #' @importFrom graphics stem #' @importFrom magrittr %>% extract2 #' @importFrom checkmate assert assert_string assert_choice assert_data_frame -#' check_r6 check_data_frame test_string +#' check_r6 check_data_frame test_string test_r6 #' "_PACKAGE" From 7eee7404be88086fe4977f49eaf414f7df2bc5fd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 23 Nov 2023 16:57:42 +0100 Subject: [PATCH 024/267] feat: checkmate support in length and messages --- NAMESPACE | 2 ++ R/length.R | 12 ++++++++++-- R/messages.R | 10 ++++++++++ R/xportr-package.R | 2 +- 4 files changed, 23 insertions(+), 3 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index ed9a76ca..eafd5ee9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -19,11 +19,13 @@ 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_string) importFrom(checkmate,check_data_frame) importFrom(checkmate,check_r6) +importFrom(checkmate,test_r6) importFrom(checkmate,test_string) importFrom(cli,cli_alert_danger) importFrom(cli,cli_alert_info) diff --git a/R/length.R b/R/length.R index 81864c2b..7f925c22 100644 --- a/R/length.R +++ b/R/length.R @@ -76,6 +76,14 @@ xportr_length <- function(.df, ) metadata <- metacore } + assert( + combine = "or", + check_r6(metadata, "Metacore", null.ok = TRUE), + check_data_frame(metadata, null.ok = TRUE) + ) + assert_string(domain, null.ok = TRUE) + assert_choice(verbose, choices = .internal_verbose_choices) + domain_name <- getOption("xportr.domain_name") variable_length <- getOption("xportr.length") variable_name <- getOption("xportr.variable_name") @@ -86,12 +94,13 @@ xportr_length <- function(.df, if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section + assert_data_frame(.df) # deferred after `enexpr` call metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") %||% rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`") - if (inherits(metadata, "Metacore")) { + if (test_r6(metadata, "Metacore")) { metadata <- metadata$var_spec } @@ -103,7 +112,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]]) diff --git a/R/messages.R b/R/messages.R index 6c4e21c0..6057491c 100644 --- a/R/messages.R +++ b/R/messages.R @@ -97,6 +97,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") @@ -119,6 +122,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") @@ -141,6 +147,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( diff --git a/R/xportr-package.R b/R/xportr-package.R index e239af12..4c2a22b8 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -109,7 +109,7 @@ #' @importFrom graphics stem #' @importFrom magrittr %>% extract2 #' @importFrom checkmate assert assert_string assert_choice assert_data_frame -#' check_r6 check_data_frame test_string test_r6 +#' check_r6 check_data_frame test_string test_r6 assert_character #' "_PACKAGE" From b778b78e618c0548ec42f9d0108b349b56b38930 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 23 Nov 2023 17:03:28 +0100 Subject: [PATCH 025/267] feat: checkmate support in metadata --- R/metadata.R | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/R/metadata.R b/R/metadata.R index 926de49e..e19ea05f 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -41,14 +41,22 @@ #' xportr_order() #' } xportr_metadata <- function(.df, metadata, domain = NULL) { + assert( + combine = "or", + check_r6(metadata, "Metacore", null.ok = TRUE), + check_data_frame(metadata, null.ok = TRUE) + ) + assert_string(domain, null.ok = TRUE) + ## Common section to detect domain from argument or pipes domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section + assert_data_frame(.df) # deferred after `enexpr` call - structure(.df, `_xportr.df_metadata_` = metadata) + structure(.df, "_xportr.df_metadata_" = metadata) } From 68bea69a23e03db56ca963a0972d20c5327d358a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 23 Nov 2023 17:16:16 +0100 Subject: [PATCH 026/267] feat: checkmate support in order --- R/order.R | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/R/order.R b/R/order.R index 43ea130d..70ffbfbf 100644 --- a/R/order.R +++ b/R/order.R @@ -72,6 +72,14 @@ xportr_order <- function(.df, ) metadata <- metacore } + assert( + combine = "or", + check_r6(metadata, "Metacore", null.ok = TRUE), + check_data_frame(metadata, null.ok = TRUE) + ) + assert_string(domain, null.ok = TRUE) + assert_choice(verbose, choices = .internal_verbose_choices) + domain_name <- getOption("xportr.domain_name") order_name <- getOption("xportr.order_name") variable_name <- getOption("xportr.variable_name") @@ -82,12 +90,13 @@ xportr_order <- function(.df, if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section + assert_data_frame(.df) # deferred after `enexpr` call metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") %||% rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`") - if (inherits(metadata, "Metacore")) { + if (test_r6(metadata, "Metacore")) { metadata <- metadata$ds_vars } From 7913b2166c4af6cd26025f99d08df6f83de260b1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 23 Nov 2023 17:26:19 +0100 Subject: [PATCH 027/267] feat: checkmate support in type --- NAMESPACE | 1 + R/messages.R | 4 ++++ R/type.R | 13 +++++++++++-- R/xportr-package.R | 2 +- 4 files changed, 17 insertions(+), 3 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index eafd5ee9..a7ac18fa 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -22,6 +22,7 @@ importFrom(checkmate,assert) importFrom(checkmate,assert_character) importFrom(checkmate,assert_choice) importFrom(checkmate,assert_data_frame) +importFrom(checkmate,assert_integer) importFrom(checkmate,assert_string) importFrom(checkmate,check_data_frame) importFrom(checkmate,check_r6) diff --git a/R/messages.R b/R/messages.R index 6057491c..0c56784c 100644 --- a/R/messages.R +++ b/R/messages.R @@ -76,6 +76,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") diff --git a/R/type.R b/R/type.R index c04ac317..5814e569 100644 --- a/R/type.R +++ b/R/type.R @@ -89,6 +89,14 @@ xportr_type <- function(.df, ) metadata <- metacore } + assert( + combine = "or", + check_r6(metadata, "Metacore", null.ok = TRUE), + check_data_frame(metadata, null.ok = TRUE) + ) + assert_string(domain, null.ok = TRUE) + assert_choice(verbose, choices = .internal_verbose_choices) + # Name of the columns for working with metadata domain_name <- getOption("xportr.domain_name") variable_name <- getOption("xportr.variable_name") @@ -103,13 +111,14 @@ xportr_type <- function(.df, if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section + assert_data_frame(.df) # deferred after `enexpr` call ## Pull out correct metadata metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") %||% rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`") - if (inherits(metadata, "Metacore")) { + if (test_r6(metadata, "Metacore")) { metadata <- metadata$var_spec } @@ -155,7 +164,7 @@ xportr_type <- function(.df, type_log(meta_ordered, type_mismatch_ind, verbose) # Check if variable types match - is_correct <- sapply(meta_ordered[["type.x"]] == meta_ordered[["type.y"]], isTRUE) + is_correct <- vapply(meta_ordered[["type.x"]] == meta_ordered[["type.y"]], isTRUE, logical(1)) # Use the original variable iff metadata is missing that variable correct_type <- ifelse(is.na(meta_ordered[["type.y"]]), meta_ordered[["type.x"]], meta_ordered[["type.y"]]) diff --git a/R/xportr-package.R b/R/xportr-package.R index 4c2a22b8..983eb736 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -109,7 +109,7 @@ #' @importFrom graphics stem #' @importFrom magrittr %>% extract2 #' @importFrom checkmate assert assert_string assert_choice assert_data_frame -#' check_r6 check_data_frame test_string test_r6 assert_character +#' check_r6 check_data_frame test_string test_r6 assert_character assert_integer #' "_PACKAGE" From a6d565c2910e2767980155570a76c562d5817b2a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 23 Nov 2023 18:58:01 +0100 Subject: [PATCH 028/267] feat: checkmate support in write --- NAMESPACE | 1 + R/write.R | 15 ++++++++------- R/xportr-package.R | 1 + 3 files changed, 10 insertions(+), 7 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index a7ac18fa..4e955824 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -23,6 +23,7 @@ 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) diff --git a/R/write.R b/R/write.R index 57367fc2..930671ea 100644 --- a/R/write.R +++ b/R/write.R @@ -39,25 +39,26 @@ #' ) #' xportr_write <- function(.df, path, label = NULL, strict_checks = FALSE) { + assert_data_frame(.df) + assert_string(path) + assert_string(label, null.ok = TRUE, max.chars = 40) + assert_logical(strict_checks) + path <- normalizePath(path, mustWork = FALSE) name <- tools::file_path_sans_ext(basename(path)) if (nchar(name) > 8) { - abort("`.df` file name must be 8 characters or less.") + abort("Assertion on file name from `path` failed: Must be 8 characters or less.") } if (stringr::str_detect(name, "[^a-zA-Z0-9]")) { - abort("`.df` cannot contain any non-ASCII, symbol or underscore characters.") + abort("Assertion on file name from `path` failed: Must not contain any non-ASCII, symbol or underscore characters.") } if (!is.null(label)) { - if (nchar(label) > 40) { - abort("`label` must be 40 characters or less.") - } - if (stringr::str_detect(label, "[^[:ascii:]]")) { - abort("`label` cannot contain any non-ASCII, symbol or special characters.") + abort("Assertion on `label` failed: Must not contain any non-ASCII, symbol or special characters.") } attr(.df, "label") <- label diff --git a/R/xportr-package.R b/R/xportr-package.R index 983eb736..07bde629 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -110,6 +110,7 @@ #' @importFrom magrittr %>% extract2 #' @importFrom checkmate assert assert_string assert_choice assert_data_frame #' check_r6 check_data_frame test_string test_r6 assert_character assert_integer +#' assert_logical #' "_PACKAGE" From f50346b68d69a408878d457b23643831f3347990 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 23 Nov 2023 19:24:51 +0100 Subject: [PATCH 029/267] feat: adds assertion to exported functions --- R/messages.R | 6 ++++++ R/utils-xportr.R | 2 ++ 2 files changed, 8 insertions(+) diff --git a/R/messages.R b/R/messages.R index 0c56784c..429388f8 100644 --- a/R/messages.R +++ b/R/messages.R @@ -10,6 +10,9 @@ #' @return Output to Console #' @export xportr_logger <- function(message, type = "none", ...) { + assert_character(message) + assert_choice(verbose, choices = .internal_verbose_choices) + log_fun <- switch(type, stop = abort, warn = warn, @@ -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( diff --git a/R/utils-xportr.R b/R/utils-xportr.R index bb490ec5..0ef807fb 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -184,6 +184,8 @@ xpt_validate_var_names <- function(varnames, #' #' @export xpt_validate <- function(data) { + assert_data_frame(data) + err_cnd <- character() # 1.0 VARIABLES ---- From d59c241215958e43c79e60ccd66111047c0b70c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 23 Nov 2023 19:34:04 +0100 Subject: [PATCH 030/267] fix: problem with xportr_logger --- DESCRIPTION | 1 + R/messages.R | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 61e81239..ed7dd83e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -47,6 +47,7 @@ Description: Tools to build CDISC compliant data sets and check for CDISC compli URL: https://github.com/atorus-research/xportr BugReports: https://github.com/atorus-research/xportr/issues Imports: + checkmate, dplyr (>= 1.0.2), purrr (>= 0.3.4), stringr (>= 1.4.0), diff --git a/R/messages.R b/R/messages.R index 429388f8..50b4df7c 100644 --- a/R/messages.R +++ b/R/messages.R @@ -11,7 +11,7 @@ #' @export xportr_logger <- function(message, type = "none", ...) { assert_character(message) - assert_choice(verbose, choices = .internal_verbose_choices) + assert_choice(type, choices = .internal_verbose_choices) log_fun <- switch(type, stop = abort, From 531f7063bb09f32a97eedebda961d108516405c1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 30 Nov 2023 17:56:47 +0100 Subject: [PATCH 031/267] fix: move assert dataframe up --- R/df_label.R | 2 +- R/format.R | 2 +- R/label.R | 2 +- R/length.R | 2 +- R/metadata.R | 2 +- R/order.R | 2 +- R/type.R | 2 +- 7 files changed, 7 insertions(+), 7 deletions(-) diff --git a/R/df_label.R b/R/df_label.R index 5d2239e8..e5fc5545 100644 --- a/R/df_label.R +++ b/R/df_label.R @@ -51,6 +51,7 @@ xportr_df_label <- function(.df, ) metadata <- metacore } + assert_data_frame(.df) assert( combine = "or", check_r6(metadata, "Metacore", null.ok = TRUE), @@ -67,7 +68,6 @@ xportr_df_label <- function(.df, if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section - assert_data_frame(.df) # deferred after `enexpr` call ## Pull out correct metadata metadata <- metadata %||% diff --git a/R/format.R b/R/format.R index 884a731c..8c945049 100644 --- a/R/format.R +++ b/R/format.R @@ -53,6 +53,7 @@ xportr_format <- function(.df, ) metadata <- metacore } + assert_data_frame(.df) assert( combine = "or", check_r6(metadata, "Metacore", null.ok = TRUE), @@ -70,7 +71,6 @@ xportr_format <- function(.df, if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section - assert_data_frame(.df) # deferred after `enexpr` call metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") %||% diff --git a/R/label.R b/R/label.R index 19497d9f..edfdba2e 100644 --- a/R/label.R +++ b/R/label.R @@ -69,6 +69,7 @@ xportr_label <- function(.df, ) metadata <- metacore } + assert_data_frame(.df) assert( combine = "or", check_r6(metadata, "Metacore", null.ok = TRUE), @@ -87,7 +88,6 @@ xportr_label <- function(.df, if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section - assert_data_frame(.df) # deferred after `enexpr` call metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") %||% diff --git a/R/length.R b/R/length.R index 7f925c22..21b6b152 100644 --- a/R/length.R +++ b/R/length.R @@ -76,6 +76,7 @@ xportr_length <- function(.df, ) metadata <- metacore } + assert_data_frame(.df) assert( combine = "or", check_r6(metadata, "Metacore", null.ok = TRUE), @@ -94,7 +95,6 @@ xportr_length <- function(.df, if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section - assert_data_frame(.df) # deferred after `enexpr` call metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") %||% diff --git a/R/metadata.R b/R/metadata.R index e19ea05f..e427eb43 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -41,6 +41,7 @@ #' xportr_order() #' } xportr_metadata <- function(.df, metadata, domain = NULL) { + assert_data_frame(.df) assert( combine = "or", check_r6(metadata, "Metacore", null.ok = TRUE), @@ -54,7 +55,6 @@ xportr_metadata <- function(.df, metadata, domain = NULL) { if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section - assert_data_frame(.df) # deferred after `enexpr` call structure(.df, "_xportr.df_metadata_" = metadata) } diff --git a/R/order.R b/R/order.R index 70ffbfbf..4a9d7915 100644 --- a/R/order.R +++ b/R/order.R @@ -72,6 +72,7 @@ xportr_order <- function(.df, ) metadata <- metacore } + assert_data_frame(.df) assert( combine = "or", check_r6(metadata, "Metacore", null.ok = TRUE), @@ -90,7 +91,6 @@ xportr_order <- function(.df, if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section - assert_data_frame(.df) # deferred after `enexpr` call metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") %||% diff --git a/R/type.R b/R/type.R index 5814e569..53ce1cd1 100644 --- a/R/type.R +++ b/R/type.R @@ -89,6 +89,7 @@ xportr_type <- function(.df, ) metadata <- metacore } + assert_data_frame(.df) assert( combine = "or", check_r6(metadata, "Metacore", null.ok = TRUE), @@ -111,7 +112,6 @@ xportr_type <- function(.df, if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section - assert_data_frame(.df) # deferred after `enexpr` call ## Pull out correct metadata metadata <- metadata %||% From 14b006ddf787e5580688224543ac8d4c450f6c7e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 30 Nov 2023 18:02:54 +0100 Subject: [PATCH 032/267] styler: remove empty space --- R/metadata.R | 1 - tests/testthat/test-pipe.R | 1 - 2 files changed, 2 deletions(-) diff --git a/R/metadata.R b/R/metadata.R index e427eb43..f1fd9701 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -69,7 +69,6 @@ xportr_metadata <- function(.df, metadata, domain = NULL) { #' #' @rdname metadata xportr_domain_name <- function(.df, domain) { - attr(.df, "_xportr.df_arg_") <- domain .df diff --git a/tests/testthat/test-pipe.R b/tests/testthat/test-pipe.R index 6f9bafb5..90876763 100644 --- a/tests/testthat/test-pipe.R +++ b/tests/testthat/test-pipe.R @@ -1,4 +1,3 @@ - test_that("xportr_*: Domain is kept in between calls", { # Divert all messages to tempfile, instead of printing them # note: be aware as this should only be used in tests that don't track From 9a7401e67bdb92365ef866ba7a65b80077dbd003 Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 5 Dec 2023 05:33:24 +0530 Subject: [PATCH 033/267] feat: add vbump CI and update the PR teamplate --- .github/pull_request_template.md | 17 +++++++++-------- .github/workflows/check-links.yml | 6 ++++-- .github/workflows/check-standard.yaml | 16 +++++++++------- .github/workflows/lint.yaml | 6 ++++-- .github/workflows/pkgdown.yaml | 1 - .github/workflows/spellcheck.yml | 2 -- .github/workflows/style.yml | 6 ++++-- .github/workflows/test-coverage.yaml | 2 -- .github/workflows/vbump.yaml | 14 ++++++++++++++ DESCRIPTION | 2 +- NEWS.md | 8 +++----- 11 files changed, 48 insertions(+), 32 deletions(-) create mode 100644 .github/workflows/vbump.yaml diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index 747fdd1c..83a0dbad 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -1,29 +1,30 @@ -### Thank you for your Pull Request! +### Thank you for your Pull Request! -We have developed a Pull Request template to aid you and our reviewers. Completing the below tasks helps to ensure our reviewers can maximize their time on your code as well as making sure the xportr codebase remains robust and consistent. +We have developed a Pull Request template to aid you and our reviewers. Completing the below tasks helps to ensure our reviewers can maximize their time on your code as well as making sure the xportr codebase remains robust and consistent. ### The scope of `{xportr}` -`{xportr}`'s scope is to enable R users to write out submission compliant `xpt` files that can be delivered to a Health Authority or to downstream validation software programs. We see labels, lengths, types, ordering and formats from a dataset specification object (SDTM and ADaM) as being our primary focus. We also see messaging and warnings to users around applying information from the specification file as a primary focus. Please make sure your Pull Request meets this **scope of {xportr}**. If your Pull Request moves beyond this scope, please get in touch with the `{xportr}` team on [slack](https://pharmaverse.slack.com/archives/C030EB2M4GM) or create an issue to discuss. +`{xportr}`'s scope is to enable R users to write out submission compliant `xpt` files that can be delivered to a Health Authority or to downstream validation software programs. We see labels, lengths, types, ordering and formats from a dataset specification object (SDTM and ADaM) as being our primary focus. We also see messaging and warnings to users around applying information from the specification file as a primary focus. Please make sure your Pull Request meets this **scope of {xportr}**. If your Pull Request moves beyond this scope, please get in touch with the `{xportr}` team on [slack](https://pharmaverse.slack.com/archives/C030EB2M4GM) or create an issue to discuss. Please check off each task box as an acknowledgment that you completed the task. This checklist is part of the Github Action workflows and the Pull Request will not be merged into the `devel` branch until you have checked off each task. ### Changes Description -_(descriptions of changes)_ +_(descriptions of changes)_ ### Task List - [ ] The spirit of xportr is met in your Pull Request - [ ] Place Closes # into the beginning of your Pull Request Title (Use Edit button in top-right if you need to update) -- [ ] Summary of changes filled out in the above Changes Description. Can be removed or left blank if changes are minor/self-explanatory. -- [ ] Code is formatted according to the [tidyverse style guide](https://style.tidyverse.org/). Use `styler` package and functions to style files accordingly. +- [ ] Summary of changes filled out in the above Changes Description. Can be removed or left blank if changes are minor/self-explanatory. +- [ ] Code is formatted according to the [tidyverse style guide](https://style.tidyverse.org/). Use `styler` package and functions to style files accordingly. - [ ] Updated relevant unit tests or have written new unit tests. See our [Wiki](https://github.com/atorus-research/xportr/wiki/Style-Guide-for-Unit-Tests) for conventions used in this package. - [ ] Creation/updated relevant roxygen headers and examples. See our [Wiki](https://github.com/atorus-research/xportr/wiki/Style-Guide-for-Roxygen-Headers) for conventions used in this package. - [ ] Run `devtools::document()` so all `.Rd` files in the `man` folder and the `NAMESPACE` file in the project root are updated appropriately - [ ] Run `pkgdown::build_site()` and check that all affected examples are displayed correctly and that all new/updated functions occur on the "Reference" page. - [ ] Update NEWS.md if the changes pertain to a user-facing function (i.e. it has an @export tag) or documentation aimed at users (rather than developers) +- [ ] Make sure that the pacakge version in the NEWS.md and DESCRIPTION file is same. Don't worry about updating the version because it will be auto-updated using the `vbump.yaml` CI. - [ ] Address any updates needed for vignettes and/or templates - [ ] Link the issue Development Panel so that it closes after successful merging. -- [ ] Fix merge conflicts -- [ ] Pat yourself on the back for a job well done! Much love to your accomplishment! +- [ ] Fix merge conflicts +- [ ] Pat yourself on the back for a job well done! Much love to your accomplishment! diff --git a/.github/workflows/check-links.yml b/.github/workflows/check-links.yml index 230e521b..21e50fa5 100644 --- a/.github/workflows/check-links.yml +++ b/.github/workflows/check-links.yml @@ -2,9 +2,11 @@ name: Check URLs 🔗 on: push: - branches: [main] + branches: + - main pull_request: - branches: [main, devel] + branches: + - main jobs: links: diff --git a/.github/workflows/check-standard.yaml b/.github/workflows/check-standard.yaml index c9239381..05c1b71c 100644 --- a/.github/workflows/check-standard.yaml +++ b/.github/workflows/check-standard.yaml @@ -4,9 +4,11 @@ name: R-CMD-check 📦 on: push: - branches: [main, devel] + branches: + - main pull_request: - branches: [main, devel] + branches: + - main jobs: R-CMD-check: @@ -18,11 +20,11 @@ jobs: fail-fast: false matrix: config: - - {os: macOS-latest, r: 'release'} - - {os: windows-latest, r: 'release'} - - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} - - {os: ubuntu-latest, r: 'release'} - - {os: ubuntu-latest, r: 'oldrel-1'} + - { os: macOS-latest, r: "release" } + - { os: windows-latest, r: "release" } + - { os: ubuntu-latest, r: "devel", http-user-agent: "release" } + - { os: ubuntu-latest, r: "release" } + - { os: ubuntu-latest, r: "oldrel-1" } env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml index cee715dc..85e6a1b3 100644 --- a/.github/workflows/lint.yaml +++ b/.github/workflows/lint.yaml @@ -4,9 +4,11 @@ name: Check Lint 🧹 on: push: - branches: [main] + branches: + - main pull_request: - branches: [main, devel] + branches: + - main jobs: lint: diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 16404107..967eb46d 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -4,7 +4,6 @@ on: push: branches: - main - - master jobs: pkgdown: diff --git a/.github/workflows/spellcheck.yml b/.github/workflows/spellcheck.yml index 42c7e327..5c7adb19 100644 --- a/.github/workflows/spellcheck.yml +++ b/.github/workflows/spellcheck.yml @@ -5,11 +5,9 @@ on: push: branches: - main - - devel pull_request: branches: - main - - devel concurrency: group: spelling-${{ github.event.pull_request.number || github.ref }} diff --git a/.github/workflows/style.yml b/.github/workflows/style.yml index fc779f37..410da4b5 100644 --- a/.github/workflows/style.yml +++ b/.github/workflows/style.yml @@ -2,9 +2,11 @@ name: Check Style 🎨 on: push: - branches: [main] + branches: + - main pull_request: - branches: [main, devel] + branches: + - main concurrency: group: style-${{ github.event.pull_request.number || github.ref }} diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index dadf5abe..43ae648d 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -4,11 +4,9 @@ on: push: branches: - main - - master pull_request: branches: - main - - master jobs: test-coverage: diff --git a/.github/workflows/vbump.yaml b/.github/workflows/vbump.yaml new file mode 100644 index 00000000..a2091019 --- /dev/null +++ b/.github/workflows/vbump.yaml @@ -0,0 +1,14 @@ +name: Version Bump ⬆️ + +on: + push: + branches: + - main + +jobs: + vbump: + name: Version Bump 🤜🤛 + if: github.event_name == 'push' + uses: insightsengineering/r.pkg.template/.github/workflows/version-bump.yaml@main + secrets: + REPO_GITHUB_TOKEN: ${{ secrets.REPO_GITHUB_TOKEN }} diff --git a/DESCRIPTION b/DESCRIPTION index 4e813ef9..61e81239 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9000 +Version: 0.3.1 Authors@R: c( person(given = "Eli", diff --git a/NEWS.md b/NEWS.md index 07babb71..08ab28de 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,17 +1,15 @@ -# xportr (development version) +# xportr 0.3.1 ## New Features and Bug Fixes +* Make `xportr_type()` drop factor levels when coercing variables + ## Documentation * Set up Development version of Website (#187) ## Deprecation and Breaking Changes -# xportr 0.3.1 - -* Make `xportr_type()` drop factor levels when coercing variables - # xportr 0.3.0 ## New Features and Bug Fixes From 338739eed385b7b6bf98498eb96bfa7176db7916 Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 5 Dec 2023 06:00:30 +0530 Subject: [PATCH 034/267] fix: use `xportr_df_label` to set the dataset label before writing it --- README.Rmd | 6 ++++++ README.md | 5 +++++ vignettes/deepdive.Rmd | 14 ++++++++++++-- 3 files changed, 23 insertions(+), 2 deletions(-) diff --git a/README.Rmd b/README.Rmd index 2d41e159..89d6e94b 100644 --- a/README.Rmd +++ b/README.Rmd @@ -19,6 +19,7 @@ library(fontawesome) # xportr +[](https://RValidationHub.slack.com) [![R build status](https://github.com/atorus-research/xportr/workflows/R-CMD-check/badge.svg)](https://github.com/atorus-research/xportr/actions?workflow=R-CMD-check) [](https://app.codecov.io/gh/atorus-research/xportr) [](https://github.com/atorus-research/xportr/blob/master/LICENSE) @@ -121,6 +122,9 @@ spec_path <- system.file(paste0("specs/", "ADaM_admiral_spec.xlsx"), package = " var_spec <- readxl::read_xlsx(spec_path, sheet = "Variables") %>% dplyr::rename(type = "Data Type") %>% rlang::set_names(tolower) +dataset_spec <- readxl::read_xlsx(spec_path, sheet = "Datasets") %>% + dplyr::rename(label = "Description") %>% + rlang::set_names(tolower) ``` Each `xportr_` function has been written in a way to take in a part of the specification file and apply that piece to the dataset. Setting `verbose = "warn"` will send appropriate warning message to the console. We have suppressed the warning for the sake of brevity. @@ -132,6 +136,7 @@ adsl %>% xportr_label(var_spec, "ADSL", verbose = "warn") %>% xportr_order(var_spec, "ADSL", verbose = "warn") %>% xportr_format(var_spec, "ADSL") %>% + xportr_df_label(dataset_spec, "ADSL") %>% xportr_write("adsl.xpt") ``` @@ -145,6 +150,7 @@ adsl %>% xportr_label() %>% xportr_order() %>% xportr_format() %>% + xportr_df_label(dataset_spec) %>% xportr_write("adsl.xpt") ``` diff --git a/README.md b/README.md index 675ca401..147964b2 100644 --- a/README.md +++ b/README.md @@ -126,6 +126,9 @@ spec_path <- system.file(paste0("specs/", "ADaM_admiral_spec.xlsx"), package = " var_spec <- readxl::read_xlsx(spec_path, sheet = "Variables") %>% dplyr::rename(type = "Data Type") %>% rlang::set_names(tolower) +dataset_spec <- readxl::read_xlsx(spec_path, sheet = "Datasets") %>% + dplyr::rename(label = "Description") %>% + rlang::set_names(tolower) ``` Each `xportr_` function has been written in a way to take in a part of @@ -140,6 +143,7 @@ adsl %>% xportr_label(var_spec, "ADSL", verbose = "warn") %>% xportr_order(var_spec, "ADSL", verbose = "warn") %>% xportr_format(var_spec, "ADSL") %>% + xportr_df_label(dataset_spec, "ADSL") %>% xportr_write("adsl.xpt") ``` @@ -156,6 +160,7 @@ adsl %>% xportr_label() %>% xportr_order() %>% xportr_format() %>% + xportr_df_label(dataset_spec) %>% xportr_write("adsl.xpt") ``` diff --git a/vignettes/deepdive.Rmd b/vignettes/deepdive.Rmd index 72af4bca..5567e14f 100644 --- a/vignettes/deepdive.Rmd +++ b/vignettes/deepdive.Rmd @@ -171,6 +171,7 @@ adsl %>% xportr_label(var_spec, "ADSL", "message") %>% xportr_order(var_spec, "ADSL", "message") %>% xportr_format(var_spec, "ADSL") %>% + xportr_df_label(dataset_spec, "ADSL") %>% xportr_write("adsl.xpt") ``` @@ -185,6 +186,7 @@ adsl %>% xportr_label() %>% xportr_order() %>% xportr_format() %>% + xportr_df_label(dataset_spec) %>% xportr_write("adsl.xpt") ``` @@ -198,11 +200,16 @@ For the next six sections, we are going to explore the Warnings and Errors messa ### Setting up our metadata object First, let's read in the specification file and call it `var_spec`. Note that we are not using `options()` here. We will do some slight manipulation to the column names by doing all lower case, and changing `Data Type` to `type` and making the Order column numeric. You can also use `options()` for this step as well. The `var_spec` object has five dataset specification files stacked on top of each other. We will make use of the `ADSL` subset of `var_spec`. You can make use of the Search field above the dataset column to subset the specification file for `ADSL` +Similarly, we can read the Dataset spec file and call it `dataset_spec`. ```{r} var_spec <- var_spec %>% rename(type = "Data Type") %>% set_names(tolower) + +dataset_spec <- readxl::read_xlsx(spec_path, sheet = "Datasets") %>% + rename(label = "Description") %>% + set_names(tolower) ``` ```{r, echo = FALSE} @@ -400,7 +407,8 @@ At the time of `{xportr} v0.3.0` we have not implemented any warnings or error m Finally, we want to write out an `xpt` dataset with all our metadata applied. -We will make use of `xportr_metadata()` to reduce repetitive metadata and domain specifications. We will use default option for verbose, which is just `message` and so not set anything for `verbose`. In `xportr_write()` we will specify the path, which will just be our current working directory, set the dataset label and toggle the `strict_checks` to be `FALSE`. +We will make use of `xportr_metadata()` to reduce repetitive metadata and domain specifications. We will use default option for verbose, which is just `message` and so not set anything for `verbose`. In `xportr_write()` we will specify the path, which will just be our current working directory, set the dataset label and toggle the `strict_checks` to be `FALSE`. +It is also note worthy that you can set the dataset label using the `xportr_df_label` and a `dataset_spec` which will be used by the `xportr_write()` ```{r, echo = TRUE, error = TRUE} adsl %>% @@ -410,6 +418,7 @@ adsl %>% xportr_label() %>% xportr_order() %>% xportr_format() %>% + xportr_df_label(dataset_spec) %>% xportr_write(path = "adsl.xpt", strict_checks = FALSE) ``` @@ -419,7 +428,7 @@ The next two examples showcase the `strict_checks = TRUE` option in `xportr_writ ```{r, echo = TRUE, error = TRUE} adsl %>% - xportr_write(path = "adsl.xpt", strict_checks = TRUE) + xportr_write(path = "adsl.xpt", metadata = dataset_spec, domain = "ADSL", strict_checks = TRUE) ``` @@ -439,6 +448,7 @@ adsl %>% xportr_label() %>% xportr_type() %>% xportr_format() %>% + xportr_df_label(dataset_spec) %>% xportr_write(path = "adsl.xpt", strict_checks = TRUE) ``` From 4c2f3766469c35d9278e3faaeb421c5ea389bb15 Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 5 Dec 2023 06:03:51 +0530 Subject: [PATCH 035/267] chore: use the proper version numbers --- DESCRIPTION | 2 +- NEWS.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 28b9ff0b..4e813ef9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9001 +Version: 0.3.1.9000 Authors@R: c( person(given = "Eli", diff --git a/NEWS.md b/NEWS.md index b1ef4a4d..53462ac2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# xportr 0.3.1.9001 +# xportr 0.3.1.9000 ## New Features and Bug Fixes * `xportr_write()` now accepts `metadata` argument which can be used to set the dataset label to stay consistent with the other `xportr_*` functions. It is noteworthy that the dataset label set using the `xportr_df_label()` function will be retained during the `xportr_write()`. From 907e91b0ab351931468d6428d73c8300b3cd94c0 Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 5 Dec 2023 06:23:26 +0530 Subject: [PATCH 036/267] feat: exporting the `dataset_spec` similar to `var_spec` --- NEWS.md | 1 + R/data.R | 19 ++++++++++++++++++- _pkgdown.yml | 1 + data/dataset_spec.rda | Bin 0 -> 310 bytes vignettes/deepdive.Rmd | 2 +- 5 files changed, 21 insertions(+), 2 deletions(-) create mode 100644 data/dataset_spec.rda diff --git a/NEWS.md b/NEWS.md index 00cbce19..1800f0d5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,7 @@ ## New Features and Bug Fixes * `xportr_write()` now accepts `metadata` argument which can be used to set the dataset label to stay consistent with the other `xportr_*` functions. It is noteworthy that the dataset label set using the `xportr_df_label()` function will be retained during the `xportr_write()`. +* Exporting a new dataset `dataset_spec` that contains the Dataset Specification for ADSL. ## Deprecation and Breaking Changes * The `label` argument from the `xportr_write()` function is deprecated in favor of the `metadata` argument. diff --git a/R/data.R b/R/data.R index 96e24de2..ca83a2a6 100644 --- a/R/data.R +++ b/R/data.R @@ -56,7 +56,7 @@ #' } "adsl" -#' Example Dataset Specification +#' Example Dataset Variable Specification #' #' @format ## `var_spec` #' A data frame with 216 rows and 19 columns: @@ -82,3 +82,20 @@ #' \item{Developer Notes}{Developer Notes} #' } "var_spec" + +#' Example Dataset Specification +#' +#' @format ## `dataset_spec` +#' A data frame with 1 row and 9 columns: +#' \describe{ +#' \item{Dataset}{ Dataset} +#' \item{Description}{ Dataset description} +#' \item{Class}{ Dataset class} +#' \item{Structure}{ Logical, indicating if there's a specific structure} +#' \item{Purpose}{ Purpose of the dataset} +#' \item{Key, Variables}{ Join Key variables in the dataset} +#' \item{Repeating}{ Indicates if the dataset is repeating} +#' \item{Reference Data}{ Regerence Data} +#' \item{Comment}{ Additional comment} +#' } +"dataset_spec" diff --git a/_pkgdown.yml b/_pkgdown.yml index b3a5cde5..29b72472 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -45,6 +45,7 @@ reference: - contents: - adsl - var_spec + - dataset_spec articles: - title: ~ diff --git a/data/dataset_spec.rda b/data/dataset_spec.rda new file mode 100644 index 0000000000000000000000000000000000000000..be9c31c4d8dd8a0c495a96c953fb55d3abc34e2d GIT binary patch literal 310 zcmV-60m=R!iwFP!000001AS4?PlGTR?FMLuKeEKT;Sbn$@#1yTn4mit3TB>`!afY9 z6w(&WZvN$J3)Czm+Ju(xeXp;tuQA@<_*)+#_ znSfS>pcRaCW}^OBag7_T3**H&_|{{5pe4<_aC`97Ce@c`7-TNWri;Lu?|cr25hdDO zwF2z^r&ctzwB_X^92UVd6(!9W{O*dO0UaxUwX_%t5WsWjUdn2PbyWd3ul8lWAISs% I2|xk>0OjA7% rename(type = "Data Type") %>% set_names(tolower) -dataset_spec <- readxl::read_xlsx(spec_path, sheet = "Datasets") %>% +dataset_spec <- dataset_spec %>% rename(label = "Description") %>% set_names(tolower) ``` From c36bb5f8c798c2af171096055c06228563e7275b Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 5 Dec 2023 06:30:48 +0530 Subject: [PATCH 037/267] docs: update docs --- man/dataset_spec.Rd | 30 ++++++++++++++++++++++++++++++ man/var_spec.Rd | 4 ++-- 2 files changed, 32 insertions(+), 2 deletions(-) create mode 100644 man/dataset_spec.Rd diff --git a/man/dataset_spec.Rd b/man/dataset_spec.Rd new file mode 100644 index 00000000..7ab0d370 --- /dev/null +++ b/man/dataset_spec.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\docType{data} +\name{dataset_spec} +\alias{dataset_spec} +\title{Example Dataset Specification} +\format{ +\subsection{\code{dataset_spec}}{ + +A data frame with 1 row and 9 columns: +\describe{ +\item{Dataset}{\if{html}{\out{}} Dataset} +\item{Description}{\if{html}{\out{}} Dataset description} +\item{Class}{\if{html}{\out{}} Dataset class} +\item{Structure}{\if{html}{\out{}} Logical, indicating if there's a specific structure} +\item{Purpose}{\if{html}{\out{}} Purpose of the dataset} +\item{Key, Variables}{\if{html}{\out{}} Join Key variables in the dataset} +\item{Repeating}{\if{html}{\out{}} Indicates if the dataset is repeating} +\item{Reference Data}{\if{html}{\out{}} Regerence Data} +\item{Comment}{\if{html}{\out{}} Additional comment} +} +} +} +\usage{ +dataset_spec +} +\description{ +Example Dataset Specification +} +\keyword{datasets} diff --git a/man/var_spec.Rd b/man/var_spec.Rd index 1b688c9c..5460c33d 100644 --- a/man/var_spec.Rd +++ b/man/var_spec.Rd @@ -3,7 +3,7 @@ \docType{data} \name{var_spec} \alias{var_spec} -\title{Example Dataset Specification} +\title{Example Dataset Variable Specification} \format{ \subsection{\code{var_spec}}{ @@ -35,6 +35,6 @@ A data frame with 216 rows and 19 columns: var_spec } \description{ -Example Dataset Specification +Example Dataset Variable Specification } \keyword{datasets} From 9c0b997043d0536a1a132c5767dd084d00ae966d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 5 Dec 2023 17:57:17 +0100 Subject: [PATCH 038/267] feat: assert parameters on xportr_domain_name --- R/metadata.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/metadata.R b/R/metadata.R index f1fd9701..4a2a157d 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -69,6 +69,8 @@ xportr_metadata <- function(.df, metadata, domain = NULL) { #' #' @rdname metadata xportr_domain_name <- function(.df, domain) { + assert_data_frame(.df) + assert_string(domain, null.ok = TRUE) attr(.df, "_xportr.df_arg_") <- domain .df From dc3a3bfea961a2b4d27a32d5556b21b2e93c8439 Mon Sep 17 00:00:00 2001 From: bs832471 Date: Tue, 5 Dec 2023 17:59:36 +0000 Subject: [PATCH 039/267] Increment version number to 0.3.1.9000 --- DESCRIPTION | 2 +- NEWS.md | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 61e81239..4e813ef9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1 +Version: 0.3.1.9000 Authors@R: c( person(given = "Eli", diff --git a/NEWS.md b/NEWS.md index 08ab28de..00aa31b4 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,5 @@ +# xportr (development version) + # xportr 0.3.1 ## New Features and Bug Fixes From ba7e7c4e1c279588863652b5dff38ee6d5f218d7 Mon Sep 17 00:00:00 2001 From: bs832471 Date: Tue, 5 Dec 2023 18:05:55 +0000 Subject: [PATCH 040/267] fix: #187 dev web --- NEWS.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/NEWS.md b/NEWS.md index 00aa31b4..27f14385 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,11 @@ # xportr (development version) +## New Features and Bug Fixes + +## Documentation + +## Deprecation and Breaking Changes + # xportr 0.3.1 ## New Features and Bug Fixes From 5f6e0dcb041f273eed7b4e0d06bd463e3bf0cb2e Mon Sep 17 00:00:00 2001 From: elimillera Date: Wed, 6 Dec 2023 13:52:58 +0000 Subject: [PATCH 041/267] Update docs and tests per review --- R/metadata.R | 2 ++ R/utils-xportr.R | 2 +- README.Rmd | 11 ++++++----- README.md | 12 ++++++------ man/metadata.Rd | 2 ++ tests/testthat/test-metadata.R | 3 +++ tests/testthat/test-type.R | 2 ++ 7 files changed, 22 insertions(+), 12 deletions(-) diff --git a/R/metadata.R b/R/metadata.R index 926de49e..f6110574 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -54,6 +54,8 @@ xportr_metadata <- function(.df, metadata, domain = NULL) { #' Update Metadata Domain Name #' +#' Similar to `xportr_metadata`, but just added the domain and not the metadata. +#' #' @inheritParams xportr_length #' #' @return `.df` dataset with domain argument set diff --git a/R/utils-xportr.R b/R/utils-xportr.R index f97bb346..398617e8 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -305,7 +305,7 @@ xpt_validate <- function(data) { return(err_cnd) } -#' Get the domain from argument or from magrittr's pipe (`%>%`) +#' Get the domain from argument or from the existing domain attr #' #' @return A string representing the domain #' @noRd diff --git a/README.Rmd b/README.Rmd index 7af50e6d..385a2e01 100644 --- a/README.Rmd +++ b/README.Rmd @@ -127,11 +127,12 @@ Each `xportr_` function has been written in a way to take in a part of the speci ```{r, warning = FALSE, message=FALSE, eval=TRUE} adsl %>% - xportr_type(var_spec, "ADSL", verbose = "warn") %>% - xportr_length(var_spec, "ADSL", verbose = "warn") %>% - xportr_label(var_spec, "ADSL", verbose = "warn") %>% - xportr_order(var_spec, "ADSL", verbose = "warn") %>% - xportr_format(var_spec, "ADSL") %>% + xportr_domain_name("ADSL") %>% + xportr_type(var_spec, verbose = "warn") %>% + xportr_length(var_spec, verbose = "warn") %>% + xportr_label(var_spec, verbose = "warn") %>% + xportr_order(var_spec, verbose = "warn") %>% + xportr_format(var_spec) %>% xportr_write("adsl.xpt", label = "Subject-Level Analysis Dataset") ``` diff --git a/README.md b/README.md index bbd581f9..c1c5bd6f 100644 --- a/README.md +++ b/README.md @@ -5,7 +5,6 @@ -[](https://RValidationHub.slack.com) [![R build status](https://github.com/atorus-research/xportr/workflows/R-CMD-check/badge.svg)](https://github.com/atorus-research/xportr/actions?workflow=R-CMD-check) [](https://app.codecov.io/gh/atorus-research/xportr) @@ -135,11 +134,12 @@ We have suppressed the warning for the sake of brevity. ``` r adsl %>% - xportr_type(var_spec, "ADSL", verbose = "warn") %>% - xportr_length(var_spec, "ADSL", verbose = "warn") %>% - xportr_label(var_spec, "ADSL", verbose = "warn") %>% - xportr_order(var_spec, "ADSL", verbose = "warn") %>% - xportr_format(var_spec, "ADSL") %>% + xportr_domain_name("ADSL") %>% + xportr_type(var_spec, verbose = "warn") %>% + xportr_length(var_spec, verbose = "warn") %>% + xportr_label(var_spec, verbose = "warn") %>% + xportr_order(var_spec, verbose = "warn") %>% + xportr_format(var_spec) %>% xportr_write("adsl.xpt", label = "Subject-Level Analysis Dataset") ``` diff --git a/man/metadata.Rd b/man/metadata.Rd index d1f5d30b..2a7d0af0 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -29,6 +29,8 @@ Sets metadata for a dataset in a way that can be accessed by other xportr functions. If used at the start of an xportr pipeline, it removes the need to set metadata and domain at each step individually. For details on the format of the metadata, see the 'Metadata' section for each function in question. + +Similar to \code{xportr_metadata}, but just added the domain and not the metadata. } \examples{ diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index c74f906e..89ab1f11 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -548,6 +548,9 @@ test_that("xportr_length: Expect error if domain is not a character", { # tests for `xportr_metadata()` basic functionality # start test_that("xportr_metadata: Check metadata interaction with other functions", { + + skip_if_not_installed("admiral") + adsl <- admiral::admiral_adsl var_spec <- diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index a865b6cb..2a84cf16 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -215,6 +215,8 @@ test_that("xportr_type: error when metadata is not set", { }) test_that("xportr_type: date variables are not converted to numeric", { + skip_if_not_installed("metacore") + df <- data.frame(RFICDT = as.Date("2017-03-30"), RFICDTM = as.POSIXct("2017-03-30")) metacore_meta <- suppressWarnings( metacore::metacore( From 3dcf6fb6c5dd53d1ca59e5258619107f43aefb8f Mon Sep 17 00:00:00 2001 From: EeethB Date: Tue, 14 Nov 2023 15:15:17 +0000 Subject: [PATCH 042/267] Add `verbose` option to metadata --- R/metadata.R | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/R/metadata.R b/R/metadata.R index 1fdabc28..8d831369 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -37,7 +37,10 @@ #' xportr_type() %>% #' xportr_order() #' } -xportr_metadata <- function(.df, metadata, domain = NULL) { +xportr_metadata <- function(.df, + metadata, + domain = NULL, + verbose = getOption("xportr.type_verbose", "none")) { ## Common section to detect domain from argument or pipes df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) @@ -46,5 +49,7 @@ xportr_metadata <- function(.df, metadata, domain = NULL) { ## End of common section - structure(.df, `_xportr.df_metadata_` = metadata) + structure(.df, + `_xportr.df_metadata_` = metadata, + `_xportr.df_verbose_` = verbose) } From 26bbc8e291c2778098493344a5fd0ad082a20785 Mon Sep 17 00:00:00 2001 From: EeethB Date: Tue, 28 Nov 2023 16:09:20 +0000 Subject: [PATCH 043/267] Add verbose to metadata --- R/metadata.R | 2 +- R/type.R | 8 +++++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/R/metadata.R b/R/metadata.R index 8d831369..4dc7a9c3 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -40,7 +40,7 @@ xportr_metadata <- function(.df, metadata, domain = NULL, - verbose = getOption("xportr.type_verbose", "none")) { + verbose = NULL) { ## Common section to detect domain from argument or pipes df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) diff --git a/R/type.R b/R/type.R index 78cf6dca..84866c79 100644 --- a/R/type.R +++ b/R/type.R @@ -79,7 +79,7 @@ xportr_type <- function(.df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.type_verbose", "none"), + verbose = NULL, metacore = deprecated()) { if (!missing(metacore)) { lifecycle::deprecate_warn( @@ -148,6 +148,12 @@ xportr_type <- function(.df, type.y = if_else(type.y %in% numericTypes, "_numeric", type.y) ) + # Verbose should use an explicit verbose option first, then the value set in + # metadata, and finally fall back to the option value + verbose <- verbose %||% + attr(.df, "_xportr.df_verbose_") %||% + getOption("xportr.type_verbose", "none") + # It is possible that a variable exists in the table that isn't in the metadata # it will be silently ignored here. This may happen depending on what a user # passes and the options they choose. The check_core function is the place From f4a4b4d4e43ab9657b0b909bbd0987d6667289d6 Mon Sep 17 00:00:00 2001 From: EeethB Date: Tue, 5 Dec 2023 21:55:13 +0000 Subject: [PATCH 044/267] Add `verbose` option to metadata --- R/label.R | 8 +++++++- R/length.R | 8 +++++++- R/order.R | 8 +++++++- man/xportr_metadata.Rd | 6 +++++- man/xportr_type.Rd | 2 +- tests/testthat/test-length.R | 13 +++++++++++++ tests/testthat/test-order.R | 13 +++++++++++++ tests/testthat/test-type.R | 20 ++++++++++++++++---- 8 files changed, 69 insertions(+), 9 deletions(-) diff --git a/R/label.R b/R/label.R index e412e9fc..3409c091 100644 --- a/R/label.R +++ b/R/label.R @@ -59,7 +59,7 @@ xportr_label <- function(.df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.label_verbose", "none"), + verbose = NULL, metacore = deprecated()) { if (!missing(metacore)) { lifecycle::deprecate_warn( @@ -101,6 +101,12 @@ xportr_label <- function(.df, # Check any variables missed in metadata but present in input data --- miss_vars <- setdiff(names(.df), metadata[[variable_name]]) + # Verbose should use an explicit verbose option first, then the value set in + # metadata, and finally fall back to the option value + verbose <- verbose %||% + attr(.df, "_xportr.df_verbose_") %||% + getOption("xportr.label_verbose", "none") + label_log(miss_vars, verbose) label <- metadata[[variable_label]] diff --git a/R/length.R b/R/length.R index 17627268..e1fddefa 100644 --- a/R/length.R +++ b/R/length.R @@ -66,7 +66,7 @@ xportr_length <- function(.df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.length_verbose", "none"), + verbose = NULL, metacore = deprecated()) { if (!missing(metacore)) { lifecycle::deprecate_warn( @@ -108,6 +108,12 @@ xportr_length <- function(.df, # Check any variables missed in metadata but present in input data --- miss_vars <- setdiff(names(.df), metadata[[variable_name]]) + # Verbose should use an explicit verbose option first, then the value set in + # metadata, and finally fall back to the option value + verbose <- verbose %||% + attr(.df, "_xportr.df_verbose_") %||% + getOption("xportr.length_verbose", "none") + length_log(miss_vars, verbose) length <- metadata[[variable_length]] diff --git a/R/order.R b/R/order.R index 0f7e1b30..1b5b7ce8 100644 --- a/R/order.R +++ b/R/order.R @@ -62,7 +62,7 @@ xportr_order <- function(.df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.order_verbose", "none"), + verbose = NULL, metacore = deprecated()) { if (!missing(metacore)) { lifecycle::deprecate_warn( @@ -122,6 +122,12 @@ xportr_order <- function(.df, # Used in warning message for how many vars have been moved reorder_vars <- names(df_re_ord)[names(df_re_ord) != names(.df)] + # Verbose should use an explicit verbose option first, then the value set in + # metadata, and finally fall back to the option value + verbose <- verbose %||% + attr(.df, "_xportr.df_verbose_") %||% + getOption("xportr.order_verbose", "none") + # Function is located in messages.R var_ord_msg(reorder_vars, names(drop_vars), verbose) diff --git a/man/xportr_metadata.Rd b/man/xportr_metadata.Rd index 592c6f45..c8e7fc8b 100644 --- a/man/xportr_metadata.Rd +++ b/man/xportr_metadata.Rd @@ -4,7 +4,7 @@ \alias{xportr_metadata} \title{Set variable specifications and domain} \usage{ -xportr_metadata(.df, metadata, domain = NULL) +xportr_metadata(.df, metadata, domain = NULL, verbose = NULL) } \arguments{ \item{.df}{A data frame of CDISC standard.} @@ -15,6 +15,10 @@ xportr_metadata(.df, metadata, domain = NULL) \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset the metadata object. If none is passed, then name of the dataset passed as .df will be used.} + +\item{verbose}{The action this function takes when an action is taken on the +dataset or function validation finds an issue. See 'Messaging' section for +details. Options are 'stop', 'warn', 'message', and 'none'} } \value{ \code{.df} dataset with metadata and domain attributes set diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index abfa41d8..dd605ddc 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -8,7 +8,7 @@ xportr_type( .df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.type_verbose", "none"), + verbose = NULL, metacore = deprecated() ) } diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index e749684d..d77ecd50 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -128,6 +128,13 @@ test_that("xportr_length: Impute character lengths based on class", { expect_message("Variable lengths missing from metadata") %>% expect_message("lengths resolved") %>% expect_attr_width(c(7, 199, 200, 200, 8)) + + adsl %>% + xportr_metadata(metadata, verbose = "none") %>% + xportr_length() %>% + expect_message("Variable lengths missing from metadata") %>% + expect_message("lengths resolved") %>% + expect_attr_width(c(7, 199, 200, 200, 8)) }) test_that("xportr_length: Throws message when variables not present in metadata", { @@ -144,6 +151,12 @@ test_that("xportr_length: Throws message when variables not present in metadata" expect_message("Variable lengths missing from metadata") %>% expect_message("lengths resolved") %>% expect_message(regexp = "Problem with `y`") + + xportr_metadata(adsl, metadata, verbose = "message") %>% + xportr_length() %>% + expect_message("Variable lengths missing from metadata") %>% + expect_message("lengths resolved") %>% + expect_message(regexp = "Problem with `y`") }) test_that("xportr_length: Metacore instance can be used", { diff --git a/tests/testthat/test-order.R b/tests/testthat/test-order.R index 801108c4..5f666cce 100644 --- a/tests/testthat/test-order.R +++ b/tests/testthat/test-order.R @@ -136,6 +136,19 @@ test_that("xportr_order: Variable ordering messaging is correct", { expect_message("2 variables not in spec and moved to end") %>% expect_message("Variable moved to end in `.df`: `a` and `z`") %>% expect_message("All variables in dataset are ordered") + + # Metadata versions + xportr_metadata(df, df_meta, verbose = "message") %>% + xportr_order() %>% + expect_message("All variables in specification file are in dataset") %>% + expect_condition("4 reordered in dataset") %>% + expect_message("Variable reordered in `.df`: `a`, `b`, `c`, and `d`") + + xportr_metadata(df2, df_meta, verbose = "message") %>% + xportr_order() %>% + expect_message("2 variables not in spec and moved to end") %>% + expect_message("Variable moved to end in `.df`: `a` and `z`") %>% + expect_message("All variables in dataset are ordered") }) test_that("xportr_order: Metadata order columns are coersed to numeric", { diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index d5841a63..fa2ad2b6 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -66,6 +66,12 @@ test_that("xportr_type: Variable types are coerced as expected and can raise mes (df3 <- suppressMessages(xportr_type(df, meta_example, verbose = "warn"))) %>% expect_warning() + # Metadata version of the last statement + df %>% + xportr_metadata(meta_example, verbose = "warn") %>% + xportr_type() %>% + expect_warning() + expect_equal(purrr::map_chr(df3, class), c( Subj = "numeric", Different = "character", Val = "numeric", Param = "character" @@ -77,6 +83,12 @@ test_that("xportr_type: Variable types are coerced as expected and can raise mes expect_message("Variable type\\(s\\) in dataframe don't match metadata") ) + # Metadata version + df %>% + xportr_metadata(meta_example, verbose = "message") %>% + xportr_type() %>% + expect_message("Variable type\\(s\\) in dataframe don't match metadata") + expect_equal(purrr::map_chr(df4, class), c( Subj = "numeric", Different = "character", Val = "numeric", Param = "character" @@ -100,12 +112,12 @@ test_that("xportr_metadata: Var types coerced as expected and raise messages", { )) suppressMessages( - xportr_metadata(df, meta_example) %>% xportr_type(verbose = "stop") + xportr_metadata(df, meta_example, verbose = "stop") %>% xportr_type() ) %>% expect_error() suppressMessages( - df3 <- xportr_metadata(df, meta_example) %>% xportr_type(verbose = "warn") + df3 <- xportr_metadata(df, meta_example, verbose = "warn") %>% xportr_type() ) %>% expect_warning() @@ -116,8 +128,8 @@ test_that("xportr_metadata: Var types coerced as expected and raise messages", { suppressMessages({ ( - df4 <- xportr_metadata(df, meta_example) %>% - xportr_type(verbose = "message") + df4 <- xportr_metadata(df, meta_example, verbose = "message") %>% + xportr_type() ) %>% expect_message("Variable type\\(s\\) in dataframe don't match metadata: `Subj` and `Val`") }) From f5346807a392eebef33971bb1bbf93be95503c43 Mon Sep 17 00:00:00 2001 From: EeethB Date: Wed, 6 Dec 2023 22:24:17 +0000 Subject: [PATCH 045/267] Update docs --- R/metadata.R | 5 +++-- man/xportr_label.Rd | 2 +- man/xportr_length.Rd | 2 +- man/xportr_order.Rd | 2 +- 4 files changed, 6 insertions(+), 5 deletions(-) diff --git a/R/metadata.R b/R/metadata.R index 4dc7a9c3..1e8a5dc9 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -50,6 +50,7 @@ xportr_metadata <- function(.df, ## End of common section structure(.df, - `_xportr.df_metadata_` = metadata, - `_xportr.df_verbose_` = verbose) + `_xportr.df_metadata_` = metadata, + `_xportr.df_verbose_` = verbose + ) } diff --git a/man/xportr_label.Rd b/man/xportr_label.Rd index a74137ed..a3c5dc90 100644 --- a/man/xportr_label.Rd +++ b/man/xportr_label.Rd @@ -8,7 +8,7 @@ xportr_label( .df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.label_verbose", "none"), + verbose = NULL, metacore = deprecated() ) } diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index 89fb5703..c9f63ff4 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -8,7 +8,7 @@ xportr_length( .df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.length_verbose", "none"), + verbose = NULL, metacore = deprecated() ) } diff --git a/man/xportr_order.Rd b/man/xportr_order.Rd index e8ea269c..12b0dcb7 100644 --- a/man/xportr_order.Rd +++ b/man/xportr_order.Rd @@ -8,7 +8,7 @@ xportr_order( .df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.order_verbose", "none"), + verbose = NULL, metacore = deprecated() ) } From a0d83b71a285ef737b492b0fddcd73156d3d7090 Mon Sep 17 00:00:00 2001 From: EeethB Date: Wed, 6 Dec 2023 22:31:52 +0000 Subject: [PATCH 046/267] Update news and README --- NEWS.md | 2 ++ README.Rmd | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 27f14385..11f4bfee 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,8 @@ ## New Features and Bug Fixes +* `xportr_metadata()` can set `verbose` for a whole pipeline + ## Documentation ## Deprecation and Breaking Changes diff --git a/README.Rmd b/README.Rmd index 7af50e6d..c060960d 100644 --- a/README.Rmd +++ b/README.Rmd @@ -139,7 +139,7 @@ The `xportr_metadata()` function can reduce duplication by setting the variable ```{r, message=FALSE, eval=FALSE} adsl %>% - xportr_metadata(var_spec, "ADSL") %>% + xportr_metadata(var_spec, "ADSL", verbose = "warn") %>% xportr_type() %>% xportr_length() %>% xportr_label() %>% From c5edb1d1703d26fee5f0ca2058cf54db93de59a6 Mon Sep 17 00:00:00 2001 From: elimillera Date: Thu, 7 Dec 2023 14:57:30 +0000 Subject: [PATCH 047/267] update style --- R/metadata.R | 1 - tests/testthat/test-metadata.R | 1 - 2 files changed, 2 deletions(-) diff --git a/R/metadata.R b/R/metadata.R index f6110574..48bb65df 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -63,7 +63,6 @@ xportr_metadata <- function(.df, metadata, domain = NULL) { #' #' @rdname metadata xportr_domain_name <- function(.df, domain) { - attr(.df, "_xportr.df_arg_") <- domain .df diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index 89ab1f11..9841ae0d 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -548,7 +548,6 @@ test_that("xportr_length: Expect error if domain is not a character", { # tests for `xportr_metadata()` basic functionality # start test_that("xportr_metadata: Check metadata interaction with other functions", { - skip_if_not_installed("admiral") adsl <- admiral::admiral_adsl From 40a1dd4d0cb02b0b9858d5987b6d0c8d8af584b3 Mon Sep 17 00:00:00 2001 From: elimillera Date: Thu, 7 Dec 2023 16:57:31 +0000 Subject: [PATCH 048/267] [skip actions] Bump version to 0.3.1.9001 --- DESCRIPTION | 114 +++++++++++++++++++++------------------------------- 1 file changed, 45 insertions(+), 69 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4e813ef9..29842a22 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,85 +1,61 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9000 -Authors@R: - c( - person(given = "Eli", - family = "Miller", - role = c("aut", "cre"), - email = "Eli.Miller@AtorusResearch.com", +Version: 0.3.1.9001 +Authors@R: c( + person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")), - person(given = "Vignesh ", - family = "Thanikachalam", - role = c("aut")), - person(given = "Ben", - family = "Straub", - role = ("aut")), - person(given = "Ross", - family = "Didenko", - role = ("aut")), - person(given = "Zelos", - family = "Zhu", - role = ("aut")), - person(given = "Ethan", - family = "Brockmann", - role = ("aut")), - person(given = "Vedha", - family = "Viyash", - role = ("aut")), - person(given = "Andre", - family = "Verissimo", - role = ("aut")), - person(given = "Sophie", - family = "Shapcott", - role = ("aut")), - person(given = "Celine", - family = "Piraux", - role = ("aut")), - person(given = "Adrian", - family = "Chan", - role = ("aut")), - person(given = "Sadchla", - family = "Mascary", - role = ("aut")), - person(given = "Atorus/GSK JPT", - role = "cph")) -Description: Tools to build CDISC compliant data sets and check for CDISC compliance. + person("Vignesh ", "Thanikachalam", role = "aut"), + person("Ben", "Straub", role = "aut"), + person("Ross", "Didenko", role = "aut"), + person("Zelos", "Zhu", role = "aut"), + person("Ethan", "Brockmann", role = "aut"), + person("Vedha", "Viyash", role = "aut"), + person("Andre", "Verissimo", role = "aut"), + person("Sophie", "Shapcott", role = "aut"), + person("Celine", "Piraux", role = "aut"), + person("Adrian", "Chan", role = "aut"), + person("Sadchla", "Mascary", role = "aut"), + person("Atorus/GSK JPT", role = "cph") + ) +Description: Tools to build CDISC compliant data sets and check for CDISC + compliance. +License: MIT + file LICENSE URL: https://github.com/atorus-research/xportr BugReports: https://github.com/atorus-research/xportr/issues +Depends: + R (>= 3.5) Imports: + cli, dplyr (>= 1.0.2), - purrr (>= 0.3.4), - stringr (>= 1.4.0), - magrittr, glue (>= 1.4.2), + haven (>= 2.5.0), + janitor, + lifecycle, + magrittr, + purrr (>= 0.3.4), + readr, rlang (>= 0.4.10), - cli, + stringr (>= 1.4.0), tidyselect, - readr, - janitor, - tm, - haven (>= 2.5.0), - lifecycle -License: MIT + file LICENSE -Encoding: UTF-8 -LazyData: true -Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 + tm Suggests: - testthat (>= 3.0.0), - withr, - knitr, - rmarkdown, - readxl, - DT, - labelled, admiral, devtools, + DT, + knitr, + labelled, + lintr, + metacore, + readxl, + rmarkdown, spelling, + testthat (>= 3.0.0), usethis, - lintr, - metacore + withr +VignetteBuilder: + knitr Config/testthat/edition: 3 -VignetteBuilder: knitr -Depends: - R (>= 3.5) +Encoding: UTF-8 +LazyData: true +Roxygen: list(markdown = TRUE) +RoxygenNote: 7.2.3 From 7dd04d0a3a32afdc3ffb0feeff7df5d5e1c38d4e Mon Sep 17 00:00:00 2001 From: vedhav Date: Thu, 7 Dec 2023 17:16:40 +0000 Subject: [PATCH 049/267] [skip actions] Bump version to 0.3.1.9002 --- DESCRIPTION | 2 +- NEWS.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 29842a22..1f3a1a59 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9001 +Version: 0.3.1.9002 Authors@R: c( person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")), diff --git a/NEWS.md b/NEWS.md index 86f99365..a4fc0187 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# xportr 0.3.1.9001 +# xportr 0.3.1.9002 ## New Features and Bug Fixes * `xportr_write()` now accepts `metadata` argument which can be used to set the dataset label to stay consistent with the other `xportr_*` functions. It is noteworthy that the dataset label set using the `xportr_df_label()` function will be retained during the `xportr_write()`. From b09805e4499204f370b847645de613e96f9ad1bc Mon Sep 17 00:00:00 2001 From: Ben Straub Date: Thu, 7 Dec 2023 14:30:03 -0500 Subject: [PATCH 050/267] docs: #81 added new blurb --- NEWS.md | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index a4fc0187..dbbab276 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,14 +1,19 @@ -# xportr 0.3.1.9002 +# xportr (development version) ## New Features and Bug Fixes + * `xportr_write()` now accepts `metadata` argument which can be used to set the dataset label to stay consistent with the other `xportr_*` functions. It is noteworthy that the dataset label set using the `xportr_df_label()` function will be retained during the `xportr_write()`. -* Exporting a new dataset `dataset_spec` that contains the Dataset Specification for ADSL. +* Exporting a new dataset `dataset_spec` that contains the Dataset Specification for ADSL. (#179) ## Deprecation and Breaking Changes -* The `label` argument from the `xportr_write()` function is deprecated in favor of the `metadata` argument. + +* The `label` argument from the `xportr_write()` function is deprecated in favor of the `metadata` argument. (#179) ## Documentation +* Created development version of the website (#187) +* Additional guidance for options added in deep dive vignette (#81) + # xportr 0.3.1 ## New Features and Bug Fixes From c090ea5db800a3976adfa45925a9e066980e6272 Mon Sep 17 00:00:00 2001 From: bms63 Date: Thu, 7 Dec 2023 19:47:20 +0000 Subject: [PATCH 051/267] [skip actions] Bump version to 0.3.1.9003 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1f3a1a59..065cf316 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9002 +Version: 0.3.1.9003 Authors@R: c( person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")), From 2851f70e43c334e47ea25ba96fea934205113cd8 Mon Sep 17 00:00:00 2001 From: Kangjie Zhang Date: Thu, 7 Dec 2023 21:36:41 +0000 Subject: [PATCH 052/267] add a test for non-acsii character >200 bytes, <200 characters --- tests/testthat/test-utils-xportr.R | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/tests/testthat/test-utils-xportr.R b/tests/testthat/test-utils-xportr.R index 7c272fe0..41f6adb8 100644 --- a/tests/testthat/test-utils-xportr.R +++ b/tests/testthat/test-utils-xportr.R @@ -119,3 +119,11 @@ test_that("xpt_validate: Get error message when the length of a character variab "Length of A must be 200 bytes or less." ) }) + +test_that("xpt_validate: Get error message when the length of a non-ASCII character variable is > 200 bytes", { + df <- data.frame(A = paste(rep("一", 67), collapse = "")) + expect_equal( + xpt_validate(df), + "Length of A must be 200 bytes or less." + ) +}) From c73780bcb3f24307973a8f9bb815f6bc5dee87f0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 8 Dec 2023 10:58:29 +0100 Subject: [PATCH 053/267] fix: updates comments --- R/format.R | 2 +- R/label.R | 2 +- R/length.R | 2 +- R/metadata.R | 2 +- R/order.R | 2 +- R/type.R | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/format.R b/R/format.R index 864faaf4..1249ac4e 100644 --- a/R/format.R +++ b/R/format.R @@ -57,7 +57,7 @@ xportr_format <- function(.df, format_name <- getOption("xportr.format_name") variable_name <- getOption("xportr.variable_name") - ## Common section to detect domain from argument or pipes + ## Common section to detect domain from argument or attribute domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain diff --git a/R/label.R b/R/label.R index 3d422f1b..ad6c339a 100644 --- a/R/label.R +++ b/R/label.R @@ -73,7 +73,7 @@ xportr_label <- function(.df, variable_name <- getOption("xportr.variable_name") variable_label <- getOption("xportr.label") - ## Common section to detect domain from argument or pipes + ## Common section to detect domain from argument or attribute domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain diff --git a/R/length.R b/R/length.R index 81864c2b..ec4e191a 100644 --- a/R/length.R +++ b/R/length.R @@ -80,7 +80,7 @@ xportr_length <- function(.df, variable_length <- getOption("xportr.length") variable_name <- getOption("xportr.variable_name") - ## Common section to detect domain from argument or pipes + ## Common section to detect domain from argument or attribute domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain diff --git a/R/metadata.R b/R/metadata.R index 48bb65df..325a3ff4 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -41,7 +41,7 @@ #' xportr_order() #' } xportr_metadata <- function(.df, metadata, domain = NULL) { - ## Common section to detect domain from argument or pipes + ## Common section to detect domain from argument or attribute domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain diff --git a/R/order.R b/R/order.R index 43ea130d..8f01ee78 100644 --- a/R/order.R +++ b/R/order.R @@ -76,7 +76,7 @@ xportr_order <- function(.df, order_name <- getOption("xportr.order_name") variable_name <- getOption("xportr.variable_name") - ## Common section to detect domain from argument or pipes + ## Common section to detect domain from argument or attribute domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain diff --git a/R/type.R b/R/type.R index c316373c..f75395f1 100644 --- a/R/type.R +++ b/R/type.R @@ -97,7 +97,7 @@ xportr_type <- function(.df, numericTypes <- c(getOption("xportr.numeric_types"), "_numeric") format_name <- getOption("xportr.format_name") - ## Common section to detect domain from argument or pipes + ## Common section to detect domain from argument or attribute domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain From 17c7f1405677a5006d0a4f7aea838dd450c3761a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 8 Dec 2023 11:00:31 +0100 Subject: [PATCH 054/267] style: rm extra empty line --- tests/testthat/test-pipe.R | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/testthat/test-pipe.R b/tests/testthat/test-pipe.R index 6f9bafb5..90876763 100644 --- a/tests/testthat/test-pipe.R +++ b/tests/testthat/test-pipe.R @@ -1,4 +1,3 @@ - test_that("xportr_*: Domain is kept in between calls", { # Divert all messages to tempfile, instead of printing them # note: be aware as this should only be used in tests that don't track From 362a505b2665968233905066e221753b6ec1c3ac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?C=C3=A9line=20Piraux?= Date: Mon, 11 Dec 2023 13:42:11 +0100 Subject: [PATCH 055/267] include filename check in strict_checks --- R/write.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/write.R b/R/write.R index 0dd13541..84bea9c1 100644 --- a/R/write.R +++ b/R/write.R @@ -75,12 +75,12 @@ xportr_write <- function(.df, abort("`.df` file name must be 8 characters or less.") } + checks <- xpt_validate(.df) + if (stringr::str_detect(name, "[^a-zA-Z0-9]")) { - abort("`.df` cannot contain any non-ASCII, symbol or underscore characters.") + checks <- c(checks, "`.df` cannot contain any non-ASCII, symbol or underscore characters.") } - checks <- xpt_validate(.df) - if (length(checks) > 0) { if (!strict_checks) { warn(c("The following validation checks failed:", checks)) From 90a691449e321583608c9c32f5749716f43b23bb Mon Sep 17 00:00:00 2001 From: Kangjie Zhang <47867131+kaz462@users.noreply.github.com> Date: Wed, 13 Dec 2023 21:22:58 -0800 Subject: [PATCH 056/267] Update R/utils-xportr.R MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- R/utils-xportr.R | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/R/utils-xportr.R b/R/utils-xportr.R index 5e21c7e9..860d2cf6 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -307,10 +307,12 @@ xpt_validate <- function(data) { max_nchar <- data %>% dplyr::summarise(across(where(is.character), ~ max(nchar(., type = "bytes")))) nchar_gt_200 <- max_nchar[which(max_nchar > 200)] - err_cnd <- c( - err_cnd, - glue("Length of {names(nchar_gt_200)} must be 200 bytes or less.") - ) + if (length(nchar_gt_200) > 0) { + err_cnd <- c( + err_cnd, + glue("Length of {names(nchar_gt_200)} must be 200 bytes or less.") + ) + } return(err_cnd) } From 5ff189a45f5ddaea932b178aea37af813de66934 Mon Sep 17 00:00:00 2001 From: Kangjie Zhang <47867131+kaz462@users.noreply.github.com> Date: Thu, 14 Dec 2023 12:56:44 -0500 Subject: [PATCH 057/267] Update R/utils-xportr.R MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- R/utils-xportr.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utils-xportr.R b/R/utils-xportr.R index 860d2cf6..feb31195 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -305,7 +305,7 @@ xpt_validate <- function(data) { # 4.0 max length of Character variables <= 200 bytes max_nchar <- data %>% - dplyr::summarise(across(where(is.character), ~ max(nchar(., type = "bytes")))) + summarize(across(where(is.character), ~ max(nchar(., type = "bytes")))) nchar_gt_200 <- max_nchar[which(max_nchar > 200)] if (length(nchar_gt_200) > 0) { err_cnd <- c( From 6a74578bb5698e3d094ce6c8cfbc656e4bfaf5f9 Mon Sep 17 00:00:00 2001 From: Kangjie Zhang Date: Thu, 14 Dec 2023 18:06:30 +0000 Subject: [PATCH 058/267] add across/where to import --- NAMESPACE | 2 ++ R/xportr-package.R | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 2b7d1412..d2f10378 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -23,6 +23,7 @@ importFrom(cli,cli_alert_success) importFrom(cli,cli_div) importFrom(cli,cli_h2) importFrom(cli,cli_text) +importFrom(dplyr,across) importFrom(dplyr,arrange) importFrom(dplyr,bind_cols) importFrom(dplyr,case_when) @@ -61,6 +62,7 @@ importFrom(stringr,str_replace) importFrom(stringr,str_replace_all) importFrom(tidyselect,all_of) importFrom(tidyselect,any_of) +importFrom(tidyselect,where) importFrom(tm,stemDocument) importFrom(utils,capture.output) importFrom(utils,packageVersion) diff --git a/R/xportr-package.R b/R/xportr-package.R index 701c4a52..197ad5be 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -95,11 +95,11 @@ #' @import rlang haven #' @importFrom dplyr left_join bind_cols filter select rename rename_with n #' everything arrange group_by summarize mutate ungroup case_when distinct -#' tribble if_else +#' tribble if_else across #' @importFrom glue glue glue_collapse #' @importFrom cli cli_alert_info cli_h2 cli_alert_success cli_div cli_text #' cli_alert_danger -#' @importFrom tidyselect all_of any_of +#' @importFrom tidyselect all_of any_of where #' @importFrom utils capture.output str tail packageVersion #' @importFrom stringr str_detect str_extract str_replace str_replace_all #' @importFrom readr parse_number From facd4a4a767f41c9a9ece0ca632a58e158ce82aa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 15 Dec 2023 11:32:04 +0100 Subject: [PATCH 059/267] docs: add news entry for this issue --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index 27f14385..d746a145 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,8 @@ ## New Features and Bug Fixes +* Adds argument assertions to public functions (#175) + ## Documentation ## Deprecation and Breaking Changes From 58eba112031cb53c24d1856bc56665ff0cd11f27 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 15 Dec 2023 14:30:53 +0100 Subject: [PATCH 060/267] fix: consolidation on assertions --- NAMESPACE | 3 +++ R/df_label.R | 28 +++++++----------------- R/format.R | 27 +++++++---------------- R/label.R | 27 +++++++---------------- R/length.R | 17 ++++++++++----- R/metadata.R | 17 +++++---------- R/order.R | 27 +++++++---------------- R/type.R | 28 +++++++----------------- R/utils-xportr.R | 40 ++++++++++++++++++++++++++++++++++ R/write.R | 6 ++--- R/xportr-package.R | 7 +++--- tests/testthat/test-df_label.R | 2 +- tests/testthat/test-format.R | 2 +- tests/testthat/test-label.R | 2 +- tests/testthat/test-length.R | 2 +- tests/testthat/test-metadata.R | 1 - tests/testthat/test-order.R | 2 +- tests/testthat/test-type.R | 2 +- 18 files changed, 111 insertions(+), 129 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 4e955824..1a6419a1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -27,8 +27,11 @@ 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_r6) importFrom(checkmate,test_string) +importFrom(checkmate,vname) importFrom(cli,cli_alert_danger) importFrom(cli,cli_alert_info) importFrom(cli,cli_alert_success) diff --git a/R/df_label.R b/R/df_label.R index e5fc5545..912890e6 100644 --- a/R/df_label.R +++ b/R/df_label.R @@ -52,31 +52,19 @@ xportr_df_label <- function(.df, metadata <- metacore } assert_data_frame(.df) - assert( - combine = "or", - check_r6(metadata, "Metacore", null.ok = TRUE), - check_data_frame(metadata, null.ok = TRUE) - ) - assert_string(domain, null.ok = TRUE) - - domain_name <- getOption("xportr.df_domain_name") - label_name <- getOption("xportr.df_label") - ## Common section to detect domain from argument or attribute + domain <- domain %||% attr(.df, "_xportr.df_arg_") + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") - domain <- get_domain(.df, domain) - if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + assert_string(domain, null.ok = TRUE) + assert_metadata(metadata) - ## End of common section + if (!is.null(domain)) .df <- xportr_domain_name(.df, domain) - ## 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) %>% diff --git a/R/format.R b/R/format.R index 8c945049..cd4152aa 100644 --- a/R/format.R +++ b/R/format.R @@ -54,31 +54,20 @@ xportr_format <- function(.df, metadata <- metacore } assert_data_frame(.df) - assert( - combine = "or", - check_r6(metadata, "Metacore", null.ok = TRUE), - check_data_frame(metadata, null.ok = TRUE) - ) + + domain <- domain %||% attr(.df, "_xportr.df_arg_") + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + assert_string(domain, null.ok = TRUE) + assert_metadata(metadata) + + if (!is.null(domain)) .df <- xportr_domain_name(.df, domain) domain_name <- getOption("xportr.domain_name") format_name <- getOption("xportr.format_name") variable_name <- getOption("xportr.variable_name") - ## Common section to detect domain from argument or pipes - - 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()`") - - if (test_r6(metadata, "Metacore")) { - metadata <- metadata$var_spec - } + if (test_r6(metadata, "Metacore")) metadata <- metadata$var_spec if (domain_name %in% names(metadata)) { metadata <- metadata %>% diff --git a/R/label.R b/R/label.R index edfdba2e..a856d717 100644 --- a/R/label.R +++ b/R/label.R @@ -70,32 +70,21 @@ xportr_label <- function(.df, metadata <- metacore } assert_data_frame(.df) - assert( - combine = "or", - check_r6(metadata, "Metacore", null.ok = TRUE), - check_data_frame(metadata, null.ok = TRUE) - ) + + domain <- domain %||% attr(.df, "_xportr.df_arg_") + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + assert_string(domain, null.ok = TRUE) + assert_metadata(metadata) assert_choice(verbose, choices = .internal_verbose_choices) + if (!is.null(domain)) .df <- xportr_domain_name(.df, domain) + domain_name <- getOption("xportr.domain_name") variable_name <- getOption("xportr.variable_name") variable_label <- getOption("xportr.label") - ## Common section to detect domain from argument or pipes - - 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()`") - - if (inherits(metadata, "Metacore")) { - metadata <- metadata$var_spec - } + if (inherits(metadata, "Metacore")) metadata <- metadata$var_spec if (domain_name %in% names(metadata)) { metadata <- metadata %>% diff --git a/R/length.R b/R/length.R index 21b6b152..97890fe4 100644 --- a/R/length.R +++ b/R/length.R @@ -77,14 +77,16 @@ xportr_length <- function(.df, metadata <- metacore } assert_data_frame(.df) - assert( - combine = "or", - check_r6(metadata, "Metacore", null.ok = TRUE), - check_data_frame(metadata, null.ok = TRUE) - ) + + domain <- domain %||% attr(.df, "_xportr.df_arg_") + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + assert_string(domain, null.ok = TRUE) + assert_metadata(metadata) assert_choice(verbose, choices = .internal_verbose_choices) + if (!is.null(domain)) .df <- xportr_domain_name(.df, domain) + domain_name <- getOption("xportr.domain_name") variable_length <- getOption("xportr.length") variable_name <- getOption("xportr.variable_name") @@ -98,7 +100,10 @@ xportr_length <- function(.df, metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") %||% - rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`") + assert( + "Must be of type 'data.frame' or set via 'xportr_metadata()'", + .var.name = "metadata" + ) if (test_r6(metadata, "Metacore")) { metadata <- metadata$var_spec diff --git a/R/metadata.R b/R/metadata.R index 0133bfac..0f6a140a 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -42,19 +42,12 @@ #' } xportr_metadata <- function(.df, metadata, domain = NULL) { assert_data_frame(.df) - assert( - combine = "or", - check_r6(metadata, "Metacore", null.ok = TRUE), - check_data_frame(metadata, null.ok = TRUE) - ) - assert_string(domain, null.ok = TRUE) - - ## Common section to detect domain from argument or pipes - domain <- get_domain(.df, domain) - if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + domain <- domain %||% attr(.df, "_xportr.df_arg_") + assert_metadata(metadata, include_fun_message = FALSE) + assert_string(domain, null.ok = TRUE) - ## End of common section + if (!is.null(domain)) .df <- xportr_domain_name(.df, domain) structure(.df, "_xportr.df_metadata_" = metadata) } @@ -72,7 +65,7 @@ xportr_metadata <- function(.df, metadata, domain = NULL) { #' @rdname metadata xportr_domain_name <- function(.df, domain) { assert_data_frame(.df) - assert_string(domain, null.ok = TRUE) + assert_string(domain) attr(.df, "_xportr.df_arg_") <- domain .df diff --git a/R/order.R b/R/order.R index 4a9d7915..31e7ccd1 100644 --- a/R/order.R +++ b/R/order.R @@ -73,32 +73,21 @@ xportr_order <- function(.df, metadata <- metacore } assert_data_frame(.df) - assert( - combine = "or", - check_r6(metadata, "Metacore", null.ok = TRUE), - check_data_frame(metadata, null.ok = TRUE) - ) + + domain <- domain %||% attr(.df, "_xportr.df_arg_") + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + assert_string(domain, null.ok = TRUE) + assert_metadata(metadata) assert_choice(verbose, choices = .internal_verbose_choices) + if (!is.null(domain)) .df <- xportr_domain_name(.df, domain) + domain_name <- getOption("xportr.domain_name") order_name <- getOption("xportr.order_name") variable_name <- getOption("xportr.variable_name") - ## Common section to detect domain from argument or pipes - - 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()`") - - if (test_r6(metadata, "Metacore")) { - metadata <- metadata$ds_vars - } + if (test_r6(metadata, "Metacore")) metadata <- metadata$ds_vars if (domain_name %in% names(metadata)) { metadata <- metadata %>% diff --git a/R/type.R b/R/type.R index 7b1186d1..b6ecd526 100644 --- a/R/type.R +++ b/R/type.R @@ -90,14 +90,16 @@ xportr_type <- function(.df, metadata <- metacore } assert_data_frame(.df) - assert( - combine = "or", - check_r6(metadata, "Metacore", null.ok = TRUE), - check_data_frame(metadata, null.ok = TRUE) - ) + + domain <- domain %||% attr(.df, "_xportr.df_arg_") + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + assert_string(domain, null.ok = TRUE) + assert_metadata(metadata) assert_choice(verbose, choices = .internal_verbose_choices) + if (!is.null(domain)) .df <- xportr_domain_name(.df, domain) + # Name of the columns for working with metadata domain_name <- getOption("xportr.domain_name") variable_name <- getOption("xportr.variable_name") @@ -106,21 +108,7 @@ xportr_type <- function(.df, numericTypes <- c(getOption("xportr.numeric_types"), "_numeric") format_name <- getOption("xportr.format_name") - ## Common section to detect domain from argument or pipes - - 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()`") - - if (test_r6(metadata, "Metacore")) { - metadata <- metadata$var_spec - } + if (test_r6(metadata, "Metacore")) metadata <- metadata$var_spec if (domain_name %in% names(metadata)) { metadata <- metadata %>% diff --git a/R/utils-xportr.R b/R/utils-xportr.R index 7e06c5a6..dc70a876 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -371,6 +371,46 @@ check_multiple_var_specs <- function(metadata, } } +#' Custom check for metadata object +#' +#' Improvement on the message clarity over the default assert(...) messages. +#' @noRd +#' @param metadata A data frame or `Metacore` object containing variable level +#' metadata. +check_metadata <- function(metadata, include_fun_message) { + extra_string <- ", 'Metacore' or set via 'xportr_metadata()'" + if (!include_fun_message) { + extra_string <- " or 'Metacore'" + } + + if (!test_r6(metadata, "Metacore") && !test_data_frame(metadata)) { + return( + glue( + "Must be of type 'data.frame'{extra_string},", + " not `{paste(class(metadata), collapse = '/')}" + ) + ) + } + TRUE +} + +#' Custom assertion for metadata object +#' @noRd +#' @param metadata A data frame or `Metacore` object containing variable level +#' @inheritParams checkmate::check_logical +#' metadata. +assert_metadata <- function(metadata, + include_fun_message = TRUE, + add = NULL, + .var.name = vname(metadata)) { + makeAssertion( + metadata, + check_metadata(metadata, include_fun_message), + var.name = .var.name, + collection = add + ) +} + #' Internal choices for verbose option #' @noRd .internal_verbose_choices <- c("none", "warn", "message", "stop") diff --git a/R/write.R b/R/write.R index 930671ea..05a914c6 100644 --- a/R/write.R +++ b/R/write.R @@ -49,16 +49,16 @@ xportr_write <- function(.df, path, label = NULL, strict_checks = FALSE) { name <- tools::file_path_sans_ext(basename(path)) if (nchar(name) > 8) { - abort("Assertion on file name from `path` failed: Must be 8 characters or less.") + assert("File name must be 8 characters or less.", .var.name = vname(path)) } if (stringr::str_detect(name, "[^a-zA-Z0-9]")) { - abort("Assertion on file name from `path` failed: Must not contain any non-ASCII, symbol or underscore characters.") + assert("File name must not contain any non-ASCII, symbol or underscore characters.", .var.name = vname(path)) } if (!is.null(label)) { if (stringr::str_detect(label, "[^[:ascii:]]")) { - abort("Assertion on `label` failed: Must not contain any non-ASCII, symbol or special characters.") + assert("Must not contain any non-ASCII, symbol or special characters.", .var.name = vname(label)) } attr(.df, "label") <- label diff --git a/R/xportr-package.R b/R/xportr-package.R index 07bde629..d0a129ce 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -108,10 +108,9 @@ #' @importFrom tm stemDocument #' @importFrom graphics stem #' @importFrom magrittr %>% extract2 -#' @importFrom checkmate assert assert_string assert_choice assert_data_frame -#' check_r6 check_data_frame test_string test_r6 assert_character assert_integer -#' assert_logical -#' +#' @importFrom checkmate assert assert_character assert_choice assert_data_frame +#' assert_integer assert_logical assert_string makeAssertion check_data_frame +#' check_r6 test_data_frame test_r6 test_string vname "_PACKAGE" globalVariables(c( diff --git a/tests/testthat/test-df_label.R b/tests/testthat/test-df_label.R index eae3969d..2cbe1736 100644 --- a/tests/testthat/test-df_label.R +++ b/tests/testthat/test-df_label.R @@ -9,6 +9,6 @@ test_that("xportr_df_label: error when metadata is not set", { expect_error( xportr_df_label(adsl), - regexp = "Metadata must be set with `metadata` or `xportr_metadata\\(\\)`" + regexp = "Must be of type 'data.frame', 'Metacore' or set via 'xportr_metadata\\(\\)'" ) }) diff --git a/tests/testthat/test-format.R b/tests/testthat/test-format.R index 76b65e1d..6b39c7e6 100644 --- a/tests/testthat/test-format.R +++ b/tests/testthat/test-format.R @@ -6,7 +6,7 @@ test_that("xportr_format: error when metadata is not set", { expect_error( xportr_format(adsl), - regexp = "Metadata must be set with `metadata` or `xportr_metadata\\(\\)`" + regexp = "Must be of type 'data.frame', 'Metacore' or set via 'xportr_metadata\\(\\)'" ) }) diff --git a/tests/testthat/test-label.R b/tests/testthat/test-label.R index 8030a826..6d1b0349 100644 --- a/tests/testthat/test-label.R +++ b/tests/testthat/test-label.R @@ -8,7 +8,7 @@ test_that("xportr_label: error when metadata is not set", { expect_error( xportr_label(df), - regexp = "Metadata must be set with `metadata` or `xportr_metadata\\(\\)`" + regexp = "Must be of type 'data.frame', 'Metacore' or set via 'xportr_metadata\\(\\)'" ) }) diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index dd8b531f..ab4ea152 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -180,7 +180,7 @@ test_that("xportr_length: error when metadata is not set", { expect_error( xportr_length(adsl), - regexp = "Metadata must be set with `metadata` or `xportr_metadata\\(\\)`" + regexp = "Must be of type 'data.frame', 'Metacore' or set via 'xportr_metadata\\(\\)'" ) }) diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index b86eb205..9f6d4169 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -548,7 +548,6 @@ test_that("xportr_length: Expect error if domain is not a character", { # tests for `xportr_metadata()` basic functionality # start test_that("xportr_metadata: Check metadata interaction with other functions", { - skip_if_not_installed("admiral") adsl <- admiral::admiral_adsl diff --git a/tests/testthat/test-order.R b/tests/testthat/test-order.R index 941a7d04..c5bde736 100644 --- a/tests/testthat/test-order.R +++ b/tests/testthat/test-order.R @@ -106,7 +106,7 @@ test_that("xportr_order: error when metadata is not set", { expect_error( xportr_order(df), - regexp = "Metadata must be set with `metadata` or `xportr_metadata\\(\\)`" + regexp = "Must be of type 'data.frame', 'Metacore' or set via 'xportr_metadata\\(\\)'" ) }) diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index 2a84cf16..3a3e10d7 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -210,7 +210,7 @@ test_that("xportr_type: works fine from metacore spec", { test_that("xportr_type: error when metadata is not set", { expect_error( xportr_type(df), - regexp = "Metadata must be set with `metadata` or `xportr_metadata\\(\\)`" + regexp = "Must be of type 'data.frame', 'Metacore' or set via 'xportr_metadata\\(\\)'" ) }) From 5d9c36797e168224be59489a2307e01c1fce6517 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 15 Dec 2023 14:46:15 +0100 Subject: [PATCH 061/267] fix: use iwalk instead if walk2 with seq(...) --- NAMESPACE | 2 +- R/type.R | 4 ++-- R/xportr-package.R | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 1a6419a1..2c7d28c7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -62,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) diff --git a/R/type.R b/R/type.R index b6ecd526..77dd74c2 100644 --- a/R/type.R +++ b/R/type.R @@ -158,8 +158,8 @@ xportr_type <- function(.df, # Walk along the columns and coerce the variables. Modifying the columns # Directly instead of something like map_dfc to preserve any attributes. - walk2( - correct_type, seq_along(correct_type), + iwalk( + correct_type, function(x, i, is_correct) { if (!is_correct[i]) { orig_attributes <- attributes(.df[[i]]) diff --git a/R/xportr-package.R b/R/xportr-package.R index d0a129ce..cbb70642 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -103,7 +103,7 @@ #' @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 walk walk2 map map_dbl pluck +#' @importFrom purrr map_chr map2_chr walk iwalk map map_dbl pluck #' @importFrom janitor make_clean_names #' @importFrom tm stemDocument #' @importFrom graphics stem From 328c244e321d60a077aa6fc4c72379745879fa48 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 15 Dec 2023 14:51:50 +0100 Subject: [PATCH 062/267] fix: change vname() in favor of string --- R/write.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/write.R b/R/write.R index 05a914c6..561ec512 100644 --- a/R/write.R +++ b/R/write.R @@ -49,16 +49,16 @@ xportr_write <- function(.df, path, label = NULL, strict_checks = FALSE) { name <- tools::file_path_sans_ext(basename(path)) if (nchar(name) > 8) { - assert("File name must be 8 characters or less.", .var.name = vname(path)) + assert("File name must be 8 characters or less.", .var.name = "path") } if (stringr::str_detect(name, "[^a-zA-Z0-9]")) { - assert("File name must not contain any non-ASCII, symbol or underscore characters.", .var.name = vname(path)) + assert("File name must not contain any non-ASCII, symbol or underscore characters.", .var.name = "path") } if (!is.null(label)) { if (stringr::str_detect(label, "[^[:ascii:]]")) { - assert("Must not contain any non-ASCII, symbol or special characters.", .var.name = vname(label)) + assert("Must not contain any non-ASCII, symbol or special characters.", .var.name = "label") } attr(.df, "label") <- label From 7428e0408ed80762d356c17d7fa0d2a20141a6fc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 15 Dec 2023 14:54:44 +0100 Subject: [PATCH 063/267] fix: revert test_r6() in favor of inherits() --- NAMESPACE | 1 - R/format.R | 2 +- R/length.R | 18 +----------------- R/order.R | 2 +- R/type.R | 2 +- R/utils-xportr.R | 2 +- R/xportr-package.R | 2 +- 7 files changed, 6 insertions(+), 23 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 2c7d28c7..e07dd8b3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -29,7 +29,6 @@ importFrom(checkmate,check_data_frame) importFrom(checkmate,check_r6) importFrom(checkmate,makeAssertion) importFrom(checkmate,test_data_frame) -importFrom(checkmate,test_r6) importFrom(checkmate,test_string) importFrom(checkmate,vname) importFrom(cli,cli_alert_danger) diff --git a/R/format.R b/R/format.R index cd4152aa..b44c369b 100644 --- a/R/format.R +++ b/R/format.R @@ -67,7 +67,7 @@ xportr_format <- function(.df, format_name <- getOption("xportr.format_name") variable_name <- getOption("xportr.variable_name") - if (test_r6(metadata, "Metacore")) metadata <- metadata$var_spec + if (inherits(metadata, "Metacore")) metadata <- metadata$var_spec if (domain_name %in% names(metadata)) { metadata <- metadata %>% diff --git a/R/length.R b/R/length.R index 97890fe4..16c2b07d 100644 --- a/R/length.R +++ b/R/length.R @@ -91,23 +91,7 @@ xportr_length <- function(.df, variable_length <- getOption("xportr.length") variable_name <- getOption("xportr.variable_name") - ## Common section to detect domain from argument or pipes - - 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_") %||% - assert( - "Must be of type 'data.frame' or set via 'xportr_metadata()'", - .var.name = "metadata" - ) - - if (test_r6(metadata, "Metacore")) { - metadata <- metadata$var_spec - } + if (inherits(metadata, "Metacore")) metadata <- metadata$var_spec if (domain_name %in% names(metadata)) { metadata <- metadata %>% diff --git a/R/order.R b/R/order.R index 31e7ccd1..442c1d10 100644 --- a/R/order.R +++ b/R/order.R @@ -87,7 +87,7 @@ xportr_order <- function(.df, order_name <- getOption("xportr.order_name") variable_name <- getOption("xportr.variable_name") - if (test_r6(metadata, "Metacore")) metadata <- metadata$ds_vars + if (inherits(metadata, "Metacore")) metadata <- metadata$ds_vars if (domain_name %in% names(metadata)) { metadata <- metadata %>% diff --git a/R/type.R b/R/type.R index 77dd74c2..bd5e0f1a 100644 --- a/R/type.R +++ b/R/type.R @@ -108,7 +108,7 @@ xportr_type <- function(.df, numericTypes <- c(getOption("xportr.numeric_types"), "_numeric") format_name <- getOption("xportr.format_name") - if (test_r6(metadata, "Metacore")) metadata <- metadata$var_spec + if (inherits(metadata, "Metacore")) metadata <- metadata$var_spec if (domain_name %in% names(metadata)) { metadata <- metadata %>% diff --git a/R/utils-xportr.R b/R/utils-xportr.R index dc70a876..9c9edace 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -383,7 +383,7 @@ check_metadata <- function(metadata, include_fun_message) { extra_string <- " or 'Metacore'" } - if (!test_r6(metadata, "Metacore") && !test_data_frame(metadata)) { + if (!inherits(metadata, "Metacore") && !test_data_frame(metadata)) { return( glue( "Must be of type 'data.frame'{extra_string},", diff --git a/R/xportr-package.R b/R/xportr-package.R index cbb70642..54205767 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -110,7 +110,7 @@ #' @importFrom magrittr %>% extract2 #' @importFrom checkmate assert assert_character assert_choice assert_data_frame #' assert_integer assert_logical assert_string makeAssertion check_data_frame -#' check_r6 test_data_frame test_r6 test_string vname +#' check_r6 test_data_frame test_string vname "_PACKAGE" globalVariables(c( From aaf1886bbaabfa28158127e73fe17fc27b1b4136 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 15 Dec 2023 16:28:36 +0100 Subject: [PATCH 064/267] feat: change default parameter to be attribute --- R/df_label.R | 8 ++------ R/format.R | 8 ++------ R/label.R | 8 ++------ R/length.R | 8 ++------ R/metadata.R | 4 +--- R/order.R | 8 ++------ R/type.R | 8 ++------ 7 files changed, 13 insertions(+), 39 deletions(-) diff --git a/R/df_label.R b/R/df_label.R index 912890e6..d63b791f 100644 --- a/R/df_label.R +++ b/R/df_label.R @@ -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_"), metacore = deprecated()) { if (!missing(metacore)) { lifecycle::deprecate_warn( @@ -52,10 +52,6 @@ xportr_df_label <- function(.df, metadata <- metacore } assert_data_frame(.df) - - domain <- domain %||% attr(.df, "_xportr.df_arg_") - metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") - assert_string(domain, null.ok = TRUE) assert_metadata(metadata) diff --git a/R/format.R b/R/format.R index b44c369b..00fc692b 100644 --- a/R/format.R +++ b/R/format.R @@ -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_warn( @@ -54,10 +54,6 @@ xportr_format <- function(.df, metadata <- metacore } assert_data_frame(.df) - - domain <- domain %||% attr(.df, "_xportr.df_arg_") - metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") - assert_string(domain, null.ok = TRUE) assert_metadata(metadata) diff --git a/R/label.R b/R/label.R index a856d717..5667ae92 100644 --- a/R/label.R +++ b/R/label.R @@ -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)) { @@ -70,10 +70,6 @@ xportr_label <- function(.df, metadata <- metacore } assert_data_frame(.df) - - domain <- domain %||% attr(.df, "_xportr.df_arg_") - metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") - assert_string(domain, null.ok = TRUE) assert_metadata(metadata) assert_choice(verbose, choices = .internal_verbose_choices) diff --git a/R/length.R b/R/length.R index 16c2b07d..5202345d 100644 --- a/R/length.R +++ b/R/length.R @@ -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)) { @@ -77,10 +77,6 @@ xportr_length <- function(.df, metadata <- metacore } assert_data_frame(.df) - - domain <- domain %||% attr(.df, "_xportr.df_arg_") - metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") - assert_string(domain, null.ok = TRUE) assert_metadata(metadata) assert_choice(verbose, choices = .internal_verbose_choices) diff --git a/R/metadata.R b/R/metadata.R index 0f6a140a..6be201d7 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -40,10 +40,8 @@ #' xportr_type() %>% #' xportr_order() #' } -xportr_metadata <- function(.df, metadata, domain = NULL) { +xportr_metadata <- function(.df, metadata, domain = attr(.df, "_xportr.df_arg_")) { assert_data_frame(.df) - - domain <- domain %||% attr(.df, "_xportr.df_arg_") assert_metadata(metadata, include_fun_message = FALSE) assert_string(domain, null.ok = TRUE) diff --git a/R/order.R b/R/order.R index 442c1d10..e9cf0406 100644 --- a/R/order.R +++ b/R/order.R @@ -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)) { @@ -73,10 +73,6 @@ xportr_order <- function(.df, metadata <- metacore } assert_data_frame(.df) - - domain <- domain %||% attr(.df, "_xportr.df_arg_") - metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") - assert_string(domain, null.ok = TRUE) assert_metadata(metadata) assert_choice(verbose, choices = .internal_verbose_choices) diff --git a/R/type.R b/R/type.R index bd5e0f1a..a54064a5 100644 --- a/R/type.R +++ b/R/type.R @@ -77,8 +77,8 @@ #' #' df2 <- xportr_type(.df, metadata, "test") xportr_type <- function(.df, - metadata = NULL, - domain = NULL, + metadata = attr(.df, "_xportr.df_metadata_"), + domain = attr(.df, "_xportr.df_arg_"), verbose = getOption("xportr.type_verbose", "none"), metacore = deprecated()) { if (!missing(metacore)) { @@ -90,10 +90,6 @@ xportr_type <- function(.df, metadata <- metacore } assert_data_frame(.df) - - domain <- domain %||% attr(.df, "_xportr.df_arg_") - metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") - assert_string(domain, null.ok = TRUE) assert_metadata(metadata) assert_choice(verbose, choices = .internal_verbose_choices) From d4511f9b0b0f571195ca288d93abe28127bfc6bd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 15 Dec 2023 16:43:59 +0100 Subject: [PATCH 065/267] docs: update --- man/metadata.Rd | 2 +- man/xportr_df_label.Rd | 7 ++++++- man/xportr_format.Rd | 7 ++++++- man/xportr_label.Rd | 4 ++-- man/xportr_length.Rd | 4 ++-- man/xportr_order.Rd | 4 ++-- man/xportr_type.Rd | 4 ++-- 7 files changed, 21 insertions(+), 11 deletions(-) diff --git a/man/metadata.Rd b/man/metadata.Rd index 2a7d0af0..52b4ca6b 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -5,7 +5,7 @@ \alias{xportr_domain_name} \title{Set variable specifications and domain} \usage{ -xportr_metadata(.df, metadata, domain = NULL) +xportr_metadata(.df, metadata, domain = attr(.df, "_xportr.df_arg_")) xportr_domain_name(.df, domain) } diff --git a/man/xportr_df_label.Rd b/man/xportr_df_label.Rd index 691de990..f5d9833e 100644 --- a/man/xportr_df_label.Rd +++ b/man/xportr_df_label.Rd @@ -4,7 +4,12 @@ \alias{xportr_df_label} \title{Assign Dataset Label} \usage{ -xportr_df_label(.df, metadata = NULL, domain = NULL, metacore = deprecated()) +xportr_df_label( + .df, + metadata = attr(.df, "_xportr.df_metadata_"), + domain = attr(.df, "_xportr.df_arg_"), + metacore = deprecated() +) } \arguments{ \item{.df}{A data frame of CDISC standard.} diff --git a/man/xportr_format.Rd b/man/xportr_format.Rd index c6fd6e85..ad0f24b2 100644 --- a/man/xportr_format.Rd +++ b/man/xportr_format.Rd @@ -4,7 +4,12 @@ \alias{xportr_format} \title{Assign SAS Format} \usage{ -xportr_format(.df, metadata = NULL, domain = NULL, metacore = deprecated()) +xportr_format( + .df, + metadata = attr(.df, "_xportr.df_metadata_"), + domain = attr(.df, "_xportr.df_arg_"), + metacore = deprecated() +) } \arguments{ \item{.df}{A data frame of CDISC standard.} diff --git a/man/xportr_label.Rd b/man/xportr_label.Rd index 4cd7d18c..fc19a966 100644 --- a/man/xportr_label.Rd +++ b/man/xportr_label.Rd @@ -6,8 +6,8 @@ \usage{ xportr_label( .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() ) diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index 4c4dd224..f7674540 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -6,8 +6,8 @@ \usage{ xportr_length( .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() ) diff --git a/man/xportr_order.Rd b/man/xportr_order.Rd index 44f283cf..fbfb3213 100644 --- a/man/xportr_order.Rd +++ b/man/xportr_order.Rd @@ -6,8 +6,8 @@ \usage{ xportr_order( .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() ) diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index abfa41d8..e4b68e8c 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -6,8 +6,8 @@ \usage{ xportr_type( .df, - metadata = NULL, - domain = NULL, + metadata = attr(.df, "_xportr.df_metadata_"), + domain = attr(.df, "_xportr.df_arg_"), verbose = getOption("xportr.type_verbose", "none"), metacore = deprecated() ) From 71f59959c07d6974067e782a5d4b77c00cd18600 Mon Sep 17 00:00:00 2001 From: bms63 Date: Fri, 15 Dec 2023 16:36:54 +0000 Subject: [PATCH 066/267] [skip actions] Bump version to 0.3.1.9004 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 065cf316..0288c86c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9003 +Version: 0.3.1.9004 Authors@R: c( person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")), From 8747e76d721505e247df06b8886b163e2eefc116 Mon Sep 17 00:00:00 2001 From: Celine Date: Mon, 18 Dec 2023 04:27:35 -0500 Subject: [PATCH 067/267] Add test for underscore in filename --- tests/testthat/test-write.R | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index 4229c06e..953a6939 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -91,6 +91,15 @@ test_that("xportr_write: expect error when file name contains non-ASCII symbols expect_error(xportr_write(data_to_save, tmp)) }) +test_that("xportr_write: expect warning when file name contains underscore and strict_checks = FALSE", { + tmpdir <- tempdir() + tmp <- file.path(tmpdir, "test_.xpt") + + on.exit(unlink(tmpdir)) + + expect_warning(xportr_write(data_to_save, tmp, strict_checks = FALSE)) +}) + test_that("xportr_write: expect error when label contains non-ASCII symbols or special characters", { tmpdir <- tempdir() tmp <- file.path(tmpdir, "xyz.xpt") From 49b44e834031de0b64d5e15080009463ee1fd29a Mon Sep 17 00:00:00 2001 From: elimillera Date: Mon, 18 Dec 2023 21:36:22 +0000 Subject: [PATCH 068/267] Add news entry --- NEWS.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NEWS.md b/NEWS.md index 27f14385..aa4049f2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,10 @@ ## 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) + # xportr 0.3.1 ## New Features and Bug Fixes From 9da5288947dd80197aec48c191158f6d21220674 Mon Sep 17 00:00:00 2001 From: elimillera Date: Mon, 18 Dec 2023 21:45:55 +0000 Subject: [PATCH 069/267] Remove unneeded tests --- tests/testthat/test-metadata.R | 37 ++++++ tests/testthat/test-pipe.R | 202 --------------------------------- 2 files changed, 37 insertions(+), 202 deletions(-) delete mode 100644 tests/testthat/test-pipe.R diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index 9841ae0d..20a4aa63 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -607,4 +607,41 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { ) ) }) + +test_that("xportr_*: Domain is kept in between calls", { + # Divert all messages to tempfile, instead of printing them + # note: be aware as this should only be used in tests that don't track + # messages + withr::local_message_sink(tempfile()) + + adsl <- minimal_table(30) + + metadata <- minimal_metadata( + dataset = TRUE, length = TRUE, label = TRUE, type = TRUE, format = TRUE, + order = TRUE + ) + + df2 <- adsl %>% + xportr_domain_name("adsl") %>% + xportr_type(metadata) + + df3 <- df2 %>% + xportr_label(metadata) %>% + xportr_length(metadata) %>% + xportr_order(metadata) %>% + xportr_format(metadata) + + expect_equal(attr(df3, "_xportr.df_arg_"), "adsl") + + df4 <- adsl %>% + xportr_type(metadata, domain = "adsl") + + df5 <- df4 %>% + xportr_label(metadata) %>% + xportr_length(metadata) %>% + xportr_order(metadata) %>% + xportr_format(metadata) + + expect_equal(attr(df5, "_xportr.df_arg_"), "adsl") +}) # end diff --git a/tests/testthat/test-pipe.R b/tests/testthat/test-pipe.R deleted file mode 100644 index 90876763..00000000 --- a/tests/testthat/test-pipe.R +++ /dev/null @@ -1,202 +0,0 @@ -test_that("xportr_*: Domain is kept in between calls", { - # Divert all messages to tempfile, instead of printing them - # note: be aware as this should only be used in tests that don't track - # messages - withr::local_message_sink(tempfile()) - - adsl <- minimal_table(30) - - metadata <- minimal_metadata( - dataset = TRUE, length = TRUE, label = TRUE, type = TRUE, format = TRUE, - order = TRUE - ) - - df2 <- adsl %>% - xportr_domain_name("adsl") %>% - xportr_type(metadata) - - df3 <- df2 %>% - xportr_label(metadata) %>% - xportr_length(metadata) %>% - xportr_order(metadata) %>% - xportr_format(metadata) - - expect_equal(attr(df3, "_xportr.df_arg_"), "adsl") - - df4 <- adsl %>% - xportr_type(metadata, domain = "adsl") - - df5 <- df4 %>% - xportr_label(metadata) %>% - xportr_length(metadata) %>% - xportr_order(metadata) %>% - xportr_format(metadata) - - expect_equal(attr(df5, "_xportr.df_arg_"), "adsl") -}) - -test_that("xportr_*: Can use magrittr pipe and aquire domain from call", { - # Divert all messages to tempfile, instead of printing them - # note: be aware as this should only be used in tests that don't track - # messages - withr::local_message_sink(tempfile()) - - adsl <- minimal_table(30) - - metadata <- minimal_metadata( - dataset = TRUE, length = TRUE, label = TRUE, type = TRUE, format = TRUE, - order = TRUE - ) - - non_standard_name <- adsl - result <- non_standard_name %>% - xportr_domain_name("non_standard_name") %>% - xportr_type(metadata) %>% - xportr_label(metadata) %>% - xportr_length(metadata) %>% - xportr_order(metadata) %>% - xportr_format(metadata) %>% - xportr_df_label(metadata) - - expect_equal(attr(result, "_xportr.df_arg_"), "non_standard_name") - - # Different sequence call by moving first and last around - result2 <- non_standard_name %>% - xportr_domain_name("non_standard_name") %>% - xportr_label(metadata) %>% - xportr_length(metadata) %>% - xportr_order(metadata) %>% - xportr_df_label(metadata) %>% - xportr_type(metadata) %>% - xportr_format(metadata) - - expect_equal(attr(result2, "_xportr.df_arg_"), "non_standard_name") -}) - -test_that("xportr_*: Can use magrittr pipe and aquire domain from call (metadata)", { - # Divert all messages to tempfile, instead of printing them - # note: be aware as this should only be used in tests that don't track - # messages - withr::local_message_sink(tempfile()) - - adsl <- minimal_table(30) - - metadata <- minimal_metadata( - dataset = TRUE, length = TRUE, label = TRUE, type = TRUE, format = TRUE, - order = TRUE - ) - - non_standard_name <- adsl - result <- non_standard_name %>% - xportr_domain_name("non_standard_name") %>% - xportr_metadata(metadata) %>% - xportr_type() %>% - xportr_label() %>% - xportr_length() %>% - xportr_order() %>% - xportr_format() %>% - xportr_df_label() - - expect_equal(attr(result, "_xportr.df_arg_"), "non_standard_name") - - # Different sequence call by moving first and last around - result2 <- non_standard_name %>% - xportr_domain_name("non_standard_name") %>% - xportr_metadata(metadata) %>% - xportr_label() %>% - xportr_length() %>% - xportr_order() %>% - xportr_df_label() %>% - xportr_type() %>% - xportr_format() - - expect_equal(attr(result2, "_xportr.df_arg_"), "non_standard_name") -}) - -test_that("xportr_*: Can use R native pipe (R>4.1) and aquire domain from call", { - skip_if( - compareVersion(glue("{R.version$major}.{R.version$minor}"), "4.1.0") < 0, - "R Version doesn't support native pipe (<4.1)" - ) - - # Divert all messages to tempfile, instead of printing them - # note: be aware as this should only be used in tests that don't track - # messages - withr::local_message_sink(tempfile()) - - adsl <- minimal_table(30) - - metadata <- minimal_metadata( - dataset = TRUE, length = TRUE, label = TRUE, type = TRUE, format = TRUE, - order = TRUE - ) - - non_standard_name_native <- adsl - result <- non_standard_name_native |> - xportr_domain_name("non_standard_name_native") |> - xportr_type(metadata) |> - xportr_label(metadata) |> - xportr_length(metadata) |> - xportr_order(metadata) |> - xportr_format(metadata) |> - xportr_df_label(metadata) - - expect_equal(attr(result, "_xportr.df_arg_"), "non_standard_name_native") - - # Different sequence call by moving first and last around - result2 <- non_standard_name_native |> - xportr_domain_name("non_standard_name_native") |> - xportr_label(metadata) |> - xportr_length(metadata) |> - xportr_order(metadata) |> - xportr_df_label(metadata) |> - xportr_type(metadata) |> - xportr_format(metadata) - - expect_equal(attr(result2, "_xportr.df_arg_"), "non_standard_name_native") -}) - -test_that("xportr_*: Can use R native pipe (R>4.1) and aquire domain from call (metadata)", { - skip_if( - compareVersion(glue("{R.version$major}.{R.version$minor}"), "4.1.0") < 0, - "R Version doesn't support native pipe (<4.1)" - ) - - # Divert all messages to tempfile, instead of printing them - # note: be aware as this should only be used in tests that don't track - # messages - withr::local_message_sink(tempfile()) - - adsl <- minimal_table(30) - - metadata <- minimal_metadata( - dataset = TRUE, length = TRUE, label = TRUE, type = TRUE, format = TRUE, - order = TRUE - ) - - non_standard_name_native <- adsl - result <- non_standard_name_native |> - xportr_domain_name("non_standard_name_native") |> - xportr_metadata(metadata) |> - xportr_type() |> - xportr_label() |> - xportr_length() |> - xportr_order() |> - xportr_format() |> - xportr_df_label() - - expect_equal(attr(result, "_xportr.df_arg_"), "non_standard_name_native") - - # Different sequence call by moving first and last around - result2 <- non_standard_name_native |> - xportr_domain_name("non_standard_name_native") |> - xportr_metadata(metadata) |> - xportr_label() |> - xportr_length() |> - xportr_order() |> - xportr_df_label() |> - xportr_type() |> - xportr_format() - - expect_equal(attr(result2, "_xportr.df_arg_"), "non_standard_name_native") -}) From e7d96c992b20614e2d0ab744bcd57d00f5f4dd8c Mon Sep 17 00:00:00 2001 From: elimillera Date: Mon, 18 Dec 2023 21:50:24 +0000 Subject: [PATCH 070/267] doc update for domain argument --- R/length.R | 5 +++-- man/metadata.Rd | 5 +++-- man/xportr_df_label.Rd | 5 +++-- man/xportr_format.Rd | 5 +++-- man/xportr_label.Rd | 5 +++-- man/xportr_length.Rd | 5 +++-- man/xportr_order.Rd | 5 +++-- man/xportr_type.Rd | 5 +++-- 8 files changed, 24 insertions(+), 16 deletions(-) diff --git a/R/length.R b/R/length.R index ec4e191a..46a6f7a7 100644 --- a/R/length.R +++ b/R/length.R @@ -9,8 +9,9 @@ #' @param metadata A data frame containing variable level metadata. See #' 'Metadata' section for details. #' @param domain Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -#' the metadata object. If none is passed, then name of the dataset passed as -#' .df will be used. +#' the metadata object. If none is passed, then [xportr_domain()] or +#' [xportr_metadata()] must be called before hand to set the domain as an +#' attribute of `.df`. #' @param verbose The action this function takes when an action is taken on the #' dataset or function validation finds an issue. See 'Messaging' section for #' details. Options are 'stop', 'warn', 'message', and 'none' diff --git a/man/metadata.Rd b/man/metadata.Rd index 2a7d0af0..e429b91d 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -16,8 +16,9 @@ xportr_domain_name(.df, domain) 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then name of the dataset passed as -.df will be used.} +the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an +attribute of \code{.df}.} } \value{ \code{.df} dataset with metadata and domain attributes set diff --git a/man/xportr_df_label.Rd b/man/xportr_df_label.Rd index 691de990..64c1aebb 100644 --- a/man/xportr_df_label.Rd +++ b/man/xportr_df_label.Rd @@ -13,8 +13,9 @@ xportr_df_label(.df, metadata = NULL, domain = NULL, metacore = deprecated()) details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then name of the dataset passed as -.df will be used.} +the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an +attribute of \code{.df}.} \item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass metadata now renamed with \code{metadata}} diff --git a/man/xportr_format.Rd b/man/xportr_format.Rd index c6fd6e85..0bef1798 100644 --- a/man/xportr_format.Rd +++ b/man/xportr_format.Rd @@ -13,8 +13,9 @@ xportr_format(.df, metadata = NULL, domain = NULL, metacore = deprecated()) 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then name of the dataset passed as -.df will be used.} +the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an +attribute of \code{.df}.} \item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass metadata now renamed with \code{metadata}} diff --git a/man/xportr_label.Rd b/man/xportr_label.Rd index 4cd7d18c..ecad5b4d 100644 --- a/man/xportr_label.Rd +++ b/man/xportr_label.Rd @@ -19,8 +19,9 @@ xportr_label( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then name of the dataset passed as -.df will be used.} +the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an +attribute of \code{.df}.} \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index 4c4dd224..d4a0b252 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -19,8 +19,9 @@ xportr_length( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then name of the dataset passed as -.df will be used.} +the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an +attribute of \code{.df}.} \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for diff --git a/man/xportr_order.Rd b/man/xportr_order.Rd index 44f283cf..ef10eab0 100644 --- a/man/xportr_order.Rd +++ b/man/xportr_order.Rd @@ -19,8 +19,9 @@ xportr_order( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then name of the dataset passed as -.df will be used.} +the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an +attribute of \code{.df}.} \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index abfa41d8..8dfdfa1e 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -19,8 +19,9 @@ xportr_type( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then name of the dataset passed as -.df will be used.} +the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an +attribute of \code{.df}.} \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for From 5ab7ed508b09471a75a08cff00a4689c9e81aeb7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 19 Dec 2023 09:13:45 +0100 Subject: [PATCH 071/267] Update NEWS.md Co-authored-by: Ben Straub --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index d746a145..5dfd35bf 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +2,7 @@ ## New Features and Bug Fixes -* Adds argument assertions to public functions (#175) +* Adds argument assertions to public functions using `{checkmate}` (#175) ## Documentation From a6696574cff9d8ed043adca3569fb09b8fd7e4ad Mon Sep 17 00:00:00 2001 From: Celine Date: Tue, 19 Dec 2023 06:54:40 -0500 Subject: [PATCH 072/267] Add a function for max length --- R/utils-xportr.R | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) diff --git a/R/utils-xportr.R b/R/utils-xportr.R index feb31195..38034cc4 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -387,3 +387,35 @@ check_multiple_var_specs <- function(metadata, ) } } + +#' Calculate the maximum length of variables +#' +#' Function to calculate the maximum length of variables in a given dataframe +#' +#' @inheritParams xportr_length +#' +#' @return Returns a dataframe with variables and their maximum length +#' +#' @export + +variable_max_length <- function(.df) { + max_nchar <- .df %>% + summarize(across(where(is.character), ~ max(0L, nchar(., type = "bytes"), na.rm = TRUE))) + + + xport_max_length <- data.frame() + col <- 0 + for (var in names(.df)) { + col <- col + 1 + + xport_max_length[col, xportr.variable_name] <- var + + if (is.character(.df[[var]])) { + xport_max_length[col, xportr.length] <- max_nchar[var] + } else { + xport_max_length[col, xportr.length] <- 8 + } + } + + return(xport_max_length) +} From ea1201acb9d0935c330a57d4985edf675d049910 Mon Sep 17 00:00:00 2001 From: Celine Date: Tue, 19 Dec 2023 07:25:08 -0500 Subject: [PATCH 073/267] Update to use getOption for df name --- R/utils-xportr.R | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/R/utils-xportr.R b/R/utils-xportr.R index 38034cc4..168a2a48 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -399,6 +399,10 @@ check_multiple_var_specs <- function(metadata, #' @export variable_max_length <- function(.df) { + + variable_length <- getOption("xportr.length") + variable_name <- getOption("xportr.variable_name") + max_nchar <- .df %>% summarize(across(where(is.character), ~ max(0L, nchar(., type = "bytes"), na.rm = TRUE))) @@ -408,12 +412,12 @@ variable_max_length <- function(.df) { for (var in names(.df)) { col <- col + 1 - xport_max_length[col, xportr.variable_name] <- var + xport_max_length[col, variable_name] <- var if (is.character(.df[[var]])) { - xport_max_length[col, xportr.length] <- max_nchar[var] + xport_max_length[col, variable_length] <- max_nchar[var] } else { - xport_max_length[col, xportr.length] <- 8 + xport_max_length[col, variable_length] <- 8 } } From 49bfdfbf299fe7343731e39b2e103acfe7f4079d Mon Sep 17 00:00:00 2001 From: Celine Date: Tue, 19 Dec 2023 08:41:58 -0500 Subject: [PATCH 074/267] Update New.md for #126 --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 56a921e3..9dfa7fdc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,7 @@ * Exporting a new dataset `dataset_spec` that contains the Dataset Specification for ADSL. (#179) * 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) ## Deprecation and Breaking Changes From da3fe758874cc8c82c5f2d4d405e17a5617e6846 Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 19 Dec 2023 21:33:23 +0530 Subject: [PATCH 075/267] chore: hard deprecate the `metacore` argument --- NEWS.md | 1 + R/df_label.R | 5 ++--- R/format.R | 5 ++--- R/label.R | 5 ++--- R/length.R | 5 ++--- R/order.R | 5 ++--- R/type.R | 5 ++--- 7 files changed, 13 insertions(+), 18 deletions(-) diff --git a/NEWS.md b/NEWS.md index 56a921e3..0adb7867 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,6 +10,7 @@ ## Deprecation and Breaking Changes * 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`. ## Documentation diff --git a/R/df_label.R b/R/df_label.R index 0621428a..91ba0c36 100644 --- a/R/df_label.R +++ b/R/df_label.R @@ -44,12 +44,11 @@ xportr_df_label <- function(.df, domain = NULL, metacore = deprecated()) { if (!missing(metacore)) { - lifecycle::deprecate_warn( - when = "0.3.0", + lifecycle::deprecate_stop( + when = "0.3.1.9005", what = "xportr_df_label(metacore = )", with = "xportr_df_label(metadata = )" ) - metadata <- metacore } domain_name <- getOption("xportr.df_domain_name") label_name <- getOption("xportr.df_label") diff --git a/R/format.R b/R/format.R index 17e15183..1b1a627d 100644 --- a/R/format.R +++ b/R/format.R @@ -46,12 +46,11 @@ xportr_format <- function(.df, domain = NULL, metacore = deprecated()) { if (!missing(metacore)) { - lifecycle::deprecate_warn( - when = "0.3.0", + lifecycle::deprecate_stop( + when = "0.3.1.9005", what = "xportr_format(metacore = )", with = "xportr_format(metadata = )" ) - metadata <- metacore } domain_name <- getOption("xportr.domain_name") format_name <- getOption("xportr.format_name") diff --git a/R/label.R b/R/label.R index e412e9fc..03a09348 100644 --- a/R/label.R +++ b/R/label.R @@ -62,12 +62,11 @@ xportr_label <- function(.df, verbose = getOption("xportr.label_verbose", "none"), metacore = deprecated()) { if (!missing(metacore)) { - lifecycle::deprecate_warn( - when = "0.3.0", + lifecycle::deprecate_stop( + when = "0.3.1.9005", what = "xportr_label(metacore = )", with = "xportr_label(metadata = )" ) - metadata <- metacore } domain_name <- getOption("xportr.domain_name") variable_name <- getOption("xportr.variable_name") diff --git a/R/length.R b/R/length.R index 17627268..1cd10980 100644 --- a/R/length.R +++ b/R/length.R @@ -69,12 +69,11 @@ xportr_length <- function(.df, verbose = getOption("xportr.length_verbose", "none"), metacore = deprecated()) { if (!missing(metacore)) { - lifecycle::deprecate_warn( - when = "0.3.0", + lifecycle::deprecate_stop( + when = "0.3.1.9005", what = "xportr_length(metacore = )", with = "xportr_length(metadata = )" ) - metadata <- metacore } domain_name <- getOption("xportr.domain_name") variable_length <- getOption("xportr.length") diff --git a/R/order.R b/R/order.R index 0f7e1b30..0c8d322f 100644 --- a/R/order.R +++ b/R/order.R @@ -65,12 +65,11 @@ xportr_order <- function(.df, verbose = getOption("xportr.order_verbose", "none"), metacore = deprecated()) { if (!missing(metacore)) { - lifecycle::deprecate_warn( - when = "0.3.0", + lifecycle::deprecate_stop( + when = "0.3.1.9005", what = "xportr_order(metacore = )", with = "xportr_order(metadata = )" ) - metadata <- metacore } domain_name <- getOption("xportr.domain_name") order_name <- getOption("xportr.order_name") diff --git a/R/type.R b/R/type.R index 78cf6dca..86d6bd15 100644 --- a/R/type.R +++ b/R/type.R @@ -82,12 +82,11 @@ xportr_type <- function(.df, verbose = getOption("xportr.type_verbose", "none"), metacore = deprecated()) { if (!missing(metacore)) { - lifecycle::deprecate_warn( - when = "0.3.0", + lifecycle::deprecate_stop( + when = "0.3.1.9005", what = "xportr_type(metacore = )", with = "xportr_type(metadata = )" ) - metadata <- metacore } # Name of the columns for working with metadata domain_name <- getOption("xportr.domain_name") From e9a3e997f04840c31a546baadfa162de4f425301 Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 19 Dec 2023 21:48:16 +0530 Subject: [PATCH 076/267] chore: fix tests --- tests/testthat/test-depreciation.R | 65 ++++++------------------------ tests/testthat/test-length.R | 1 - tests/testthat/test-metadata.R | 1 + tests/testthat/test-order.R | 1 - 4 files changed, 13 insertions(+), 55 deletions(-) diff --git a/tests/testthat/test-depreciation.R b/tests/testthat/test-depreciation.R index 157f59b1..2679ecc9 100644 --- a/tests/testthat/test-depreciation.R +++ b/tests/testthat/test-depreciation.R @@ -1,16 +1,12 @@ -test_that("xportr_df_label: deprecated metacore argument still works and gives warning", { +test_that("xportr_df_label: deprecated metacore gives an error", { withr::local_options(lifecycle_verbosity = "quiet") df <- data.frame(x = "a", y = "b") df_meta <- data.frame(dataset = "df", label = "Label") - df_spec_labeled_df <- xportr_df_label(df, metacore = df_meta) - - expect_equal(attr(df_spec_labeled_df, "label"), "Label") - xportr_df_label(df, metacore = df_meta) %>% - lifecycle::expect_deprecated("Please use the `metadata` argument instead.") + expect_error(xportr_df_label(df, metacore = df_meta)) }) -test_that("xportr_format: deprecated metacore argument still works and gives warning", { +test_that("xportr_format: deprecated metacore gives an error", { withr::local_options(lifecycle_verbosity = "quiet") df <- data.frame(x = 1, y = 2) df_meta <- data.frame( @@ -19,33 +15,19 @@ test_that("xportr_format: deprecated metacore argument still works and gives war format = "date9." ) - formatted_df <- xportr_format(df, metacore = df_meta) - - expect_equal(attr(formatted_df$x, "format.sas"), "DATE9.") - xportr_format(df, metacore = df_meta) %>% - lifecycle::expect_deprecated("Please use the `metadata` argument instead.") + expect_error(xportr_format(df, metacore = df_meta)) }) -test_that("xportr_label: deprecated metacore argument still works and gives warning", { +test_that("xportr_label: using the deprecated metacore argument gives an error", { withr::local_options(lifecycle_verbosity = "quiet") df <- data.frame(x = "a", y = "b") df_meta <- data.frame(dataset = "df", variable = "x", label = "foo") - df_labeled_df <- suppressMessages( - xportr_label(df, metacore = df_meta) - ) - - expect_equal(attr(df_labeled_df$x, "label"), "foo") - - # Note that only the deprecated message should be caught (others are ignored) - suppressMessages( - xportr_label(df, metacore = df_meta) %>% - lifecycle::expect_deprecated("Please use the `metadata` argument instead.") - ) + expect_error(xportr_label(df, metacore = df_meta)) }) -test_that("xportr_length: deprecated metacore argument still works and gives warning", { +test_that("xportr_length: using the deprecated metacore argument gives an error", { withr::local_options(lifecycle_verbosity = "quiet") df <- data.frame(x = "a", y = "b") df_meta <- data.frame( @@ -55,15 +37,10 @@ test_that("xportr_length: deprecated metacore argument still works and gives war length = c(1, 2) ) - df_with_width <- xportr_length(df, metacore = df_meta) - - expect_equal(c(x = 1, y = 2), map_dbl(df_with_width, attr, "width")) - - xportr_length(df, metacore = df_meta) %>% - lifecycle::expect_deprecated("Please use the `metadata` argument instead.") + expect_error(xportr_length(df, metacore = df_meta)) }) -test_that("xportr_order: deprecated metacore argument still works and gives warning", { +test_that("xportr_order: using the deprecated metacore argument gives an error", { withr::local_options(lifecycle_verbosity = "quiet") df <- data.frame(c = 1:5, a = "a", d = 5:1, b = LETTERS[1:5]) @@ -73,20 +50,10 @@ test_that("xportr_order: deprecated metacore argument still works and gives warn order = 1:4 ) - ordered_df <- suppressMessages( - xportr_order(df, metacore = df_meta, domain = "DOMAIN") - ) - - expect_equal(names(ordered_df), df_meta$variable) - - # Note that only the deprecated message should be caught (others are ignored) - suppressMessages( - xportr_order(df, metacore = df_meta) %>% - lifecycle::expect_deprecated("Please use the `metadata` argument instead.") - ) + expect_error(xportr_order(df, metacore = df_meta, domain = "DOMAIN")) }) -test_that("xportr_type: deprecated metacore argument still works and gives warning", { +test_that("xportr_type: using the deprecated metacore argument gives an error", { withr::local_options(lifecycle_verbosity = "quiet") df <- data.frame( Subj = as.character(c(123, 456, 789, "", NA, NA_integer_)), @@ -101,13 +68,5 @@ test_that("xportr_type: deprecated metacore argument still works and gives warni format = NA ) - df2 <- suppressMessages( - xportr_type(df, metacore = df_meta) - ) - - # Note that only the deprecated message should be caught (others are ignored) - suppressMessages( - xportr_type(df, metacore = df_meta) %>% - lifecycle::expect_deprecated("Please use the `metadata` argument instead.") - ) + expect_error(xportr_type(df, metacore = df_meta)) }) diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index e749684d..35761d84 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -181,7 +181,6 @@ test_that("xportr_length: Metacore instance can be used", { }) test_that("xportr_length: Domain not in character format", { - skip_if_not_installed("haven") skip_if_not_installed("readxl") require(haven, quietly = TRUE) diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index b232ea2d..465d0de5 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -547,6 +547,7 @@ test_that("xportr_length: Expect error if domain is not a character", { # tests for `xportr_metadata()` basic functionality # start test_that("xportr_metadata: Check metadata interaction with other functions", { + skip_if_not_installed("admiral") adsl <- admiral::admiral_adsl var_spec <- diff --git a/tests/testthat/test-order.R b/tests/testthat/test-order.R index 801108c4..4caba77d 100644 --- a/tests/testthat/test-order.R +++ b/tests/testthat/test-order.R @@ -110,7 +110,6 @@ test_that("xportr_order: error when metadata is not set", { }) test_that("xportr_order: Variable ordering messaging is correct", { - skip_if_not_installed("haven") skip_if_not_installed("readxl") require(haven, quietly = TRUE) From a5bd5271e2c1c5e3e0ce9a2df32b1fd6358d1df3 Mon Sep 17 00:00:00 2001 From: Eli Miller Date: Tue, 19 Dec 2023 10:28:10 -0600 Subject: [PATCH 077/267] Update R/metadata.R Co-authored-by: Ben Straub --- R/metadata.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/metadata.R b/R/metadata.R index 325a3ff4..2db7d1b5 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -54,7 +54,7 @@ xportr_metadata <- function(.df, metadata, domain = NULL) { #' Update Metadata Domain Name #' -#' Similar to `xportr_metadata`, but just added the domain and not the metadata. +#' Similar to `xportr_metadata()`, but just adds the domain and not the metadata. #' #' @inheritParams xportr_length #' From dc832f3be650a5bcbd28a6fdf700fb90ed488635 Mon Sep 17 00:00:00 2001 From: elimillera Date: Tue, 19 Dec 2023 16:29:41 +0000 Subject: [PATCH 078/267] Update with PR comments --- R/length.R | 2 +- README.Rmd | 4 ++-- README.md | 3 ++- man/metadata.Rd | 2 +- man/xportr_df_label.Rd | 2 +- man/xportr_format.Rd | 2 +- man/xportr_label.Rd | 2 +- man/xportr_length.Rd | 2 +- man/xportr_order.Rd | 2 +- man/xportr_type.Rd | 2 +- 10 files changed, 12 insertions(+), 11 deletions(-) diff --git a/R/length.R b/R/length.R index 46a6f7a7..1b007970 100644 --- a/R/length.R +++ b/R/length.R @@ -9,7 +9,7 @@ #' @param metadata A data frame containing variable level metadata. See #' 'Metadata' section for details. #' @param domain Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -#' the metadata object. If none is passed, then [xportr_domain()] or +#' the metadata object. If none is passed, then [xportr_domain_name()] or #' [xportr_metadata()] must be called before hand to set the domain as an #' attribute of `.df`. #' @param verbose The action this function takes when an action is taken on the diff --git a/README.Rmd b/README.Rmd index 5f8431f5..1541a21b 100644 --- a/README.Rmd +++ b/README.Rmd @@ -137,8 +137,8 @@ adsl %>% xportr_label(var_spec, verbose = "warn") %>% xportr_order(var_spec, verbose = "warn") %>% xportr_format(var_spec) %>% - xportr_df_label(dataset_spec, "ADSL") %>% - xportr_write("adsl.xpt", label = "Subject-Level Analysis Dataset") + xportr_df_label(dataset_spec, "ADSL") %>% + xportr_write("adsl.xpt") ``` The `xportr_metadata()` function can reduce duplication by setting the variable specification and domain explicitly at the top of a pipeline. If you would like to use the `verbose` argument, you will need to set in each function call. diff --git a/README.md b/README.md index 646d0b45..cc83fae4 100644 --- a/README.md +++ b/README.md @@ -5,6 +5,7 @@ +[](https://RValidationHub.slack.com) [![R build status](https://github.com/atorus-research/xportr/workflows/R-CMD-check/badge.svg)](https://github.com/atorus-research/xportr/actions?workflow=R-CMD-check) [](https://app.codecov.io/gh/atorus-research/xportr) @@ -144,7 +145,7 @@ adsl %>% xportr_order(var_spec, verbose = "warn") %>% xportr_format(var_spec) %>% xportr_df_label(dataset_spec, "ADSL") %>% - xportr_write("adsl.xpt", label = "Subject-Level Analysis Dataset") + xportr_write("adsl.xpt") ``` The `xportr_metadata()` function can reduce duplication by setting the diff --git a/man/metadata.Rd b/man/metadata.Rd index e429b91d..d6171414 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -16,7 +16,7 @@ xportr_domain_name(.df, domain) 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or \code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an attribute of \code{.df}.} } diff --git a/man/xportr_df_label.Rd b/man/xportr_df_label.Rd index 64c1aebb..6d4764b4 100644 --- a/man/xportr_df_label.Rd +++ b/man/xportr_df_label.Rd @@ -13,7 +13,7 @@ xportr_df_label(.df, metadata = NULL, domain = NULL, metacore = deprecated()) details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or \code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an attribute of \code{.df}.} diff --git a/man/xportr_format.Rd b/man/xportr_format.Rd index 0bef1798..b7825fc4 100644 --- a/man/xportr_format.Rd +++ b/man/xportr_format.Rd @@ -13,7 +13,7 @@ xportr_format(.df, metadata = NULL, domain = NULL, metacore = deprecated()) 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or \code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an attribute of \code{.df}.} diff --git a/man/xportr_label.Rd b/man/xportr_label.Rd index ecad5b4d..87d648da 100644 --- a/man/xportr_label.Rd +++ b/man/xportr_label.Rd @@ -19,7 +19,7 @@ xportr_label( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or \code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an attribute of \code{.df}.} diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index d4a0b252..1d5100df 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -19,7 +19,7 @@ xportr_length( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or \code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an attribute of \code{.df}.} diff --git a/man/xportr_order.Rd b/man/xportr_order.Rd index ef10eab0..72bda30d 100644 --- a/man/xportr_order.Rd +++ b/man/xportr_order.Rd @@ -19,7 +19,7 @@ xportr_order( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or \code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an attribute of \code{.df}.} diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index 8dfdfa1e..3c67c4c7 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -19,7 +19,7 @@ xportr_type( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or \code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an attribute of \code{.df}.} From e378cbdcb80233a2e9605fcbe322d1f17ea15857 Mon Sep 17 00:00:00 2001 From: elimillera Date: Tue, 19 Dec 2023 16:46:30 +0000 Subject: [PATCH 079/267] passing R CMD Check --- R/write.R | 6 +++--- man/metadata.Rd | 2 +- man/xportr_write.Rd | 6 ++++-- tests/testthat/test-write.R | 8 ++++++-- 4 files changed, 14 insertions(+), 8 deletions(-) diff --git a/R/write.R b/R/write.R index 0dd13541..c9005471 100644 --- a/R/write.R +++ b/R/write.R @@ -37,6 +37,7 @@ #' var_spec <- data.frame(dataset = "adsl", label = "Subject-Level Analysis Dataset") #' xportr_write(adsl, #' path = paste0(tempdir(), "/adsl.xpt"), +#' domain = "adsl", #' metadata = var_spec, #' strict_checks = FALSE #' ) @@ -51,10 +52,9 @@ xportr_write <- function(.df, name <- tools::file_path_sans_ext(basename(path)) - ## Common section to detect domain from argument or pipes + ## Common section to detect domain from argument or attribute - df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) - domain <- get_domain(.df, df_arg, domain) + domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section diff --git a/man/metadata.Rd b/man/metadata.Rd index d6171414..f3c497de 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -31,7 +31,7 @@ functions. If used at the start of an xportr pipeline, it removes the need to set metadata and domain at each step individually. For details on the format of the metadata, see the 'Metadata' section for each function in question. -Similar to \code{xportr_metadata}, but just added the domain and not the metadata. +Similar to \code{xportr_metadata()}, but just adds the domain and not the metadata. } \examples{ diff --git a/man/xportr_write.Rd b/man/xportr_write.Rd index b59e61bd..9ecbd3a4 100644 --- a/man/xportr_write.Rd +++ b/man/xportr_write.Rd @@ -23,8 +23,9 @@ used as \code{xpt} name.} 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then name of the dataset passed as -.df will be used.} +the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or +\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an +attribute of \code{.df}.} \item{strict_checks}{If TRUE, xpt validation will report errors and not write out the dataset. If FALSE, xpt validation will report warnings and continue @@ -60,6 +61,7 @@ adsl <- data.frame( var_spec <- data.frame(dataset = "adsl", label = "Subject-Level Analysis Dataset") xportr_write(adsl, path = paste0(tempdir(), "/adsl.xpt"), + domain = "adsl", metadata = var_spec, strict_checks = FALSE ) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index 4229c06e..e45abce0 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -16,7 +16,7 @@ test_that("xportr_write: exported data can still be saved to a file with a label on.exit(unlink(tmpdir)) - suppressWarnings(xportr_write(data_to_save, path = tmp, label = "Lorem ipsum dolor sit amet")) + suppressWarnings(xportr_write(data_to_save, path = tmp, label = "Lorem ipsum dolor sit amet", domain = "data_to_save")) expect_output(str(read_xpt(tmp)), "Lorem ipsum dolor sit amet") }) @@ -29,6 +29,7 @@ test_that("xportr_write: exported data can be saved to a file with a metadata", xportr_write( data_to_save, path = tmp, + domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", label = "Lorem ipsum dolor sit amet" @@ -45,13 +46,14 @@ test_that("xportr_write: exported data can be saved to a file with a existing me df <- xportr_df_label( data_to_save, + domain = "data_to_save", data.frame( dataset = "data_to_save", label = "Lorem ipsum dolor sit amet" ) ) - xportr_write(df, path = tmp) + xportr_write(df, path = tmp, domain = "data_to_save") expect_output(str(read_xpt(tmp)), "Lorem ipsum dolor sit amet") }) @@ -162,6 +164,7 @@ test_that("xportr_write: expect warning when an xpt validation fails with strict expect_warning( xportr_write( data_to_save, tmp, + domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", label = "label" @@ -184,6 +187,7 @@ test_that("xportr_write: Capture errors by haven and report them as such", { suppressWarnings( xportr_write( data_to_save, tmp, + domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", label = "label" From 8c5e0ceadd83c7e623c54f3ae359320ed2fa598e Mon Sep 17 00:00:00 2001 From: elimillera Date: Tue, 19 Dec 2023 16:57:39 +0000 Subject: [PATCH 080/267] fix coverage --- tests/testthat/test-write.R | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index e45abce0..e6e35ca5 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -16,7 +16,12 @@ test_that("xportr_write: exported data can still be saved to a file with a label on.exit(unlink(tmpdir)) - suppressWarnings(xportr_write(data_to_save, path = tmp, label = "Lorem ipsum dolor sit amet", domain = "data_to_save")) + suppressWarnings( + xportr_write(data_to_save, + path = tmp, + label = "Lorem ipsum dolor sit amet", + domain = "data_to_save") + ) expect_output(str(read_xpt(tmp)), "Lorem ipsum dolor sit amet") }) @@ -106,6 +111,7 @@ test_that("xportr_write: expect error when label contains non-ASCII symbols or s expect_error( xportr_write( data_to_save, + domain = "data_to_save", tmp, metadata = data.frame( dataset = "data_to_save", @@ -126,6 +132,7 @@ test_that("xportr_write: expect error when label is over 40 characters", { expect_error( xportr_write( data_to_save, + domain = "data_to_save", tmp, metadata = data.frame( dataset = "data_to_save", @@ -145,6 +152,7 @@ test_that("xportr_write: expect error when an xpt validation fails with strict_c expect_error( xportr_write( data_to_save, tmp, + domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", label = "label" From ce6fc724a5e488ee80adfab1eb89145bc5b6a185 Mon Sep 17 00:00:00 2001 From: Ethan Brockmann <59264453+EeethB@users.noreply.github.com> Date: Tue, 19 Dec 2023 12:12:44 -0600 Subject: [PATCH 081/267] Update NEWS.md Co-authored-by: Ben Straub --- NEWS.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 9d49d848..e49bde65 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +2,9 @@ ## New Features and Bug Fixes -* `xportr_metadata()` can set `verbose` for a whole pipeline +* `xportr_metadata()` can set `verbose` for a whole pipeline, i.e. setting `verbose` in `xportr_metadata()` will populate to all `xportr` functions. (#151) + +* All `xportr` functions now have `verbose = NULL` as the default (#151) ## Documentation From df65c51a8d8d19a347ac44a389403981d03f08d4 Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 20 Dec 2023 09:25:06 -0500 Subject: [PATCH 082/267] Add message for data length --- R/length.R | 8 ++++++++ R/messages.R | 27 +++++++++++++++++++++++++++ 2 files changed, 35 insertions(+) diff --git a/R/length.R b/R/length.R index 17627268..47765973 100644 --- a/R/length.R +++ b/R/length.R @@ -121,6 +121,14 @@ xportr_length <- function(.df, } } + # Check if data length is shorter than metadata length + var_length_max <- variable_max_length(.df) + + length_msg <- left_join(var_length_max, metadata[, c(variable_name, variable_length)], by = variable_name) %>% + filter(length.x < length.y) + + max_length_msg(length_msg, verbose) + .df } diff --git a/R/messages.R b/R/messages.R index 6c4e21c0..6a2b417f 100644 --- a/R/messages.R +++ b/R/messages.R @@ -161,3 +161,30 @@ var_ord_msg <- function(reordered_vars, moved_vars, verbose) { cli_h2("All variables in dataset are ordered") } } + +#' Utility for data Lengths +#' +#' @param max_length Dataframe with data and metadata length +#' @param verbose Provides additional messaging for user +#' +#' @return Output to Console + +max_length_msg <- function(max_length, verbose) { + if (nrow(max_length) > 0) { + cli_h2("Variable length is shorter than the length specified in the metadata.") + + xportr_logger( + glue( + "Update length in metadata to trim the variables:" + ), + type = verbose + ) + + xportr_logger( + glue( + "{format(max_length[[1]], width = 8)} has a length of {format(as.character(max_length[[2]]), width = 3)} and a length of {format(as.character(max_length[[3]]), width = 3)} in metadata" + ), + type = verbose + ) + } +} From 9a451f74843e21fbd98e17a29037bbbb5e8217ae Mon Sep 17 00:00:00 2001 From: EeethB Date: Thu, 21 Dec 2023 16:35:35 +0000 Subject: [PATCH 083/267] [skip actions] Bump version to 0.3.1.9005 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0288c86c..315b2810 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9004 +Version: 0.3.1.9005 Authors@R: c( person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")), From 6693b8e45f7424d74d3efdb686207e4caef696d6 Mon Sep 17 00:00:00 2001 From: Celine Date: Fri, 22 Dec 2023 03:45:05 -0500 Subject: [PATCH 084/267] Add argument to function --- R/length.R | 34 ++++++++++++++++++++-------------- 1 file changed, 20 insertions(+), 14 deletions(-) diff --git a/R/length.R b/R/length.R index 47765973..2e35053d 100644 --- a/R/length.R +++ b/R/length.R @@ -11,6 +11,8 @@ #' @param domain Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset #' the metadata object. If none is passed, then name of the dataset passed as #' .df will be used. +#' @param length TO BE UPDATED!!! +#' *Permitted Values*: `"metadata"`, `"data"` #' @param verbose The action this function takes when an action is taken on the #' dataset or function validation finds an issue. See 'Messaging' section for #' details. Options are 'stop', 'warn', 'message', and 'none' @@ -66,6 +68,7 @@ xportr_length <- function(.df, metadata = NULL, domain = NULL, + length = "metadata", verbose = getOption("xportr.length_verbose", "none"), metacore = deprecated()) { if (!missing(metacore)) { @@ -96,13 +99,13 @@ xportr_length <- function(.df, metadata <- metadata$var_spec } - if (domain_name %in% names(metadata)) { - metadata <- metadata %>% - filter(!!sym(domain_name) == domain) - } else { - # Common check for multiple variables name - check_multiple_var_specs(metadata, variable_name) - } + # if (domain_name %in% names(metadata)) { + # metadata <- metadata %>% + # filter(!!sym(domain_name) == domain) + # } else { + # # Common check for multiple variables name + # check_multiple_var_specs(metadata, variable_name) + # } # Check any variables missed in metadata but present in input data --- @@ -110,24 +113,27 @@ xportr_length <- function(.df, length_log(miss_vars, verbose) - length <- metadata[[variable_length]] - names(length) <- metadata[[variable_name]] + length_metadata <- metadata[[variable_length]] + names(length_metadata) <- metadata[[variable_name]] for (i in names(.df)) { if (i %in% miss_vars) { attr(.df[[i]], "width") <- impute_length(.df[[i]]) } else { - attr(.df[[i]], "width") <- length[[i]] + attr(.df[[i]], "width") <- length_metadata[[i]] } } # Check if data length is shorter than metadata length - var_length_max <- variable_max_length(.df) + if (length == "data"){ + var_length_max <- variable_max_length(.df) - length_msg <- left_join(var_length_max, metadata[, c(variable_name, variable_length)], by = variable_name) %>% - filter(length.x < length.y) + length_msg <- left_join(var_length_max, metadata[, c(variable_name, variable_length)], by = variable_name) %>% + filter(length.x < length.y) + + max_length_msg(length_msg, verbose) + } - max_length_msg(length_msg, verbose) .df } From 21676a6544696b3b2edcce0bb354ae1e4f394f5c Mon Sep 17 00:00:00 2001 From: Celine Date: Fri, 22 Dec 2023 04:55:41 -0500 Subject: [PATCH 085/267] Add metadata type --- R/type.R | 8 +++++--- R/zzz.R | 6 ++++-- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/R/type.R b/R/type.R index 86d6bd15..65d8ec40 100644 --- a/R/type.R +++ b/R/type.R @@ -93,6 +93,8 @@ xportr_type <- function(.df, variable_name <- getOption("xportr.variable_name") type_name <- getOption("xportr.type_name") characterTypes <- c(getOption("xportr.character_types"), "_character") + characterMetadataTypes <- c(getOption("xportr.character_metadata_types"), "_character") + numericMetadataTypes <- c(getOption("xportr.numeric_metadata_types"), "_numeric") numericTypes <- c(getOption("xportr.numeric_types"), "_numeric") format_name <- getOption("xportr.format_name") @@ -137,14 +139,14 @@ xportr_type <- function(.df, # _character is used here as a mask of character, in case someone doesn't # want 'character' coerced to character type.x = if_else(type.x %in% characterTypes, "_character", type.x), - type.x = if_else(type.x %in% numericTypes | (grepl("DT$|DTM$|TM$", variable) & !is.na(format)), + type.x = if_else(type.x %in% numericTypes, "_numeric", type.x ), type.y = if_else(is.na(type.y), type.x, type.y), type.y = tolower(type.y), - type.y = if_else(type.y %in% characterTypes | (grepl("DTC$", variable) & is.na(format)), "_character", type.y), - type.y = if_else(type.y %in% numericTypes, "_numeric", type.y) + type.y = if_else(type.y %in% characterMetadataTypes, "_character", type.y), + type.y = if_else(type.y %in% numericMetadataTypes, "_numeric", type.y) ) # It is possible that a variable exists in the table that isn't in the metadata diff --git a/R/zzz.R b/R/zzz.R index 88b877b5..6b8ef834 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -13,14 +13,16 @@ xportr.label_verbose = "none", xportr.length_verbose = "none", xportr.type_verbose = "none", - xportr.character_types = c( + xportr.character_types = c("character"), + xportr.character_metadata_types = c( "character", "char", "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", "partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", "intervaldatetime" ), - xportr.numeric_types = c("integer", "numeric", "num", "float"), + xportr.numeric_metadata_types = c("integer", "numeric", "num", "float"), + xportr.numeric_types = c("integer", "float", "posixct", "posixt", "time", "date"), xportr.order_name = "order" ) toset <- !(names(op.devtools) %in% names(op)) From 6138a14730f07cc6ec5e01c51b6dcdc106e218d0 Mon Sep 17 00:00:00 2001 From: elimillera Date: Fri, 29 Dec 2023 20:27:35 +0000 Subject: [PATCH 086/267] Updates with PR comment --- R/format.R | 2 +- R/label.R | 2 +- R/length.R | 2 +- R/order.R | 2 +- R/type.R | 2 +- _pkgdown.yml | 1 + tests/testthat/test-format.R | 15 +++++++++++++++ tests/testthat/test-label.R | 16 ++++++++++++++++ tests/testthat/test-length.R | 16 ++++++++++++++++ tests/testthat/test-order.R | 16 ++++++++++++++++ tests/testthat/test-type.R | 17 +++++++++++++++++ tests/testthat/test-write.R | 7 ++++--- 12 files changed, 90 insertions(+), 8 deletions(-) diff --git a/R/format.R b/R/format.R index 1249ac4e..798c7e18 100644 --- a/R/format.R +++ b/R/format.R @@ -72,7 +72,7 @@ xportr_format <- function(.df, metadata <- metadata$var_spec } - if (domain_name %in% names(metadata)) { + if (domain_name %in% names(metadata) && !is.null(domain)) { metadata <- metadata %>% dplyr::filter(!!sym(domain_name) == domain & !is.na(!!sym(format_name))) } else { diff --git a/R/label.R b/R/label.R index ad6c339a..15a386f4 100644 --- a/R/label.R +++ b/R/label.R @@ -88,7 +88,7 @@ xportr_label <- function(.df, metadata <- metadata$var_spec } - if (domain_name %in% names(metadata)) { + if (domain_name %in% names(metadata) && !is.null(domain)) { metadata <- metadata %>% dplyr::filter(!!sym(domain_name) == domain) } else { diff --git a/R/length.R b/R/length.R index 1b007970..5ee823b4 100644 --- a/R/length.R +++ b/R/length.R @@ -96,7 +96,7 @@ xportr_length <- function(.df, metadata <- metadata$var_spec } - if (domain_name %in% names(metadata)) { + if (domain_name %in% names(metadata) && !is.null(domain)) { metadata <- metadata %>% filter(!!sym(domain_name) == domain) } else { diff --git a/R/order.R b/R/order.R index 8f01ee78..e5f5a822 100644 --- a/R/order.R +++ b/R/order.R @@ -91,7 +91,7 @@ xportr_order <- function(.df, metadata <- metadata$ds_vars } - if (domain_name %in% names(metadata)) { + if (domain_name %in% names(metadata) && !is.null(domain)) { metadata <- metadata %>% dplyr::filter(!!sym(domain_name) == domain & !is.na(!!sym(order_name))) } else { diff --git a/R/type.R b/R/type.R index f75395f1..d01ad078 100644 --- a/R/type.R +++ b/R/type.R @@ -113,7 +113,7 @@ xportr_type <- function(.df, metadata <- metadata$var_spec } - if (domain_name %in% names(metadata)) { + if (domain_name %in% names(metadata) && !is.null(domain)) { metadata <- metadata %>% filter(!!sym(domain_name) == domain) } diff --git a/_pkgdown.yml b/_pkgdown.yml index dbeae1cc..8082901f 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -32,6 +32,7 @@ reference: - xportr_order - xportr_df_label - xportr_metadata + - xportr_domain_name - title: xportr helper functions desc: Utility functions called within core xportr functions diff --git a/tests/testthat/test-format.R b/tests/testthat/test-format.R index 76b65e1d..a311a8c4 100644 --- a/tests/testthat/test-format.R +++ b/tests/testthat/test-format.R @@ -19,3 +19,18 @@ test_that("xportr_format: Gets warning when metadata has multiple rows with same # Checks that message doesn't appear when xportr.domain_name is valid multiple_vars_in_spec_helper2(xportr_format) }) + +test_that("xportr_format: Works as expected with only one domain in metadata", { + adsl <- data.frame( + USUBJID = c(1001, 1002, 1003), + BRTHDT = c(1, 1, 2) + ) + + metadata <- data.frame( + dataset = c("adsl", "adsl"), + variable = c("USUBJID", "BRTHDT"), + format = c(NA, "DATE9.") + ) + + expect_silent(xportr_format(adsl, metadata)) +}) diff --git a/tests/testthat/test-label.R b/tests/testthat/test-label.R index 8030a826..cd0fc30b 100644 --- a/tests/testthat/test-label.R +++ b/tests/testthat/test-label.R @@ -21,3 +21,19 @@ test_that("xportr_label: Gets warning when metadata has multiple rows with same # Checks that message doesn't appear when xportr.domain_name is valid multiple_vars_in_spec_helper2(xportr_label) }) + + +test_that("xportr_label: Works as expected with only one domain in metadata", { + adsl <- data.frame( + USUBJID = c(1001, 1002, 1003), + BRTHDT = c(1, 1, 2) + ) + + metadata <- data.frame( + dataset = c("adsl", "adsl"), + variable = c("USUBJID", "BRTHDT"), + label = c("Hello", "Hello2") + ) + + expect_silent(xportr_label(adsl, metadata)) +}) diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index dd8b531f..f0045ead 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -193,3 +193,19 @@ test_that("xportr_length: Gets warning when metadata has multiple rows with same # Checks that message doesn't appear when xportr.domain_name is valid multiple_vars_in_spec_helper2(xportr_length) }) + + +test_that("xportr_length: Works as expected with only one domain in metadata", { + adsl <- data.frame( + USUBJID = c(1001, 1002, 1003), + BRTHDT = c(1, 1, 2) + ) + + metadata <- data.frame( + dataset = c("adsl", "adsl"), + variable = c("USUBJID", "BRTHDT"), + length = c(1, 1) + ) + + expect_silent(xportr_length(adsl, metadata)) +}) diff --git a/tests/testthat/test-order.R b/tests/testthat/test-order.R index 941a7d04..431db805 100644 --- a/tests/testthat/test-order.R +++ b/tests/testthat/test-order.R @@ -170,3 +170,19 @@ test_that("xportr_order: Gets warning when metadata has multiple rows with same expect_message("All variables in specification file are in dataset") %>% expect_message("All variables in dataset are ordered") }) + + +test_that("xportr_order: Works as expected with only one domain in metadata", { + adsl <- data.frame( + USUBJID = c(1001, 1002, 1003), + BRTHDT = c(1, 1, 2) + ) + + metadata <- data.frame( + dataset = c("adsl", "adsl"), + variable = c("USUBJID", "BRTHDT"), + order = c(1, 2) + ) + + expect_equal(xportr_order(adsl, metadata), adsl) +}) diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index 2287198e..f53271cc 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -304,3 +304,20 @@ test_that("xportr_type: Drops factor levels", { expect_null(attributes(df2$Val)) }) + + +test_that("xportr_type: Works as expected with only one domain in metadata", { + adsl <- data.frame( + USUBJID = c(1001, 1002, 1003), + BRTHDT = c(1, 1, 2) + ) + + metadata <- data.frame( + dataset = c("adsl", "adsl"), + variable = c("USUBJID", "BRTHDT"), + type = c("numeric", "numeric"), + format = c(NA, "DATE9.") + ) + + expect_equal(xportr_type(adsl, metadata), adsl) +}) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index e6e35ca5..44e4718a 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -18,10 +18,11 @@ test_that("xportr_write: exported data can still be saved to a file with a label suppressWarnings( xportr_write(data_to_save, - path = tmp, - label = "Lorem ipsum dolor sit amet", - domain = "data_to_save") + path = tmp, + label = "Lorem ipsum dolor sit amet", + domain = "data_to_save" ) + ) expect_output(str(read_xpt(tmp)), "Lorem ipsum dolor sit amet") }) From 8db698ee1b659141a0489d9cdfcb4397d6c49666 Mon Sep 17 00:00:00 2001 From: elimillera Date: Fri, 29 Dec 2023 20:48:07 +0000 Subject: [PATCH 087/267] Revert bad merge --- tests/testthat/test-depreciation.R | 53 ++++-------------------------- 1 file changed, 6 insertions(+), 47 deletions(-) diff --git a/tests/testthat/test-depreciation.R b/tests/testthat/test-depreciation.R index b967c27e..2679ecc9 100644 --- a/tests/testthat/test-depreciation.R +++ b/tests/testthat/test-depreciation.R @@ -3,11 +3,7 @@ test_that("xportr_df_label: deprecated metacore gives an error", { df <- data.frame(x = "a", y = "b") df_meta <- data.frame(dataset = "df", label = "Label") - df_spec_labeled_df <- xportr_df_label(df, metacore = df_meta, domain = "df") - - expect_equal(attr(df_spec_labeled_df, "label"), "Label") - xportr_df_label(df, metacore = df_meta, domain = "df") %>% - lifecycle::expect_deprecated("Please use the `metadata` argument instead.") + expect_error(xportr_df_label(df, metacore = df_meta)) }) test_that("xportr_format: deprecated metacore gives an error", { @@ -19,11 +15,7 @@ test_that("xportr_format: deprecated metacore gives an error", { format = "date9." ) - formatted_df <- xportr_format(df, metacore = df_meta, domain = "df") - - expect_equal(attr(formatted_df$x, "format.sas"), "DATE9.") - xportr_format(df, metacore = df_meta, domain = "df") %>% - lifecycle::expect_deprecated("Please use the `metadata` argument instead.") + expect_error(xportr_format(df, metacore = df_meta)) }) test_that("xportr_label: using the deprecated metacore argument gives an error", { @@ -32,17 +24,7 @@ test_that("xportr_label: using the deprecated metacore argument gives an error", df <- data.frame(x = "a", y = "b") df_meta <- data.frame(dataset = "df", variable = "x", label = "foo") - df_labeled_df <- suppressMessages( - xportr_label(df, metacore = df_meta, domain = "df") - ) - - expect_equal(attr(df_labeled_df$x, "label"), "foo") - - # Note that only the deprecated message should be caught (others are ignored) - suppressMessages( - xportr_label(df, metacore = df_meta, domain = "df") %>% - lifecycle::expect_deprecated("Please use the `metadata` argument instead.") - ) + expect_error(xportr_label(df, metacore = df_meta)) }) test_that("xportr_length: using the deprecated metacore argument gives an error", { @@ -55,12 +37,7 @@ test_that("xportr_length: using the deprecated metacore argument gives an error" length = c(1, 2) ) - df_with_width <- xportr_length(df, metacore = df_meta, domain = "df") - - expect_equal(c(x = 1, y = 2), map_dbl(df_with_width, attr, "width")) - - xportr_length(df, metacore = df_meta, domain = "df") %>% - lifecycle::expect_deprecated("Please use the `metadata` argument instead.") + expect_error(xportr_length(df, metacore = df_meta)) }) test_that("xportr_order: using the deprecated metacore argument gives an error", { @@ -73,17 +50,7 @@ test_that("xportr_order: using the deprecated metacore argument gives an error", order = 1:4 ) - ordered_df <- suppressMessages( - xportr_order(df, metacore = df_meta, domain = "DOMAIN") - ) - - expect_equal(names(ordered_df), df_meta$variable) - - # Note that only the deprecated message should be caught (others are ignored) - suppressMessages( - xportr_order(df, metacore = df_meta, domain = "df") %>% - lifecycle::expect_deprecated("Please use the `metadata` argument instead.") - ) + expect_error(xportr_order(df, metacore = df_meta, domain = "DOMAIN")) }) test_that("xportr_type: using the deprecated metacore argument gives an error", { @@ -101,13 +68,5 @@ test_that("xportr_type: using the deprecated metacore argument gives an error", format = NA ) - df2 <- suppressMessages( - xportr_type(df, metacore = df_meta, domain = "df") - ) - - # Note that only the deprecated message should be caught (others are ignored) - suppressMessages( - xportr_type(df, metacore = df_meta, domain = "df") %>% - lifecycle::expect_deprecated("Please use the `metadata` argument instead.") - ) + expect_error(xportr_type(df, metacore = df_meta)) }) From 878fa51107df5399893714b7412e8cd45d5cdd39 Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 3 Jan 2024 03:49:25 -0500 Subject: [PATCH 088/267] Add length from max data length to 'width' attribute --- R/length.R | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/R/length.R b/R/length.R index 2e35053d..7c3062ae 100644 --- a/R/length.R +++ b/R/length.R @@ -113,21 +113,30 @@ xportr_length <- function(.df, length_log(miss_vars, verbose) - length_metadata <- metadata[[variable_length]] - names(length_metadata) <- metadata[[variable_name]] - - for (i in names(.df)) { - if (i %in% miss_vars) { - attr(.df[[i]], "width") <- impute_length(.df[[i]]) - } else { - attr(.df[[i]], "width") <- length_metadata[[i]] + if (length == "metadata"){ + length_metadata <- metadata[[variable_length]] + names(length_metadata) <- metadata[[variable_name]] + + for (i in names(.df)) { + if (i %in% miss_vars) { + attr(.df[[i]], "width") <- impute_length(.df[[i]]) + } else { + attr(.df[[i]], "width") <- length_metadata[[i]] + } } } - # Check if data length is shorter than metadata length + # Assign length from data if (length == "data"){ var_length_max <- variable_max_length(.df) + length_data <- var_length_max[[variable_length]] + names(length_data) <- var_length_max[[variable_name]] + + for (i in names(.df)) { + attr(.df[[i]], "width") <- length_data[[i]] + } + length_msg <- left_join(var_length_max, metadata[, c(variable_name, variable_length)], by = variable_name) %>% filter(length.x < length.y) From edc977a14595528497936155f0903370ee2966e4 Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 3 Jan 2024 04:35:04 -0500 Subject: [PATCH 089/267] Update function description --- R/length.R | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/R/length.R b/R/length.R index 7c3062ae..7bd0d233 100644 --- a/R/length.R +++ b/R/length.R @@ -1,9 +1,9 @@ #' Assign SAS Length #' -#' Assigns SAS length from a metadata object to a given data frame. If a -#' length isn't present for a variable the length value is set to 200 for -#' character columns, and 8 for non-character columns. This value is stored in -#' the 'width' attribute of the column. +#' Assigns the SAS length to a specified data frame, either from a metadata object +#' or based on the calculated maximum data length. If a length isn't present for +#' a variable the length value is set to 200 for character columns, and 8 +#' for non-character columns. This value is stored in the 'width' attribute of the column. #' #' @param .df A data frame of CDISC standard. #' @param metadata A data frame containing variable level metadata. See @@ -11,7 +11,11 @@ #' @param domain Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset #' the metadata object. If none is passed, then name of the dataset passed as #' .df will be used. -#' @param length TO BE UPDATED!!! +#' @param length Choose the assigned length from either metadata or data. +#' +#' If `"metadata"` is specified, the assigned length is from the metadata length. +#' If `"data"` is specified, the assigned length is determined by the calculated maximum data length. +#' #' *Permitted Values*: `"metadata"`, `"data"` #' @param verbose The action this function takes when an action is taken on the #' dataset or function validation finds an issue. See 'Messaging' section for From 20f48533d8f36c260982b25ed35c225f29cbb176 Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 3 Jan 2024 08:58:06 -0500 Subject: [PATCH 090/267] add test for length argument --- tests/testthat/test-length.R | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index e749684d..dfe56cb4 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -224,3 +224,30 @@ test_that("xportr_length: Gets warning when metadata has multiple rows with same # Checks that message doesn't appear when xportr.domain_name is valid multiple_vars_in_spec_helper2(xportr_length) }) + +meta_example <- data.frame( + dataset = "df", + variable = c("USUBJID", "WEIGHT"), + length = c(10, 8) +) + +df <- data.frame( + USUBJID = c("1", "12", "123"), + WEIGHT = c(85, 45, 121 ) +) + +test_that("xportr_length: length assigned as expected from metadata or data", { + result <- df %>% + xportr_length(meta_example, length = "metadata") %>% + expect_attr_width(c(10,8)) + + result <- df %>% + xportr_length(meta_example, length = "data") %>% + expect_attr_width(c(3,8)) +}) + +test_that("xportr_length: Gets message when length in metadata longer than data length", { + result <- df %>% + xportr_length(meta_example, length = "data") %>% + expect_message() +}) From 3f79aaa02e351291ffd0587dea48bc201516e6d2 Mon Sep 17 00:00:00 2001 From: EeethB Date: Thu, 4 Jan 2024 09:26:02 -0600 Subject: [PATCH 091/267] Move metadata tests all to a single file --- tests/testthat/test-length.R | 13 ----- tests/testthat/test-metadata.R | 90 ++++++++++++++++++++++++++++++++++ tests/testthat/test-order.R | 13 ----- tests/testthat/test-type.R | 57 --------------------- 4 files changed, 90 insertions(+), 83 deletions(-) diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index d77ecd50..e749684d 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -128,13 +128,6 @@ test_that("xportr_length: Impute character lengths based on class", { expect_message("Variable lengths missing from metadata") %>% expect_message("lengths resolved") %>% expect_attr_width(c(7, 199, 200, 200, 8)) - - adsl %>% - xportr_metadata(metadata, verbose = "none") %>% - xportr_length() %>% - expect_message("Variable lengths missing from metadata") %>% - expect_message("lengths resolved") %>% - expect_attr_width(c(7, 199, 200, 200, 8)) }) test_that("xportr_length: Throws message when variables not present in metadata", { @@ -151,12 +144,6 @@ test_that("xportr_length: Throws message when variables not present in metadata" expect_message("Variable lengths missing from metadata") %>% expect_message("lengths resolved") %>% expect_message(regexp = "Problem with `y`") - - xportr_metadata(adsl, metadata, verbose = "message") %>% - xportr_length() %>% - expect_message("Variable lengths missing from metadata") %>% - expect_message("lengths resolved") %>% - expect_message(regexp = "Problem with `y`") }) test_that("xportr_length: Metacore instance can be used", { diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index b232ea2d..1d3ea94e 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -543,6 +543,96 @@ test_that("xportr_length: Expect error if domain is not a character", { ) }) +test_that("xportr_metadata: Impute character lengths based on class", { + adsl <- minimal_table(30, cols = c("x", "b")) + metadata <- minimal_metadata( + dataset = TRUE, length = TRUE, var_names = colnames(adsl) + ) %>% + mutate(length = length - 1) + + adsl <- adsl %>% + mutate( + new_date = as.Date(.data$x, origin = "1970-01-01"), + new_char = as.character(.data$b), + new_num = as.numeric(.data$x) + ) + + adsl %>% + xportr_metadata(metadata, verbose = "none") %>% + xportr_length() %>% + expect_message("Variable lengths missing from metadata") %>% + expect_message("lengths resolved") %>% + expect_attr_width(c(7, 199, 200, 200, 8)) +}) + +test_that("xportr_metadata: Throws message when variables not present in metadata", { + adsl <- minimal_table(30, cols = c("x", "y")) + metadata <- minimal_metadata(dataset = TRUE, length = TRUE, var_names = c("x")) + + # Test that message is given which indicates that variable is not present + xportr_metadata(adsl, metadata, verbose = "message") %>% + xportr_length() %>% + expect_message("Variable lengths missing from metadata") %>% + expect_message("lengths resolved") %>% + expect_message(regexp = "Problem with `y`") +}) + +test_that("xportr_metadata: Variable ordering messaging is correct", { + skip_if_not_installed("haven") + skip_if_not_installed("readxl") + + require(haven, quietly = TRUE) + require(readxl, quietly = TRUE) + + 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 + ) + + # Metadata versions + xportr_metadata(df, df_meta, verbose = "message") %>% + xportr_order() %>% + expect_message("All variables in specification file are in dataset") %>% + expect_condition("4 reordered in dataset") %>% + expect_message("Variable reordered in `.df`: `a`, `b`, `c`, and `d`") + + xportr_metadata(df2, df_meta, verbose = "message") %>% + xportr_order() %>% + expect_message("2 variables not in spec and moved to end") %>% + expect_message("Variable moved to end in `.df`: `a` and `z`") %>% + expect_message("All variables in dataset are ordered") +}) + +test_that("xportr_type: Variable types are coerced as expected and can raise messages", { + df <- data.frame( + Subj = as.character(c(123, 456, 789, "", NA, NA_integer_)), + Different = c("a", "b", "c", "", NA, NA_character_), + Val = c("1", "2", "3", "", NA, NA_character_), + Param = c("param1", "param2", "param3", "", NA, NA_character_) + ) + meta_example <- data.frame( + dataset = "df", + variable = c("Subj", "Param", "Val", "NotUsed"), + type = c("numeric", "character", "numeric", "character"), + format = NA + ) + + # Metadata version of the last statement + df %>% + xportr_metadata(meta_example, verbose = "warn") %>% + xportr_type() %>% + expect_warning() + + # Metadata version + df %>% + xportr_metadata(meta_example, verbose = "message") %>% + xportr_type() %>% + expect_message("Variable type\\(s\\) in dataframe don't match metadata") +}) + # many tests here are more like qualification/domain testing - this section adds # tests for `xportr_metadata()` basic functionality # start diff --git a/tests/testthat/test-order.R b/tests/testthat/test-order.R index 5f666cce..801108c4 100644 --- a/tests/testthat/test-order.R +++ b/tests/testthat/test-order.R @@ -136,19 +136,6 @@ test_that("xportr_order: Variable ordering messaging is correct", { expect_message("2 variables not in spec and moved to end") %>% expect_message("Variable moved to end in `.df`: `a` and `z`") %>% expect_message("All variables in dataset are ordered") - - # Metadata versions - xportr_metadata(df, df_meta, verbose = "message") %>% - xportr_order() %>% - expect_message("All variables in specification file are in dataset") %>% - expect_condition("4 reordered in dataset") %>% - expect_message("Variable reordered in `.df`: `a`, `b`, `c`, and `d`") - - xportr_metadata(df2, df_meta, verbose = "message") %>% - xportr_order() %>% - expect_message("2 variables not in spec and moved to end") %>% - expect_message("Variable moved to end in `.df`: `a` and `z`") %>% - expect_message("All variables in dataset are ordered") }) test_that("xportr_order: Metadata order columns are coersed to numeric", { diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index 9d5bde9c..79534365 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -66,12 +66,6 @@ test_that("xportr_type: Variable types are coerced as expected and can raise mes (df3 <- suppressMessages(xportr_type(df, meta_example, verbose = "warn"))) %>% expect_warning() - # Metadata version of the last statement - df %>% - xportr_metadata(meta_example, verbose = "warn") %>% - xportr_type() %>% - expect_warning() - expect_equal(purrr::map_chr(df3, class), c( Subj = "numeric", Different = "character", Val = "numeric", Param = "character" @@ -83,57 +77,6 @@ test_that("xportr_type: Variable types are coerced as expected and can raise mes expect_message("Variable type\\(s\\) in dataframe don't match metadata") ) - # Metadata version - df %>% - xportr_metadata(meta_example, verbose = "message") %>% - xportr_type() %>% - expect_message("Variable type\\(s\\) in dataframe don't match metadata") - - expect_equal(purrr::map_chr(df4, class), c( - Subj = "numeric", Different = "character", - Val = "numeric", Param = "character" - )) -}) - -test_that("xportr_metadata: Var types coerced as expected and raise messages", { - # Remove empty lines in cli theme - local_cli_theme() - - ( - df2 <- xportr_metadata(df, meta_example) %>% - xportr_type() - ) %>% - expect_message("Variable type mismatches found.") %>% - expect_message("[0-9+] variables coerced") - - expect_equal(purrr::map_chr(df2, class), c( - Subj = "numeric", Different = "character", - Val = "numeric", Param = "character" - )) - - suppressMessages( - xportr_metadata(df, meta_example, verbose = "stop") %>% xportr_type() - ) %>% - expect_error() - - suppressMessages( - df3 <- xportr_metadata(df, meta_example, verbose = "warn") %>% xportr_type() - ) %>% - expect_warning() - - expect_equal(purrr::map_chr(df3, class), c( - Subj = "numeric", Different = "character", - Val = "numeric", Param = "character" - )) - - suppressMessages({ - ( - df4 <- xportr_metadata(df, meta_example, verbose = "message") %>% - xportr_type() - ) %>% - expect_message("Variable type\\(s\\) in dataframe don't match metadata: `Subj` and `Val`") - }) - expect_equal(purrr::map_chr(df4, class), c( Subj = "numeric", Different = "character", Val = "numeric", Param = "character" From 63c5b7b1ff56a6b7a7bad0b1f6fa2f621af3357c Mon Sep 17 00:00:00 2001 From: EeethB Date: Mon, 8 Jan 2024 16:23:38 -0600 Subject: [PATCH 092/267] Add `verbose` option to metadata --- R/metadata.R | 11 ++++++++--- man/metadata.Rd | 11 ++++++++++- tests/testthat/test-metadata.R | 32 +++++++++++++++----------------- 3 files changed, 33 insertions(+), 21 deletions(-) diff --git a/R/metadata.R b/R/metadata.R index 2db7d1b5..4da01a30 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -40,15 +40,20 @@ #' xportr_type() %>% #' xportr_order() #' } -xportr_metadata <- function(.df, metadata, domain = NULL) { - ## Common section to detect domain from argument or attribute +xportr_metadata <- function(.df, + metadata, + domain = NULL, + verbose = getOption("xportr.type_verbose", "none")) { + ## Common section to detect domain from argument or pipes 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, + `_xportr.df_verbose_` = verbose) } diff --git a/man/metadata.Rd b/man/metadata.Rd index f3c497de..a74613a6 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -5,7 +5,12 @@ \alias{xportr_domain_name} \title{Set variable specifications and domain} \usage{ -xportr_metadata(.df, metadata, domain = NULL) +xportr_metadata( + .df, + metadata, + domain = NULL, + verbose = getOption("xportr.type_verbose", "none") +) xportr_domain_name(.df, domain) } @@ -19,6 +24,10 @@ xportr_domain_name(.df, domain) the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or \code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an attribute of \code{.df}.} + +\item{verbose}{The action this function takes when an action is taken on the +dataset or function validation finds an issue. See 'Messaging' section for +details. Options are 'stop', 'warn', 'message', and 'none'} } \value{ \code{.df} dataset with metadata and domain attributes set diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index b3041018..6f7ec281 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -560,47 +560,45 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { rlang::set_names(tolower) expect_equal( - structure(xportr_type(adsl, var_spec, domain = "adsl"), `_xportr.df_metadata_` = var_spec), + structure(xportr_type(adsl, var_spec, domain = "adsl"), + `_xportr.df_metadata_` = var_spec, + `_xportr.df_verbose_` = "none"), suppressMessages( xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_type() ) ) expect_equal( - structure( - suppressMessages(xportr_length(adsl, var_spec, domain = "adsl")), - `_xportr.df_metadata_` = var_spec - ), + structure(xportr_length(adsl, var_spec, domain = "adsl"), + `_xportr.df_metadata_` = var_spec, + `_xportr.df_verbose_` = "none"), suppressMessages( xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_length() ) ) expect_equal( - structure( - suppressMessages(xportr_label(adsl, var_spec, domain = "adsl")), - `_xportr.df_metadata_` = var_spec - ), + structure(xportr_label(adsl, var_spec, domain = "adsl"), + `_xportr.df_metadata_` = var_spec, + `_xportr.df_verbose_` = "none"), suppressMessages( xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_label() ) ) expect_equal( - structure( - suppressMessages(xportr_order(adsl, var_spec, domain = "adsl")), - `_xportr.df_metadata_` = var_spec - ), + structure(xportr_order(adsl, var_spec, domain = "adsl"), + `_xportr.df_metadata_` = var_spec, + `_xportr.df_verbose_` = "none"), suppressMessages( xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_order() ) ) expect_equal( - structure( - suppressMessages(xportr_format(adsl, var_spec, domain = "adsl")), - `_xportr.df_metadata_` = var_spec - ), + structure(xportr_format(adsl, var_spec, domain = "adsl"), + `_xportr.df_metadata_` = var_spec, + `_xportr.df_verbose_` = "none"), suppressMessages( xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_format() ) From 18c766fb2d19a7e839ec37aa2c5da85571499867 Mon Sep 17 00:00:00 2001 From: EeethB Date: Tue, 28 Nov 2023 16:09:20 +0000 Subject: [PATCH 093/267] Add verbose to metadata --- R/label.R | 8 +++++++- R/length.R | 8 +++++++- R/metadata.R | 2 +- R/order.R | 8 +++++++- R/type.R | 8 +++++++- man/metadata.Rd | 7 +------ man/xportr_label.Rd | 2 +- man/xportr_length.Rd | 2 +- man/xportr_order.Rd | 2 +- man/xportr_type.Rd | 2 +- tests/testthat/test-length.R | 13 +++++++++++++ tests/testthat/test-order.R | 13 +++++++++++++ tests/testthat/test-type.R | 20 ++++++++++++++++---- 13 files changed, 76 insertions(+), 19 deletions(-) diff --git a/R/label.R b/R/label.R index 6724e53d..de0630ad 100644 --- a/R/label.R +++ b/R/label.R @@ -59,7 +59,7 @@ xportr_label <- function(.df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.label_verbose", "none"), + verbose = NULL, metacore = deprecated()) { if (!missing(metacore)) { lifecycle::deprecate_stop( @@ -99,6 +99,12 @@ xportr_label <- function(.df, # Check any variables missed in metadata but present in input data --- miss_vars <- setdiff(names(.df), metadata[[variable_name]]) + # Verbose should use an explicit verbose option first, then the value set in + # metadata, and finally fall back to the option value + verbose <- verbose %||% + attr(.df, "_xportr.df_verbose_") %||% + getOption("xportr.label_verbose", "none") + label_log(miss_vars, verbose) label <- metadata[[variable_label]] diff --git a/R/length.R b/R/length.R index 3039218f..076bfc56 100644 --- a/R/length.R +++ b/R/length.R @@ -67,7 +67,7 @@ xportr_length <- function(.df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.length_verbose", "none"), + verbose = NULL, metacore = deprecated()) { if (!missing(metacore)) { lifecycle::deprecate_stop( @@ -107,6 +107,12 @@ xportr_length <- function(.df, # Check any variables missed in metadata but present in input data --- miss_vars <- setdiff(names(.df), metadata[[variable_name]]) + # Verbose should use an explicit verbose option first, then the value set in + # metadata, and finally fall back to the option value + verbose <- verbose %||% + attr(.df, "_xportr.df_verbose_") %||% + getOption("xportr.length_verbose", "none") + length_log(miss_vars, verbose) length <- metadata[[variable_length]] diff --git a/R/metadata.R b/R/metadata.R index 4da01a30..bf1e616d 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -43,7 +43,7 @@ xportr_metadata <- function(.df, metadata, domain = NULL, - verbose = getOption("xportr.type_verbose", "none")) { + verbose = NULL) { ## Common section to detect domain from argument or pipes domain <- get_domain(.df, domain) diff --git a/R/order.R b/R/order.R index 60bccbc8..1358a877 100644 --- a/R/order.R +++ b/R/order.R @@ -62,7 +62,7 @@ xportr_order <- function(.df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.order_verbose", "none"), + verbose = NULL, metacore = deprecated()) { if (!missing(metacore)) { lifecycle::deprecate_stop( @@ -120,6 +120,12 @@ xportr_order <- function(.df, # Used in warning message for how many vars have been moved reorder_vars <- names(df_re_ord)[names(df_re_ord) != names(.df)] + # Verbose should use an explicit verbose option first, then the value set in + # metadata, and finally fall back to the option value + verbose <- verbose %||% + attr(.df, "_xportr.df_verbose_") %||% + getOption("xportr.order_verbose", "none") + # Function is located in messages.R var_ord_msg(reorder_vars, names(drop_vars), verbose) diff --git a/R/type.R b/R/type.R index 8f45e326..8441c7c4 100644 --- a/R/type.R +++ b/R/type.R @@ -79,7 +79,7 @@ xportr_type <- function(.df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.type_verbose", "none"), + verbose = NULL, metacore = deprecated()) { if (!missing(metacore)) { lifecycle::deprecate_stop( @@ -146,6 +146,12 @@ xportr_type <- function(.df, type.y = if_else(type.y %in% numericTypes, "_numeric", type.y) ) + # Verbose should use an explicit verbose option first, then the value set in + # metadata, and finally fall back to the option value + verbose <- verbose %||% + attr(.df, "_xportr.df_verbose_") %||% + getOption("xportr.type_verbose", "none") + # It is possible that a variable exists in the table that isn't in the metadata # it will be silently ignored here. This may happen depending on what a user # passes and the options they choose. The check_core function is the place diff --git a/man/metadata.Rd b/man/metadata.Rd index a74613a6..4c52c4ea 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -5,12 +5,7 @@ \alias{xportr_domain_name} \title{Set variable specifications and domain} \usage{ -xportr_metadata( - .df, - metadata, - domain = NULL, - verbose = getOption("xportr.type_verbose", "none") -) +xportr_metadata(.df, metadata, domain = NULL, verbose = NULL) xportr_domain_name(.df, domain) } diff --git a/man/xportr_label.Rd b/man/xportr_label.Rd index 87d648da..7f447418 100644 --- a/man/xportr_label.Rd +++ b/man/xportr_label.Rd @@ -8,7 +8,7 @@ xportr_label( .df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.label_verbose", "none"), + verbose = NULL, metacore = deprecated() ) } diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index 1d5100df..fa51508e 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -8,7 +8,7 @@ xportr_length( .df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.length_verbose", "none"), + verbose = NULL, metacore = deprecated() ) } diff --git a/man/xportr_order.Rd b/man/xportr_order.Rd index 72bda30d..bf20ffa7 100644 --- a/man/xportr_order.Rd +++ b/man/xportr_order.Rd @@ -8,7 +8,7 @@ xportr_order( .df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.order_verbose", "none"), + verbose = NULL, metacore = deprecated() ) } diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index 3c67c4c7..6c4486ad 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -8,7 +8,7 @@ xportr_type( .df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.type_verbose", "none"), + verbose = NULL, metacore = deprecated() ) } diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index 7fa87f53..7ca82e87 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -97,6 +97,13 @@ test_that("xportr_length: Impute character lengths based on class", { expect_message("Variable lengths missing from metadata") %>% expect_message("lengths resolved") %>% expect_attr_width(c(7, 199, 200, 200, 8)) + + adsl %>% + xportr_metadata(metadata, verbose = "none") %>% + xportr_length() %>% + expect_message("Variable lengths missing from metadata") %>% + expect_message("lengths resolved") %>% + expect_attr_width(c(7, 199, 200, 200, 8)) }) test_that("xportr_length: Throws message when variables not present in metadata", { @@ -113,6 +120,12 @@ test_that("xportr_length: Throws message when variables not present in metadata" expect_message("Variable lengths missing from metadata") %>% expect_message("lengths resolved") %>% expect_message(regexp = "Problem with `y`") + + xportr_metadata(adsl, metadata, verbose = "message") %>% + xportr_length() %>% + expect_message("Variable lengths missing from metadata") %>% + expect_message("lengths resolved") %>% + expect_message(regexp = "Problem with `y`") }) test_that("xportr_length: Metacore instance can be used", { diff --git a/tests/testthat/test-order.R b/tests/testthat/test-order.R index 3450ba10..59c3044c 100644 --- a/tests/testthat/test-order.R +++ b/tests/testthat/test-order.R @@ -136,6 +136,19 @@ test_that("xportr_order: Variable ordering messaging is correct", { expect_message("2 variables not in spec and moved to end") %>% expect_message("Variable moved to end in `.df`: `a` and `z`") %>% expect_message("All variables in dataset are ordered") + + # Metadata versions + xportr_metadata(df, df_meta, verbose = "message") %>% + xportr_order() %>% + expect_message("All variables in specification file are in dataset") %>% + expect_condition("4 reordered in dataset") %>% + expect_message("Variable reordered in `.df`: `a`, `b`, `c`, and `d`") + + xportr_metadata(df2, df_meta, verbose = "message") %>% + xportr_order() %>% + expect_message("2 variables not in spec and moved to end") %>% + expect_message("Variable moved to end in `.df`: `a` and `z`") %>% + expect_message("All variables in dataset are ordered") }) test_that("xportr_order: Metadata order columns are coersed to numeric", { diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index f53271cc..d4bba61f 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -66,6 +66,12 @@ test_that("xportr_type: Variable types are coerced as expected and can raise mes (df3 <- suppressMessages(xportr_type(df, meta_example, verbose = "warn", domain = "df"))) %>% expect_warning() + # Metadata version of the last statement + df %>% + xportr_metadata(meta_example, verbose = "warn") %>% + xportr_type() %>% + expect_warning() + expect_equal(purrr::map_chr(df3, class), c( Subj = "numeric", Different = "character", Val = "numeric", Param = "character" @@ -77,6 +83,12 @@ test_that("xportr_type: Variable types are coerced as expected and can raise mes expect_message("Variable type\\(s\\) in dataframe don't match metadata") ) + # Metadata version + df %>% + xportr_metadata(meta_example, verbose = "message") %>% + xportr_type() %>% + expect_message("Variable type\\(s\\) in dataframe don't match metadata") + expect_equal(purrr::map_chr(df4, class), c( Subj = "numeric", Different = "character", Val = "numeric", Param = "character" @@ -100,12 +112,12 @@ test_that("xportr_metadata: Var types coerced as expected and raise messages", { )) suppressMessages( - xportr_metadata(df, meta_example, domain = "df") %>% xportr_type(verbose = "stop") + xportr_metadata(df, meta_example, verbose = "stop") %>% xportr_type() ) %>% expect_error() suppressMessages( - df3 <- xportr_metadata(df, meta_example, domain = "df") %>% xportr_type(verbose = "warn") + df3 <- xportr_metadata(df, meta_example, verbose = "warn") %>% xportr_type() ) %>% expect_warning() @@ -116,8 +128,8 @@ test_that("xportr_metadata: Var types coerced as expected and raise messages", { suppressMessages({ ( - df4 <- xportr_metadata(df, meta_example, domain = "df") %>% - xportr_type(verbose = "message") + df4 <- xportr_metadata(df, meta_example, verbose = "message") %>% + xportr_type() ) %>% expect_message("Variable type\\(s\\) in dataframe don't match metadata: `Subj` and `Val`") }) From c96d4df651056e4b6159a1dfd4b1e6f83f78313f Mon Sep 17 00:00:00 2001 From: EeethB Date: Wed, 6 Dec 2023 22:24:17 +0000 Subject: [PATCH 094/267] Update docs --- NEWS.md | 6 +++ R/metadata.R | 5 +- README.Rmd | 2 +- tests/testthat/test-length.R | 13 ----- tests/testthat/test-metadata.R | 90 ++++++++++++++++++++++++++++++++++ tests/testthat/test-order.R | 13 ----- tests/testthat/test-type.R | 57 --------------------- 7 files changed, 100 insertions(+), 86 deletions(-) diff --git a/NEWS.md b/NEWS.md index 3a66b267..217c5099 100644 --- a/NEWS.md +++ b/NEWS.md @@ -7,6 +7,12 @@ * Added a check for character variable lengths up to 200 bytes in `xpt_validate()`(#91, #189). +* `xportr_metadata()` can set `verbose` for a whole pipeline, i.e. setting `verbose` in `xportr_metadata()` will populate to all `xportr` functions. (#151) + +* All `xportr` functions now have `verbose = NULL` as the default. If left `NULL`, the previous default of `getOption("xportr.[fn_name]_verbose")` is used (#151) + +## Documentation + ## Deprecation and Breaking Changes * The `domain` argument for xportr functions will no longer be dynamically diff --git a/R/metadata.R b/R/metadata.R index bf1e616d..555407c5 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -52,8 +52,9 @@ xportr_metadata <- function(.df, ## End of common section structure(.df, - `_xportr.df_metadata_` = metadata, - `_xportr.df_verbose_` = verbose) + `_xportr.df_metadata_` = metadata, + `_xportr.df_verbose_` = verbose + ) } diff --git a/README.Rmd b/README.Rmd index 1541a21b..edc532c9 100644 --- a/README.Rmd +++ b/README.Rmd @@ -145,7 +145,7 @@ The `xportr_metadata()` function can reduce duplication by setting the variable ```{r, message=FALSE, eval=FALSE} adsl %>% - xportr_metadata(var_spec, "ADSL") %>% + xportr_metadata(var_spec, "ADSL", verbose = "warn") %>% xportr_type() %>% xportr_length() %>% xportr_label() %>% diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index 7ca82e87..7fa87f53 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -97,13 +97,6 @@ test_that("xportr_length: Impute character lengths based on class", { expect_message("Variable lengths missing from metadata") %>% expect_message("lengths resolved") %>% expect_attr_width(c(7, 199, 200, 200, 8)) - - adsl %>% - xportr_metadata(metadata, verbose = "none") %>% - xportr_length() %>% - expect_message("Variable lengths missing from metadata") %>% - expect_message("lengths resolved") %>% - expect_attr_width(c(7, 199, 200, 200, 8)) }) test_that("xportr_length: Throws message when variables not present in metadata", { @@ -120,12 +113,6 @@ test_that("xportr_length: Throws message when variables not present in metadata" expect_message("Variable lengths missing from metadata") %>% expect_message("lengths resolved") %>% expect_message(regexp = "Problem with `y`") - - xportr_metadata(adsl, metadata, verbose = "message") %>% - xportr_length() %>% - expect_message("Variable lengths missing from metadata") %>% - expect_message("lengths resolved") %>% - expect_message(regexp = "Problem with `y`") }) test_that("xportr_length: Metacore instance can be used", { diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index 6f7ec281..27b80500 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -544,6 +544,96 @@ test_that("xportr_length: Expect error if domain is not a character", { ) }) +test_that("xportr_metadata: Impute character lengths based on class", { + adsl <- minimal_table(30, cols = c("x", "b")) + metadata <- minimal_metadata( + dataset = TRUE, length = TRUE, var_names = colnames(adsl) + ) %>% + mutate(length = length - 1) + + adsl <- adsl %>% + mutate( + new_date = as.Date(.data$x, origin = "1970-01-01"), + new_char = as.character(.data$b), + new_num = as.numeric(.data$x) + ) + + adsl %>% + xportr_metadata(metadata, verbose = "none") %>% + xportr_length() %>% + expect_message("Variable lengths missing from metadata") %>% + expect_message("lengths resolved") %>% + expect_attr_width(c(7, 199, 200, 200, 8)) +}) + +test_that("xportr_metadata: Throws message when variables not present in metadata", { + adsl <- minimal_table(30, cols = c("x", "y")) + metadata <- minimal_metadata(dataset = TRUE, length = TRUE, var_names = c("x")) + + # Test that message is given which indicates that variable is not present + xportr_metadata(adsl, metadata, verbose = "message") %>% + xportr_length() %>% + expect_message("Variable lengths missing from metadata") %>% + expect_message("lengths resolved") %>% + expect_message(regexp = "Problem with `y`") +}) + +test_that("xportr_metadata: Variable ordering messaging is correct", { + skip_if_not_installed("haven") + skip_if_not_installed("readxl") + + require(haven, quietly = TRUE) + require(readxl, quietly = TRUE) + + 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 + ) + + # Metadata versions + xportr_metadata(df, df_meta, verbose = "message") %>% + xportr_order() %>% + expect_message("All variables in specification file are in dataset") %>% + expect_condition("4 reordered in dataset") %>% + expect_message("Variable reordered in `.df`: `a`, `b`, `c`, and `d`") + + xportr_metadata(df2, df_meta, verbose = "message") %>% + xportr_order() %>% + expect_message("2 variables not in spec and moved to end") %>% + expect_message("Variable moved to end in `.df`: `a` and `z`") %>% + expect_message("All variables in dataset are ordered") +}) + +test_that("xportr_type: Variable types are coerced as expected and can raise messages", { + df <- data.frame( + Subj = as.character(c(123, 456, 789, "", NA, NA_integer_)), + Different = c("a", "b", "c", "", NA, NA_character_), + Val = c("1", "2", "3", "", NA, NA_character_), + Param = c("param1", "param2", "param3", "", NA, NA_character_) + ) + meta_example <- data.frame( + dataset = "df", + variable = c("Subj", "Param", "Val", "NotUsed"), + type = c("numeric", "character", "numeric", "character"), + format = NA + ) + + # Metadata version of the last statement + df %>% + xportr_metadata(meta_example, verbose = "warn") %>% + xportr_type() %>% + expect_warning() + + # Metadata version + df %>% + xportr_metadata(meta_example, verbose = "message") %>% + xportr_type() %>% + expect_message("Variable type\\(s\\) in dataframe don't match metadata") +}) + # many tests here are more like qualification/domain testing - this section adds # tests for `xportr_metadata()` basic functionality # start diff --git a/tests/testthat/test-order.R b/tests/testthat/test-order.R index 59c3044c..3450ba10 100644 --- a/tests/testthat/test-order.R +++ b/tests/testthat/test-order.R @@ -136,19 +136,6 @@ test_that("xportr_order: Variable ordering messaging is correct", { expect_message("2 variables not in spec and moved to end") %>% expect_message("Variable moved to end in `.df`: `a` and `z`") %>% expect_message("All variables in dataset are ordered") - - # Metadata versions - xportr_metadata(df, df_meta, verbose = "message") %>% - xportr_order() %>% - expect_message("All variables in specification file are in dataset") %>% - expect_condition("4 reordered in dataset") %>% - expect_message("Variable reordered in `.df`: `a`, `b`, `c`, and `d`") - - xportr_metadata(df2, df_meta, verbose = "message") %>% - xportr_order() %>% - expect_message("2 variables not in spec and moved to end") %>% - expect_message("Variable moved to end in `.df`: `a` and `z`") %>% - expect_message("All variables in dataset are ordered") }) test_that("xportr_order: Metadata order columns are coersed to numeric", { diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index d4bba61f..3fa7dd15 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -66,12 +66,6 @@ test_that("xportr_type: Variable types are coerced as expected and can raise mes (df3 <- suppressMessages(xportr_type(df, meta_example, verbose = "warn", domain = "df"))) %>% expect_warning() - # Metadata version of the last statement - df %>% - xportr_metadata(meta_example, verbose = "warn") %>% - xportr_type() %>% - expect_warning() - expect_equal(purrr::map_chr(df3, class), c( Subj = "numeric", Different = "character", Val = "numeric", Param = "character" @@ -83,57 +77,6 @@ test_that("xportr_type: Variable types are coerced as expected and can raise mes expect_message("Variable type\\(s\\) in dataframe don't match metadata") ) - # Metadata version - df %>% - xportr_metadata(meta_example, verbose = "message") %>% - xportr_type() %>% - expect_message("Variable type\\(s\\) in dataframe don't match metadata") - - expect_equal(purrr::map_chr(df4, class), c( - Subj = "numeric", Different = "character", - Val = "numeric", Param = "character" - )) -}) - -test_that("xportr_metadata: Var types coerced as expected and raise messages", { - # Remove empty lines in cli theme - local_cli_theme() - - ( - df2 <- xportr_metadata(df, meta_example, domain = "df") %>% - xportr_type() - ) %>% - expect_message("Variable type mismatches found.") %>% - expect_message("[0-9+] variables coerced") - - expect_equal(purrr::map_chr(df2, class), c( - Subj = "numeric", Different = "character", - Val = "numeric", Param = "character" - )) - - suppressMessages( - xportr_metadata(df, meta_example, verbose = "stop") %>% xportr_type() - ) %>% - expect_error() - - suppressMessages( - df3 <- xportr_metadata(df, meta_example, verbose = "warn") %>% xportr_type() - ) %>% - expect_warning() - - expect_equal(purrr::map_chr(df3, class), c( - Subj = "numeric", Different = "character", - Val = "numeric", Param = "character" - )) - - suppressMessages({ - ( - df4 <- xportr_metadata(df, meta_example, verbose = "message") %>% - xportr_type() - ) %>% - expect_message("Variable type\\(s\\) in dataframe don't match metadata: `Subj` and `Val`") - }) - expect_equal(purrr::map_chr(df4, class), c( Subj = "numeric", Different = "character", Val = "numeric", Param = "character" From f6a644b3a3679026bbebb232b25c3e12b58d6bf1 Mon Sep 17 00:00:00 2001 From: EeethB Date: Mon, 11 Dec 2023 18:19:55 +0000 Subject: [PATCH 095/267] Add basic top-level wrapper --- R/process.R | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 R/process.R diff --git a/R/process.R b/R/process.R new file mode 100644 index 00000000..0dd16c95 --- /dev/null +++ b/R/process.R @@ -0,0 +1,17 @@ +xportr_process <- function(.df, + metadata = NULL, + domain = NULL, + verbose = getOption("xportr.type_verbose", "none"), + path, + strict_checks = FALSE + ) { + .df %>% + xportr_metadata(metadata, domain) %>% + xportr_type() %>% + xportr_length() %>% + xportr_label() %>% + xportr_order() %>% + xportr_format() %>% + xportr_df_label(dataset_spec) %>% + xportr_write("adsl.xpt") +} From 21accf03b0a412d96af0d7ee6d9c187c62470551 Mon Sep 17 00:00:00 2001 From: EeethB Date: Mon, 8 Jan 2024 11:20:27 -0600 Subject: [PATCH 096/267] Add docs for xportr() --- NAMESPACE | 1 + R/process.R | 17 ----------- R/xportr.R | 75 ++++++++++++++++++++++++++++++++++++++++++++++ man/xportr.Rd | 83 +++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 159 insertions(+), 17 deletions(-) delete mode 100644 R/process.R create mode 100644 R/xportr.R create mode 100644 man/xportr.Rd diff --git a/NAMESPACE b/NAMESPACE index dd495905..5a5d4df7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,7 @@ export(length_log) export(type_log) export(var_names_log) export(var_ord_msg) +export(xportr) export(xportr_df_label) export(xportr_domain_name) export(xportr_format) diff --git a/R/process.R b/R/process.R deleted file mode 100644 index 0dd16c95..00000000 --- a/R/process.R +++ /dev/null @@ -1,17 +0,0 @@ -xportr_process <- function(.df, - metadata = NULL, - domain = NULL, - verbose = getOption("xportr.type_verbose", "none"), - path, - strict_checks = FALSE - ) { - .df %>% - xportr_metadata(metadata, domain) %>% - xportr_type() %>% - xportr_length() %>% - xportr_label() %>% - xportr_order() %>% - xportr_format() %>% - xportr_df_label(dataset_spec) %>% - xportr_write("adsl.xpt") -} diff --git a/R/xportr.R b/R/xportr.R new file mode 100644 index 00000000..687e66d6 --- /dev/null +++ b/R/xportr.R @@ -0,0 +1,75 @@ +#' Wrapper to apply all core xportr functions and write xpt +#' +#' @param .df A data frame of CDISC standard. +#' @param var_metadata A data frame containing variable level metadata +#' @param domain Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset +#' the metadata object. If none is passed, then name of the dataset passed as +#' .df will be used. +#' @param verbose The action this function takes when an action is taken on the +#' dataset or function validation finds an issue. See 'Messaging' section for +#' details. Options are 'stop', 'warn', 'message', and 'none' +#' @param df_metadata A data frame containing dataset level metadata. +#' @param path Path where transport file will be written. File name sans will be +#' used as `xpt` name. +#' @param strict_checks If TRUE, xpt validation will report errors and not write +#' out the dataset. If FALSE, xpt validation will report warnings and continue +#' with writing out the dataset. Defaults to FALSE +#' +#' @return Returns the input dataframe invisibly +#' @export +#' +#' @examples +#' +#' has_pkgs <- require(admiral, quietly = TRUE) && +#' require(dplyr, quietly = TRUE) && +#' require(readxl, quietly = TRUE) && +#' require(rlang, quietly = TRUE) +#' +#' if (has_pkgs) { +#' adsl <- admiral::admiral_adsl +#' +#' spec_path <- system.file(paste0("specs/", "ADaM_admiral_spec.xlsx"), package = "xportr") +#' +#' var_spec <- readxl::read_xlsx(spec_path, sheet = "Variables") %>% +#' dplyr::rename(type = "Data Type") %>% +#' rlang::set_names(tolower) +#' dataset_spec <- readxl::read_xlsx(spec_path, sheet = "Datasets") %>% +#' dplyr::rename(label = "Description") %>% +#' rlang::set_names(tolower) +#' +#' adsl %>% +#' xportr_metadata(var_spec, "ADSL", verbose = "warn") %>% +#' xportr_type() %>% +#' xportr_length() %>% +#' xportr_label() %>% +#' xportr_order() %>% +#' xportr_format() %>% +#' xportr_df_label(dataset_spec) %>% +#' xportr_write("adsl.xpt") +#' +#' # `xportr()` can be used to apply a whole pipeline at once +#' xportr(adsl, +#' var_metadata = var_spec, +#' df_metadata = dataset_spec, +#' domain = "ADSL", +#' verbose = "warn", +#' path = "adsl.xpt" +#' ) +#' } +xportr <- function(.df, + var_metadata = NULL, + df_metadata = NULL, + domain = NULL, + verbose = NULL, + path, + strict_checks = FALSE) { + .df %>% + xportr_metadata(var_metadata, domain, verbose) %>% + xportr_type() %>% + xportr_length() %>% + xportr_label() %>% + xportr_order() %>% + xportr_format() %>% + xportr_df_label(dataset_spec) %>% + xportr_write(path) +} diff --git a/man/xportr.Rd b/man/xportr.Rd new file mode 100644 index 00000000..4a391256 --- /dev/null +++ b/man/xportr.Rd @@ -0,0 +1,83 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/xportr.R +\name{xportr} +\alias{xportr} +\title{Wrapper to apply all core xportr functions and write xpt} +\usage{ +xportr( + .df, + var_metadata = NULL, + df_metadata = NULL, + domain = NULL, + verbose = NULL, + path, + strict_checks = FALSE +) +} +\arguments{ +\item{.df}{A data frame of CDISC standard.} + +\item{var_metadata}{A data frame containing variable level metadata} + +\item{df_metadata}{A data frame containing dataset level metadata.} + +\item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset +the metadata object. If none is passed, then name of the dataset passed as +.df will be used.} + +\item{verbose}{The action this function takes when an action is taken on the +dataset or function validation finds an issue. See 'Messaging' section for +details. Options are 'stop', 'warn', 'message', and 'none'} + +\item{path}{Path where transport file will be written. File name sans will be +used as \code{xpt} name.} + +\item{strict_checks}{If TRUE, xpt validation will report errors and not write +out the dataset. If FALSE, xpt validation will report warnings and continue +with writing out the dataset. Defaults to FALSE} +} +\value{ +Returns the input dataframe invisibly +} +\description{ +Wrapper to apply all core xportr functions and write xpt +} +\examples{ + +has_pkgs <- require(admiral, quietly = TRUE) && + require(dplyr, quietly = TRUE) && + require(readxl, quietly = TRUE) && + require(rlang, quietly = TRUE) + +if (has_pkgs) { + adsl <- admiral::admiral_adsl + + spec_path <- system.file(paste0("specs/", "ADaM_admiral_spec.xlsx"), package = "xportr") + + var_spec <- readxl::read_xlsx(spec_path, sheet = "Variables") \%>\% + dplyr::rename(type = "Data Type") \%>\% + rlang::set_names(tolower) + dataset_spec <- readxl::read_xlsx(spec_path, sheet = "Datasets") \%>\% + dplyr::rename(label = "Description") \%>\% + rlang::set_names(tolower) + + adsl \%>\% + xportr_metadata(var_spec, "ADSL", verbose = "warn") \%>\% + xportr_type() \%>\% + xportr_length() \%>\% + xportr_label() \%>\% + xportr_order() \%>\% + xportr_format() \%>\% + xportr_df_label(dataset_spec) \%>\% + xportr_write("adsl.xpt") + + # `xportr()` can be used to apply a whole pipeline at once + xportr(adsl, + var_metadata = var_spec, + df_metadata = dataset_spec, + domain = "ADSL", + verbose = "warn", + path = "adsl.xpt" + ) +} +} From 9afeeb5e357ab2df2c0a731d5a86dd94ec01811c Mon Sep 17 00:00:00 2001 From: EeethB Date: Mon, 8 Jan 2024 18:22:56 -0600 Subject: [PATCH 097/267] Correct failing tests --- R/xportr-package.R | 1 + R/xportr.R | 10 +++---- README.Rmd | 4 +-- README.md | 2 +- man/xportr-package.Rd | 2 +- tests/testthat/test-metadata.R | 23 +++++++++------ tests/testthat/test-xportr.R | 52 ++++++++++++++++++++++++++++++++++ 7 files changed, 76 insertions(+), 18 deletions(-) create mode 100644 tests/testthat/test-xportr.R diff --git a/R/xportr-package.R b/R/xportr-package.R index 197ad5be..be1c7bef 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -91,6 +91,7 @@ #' #' #' @keywords internal +#' @aliases xportr-package #' #' @import rlang haven #' @importFrom dplyr left_join bind_cols filter select rename rename_with n diff --git a/R/xportr.R b/R/xportr.R index 687e66d6..b0573c68 100644 --- a/R/xportr.R +++ b/R/xportr.R @@ -20,10 +20,10 @@ #' #' @examples #' -#' has_pkgs <- require(admiral, quietly = TRUE) && -#' require(dplyr, quietly = TRUE) && -#' require(readxl, quietly = TRUE) && -#' require(rlang, quietly = TRUE) +#' has_pkgs <- requireNamespace("admiral", quietly = TRUE) && +#' requireNamespace("dplyr", quietly = TRUE) && +#' requireNamespace("readxl", quietly = TRUE) && +#' requireNamespace("rlang", quietly = TRUE) #' #' if (has_pkgs) { #' adsl <- admiral::admiral_adsl @@ -64,7 +64,7 @@ xportr <- function(.df, path, strict_checks = FALSE) { .df %>% - xportr_metadata(var_metadata, domain, verbose) %>% + xportr_metadata(var_metadata, domain = domain, verbose = verbose) %>% xportr_type() %>% xportr_length() %>% xportr_label() %>% diff --git a/README.Rmd b/README.Rmd index edc532c9..c6a9adbd 100644 --- a/README.Rmd +++ b/README.Rmd @@ -143,9 +143,9 @@ adsl %>% The `xportr_metadata()` function can reduce duplication by setting the variable specification and domain explicitly at the top of a pipeline. If you would like to use the `verbose` argument, you will need to set in each function call. -```{r, message=FALSE, eval=FALSE} +```{r, warning=FALSE, message=FALSE, eval=FALSE} adsl %>% - xportr_metadata(var_spec, "ADSL", verbose = "warn") %>% + xportr_metadata(var_spec, domain = "ADSL") %>% xportr_type() %>% xportr_length() %>% xportr_label() %>% diff --git a/README.md b/README.md index cc83fae4..592fcce1 100644 --- a/README.md +++ b/README.md @@ -155,7 +155,7 @@ each function call. ``` r adsl %>% - xportr_metadata(var_spec, "ADSL") %>% + xportr_metadata(var_spec, domain = "ADSL") %>% xportr_type() %>% xportr_length() %>% xportr_label() %>% diff --git a/man/xportr-package.Rd b/man/xportr-package.Rd index 64eaed80..ab8f471e 100644 --- a/man/xportr-package.Rd +++ b/man/xportr-package.Rd @@ -2,8 +2,8 @@ % Please edit documentation in R/xportr-package.R \docType{package} \name{xportr-package} -\alias{xportr} \alias{xportr-package} +\alias{_PACKAGE} \title{The \code{xportr} package} \description{ \code{xportr} is designed to be a clinical workflow friendly method for outputting diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index 27b80500..97fd0e79 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -594,13 +594,13 @@ test_that("xportr_metadata: Variable ordering messaging is correct", { ) # Metadata versions - xportr_metadata(df, df_meta, verbose = "message") %>% + xportr_metadata(df, df_meta, domain = "df", verbose = "message") %>% xportr_order() %>% expect_message("All variables in specification file are in dataset") %>% expect_condition("4 reordered in dataset") %>% expect_message("Variable reordered in `.df`: `a`, `b`, `c`, and `d`") - xportr_metadata(df2, df_meta, verbose = "message") %>% + xportr_metadata(df2, df_meta, domain = "df2", verbose = "message") %>% xportr_order() %>% expect_message("2 variables not in spec and moved to end") %>% expect_message("Variable moved to end in `.df`: `a` and `z`") %>% @@ -623,13 +623,13 @@ test_that("xportr_type: Variable types are coerced as expected and can raise mes # Metadata version of the last statement df %>% - xportr_metadata(meta_example, verbose = "warn") %>% + xportr_metadata(meta_example, domain = "df", verbose = "warn") %>% xportr_type() %>% expect_warning() # Metadata version df %>% - xportr_metadata(meta_example, verbose = "message") %>% + xportr_metadata(meta_example, domain = "df", verbose = "message") %>% xportr_type() %>% expect_message("Variable type\\(s\\) in dataframe don't match metadata") }) @@ -654,7 +654,8 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { `_xportr.df_metadata_` = var_spec, `_xportr.df_verbose_` = "none"), suppressMessages( - xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_type() + xportr_metadata(adsl, var_spec, domain = "adsl", verbose = "none") %>% + xportr_type() ) ) @@ -663,7 +664,8 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { `_xportr.df_metadata_` = var_spec, `_xportr.df_verbose_` = "none"), suppressMessages( - xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_length() + xportr_metadata(adsl, var_spec, domain = "adsl", verbose = "none") %>% + xportr_length() ) ) @@ -672,7 +674,8 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { `_xportr.df_metadata_` = var_spec, `_xportr.df_verbose_` = "none"), suppressMessages( - xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_label() + xportr_metadata(adsl, var_spec, domain = "adsl", verbose = "none") %>% + xportr_label() ) ) @@ -681,7 +684,8 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { `_xportr.df_metadata_` = var_spec, `_xportr.df_verbose_` = "none"), suppressMessages( - xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_order() + xportr_metadata(adsl, var_spec, domain = "adsl", verbose = "none") %>% + xportr_order() ) ) @@ -690,7 +694,8 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { `_xportr.df_metadata_` = var_spec, `_xportr.df_verbose_` = "none"), suppressMessages( - xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_format() + xportr_metadata(adsl, var_spec, domain = "adsl", verbose = "none") %>% + xportr_format() ) ) }) diff --git a/tests/testthat/test-xportr.R b/tests/testthat/test-xportr.R new file mode 100644 index 00000000..6ebb129c --- /dev/null +++ b/tests/testthat/test-xportr.R @@ -0,0 +1,52 @@ +test_that("pipeline results match `xportr()` results", { + + has_pkgs <- requireNamespace("admiral", quietly = TRUE) && + requireNamespace("dplyr", quietly = TRUE) && + requireNamespace("readxl", quietly = TRUE) && + requireNamespace("rlang", quietly = TRUE) + + if (has_pkgs) { + adsl <- admiral::admiral_adsl + + spec_path <- system.file(paste0("specs/", "ADaM_admiral_spec.xlsx"), + package = "xportr") + + var_spec <- readxl::read_xlsx(spec_path, sheet = "Variables") %>% + dplyr::rename(type = "Data Type") %>% + rlang::set_names(tolower) + dataset_spec <- readxl::read_xlsx(spec_path, sheet = "Datasets") %>% + dplyr::rename(label = "Description") %>% + rlang::set_names(tolower) + + test_dir <- tempdir() + + pipeline_path <- file.path(test_dir, "adslpipe.xpt") + xportr_path <- file.path(test_dir, "adslxptr.xpt") + + pipeline_df <- adsl %>% + xportr_metadata(var_spec, "ADSL", verbose = "none") %>% + xportr_type() %>% + xportr_length() %>% + xportr_label() %>% + xportr_order() %>% + xportr_format() %>% + xportr_df_label(dataset_spec) %>% + xportr_write(pipeline_path) + + # `xportr()` can be used to apply a whole pipeline at once + xportr_df <- xportr(adsl, + var_metadata = var_spec, + df_metadata = dataset_spec, + domain = "ADSL", + verbose = "none", + path = xportr_path + ) + + expect_identical(pipeline_df, xportr_df) + + expect_identical( + haven::read_xpt(pipeline_path), + haven::read_xpt(xportr_path) + ) + } +}) From f7cf12994cede81e54fefdb8cb1675f6319c4e3e Mon Sep 17 00:00:00 2001 From: EeethB Date: Mon, 8 Jan 2024 18:30:44 -0600 Subject: [PATCH 098/267] Run styler --- man/xportr.Rd | 8 ++++---- tests/testthat/test-metadata.R | 25 +++++++++++++++---------- tests/testthat/test-xportr.R | 4 ++-- 3 files changed, 21 insertions(+), 16 deletions(-) diff --git a/man/xportr.Rd b/man/xportr.Rd index 4a391256..47da1537 100644 --- a/man/xportr.Rd +++ b/man/xportr.Rd @@ -44,10 +44,10 @@ Wrapper to apply all core xportr functions and write xpt } \examples{ -has_pkgs <- require(admiral, quietly = TRUE) && - require(dplyr, quietly = TRUE) && - require(readxl, quietly = TRUE) && - require(rlang, quietly = TRUE) +has_pkgs <- requireNamespace("admiral", quietly = TRUE) && + requireNamespace("dplyr", quietly = TRUE) && + requireNamespace("readxl", quietly = TRUE) && + requireNamespace("rlang", quietly = TRUE) if (has_pkgs) { adsl <- admiral::admiral_adsl diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index 97fd0e79..7117b027 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -651,8 +651,9 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { expect_equal( structure(xportr_type(adsl, var_spec, domain = "adsl"), - `_xportr.df_metadata_` = var_spec, - `_xportr.df_verbose_` = "none"), + `_xportr.df_metadata_` = var_spec, + `_xportr.df_verbose_` = "none" + ), suppressMessages( xportr_metadata(adsl, var_spec, domain = "adsl", verbose = "none") %>% xportr_type() @@ -661,8 +662,9 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { expect_equal( structure(xportr_length(adsl, var_spec, domain = "adsl"), - `_xportr.df_metadata_` = var_spec, - `_xportr.df_verbose_` = "none"), + `_xportr.df_metadata_` = var_spec, + `_xportr.df_verbose_` = "none" + ), suppressMessages( xportr_metadata(adsl, var_spec, domain = "adsl", verbose = "none") %>% xportr_length() @@ -671,8 +673,9 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { expect_equal( structure(xportr_label(adsl, var_spec, domain = "adsl"), - `_xportr.df_metadata_` = var_spec, - `_xportr.df_verbose_` = "none"), + `_xportr.df_metadata_` = var_spec, + `_xportr.df_verbose_` = "none" + ), suppressMessages( xportr_metadata(adsl, var_spec, domain = "adsl", verbose = "none") %>% xportr_label() @@ -681,8 +684,9 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { expect_equal( structure(xportr_order(adsl, var_spec, domain = "adsl"), - `_xportr.df_metadata_` = var_spec, - `_xportr.df_verbose_` = "none"), + `_xportr.df_metadata_` = var_spec, + `_xportr.df_verbose_` = "none" + ), suppressMessages( xportr_metadata(adsl, var_spec, domain = "adsl", verbose = "none") %>% xportr_order() @@ -691,8 +695,9 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { expect_equal( structure(xportr_format(adsl, var_spec, domain = "adsl"), - `_xportr.df_metadata_` = var_spec, - `_xportr.df_verbose_` = "none"), + `_xportr.df_metadata_` = var_spec, + `_xportr.df_verbose_` = "none" + ), suppressMessages( xportr_metadata(adsl, var_spec, domain = "adsl", verbose = "none") %>% xportr_format() diff --git a/tests/testthat/test-xportr.R b/tests/testthat/test-xportr.R index 6ebb129c..eb43c244 100644 --- a/tests/testthat/test-xportr.R +++ b/tests/testthat/test-xportr.R @@ -1,5 +1,4 @@ test_that("pipeline results match `xportr()` results", { - has_pkgs <- requireNamespace("admiral", quietly = TRUE) && requireNamespace("dplyr", quietly = TRUE) && requireNamespace("readxl", quietly = TRUE) && @@ -9,7 +8,8 @@ test_that("pipeline results match `xportr()` results", { adsl <- admiral::admiral_adsl spec_path <- system.file(paste0("specs/", "ADaM_admiral_spec.xlsx"), - package = "xportr") + package = "xportr" + ) var_spec <- readxl::read_xlsx(spec_path, sheet = "Variables") %>% dplyr::rename(type = "Data Type") %>% From 8e01730c561e02e367cc832bbddae7b6918d411f Mon Sep 17 00:00:00 2001 From: Celine Date: Tue, 9 Jan 2024 09:02:19 -0500 Subject: [PATCH 099/267] Update nchar_gt_200 to take into account NA values --- R/utils-xportr.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utils-xportr.R b/R/utils-xportr.R index 168a2a48..04c2f178 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -305,7 +305,7 @@ xpt_validate <- function(data) { # 4.0 max length of Character variables <= 200 bytes max_nchar <- data %>% - summarize(across(where(is.character), ~ max(nchar(., type = "bytes")))) + summarize(across(where(is.character), ~ max(0L, nchar(., type = "bytes"), na.rm = TRUE))) nchar_gt_200 <- max_nchar[which(max_nchar > 200)] if (length(nchar_gt_200) > 0) { err_cnd <- c( From 56f02d763ccdd6df581263d55ba47159b2669de7 Mon Sep 17 00:00:00 2001 From: Celine Date: Tue, 9 Jan 2024 09:19:58 -0500 Subject: [PATCH 100/267] Add test for variable length < 200 when the variable contains NAs --- tests/testthat/test-utils-xportr.R | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/tests/testthat/test-utils-xportr.R b/tests/testthat/test-utils-xportr.R index 41f6adb8..f36393af 100644 --- a/tests/testthat/test-utils-xportr.R +++ b/tests/testthat/test-utils-xportr.R @@ -127,3 +127,11 @@ test_that("xpt_validate: Get error message when the length of a non-ASCII charac "Length of A must be 200 bytes or less." ) }) + +test_that("xpt_validate: Get error message when the length of a character variable is > 200 bytes and contains NAs", { + df <- data.frame(A = c(paste(rep("A", 201), collapse = ""), NA_character_)) + expect_equal( + xpt_validate(df), + "Length of A must be 200 bytes or less." + ) +}) From 4d3973e7e0b58d4dbbc14cdf8f9114e890ed0d6d Mon Sep 17 00:00:00 2001 From: Celine Date: Tue, 9 Jan 2024 09:22:06 -0500 Subject: [PATCH 101/267] Uncomment code --- R/length.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/R/length.R b/R/length.R index 7bd0d233..bbf08207 100644 --- a/R/length.R +++ b/R/length.R @@ -103,13 +103,13 @@ xportr_length <- function(.df, metadata <- metadata$var_spec } - # if (domain_name %in% names(metadata)) { - # metadata <- metadata %>% - # filter(!!sym(domain_name) == domain) - # } else { - # # Common check for multiple variables name - # check_multiple_var_specs(metadata, variable_name) - # } + if (domain_name %in% names(metadata)) { + metadata <- metadata %>% + filter(!!sym(domain_name) == domain) + } else { + # Common check for multiple variables name + check_multiple_var_specs(metadata, variable_name) + } # Check any variables missed in metadata but present in input data --- From 5f6b3e1411449cd5885f4bf30974d18982be5cdf Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 9 Jan 2024 21:51:43 +0530 Subject: [PATCH 102/267] feat: add support for easy operations with xportr options --- NAMESPACE | 1 + R/xportr-options.R | 101 ++++++++++++++++++++++++++++++++++++++++++ R/zzz.R | 27 +---------- man/xportrOptions.Rd | 56 +++++++++++++++++++++++ man/xportr_options.Rd | 16 +++++++ 5 files changed, 176 insertions(+), 25 deletions(-) create mode 100644 R/xportr-options.R create mode 100644 man/xportrOptions.Rd create mode 100644 man/xportr_options.Rd diff --git a/NAMESPACE b/NAMESPACE index d2f10378..ea6b9440 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,7 @@ export(length_log) export(type_log) export(var_names_log) export(var_ord_msg) +export(xportrOptions) export(xportr_df_label) export(xportr_format) export(xportr_label) diff --git a/R/xportr-options.R b/R/xportr-options.R new file mode 100644 index 00000000..2bc194bc --- /dev/null +++ b/R/xportr-options.R @@ -0,0 +1,101 @@ +#' A list with all the supported options of xportr +#' +#' An internal list with all the supported options of xportr with defaults +#' +#' @keywords internal +xportr_options <- list( + xportr.df_domain_name = "dataset", + xportr.df_label = "label", + xportr.domain_name = "dataset", + xportr.variable_name = "variable", + xportr.type_name = "type", + xportr.label = "label", + xportr.length = "length", + xportr.format_name = "format", + xportr.format_verbose = "none", + xportr.label_verbose = "none", + xportr.length_verbose = "none", + xportr.type_verbose = "none", + xportr.character_types = c( + "character", "char", "text", "date", "posixct", + "posixt", "datetime", "time", "partialdate", + "partialtime", "partialdatetime", + "incompletedatetime", "durationdatetime", + "intervaldatetime" + ), + xportr.numeric_types = c("integer", "numeric", "num", "float"), + xportr.order_name = "order" +) + + +#' Get or set Xportr options +#' +#' @description +#' +#' There are two mechanisms for working with options for xportr. One is the +#' [options()] function, which is part of base R, and the other is the +#' `xportrOptions()` function, which is in the xportr package. The reason for +#' these two mechanisms is has to do with legacy code and scoping. +#' +#' The [options()] function sets options globally, for the duration of the R +#' process. The [getOption()] function retrieves the value of an option. All +#' xportr related options of this type are prefixed with `"xportr."`. +#' +#' +#' @section Options with `options()`: +#' +#' \describe{ +#' \item{xportr.df_domain_name (defaults to `"dataset"`)}{Description about this option ...} +#' \item{xportr.df_label (defaults to `"label"`)}{Description about this option ...} +#' \item{xportr.domain_name (defaults to `"dataset"`)}{Description about this option ...} +#' \item{xportr.variable_name (defaults to `"variable"`)}{Description about this option ...} +#' \item{xportr.type_name (defaults to `"type"`)}{Description about this option ...} +#' \item{xportr.label (defaults to `"label"`)}{Description about this option ...} +#' \item{xportr.length (defaults to `"length"`)}{Description about this option ...} +#' \item{xportr.format_name (defaults to `"format"`)}{Description about this option ...} +#' \item{xportr.format_verbose (defaults to `"none"`)}{Description about this option ...} +#' \item{xportr.label_verbose (defaults to `"none"`)}{Description about this option ...} +#' \item{xportr.length_verbose (defaults to `"none"`)}{Description about this option ...} +#' \item{xportr.type_verbose (defaults to `"label"`)}{Description about this option ...} +#' \item{xportr.character_types (defaults to `c("character", "char", "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", "partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", "intervaldatetime")`)}{Description about this option ...} # nolint +#' \item{xportr.numeric_types (defaults to `c("integer", "numeric", "num", "float")`)}{Description about this option ...} # nolint +#' \item{xportr.order_name (defaults to `"order"`)}{Description about this option ...} +#' +#' +#' @section Options with `xportrOptions()`: +#' +#' There are a number of global options that affect xportr's behavior. These +#' can be set globally with `options()` or with `xportrOptions()`. +#' The `xportrOptions()` function also returns the current options when nothing is passed to it. +#' +#' @param ... Options to set, with the form `name = value`. +#' +#' @examples +#' xportrOptions(xportr.df_label = "data_label", xportr.label = "custom_label") +#' xportrOptions("xportr.df_label") +#' xportrOptions(c("xportr.label", "xportr.df_label")) +#' xportrOptions() +#' @export +xportrOptions <- function(...) { + checkmate::assert_subset(names(list(...)), names(xportr_options)) + if (is.null(names(list(...)))) { + if (length(list(...)) == 0) { + queried_options <- names(xportr_options) + } else { + queried_options <- intersect(unlist(...), names(xportr_options)) + } + current_options <- lapply(queried_options, function(opt) { + getOption(opt) + }) + names(current_options) <- queried_options + return(current_options) + } + if (length(list(...)) > 0) { + options_list <- list(...) + xportr_options <- grep("^xportr\\.", names(options_list), value = TRUE) + for (opt in xportr_options) { + option_value <- options_list[[opt]] + do.call(options, setNames(list(option_value), opt)) + } + } +} diff --git a/R/zzz.R b/R/zzz.R index 88b877b5..ff3cce14 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,30 +1,7 @@ .onLoad <- function(libname, pkgname) { op <- options() - op.devtools <- list( - xportr.df_domain_name = "dataset", - xportr.df_label = "label", - xportr.domain_name = "dataset", - xportr.variable_name = "variable", - xportr.type_name = "type", - xportr.label = "label", - xportr.length = "length", - xportr.format_name = "format", - xportr.format_verbose = "none", - xportr.label_verbose = "none", - xportr.length_verbose = "none", - xportr.type_verbose = "none", - xportr.character_types = c( - "character", "char", "text", "date", "posixct", - "posixt", "datetime", "time", "partialdate", - "partialtime", "partialdatetime", - "incompletedatetime", "durationdatetime", - "intervaldatetime" - ), - xportr.numeric_types = c("integer", "numeric", "num", "float"), - xportr.order_name = "order" - ) - toset <- !(names(op.devtools) %in% names(op)) - if (any(toset)) options(op.devtools[toset]) + toset <- !(names(xportr_options) %in% names(op)) + if (any(toset)) options(xportr_options[toset]) invisible() } diff --git a/man/xportrOptions.Rd b/man/xportrOptions.Rd new file mode 100644 index 00000000..88b3150b --- /dev/null +++ b/man/xportrOptions.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/xportr-options.R +\name{xportrOptions} +\alias{xportrOptions} +\title{Get or set Xportr options} +\usage{ +xportrOptions(...) +} +\arguments{ +\item{...}{Options to set, with the form \code{name = value}.} +} +\description{ +There are two mechanisms for working with options for xportr. One is the +\code{\link[=options]{options()}} function, which is part of base R, and the other is the +\code{xportrOptions()} function, which is in the xportr package. The reason for +these two mechanisms is has to do with legacy code and scoping. + +The \code{\link[=options]{options()}} function sets options globally, for the duration of the R +process. The \code{\link[=getOption]{getOption()}} function retrieves the value of an option. All +xportr related options of this type are prefixed with \code{"xportr."}. +} +\section{Options with \code{options()}}{ + + +\describe{ +\item{xportr.df_domain_name (defaults to \code{"dataset"})}{Description about this option ...} +\item{xportr.df_label (defaults to \code{"label"})}{Description about this option ...} +\item{xportr.domain_name (defaults to \code{"dataset"})}{Description about this option ...} +\item{xportr.variable_name (defaults to \code{"variable"})}{Description about this option ...} +\item{xportr.type_name (defaults to \code{"type"})}{Description about this option ...} +\item{xportr.label (defaults to \code{"label"})}{Description about this option ...} +\item{xportr.length (defaults to \code{"length"})}{Description about this option ...} +\item{xportr.format_name (defaults to \code{"format"})}{Description about this option ...} +\item{xportr.format_verbose (defaults to \code{"none"})}{Description about this option ...} +\item{xportr.label_verbose (defaults to \code{"none"})}{Description about this option ...} +\item{xportr.length_verbose (defaults to \code{"none"})}{Description about this option ...} +\item{xportr.type_verbose (defaults to \code{"label"})}{Description about this option ...} +\item{xportr.character_types (defaults to \code{c("character", "char", "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", "partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", "intervaldatetime")})}{Description about this option ...} # nolint +\item{xportr.numeric_types (defaults to \code{c("integer", "numeric", "num", "float")})}{Description about this option ...} # nolint +\item{xportr.order_name (defaults to \code{"order"})}{Description about this option ...} +} + +\section{Options with \code{xportrOptions()}}{ + + +There are a number of global options that affect xportr's behavior. These +can be set globally with \code{options()} or with \code{xportrOptions()}. +The \code{xportrOptions()} function also returns the current options when nothing is passed to it. +} + +\examples{ +xportrOptions(xportr.df_label = "data_label", xportr.label = "custom_label") +xportrOptions("xportr.df_label") +xportrOptions(c("xportr.label", "xportr.df_label")) +xportrOptions() +} diff --git a/man/xportr_options.Rd b/man/xportr_options.Rd new file mode 100644 index 00000000..9ade0e27 --- /dev/null +++ b/man/xportr_options.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/xportr-options.R +\docType{data} +\name{xportr_options} +\alias{xportr_options} +\title{A list with all the supported options of xportr} +\format{ +An object of class \code{list} of length 15. +} +\usage{ +xportr_options +} +\description{ +An internal list with all the supported options of xportr with defaults +} +\keyword{internal} From 31ecca86f1aca6a3690a191dcd35e358457b4ad8 Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 9 Jan 2024 21:53:11 +0530 Subject: [PATCH 103/267] chore: make the user facing function camel case --- NAMESPACE | 2 +- R/xportr-options.R | 18 +++++++------- man/xportrOptions.Rd | 56 ------------------------------------------- man/xportr_options.Rd | 55 ++++++++++++++++++++++++++++++++++++++---- 4 files changed, 60 insertions(+), 71 deletions(-) delete mode 100644 man/xportrOptions.Rd diff --git a/NAMESPACE b/NAMESPACE index ea6b9440..8e934b3f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,13 +5,13 @@ export(length_log) export(type_log) export(var_names_log) export(var_ord_msg) -export(xportrOptions) export(xportr_df_label) export(xportr_format) export(xportr_label) export(xportr_length) export(xportr_logger) export(xportr_metadata) +export(xportr_options) export(xportr_order) export(xportr_type) export(xportr_write) diff --git a/R/xportr-options.R b/R/xportr-options.R index 2bc194bc..fa0f8fd3 100644 --- a/R/xportr-options.R +++ b/R/xportr-options.R @@ -34,7 +34,7 @@ xportr_options <- list( #' #' There are two mechanisms for working with options for xportr. One is the #' [options()] function, which is part of base R, and the other is the -#' `xportrOptions()` function, which is in the xportr package. The reason for +#' `xportr_options()` function, which is in the xportr package. The reason for #' these two mechanisms is has to do with legacy code and scoping. #' #' The [options()] function sets options globally, for the duration of the R @@ -62,21 +62,21 @@ xportr_options <- list( #' \item{xportr.order_name (defaults to `"order"`)}{Description about this option ...} #' #' -#' @section Options with `xportrOptions()`: +#' @section Options with `xportr_options()`: #' #' There are a number of global options that affect xportr's behavior. These -#' can be set globally with `options()` or with `xportrOptions()`. -#' The `xportrOptions()` function also returns the current options when nothing is passed to it. +#' can be set globally with `options()` or with `xportr_options()`. +#' The `xportr_options()` function also returns the current options when nothing is passed to it. #' #' @param ... Options to set, with the form `name = value`. #' #' @examples -#' xportrOptions(xportr.df_label = "data_label", xportr.label = "custom_label") -#' xportrOptions("xportr.df_label") -#' xportrOptions(c("xportr.label", "xportr.df_label")) -#' xportrOptions() +#' xportr_options(xportr.df_label = "data_label", xportr.label = "custom_label") +#' xportr_options("xportr.df_label") +#' xportr_options(c("xportr.label", "xportr.df_label")) +#' xportr_options() #' @export -xportrOptions <- function(...) { +xportr_options <- function(...) { checkmate::assert_subset(names(list(...)), names(xportr_options)) if (is.null(names(list(...)))) { if (length(list(...)) == 0) { diff --git a/man/xportrOptions.Rd b/man/xportrOptions.Rd deleted file mode 100644 index 88b3150b..00000000 --- a/man/xportrOptions.Rd +++ /dev/null @@ -1,56 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/xportr-options.R -\name{xportrOptions} -\alias{xportrOptions} -\title{Get or set Xportr options} -\usage{ -xportrOptions(...) -} -\arguments{ -\item{...}{Options to set, with the form \code{name = value}.} -} -\description{ -There are two mechanisms for working with options for xportr. One is the -\code{\link[=options]{options()}} function, which is part of base R, and the other is the -\code{xportrOptions()} function, which is in the xportr package. The reason for -these two mechanisms is has to do with legacy code and scoping. - -The \code{\link[=options]{options()}} function sets options globally, for the duration of the R -process. The \code{\link[=getOption]{getOption()}} function retrieves the value of an option. All -xportr related options of this type are prefixed with \code{"xportr."}. -} -\section{Options with \code{options()}}{ - - -\describe{ -\item{xportr.df_domain_name (defaults to \code{"dataset"})}{Description about this option ...} -\item{xportr.df_label (defaults to \code{"label"})}{Description about this option ...} -\item{xportr.domain_name (defaults to \code{"dataset"})}{Description about this option ...} -\item{xportr.variable_name (defaults to \code{"variable"})}{Description about this option ...} -\item{xportr.type_name (defaults to \code{"type"})}{Description about this option ...} -\item{xportr.label (defaults to \code{"label"})}{Description about this option ...} -\item{xportr.length (defaults to \code{"length"})}{Description about this option ...} -\item{xportr.format_name (defaults to \code{"format"})}{Description about this option ...} -\item{xportr.format_verbose (defaults to \code{"none"})}{Description about this option ...} -\item{xportr.label_verbose (defaults to \code{"none"})}{Description about this option ...} -\item{xportr.length_verbose (defaults to \code{"none"})}{Description about this option ...} -\item{xportr.type_verbose (defaults to \code{"label"})}{Description about this option ...} -\item{xportr.character_types (defaults to \code{c("character", "char", "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", "partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", "intervaldatetime")})}{Description about this option ...} # nolint -\item{xportr.numeric_types (defaults to \code{c("integer", "numeric", "num", "float")})}{Description about this option ...} # nolint -\item{xportr.order_name (defaults to \code{"order"})}{Description about this option ...} -} - -\section{Options with \code{xportrOptions()}}{ - - -There are a number of global options that affect xportr's behavior. These -can be set globally with \code{options()} or with \code{xportrOptions()}. -The \code{xportrOptions()} function also returns the current options when nothing is passed to it. -} - -\examples{ -xportrOptions(xportr.df_label = "data_label", xportr.label = "custom_label") -xportrOptions("xportr.df_label") -xportrOptions(c("xportr.label", "xportr.df_label")) -xportrOptions() -} diff --git a/man/xportr_options.Rd b/man/xportr_options.Rd index 9ade0e27..2008f5d7 100644 --- a/man/xportr_options.Rd +++ b/man/xportr_options.Rd @@ -1,16 +1,61 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/xportr-options.R -\docType{data} \name{xportr_options} \alias{xportr_options} \title{A list with all the supported options of xportr} -\format{ -An object of class \code{list} of length 15. -} \usage{ -xportr_options +xportr_options(...) + +xportr_options(...) +} +\arguments{ +\item{...}{Options to set, with the form \code{name = value}.} } \description{ An internal list with all the supported options of xportr with defaults + +There are two mechanisms for working with options for xportr. One is the +\code{\link[=options]{options()}} function, which is part of base R, and the other is the +\code{xportr_options()} function, which is in the xportr package. The reason for +these two mechanisms is has to do with legacy code and scoping. + +The \code{\link[=options]{options()}} function sets options globally, for the duration of the R +process. The \code{\link[=getOption]{getOption()}} function retrieves the value of an option. All +xportr related options of this type are prefixed with \code{"xportr."}. +} +\section{Options with \code{options()}}{ + + +\describe{ +\item{xportr.df_domain_name (defaults to \code{"dataset"})}{Description about this option ...} +\item{xportr.df_label (defaults to \code{"label"})}{Description about this option ...} +\item{xportr.domain_name (defaults to \code{"dataset"})}{Description about this option ...} +\item{xportr.variable_name (defaults to \code{"variable"})}{Description about this option ...} +\item{xportr.type_name (defaults to \code{"type"})}{Description about this option ...} +\item{xportr.label (defaults to \code{"label"})}{Description about this option ...} +\item{xportr.length (defaults to \code{"length"})}{Description about this option ...} +\item{xportr.format_name (defaults to \code{"format"})}{Description about this option ...} +\item{xportr.format_verbose (defaults to \code{"none"})}{Description about this option ...} +\item{xportr.label_verbose (defaults to \code{"none"})}{Description about this option ...} +\item{xportr.length_verbose (defaults to \code{"none"})}{Description about this option ...} +\item{xportr.type_verbose (defaults to \code{"label"})}{Description about this option ...} +\item{xportr.character_types (defaults to \code{c("character", "char", "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", "partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", "intervaldatetime")})}{Description about this option ...} # nolint +\item{xportr.numeric_types (defaults to \code{c("integer", "numeric", "num", "float")})}{Description about this option ...} # nolint +\item{xportr.order_name (defaults to \code{"order"})}{Description about this option ...} +} + +\section{Options with \code{xportr_options()}}{ + + +There are a number of global options that affect xportr's behavior. These +can be set globally with \code{options()} or with \code{xportr_options()}. +The \code{xportr_options()} function also returns the current options when nothing is passed to it. +} + +\examples{ +xportr_options(xportr.df_label = "data_label", xportr.label = "custom_label") +xportr_options("xportr.df_label") +xportr_options(c("xportr.label", "xportr.df_label")) +xportr_options() } \keyword{internal} From 36ecbf5ac5c70ef5d8cb7de77325a004c43e5eb6 Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 9 Jan 2024 22:40:03 +0530 Subject: [PATCH 104/267] fix: fix broken tests and move the xportr_options data to globals --- R/xportr-options.R | 30 ------------------------------ R/zzz.R | 27 +++++++++++++++++++++++++++ man/xportr_options.Rd | 20 +++++++++++++------- 3 files changed, 40 insertions(+), 37 deletions(-) diff --git a/R/xportr-options.R b/R/xportr-options.R index fa0f8fd3..349eb2b4 100644 --- a/R/xportr-options.R +++ b/R/xportr-options.R @@ -1,33 +1,3 @@ -#' A list with all the supported options of xportr -#' -#' An internal list with all the supported options of xportr with defaults -#' -#' @keywords internal -xportr_options <- list( - xportr.df_domain_name = "dataset", - xportr.df_label = "label", - xportr.domain_name = "dataset", - xportr.variable_name = "variable", - xportr.type_name = "type", - xportr.label = "label", - xportr.length = "length", - xportr.format_name = "format", - xportr.format_verbose = "none", - xportr.label_verbose = "none", - xportr.length_verbose = "none", - xportr.type_verbose = "none", - xportr.character_types = c( - "character", "char", "text", "date", "posixct", - "posixt", "datetime", "time", "partialdate", - "partialtime", "partialdatetime", - "incompletedatetime", "durationdatetime", - "intervaldatetime" - ), - xportr.numeric_types = c("integer", "numeric", "num", "float"), - xportr.order_name = "order" -) - - #' Get or set Xportr options #' #' @description diff --git a/R/zzz.R b/R/zzz.R index ff3cce14..9136e435 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,3 +1,30 @@ +#' A list with all the supported options of xportr +#' +#' An internal list with all the supported options of xportr with defaults +xportr_options <- list( + xportr.df_domain_name = "dataset", + xportr.df_label = "label", + xportr.domain_name = "dataset", + xportr.variable_name = "variable", + xportr.type_name = "type", + xportr.label = "label", + xportr.length = "length", + xportr.format_name = "format", + xportr.format_verbose = "none", + xportr.label_verbose = "none", + xportr.length_verbose = "none", + xportr.type_verbose = "none", + xportr.character_types = c( + "character", "char", "text", "date", "posixct", + "posixt", "datetime", "time", "partialdate", + "partialtime", "partialdatetime", + "incompletedatetime", "durationdatetime", + "intervaldatetime" + ), + xportr.numeric_types = c("integer", "numeric", "num", "float"), + xportr.order_name = "order" +) + .onLoad <- function(libname, pkgname) { op <- options() toset <- !(names(xportr_options) %in% names(op)) diff --git a/man/xportr_options.Rd b/man/xportr_options.Rd index 2008f5d7..6b9703da 100644 --- a/man/xportr_options.Rd +++ b/man/xportr_options.Rd @@ -1,19 +1,23 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/xportr-options.R +% Please edit documentation in R/xportr-options.R, R/zzz.R +\docType{data} \name{xportr_options} \alias{xportr_options} -\title{A list with all the supported options of xportr} +\title{Get or set Xportr options} +\format{ +An object of class \code{list} of length 15. + +An object of class \code{list} of length 15. +} \usage{ -xportr_options(...) +xportr_options -xportr_options(...) +xportr_options } \arguments{ \item{...}{Options to set, with the form \code{name = value}.} } \description{ -An internal list with all the supported options of xportr with defaults - There are two mechanisms for working with options for xportr. One is the \code{\link[=options]{options()}} function, which is part of base R, and the other is the \code{xportr_options()} function, which is in the xportr package. The reason for @@ -22,6 +26,8 @@ these two mechanisms is has to do with legacy code and scoping. The \code{\link[=options]{options()}} function sets options globally, for the duration of the R process. The \code{\link[=getOption]{getOption()}} function retrieves the value of an option. All xportr related options of this type are prefixed with \code{"xportr."}. + +An internal list with all the supported options of xportr with defaults } \section{Options with \code{options()}}{ @@ -58,4 +64,4 @@ xportr_options("xportr.df_label") xportr_options(c("xportr.label", "xportr.df_label")) xportr_options() } -\keyword{internal} +\keyword{datasets} From 7fdcfc8d7f568cbbf05780a63cf5b53d175ee9fe Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 10 Jan 2024 03:33:57 -0500 Subject: [PATCH 105/267] add "domain =" in function for test --- tests/testthat/test-length.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index dfe56cb4..8a580227 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -238,16 +238,16 @@ df <- data.frame( test_that("xportr_length: length assigned as expected from metadata or data", { result <- df %>% - xportr_length(meta_example, length = "metadata") %>% + xportr_length(meta_example, domain = "df", length = "metadata") %>% expect_attr_width(c(10,8)) result <- df %>% - xportr_length(meta_example, length = "data") %>% + xportr_length(meta_example, domain = "df", length = "data") %>% expect_attr_width(c(3,8)) }) test_that("xportr_length: Gets message when length in metadata longer than data length", { result <- df %>% - xportr_length(meta_example, length = "data") %>% + xportr_length(meta_example, domain = "df", length = "data") %>% expect_message() }) From 43c0a2dce054238c34db688e763276f68da693fc Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 10 Jan 2024 03:48:57 -0500 Subject: [PATCH 106/267] Update style --- tests/testthat/test-length.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index 8a580227..68218903 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -233,17 +233,17 @@ meta_example <- data.frame( df <- data.frame( USUBJID = c("1", "12", "123"), - WEIGHT = c(85, 45, 121 ) + WEIGHT = c(85, 45, 121) ) test_that("xportr_length: length assigned as expected from metadata or data", { result <- df %>% xportr_length(meta_example, domain = "df", length = "metadata") %>% - expect_attr_width(c(10,8)) + expect_attr_width(c(10, 8)) result <- df %>% xportr_length(meta_example, domain = "df", length = "data") %>% - expect_attr_width(c(3,8)) + expect_attr_width(c(3, 8)) }) test_that("xportr_length: Gets message when length in metadata longer than data length", { From 2bd889d24e1fb593b09b14d38dbebe2187f9629f Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 10 Jan 2024 03:54:16 -0500 Subject: [PATCH 107/267] Update documentation --- NAMESPACE | 1 + man/max_length_msg.Rd | 19 +++++++++++++++++++ man/variable_max_length.Rd | 17 +++++++++++++++++ man/xportr_length.Rd | 16 ++++++++++++---- 4 files changed, 49 insertions(+), 4 deletions(-) create mode 100644 man/max_length_msg.Rd create mode 100644 man/variable_max_length.Rd diff --git a/NAMESPACE b/NAMESPACE index d2f10378..c8cc4e25 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,7 @@ export(length_log) export(type_log) export(var_names_log) export(var_ord_msg) +export(variable_max_length) export(xportr_df_label) export(xportr_format) export(xportr_label) diff --git a/man/max_length_msg.Rd b/man/max_length_msg.Rd new file mode 100644 index 00000000..85bd35a7 --- /dev/null +++ b/man/max_length_msg.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/messages.R +\name{max_length_msg} +\alias{max_length_msg} +\title{Utility for data Lengths} +\usage{ +max_length_msg(max_length, verbose) +} +\arguments{ +\item{max_length}{Dataframe with data and metadata length} + +\item{verbose}{Provides additional messaging for user} +} +\value{ +Output to Console +} +\description{ +Utility for data Lengths +} diff --git a/man/variable_max_length.Rd b/man/variable_max_length.Rd new file mode 100644 index 00000000..3c478d7c --- /dev/null +++ b/man/variable_max_length.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils-xportr.R +\name{variable_max_length} +\alias{variable_max_length} +\title{Calculate the maximum length of variables} +\usage{ +variable_max_length(.df) +} +\arguments{ +\item{.df}{A data frame of CDISC standard.} +} +\value{ +Returns a dataframe with variables and their maximum length +} +\description{ +Function to calculate the maximum length of variables in a given dataframe +} diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index 89fb5703..513f0496 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -8,6 +8,7 @@ xportr_length( .df, metadata = NULL, domain = NULL, + length = "metadata", verbose = getOption("xportr.length_verbose", "none"), metacore = deprecated() ) @@ -22,6 +23,13 @@ xportr_length( the metadata object. If none is passed, then name of the dataset passed as .df will be used.} +\item{length}{Choose the assigned length from either metadata or data. + +If \code{"metadata"} is specified, the assigned length is from the metadata length. +If \code{"data"} is specified, the assigned length is determined by the calculated maximum data length. + +\emph{Permitted Values}: \code{"metadata"}, \code{"data"}} + \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for details. Options are 'stop', 'warn', 'message', and 'none'} @@ -33,10 +41,10 @@ metadata now renamed with \code{metadata}} Data frame with \code{SASlength} attributes for each variable. } \description{ -Assigns SAS length from a metadata object to a given data frame. If a -length isn't present for a variable the length value is set to 200 for -character columns, and 8 for non-character columns. This value is stored in -the 'width' attribute of the column. +Assigns the SAS length to a specified data frame, either from a metadata object +or based on the calculated maximum data length. If a length isn't present for +a variable the length value is set to 200 for character columns, and 8 +for non-character columns. This value is stored in the 'width' attribute of the column. } \section{Messaging}{ \code{length_log} is the primary messaging tool for From 2cd4a6fadb6914c55d6da90c547bbd94d21e7062 Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 10 Jan 2024 04:12:08 -0500 Subject: [PATCH 108/267] Update style --- R/length.R | 2 +- R/messages.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/length.R b/R/length.R index bbf08207..b9699b41 100644 --- a/R/length.R +++ b/R/length.R @@ -131,7 +131,7 @@ xportr_length <- function(.df, } # Assign length from data - if (length == "data"){ + if (length == "data") { var_length_max <- variable_max_length(.df) length_data <- var_length_max[[variable_length]] diff --git a/R/messages.R b/R/messages.R index 6a2b417f..8dfce082 100644 --- a/R/messages.R +++ b/R/messages.R @@ -182,7 +182,7 @@ max_length_msg <- function(max_length, verbose) { xportr_logger( glue( - "{format(max_length[[1]], width = 8)} has a length of {format(as.character(max_length[[2]]), width = 3)} and a length of {format(as.character(max_length[[3]]), width = 3)} in metadata" + "{format(max_length[[1]], width = 8)} has a length of {format(as.character(max_length[[2]]), width = 3)} and a length of {format(as.character(max_length[[3]]), width = 3)} in metadata" ), type = verbose ) From e796810e8dd93898b499b7538deada44c5966d16 Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 10 Jan 2024 04:22:00 -0500 Subject: [PATCH 109/267] Update style --- R/length.R | 2 +- R/messages.R | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/R/length.R b/R/length.R index b9699b41..21436adc 100644 --- a/R/length.R +++ b/R/length.R @@ -117,7 +117,7 @@ xportr_length <- function(.df, length_log(miss_vars, verbose) - if (length == "metadata"){ + if (length == "metadata") { length_metadata <- metadata[[variable_length]] names(length_metadata) <- metadata[[variable_name]] diff --git a/R/messages.R b/R/messages.R index 8dfce082..e5fea57b 100644 --- a/R/messages.R +++ b/R/messages.R @@ -182,7 +182,8 @@ max_length_msg <- function(max_length, verbose) { xportr_logger( glue( - "{format(max_length[[1]], width = 8)} has a length of {format(as.character(max_length[[2]]), width = 3)} and a length of {format(as.character(max_length[[3]]), width = 3)} in metadata" + "{format(max_length[[1]], width = 8)} has a length of {format(as.character(max_length[[2]]), width = 3)}", + " and a length of {format(as.character(max_length[[3]]), width = 3)} in metadata" ), type = verbose ) From ce0b5e4389a3963c5fdfd1bcfa08e3669d0fccae Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 10 Jan 2024 06:10:03 -0500 Subject: [PATCH 110/267] Add test for date coercion to character --- tests/testthat/test-type.R | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index c593fdb1..5f2a54d5 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -300,3 +300,38 @@ test_that("xportr_type: Drops factor levels", { expect_null(attributes(df2$Val)) }) + + +df <- data.frame( + STUDYID = c("PILOT01", "PILOT01", "PILOT01"), + USUBJID = c("01-1130", "01-1133", "01-1133"), + TRTEDT = c("2014-08-16", "2013-04-28", "2013-01-12") +) %>% + mutate( + TRTEDT = as.Date(TRTEDT), + EXSTDTC = TRTEDT + ) + +metadata <- data.frame( + dataset = c("df", "df", "df", "df"), + variable = c("STUDYID", "USUBJID", "TRTEDT", "EXSTDTC"), + type = c("character", "character", "numeric", "date"), + format = c(NA, NA, "DATE9.", NA) +) + +test_that("xportr_metadata: Var date types (--DTC) coerced as expected and raise messages", { + # Remove empty lines in cli theme + local_cli_theme() + + ( + df2 <- xportr_metadata(df, metadata) %>% + xportr_type() + ) %>% + expect_message("Variable type mismatches found.") %>% + expect_message("[0-9+] variables coerced") + + expect_equal(purrr::map_chr(df2, class), c( + STUDYID = "character", USUBJID = "character", + TRTEDT = "Date", EXSTDTC = "character" + )) +}) From 466d7efe8c18e0444d68055ca26f22786f1edf2e Mon Sep 17 00:00:00 2001 From: elimillera Date: Wed, 10 Jan 2024 17:15:58 +0000 Subject: [PATCH 111/267] Remove function and update xportr_metadata to allow for domain setting --- NAMESPACE | 1 - R/length.R | 5 ++--- R/metadata.R | 32 +++++++++----------------------- R/support-test.R | 2 +- _pkgdown.yml | 1 - man/metadata.Rd | 24 ++++++++---------------- man/xportr_df_label.Rd | 5 ++--- man/xportr_format.Rd | 5 ++--- man/xportr_label.Rd | 5 ++--- man/xportr_length.Rd | 5 ++--- man/xportr_order.Rd | 5 ++--- man/xportr_type.Rd | 5 ++--- man/xportr_write.Rd | 5 ++--- tests/testthat/test-length.R | 2 +- tests/testthat/test-metadata.R | 4 ++-- tests/testthat/test-order.R | 2 +- tests/testthat/test-type.R | 4 ++-- 17 files changed, 40 insertions(+), 72 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index dd495905..d2f10378 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,7 +6,6 @@ export(type_log) export(var_names_log) export(var_ord_msg) export(xportr_df_label) -export(xportr_domain_name) export(xportr_format) export(xportr_label) export(xportr_length) diff --git a/R/length.R b/R/length.R index 3039218f..21ea95d4 100644 --- a/R/length.R +++ b/R/length.R @@ -9,9 +9,8 @@ #' @param metadata A data frame containing variable level metadata. See #' 'Metadata' section for details. #' @param domain Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -#' the metadata object. If none is passed, then [xportr_domain_name()] or -#' [xportr_metadata()] must be called before hand to set the domain as an -#' attribute of `.df`. +#' the metadata object. If none is passed, then [xportr_metadata()] must be +#' called before hand to set the domain as an attribute of `.df`. #' @param verbose The action this function takes when an action is taken on the #' dataset or function validation finds an issue. See 'Messaging' section for #' details. Options are 'stop', 'warn', 'message', and 'none' diff --git a/R/metadata.R b/R/metadata.R index 2db7d1b5..df206ef2 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -1,9 +1,10 @@ #' Set variable specifications and domain #' -#' Sets metadata for a dataset in a way that can be accessed by other xportr -#' functions. If used at the start of an xportr pipeline, it removes the need to -#' set metadata and domain at each step individually. For details on the format -#' of the metadata, see the 'Metadata' section for each function in question. +#' Sets metadata and/or domain for a dataset in a way that can be accessed by +#' other xportr functions. If used at the start of an xportr pipeline, it +#' removes the need to set metadata and domain at each step individually. For +#' details on the format of the metadata, see the 'Metadata' section for each +#' function in question. #' #' @inheritParams xportr_length #' @@ -35,12 +36,14 @@ #' library(magrittr) #' #' adlb %>% -#' xportr_domain_name("adlb") %>% #' xportr_metadata(metadata, "test") %>% #' xportr_type() %>% #' xportr_order() #' } -xportr_metadata <- function(.df, metadata, domain = NULL) { +xportr_metadata <- function(.df, metadata = NULL, domain = NULL) { + if (is.null(metadata) && is.null(domain)) { + stop("Must provide either metadata or domain argument") + } ## Common section to detect domain from argument or attribute domain <- get_domain(.df, domain) @@ -50,20 +53,3 @@ xportr_metadata <- function(.df, metadata, domain = NULL) { structure(.df, `_xportr.df_metadata_` = metadata) } - - -#' Update Metadata Domain Name -#' -#' Similar to `xportr_metadata()`, but just adds the domain and not the metadata. -#' -#' @inheritParams xportr_length -#' -#' @return `.df` dataset with domain argument set -#' @export -#' -#' @rdname metadata -xportr_domain_name <- function(.df, domain) { - attr(.df, "_xportr.df_arg_") <- domain - - .df -} diff --git a/R/support-test.R b/R/support-test.R index b81fba3d..d223a6d6 100644 --- a/R/support-test.R +++ b/R/support-test.R @@ -180,7 +180,7 @@ multiple_vars_in_spec_helper2 <- function(FUN) { local_cli_theme() adsl %>% - xportr_domain_name("adsl") %>% + xportr_metadata(domain = "adsl") %>% FUN(metadata) %>% testthat::expect_no_message(message = "There are multiple specs for the same variable name") } diff --git a/_pkgdown.yml b/_pkgdown.yml index 8082901f..dbeae1cc 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -32,7 +32,6 @@ reference: - xportr_order - xportr_df_label - xportr_metadata - - xportr_domain_name - title: xportr helper functions desc: Utility functions called within core xportr functions diff --git a/man/metadata.Rd b/man/metadata.Rd index f3c497de..658fe0a4 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -2,12 +2,9 @@ % Please edit documentation in R/metadata.R \name{xportr_metadata} \alias{xportr_metadata} -\alias{xportr_domain_name} \title{Set variable specifications and domain} \usage{ -xportr_metadata(.df, metadata, domain = NULL) - -xportr_domain_name(.df, domain) +xportr_metadata(.df, metadata = NULL, domain = NULL) } \arguments{ \item{.df}{A data frame of CDISC standard.} @@ -16,22 +13,18 @@ xportr_domain_name(.df, domain) 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or -\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an -attribute of \code{.df}.} +the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be +called before hand to set the domain as an attribute of \code{.df}.} } \value{ \code{.df} dataset with metadata and domain attributes set - -\code{.df} dataset with domain argument set } \description{ -Sets metadata for a dataset in a way that can be accessed by other xportr -functions. If used at the start of an xportr pipeline, it removes the need to -set metadata and domain at each step individually. For details on the format -of the metadata, see the 'Metadata' section for each function in question. - -Similar to \code{xportr_metadata()}, but just adds the domain and not the metadata. +Sets metadata and/or domain for a dataset in a way that can be accessed by +other xportr functions. If used at the start of an xportr pipeline, it +removes the need to set metadata and domain at each step individually. For +details on the format of the metadata, see the 'Metadata' section for each +function in question. } \examples{ @@ -56,7 +49,6 @@ if (rlang::is_installed("magrittr")) { library(magrittr) adlb \%>\% - xportr_domain_name("adlb") \%>\% xportr_metadata(metadata, "test") \%>\% xportr_type() \%>\% xportr_order() diff --git a/man/xportr_df_label.Rd b/man/xportr_df_label.Rd index 6d4764b4..363c59c4 100644 --- a/man/xportr_df_label.Rd +++ b/man/xportr_df_label.Rd @@ -13,9 +13,8 @@ xportr_df_label(.df, metadata = NULL, domain = NULL, metacore = deprecated()) details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or -\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an -attribute of \code{.df}.} +the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be +called before hand to set the domain as an attribute of \code{.df}.} \item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass metadata now renamed with \code{metadata}} diff --git a/man/xportr_format.Rd b/man/xportr_format.Rd index b7825fc4..059fe168 100644 --- a/man/xportr_format.Rd +++ b/man/xportr_format.Rd @@ -13,9 +13,8 @@ xportr_format(.df, metadata = NULL, domain = NULL, metacore = deprecated()) 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or -\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an -attribute of \code{.df}.} +the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be +called before hand to set the domain as an attribute of \code{.df}.} \item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass metadata now renamed with \code{metadata}} diff --git a/man/xportr_label.Rd b/man/xportr_label.Rd index 87d648da..6af7ad9a 100644 --- a/man/xportr_label.Rd +++ b/man/xportr_label.Rd @@ -19,9 +19,8 @@ xportr_label( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or -\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an -attribute of \code{.df}.} +the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be +called before hand to set the domain as an attribute of \code{.df}.} \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index 1d5100df..b7f3e818 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -19,9 +19,8 @@ xportr_length( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or -\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an -attribute of \code{.df}.} +the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be +called before hand to set the domain as an attribute of \code{.df}.} \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for diff --git a/man/xportr_order.Rd b/man/xportr_order.Rd index 72bda30d..de8ec9cd 100644 --- a/man/xportr_order.Rd +++ b/man/xportr_order.Rd @@ -19,9 +19,8 @@ xportr_order( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or -\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an -attribute of \code{.df}.} +the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be +called before hand to set the domain as an attribute of \code{.df}.} \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index 3c67c4c7..440cf535 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -19,9 +19,8 @@ xportr_type( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or -\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an -attribute of \code{.df}.} +the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be +called before hand to set the domain as an attribute of \code{.df}.} \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for diff --git a/man/xportr_write.Rd b/man/xportr_write.Rd index 9ecbd3a4..31c91c1e 100644 --- a/man/xportr_write.Rd +++ b/man/xportr_write.Rd @@ -23,9 +23,8 @@ used as \code{xpt} name.} 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or -\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an -attribute of \code{.df}.} +the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be +called before hand to set the domain as an attribute of \code{.df}.} \item{strict_checks}{If TRUE, xpt validation will report errors and not write out the dataset. If FALSE, xpt validation will report warnings and continue diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index 7fa87f53..e3adce3f 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -14,7 +14,7 @@ test_that("xportr_length: Accepts valid domain names in metadata object", { # Test minimal call with valid data and without domain adsl %>% - xportr_domain_name("adsl") %>% + xportr_metadata(domain = "adsl") %>% xportr_length(metadata) %>% expect_silent() %>% expect_attr_width(metadata$length) diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index b3041018..fc4a3b74 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -178,7 +178,7 @@ test_that("xportr_df_label: Correctly applies label when data is piped", { df_meta <- data.frame(dataset = "df", label = "Label") df_spec_labeled_df <- df %>% - xportr_domain_name("df") %>% + xportr_metadata(domain = "df") %>% xportr_df_label(df_meta) %>% xportr_df_label(df_meta) @@ -621,7 +621,7 @@ test_that("xportr_*: Domain is kept in between calls", { ) df2 <- adsl %>% - xportr_domain_name("adsl") %>% + xportr_metadata(domain = "adsl") %>% xportr_type(metadata) df3 <- df2 %>% diff --git a/tests/testthat/test-order.R b/tests/testthat/test-order.R index 3450ba10..1c68feef 100644 --- a/tests/testthat/test-order.R +++ b/tests/testthat/test-order.R @@ -21,7 +21,7 @@ test_that("xportr_order: Variable are ordered correctly when data is piped", { ordered_df <- suppressMessages( df %>% - xportr_domain_name("df") %>% + xportr_metadata(domain = "df") %>% xportr_order(df_meta) %>% xportr_order(df_meta) ) diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index f53271cc..aa31baf1 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -155,14 +155,14 @@ test_that("xportr_type: Variables retain column attributes, besides class", { withr::local_message_sink(tempfile()) df_type_label <- adsl %>% - xportr_domain_name("adsl") %>% + xportr_metadata(domain = "adsl") %>% xportr_type(metadata) %>% xportr_label(metadata) %>% xportr_length(metadata) %>% xportr_format(metadata) df_label_type <- adsl %>% - xportr_domain_name("adsl") %>% + xportr_metadata(domain = "adsl") %>% xportr_label(metadata) %>% xportr_length(metadata) %>% xportr_format(metadata) %>% From 0dc0a83fcadd3accab96d0300a9e5599f8373238 Mon Sep 17 00:00:00 2001 From: EeethB Date: Wed, 10 Jan 2024 17:37:00 -0600 Subject: [PATCH 112/267] Correct typo in `xportr()` to pass test --- R/xportr.R | 2 +- tests/testthat/test-xportr.R | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/R/xportr.R b/R/xportr.R index b0573c68..841c2d79 100644 --- a/R/xportr.R +++ b/R/xportr.R @@ -70,6 +70,6 @@ xportr <- function(.df, xportr_label() %>% xportr_order() %>% xportr_format() %>% - xportr_df_label(dataset_spec) %>% + xportr_df_label(df_metadata) %>% xportr_write(path) } diff --git a/tests/testthat/test-xportr.R b/tests/testthat/test-xportr.R index eb43c244..a6c81e8a 100644 --- a/tests/testthat/test-xportr.R +++ b/tests/testthat/test-xportr.R @@ -34,7 +34,8 @@ test_that("pipeline results match `xportr()` results", { xportr_write(pipeline_path) # `xportr()` can be used to apply a whole pipeline at once - xportr_df <- xportr(adsl, + xportr_df <- xportr( + adsl, var_metadata = var_spec, df_metadata = dataset_spec, domain = "ADSL", From 88b0c5e3b8d9cc57dbeb9aec1f50ff3803c8a053 Mon Sep 17 00:00:00 2001 From: EeethB Date: Wed, 10 Jan 2024 17:49:14 -0600 Subject: [PATCH 113/267] Document --- man/metadata.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/metadata.Rd b/man/metadata.Rd index f89f9993..da5de14c 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -4,7 +4,7 @@ \alias{xportr_metadata} \title{Set variable specifications and domain} \usage{ -xportr_metadata(.df, metadata, domain = NULL, verbose = NULL) +xportr_metadata(.df, metadata = NULL, domain = NULL, verbose = NULL) } \arguments{ \item{.df}{A data frame of CDISC standard.} From 226f4344231a7bcfc0f8cf2b7704625b358d10dc Mon Sep 17 00:00:00 2001 From: EeethB Date: Thu, 11 Jan 2024 09:56:51 -0600 Subject: [PATCH 114/267] Update xportr() example to use internal data --- NEWS.md | 2 ++ R/xportr.R | 39 +++++++++++++++++------------------- man/xportr.Rd | 39 +++++++++++++++++------------------- tests/testthat/test-xportr.R | 33 ++++++++++-------------------- 4 files changed, 49 insertions(+), 64 deletions(-) diff --git a/NEWS.md b/NEWS.md index 217c5099..1d34c14f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,6 +11,8 @@ * All `xportr` functions now have `verbose = NULL` as the default. If left `NULL`, the previous default of `getOption("xportr.[fn_name]_verbose")` is used (#151) +* All core functions can be run together by using new function `xportr()` (#137) + ## Documentation ## Deprecation and Breaking Changes diff --git a/R/xportr.R b/R/xportr.R index 841c2d79..3d25f00b 100644 --- a/R/xportr.R +++ b/R/xportr.R @@ -20,40 +20,37 @@ #' #' @examples #' -#' has_pkgs <- requireNamespace("admiral", quietly = TRUE) && -#' requireNamespace("dplyr", quietly = TRUE) && -#' requireNamespace("readxl", quietly = TRUE) && -#' requireNamespace("rlang", quietly = TRUE) +#' if (require(magrittr, quietly = TRUE)) { #' -#' if (has_pkgs) { -#' adsl <- admiral::admiral_adsl +#' test_dir <- tempdir() #' -#' spec_path <- system.file(paste0("specs/", "ADaM_admiral_spec.xlsx"), package = "xportr") +#' pipeline_path <- file.path(test_dir, "adslpipe.xpt") +#' xportr_path <- file.path(test_dir, "adslxptr.xpt") #' -#' var_spec <- readxl::read_xlsx(spec_path, sheet = "Variables") %>% -#' dplyr::rename(type = "Data Type") %>% -#' rlang::set_names(tolower) -#' dataset_spec <- readxl::read_xlsx(spec_path, sheet = "Datasets") %>% -#' dplyr::rename(label = "Description") %>% -#' rlang::set_names(tolower) +#' dataset_spec_low <- setNames(dataset_spec, tolower(names(dataset_spec))) +#' names(dataset_spec_low)[[2]] <- "label" +#' +#' var_spec_low <- setNames(var_spec, tolower(names(var_spec))) +#' names(var_spec_low)[[5]] <- "type" #' #' adsl %>% -#' xportr_metadata(var_spec, "ADSL", verbose = "warn") %>% +#' xportr_metadata(var_spec_low, "ADSL", verbose = "none") %>% #' xportr_type() %>% #' xportr_length() %>% #' xportr_label() %>% #' xportr_order() %>% #' xportr_format() %>% -#' xportr_df_label(dataset_spec) %>% -#' xportr_write("adsl.xpt") +#' xportr_df_label(dataset_spec_low) %>% +#' xportr_write(pipeline_path) #' #' # `xportr()` can be used to apply a whole pipeline at once -#' xportr(adsl, -#' var_metadata = var_spec, -#' df_metadata = dataset_spec, +#' xportr( +#' adsl, +#' var_metadata = var_spec_low, +#' df_metadata = dataset_spec_low, #' domain = "ADSL", -#' verbose = "warn", -#' path = "adsl.xpt" +#' verbose = "none", +#' path = xportr_path #' ) #' } xportr <- function(.df, diff --git a/man/xportr.Rd b/man/xportr.Rd index 47da1537..fcded870 100644 --- a/man/xportr.Rd +++ b/man/xportr.Rd @@ -44,40 +44,37 @@ Wrapper to apply all core xportr functions and write xpt } \examples{ -has_pkgs <- requireNamespace("admiral", quietly = TRUE) && - requireNamespace("dplyr", quietly = TRUE) && - requireNamespace("readxl", quietly = TRUE) && - requireNamespace("rlang", quietly = TRUE) +if (require(magrittr, quietly = TRUE)) { -if (has_pkgs) { - adsl <- admiral::admiral_adsl + test_dir <- tempdir() - spec_path <- system.file(paste0("specs/", "ADaM_admiral_spec.xlsx"), package = "xportr") + pipeline_path <- file.path(test_dir, "adslpipe.xpt") + xportr_path <- file.path(test_dir, "adslxptr.xpt") - var_spec <- readxl::read_xlsx(spec_path, sheet = "Variables") \%>\% - dplyr::rename(type = "Data Type") \%>\% - rlang::set_names(tolower) - dataset_spec <- readxl::read_xlsx(spec_path, sheet = "Datasets") \%>\% - dplyr::rename(label = "Description") \%>\% - rlang::set_names(tolower) + dataset_spec_low <- setNames(dataset_spec, tolower(names(dataset_spec))) + names(dataset_spec_low)[[2]] <- "label" + + var_spec_low <- setNames(var_spec, tolower(names(var_spec))) + names(var_spec_low)[[5]] <- "type" adsl \%>\% - xportr_metadata(var_spec, "ADSL", verbose = "warn") \%>\% + xportr_metadata(var_spec_low, "ADSL", verbose = "none") \%>\% xportr_type() \%>\% xportr_length() \%>\% xportr_label() \%>\% xportr_order() \%>\% xportr_format() \%>\% - xportr_df_label(dataset_spec) \%>\% - xportr_write("adsl.xpt") + xportr_df_label(dataset_spec_low) \%>\% + xportr_write(pipeline_path) # `xportr()` can be used to apply a whole pipeline at once - xportr(adsl, - var_metadata = var_spec, - df_metadata = dataset_spec, + xportr( + adsl, + var_metadata = var_spec_low, + df_metadata = dataset_spec_low, domain = "ADSL", - verbose = "warn", - path = "adsl.xpt" + verbose = "none", + path = xportr_path ) } } diff --git a/tests/testthat/test-xportr.R b/tests/testthat/test-xportr.R index a6c81e8a..908dc03e 100644 --- a/tests/testthat/test-xportr.R +++ b/tests/testthat/test-xportr.R @@ -1,43 +1,32 @@ test_that("pipeline results match `xportr()` results", { - has_pkgs <- requireNamespace("admiral", quietly = TRUE) && - requireNamespace("dplyr", quietly = TRUE) && - requireNamespace("readxl", quietly = TRUE) && - requireNamespace("rlang", quietly = TRUE) - - if (has_pkgs) { - adsl <- admiral::admiral_adsl - - spec_path <- system.file(paste0("specs/", "ADaM_admiral_spec.xlsx"), - package = "xportr" - ) - - var_spec <- readxl::read_xlsx(spec_path, sheet = "Variables") %>% - dplyr::rename(type = "Data Type") %>% - rlang::set_names(tolower) - dataset_spec <- readxl::read_xlsx(spec_path, sheet = "Datasets") %>% - dplyr::rename(label = "Description") %>% - rlang::set_names(tolower) + if (require(magrittr, quietly = TRUE)) { test_dir <- tempdir() pipeline_path <- file.path(test_dir, "adslpipe.xpt") xportr_path <- file.path(test_dir, "adslxptr.xpt") + dataset_spec_low <- setNames(dataset_spec, tolower(names(dataset_spec))) + names(dataset_spec_low)[[2]] <- "label" + + var_spec_low <- setNames(var_spec, tolower(names(var_spec))) + names(var_spec_low)[[5]] <- "type" + pipeline_df <- adsl %>% - xportr_metadata(var_spec, "ADSL", verbose = "none") %>% + xportr_metadata(var_spec_low, "ADSL", verbose = "none") %>% xportr_type() %>% xportr_length() %>% xportr_label() %>% xportr_order() %>% xportr_format() %>% - xportr_df_label(dataset_spec) %>% + xportr_df_label(dataset_spec_low) %>% xportr_write(pipeline_path) # `xportr()` can be used to apply a whole pipeline at once xportr_df <- xportr( adsl, - var_metadata = var_spec, - df_metadata = dataset_spec, + var_metadata = var_spec_low, + df_metadata = dataset_spec_low, domain = "ADSL", verbose = "none", path = xportr_path From 517c84a2c5aef0df470ff85939c47cbebd74ebea Mon Sep 17 00:00:00 2001 From: EeethB Date: Thu, 11 Jan 2024 09:57:08 -0600 Subject: [PATCH 115/267] Style --- R/xportr.R | 1 - tests/testthat/test-xportr.R | 1 - 2 files changed, 2 deletions(-) diff --git a/R/xportr.R b/R/xportr.R index 3d25f00b..8ac85a71 100644 --- a/R/xportr.R +++ b/R/xportr.R @@ -21,7 +21,6 @@ #' @examples #' #' if (require(magrittr, quietly = TRUE)) { -#' #' test_dir <- tempdir() #' #' pipeline_path <- file.path(test_dir, "adslpipe.xpt") diff --git a/tests/testthat/test-xportr.R b/tests/testthat/test-xportr.R index 908dc03e..6711a668 100644 --- a/tests/testthat/test-xportr.R +++ b/tests/testthat/test-xportr.R @@ -1,6 +1,5 @@ test_that("pipeline results match `xportr()` results", { if (require(magrittr, quietly = TRUE)) { - test_dir <- tempdir() pipeline_path <- file.path(test_dir, "adslpipe.xpt") From e8831219b989c1eaeb27b6542491916f0f4c5084 Mon Sep 17 00:00:00 2001 From: EeethB Date: Thu, 11 Jan 2024 10:28:15 -0600 Subject: [PATCH 116/267] Add `xportr()` to pkgdown reference --- _pkgdown.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index dbeae1cc..2c2184eb 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -32,6 +32,7 @@ reference: - xportr_order - xportr_df_label - xportr_metadata + - xportr - title: xportr helper functions desc: Utility functions called within core xportr functions From 12d7c1de40168bc00403e0141f74324f4415dbd4 Mon Sep 17 00:00:00 2001 From: sadchla-codes Date: Thu, 11 Jan 2024 11:45:21 -0500 Subject: [PATCH 117/267] Closes #136 removing used SASlength from functions --- R/utils-xportr.R | 4 ++-- R/write.R | 2 -- inst/WORDLIST | 1 - man/xportr_write.Rd | 1 - 4 files changed, 2 insertions(+), 6 deletions(-) diff --git a/R/utils-xportr.R b/R/utils-xportr.R index feb31195..f1596b78 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -1,11 +1,11 @@ #' Extract Attribute From Data #' #' @param data Dataset to be exported as xpt file -#' @param attr SAS attributes such as label, format, type, length +#' @param attr SAS attributes such as label, format, type #' #' @return Character vector of attributes with column names assigned #' @noRd -extract_attr <- function(data, attr = c("label", "format.sas", "SAStype", "SASlength")) { +extract_attr <- function(data, attr = c("label", "format.sas", "SAStype")) { attr <- match.arg(attr) out <- lapply(data, function(.x) attr(.x, attr)) out <- vapply(out, diff --git a/R/write.R b/R/write.R index 0dd13541..c53afb96 100644 --- a/R/write.R +++ b/R/write.R @@ -17,8 +17,6 @@ #' @details #' * Variable and dataset labels are stored in the "label" attribute. #' -#' * SAS length are stored in the "SASlength" attribute. -#' #' * SAS format are stored in the "SASformat" attribute. #' #' * SAS type are stored in the "SAStype" attribute. diff --git a/inst/WORDLIST b/inst/WORDLIST index 494ba288..a0d3ae8d 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -19,7 +19,6 @@ PHUSE Pharma Repostiory SASformat -SASlength SAStype SDSP SDTM diff --git a/man/xportr_write.Rd b/man/xportr_write.Rd index b59e61bd..d28b1fbc 100644 --- a/man/xportr_write.Rd +++ b/man/xportr_write.Rd @@ -44,7 +44,6 @@ to the FDA. \details{ \itemize{ \item Variable and dataset labels are stored in the "label" attribute. -\item SAS length are stored in the "SASlength" attribute. \item SAS format are stored in the "SASformat" attribute. \item SAS type are stored in the "SAStype" attribute. } From 1f50d9b4a88638b38c8528c944ba58493228f26d Mon Sep 17 00:00:00 2001 From: Celine Date: Fri, 12 Jan 2024 02:57:27 -0500 Subject: [PATCH 118/267] Update test-length for datetime variables --- tests/testthat/test-length.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index 35761d84..91ecb38f 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -198,8 +198,8 @@ test_that("xportr_length: Column length of known/unkown character types is 200/8 expect_equal(impute_length(123), 8) expect_equal(impute_length(123L), 8) expect_equal(impute_length("string"), 200) - expect_equal(impute_length(Sys.Date()), 200) - expect_equal(impute_length(Sys.time()), 200) + expect_equal(impute_length(Sys.Date()), 8) + expect_equal(impute_length(Sys.time()), 8) withr::local_options(list(xportr.character_types = c("character", "date"))) expect_equal(impute_length(Sys.time()), 8) From 9625a773a799217de20cf9dfcbd22fa1efaf7e9c Mon Sep 17 00:00:00 2001 From: Celine Date: Fri, 12 Jan 2024 04:45:13 -0500 Subject: [PATCH 119/267] Remove format from type --- R/type.R | 18 ++++++------------ man/xportr_type.Rd | 6 +----- 2 files changed, 7 insertions(+), 17 deletions(-) diff --git a/R/type.R b/R/type.R index 65d8ec40..34ab1dfc 100644 --- a/R/type.R +++ b/R/type.R @@ -36,24 +36,20 @@ #' "dataset". This is the column subset by the 'domain' argument in the #' function. #' -#' 2) Format Name - passed as the 'xportr.format_name' option. Default: -#' "format". Character values to update the 'format.sas' attribute of the -#' column. This is passed to `haven::write` to note the format. -#' -#' 3) Variable Name - passed as the 'xportr.variable_name' option. Default: +#' 2) Variable Name - passed as the 'xportr.variable_name' option. Default: #' "variable". This is used to match columns in '.df' argument and the #' metadata. #' -#' 4) Variable Type - passed as the 'xportr.type_name'. Default: "type". This +#' 3) Variable Type - passed as the 'xportr.type_name'. Default: "type". This #' is used to note the XPT variable "type" options are numeric or character. #' -#' 5) (Option only) Character Types - The list of classes that should be +#' 4) (Option only) Character Types - The list of classes that should be #' explicitly coerced to a XPT Character type. Default: c( "character", #' "char", "text", "date", "posixct", "posixt", "datetime", "time", #' "partialdate", "partialtime", "partialdatetime", "incompletedatetime", #' "durationdatetime", "intervaldatetime") #' -#' 6) (Option only) Numeric Types - The list of classes that should be +#' 5) (Option only) Numeric Types - The list of classes that should be #' explicitly coerced to a XPT numeric type. Default: c("integer", "numeric", #' "num", "float") #' @@ -64,8 +60,7 @@ #' metadata <- data.frame( #' dataset = "test", #' variable = c("Subj", "Param", "Val", "NotUsed"), -#' type = c("numeric", "character", "numeric", "character"), -#' format = NA +#' type = c("numeric", "character", "numeric", "character") #' ) #' #' .df <- data.frame( @@ -96,7 +91,6 @@ xportr_type <- function(.df, characterMetadataTypes <- c(getOption("xportr.character_metadata_types"), "_character") numericMetadataTypes <- c(getOption("xportr.numeric_metadata_types"), "_numeric") numericTypes <- c(getOption("xportr.numeric_types"), "_numeric") - format_name <- getOption("xportr.format_name") ## Common section to detect domain from argument or pipes @@ -121,7 +115,7 @@ xportr_type <- function(.df, } metacore <- metadata %>% - select(!!sym(variable_name), !!sym(type_name), !!sym(format_name)) + select(!!sym(variable_name), !!sym(type_name)) # Common check for multiple variables name check_multiple_var_specs(metadata, variable_name) diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index abfa41d8..1a49735b 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -70,9 +70,6 @@ For data.frame 'metadata' arguments four columns must be present: \item Domain Name - passed as the 'xportr.domain_name' option. Default: "dataset". This is the column subset by the 'domain' argument in the function. -\item Format Name - passed as the 'xportr.format_name' option. Default: -"format". Character values to update the 'format.sas' attribute of the -column. This is passed to \code{haven::write} to note the format. \item Variable Name - passed as the 'xportr.variable_name' option. Default: "variable". This is used to match columns in '.df' argument and the metadata. @@ -93,8 +90,7 @@ explicitly coerced to a XPT numeric type. Default: c("integer", "numeric", metadata <- data.frame( dataset = "test", variable = c("Subj", "Param", "Val", "NotUsed"), - type = c("numeric", "character", "numeric", "character"), - format = NA + type = c("numeric", "character", "numeric", "character") ) .df <- data.frame( From d3a425bd6d82e11757f9d0d55d64981e62def39c Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 16 Jan 2024 19:37:02 +0530 Subject: [PATCH 120/267] fix: fix the broken tests + add tests & docs --- R/xportr-options.R | 67 +++++++++++++++++++++------------ R/xportr-package.R | 8 ++-- R/zzz.R | 50 ++++++++++++------------ _pkgdown.yml | 1 + man/xportr-package.Rd | 8 ++-- man/xportr_options.Rd | 71 +++++++++++++++++++---------------- man/xportr_options_list.Rd | 16 ++++++++ tests/testthat/test-options.R | 30 +++++++++++++++ 8 files changed, 162 insertions(+), 89 deletions(-) create mode 100644 man/xportr_options_list.Rd diff --git a/R/xportr-options.R b/R/xportr-options.R index 349eb2b4..a28df989 100644 --- a/R/xportr-options.R +++ b/R/xportr-options.R @@ -15,44 +15,61 @@ #' @section Options with `options()`: #' #' \describe{ -#' \item{xportr.df_domain_name (defaults to `"dataset"`)}{Description about this option ...} -#' \item{xportr.df_label (defaults to `"label"`)}{Description about this option ...} -#' \item{xportr.domain_name (defaults to `"dataset"`)}{Description about this option ...} -#' \item{xportr.variable_name (defaults to `"variable"`)}{Description about this option ...} -#' \item{xportr.type_name (defaults to `"type"`)}{Description about this option ...} -#' \item{xportr.label (defaults to `"label"`)}{Description about this option ...} -#' \item{xportr.length (defaults to `"length"`)}{Description about this option ...} -#' \item{xportr.format_name (defaults to `"format"`)}{Description about this option ...} -#' \item{xportr.format_verbose (defaults to `"none"`)}{Description about this option ...} -#' \item{xportr.label_verbose (defaults to `"none"`)}{Description about this option ...} -#' \item{xportr.length_verbose (defaults to `"none"`)}{Description about this option ...} -#' \item{xportr.type_verbose (defaults to `"label"`)}{Description about this option ...} -#' \item{xportr.character_types (defaults to `c("character", "char", "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", "partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", "intervaldatetime")`)}{Description about this option ...} # nolint -#' \item{xportr.numeric_types (defaults to `c("integer", "numeric", "num", "float")`)}{Description about this option ...} # nolint -#' \item{xportr.order_name (defaults to `"order"`)}{Description about this option ...} -#' +#' \item{xportr.df_domain_name} {defaults to `"dataset"`}: +#' The name of the domain "name" column in dataset metadata. +#' \item{xportr.df_label} {defaults to `"label"`}: +#' The column noting the dataset label in dataset metadata. +#' \item{xportr.domain_name} {defaults to `"dataset"`}: +#' The name of the domain "name" column in variable metadata. +#' \item{xportr.variable_name} {defaults to `"variable"`}: +#' The name of the variable "name" in variable metadata. +#' \item{xportr.type_name} {defaults to `"type"`}: +#' The name of the variable type column in variable metadata. +#' \item{xportr.label} {defaults to `"label"`}: +#' The name of the variable label column in variable metadata. +#' \item{xportr.length} {defaults to `"length"`}: +#' The name of the variable length column in variable metadata. +#' \item{xportr.order_name} {defaults to `"order"`}: +#' The name of the variable order column in variable metadata. +#' \item{xportr.format_name} {defaults to `"format"`}: +#' The name of the variable format column in variable metadata. +#' \item{xportr.format_verbose} {defaults to `"none"`}: +#' The default argument for the 'verbose' argument for `xportr_format`. +#' \item{xportr.label_verbose} {defaults to `"none"`}: +#' The default argument for the 'verbose' argument for `xportr_label`. +#' \item{xportr.length_verbose} {defaults to `"none"`}: +#' The default argument for the 'verbose' argument for `xportr_length`. +#' \item{xportr.type_verbose} {defaults to `"label"`}: +#' The default argument for the 'verbose' argument for `xportr_type`. +#' \item{xportr.character_types} {defaults to `c("character", "char", "text", "date", "posixct", "posixt", +#' "datetime", "time", "partialdate", "partialtime", "partialdatetime", +#' "incompletedatetime", "durationdatetime", "intervaldatetime")`}: +#' The default character vector used to explicitly coerce R classes to character XPT types. +#' \item{xportr.numeric_types} {defaults to `c("integer", "numeric", "num", "float")`}: +#' The default character vector used to explicitly coerce R classes to numeric XPT types. +#' } #' #' @section Options with `xportr_options()`: #' -#' There are a number of global options that affect xportr's behavior. These -#' can be set globally with `options()` or with `xportr_options()`. -#' The `xportr_options()` function also returns the current options when nothing is passed to it. +#' Alternative to the `options()`, the `xportr_options()` function can be used to set the options. +#' The `xportr_options()` function also returns the current options when a character vector of +#' the options keys are passed into it. If nothing is passed into it, it returns the state of all xportr options. #' -#' @param ... Options to set, with the form `name = value`. +#' @param ... Options to set, with the form `name = value` or a character vector of option names. #' #' @examples -#' xportr_options(xportr.df_label = "data_label", xportr.label = "custom_label") #' xportr_options("xportr.df_label") +#' xportr_options(xportr.df_label = "data_label", xportr.label = "custom_label") #' xportr_options(c("xportr.label", "xportr.df_label")) #' xportr_options() #' @export xportr_options <- function(...) { - checkmate::assert_subset(names(list(...)), names(xportr_options)) + checkmate::assert_subset(names(list(...)), names(xportr_options_list)) if (is.null(names(list(...)))) { - if (length(list(...)) == 0) { - queried_options <- names(xportr_options) + if (length(list(...)) == 0) { + queried_options <- names(xportr_options_list) } else { - queried_options <- intersect(unlist(...), names(xportr_options)) + queried_options <- intersect(c(...), names(xportr_options_list)) } current_options <- lapply(queried_options, function(opt) { getOption(opt) diff --git a/R/xportr-package.R b/R/xportr-package.R index 197ad5be..52098b45 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -39,14 +39,14 @@ #' metadata. Default: "length" #' } #' \item{ -#' xportr.format_name - The name of the variable format column in variable -#' metadata. Default: "format" -#' } -#' \item{ #' xportr.order_name - The name of the variable order column in variable #' metadata. Default: "order" #' } #' \item{ +#' xportr.format_name - The name of the variable format column in variable +#' metadata. Default: "format" +#' } +#' \item{ #' xportr.format_verbose - The default argument for the 'verbose' argument for #' `xportr_format`. Default: "none" #' } diff --git a/R/zzz.R b/R/zzz.R index 9136e435..0ed3a1ec 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,34 +1,38 @@ #' A list with all the supported options of xportr #' #' An internal list with all the supported options of xportr with defaults -xportr_options <- list( - xportr.df_domain_name = "dataset", - xportr.df_label = "label", - xportr.domain_name = "dataset", - xportr.variable_name = "variable", - xportr.type_name = "type", - xportr.label = "label", - xportr.length = "length", - xportr.format_name = "format", - xportr.format_verbose = "none", - xportr.label_verbose = "none", - xportr.length_verbose = "none", - xportr.type_verbose = "none", - xportr.character_types = c( - "character", "char", "text", "date", "posixct", - "posixt", "datetime", "time", "partialdate", - "partialtime", "partialdatetime", - "incompletedatetime", "durationdatetime", - "intervaldatetime" +#' @keywords internal +xportr_options_list <- list( + xportr.df_domain_name = getOption("xportr.df_domain_name", "dataset"), + xportr.df_label = getOption("xportr.df_label", "label"), + xportr.domain_name = getOption("xportr.domain_name", "dataset"), + xportr.variable_name = getOption("xportr.variable_name", "variable"), + xportr.type_name = getOption("xportr.type_name", "type"), + xportr.label = getOption("xportr.label", "label"), + xportr.length = getOption("xportr.length", "length"), + xportr.order_name = getOption("xportr.order_name", "order"), + xportr.format_name = getOption("xportr.format_name", "format"), + xportr.format_verbose = getOption("xportr.format_verbose", "none"), + xportr.label_verbose = getOption("xportr.label_verbose", "none"), + xportr.length_verbose = getOption("xportr.length_verbose", "none"), + xportr.type_verbose = getOption("xportr.type_verbose", "none"), + xportr.character_types = getOption( + "xportr.character_types", + c( + "character", "char", "text", "date", "posixct", + "posixt", "datetime", "time", "partialdate", + "partialtime", "partialdatetime", + "incompletedatetime", "durationdatetime", + "intervaldatetime" + ) ), - xportr.numeric_types = c("integer", "numeric", "num", "float"), - xportr.order_name = "order" + xportr.numeric_types = getOption("xportr.numeric_types", c("integer", "numeric", "num", "float")) ) .onLoad <- function(libname, pkgname) { op <- options() - toset <- !(names(xportr_options) %in% names(op)) - if (any(toset)) options(xportr_options[toset]) + toset <- !(names(xportr_options_list) %in% names(op)) + if (any(toset)) options(xportr_options_list[toset]) invisible() } diff --git a/_pkgdown.yml b/_pkgdown.yml index dbeae1cc..4143179b 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -36,6 +36,7 @@ reference: - title: xportr helper functions desc: Utility functions called within core xportr functions - contents: + - xportr_options - label_log - length_log - type_log diff --git a/man/xportr-package.Rd b/man/xportr-package.Rd index 64eaed80..e23a276c 100644 --- a/man/xportr-package.Rd +++ b/man/xportr-package.Rd @@ -46,14 +46,14 @@ xportr.length - The name of the variable length column in variable metadata. Default: "length" } \item{ -xportr.format_name - The name of the variable format column in variable -metadata. Default: "format" -} -\item{ xportr.order_name - The name of the variable order column in variable metadata. Default: "order" } \item{ +xportr.format_name - The name of the variable format column in variable +metadata. Default: "format" +} +\item{ xportr.format_verbose - The default argument for the 'verbose' argument for \code{xportr_format}. Default: "none" } diff --git a/man/xportr_options.Rd b/man/xportr_options.Rd index 6b9703da..4cd2f4f1 100644 --- a/man/xportr_options.Rd +++ b/man/xportr_options.Rd @@ -1,21 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/xportr-options.R, R/zzz.R -\docType{data} +% Please edit documentation in R/xportr-options.R \name{xportr_options} \alias{xportr_options} \title{Get or set Xportr options} -\format{ -An object of class \code{list} of length 15. - -An object of class \code{list} of length 15. -} \usage{ -xportr_options - -xportr_options +xportr_options(...) } \arguments{ -\item{...}{Options to set, with the form \code{name = value}.} +\item{...}{Options to set, with the form \code{name = value} or a character vector of option names.} } \description{ There are two mechanisms for working with options for xportr. One is the @@ -26,42 +18,55 @@ these two mechanisms is has to do with legacy code and scoping. The \code{\link[=options]{options()}} function sets options globally, for the duration of the R process. The \code{\link[=getOption]{getOption()}} function retrieves the value of an option. All xportr related options of this type are prefixed with \code{"xportr."}. - -An internal list with all the supported options of xportr with defaults } \section{Options with \code{options()}}{ \describe{ -\item{xportr.df_domain_name (defaults to \code{"dataset"})}{Description about this option ...} -\item{xportr.df_label (defaults to \code{"label"})}{Description about this option ...} -\item{xportr.domain_name (defaults to \code{"dataset"})}{Description about this option ...} -\item{xportr.variable_name (defaults to \code{"variable"})}{Description about this option ...} -\item{xportr.type_name (defaults to \code{"type"})}{Description about this option ...} -\item{xportr.label (defaults to \code{"label"})}{Description about this option ...} -\item{xportr.length (defaults to \code{"length"})}{Description about this option ...} -\item{xportr.format_name (defaults to \code{"format"})}{Description about this option ...} -\item{xportr.format_verbose (defaults to \code{"none"})}{Description about this option ...} -\item{xportr.label_verbose (defaults to \code{"none"})}{Description about this option ...} -\item{xportr.length_verbose (defaults to \code{"none"})}{Description about this option ...} -\item{xportr.type_verbose (defaults to \code{"label"})}{Description about this option ...} -\item{xportr.character_types (defaults to \code{c("character", "char", "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", "partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", "intervaldatetime")})}{Description about this option ...} # nolint -\item{xportr.numeric_types (defaults to \code{c("integer", "numeric", "num", "float")})}{Description about this option ...} # nolint -\item{xportr.order_name (defaults to \code{"order"})}{Description about this option ...} +\item{xportr.df_domain_name} {defaults to \code{"dataset"}}: +The name of the domain "name" column in dataset metadata. +\item{xportr.df_label} {defaults to \code{"label"}}: +The column noting the dataset label in dataset metadata. +\item{xportr.domain_name} {defaults to \code{"dataset"}}: +The name of the domain "name" column in variable metadata. +\item{xportr.variable_name} {defaults to \code{"variable"}}: +The name of the variable "name" in variable metadata. +\item{xportr.type_name} {defaults to \code{"type"}}: +The name of the variable type column in variable metadata. +\item{xportr.label} {defaults to \code{"label"}}: +The name of the variable label column in variable metadata. +\item{xportr.length} {defaults to \code{"length"}}: +The name of the variable length column in variable metadata. +\item{xportr.order_name} {defaults to \code{"order"}}: +The name of the variable order column in variable metadata. +\item{xportr.format_name} {defaults to \code{"format"}}: +The name of the variable format column in variable metadata. +\item{xportr.format_verbose} {defaults to \code{"none"}}: +The default argument for the 'verbose' argument for \code{xportr_format}. +\item{xportr.label_verbose} {defaults to \code{"none"}}: +The default argument for the 'verbose' argument for \code{xportr_label}. +\item{xportr.length_verbose} {defaults to \code{"none"}}: +The default argument for the 'verbose' argument for \code{xportr_length}. +\item{xportr.type_verbose} {defaults to \code{"label"}}: +The default argument for the 'verbose' argument for \code{xportr_type}. +\item{xportr.character_types} {defaults to \code{c("character", "char", "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", "partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", "intervaldatetime")}}: +The default character vector used to explicitly coerce R classes to character XPT types. +\item{xportr.numeric_types} {defaults to \code{c("integer", "numeric", "num", "float")}}: +The default character vector used to explicitly coerce R classes to numeric XPT types. +} } \section{Options with \code{xportr_options()}}{ -There are a number of global options that affect xportr's behavior. These -can be set globally with \code{options()} or with \code{xportr_options()}. -The \code{xportr_options()} function also returns the current options when nothing is passed to it. +Alternative to the \code{options()}, the \code{xportr_options()} function can be used to set the options. +The \code{xportr_options()} function also returns the current options when a character vector of +the options keys are passed into it. If nothing is passed into it, it returns the state of all xportr options. } \examples{ -xportr_options(xportr.df_label = "data_label", xportr.label = "custom_label") xportr_options("xportr.df_label") +xportr_options(xportr.df_label = "data_label", xportr.label = "custom_label") xportr_options(c("xportr.label", "xportr.df_label")) xportr_options() } -\keyword{datasets} diff --git a/man/xportr_options_list.Rd b/man/xportr_options_list.Rd new file mode 100644 index 00000000..fb36fa78 --- /dev/null +++ b/man/xportr_options_list.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/zzz.R +\docType{data} +\name{xportr_options_list} +\alias{xportr_options_list} +\title{A list with all the supported options of xportr} +\format{ +An object of class \code{list} of length 15. +} +\usage{ +xportr_options_list +} +\description{ +An internal list with all the supported options of xportr with defaults +} +\keyword{internal} diff --git a/tests/testthat/test-options.R b/tests/testthat/test-options.R index 1a13ff23..8b2963d1 100644 --- a/tests/testthat/test-options.R +++ b/tests/testthat/test-options.R @@ -10,3 +10,33 @@ test_that("options are originally set as expected", { expect_equal(op$xportr.length, "length") expect_equal(op$xportr.format_name, "format") }) + + +test_that("xportr_options: options can be fetched using the xportr_options", { + expect_equal(xportr_options(), xportr_options_list) + new_domain <- "new domain name" + new_label <- "new label name" + op <- options(xportr.df_domain_name = new_domain, xportr.df_label = new_label) + on.exit(options(op), add = TRUE, after = FALSE) + domain <- xportr_options("xportr.df_domain_name")$xportr.df_domain_name + domain_label <- xportr_options(c("xportr.df_domain_name", "xportr.df_label")) + + expect_equal(domain, new_domain) + expect_equal(domain_label, list(xportr.df_domain_name = new_domain, xportr.df_label = new_label)) +}) + +test_that("xportr_options: options can be set using the xportr_options", { + op <- options() + on.exit(options(op), add = TRUE, after = FALSE) + old_name <- "old name" + new_name <- "new name" + old_label <- "old label" + new_label <- "new label" + options(xportr.df_domain_name = old_name, xportr.df_label = old_label) + old_values <- xportr_options(c("xportr.df_domain_name", "xportr.df_label")) + expect_equal(old_values, list(xportr.df_domain_name = old_name, xportr.df_label = old_label)) + + xportr_options(xportr.df_domain_name = new_name, xportr.df_label = new_label) + new_values <- xportr_options(c("xportr.df_domain_name", "xportr.df_label")) + expect_equal(new_values, list(xportr.df_domain_name = new_name, xportr.df_label = new_label)) +}) From 1c42f242a374e8ba102167f961125e973136e8e4 Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 16 Jan 2024 19:38:07 +0530 Subject: [PATCH 121/267] fix: use setNames with namespace --- R/xportr-options.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/xportr-options.R b/R/xportr-options.R index a28df989..180a8836 100644 --- a/R/xportr-options.R +++ b/R/xportr-options.R @@ -82,7 +82,7 @@ xportr_options <- function(...) { xportr_options <- grep("^xportr\\.", names(options_list), value = TRUE) for (opt in xportr_options) { option_value <- options_list[[opt]] - do.call(options, setNames(list(option_value), opt)) + do.call(options, stats::setNames(list(option_value), opt)) } } } From 245a1232b7af107c42e136d0c7329414f9d4e3b1 Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 16 Jan 2024 19:41:09 +0530 Subject: [PATCH 122/267] chore: use the existing file nomenclature --- R/{xportr-options.R => options.R} | 0 man/xportr_options.Rd | 2 +- 2 files changed, 1 insertion(+), 1 deletion(-) rename R/{xportr-options.R => options.R} (100%) diff --git a/R/xportr-options.R b/R/options.R similarity index 100% rename from R/xportr-options.R rename to R/options.R diff --git a/man/xportr_options.Rd b/man/xportr_options.Rd index 4cd2f4f1..3d7206a3 100644 --- a/man/xportr_options.Rd +++ b/man/xportr_options.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/xportr-options.R +% Please edit documentation in R/options.R \name{xportr_options} \alias{xportr_options} \title{Get or set Xportr options} From 4cb4fd0a89dac33fb8a026f5503ee765135c470d Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 16 Jan 2024 19:53:06 +0530 Subject: [PATCH 123/267] fix: update example in write to fix the R cmd check --- DESCRIPTION | 1 + R/options.R | 30 +++++++++++++++--------------- R/write.R | 14 +++++++++----- man/xportr_options.Rd | 30 +++++++++++++++--------------- man/xportr_write.Rd | 14 +++++++++----- 5 files changed, 49 insertions(+), 40 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 315b2810..690bff2f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,6 +25,7 @@ BugReports: https://github.com/atorus-research/xportr/issues Depends: R (>= 3.5) Imports: + checkmate, cli, dplyr (>= 1.0.2), glue (>= 1.4.2), diff --git a/R/options.R b/R/options.R index 180a8836..80f74c75 100644 --- a/R/options.R +++ b/R/options.R @@ -15,37 +15,37 @@ #' @section Options with `options()`: #' #' \describe{ -#' \item{xportr.df_domain_name} {defaults to `"dataset"`}: +#' \item{xportr.df_domain_name}{defaults to `"dataset"`}: #' The name of the domain "name" column in dataset metadata. -#' \item{xportr.df_label} {defaults to `"label"`}: +#' \item{xportr.df_label}{defaults to `"label"`}: #' The column noting the dataset label in dataset metadata. -#' \item{xportr.domain_name} {defaults to `"dataset"`}: +#' \item{xportr.domain_name}{defaults to `"dataset"`}: #' The name of the domain "name" column in variable metadata. -#' \item{xportr.variable_name} {defaults to `"variable"`}: +#' \item{xportr.variable_name}{defaults to `"variable"`}: #' The name of the variable "name" in variable metadata. -#' \item{xportr.type_name} {defaults to `"type"`}: +#' \item{xportr.type_name}{defaults to `"type"`}: #' The name of the variable type column in variable metadata. -#' \item{xportr.label} {defaults to `"label"`}: +#' \item{xportr.label}{defaults to `"label"`}: #' The name of the variable label column in variable metadata. -#' \item{xportr.length} {defaults to `"length"`}: +#' \item{xportr.length}{defaults to `"length"`}: #' The name of the variable length column in variable metadata. -#' \item{xportr.order_name} {defaults to `"order"`}: +#' \item{xportr.order_name}{defaults to `"order"`}: #' The name of the variable order column in variable metadata. -#' \item{xportr.format_name} {defaults to `"format"`}: +#' \item{xportr.format_name}{defaults to `"format"`}: #' The name of the variable format column in variable metadata. -#' \item{xportr.format_verbose} {defaults to `"none"`}: +#' \item{xportr.format_verbose}{defaults to `"none"`}: #' The default argument for the 'verbose' argument for `xportr_format`. -#' \item{xportr.label_verbose} {defaults to `"none"`}: +#' \item{xportr.label_verbose}{defaults to `"none"`}: #' The default argument for the 'verbose' argument for `xportr_label`. -#' \item{xportr.length_verbose} {defaults to `"none"`}: +#' \item{xportr.length_verbose}{defaults to `"none"`}: #' The default argument for the 'verbose' argument for `xportr_length`. -#' \item{xportr.type_verbose} {defaults to `"label"`}: +#' \item{xportr.type_verbose}{defaults to `"label"`}: #' The default argument for the 'verbose' argument for `xportr_type`. -#' \item{xportr.character_types} {defaults to `c("character", "char", "text", "date", "posixct", "posixt", +#' \item{xportr.character_types}{defaults to `c("character", "char", "text", "date", "posixct", "posixt", #' "datetime", "time", "partialdate", "partialtime", "partialdatetime", #' "incompletedatetime", "durationdatetime", "intervaldatetime")`}: #' The default character vector used to explicitly coerce R classes to character XPT types. -#' \item{xportr.numeric_types} {defaults to `c("integer", "numeric", "num", "float")`}: +#' \item{xportr.numeric_types}{defaults to `c("integer", "numeric", "num", "float")`}: #' The default character vector used to explicitly coerce R classes to numeric XPT types. #' } #' diff --git a/R/write.R b/R/write.R index 0dd13541..384c6184 100644 --- a/R/write.R +++ b/R/write.R @@ -28,13 +28,17 @@ #' #' @examples #' adsl <- data.frame( -#' Subj = as.character(123, 456, 789), -#' Different = c("a", "b", "c"), -#' Val = c("1", "2", "3"), -#' Param = c("param1", "param2", "param3") +#' SUBL = as.character(123, 456, 789), +#' DIFF = c("a", "b", "c"), +#' VAL = c("1", "2", "3"), +#' PARAM = c("param1", "param2", "param3") #' ) #' -#' var_spec <- data.frame(dataset = "adsl", label = "Subject-Level Analysis Dataset") +#' var_spec <- data.frame( +#' dataset = "adsl", +#' label = "Subject-Level Analysis Dataset", +#' data_label = "ADSL" +#' ) #' xportr_write(adsl, #' path = paste0(tempdir(), "/adsl.xpt"), #' metadata = var_spec, diff --git a/man/xportr_options.Rd b/man/xportr_options.Rd index 3d7206a3..4194aa52 100644 --- a/man/xportr_options.Rd +++ b/man/xportr_options.Rd @@ -23,35 +23,35 @@ xportr related options of this type are prefixed with \code{"xportr."}. \describe{ -\item{xportr.df_domain_name} {defaults to \code{"dataset"}}: +\item{xportr.df_domain_name}{defaults to \code{"dataset"}}: The name of the domain "name" column in dataset metadata. -\item{xportr.df_label} {defaults to \code{"label"}}: +\item{xportr.df_label}{defaults to \code{"label"}}: The column noting the dataset label in dataset metadata. -\item{xportr.domain_name} {defaults to \code{"dataset"}}: +\item{xportr.domain_name}{defaults to \code{"dataset"}}: The name of the domain "name" column in variable metadata. -\item{xportr.variable_name} {defaults to \code{"variable"}}: +\item{xportr.variable_name}{defaults to \code{"variable"}}: The name of the variable "name" in variable metadata. -\item{xportr.type_name} {defaults to \code{"type"}}: +\item{xportr.type_name}{defaults to \code{"type"}}: The name of the variable type column in variable metadata. -\item{xportr.label} {defaults to \code{"label"}}: +\item{xportr.label}{defaults to \code{"label"}}: The name of the variable label column in variable metadata. -\item{xportr.length} {defaults to \code{"length"}}: +\item{xportr.length}{defaults to \code{"length"}}: The name of the variable length column in variable metadata. -\item{xportr.order_name} {defaults to \code{"order"}}: +\item{xportr.order_name}{defaults to \code{"order"}}: The name of the variable order column in variable metadata. -\item{xportr.format_name} {defaults to \code{"format"}}: +\item{xportr.format_name}{defaults to \code{"format"}}: The name of the variable format column in variable metadata. -\item{xportr.format_verbose} {defaults to \code{"none"}}: +\item{xportr.format_verbose}{defaults to \code{"none"}}: The default argument for the 'verbose' argument for \code{xportr_format}. -\item{xportr.label_verbose} {defaults to \code{"none"}}: +\item{xportr.label_verbose}{defaults to \code{"none"}}: The default argument for the 'verbose' argument for \code{xportr_label}. -\item{xportr.length_verbose} {defaults to \code{"none"}}: +\item{xportr.length_verbose}{defaults to \code{"none"}}: The default argument for the 'verbose' argument for \code{xportr_length}. -\item{xportr.type_verbose} {defaults to \code{"label"}}: +\item{xportr.type_verbose}{defaults to \code{"label"}}: The default argument for the 'verbose' argument for \code{xportr_type}. -\item{xportr.character_types} {defaults to \code{c("character", "char", "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", "partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", "intervaldatetime")}}: +\item{xportr.character_types}{defaults to \code{c("character", "char", "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", "partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", "intervaldatetime")}}: The default character vector used to explicitly coerce R classes to character XPT types. -\item{xportr.numeric_types} {defaults to \code{c("integer", "numeric", "num", "float")}}: +\item{xportr.numeric_types}{defaults to \code{c("integer", "numeric", "num", "float")}}: The default character vector used to explicitly coerce R classes to numeric XPT types. } } diff --git a/man/xportr_write.Rd b/man/xportr_write.Rd index b59e61bd..48fc887d 100644 --- a/man/xportr_write.Rd +++ b/man/xportr_write.Rd @@ -51,13 +51,17 @@ to the FDA. } \examples{ adsl <- data.frame( - Subj = as.character(123, 456, 789), - Different = c("a", "b", "c"), - Val = c("1", "2", "3"), - Param = c("param1", "param2", "param3") + SUBL = as.character(123, 456, 789), + DIFF = c("a", "b", "c"), + VAL = c("1", "2", "3"), + PARAM = c("param1", "param2", "param3") ) -var_spec <- data.frame(dataset = "adsl", label = "Subject-Level Analysis Dataset") +var_spec <- data.frame( + dataset = "adsl", + label = "Subject-Level Analysis Dataset", + data_label = "ADSL" +) xportr_write(adsl, path = paste0(tempdir(), "/adsl.xpt"), metadata = var_spec, From fdc93fa06e8af3f313cc657a1af0e76a6ea090b4 Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 16 Jan 2024 19:57:26 +0530 Subject: [PATCH 124/267] chore: lint changes --- R/options.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/options.R b/R/options.R index 80f74c75..f4c3ab5b 100644 --- a/R/options.R +++ b/R/options.R @@ -66,7 +66,7 @@ xportr_options <- function(...) { checkmate::assert_subset(names(list(...)), names(xportr_options_list)) if (is.null(names(list(...)))) { - if (length(list(...)) == 0) { + if (length(list(...)) == 0) { queried_options <- names(xportr_options_list) } else { queried_options <- intersect(c(...), names(xportr_options_list)) From b1a78bff216bd0160e2fdb93340a5a31f9eecb42 Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 16 Jan 2024 20:05:02 +0530 Subject: [PATCH 125/267] docs: update news and style package --- NEWS.md | 2 +- tests/testthat/test-options.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index 0adb7867..450cf996 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,8 +4,8 @@ * `xportr_write()` now accepts `metadata` argument which can be used to set the dataset label to stay consistent with the other `xportr_*` functions. It is noteworthy that the dataset label set using the `xportr_df_label()` function will be retained during the `xportr_write()`. * Exporting a new dataset `dataset_spec` that contains the Dataset Specification for ADSL. (#179) - * Added a check for character variable lengths up to 200 bytes in `xpt_validate()`(#91, #189). +* It is now possible to get and set the xportr options using the helper function `xportr_options()` ## Deprecation and Breaking Changes diff --git a/tests/testthat/test-options.R b/tests/testthat/test-options.R index 8b2963d1..39be84b8 100644 --- a/tests/testthat/test-options.R +++ b/tests/testthat/test-options.R @@ -35,7 +35,7 @@ test_that("xportr_options: options can be set using the xportr_options", { options(xportr.df_domain_name = old_name, xportr.df_label = old_label) old_values <- xportr_options(c("xportr.df_domain_name", "xportr.df_label")) expect_equal(old_values, list(xportr.df_domain_name = old_name, xportr.df_label = old_label)) - + xportr_options(xportr.df_domain_name = new_name, xportr.df_label = new_label) new_values <- xportr_options(c("xportr.df_domain_name", "xportr.df_label")) expect_equal(new_values, list(xportr.df_domain_name = new_name, xportr.df_label = new_label)) From 4b557babb6209bb8c2e5ce4b62e23b88d7623cb8 Mon Sep 17 00:00:00 2001 From: vedhav Date: Tue, 16 Jan 2024 20:24:25 +0530 Subject: [PATCH 126/267] docs: update vignette with the new options function --- vignettes/deepdive.Rmd | 25 +++++++++++++++++++------ 1 file changed, 19 insertions(+), 6 deletions(-) diff --git a/vignettes/deepdive.Rmd b/vignettes/deepdive.Rmd index f55b1f91..fc9f601d 100644 --- a/vignettes/deepdive.Rmd +++ b/vignettes/deepdive.Rmd @@ -105,15 +105,18 @@ We will focus on warning and error messaging with contrived examples from these Before we dive into the functions, we want to point out some quality of life utilities to make your `xpt` generation life a little bit easier. -* `options()` +* `options()` +* `xportr_options()` * `xportr_metadata()` **NOTE:** As long as you have a well-defined _metadata object_ you do NOT need to use `options()` or `xportr_metadata()`, but we find these handy to use and think they deserve a quick mention! -## You got `options()` +## You've got `options()` or `xportr_options()` `{xportr}` is built with certain assumptions around specification column names and information in those columns. We have found that each company specification file can differ slightly from our assumptions. For example, one company might call a column `Variables`, another `Variable` and another `variables`. Rather than trying to regex ourselves out of this situation, we have introduced `options()`. `options()` allows users to control those assumptions inside `{xportr}` functions based on their needs. +Additionally, we have a helper function `xportr_options()` which works just like the `options()` but, it can also be used to get the current state of the xportr options. + Let's take a look at our example specification file names available in this package. We can see that all the columns start with an upper case letter and have spaces in several of them. We could convert all the column names to lower case and deal with the spacing using some `{dplyr}` functions or base R, or we could just use `options()`! ```{r, message = FALSE} @@ -125,9 +128,19 @@ library(haven) colnames(var_spec) ``` -By using `options()` at the beginning of our script we can tell `{xportr}` what the valid names are (see chunk below). Please note that before we set the options the package assumed every thing was in lowercase and there were no spaces in the names. After running `options()`, `{xportr}` sees the column `Variable` as the valid name rather than `variable`. You can inspect [`zzz.R`](https://github.com/atorus-research/xportr/blob/main/R/zzz.R) to look at additional options. +By using `options()` or `xportr_options()` at the beginning of our script we can tell `{xportr}` what the valid names are (see chunk below). Please note that before we set the options the package assumed every thing was in lowercase and there were no spaces in the names. After running `options()` or `xportr_options()`, `{xportr}` sees the column `Variable` as the valid name rather than `variable`. You can inspect `xportr_options` function docs to look at additional options. ```{r, eval = FALSE} +xportr_options( + xportr.variable_name = "Variable", + xportr.label = "Label", + xportr.type_name = "Data Type", + xportr.format = "Format", + xportr.length = "Length", + xportr.order_name = "Order" +) + +# Or alternatively options( xportr.variable_name = "Variable", xportr.label = "Label", @@ -140,18 +153,18 @@ options( ## Are we being too verbose? -One final note on `options()`. 4 of the core `{xportr}` functions have the ability to set messaging as `"none", "message", "warn", "stop"`. Setting each of these in all your calls can be a bit repetitive. You can use `options()` to set these at a higher level and avoid this repetition. +One final note on the options. 4 of the core `{xportr}` functions have the ability to set messaging as `"none", "message", "warn", "stop"`. Setting each of these in all your calls can be a bit repetitive. You can use `options()` or `xportr_options()` to set these at a higher level and avoid this repetition. ```{r, eval = FALSE} # Default verbose is set to `none` -options( +xportr_options( xportr.format_verbose = "none", xportr.label_verbose = "none", xportr.length_verbose = "none", xportr.type_verbose = "none" ) -options( +xportr_options( xportr.format_verbose = "none", # Disables any messaging, keeping the console output clean xportr.label_verbose = "message", # Sends a standard message to the console xportr.length_verbose = "warn", # Sends a warning message to the console From e3a31b1e2e5dd76e87a66f702ff6807056fc307a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 16 Jan 2024 16:40:18 +0100 Subject: [PATCH 127/267] tests: add missing coverage --- tests/testthat/test-metadata.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index fc4a3b74..e50a0741 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -607,6 +607,13 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { ) }) +test_that("xportr_metadata: must throw error if both metadata and domain are null", { + expect_error( + xportr_metadata(data.frame(), metadata = NULL, domain = NULL), + "Must provide either metadata or domain argument" + ) +}) + test_that("xportr_*: Domain is kept in between calls", { # Divert all messages to tempfile, instead of printing them # note: be aware as this should only be used in tests that don't track From 601209fdb6d72725f50b53dd4d6f1aa746d1c8e1 Mon Sep 17 00:00:00 2001 From: elimillera Date: Tue, 16 Jan 2024 15:58:34 +0000 Subject: [PATCH 128/267] Update readme per comments --- README.Rmd | 12 ++++++------ README.md | 12 ++++++------ 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/README.Rmd b/README.Rmd index 1541a21b..2f422c1c 100644 --- a/README.Rmd +++ b/README.Rmd @@ -131,12 +131,12 @@ Each `xportr_` function has been written in a way to take in a part of the speci ```{r, warning = FALSE, message=FALSE, eval=TRUE} adsl %>% - xportr_domain_name("ADSL") %>% - xportr_type(var_spec, verbose = "warn") %>% - xportr_length(var_spec, verbose = "warn") %>% - xportr_label(var_spec, verbose = "warn") %>% - xportr_order(var_spec, verbose = "warn") %>% - xportr_format(var_spec) %>% + xportr_metadata(var_spec, "ADSL") %>% + xportr_type(verbose = "warn") %>% + xportr_length(verbose = "warn") %>% + xportr_label(verbose = "warn") %>% + xportr_order(verbose = "warn") %>% + xportr_format() %>% xportr_df_label(dataset_spec, "ADSL") %>% xportr_write("adsl.xpt") ``` diff --git a/README.md b/README.md index cc83fae4..bebb06c8 100644 --- a/README.md +++ b/README.md @@ -138,12 +138,12 @@ We have suppressed the warning for the sake of brevity. ``` r adsl %>% - xportr_domain_name("ADSL") %>% - xportr_type(var_spec, verbose = "warn") %>% - xportr_length(var_spec, verbose = "warn") %>% - xportr_label(var_spec, verbose = "warn") %>% - xportr_order(var_spec, verbose = "warn") %>% - xportr_format(var_spec) %>% + xportr_metadata(var_spec, "ADSL") %>% + xportr_type(verbose = "warn") %>% + xportr_length(verbose = "warn") %>% + xportr_label(verbose = "warn") %>% + xportr_order(verbose = "warn") %>% + xportr_format() %>% xportr_df_label(dataset_spec, "ADSL") %>% xportr_write("adsl.xpt") ``` From 6fc3451a7a4e56767c0bc8e4df2f81f5e0a33667 Mon Sep 17 00:00:00 2001 From: elimillera Date: Tue, 16 Jan 2024 16:00:00 +0000 Subject: [PATCH 129/267] [skip actions] Bump version to 0.3.1.9006 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 315b2810..424b59cb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9005 +Version: 0.3.1.9006 Authors@R: c( person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")), From bcf4c88d1e4b0a900410c309993ee23c3b2111fe Mon Sep 17 00:00:00 2001 From: bms63 Date: Tue, 16 Jan 2024 16:46:42 +0000 Subject: [PATCH 130/267] [skip actions] Bump version to 0.3.1.9007 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 424b59cb..d247be32 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9006 +Version: 0.3.1.9007 Authors@R: c( person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")), From 68a1a8c05966885893f870baff49257d9c90bc54 Mon Sep 17 00:00:00 2001 From: sadchla-codes Date: Tue, 16 Jan 2024 12:11:43 -0500 Subject: [PATCH 131/267] Closes #132 Removing `SAStype` and `SASlength` since they did not have any impact on the functions and updating news --- NEWS.md | 2 ++ R/length.R | 2 +- R/utils-xportr.R | 4 ++-- R/write.R | 2 +- inst/WORDLIST | 1 - man/xportr_length.Rd | 2 +- man/xportr_write.Rd | 2 +- tests/testthat/test-length.R | 2 +- tests/testthat/test-utils-xportr.R | 6 ++++-- 9 files changed, 13 insertions(+), 10 deletions(-) diff --git a/NEWS.md b/NEWS.md index 0adb7867..91a17dd4 100644 --- a/NEWS.md +++ b/NEWS.md @@ -12,6 +12,8 @@ * 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`. +* `SASlength` and `SAStype` were removed since they did not have an impact on `xpt_validate` or any other functions (#132) + ## Documentation * Created development version of the website (#187) diff --git a/R/length.R b/R/length.R index 1cd10980..896c782e 100644 --- a/R/length.R +++ b/R/length.R @@ -46,7 +46,7 @@ #' the column. This is passed to `haven::write` to note the variable length. #' #' -#' @return Data frame with `SASlength` attributes for each variable. +#' @return Data frame with SAS default length attributes for each variable. #' #' @export #' diff --git a/R/utils-xportr.R b/R/utils-xportr.R index f1596b78..f4e16c81 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -5,7 +5,7 @@ #' #' @return Character vector of attributes with column names assigned #' @noRd -extract_attr <- function(data, attr = c("label", "format.sas", "SAStype")) { +extract_attr <- function(data, attr = c("label", "format.sas","type")) { attr <- match.arg(attr) out <- lapply(data, function(.x) attr(.x, attr)) out <- vapply(out, @@ -215,7 +215,7 @@ xpt_validate <- function(data) { } # 3.0 VARIABLE TYPES ---- - types <- tolower(extract_attr(data, attr = "SAStype")) + types <- tolower(extract_attr(data, attr = "type")) expected_types <- c( "", "text", "integer", "float", "datetime", "date", "time", diff --git a/R/write.R b/R/write.R index c53afb96..ee5e10d2 100644 --- a/R/write.R +++ b/R/write.R @@ -19,7 +19,7 @@ #' #' * SAS format are stored in the "SASformat" attribute. #' -#' * SAS type are stored in the "SAStype" attribute. +#' * SAS type are based on the `metadata` attribute. #' #' @return A data frame. `xportr_write()` returns the input data invisibly. #' @export diff --git a/inst/WORDLIST b/inst/WORDLIST index a0d3ae8d..aff5d7c5 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -19,7 +19,6 @@ PHUSE Pharma Repostiory SASformat -SAStype SDSP SDTM Standardisation diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index 89fb5703..10dbba95 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -30,7 +30,7 @@ details. Options are 'stop', 'warn', 'message', and 'none'} metadata now renamed with \code{metadata}} } \value{ -Data frame with \code{SASlength} attributes for each variable. +Data frame with SAS default length attributes for each variable. } \description{ Assigns SAS length from a metadata object to a given data frame. If a diff --git a/man/xportr_write.Rd b/man/xportr_write.Rd index d28b1fbc..b949052f 100644 --- a/man/xportr_write.Rd +++ b/man/xportr_write.Rd @@ -45,7 +45,7 @@ to the FDA. \itemize{ \item Variable and dataset labels are stored in the "label" attribute. \item SAS format are stored in the "SASformat" attribute. -\item SAS type are stored in the "SAStype" attribute. +\item SAS type are based on the \code{metadata} attribute. } } \examples{ diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index 35761d84..c07fbf9d 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -2,7 +2,7 @@ #' #' Tests will check for: #' * Errors -#' * Result of call will create `SASlength` attribute (`width` for each +#' * Result of call will create SAS default length attribute (`width` for each #' variable) test_that("xportr_length: Accepts valid domain names in metadata object", { diff --git a/tests/testthat/test-utils-xportr.R b/tests/testthat/test-utils-xportr.R index 41f6adb8..79075c09 100644 --- a/tests/testthat/test-utils-xportr.R +++ b/tests/testthat/test-utils-xportr.R @@ -85,8 +85,10 @@ test_that("xpt_validate: Get error message when the label contains over 40 chara test_that("xpt_validate: Get error message when the variable type is invalid", { df <- data.frame(A = 1, B = 2) - attr(df$A, "SAStype") <- "integer" - attr(df$B, "SAStype") <- "list" + #as.integer((df$A)) + #as.list(df$B) + attr(df$A, "type") <- "integer" + attr(df$B, "type") <- "list" expect_equal( xpt_validate(df), "Variables `A` and `B` must have a valid type." From 43be198f6da7e32bb820ca45b250486a9274ff55 Mon Sep 17 00:00:00 2001 From: sadchla-codes Date: Tue, 16 Jan 2024 12:27:38 -0500 Subject: [PATCH 132/267] Closes #217 Fixing a small typo --- .github/pull_request_template.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index 83a0dbad..d08d7254 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -23,7 +23,7 @@ _(descriptions of changes)_ - [ ] Run `devtools::document()` so all `.Rd` files in the `man` folder and the `NAMESPACE` file in the project root are updated appropriately - [ ] Run `pkgdown::build_site()` and check that all affected examples are displayed correctly and that all new/updated functions occur on the "Reference" page. - [ ] Update NEWS.md if the changes pertain to a user-facing function (i.e. it has an @export tag) or documentation aimed at users (rather than developers) -- [ ] Make sure that the pacakge version in the NEWS.md and DESCRIPTION file is same. Don't worry about updating the version because it will be auto-updated using the `vbump.yaml` CI. +- [ ] Make sure that the package version in the NEWS.md and DESCRIPTION file is same. Don't worry about updating the version because it will be auto-updated using the `vbump.yaml` CI. - [ ] Address any updates needed for vignettes and/or templates - [ ] Link the issue Development Panel so that it closes after successful merging. - [ ] Fix merge conflicts From df9b422d15099bfd497460c4119d2f7456086407 Mon Sep 17 00:00:00 2001 From: sadchla-codes Date: Tue, 16 Jan 2024 12:30:27 -0500 Subject: [PATCH 133/267] Fixing lint issues --- R/utils-xportr.R | 2 +- tests/testthat/test-utils-xportr.R | 2 -- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/R/utils-xportr.R b/R/utils-xportr.R index 963073c5..65c9de6c 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -5,7 +5,7 @@ #' #' @return Character vector of attributes with column names assigned #' @noRd -extract_attr <- function(data, attr = c("label", "format.sas","type")) { +extract_attr <- function(data, attr = c("label", "format.sas", "type")) { attr <- match.arg(attr) out <- lapply(data, function(.x) attr(.x, attr)) out <- vapply(out, diff --git a/tests/testthat/test-utils-xportr.R b/tests/testthat/test-utils-xportr.R index 79075c09..cdbf5cf6 100644 --- a/tests/testthat/test-utils-xportr.R +++ b/tests/testthat/test-utils-xportr.R @@ -85,8 +85,6 @@ test_that("xpt_validate: Get error message when the label contains over 40 chara test_that("xpt_validate: Get error message when the variable type is invalid", { df <- data.frame(A = 1, B = 2) - #as.integer((df$A)) - #as.list(df$B) attr(df$A, "type") <- "integer" attr(df$B, "type") <- "list" expect_equal( From ef704445f4f8d160f00df94e85b504ef7ab5fdc8 Mon Sep 17 00:00:00 2001 From: EeethB Date: Tue, 16 Jan 2024 17:43:46 -0600 Subject: [PATCH 134/267] Fix failing test by specifying domain --- R/metadata.R | 5 ++++- man/metadata.Rd | 6 +++++- tests/testthat/test-metadata.R | 2 +- 3 files changed, 10 insertions(+), 3 deletions(-) diff --git a/R/metadata.R b/R/metadata.R index c8f3cf93..bf24ecd3 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -40,7 +40,10 @@ #' xportr_type() %>% #' xportr_order() #' } -xportr_metadata <- function(.df, metadata = NULL, domain = NULL) { +xportr_metadata <- function(.df, + metadata = NULL, + domain = NULL, + verbose = NULL) { if (is.null(metadata) && is.null(domain)) { stop("Must provide either metadata or domain argument") } diff --git a/man/metadata.Rd b/man/metadata.Rd index 658fe0a4..da5de14c 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -4,7 +4,7 @@ \alias{xportr_metadata} \title{Set variable specifications and domain} \usage{ -xportr_metadata(.df, metadata = NULL, domain = NULL) +xportr_metadata(.df, metadata = NULL, domain = NULL, verbose = NULL) } \arguments{ \item{.df}{A data frame of CDISC standard.} @@ -15,6 +15,10 @@ xportr_metadata(.df, metadata = NULL, domain = NULL) \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an attribute of \code{.df}.} + +\item{verbose}{The action this function takes when an action is taken on the +dataset or function validation finds an issue. See 'Messaging' section for +details. Options are 'stop', 'warn', 'message', and 'none'} } \value{ \code{.df} dataset with metadata and domain attributes set diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index 4265ed01..d4dbc9af 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -600,7 +600,7 @@ test_that("xportr_metadata: Variable ordering messaging is correct", { expect_condition("4 reordered in dataset") %>% expect_message("Variable reordered in `.df`: `a`, `b`, `c`, and `d`") - xportr_metadata(df2, df_meta, verbose = "message") %>% + xportr_metadata(df2, df_meta, domain = "df2", verbose = "message") %>% xportr_order() %>% expect_message("2 variables not in spec and moved to end") %>% expect_message("Variable moved to end in `.df`: `a` and `z`") %>% From 6830ffb579ea4cb9a094deb96cc72ab254e7f480 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 17 Jan 2024 10:50:36 +0100 Subject: [PATCH 135/267] merge: revert some changes --- R/df_label.R | 2 +- R/format.R | 2 +- R/label.R | 2 +- R/length.R | 2 +- R/metadata.R | 4 ++-- R/order.R | 2 +- R/type.R | 4 ++-- R/utils-xportr.R | 8 ++++++-- tests/testthat/test-metadata.R | 2 +- 9 files changed, 16 insertions(+), 12 deletions(-) diff --git a/R/df_label.R b/R/df_label.R index 35d08318..90f25e1e 100644 --- a/R/df_label.R +++ b/R/df_label.R @@ -54,7 +54,7 @@ xportr_df_label <- function(.df, assert_string(domain, null.ok = TRUE) assert_metadata(metadata) - if (!is.null(domain)) .df <- xportr_domain_name(.df, domain) + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain domain_name <- getOption("xportr.df_domain_name") label_name <- getOption("xportr.df_label") diff --git a/R/format.R b/R/format.R index bf4b9ebc..34d30576 100644 --- a/R/format.R +++ b/R/format.R @@ -56,7 +56,7 @@ xportr_format <- function(.df, assert_string(domain, null.ok = TRUE) assert_metadata(metadata) - if (!is.null(domain)) .df <- xportr_domain_name(.df, domain) + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain domain_name <- getOption("xportr.domain_name") format_name <- getOption("xportr.format_name") diff --git a/R/label.R b/R/label.R index 158b8e90..f5b495ad 100644 --- a/R/label.R +++ b/R/label.R @@ -73,7 +73,7 @@ xportr_label <- function(.df, assert_metadata(metadata) assert_choice(verbose, choices = .internal_verbose_choices) - if (!is.null(domain)) .df <- xportr_domain_name(.df, domain) + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain domain_name <- getOption("xportr.domain_name") variable_name <- getOption("xportr.variable_name") diff --git a/R/length.R b/R/length.R index eb8c635e..b7ff15c3 100644 --- a/R/length.R +++ b/R/length.R @@ -80,7 +80,7 @@ xportr_length <- function(.df, assert_metadata(metadata) assert_choice(verbose, choices = .internal_verbose_choices) - if (!is.null(domain)) .df <- xportr_domain_name(.df, domain) + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain domain_name <- getOption("xportr.domain_name") variable_length <- getOption("xportr.length") diff --git a/R/metadata.R b/R/metadata.R index d19b60a8..dd6a05e8 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -47,10 +47,10 @@ xportr_metadata <- function(.df, metadata = NULL, domain = NULL) { } 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 - if (!is.null(domain)) .df <- xportr_domain_name(.df, domain) + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain structure(.df, "_xportr.df_metadata_" = metadata) } diff --git a/R/order.R b/R/order.R index 686c8db3..bcbb0794 100644 --- a/R/order.R +++ b/R/order.R @@ -76,7 +76,7 @@ xportr_order <- function(.df, assert_metadata(metadata) assert_choice(verbose, choices = .internal_verbose_choices) - if (!is.null(domain)) .df <- xportr_domain_name(.df, domain) + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain domain_name <- getOption("xportr.domain_name") order_name <- getOption("xportr.order_name") diff --git a/R/type.R b/R/type.R index b7943c0f..342a5840 100644 --- a/R/type.R +++ b/R/type.R @@ -90,10 +90,10 @@ xportr_type <- function(.df, } assert_data_frame(.df) assert_string(domain, null.ok = TRUE) - assert_metadata(metadata) + assert_metadata(metadata, null.ok = TRUE) assert_choice(verbose, choices = .internal_verbose_choices) - if (!is.null(domain)) .df <- xportr_domain_name(.df, domain) + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain # Name of the columns for working with metadata domain_name <- getOption("xportr.domain_name") diff --git a/R/utils-xportr.R b/R/utils-xportr.R index b59c1d78..a5ccea2a 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -388,8 +388,11 @@ check_multiple_var_specs <- function(metadata, #' Improvement on the message clarity over the default assert(...) messages. #' @noRd #' @param metadata A data frame or `Metacore` object containing variable level +#' @inheritParams checkmate::check_logical #' metadata. -check_metadata <- function(metadata, include_fun_message) { +check_metadata <- function(metadata, include_fun_message, null.ok = FALSE) { + if (is.null(metadata) && null.ok) return(TRUE) + extra_string <- ", 'Metacore' or set via 'xportr_metadata()'" if (!include_fun_message) { extra_string <- " or 'Metacore'" @@ -413,11 +416,12 @@ check_metadata <- function(metadata, include_fun_message) { #' metadata. assert_metadata <- function(metadata, include_fun_message = TRUE, + null.ok = FALSE, add = NULL, .var.name = vname(metadata)) { makeAssertion( metadata, - check_metadata(metadata, include_fun_message), + check_metadata(metadata, include_fun_message, null.ok), var.name = .var.name, collection = add ) diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index e10ce09e..1ebf4e97 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -610,7 +610,7 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { test_that("xportr_metadata: must throw error if both metadata and domain are null", { expect_error( xportr_metadata(data.frame(), metadata = NULL, domain = NULL), - "Must provide either metadata or domain argument" + "Must provide either `metadata` or `domain` argument" ) }) From fb1aa2b9799f30d4c59cec9f6d26e6dbc8bab5c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 17 Jan 2024 10:58:25 +0100 Subject: [PATCH 136/267] minor bugfixes --- R/type.R | 2 +- R/write.R | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/type.R b/R/type.R index 342a5840..075328f0 100644 --- a/R/type.R +++ b/R/type.R @@ -90,7 +90,7 @@ xportr_type <- function(.df, } assert_data_frame(.df) assert_string(domain, null.ok = TRUE) - assert_metadata(metadata, null.ok = TRUE) + assert_metadata(metadata) assert_choice(verbose, choices = .internal_verbose_choices) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain diff --git a/R/write.R b/R/write.R index eab886d4..96281945 100644 --- a/R/write.R +++ b/R/write.R @@ -50,9 +50,8 @@ xportr_write <- function(.df, label = deprecated()) { assert_data_frame(.df) assert_string(path) - assert_metadata(metadata) + assert_metadata(metadata, null.ok = TRUE) assert_logical(strict_checks) - assert_string(label, null.ok = TRUE, max.chars = 40) path <- normalizePath(path, mustWork = FALSE) @@ -71,6 +70,7 @@ xportr_write <- function(.df, what = "xportr_write(label = )", with = "xportr_write(metadata = )" ) + assert_string(label, null.ok = TRUE, max.chars = 40) metadata <- data.frame(dataset = domain, label = label) } if (!is.null(metadata)) { @@ -80,9 +80,9 @@ xportr_write <- function(.df, if (nchar(name) > 8) { assert(".df file name must be 8 characters or less.", .var.name = "path") } - + checks <- xpt_validate(.df) - + if (stringr::str_detect(name, "[^a-zA-Z0-9]")) { checks <- c(checks, "`.df` cannot contain any non-ASCII, symbol or underscore characters.") } From 8aa98d0161f397383ab52a7af7c4d03831d657c9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 17 Jan 2024 11:01:47 +0100 Subject: [PATCH 137/267] default value for domain is attribute --- R/write.R | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/R/write.R b/R/write.R index 96281945..6b667af3 100644 --- a/R/write.R +++ b/R/write.R @@ -45,7 +45,7 @@ xportr_write <- function(.df, path, metadata = NULL, - domain = NULL, + domain = attr(.df, "_xportr.df_arg_"), strict_checks = FALSE, label = deprecated()) { assert_data_frame(.df) @@ -53,17 +53,12 @@ xportr_write <- function(.df, assert_metadata(metadata, null.ok = TRUE) assert_logical(strict_checks) + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + path <- normalizePath(path, mustWork = FALSE) name <- tools::file_path_sans_ext(basename(path)) - ## 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 - if (!missing(label)) { lifecycle::deprecate_warn( when = "0.3.2", From 33cb7c87c898018284c7c6d6a9854847694ff49a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 17 Jan 2024 11:03:54 +0100 Subject: [PATCH 138/267] tests: use strict checks to get ascii error --- tests/testthat/test-write.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index d53c7eb0..31837977 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -96,7 +96,7 @@ test_that("xportr_write: expect error when file name contains non-ASCII symbols on.exit(unlink(tmpdir)) - expect_error(xportr_write(data_to_save, tmp)) + expect_error(xportr_write(data_to_save, tmp, strict_checks = TRUE)) }) test_that("xportr_write: expect warning when file name contains underscore and strict_checks = FALSE", { From 810f3b0612b9b1e492685eb0545b56a33d02b9af Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 17 Jan 2024 11:09:49 +0100 Subject: [PATCH 139/267] docs: update documentation and removes unused function --- R/utils-xportr.R | 11 ----------- man/xportr_write.Rd | 2 +- 2 files changed, 1 insertion(+), 12 deletions(-) diff --git a/R/utils-xportr.R b/R/utils-xportr.R index a5ccea2a..d1959222 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -319,17 +319,6 @@ xpt_validate <- function(data) { return(err_cnd) } -#' Get the domain from argument or from the existing domain attr -#' -#' @return A string representing the domain -#' @noRd -get_domain <- function(.df, domain) { - assert_string(domain, null.ok = TRUE) - - result <- domain %||% attr(.df, "_xportr.df_arg_") - result -} - #' Get Origin Object of a Series of Pipes #' #' @return The R Object at the top of a pipe stack diff --git a/man/xportr_write.Rd b/man/xportr_write.Rd index 31c91c1e..9c8a134c 100644 --- a/man/xportr_write.Rd +++ b/man/xportr_write.Rd @@ -8,7 +8,7 @@ xportr_write( .df, path, metadata = NULL, - domain = NULL, + domain = attr(.df, "_xportr.df_arg_"), strict_checks = FALSE, label = deprecated() ) From 3f6ea8d3d92e3dae1637d0be6ae52930d36cde17 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 17 Jan 2024 11:19:19 +0100 Subject: [PATCH 140/267] style: missing styler --- R/utils-xportr.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/utils-xportr.R b/R/utils-xportr.R index d1959222..19086b4c 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -380,7 +380,9 @@ check_multiple_var_specs <- function(metadata, #' @inheritParams checkmate::check_logical #' metadata. check_metadata <- function(metadata, include_fun_message, null.ok = FALSE) { - if (is.null(metadata) && null.ok) return(TRUE) + if (is.null(metadata) && null.ok) { + return(TRUE) + } extra_string <- ", 'Metacore' or set via 'xportr_metadata()'" if (!include_fun_message) { From 59b82ebebfd9c0879ea22441cf6ac61112b95995 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 17 Jan 2024 11:30:41 +0100 Subject: [PATCH 141/267] typos and suround code and variables/arguments with backticks --- R/data.R | 2 +- R/format.R | 4 ++-- R/order.R | 4 ++-- R/type.R | 15 ++++++++------- R/xportr-package.R | 10 +++++----- man/dataset_spec.Rd | 2 +- man/xportr-package.Rd | 10 +++------- man/xportr_format.Rd | 4 ++-- man/xportr_order.Rd | 4 ++-- man/xportr_type.Rd | 15 ++++++--------- 10 files changed, 32 insertions(+), 38 deletions(-) diff --git a/R/data.R b/R/data.R index ca83a2a6..02267f2f 100644 --- a/R/data.R +++ b/R/data.R @@ -95,7 +95,7 @@ #' \item{Purpose}{ Purpose of the dataset} #' \item{Key, Variables}{ Join Key variables in the dataset} #' \item{Repeating}{ Indicates if the dataset is repeating} -#' \item{Reference Data}{ Regerence Data} +#' \item{Reference Data}{ Reference Data} #' \item{Comment}{ Additional comment} #' } "dataset_spec" diff --git a/R/format.R b/R/format.R index 4e6b908d..4e4c37c8 100644 --- a/R/format.R +++ b/R/format.R @@ -2,7 +2,7 @@ #' #' Assigns a SAS format from a variable level metadata to a given data frame. If #' no format is found for a given variable, it is set as an empty character -#' vector. This is stored in the format.sas attribute. +#' vector. This is stored in the '`format.sas`' attribute. #' #' @inheritParams xportr_length #' @@ -19,7 +19,7 @@ #' function. #' #' 2) Format Name - passed as the 'xportr.format_name' option. -#' Default: "format". Character values to update the 'format.sas' attribute of +#' Default: "format". Character values to update the '`format.sas`' attribute of #' the column. This is passed to `haven::write` to note the format. #' #' 3) Variable Name - passed as the 'xportr.variable_name' option. Default: diff --git a/R/order.R b/R/order.R index 60bccbc8..3f1842c1 100644 --- a/R/order.R +++ b/R/order.R @@ -39,8 +39,8 @@ #' #' 3) Variable Order - passed as the 'xportr.order_name' option. #' Default: "order". These values used to arrange the order of the variables. -#' If the values of order metadata are not numeric, they will be corsersed to -#' prevent alphabetical sorting of numberic values. +#' If the values of order metadata are not numeric, they will be coerced to +#' prevent alphabetical sorting of numeric values. #' #' @return Dataframe that has been re-ordered according to spec #' diff --git a/R/type.R b/R/type.R index 8f45e326..c0198e20 100644 --- a/R/type.R +++ b/R/type.R @@ -5,7 +5,8 @@ #' 'xportr.character_types' option is used to explicitly collapse the class of a #' column to character using `as.character`. Similarly, 'xportr.numeric_types' #' will collapse a column to a numeric type. If no type is passed for a -#' variable and it isn't identifed as a timing variable, it is assumed to be numeric and coerced with `as.numeric`. +#' variable and it isn't identified as a timing variable, it is assumed to be +#' numeric and coerced with `as.numeric`. #' #' Certain care should be taken when using timing variables. R serializes dates #' based on a reference date of 01/01/1970 where XPT uses 01/01/1960. This can @@ -13,7 +14,7 @@ #' using a date class. For this reason, `xportr` will try to determine what #' should happen with variables that appear to be used to denote time. #' -#' For variables that end in DT, DTM, or, TM, if they are not explicitly noted +#' For variables that end in `DT`, `DTM`, or, `TM`, if they are not explicitly noted #' in 'xportr.numeric_types' or 'xportr.character_types', they are coerced to #' numeric results. #' @@ -37,7 +38,7 @@ #' function. #' #' 2) Format Name - passed as the 'xportr.format_name' option. Default: -#' "format". Character values to update the 'format.sas' attribute of the +#' "format". Character values to update the '`format.sas`' attribute of the #' column. This is passed to `haven::write` to note the format. #' #' 3) Variable Name - passed as the 'xportr.variable_name' option. Default: @@ -48,14 +49,14 @@ #' is used to note the XPT variable "type" options are numeric or character. #' #' 5) (Option only) Character Types - The list of classes that should be -#' explicitly coerced to a XPT Character type. Default: c( "character", +#' explicitly coerced to a XPT Character type. Default: `c( "character", #' "char", "text", "date", "posixct", "posixt", "datetime", "time", #' "partialdate", "partialtime", "partialdatetime", "incompletedatetime", -#' "durationdatetime", "intervaldatetime") +#' "durationdatetime", "intervaldatetime")` #' #' 6) (Option only) Numeric Types - The list of classes that should be -#' explicitly coerced to a XPT numeric type. Default: c("integer", "numeric", -#' "num", "float") +#' explicitly coerced to a XPT numeric type. Default: `c("integer", "numeric", +#' "num", "float")` #' #' @return Returns the modified table. #' @export diff --git a/R/xportr-package.R b/R/xportr-package.R index 197ad5be..e7d4d7f2 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -4,7 +4,7 @@ #' CDISC complaint data sets in R, to XPT version 5 files. It was designed with #' options in mind to allow for flexible setting of options while allowing #' projects and system administrators to set sensible defaults for their -#' orginziations workflows. Below are a list of options that can be set to +#' organizations workflows. Below are a list of options that can be set to #' customize how `xportr` works in your environment. #' #' @section xportr options: @@ -64,15 +64,15 @@ #' } #' \item{ #' xportr.character_types - The default character vector used to explicitly -#' coerce R classes to character XPT types. Default: c("character", "char", +#' coerce R classes to character XPT types. Default: `c("character", "char", #' "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", #' "partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", -#' "intervaldatetime") +#' "intervaldatetime")` #' } #' \item{ #' xportr.numeric_types - The default character vector used to explicitly -#' coerce R classes to numeric XPT types. Default: c("integer", "numeric", -#' "num", "float") +#' coerce R classes to numeric XPT types. Default: `c("integer", "numeric", +#' "num", "float")` #' } #' } #' diff --git a/man/dataset_spec.Rd b/man/dataset_spec.Rd index 7ab0d370..6d581ab2 100644 --- a/man/dataset_spec.Rd +++ b/man/dataset_spec.Rd @@ -16,7 +16,7 @@ A data frame with 1 row and 9 columns: \item{Purpose}{\if{html}{\out{}} Purpose of the dataset} \item{Key, Variables}{\if{html}{\out{}} Join Key variables in the dataset} \item{Repeating}{\if{html}{\out{}} Indicates if the dataset is repeating} -\item{Reference Data}{\if{html}{\out{}} Regerence Data} +\item{Reference Data}{\if{html}{\out{}} Reference Data} \item{Comment}{\if{html}{\out{}} Additional comment} } } diff --git a/man/xportr-package.Rd b/man/xportr-package.Rd index 64eaed80..cc452951 100644 --- a/man/xportr-package.Rd +++ b/man/xportr-package.Rd @@ -10,7 +10,7 @@ CDISC complaint data sets in R, to XPT version 5 files. It was designed with options in mind to allow for flexible setting of options while allowing projects and system administrators to set sensible defaults for their -orginziations workflows. Below are a list of options that can be set to +organizations workflows. Below are a list of options that can be set to customize how \code{xportr} works in your environment. } \section{xportr options}{ @@ -71,15 +71,11 @@ xportr.type_verbose - The default argument for the 'verbose' argument for } \item{ xportr.character_types - The default character vector used to explicitly -coerce R classes to character XPT types. Default: c("character", "char", -"text", "date", "posixct", "posixt", "datetime", "time", "partialdate", -"partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", -"intervaldatetime") +coerce R classes to character XPT types. Default: \code{c("character", "char", "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", "partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", "intervaldatetime")} } \item{ xportr.numeric_types - The default character vector used to explicitly -coerce R classes to numeric XPT types. Default: c("integer", "numeric", -"num", "float") +coerce R classes to numeric XPT types. Default: \code{c("integer", "numeric", "num", "float")} } } } diff --git a/man/xportr_format.Rd b/man/xportr_format.Rd index 059fe168..dd883554 100644 --- a/man/xportr_format.Rd +++ b/man/xportr_format.Rd @@ -25,7 +25,7 @@ Data frame with \code{SASformat} attributes for each variable. \description{ Assigns a SAS format from a variable level metadata to a given data frame. If no format is found for a given variable, it is set as an empty character -vector. This is stored in the format.sas attribute. +vector. This is stored in the '\code{format.sas}' attribute. } \section{Metadata}{ The argument passed in the 'metadata' argument can either @@ -38,7 +38,7 @@ For data.frame 'metadata' arguments three columns must be present: "dataset". This is the column subset by the 'domain' argument in the function. \item Format Name - passed as the 'xportr.format_name' option. -Default: "format". Character values to update the 'format.sas' attribute of +Default: "format". Character values to update the '\code{format.sas}' attribute of the column. This is passed to \code{haven::write} to note the format. \item Variable Name - passed as the 'xportr.variable_name' option. Default: "variable". This is used to match columns in '.df' argument and the diff --git a/man/xportr_order.Rd b/man/xportr_order.Rd index de8ec9cd..50fd7e73 100644 --- a/man/xportr_order.Rd +++ b/man/xportr_order.Rd @@ -69,8 +69,8 @@ Default: "variable". This is used to match columns in '.df' argument and the metadata. \item Variable Order - passed as the 'xportr.order_name' option. Default: "order". These values used to arrange the order of the variables. -If the values of order metadata are not numeric, they will be corsersed to -prevent alphabetical sorting of numberic values. +If the values of order metadata are not numeric, they will be coerced to +prevent alphabetical sorting of numeric values. } } diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index 440cf535..f8c17945 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -38,7 +38,8 @@ attempts to collapse R classes to those two XPT types. The 'xportr.character_types' option is used to explicitly collapse the class of a column to character using \code{as.character}. Similarly, 'xportr.numeric_types' will collapse a column to a numeric type. If no type is passed for a -variable and it isn't identifed as a timing variable, it is assumed to be numeric and coerced with \code{as.numeric}. +variable and it isn't identified as a timing variable, it is assumed to be +numeric and coerced with \code{as.numeric}. } \details{ Certain care should be taken when using timing variables. R serializes dates @@ -47,7 +48,7 @@ result in dates being 10 years off when outputting from R to XPT if you're using a date class. For this reason, \code{xportr} will try to determine what should happen with variables that appear to be used to denote time. -For variables that end in DT, DTM, or, TM, if they are not explicitly noted +For variables that end in \code{DT}, \code{DTM}, or, \code{TM}, if they are not explicitly noted in 'xportr.numeric_types' or 'xportr.character_types', they are coerced to numeric results. } @@ -71,7 +72,7 @@ For data.frame 'metadata' arguments four columns must be present: "dataset". This is the column subset by the 'domain' argument in the function. \item Format Name - passed as the 'xportr.format_name' option. Default: -"format". Character values to update the 'format.sas' attribute of the +"format". Character values to update the '\code{format.sas}' attribute of the column. This is passed to \code{haven::write} to note the format. \item Variable Name - passed as the 'xportr.variable_name' option. Default: "variable". This is used to match columns in '.df' argument and the @@ -79,13 +80,9 @@ metadata. \item Variable Type - passed as the 'xportr.type_name'. Default: "type". This is used to note the XPT variable "type" options are numeric or character. \item (Option only) Character Types - The list of classes that should be -explicitly coerced to a XPT Character type. Default: c( "character", -"char", "text", "date", "posixct", "posixt", "datetime", "time", -"partialdate", "partialtime", "partialdatetime", "incompletedatetime", -"durationdatetime", "intervaldatetime") +explicitly coerced to a XPT Character type. Default: \code{c( "character", "char", "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", "partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", "intervaldatetime")} \item (Option only) Numeric Types - The list of classes that should be -explicitly coerced to a XPT numeric type. Default: c("integer", "numeric", -"num", "float") +explicitly coerced to a XPT numeric type. Default: \code{c("integer", "numeric", "num", "float")} } } From 1841c4e62206a4fa585763176addeb421aa7fce0 Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 17 Jan 2024 05:37:54 -0500 Subject: [PATCH 142/267] Udpate function description to remove reference to DT, DTM and TM --- R/type.R | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/R/type.R b/R/type.R index 34ab1dfc..371fed06 100644 --- a/R/type.R +++ b/R/type.R @@ -5,7 +5,7 @@ #' 'xportr.character_types' option is used to explicitly collapse the class of a #' column to character using `as.character`. Similarly, 'xportr.numeric_types' #' will collapse a column to a numeric type. If no type is passed for a -#' variable and it isn't identifed as a timing variable, it is assumed to be numeric and coerced with `as.numeric`. +#' variable, it is assumed to be numeric and coerced with `as.numeric`. #' #' Certain care should be taken when using timing variables. R serializes dates #' based on a reference date of 01/01/1970 where XPT uses 01/01/1960. This can @@ -13,10 +13,6 @@ #' using a date class. For this reason, `xportr` will try to determine what #' should happen with variables that appear to be used to denote time. #' -#' For variables that end in DT, DTM, or, TM, if they are not explicitly noted -#' in 'xportr.numeric_types' or 'xportr.character_types', they are coerced to -#' numeric results. -#' #' @inheritParams xportr_length #' #' @section Messaging: `type_log()` is the primary messaging tool for From 7ec86fb450f2fddcc14ea033cf55120937819c43 Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 17 Jan 2024 05:58:00 -0500 Subject: [PATCH 143/267] Added Changes Description --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index 0adb7867..9151fb6b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -7,6 +7,8 @@ * Added a check for character variable lengths up to 200 bytes in `xpt_validate()`(#91, #189). +* Added xportr.character_metadata_types and xportr.numeric_metadata_types so that all R types, including dates, are handled by xportr_type. In case the R type is different from the metadata type, the variable is coerced (#161). + ## Deprecation and Breaking Changes * The `label` argument from the `xportr_write()` function is deprecated in favor of the `metadata` argument. (#179) From d88c3ca74aa648298d79b7f1fa38df3eac76a37d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 17 Jan 2024 11:59:12 +0100 Subject: [PATCH 144/267] convert all instances of tmpfile and tmpdir --- NAMESPACE | 5 ++ R/support-test.R | 6 +-- R/xportr-package.R | 2 + tests/testthat/test-metadata.R | 2 +- tests/testthat/test-type.R | 2 +- tests/testthat/test-write.R | 91 ++++++++-------------------------- 6 files changed, 34 insertions(+), 74 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index d2f10378..2b2cce37 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -68,3 +68,8 @@ importFrom(utils,capture.output) importFrom(utils,packageVersion) importFrom(utils,str) importFrom(utils,tail) +importFrom(withr,defer) +importFrom(withr,local_envvar) +importFrom(withr,local_file) +importFrom(withr,local_message_sink) +importFrom(withr,local_tempfile) diff --git a/R/support-test.R b/R/support-test.R index d223a6d6..3d344ffa 100644 --- a/R/support-test.R +++ b/R/support-test.R @@ -122,10 +122,10 @@ local_cli_theme <- function(.local_envir = parent.frame()) { `.alert-success` = list(before = NULL) ) - withr::local_options(list(cli.user_theme = cli_theme_tests), .local_envir = .local_envir) - withr::local_envvar(list(NO_COLOR = "yes"), .local_envir = .local_envir) + withr::local_options(list(cli.user_theme = cli_theme_tests), .frame = .local_envir) + local_envvar(list(NO_COLOR = "yes"), .local_envir = .local_envir) app <- cli::start_app(output = "message", .auto_close = FALSE) - withr::defer(cli::stop_app(app), envir = .local_envir) + defer(cli::stop_app(app), envir = .local_envir) } #' Test if multiple vars in spec will result in warning message diff --git a/R/xportr-package.R b/R/xportr-package.R index 197ad5be..cb609f37 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -108,6 +108,8 @@ #' @importFrom tm stemDocument #' @importFrom graphics stem #' @importFrom magrittr %>% extract2 +#' @importFrom withr local_file local_tempfile local_message_sink defer +#' local_envvar #' "_PACKAGE" diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index e50a0741..065ff1dd 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -618,7 +618,7 @@ test_that("xportr_*: Domain is kept in between calls", { # Divert all messages to tempfile, instead of printing them # note: be aware as this should only be used in tests that don't track # messages - withr::local_message_sink(tempfile()) + local_message_sink(local_tempfile()) adsl <- minimal_table(30) diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index aa31baf1..94cc7a1b 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -152,7 +152,7 @@ test_that("xportr_type: Variables retain column attributes, besides class", { # Divert all messages to tempfile, instead of printing them # note: be aware as this should only be used in tests that don't track # messages - withr::local_message_sink(tempfile()) + local_message_sink(local_tempfile()) df_type_label <- adsl %>% xportr_metadata(domain = "adsl") %>% diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index d53c7eb0..2016c25e 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -1,20 +1,14 @@ data_to_save <- dplyr::tibble(X = c(1, 2, NA), Y = c("a", "", "c"), Z = c(1, 2, 3)) test_that("xportr_write: exported data can be saved to a file", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") - - on.exit(unlink(tmpdir)) + tmp <- local_file("xyz.xpt") xportr_write(data_to_save, path = tmp) expect_equal(read_xpt(tmp), data_to_save) }) test_that("xportr_write: exported data can still be saved to a file with a label", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") - - on.exit(unlink(tmpdir)) + tmp <- local_file("xyz.xpt") suppressWarnings( xportr_write(data_to_save, @@ -27,10 +21,7 @@ test_that("xportr_write: exported data can still be saved to a file with a label }) test_that("xportr_write: exported data can be saved to a file with a metadata", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") - - on.exit(unlink(tmpdir)) + tmp <- local_file("xyz.xpt") xportr_write( data_to_save, @@ -45,10 +36,7 @@ test_that("xportr_write: exported data can be saved to a file with a metadata", }) test_that("xportr_write: exported data can be saved to a file with a existing metadata", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") - - on.exit(unlink(tmpdir)) + tmp <- local_file("xyz.xpt") df <- xportr_df_label( data_to_save, @@ -64,15 +52,10 @@ test_that("xportr_write: exported data can be saved to a file with a existing me }) test_that("xportr_write: expect error when invalid multibyte string is passed in label", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") - - on.exit(unlink(tmpdir)) - expect_error( xportr_write( data_to_save, - tmp, + local_file("xyz.xpt"), metadata = data.frame( dataset = "data_to_save", label = "Lorizzle ipsizzle dolizzl\xe7 pizzle" @@ -82,38 +65,27 @@ test_that("xportr_write: expect error when invalid multibyte string is passed in }) test_that("xportr_write: expect error when file name is over 8 characters long", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, paste0(paste(letters[1:9], collapse = ""), ".xpt")) - - on.exit(unlink(tmpdir)) - - expect_error(xportr_write(data_to_save, tmp)) + expect_error( + xportr_write( + data_to_save, + local_file(paste0(paste(letters[1:9], collapse = ""), ".xpt")) + ) + ) }) test_that("xportr_write: expect error when file name contains non-ASCII symbols or special characters", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, ".xpt") - - on.exit(unlink(tmpdir)) - - expect_error(xportr_write(data_to_save, tmp)) + expect_error( + xportr_write(data_to_save, local_file(".xpt"), strict_checks = TRUE) + ) }) test_that("xportr_write: expect warning when file name contains underscore and strict_checks = FALSE", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "test_.xpt") - - on.exit(unlink(tmpdir)) - - expect_warning(xportr_write(data_to_save, tmp, strict_checks = FALSE)) + expect_warning( + xportr_write(data_to_save, local_file("test_.xpt"), strict_checks = FALSE) + ) }) test_that("xportr_write: expect error when label contains non-ASCII symbols or special characters", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") - - on.exit(unlink(tmpdir)) - expect_error( xportr_write( data_to_save, @@ -122,7 +94,7 @@ test_that("xportr_write: expect error when label contains non-ASCII symbols or s xportr_write( data_to_save, domain = "data_to_save", - tmp, + path = local_file("xyz.xpt"), metadata = data.frame( dataset = "data_to_save", label = "çtestç" @@ -134,16 +106,11 @@ test_that("xportr_write: expect error when label contains non-ASCII symbols or s }) test_that("xportr_write: expect error when label is over 40 characters", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") - - on.exit(unlink(tmpdir)) - expect_error( xportr_write( data_to_save, domain = "data_to_save", - tmp, + path = local_file("xyz.xpt"), metadata = data.frame( dataset = "data_to_save", label = paste(rep("a", 41), collapse = "") @@ -153,15 +120,11 @@ test_that("xportr_write: expect error when label is over 40 characters", { }) test_that("xportr_write: expect error when an xpt validation fails with strict_checks set to TRUE", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") attr(data_to_save$X, "format.sas") <- "foo" - on.exit(unlink(tmpdir)) - expect_error( xportr_write( - data_to_save, tmp, + data_to_save, local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", @@ -173,15 +136,11 @@ test_that("xportr_write: expect error when an xpt validation fails with strict_c }) test_that("xportr_write: expect warning when an xpt validation fails with strict_checks set to FALSE", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") attr(data_to_save$X, "format.sas") <- "foo" - on.exit(unlink(tmpdir)) - expect_warning( xportr_write( - data_to_save, tmp, + data_to_save, local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", @@ -192,19 +151,13 @@ test_that("xportr_write: expect warning when an xpt validation fails with strict ) }) - test_that("xportr_write: Capture errors by haven and report them as such", { - tmpdir <- tempdir() - tmp <- file.path(tmpdir, "xyz.xpt") attr(data_to_save$X, "format.sas") <- "E8601LXw.asdf" - on.exit(unlink(tmpdir)) - - expect_error( suppressWarnings( xportr_write( - data_to_save, tmp, + data_to_save, local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", From c2c24bf423fae29856f5d63b1b27f664af2aa8c6 Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 17 Jan 2024 05:59:43 -0500 Subject: [PATCH 145/267] Updated function description --- man/xportr_type.Rd | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index 1a49735b..f9fdab8a 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -38,7 +38,7 @@ attempts to collapse R classes to those two XPT types. The 'xportr.character_types' option is used to explicitly collapse the class of a column to character using \code{as.character}. Similarly, 'xportr.numeric_types' will collapse a column to a numeric type. If no type is passed for a -variable and it isn't identifed as a timing variable, it is assumed to be numeric and coerced with \code{as.numeric}. +variable, it is assumed to be numeric and coerced with \code{as.numeric}. } \details{ Certain care should be taken when using timing variables. R serializes dates @@ -46,10 +46,6 @@ based on a reference date of 01/01/1970 where XPT uses 01/01/1960. This can result in dates being 10 years off when outputting from R to XPT if you're using a date class. For this reason, \code{xportr} will try to determine what should happen with variables that appear to be used to denote time. - -For variables that end in DT, DTM, or, TM, if they are not explicitly noted -in 'xportr.numeric_types' or 'xportr.character_types', they are coerced to -numeric results. } \section{Messaging}{ \code{type_log()} is the primary messaging tool for From adecc2724b0f8a42061d96c5dc05ee83ff2d50bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 17 Jan 2024 12:05:54 +0100 Subject: [PATCH 146/267] docs: adds NEWS entry --- NEWS.md | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index 73c35fec..e6d3647a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,7 +4,6 @@ * `xportr_write()` now accepts `metadata` argument which can be used to set the dataset label to stay consistent with the other `xportr_*` functions. It is noteworthy that the dataset label set using the `xportr_df_label()` function will be retained during the `xportr_write()`. * Exporting a new dataset `dataset_spec` that contains the Dataset Specification for ADSL. (#179) - * 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) @@ -13,7 +12,6 @@ * 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`. @@ -22,6 +20,10 @@ done to make the use of xportr functions more explicit. (#182) * Created development version of the website (#187) * Additional guidance for options added in deep dive vignette (#81) +## Miscellaneous + +* Tests use `{withr}` to create temporary files that are automatically deleted (#219) + # xportr 0.3.1 ## New Features and Bug Fixes From 5ef7db4cdb9756413e94dada2b3da2b99d3abea0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 17 Jan 2024 12:14:55 +0100 Subject: [PATCH 147/267] rever to use double colon from suggests --- NAMESPACE | 5 ----- R/support-test.R | 4 ++-- R/xportr-package.R | 2 -- tests/testthat/test-metadata.R | 2 +- tests/testthat/test-type.R | 2 +- tests/testthat/test-write.R | 26 +++++++++++++------------- 6 files changed, 17 insertions(+), 24 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 2b2cce37..d2f10378 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -68,8 +68,3 @@ importFrom(utils,capture.output) importFrom(utils,packageVersion) importFrom(utils,str) importFrom(utils,tail) -importFrom(withr,defer) -importFrom(withr,local_envvar) -importFrom(withr,local_file) -importFrom(withr,local_message_sink) -importFrom(withr,local_tempfile) diff --git a/R/support-test.R b/R/support-test.R index 3d344ffa..ddd38ee8 100644 --- a/R/support-test.R +++ b/R/support-test.R @@ -123,9 +123,9 @@ local_cli_theme <- function(.local_envir = parent.frame()) { ) withr::local_options(list(cli.user_theme = cli_theme_tests), .frame = .local_envir) - local_envvar(list(NO_COLOR = "yes"), .local_envir = .local_envir) + withr::local_envvar(list(NO_COLOR = "yes"), .local_envir = .local_envir) app <- cli::start_app(output = "message", .auto_close = FALSE) - defer(cli::stop_app(app), envir = .local_envir) + withr::defer(cli::stop_app(app), envir = .local_envir) } #' Test if multiple vars in spec will result in warning message diff --git a/R/xportr-package.R b/R/xportr-package.R index cb609f37..197ad5be 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -108,8 +108,6 @@ #' @importFrom tm stemDocument #' @importFrom graphics stem #' @importFrom magrittr %>% extract2 -#' @importFrom withr local_file local_tempfile local_message_sink defer -#' local_envvar #' "_PACKAGE" diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index 065ff1dd..cae37e0a 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -618,7 +618,7 @@ test_that("xportr_*: Domain is kept in between calls", { # Divert all messages to tempfile, instead of printing them # note: be aware as this should only be used in tests that don't track # messages - local_message_sink(local_tempfile()) + withr::local_message_sink(withr::local_tempfile()) adsl <- minimal_table(30) diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index 94cc7a1b..865b16aa 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -152,7 +152,7 @@ test_that("xportr_type: Variables retain column attributes, besides class", { # Divert all messages to tempfile, instead of printing them # note: be aware as this should only be used in tests that don't track # messages - local_message_sink(local_tempfile()) + withr::local_message_sink(withr::local_tempfile()) df_type_label <- adsl %>% xportr_metadata(domain = "adsl") %>% diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index 2016c25e..1d6d3b45 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -1,14 +1,14 @@ data_to_save <- dplyr::tibble(X = c(1, 2, NA), Y = c("a", "", "c"), Z = c(1, 2, 3)) test_that("xportr_write: exported data can be saved to a file", { - tmp <- local_file("xyz.xpt") + tmp <- withr::local_file("xyz.xpt") xportr_write(data_to_save, path = tmp) expect_equal(read_xpt(tmp), data_to_save) }) test_that("xportr_write: exported data can still be saved to a file with a label", { - tmp <- local_file("xyz.xpt") + tmp <- withr::local_file("xyz.xpt") suppressWarnings( xportr_write(data_to_save, @@ -21,7 +21,7 @@ test_that("xportr_write: exported data can still be saved to a file with a label }) test_that("xportr_write: exported data can be saved to a file with a metadata", { - tmp <- local_file("xyz.xpt") + tmp <- withr::local_file("xyz.xpt") xportr_write( data_to_save, @@ -36,7 +36,7 @@ test_that("xportr_write: exported data can be saved to a file with a metadata", }) test_that("xportr_write: exported data can be saved to a file with a existing metadata", { - tmp <- local_file("xyz.xpt") + tmp <- withr::local_file("xyz.xpt") df <- xportr_df_label( data_to_save, @@ -55,7 +55,7 @@ test_that("xportr_write: expect error when invalid multibyte string is passed in expect_error( xportr_write( data_to_save, - local_file("xyz.xpt"), + withr::local_file("xyz.xpt"), metadata = data.frame( dataset = "data_to_save", label = "Lorizzle ipsizzle dolizzl\xe7 pizzle" @@ -68,20 +68,20 @@ test_that("xportr_write: expect error when file name is over 8 characters long", expect_error( xportr_write( data_to_save, - local_file(paste0(paste(letters[1:9], collapse = ""), ".xpt")) + withr::local_file(paste0(paste(letters[1:9], collapse = ""), ".xpt")) ) ) }) test_that("xportr_write: expect error when file name contains non-ASCII symbols or special characters", { expect_error( - xportr_write(data_to_save, local_file(".xpt"), strict_checks = TRUE) + xportr_write(data_to_save, withr::local_file(".xpt"), strict_checks = TRUE) ) }) test_that("xportr_write: expect warning when file name contains underscore and strict_checks = FALSE", { expect_warning( - xportr_write(data_to_save, local_file("test_.xpt"), strict_checks = FALSE) + xportr_write(data_to_save, withr::local_file("test_.xpt"), strict_checks = FALSE) ) }) @@ -94,7 +94,7 @@ test_that("xportr_write: expect error when label contains non-ASCII symbols or s xportr_write( data_to_save, domain = "data_to_save", - path = local_file("xyz.xpt"), + path = withr::local_file("xyz.xpt"), metadata = data.frame( dataset = "data_to_save", label = "çtestç" @@ -110,7 +110,7 @@ test_that("xportr_write: expect error when label is over 40 characters", { xportr_write( data_to_save, domain = "data_to_save", - path = local_file("xyz.xpt"), + path = withr::local_file("xyz.xpt"), metadata = data.frame( dataset = "data_to_save", label = paste(rep("a", 41), collapse = "") @@ -124,7 +124,7 @@ test_that("xportr_write: expect error when an xpt validation fails with strict_c expect_error( xportr_write( - data_to_save, local_file("xyz.xpt"), + data_to_save, withr::local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", @@ -140,7 +140,7 @@ test_that("xportr_write: expect warning when an xpt validation fails with strict expect_warning( xportr_write( - data_to_save, local_file("xyz.xpt"), + data_to_save, withr::local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", @@ -157,7 +157,7 @@ test_that("xportr_write: Capture errors by haven and report them as such", { expect_error( suppressWarnings( xportr_write( - data_to_save, local_file("xyz.xpt"), + data_to_save, withr::local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", From b96350ccaea88a33dcafaed37a70905af1c2128d Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 17 Jan 2024 06:28:28 -0500 Subject: [PATCH 148/267] fixed small bug --- tests/testthat/test-type.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index 45a3167d..d35207ed 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -339,6 +339,7 @@ test_that("xportr_metadata: Var date types (--DTC) coerced as expected and raise STUDYID = "character", USUBJID = "character", TRTEDT = "Date", EXSTDTC = "character" )) +}) test_that("xportr_type: Works as expected with only one domain in metadata", { adsl <- data.frame( From b24ae2506466a79d0b784257d7ccf126f5574033 Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 17 Jan 2024 06:29:40 -0500 Subject: [PATCH 149/267] Removed blank lines --- tests/testthat/test-type.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index d35207ed..dca4bc46 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -305,8 +305,6 @@ test_that("xportr_type: Drops factor levels", { expect_null(attributes(df2$Val)) }) - - df <- data.frame( STUDYID = c("PILOT01", "PILOT01", "PILOT01"), USUBJID = c("01-1130", "01-1133", "01-1133"), From fbf7839eede79bd65b90e47e7c34f993562360f1 Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 17 Jan 2024 06:35:46 -0500 Subject: [PATCH 150/267] Removed blank line --- tests/testthat/test-type.R | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index dca4bc46..244a85f0 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -353,5 +353,4 @@ test_that("xportr_type: Works as expected with only one domain in metadata", { ) expect_equal(xportr_type(adsl, metadata), adsl) - }) From 7a523e0666ba30b69b0ce6d89c3a7b4fc5363dfa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 17 Jan 2024 12:36:31 +0100 Subject: [PATCH 151/267] make withr optional following CRAN guidelines --- R/support-test.R | 16 ++++++++++------ tests/testthat/test-depreciation.R | 12 ++++++------ tests/testthat/test-length.R | 12 ++++++------ tests/testthat/test-metadata.R | 4 +++- tests/testthat/test-pkg-load.R | 12 ++++++------ tests/testthat/test-type.R | 4 +++- tests/testthat/test-write.R | 13 +++++++++++++ 7 files changed, 47 insertions(+), 26 deletions(-) diff --git a/R/support-test.R b/R/support-test.R index ddd38ee8..de38f3d0 100644 --- a/R/support-test.R +++ b/R/support-test.R @@ -122,10 +122,14 @@ local_cli_theme <- function(.local_envir = parent.frame()) { `.alert-success` = list(before = NULL) ) - withr::local_options(list(cli.user_theme = cli_theme_tests), .frame = .local_envir) - withr::local_envvar(list(NO_COLOR = "yes"), .local_envir = .local_envir) - app <- cli::start_app(output = "message", .auto_close = FALSE) - withr::defer(cli::stop_app(app), envir = .local_envir) + # Use rlang::local_options instead of withr (Suggest package) + local_options(cli.user_theme = cli_theme_tests, .frame = .local_envir) + app <- cli::start_app(output = "message", .auto_close = FALSE, .envir = .local_envir) + + if (requireNamespace("withr", quietly = TRUE)) { + withr::local_envvar(NO_COLOR = "yes", .frame = .local_envir) + withr::defer(cli::stop_app(app), envir = .local_envir) + } } #' Test if multiple vars in spec will result in warning message @@ -147,7 +151,7 @@ multiple_vars_in_spec_helper <- function(FUN) { dplyr::bind_rows(metadata) %>% dplyr::rename(Dataset = "dataset") - withr::local_options(list(xportr.length_verbose = "message")) + local_options(xportr.length_verbose = "message") # Setup temporary options with active verbose and Remove empty lines in cli theme local_cli_theme() @@ -175,7 +179,7 @@ multiple_vars_in_spec_helper2 <- function(FUN) { dplyr::bind_rows(metadata) %>% dplyr::rename(Dataset = "dataset") - withr::local_options(list(xportr.length_verbose = "message", xportr.domain_name = "Dataset")) + local_options(xportr.length_verbose = "message", xportr.domain_name = "Dataset") # Setup temporary options with active verbose and Remove empty lines in cli theme local_cli_theme() diff --git a/tests/testthat/test-depreciation.R b/tests/testthat/test-depreciation.R index 2679ecc9..d1eb0cd2 100644 --- a/tests/testthat/test-depreciation.R +++ b/tests/testthat/test-depreciation.R @@ -1,5 +1,5 @@ test_that("xportr_df_label: deprecated metacore gives an error", { - withr::local_options(lifecycle_verbosity = "quiet") + local_options(lifecycle_verbosity = "quiet") df <- data.frame(x = "a", y = "b") df_meta <- data.frame(dataset = "df", label = "Label") @@ -7,7 +7,7 @@ test_that("xportr_df_label: deprecated metacore gives an error", { }) test_that("xportr_format: deprecated metacore gives an error", { - withr::local_options(lifecycle_verbosity = "quiet") + local_options(lifecycle_verbosity = "quiet") df <- data.frame(x = 1, y = 2) df_meta <- data.frame( dataset = "df", @@ -19,7 +19,7 @@ test_that("xportr_format: deprecated metacore gives an error", { }) test_that("xportr_label: using the deprecated metacore argument gives an error", { - withr::local_options(lifecycle_verbosity = "quiet") + local_options(lifecycle_verbosity = "quiet") df <- data.frame(x = "a", y = "b") df_meta <- data.frame(dataset = "df", variable = "x", label = "foo") @@ -28,7 +28,7 @@ test_that("xportr_label: using the deprecated metacore argument gives an error", }) test_that("xportr_length: using the deprecated metacore argument gives an error", { - withr::local_options(lifecycle_verbosity = "quiet") + local_options(lifecycle_verbosity = "quiet") df <- data.frame(x = "a", y = "b") df_meta <- data.frame( dataset = "df", @@ -41,7 +41,7 @@ test_that("xportr_length: using the deprecated metacore argument gives an error" }) test_that("xportr_order: using the deprecated metacore argument gives an error", { - withr::local_options(lifecycle_verbosity = "quiet") + local_options(lifecycle_verbosity = "quiet") df <- data.frame(c = 1:5, a = "a", d = 5:1, b = LETTERS[1:5]) df_meta <- data.frame( @@ -54,7 +54,7 @@ test_that("xportr_order: using the deprecated metacore argument gives an error", }) test_that("xportr_type: using the deprecated metacore argument gives an error", { - withr::local_options(lifecycle_verbosity = "quiet") + local_options(lifecycle_verbosity = "quiet") df <- data.frame( Subj = as.character(c(123, 456, 789, "", NA, NA_integer_)), Different = c("a", "b", "c", "", NA, NA_character_), diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index e3adce3f..0def33be 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -10,7 +10,7 @@ test_that("xportr_length: Accepts valid domain names in metadata object", { metadata <- minimal_metadata(dataset = TRUE, length = TRUE, var_names = colnames(adsl)) # Setup temporary options with active verbose - withr::local_options(list(xportr.length_verbose = "message")) + local_options(xportr.length_verbose = "message") # Test minimal call with valid data and without domain adsl %>% @@ -50,7 +50,7 @@ test_that("xportr_length: CDISC data frame is being piped after another xportr f ) # Setup temporary options with active verbose - withr::local_options(list(xportr.length_verbose = "message")) + local_options(xportr.length_verbose = "message") adsl %>% xportr_type(metadata, domain = "adsl", verbose = "message") %>% @@ -69,9 +69,9 @@ test_that("xportr_length: Impute character lengths based on class", { mutate(length = length - 1) # Setup temporary options with `verbose = "none"` - withr::local_options(list(xportr.length_verbose = "none")) + local_options(xportr.length_verbose = "none") # Define controlled `character_types` for this test - withr::local_options(list(xportr.character_types = c("character", "date"))) + local_options(xportr.character_types = c("character", "date")) # Remove empty lines in cli theme local_cli_theme() @@ -104,7 +104,7 @@ test_that("xportr_length: Throws message when variables not present in metadata" metadata <- minimal_metadata(dataset = TRUE, length = TRUE, var_names = c("x")) # Setup temporary options with `verbose = "message"` - withr::local_options(list(xportr.length_verbose = "message")) + local_options(xportr.length_verbose = "message") # Remove empty lines in cli theme local_cli_theme() @@ -170,7 +170,7 @@ test_that("xportr_length: Column length of known/unkown character types is 200/8 expect_equal(impute_length(Sys.Date()), 200) expect_equal(impute_length(Sys.time()), 200) - withr::local_options(list(xportr.character_types = c("character", "date"))) + local_options(xportr.character_types = c("character", "date")) expect_equal(impute_length(Sys.time()), 8) }) diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index cae37e0a..443166d9 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -618,7 +618,9 @@ test_that("xportr_*: Domain is kept in between calls", { # Divert all messages to tempfile, instead of printing them # note: be aware as this should only be used in tests that don't track # messages - withr::local_message_sink(withr::local_tempfile()) + if (requireNamespace("withr", quietly = TRUE)) { + withr::local_message_sink(withr::local_tempfile()) + } adsl <- minimal_table(30) diff --git a/tests/testthat/test-pkg-load.R b/tests/testthat/test-pkg-load.R index 82341de1..be913992 100644 --- a/tests/testthat/test-pkg-load.R +++ b/tests/testthat/test-pkg-load.R @@ -1,21 +1,21 @@ test_that(".onLoad: Unset options get initialised on package load with defaults", { skip_if(getOption("testthat_interactive")) - withr::with_options( - list(xportr.df_domain_name = NULL), + with_options( { expect_no_error(.onLoad()) expect_equal(getOption("xportr.df_domain_name"), "dataset") - } + }, + xportr.df_domain_name = NULL ) }) test_that(".onLoad: Initialised options are retained and not overwritten", { skip_if(getOption("testthat_interactive")) - withr::with_options( - list(xportr.df_domain_name = "custom_domain"), + with_options( { expect_no_error(.onLoad()) expect_equal(getOption("xportr.df_domain_name"), "custom_domain") - } + }, + xportr.df_domain_name = "custom_domain" ) }) diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index 865b16aa..3bc09e7a 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -152,7 +152,9 @@ test_that("xportr_type: Variables retain column attributes, besides class", { # Divert all messages to tempfile, instead of printing them # note: be aware as this should only be used in tests that don't track # messages - withr::local_message_sink(withr::local_tempfile()) + if (requireNamespace("withr", quietly = TRUE)) { + withr::local_message_sink(withr::local_tempfile()) + } df_type_label <- adsl %>% xportr_metadata(domain = "adsl") %>% diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index 1d6d3b45..d11aadc3 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -1,6 +1,7 @@ data_to_save <- dplyr::tibble(X = c(1, 2, NA), Y = c("a", "", "c"), Z = c(1, 2, 3)) test_that("xportr_write: exported data can be saved to a file", { + skip_if_not_installed("withr") tmp <- withr::local_file("xyz.xpt") xportr_write(data_to_save, path = tmp) @@ -8,6 +9,7 @@ test_that("xportr_write: exported data can be saved to a file", { }) test_that("xportr_write: exported data can still be saved to a file with a label", { + skip_if_not_installed("withr") tmp <- withr::local_file("xyz.xpt") suppressWarnings( @@ -21,6 +23,7 @@ test_that("xportr_write: exported data can still be saved to a file with a label }) test_that("xportr_write: exported data can be saved to a file with a metadata", { + skip_if_not_installed("withr") tmp <- withr::local_file("xyz.xpt") xportr_write( @@ -36,6 +39,7 @@ test_that("xportr_write: exported data can be saved to a file with a metadata", }) test_that("xportr_write: exported data can be saved to a file with a existing metadata", { + skip_if_not_installed("withr") tmp <- withr::local_file("xyz.xpt") df <- xportr_df_label( @@ -52,6 +56,7 @@ test_that("xportr_write: exported data can be saved to a file with a existing me }) test_that("xportr_write: expect error when invalid multibyte string is passed in label", { + skip_if_not_installed("withr") expect_error( xportr_write( data_to_save, @@ -65,6 +70,7 @@ test_that("xportr_write: expect error when invalid multibyte string is passed in }) test_that("xportr_write: expect error when file name is over 8 characters long", { + skip_if_not_installed("withr") expect_error( xportr_write( data_to_save, @@ -74,18 +80,21 @@ test_that("xportr_write: expect error when file name is over 8 characters long", }) test_that("xportr_write: expect error when file name contains non-ASCII symbols or special characters", { + skip_if_not_installed("withr") expect_error( xportr_write(data_to_save, withr::local_file(".xpt"), strict_checks = TRUE) ) }) test_that("xportr_write: expect warning when file name contains underscore and strict_checks = FALSE", { + skip_if_not_installed("withr") expect_warning( xportr_write(data_to_save, withr::local_file("test_.xpt"), strict_checks = FALSE) ) }) test_that("xportr_write: expect error when label contains non-ASCII symbols or special characters", { + skip_if_not_installed("withr") expect_error( xportr_write( data_to_save, @@ -106,6 +115,7 @@ test_that("xportr_write: expect error when label contains non-ASCII symbols or s }) test_that("xportr_write: expect error when label is over 40 characters", { + skip_if_not_installed("withr") expect_error( xportr_write( data_to_save, @@ -120,6 +130,7 @@ test_that("xportr_write: expect error when label is over 40 characters", { }) test_that("xportr_write: expect error when an xpt validation fails with strict_checks set to TRUE", { + skip_if_not_installed("withr") attr(data_to_save$X, "format.sas") <- "foo" expect_error( @@ -136,6 +147,7 @@ test_that("xportr_write: expect error when an xpt validation fails with strict_c }) test_that("xportr_write: expect warning when an xpt validation fails with strict_checks set to FALSE", { + skip_if_not_installed("withr") attr(data_to_save$X, "format.sas") <- "foo" expect_warning( @@ -152,6 +164,7 @@ test_that("xportr_write: expect warning when an xpt validation fails with strict }) test_that("xportr_write: Capture errors by haven and report them as such", { + skip_if_not_installed("withr") attr(data_to_save$X, "format.sas") <- "E8601LXw.asdf" expect_error( From 1eb4ac53ba9f6780dfbbbb0b9afd4637678af4d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 17 Jan 2024 13:47:00 +0100 Subject: [PATCH 152/267] fix: problem with test coverage and use of minimal_table --- NAMESPACE | 1 + R/support-test.R | 6 ++- R/write.R | 1 + R/xportr-package.R | 2 +- tests/testthat/test-df_label.R | 8 +--- tests/testthat/test-write.R | 73 ++++++++++++++++++---------------- 6 files changed, 47 insertions(+), 44 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index d2f10378..6231bf16 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,6 +25,7 @@ importFrom(cli,cli_h2) importFrom(cli,cli_text) importFrom(dplyr,across) importFrom(dplyr,arrange) +importFrom(dplyr,as_tibble) importFrom(dplyr,bind_cols) importFrom(dplyr,case_when) importFrom(dplyr,distinct) diff --git a/R/support-test.R b/R/support-test.R index de38f3d0..0fd5cc10 100644 --- a/R/support-test.R +++ b/R/support-test.R @@ -46,9 +46,11 @@ minimal_table <- function(n_rows = 3, cols = c("x", "y")) { size = n_rows, replace = TRUE ), - d = sample(Sys.Date() + c(1, -1, 10, -10), size = n_rows, replace = TRUE) + d = sample(Sys.Date() + c(1, -1, 10, -10), size = n_rows, replace = TRUE), + e = sample(c(1, 2), replace = TRUE, size = n_rows) ) %>% - select(all_of(cols)) + mutate(e = if_else(seq_along(e) %% 2 == 0, NA, e)) %>% + select(all_of(tolower(cols))) } #' Minimal metadata data frame mock for a ADaM dataset diff --git a/R/write.R b/R/write.R index ebe5e200..7b25f097 100644 --- a/R/write.R +++ b/R/write.R @@ -67,6 +67,7 @@ xportr_write <- function(.df, ) metadata <- data.frame(dataset = domain, label = label) } + if (!is.null(metadata)) { .df <- xportr_df_label(.df, metadata = metadata, domain = domain) } diff --git a/R/xportr-package.R b/R/xportr-package.R index 197ad5be..7f79e685 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -95,7 +95,7 @@ #' @import rlang haven #' @importFrom dplyr left_join bind_cols filter select rename rename_with n #' everything arrange group_by summarize mutate ungroup case_when distinct -#' tribble if_else across +#' tribble if_else across as_tibble #' @importFrom glue glue glue_collapse #' @importFrom cli cli_alert_info cli_h2 cli_alert_success cli_div cli_text #' cli_alert_danger diff --git a/tests/testthat/test-df_label.R b/tests/testthat/test-df_label.R index eae3969d..ec1b9a44 100644 --- a/tests/testthat/test-df_label.R +++ b/tests/testthat/test-df_label.R @@ -1,11 +1,5 @@ test_that("xportr_df_label: error when metadata is not set", { - adsl <- data.frame( - USUBJID = c(1001, 1002, 1003), - SITEID = c(001, 002, 003), - AGE = c(63, 35, 27), - SEX = c("M", "F", "M") - ) - + adsl <- minimal_table() expect_error( xportr_df_label(adsl), diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index d11aadc3..b6c784dc 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -1,11 +1,12 @@ -data_to_save <- dplyr::tibble(X = c(1, 2, NA), Y = c("a", "", "c"), Z = c(1, 2, 3)) +data_to_save <- function() minimal_table(cols = c("e", "b", "x")) %>% rename_with(toupper) %>% as_tibble() test_that("xportr_write: exported data can be saved to a file", { skip_if_not_installed("withr") tmp <- withr::local_file("xyz.xpt") + local_data <- data_to_save() - xportr_write(data_to_save, path = tmp) - expect_equal(read_xpt(tmp), data_to_save) + xportr_write(local_data, path = tmp) + expect_equal(read_xpt(tmp), local_data) }) test_that("xportr_write: exported data can still be saved to a file with a label", { @@ -13,7 +14,7 @@ test_that("xportr_write: exported data can still be saved to a file with a label tmp <- withr::local_file("xyz.xpt") suppressWarnings( - xportr_write(data_to_save, + xportr_write(data_to_save(), path = tmp, label = "Lorem ipsum dolor sit amet", domain = "data_to_save" @@ -27,7 +28,7 @@ test_that("xportr_write: exported data can be saved to a file with a metadata", tmp <- withr::local_file("xyz.xpt") xportr_write( - data_to_save, + data_to_save(), path = tmp, domain = "data_to_save", metadata = data.frame( @@ -43,7 +44,7 @@ test_that("xportr_write: exported data can be saved to a file with a existing me tmp <- withr::local_file("xyz.xpt") df <- xportr_df_label( - data_to_save, + data_to_save(), domain = "data_to_save", data.frame( dataset = "data_to_save", @@ -59,7 +60,7 @@ test_that("xportr_write: expect error when invalid multibyte string is passed in skip_if_not_installed("withr") expect_error( xportr_write( - data_to_save, + data_to_save(), withr::local_file("xyz.xpt"), metadata = data.frame( dataset = "data_to_save", @@ -73,23 +74,26 @@ test_that("xportr_write: expect error when file name is over 8 characters long", skip_if_not_installed("withr") expect_error( xportr_write( - data_to_save, + data_to_save(), withr::local_file(paste0(paste(letters[1:9], collapse = ""), ".xpt")) - ) + ), + "`\\.df` file name must be 8 characters or less\\." ) }) test_that("xportr_write: expect error when file name contains non-ASCII symbols or special characters", { skip_if_not_installed("withr") expect_error( - xportr_write(data_to_save, withr::local_file(".xpt"), strict_checks = TRUE) + xportr_write(data_to_save(), withr::local_file(".xpt"), strict_checks = TRUE), + "`\\.df` cannot contain any non-ASCII, symbol or underscore characters\\." ) }) test_that("xportr_write: expect warning when file name contains underscore and strict_checks = FALSE", { skip_if_not_installed("withr") expect_warning( - xportr_write(data_to_save, withr::local_file("test_.xpt"), strict_checks = FALSE) + xportr_write(data_to_save(), withr::local_file("test_.xpt"), strict_checks = FALSE), + "`\\.df` cannot contain any non-ASCII, symbol or underscore characters\\." ) }) @@ -97,20 +101,15 @@ test_that("xportr_write: expect error when label contains non-ASCII symbols or s skip_if_not_installed("withr") expect_error( xportr_write( - data_to_save, - tmp, - expect_error( - xportr_write( - data_to_save, - domain = "data_to_save", - path = withr::local_file("xyz.xpt"), - metadata = data.frame( - dataset = "data_to_save", - label = "çtestç" - ) - ) + data_to_save(), + domain = "data_to_save", + path = withr::local_file("xyz.xpt"), + metadata = data.frame( + dataset = "data_to_save", + label = "çtestç" ) - ) + ), + "`label` cannot contain any non-ASCII, symbol or special characters" ) }) @@ -118,59 +117,65 @@ test_that("xportr_write: expect error when label is over 40 characters", { skip_if_not_installed("withr") expect_error( xportr_write( - data_to_save, + data_to_save(), domain = "data_to_save", path = withr::local_file("xyz.xpt"), metadata = data.frame( dataset = "data_to_save", label = paste(rep("a", 41), collapse = "") ) - ) + ), + "Length of dataset label must be 40 characters or less" ) }) test_that("xportr_write: expect error when an xpt validation fails with strict_checks set to TRUE", { skip_if_not_installed("withr") - attr(data_to_save$X, "format.sas") <- "foo" + local_data <- data_to_save() + attr(local_data$X, "format.sas") <- "foo" expect_error( xportr_write( - data_to_save, withr::local_file("xyz.xpt"), + local_data, withr::local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", label = "label" ), strict_checks = TRUE - ) + ), + "Format 'X' must have a valid format\\." ) }) test_that("xportr_write: expect warning when an xpt validation fails with strict_checks set to FALSE", { skip_if_not_installed("withr") - attr(data_to_save$X, "format.sas") <- "foo" + local_data <- data_to_save() + attr(local_data$X, "format.sas") <- "foo" expect_warning( xportr_write( - data_to_save, withr::local_file("xyz.xpt"), + local_data, withr::local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", label = "label" ), strict_checks = FALSE - ) + ), + "Format 'X' must have a valid format\\." ) }) test_that("xportr_write: Capture errors by haven and report them as such", { skip_if_not_installed("withr") - attr(data_to_save$X, "format.sas") <- "E8601LXw.asdf" + local_data <- data_to_save() + attr(local_data$X, "format.sas") <- "E8601LXw.asdf" expect_error( suppressWarnings( xportr_write( - data_to_save, withr::local_file("xyz.xpt"), + local_data, withr::local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", From 80bddf90397185af41f3a57f6dec6c9f85717fae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 17 Jan 2024 17:39:50 +0100 Subject: [PATCH 153/267] style: one line function divided in more lines --- tests/testthat/test-write.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index b6c784dc..7c263556 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -1,4 +1,8 @@ -data_to_save <- function() minimal_table(cols = c("e", "b", "x")) %>% rename_with(toupper) %>% as_tibble() +data_to_save <- function() { + minimal_table(cols = c("e", "b", "x")) %>% + rename_with(toupper) %>% + as_tibble() +} test_that("xportr_write: exported data can be saved to a file", { skip_if_not_installed("withr") From b65169b5e539abc4fe5dff41dad1397a89266f5d Mon Sep 17 00:00:00 2001 From: Vedha Viyash <49812166+vedhav@users.noreply.github.com> Date: Thu, 18 Jan 2024 00:42:06 +0530 Subject: [PATCH 154/267] Update R/options.R Co-authored-by: Ben Straub --- R/options.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/options.R b/R/options.R index f4c3ab5b..68d66943 100644 --- a/R/options.R +++ b/R/options.R @@ -1,4 +1,4 @@ -#' Get or set Xportr options +#' Get or set xportr options #' #' @description #' From c9ece9d50cc6821cc35a739c8ee4cb1dcea5823d Mon Sep 17 00:00:00 2001 From: Vedha Viyash <49812166+vedhav@users.noreply.github.com> Date: Thu, 18 Jan 2024 00:45:22 +0530 Subject: [PATCH 155/267] Update NEWS.md Co-authored-by: Ben Straub --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 6937cde9..abea5cfc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,7 +6,7 @@ * Exporting a new dataset `dataset_spec` that contains the Dataset Specification for ADSL. (#179) * 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()` +* It is now possible to get and set the xportr options using the helper function `xportr_options()` (#130) ## Deprecation and Breaking Changes From 0501023536d18f71a2bd590835c92f2ab64fd1f7 Mon Sep 17 00:00:00 2001 From: vedhav Date: Wed, 17 Jan 2024 19:22:08 +0000 Subject: [PATCH 156/267] [skip actions] Bump version to 0.3.1.9008 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index b808e7cf..d00b35fd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9007 +Version: 0.3.1.9008 Authors@R: c( person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")), From e93b119aa73f2330f559c39e011b6bc9a7e61924 Mon Sep 17 00:00:00 2001 From: vedhav Date: Thu, 18 Jan 2024 01:15:06 +0530 Subject: [PATCH 157/267] chore: update docs with new options --- R/options.R | 8 ++++++-- R/xportr-package.R | 11 +++++++++-- R/zzz.R | 12 +++++++++--- man/xportr-package.Rd | 11 +++++++++-- man/xportr_options.Rd | 10 +++++++--- man/xportr_options_list.Rd | 2 +- 6 files changed, 41 insertions(+), 13 deletions(-) diff --git a/R/options.R b/R/options.R index 68d66943..4ad5280a 100644 --- a/R/options.R +++ b/R/options.R @@ -41,11 +41,15 @@ #' The default argument for the 'verbose' argument for `xportr_length`. #' \item{xportr.type_verbose}{defaults to `"label"`}: #' The default argument for the 'verbose' argument for `xportr_type`. -#' \item{xportr.character_types}{defaults to `c("character", "char", "text", "date", "posixct", "posixt", +#' \item{xportr.character_types}{defaults to `"character"`}: +#' The default character vector used to explicitly coerce R classes to character XPT types. +#' \item{xportr.character_metadata_types}{defaults to `c("character", "char", "text", "date", "posixct", "posixt", #' "datetime", "time", "partialdate", "partialtime", "partialdatetime", #' "incompletedatetime", "durationdatetime", "intervaldatetime")`}: #' The default character vector used to explicitly coerce R classes to character XPT types. -#' \item{xportr.numeric_types}{defaults to `c("integer", "numeric", "num", "float")`}: +#' \item{xportr.numeric_metadata_types}{defaults to `c("integer", "numeric", "num", "float")`}: +#' The default character vector used to explicitly coerce R classes to numeric XPT types. +#' \item{xportr.numeric_types}{defaults to `c("integer", "float", "posixct", "posixt", "time", "date")`}: #' The default character vector used to explicitly coerce R classes to numeric XPT types. #' } #' diff --git a/R/xportr-package.R b/R/xportr-package.R index 52098b45..906a00f7 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -64,15 +64,22 @@ #' } #' \item{ #' xportr.character_types - The default character vector used to explicitly +#' coerce R classes to character XPT types. Default: "character" +#' } +#' \item{ +#' xportr.character_metadata_types - The default character vector used to explicitly #' coerce R classes to character XPT types. Default: c("character", "char", #' "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", #' "partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", #' "intervaldatetime") #' } #' \item{ +#' xportr.numeric_metadata_types - The default character vector used to explicitly +#' coerce R classes to numeric XPT types. Default: c("integer", "numeric", "num", "float") +#' } +#' \item{ #' xportr.numeric_types - The default character vector used to explicitly -#' coerce R classes to numeric XPT types. Default: c("integer", "numeric", -#' "num", "float") +#' coerce R classes to numeric XPT types. Default: c("integer", "float", "posixct", "posixt", "time", "date") #' } #' } #' diff --git a/R/zzz.R b/R/zzz.R index 96033406..e72972d3 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -16,7 +16,7 @@ xportr_options_list <- list( xportr.label_verbose = getOption("xportr.label_verbose", "none"), xportr.length_verbose = getOption("xportr.length_verbose", "none"), xportr.type_verbose = getOption("xportr.type_verbose", "none"), - xportr.character_types = c("character"), + xportr.character_types = getOption("xportr.character_types", "character"), xportr.character_metadata_types = getOption( "xportr.character_types", c( @@ -27,8 +27,14 @@ xportr_options_list <- list( "intervaldatetime" ) ), - xportr.numeric_metadata_types = c("integer", "numeric", "num", "float"), - xportr.numeric_types = c("integer", "float", "posixct", "posixt", "time", "date") + xportr.numeric_metadata_types = getOption( + "xportr.numeric_metadata_types", + c("integer", "numeric", "num", "float") + ), + xportr.numeric_types = getOption( + "xportr.numeric_types", + c("integer", "float", "posixct", "posixt", "time", "date") + ) ) .onLoad <- function(libname, pkgname) { diff --git a/man/xportr-package.Rd b/man/xportr-package.Rd index e23a276c..3b7d8a63 100644 --- a/man/xportr-package.Rd +++ b/man/xportr-package.Rd @@ -71,15 +71,22 @@ xportr.type_verbose - The default argument for the 'verbose' argument for } \item{ xportr.character_types - The default character vector used to explicitly +coerce R classes to character XPT types. Default: "character" +} +\item{ +xportr.character_metadata_types - The default character vector used to explicitly coerce R classes to character XPT types. Default: c("character", "char", "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", "partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", "intervaldatetime") } \item{ +xportr.numeric_metadata_types - The default character vector used to explicitly +coerce R classes to numeric XPT types. Default: c("integer", "numeric", "num", "float") +} +\item{ xportr.numeric_types - The default character vector used to explicitly -coerce R classes to numeric XPT types. Default: c("integer", "numeric", -"num", "float") +coerce R classes to numeric XPT types. Default: c("integer", "float", "posixct", "posixt", "time", "date") } } } diff --git a/man/xportr_options.Rd b/man/xportr_options.Rd index 4194aa52..db020a29 100644 --- a/man/xportr_options.Rd +++ b/man/xportr_options.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/options.R \name{xportr_options} \alias{xportr_options} -\title{Get or set Xportr options} +\title{Get or set xportr options} \usage{ xportr_options(...) } @@ -49,9 +49,13 @@ The default argument for the 'verbose' argument for \code{xportr_label}. The default argument for the 'verbose' argument for \code{xportr_length}. \item{xportr.type_verbose}{defaults to \code{"label"}}: The default argument for the 'verbose' argument for \code{xportr_type}. -\item{xportr.character_types}{defaults to \code{c("character", "char", "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", "partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", "intervaldatetime")}}: +\item{xportr.character_types}{defaults to \code{"character"}}: The default character vector used to explicitly coerce R classes to character XPT types. -\item{xportr.numeric_types}{defaults to \code{c("integer", "numeric", "num", "float")}}: +\item{xportr.character_metadata_types}{defaults to \code{c("character", "char", "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", "partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", "intervaldatetime")}}: +The default character vector used to explicitly coerce R classes to character XPT types. +\item{xportr.numeric_metadata_types}{defaults to \code{c("integer", "numeric", "num", "float")}}: +The default character vector used to explicitly coerce R classes to numeric XPT types. +\item{xportr.numeric_types}{defaults to \code{c("integer", "float", "posixct", "posixt", "time", "date")}}: The default character vector used to explicitly coerce R classes to numeric XPT types. } } diff --git a/man/xportr_options_list.Rd b/man/xportr_options_list.Rd index fb36fa78..7717def3 100644 --- a/man/xportr_options_list.Rd +++ b/man/xportr_options_list.Rd @@ -5,7 +5,7 @@ \alias{xportr_options_list} \title{A list with all the supported options of xportr} \format{ -An object of class \code{list} of length 15. +An object of class \code{list} of length 17. } \usage{ xportr_options_list From 0adfcc16cab204a0f1ed4fbff256d1808e5eb80e Mon Sep 17 00:00:00 2001 From: EeethB Date: Thu, 18 Jan 2024 16:46:37 +0000 Subject: [PATCH 158/267] [skip actions] Bump version to 0.3.1.9009 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index d00b35fd..d905b330 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9008 +Version: 0.3.1.9009 Authors@R: c( person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")), From 3f5d9e0149534d970523965c2ba6fc190062814d Mon Sep 17 00:00:00 2001 From: EeethB Date: Thu, 18 Jan 2024 16:23:37 -0600 Subject: [PATCH 159/267] Add integration test for metadata --- tests/testthat/test-metadata.R | 48 ++++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index d4dbc9af..0864fe00 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -741,3 +741,51 @@ test_that("xportr_*: Domain is kept in between calls", { expect_equal(attr(df5, "_xportr.df_arg_"), "adsl") }) # end + +test_that("`xportr_metadata()` results match traditional results", { + if (require(magrittr, quietly = TRUE)) { + test_dir <- tempdir() + + trad_path <- file.path(test_dir, "adsltrad.xpt") + metadata_path <- file.path(test_dir, "adslmeta.xpt") + + dataset_spec_low <- setNames(dataset_spec, tolower(names(dataset_spec))) + names(dataset_spec_low)[[2]] <- "label" + + var_spec_low <- setNames(var_spec, tolower(names(var_spec))) + names(var_spec_low)[[5]] <- "type" + + metadata_df <- adsl %>% + xportr_metadata(var_spec_low, "ADSL", verbose = "none") %>% + xportr_type() %>% + xportr_length() %>% + xportr_label() %>% + xportr_order() %>% + xportr_format() %>% + xportr_df_label(dataset_spec_low) %>% + xportr_write(metadata_path) + + trad_df <- adsl %>% + xportr_type(var_spec_low, "ADSL", verbose = "none") %>% + xportr_length(var_spec_low, "ADSL", verbose = "none") %>% + xportr_label(var_spec_low, "ADSL", verbose = "none") %>% + xportr_order(var_spec_low, "ADSL", verbose = "none") %>% + xportr_format(var_spec_low, "ADSL") %>% + xportr_df_label(dataset_spec_low, "ADSL") %>% + xportr_write(trad_path) + + expect_identical( + metadata_df, + structure( + trad_df, + `_xportr.df_metadata_` = var_spec_low, + `_xportr.df_verbose_` = "none" + ) + ) + + expect_identical( + haven::read_xpt(metadata_path), + haven::read_xpt(trad_path) + ) + } +}) From 63beadffea8218818a1af3370a77912d9f33c893 Mon Sep 17 00:00:00 2001 From: EeethB Date: Fri, 19 Jan 2024 18:03:09 -0600 Subject: [PATCH 160/267] Streamline documentation --- R/format.R | 6 +++--- R/length.R | 10 +--------- man/metadata.Rd | 4 ++-- man/xportr_df_label.Rd | 7 ++----- man/xportr_format.Rd | 13 +++++-------- man/xportr_label.Rd | 7 ++----- man/xportr_length.Rd | 7 ++----- man/xportr_order.Rd | 7 ++----- man/xportr_type.Rd | 7 ++----- man/xportr_write.Rd | 4 ++-- 10 files changed, 23 insertions(+), 49 deletions(-) diff --git a/R/format.R b/R/format.R index 4e4c37c8..2b5a1190 100644 --- a/R/format.R +++ b/R/format.R @@ -18,9 +18,9 @@ #' "dataset". This is the column subset by the 'domain' argument in the #' function. #' -#' 2) Format Name - passed as the 'xportr.format_name' option. -#' Default: "format". Character values to update the '`format.sas`' attribute of -#' the column. This is passed to `haven::write` to note the format. +#' 2) Format Name - passed as the 'xportr.format_name' option. Default: +#' "format". Character values to update the '`format.sas`' attribute of the +#' column. This is passed to `haven::write` to note the format. #' #' 3) Variable Name - passed as the 'xportr.variable_name' option. Default: #' "variable". This is used to match columns in '.df' argument and the diff --git a/R/length.R b/R/length.R index f8fe3b66..44f7df3a 100644 --- a/R/length.R +++ b/R/length.R @@ -5,17 +5,9 @@ #' character columns, and 8 for non-character columns. This value is stored in #' the 'width' attribute of the column. #' -#' @param .df A data frame of CDISC standard. +#' @inheritParams xportr #' @param metadata A data frame containing variable level metadata. See #' 'Metadata' section for details. -#' @param domain Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -#' the metadata object. If none is passed, then [xportr_metadata()] must be -#' called before hand to set the domain as an attribute of `.df`. -#' @param verbose The action this function takes when an action is taken on the -#' dataset or function validation finds an issue. See 'Messaging' section for -#' details. Options are 'stop', 'warn', 'message', and 'none' -#' @param metacore `r lifecycle::badge("deprecated")` Previously used to pass -#' metadata now renamed with `metadata` #' #' @section Messaging: `length_log` is the primary messaging tool for #' `xportr_length`. If there are any columns present in the '.df' that are not diff --git a/man/metadata.Rd b/man/metadata.Rd index da5de14c..30918a0c 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -13,8 +13,8 @@ xportr_metadata(.df, metadata = NULL, domain = NULL, verbose = NULL) 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be -called before hand to set the domain as an attribute of \code{.df}.} +the metadata object. If none is passed, then name of the dataset passed as +.df will be used.} \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for diff --git a/man/xportr_df_label.Rd b/man/xportr_df_label.Rd index 363c59c4..00f296bd 100644 --- a/man/xportr_df_label.Rd +++ b/man/xportr_df_label.Rd @@ -13,11 +13,8 @@ xportr_df_label(.df, metadata = NULL, domain = NULL, metacore = deprecated()) details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be -called before hand to set the domain as an attribute of \code{.df}.} - -\item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass -metadata now renamed with \code{metadata}} +the metadata object. If none is passed, then name of the dataset passed as +.df will be used.} } \value{ Data frame with label attributes. diff --git a/man/xportr_format.Rd b/man/xportr_format.Rd index dd883554..1ea51e60 100644 --- a/man/xportr_format.Rd +++ b/man/xportr_format.Rd @@ -13,11 +13,8 @@ xportr_format(.df, metadata = NULL, domain = NULL, metacore = deprecated()) 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be -called before hand to set the domain as an attribute of \code{.df}.} - -\item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass -metadata now renamed with \code{metadata}} +the metadata object. If none is passed, then name of the dataset passed as +.df will be used.} } \value{ Data frame with \code{SASformat} attributes for each variable. @@ -37,9 +34,9 @@ For data.frame 'metadata' arguments three columns must be present: \item Domain Name - passed as the 'xportr.domain_name' option. Default: "dataset". This is the column subset by the 'domain' argument in the function. -\item Format Name - passed as the 'xportr.format_name' option. -Default: "format". Character values to update the '\code{format.sas}' attribute of -the column. This is passed to \code{haven::write} to note the format. +\item Format Name - passed as the 'xportr.format_name' option. Default: +"format". Character values to update the '\code{format.sas}' attribute of the +column. This is passed to \code{haven::write} to note the format. \item Variable Name - passed as the 'xportr.variable_name' option. Default: "variable". This is used to match columns in '.df' argument and the metadata. diff --git a/man/xportr_label.Rd b/man/xportr_label.Rd index f408de4f..26346818 100644 --- a/man/xportr_label.Rd +++ b/man/xportr_label.Rd @@ -19,15 +19,12 @@ xportr_label( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be -called before hand to set the domain as an attribute of \code{.df}.} +the metadata object. If none is passed, then name of the dataset passed as +.df will be used.} \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for details. Options are 'stop', 'warn', 'message', and 'none'} - -\item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass -metadata now renamed with \code{metadata}} } \value{ Data frame with label attributes for each variable. diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index fd8c6807..853f0b48 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -19,15 +19,12 @@ xportr_length( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be -called before hand to set the domain as an attribute of \code{.df}.} +the metadata object. If none is passed, then name of the dataset passed as +.df will be used.} \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for details. Options are 'stop', 'warn', 'message', and 'none'} - -\item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass -metadata now renamed with \code{metadata}} } \value{ Data frame with \code{SASlength} attributes for each variable. diff --git a/man/xportr_order.Rd b/man/xportr_order.Rd index 9cefd0fb..b50d148e 100644 --- a/man/xportr_order.Rd +++ b/man/xportr_order.Rd @@ -19,15 +19,12 @@ xportr_order( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be -called before hand to set the domain as an attribute of \code{.df}.} +the metadata object. If none is passed, then name of the dataset passed as +.df will be used.} \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for details. Options are 'stop', 'warn', 'message', and 'none'} - -\item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass -metadata now renamed with \code{metadata}} } \value{ Dataframe that has been re-ordered according to spec diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index cbbbbef9..051f63bb 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -19,15 +19,12 @@ xportr_type( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be -called before hand to set the domain as an attribute of \code{.df}.} +the metadata object. If none is passed, then name of the dataset passed as +.df will be used.} \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for details. Options are 'stop', 'warn', 'message', and 'none'} - -\item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass -metadata now renamed with \code{metadata}} } \value{ Returns the modified table. diff --git a/man/xportr_write.Rd b/man/xportr_write.Rd index b85f1766..db739e9c 100644 --- a/man/xportr_write.Rd +++ b/man/xportr_write.Rd @@ -23,8 +23,8 @@ used as \code{xpt} name.} 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be -called before hand to set the domain as an attribute of \code{.df}.} +the metadata object. If none is passed, then name of the dataset passed as +.df will be used.} \item{strict_checks}{If TRUE, xpt validation will report errors and not write out the dataset. If FALSE, xpt validation will report warnings and continue From a729e5cbb497bc7adb1ceb6c998d2ef335fa45be Mon Sep 17 00:00:00 2001 From: EeethB Date: Fri, 19 Jan 2024 18:05:03 -0600 Subject: [PATCH 161/267] Streamline documentation --- R/length.R | 2 ++ man/xportr_df_label.Rd | 3 +++ man/xportr_format.Rd | 3 +++ man/xportr_label.Rd | 3 +++ man/xportr_length.Rd | 3 +++ man/xportr_order.Rd | 3 +++ man/xportr_type.Rd | 3 +++ 7 files changed, 20 insertions(+) diff --git a/R/length.R b/R/length.R index 44f7df3a..05fadffd 100644 --- a/R/length.R +++ b/R/length.R @@ -8,6 +8,8 @@ #' @inheritParams xportr #' @param metadata A data frame containing variable level metadata. See #' 'Metadata' section for details. +#' @param metacore `r lifecycle::badge("deprecated")` Previously used to pass +#' metadata now renamed with `metadata` #' #' @section Messaging: `length_log` is the primary messaging tool for #' `xportr_length`. If there are any columns present in the '.df' that are not diff --git a/man/xportr_df_label.Rd b/man/xportr_df_label.Rd index 00f296bd..691de990 100644 --- a/man/xportr_df_label.Rd +++ b/man/xportr_df_label.Rd @@ -15,6 +15,9 @@ details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset the metadata object. If none is passed, then name of the dataset passed as .df will be used.} + +\item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass +metadata now renamed with \code{metadata}} } \value{ Data frame with label attributes. diff --git a/man/xportr_format.Rd b/man/xportr_format.Rd index 1ea51e60..e085a345 100644 --- a/man/xportr_format.Rd +++ b/man/xportr_format.Rd @@ -15,6 +15,9 @@ xportr_format(.df, metadata = NULL, domain = NULL, metacore = deprecated()) \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset the metadata object. If none is passed, then name of the dataset passed as .df will be used.} + +\item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass +metadata now renamed with \code{metadata}} } \value{ Data frame with \code{SASformat} attributes for each variable. diff --git a/man/xportr_label.Rd b/man/xportr_label.Rd index 26346818..eb03df81 100644 --- a/man/xportr_label.Rd +++ b/man/xportr_label.Rd @@ -25,6 +25,9 @@ the metadata object. If none is passed, then name of the dataset passed as \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for details. Options are 'stop', 'warn', 'message', and 'none'} + +\item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass +metadata now renamed with \code{metadata}} } \value{ Data frame with label attributes for each variable. diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index 853f0b48..f7a7c689 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -25,6 +25,9 @@ the metadata object. If none is passed, then name of the dataset passed as \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for details. Options are 'stop', 'warn', 'message', and 'none'} + +\item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass +metadata now renamed with \code{metadata}} } \value{ Data frame with \code{SASlength} attributes for each variable. diff --git a/man/xportr_order.Rd b/man/xportr_order.Rd index b50d148e..26b87f42 100644 --- a/man/xportr_order.Rd +++ b/man/xportr_order.Rd @@ -25,6 +25,9 @@ the metadata object. If none is passed, then name of the dataset passed as \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for details. Options are 'stop', 'warn', 'message', and 'none'} + +\item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass +metadata now renamed with \code{metadata}} } \value{ Dataframe that has been re-ordered according to spec diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index 051f63bb..21eb3583 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -25,6 +25,9 @@ the metadata object. If none is passed, then name of the dataset passed as \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for details. Options are 'stop', 'warn', 'message', and 'none'} + +\item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass +metadata now renamed with \code{metadata}} } \value{ Returns the modified table. From 04f8fca2d24fb5b5debea0619fbbedace20706ba Mon Sep 17 00:00:00 2001 From: Celine Piraux <69685640+cpiraux@users.noreply.github.com> Date: Mon, 22 Jan 2024 13:20:07 +0100 Subject: [PATCH 162/267] Update description in type.R Co-authored-by: Ben Straub --- R/type.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/type.R b/R/type.R index e0cbe9e2..2a1bd3ef 100644 --- a/R/type.R +++ b/R/type.R @@ -5,7 +5,7 @@ #' 'xportr.character_types' option is used to explicitly collapse the class of a #' column to character using `as.character`. Similarly, 'xportr.numeric_types' #' will collapse a column to a numeric type. If no type is passed for a -#' variable, it is assumed to be numeric and coerced with `as.numeric`. +#' variable, it is assumed to be numeric and coerced with `as.numeric()`. #' #' Certain care should be taken when using timing variables. R serializes dates #' based on a reference date of 01/01/1970 where XPT uses 01/01/1960. This can From 701fb5e0a39ca0eb59894df9eda8e30d399eb386 Mon Sep 17 00:00:00 2001 From: Celine Date: Mon, 22 Jan 2024 07:31:45 -0500 Subject: [PATCH 163/267] Update option character_metadata_types --- R/zzz.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/zzz.R b/R/zzz.R index e72972d3..d986c442 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -18,7 +18,7 @@ xportr_options_list <- list( xportr.type_verbose = getOption("xportr.type_verbose", "none"), xportr.character_types = getOption("xportr.character_types", "character"), xportr.character_metadata_types = getOption( - "xportr.character_types", + "xportr.character_metadata_types", c( "character", "char", "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", From be591a08e5f748ab3e97c822f1def584e21b4405 Mon Sep 17 00:00:00 2001 From: Celine Date: Mon, 22 Jan 2024 07:42:16 -0500 Subject: [PATCH 164/267] update description in NEWS.md --- NEWS.md | 3 +-- man/xportr_type.Rd | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index c118106b..9d3430df 100644 --- a/NEWS.md +++ b/NEWS.md @@ -7,8 +7,7 @@ * 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) - -* Added xportr.character_metadata_types and xportr.numeric_metadata_types so that all R types, including dates, are handled by xportr_type. In case the R type is different from the metadata type, the variable is coerced (#161). +* Added `xportr.character_metadata_types` and `xportr.numeric_metadata_types` to list the metadata types that are character or numeric. Updated `xportr.character_types` and `xportr.numeric_types` to list only the R types that are character and the R types that are numeric. This ensures that all R types, including dates, are now managed by xportr_type. If the R type differs from the metadata type, the variable is coerced (#161).. ## Deprecation and Breaking Changes diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index 9f2ee549..c5d9b077 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -38,7 +38,7 @@ attempts to collapse R classes to those two XPT types. The 'xportr.character_types' option is used to explicitly collapse the class of a column to character using \code{as.character}. Similarly, 'xportr.numeric_types' will collapse a column to a numeric type. If no type is passed for a -variable, it is assumed to be numeric and coerced with \code{as.numeric}. +variable, it is assumed to be numeric and coerced with \code{as.numeric()}. } \details{ Certain care should be taken when using timing variables. R serializes dates From 2ec667f558f49a3f7062f7c88809bd79072f9fff Mon Sep 17 00:00:00 2001 From: Celine Date: Mon, 22 Jan 2024 08:10:56 -0500 Subject: [PATCH 165/267] update style --- R/utils-xportr.R | 1 - tests/testthat/test-length.R | 1 - 2 files changed, 2 deletions(-) diff --git a/R/utils-xportr.R b/R/utils-xportr.R index ce847993..09dfaa6c 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -396,7 +396,6 @@ check_multiple_var_specs <- function(metadata, #' @export variable_max_length <- function(.df) { - variable_length <- getOption("xportr.length") variable_name <- getOption("xportr.variable_name") diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index 3d108183..25ed989f 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -218,7 +218,6 @@ test_that("xportr_length: Gets message when length in metadata longer than data result <- df %>% xportr_length(meta_example, domain = "df", length = "data") %>% expect_message() - }) test_that("xportr_length: Works as expected with only one domain in metadata", { From c122df659356ff973feee46ae48a9b0c8c12fcde Mon Sep 17 00:00:00 2001 From: Ethan Brockmann <59264453+EeethB@users.noreply.github.com> Date: Mon, 22 Jan 2024 09:12:15 -0600 Subject: [PATCH 166/267] Adjust magrittr-conditional example MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- R/xportr.R | 56 ++++++++++++++++++++++++++---------------------------- 1 file changed, 27 insertions(+), 29 deletions(-) diff --git a/R/xportr.R b/R/xportr.R index 8ac85a71..ed7c3ba1 100644 --- a/R/xportr.R +++ b/R/xportr.R @@ -18,40 +18,38 @@ #' @return Returns the input dataframe invisibly #' @export #' -#' @examples +#' @examplesIf requireNamespace("magrittr") +#' library(magrittr) +#' test_dir <- tempdir() #' -#' if (require(magrittr, quietly = TRUE)) { -#' test_dir <- tempdir() +#' pipeline_path <- file.path(test_dir, "adslpipe.xpt") +#' xportr_path <- file.path(test_dir, "adslxptr.xpt") #' -#' pipeline_path <- file.path(test_dir, "adslpipe.xpt") -#' xportr_path <- file.path(test_dir, "adslxptr.xpt") +#' dataset_spec_low <- setNames(dataset_spec, tolower(names(dataset_spec))) +#' names(dataset_spec_low)[[2]] <- "label" #' -#' dataset_spec_low <- setNames(dataset_spec, tolower(names(dataset_spec))) -#' names(dataset_spec_low)[[2]] <- "label" +#' var_spec_low <- setNames(var_spec, tolower(names(var_spec))) +#' names(var_spec_low)[[5]] <- "type" #' -#' var_spec_low <- setNames(var_spec, tolower(names(var_spec))) -#' names(var_spec_low)[[5]] <- "type" +#' adsl %>% +#' xportr_metadata(var_spec_low, "ADSL", verbose = "none") %>% +#' xportr_type() %>% +#' xportr_length() %>% +#' xportr_label() %>% +#' xportr_order() %>% +#' xportr_format() %>% +#' xportr_df_label(dataset_spec_low) %>% +#' xportr_write(pipeline_path) #' -#' adsl %>% -#' xportr_metadata(var_spec_low, "ADSL", verbose = "none") %>% -#' xportr_type() %>% -#' xportr_length() %>% -#' xportr_label() %>% -#' xportr_order() %>% -#' xportr_format() %>% -#' xportr_df_label(dataset_spec_low) %>% -#' xportr_write(pipeline_path) -#' -#' # `xportr()` can be used to apply a whole pipeline at once -#' xportr( -#' adsl, -#' var_metadata = var_spec_low, -#' df_metadata = dataset_spec_low, -#' domain = "ADSL", -#' verbose = "none", -#' path = xportr_path -#' ) -#' } +#' # `xportr()` can be used to apply a whole pipeline at once +#' xportr( +#' adsl, +#' var_metadata = var_spec_low, +#' df_metadata = dataset_spec_low, +#' domain = "ADSL", +#' verbose = "none", +#' path = xportr_path +#' ) xportr <- function(.df, var_metadata = NULL, df_metadata = NULL, From b4a50ca4d9f7465367490b92b6ed66ea876ac03c Mon Sep 17 00:00:00 2001 From: Ethan Brockmann <59264453+EeethB@users.noreply.github.com> Date: Mon, 22 Jan 2024 11:29:28 -0600 Subject: [PATCH 167/267] Update metadata tests to remove unnecessary messaging MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- tests/testthat/test-metadata.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index bd0c1ba4..3c841e72 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -649,6 +649,12 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { dplyr::rename(type = "Data Type") %>% rlang::set_names(tolower) + # Divert all messages to tempfile, instead of printing them + # note: be aware as this should only be used in tests that don't track + # messages + if (requireNamespace("withr", quiet = TRUE) { + withr::local_message_sink(withr::local_tempfile()) + } expect_equal( structure(xportr_type(adsl, var_spec, domain = "adsl"), `_xportr.df_metadata_` = var_spec, From 5a7f78bce3f4859bd62c4d53a397653192c3e3e4 Mon Sep 17 00:00:00 2001 From: Ethan Brockmann <59264453+EeethB@users.noreply.github.com> Date: Mon, 22 Jan 2024 11:30:10 -0600 Subject: [PATCH 168/267] Update `xportr()` tests to remove unnecessary messaging MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- tests/testthat/test-xportr.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/testthat/test-xportr.R b/tests/testthat/test-xportr.R index 6711a668..0b1aa8ee 100644 --- a/tests/testthat/test-xportr.R +++ b/tests/testthat/test-xportr.R @@ -11,6 +11,10 @@ test_that("pipeline results match `xportr()` results", { var_spec_low <- setNames(var_spec, tolower(names(var_spec))) names(var_spec_low)[[5]] <- "type" + # Divert all messages to tempfile, instead of printing them + # note: be aware as this should only be used in tests that don't track + # messages + withr::local_message_sink(withr::local_tempfile()) pipeline_df <- adsl %>% xportr_metadata(var_spec_low, "ADSL", verbose = "none") %>% xportr_type() %>% From 5e723be50ea184e55f1ed353e838e216977a6839 Mon Sep 17 00:00:00 2001 From: Ethan Brockmann <59264453+EeethB@users.noreply.github.com> Date: Mon, 22 Jan 2024 11:31:09 -0600 Subject: [PATCH 169/267] Update `xportr()` tests to remove unnecessary messaging MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- tests/testthat/test-xportr.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/testthat/test-xportr.R b/tests/testthat/test-xportr.R index 0b1aa8ee..6c216c94 100644 --- a/tests/testthat/test-xportr.R +++ b/tests/testthat/test-xportr.R @@ -11,6 +11,10 @@ test_that("pipeline results match `xportr()` results", { var_spec_low <- setNames(var_spec, tolower(names(var_spec))) names(var_spec_low)[[5]] <- "type" + # Divert all messages to tempfile, instead of printing them + # note: be aware as this should only be used in tests that don't track + # messages + withr::local_message_sink(withr::local_tempfile()) # Divert all messages to tempfile, instead of printing them # note: be aware as this should only be used in tests that don't track # messages From d0bc225f92e6065317132d8ba190e7db824f5d89 Mon Sep 17 00:00:00 2001 From: Ethan Brockmann <59264453+EeethB@users.noreply.github.com> Date: Mon, 22 Jan 2024 11:32:09 -0600 Subject: [PATCH 170/267] Update temp files to use `local_file()` MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- tests/testthat/test-xportr.R | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-xportr.R b/tests/testthat/test-xportr.R index 6c216c94..70c2b8a5 100644 --- a/tests/testthat/test-xportr.R +++ b/tests/testthat/test-xportr.R @@ -1,9 +1,8 @@ test_that("pipeline results match `xportr()` results", { if (require(magrittr, quietly = TRUE)) { - test_dir <- tempdir() - - pipeline_path <- file.path(test_dir, "adslpipe.xpt") - xportr_path <- file.path(test_dir, "adslxptr.xpt") + skip_if_not_installed("withr") + trad_path <- withr::local_file("adslpipe.xpt") + metadata_path <- withr::local_file("adslxptr.xpt") dataset_spec_low <- setNames(dataset_spec, tolower(names(dataset_spec))) names(dataset_spec_low)[[2]] <- "label" From 4eea1660108143e861bd02625a36f5a2197312a3 Mon Sep 17 00:00:00 2001 From: Ethan Brockmann <59264453+EeethB@users.noreply.github.com> Date: Mon, 22 Jan 2024 11:32:34 -0600 Subject: [PATCH 171/267] Update temp files to use `local_file()` MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- tests/testthat/test-metadata.R | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index 3c841e72..75ef09d4 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -758,10 +758,9 @@ test_that("xportr_*: Domain is kept in between calls", { test_that("`xportr_metadata()` results match traditional results", { if (require(magrittr, quietly = TRUE)) { - test_dir <- tempdir() - - trad_path <- file.path(test_dir, "adsltrad.xpt") - metadata_path <- file.path(test_dir, "adslmeta.xpt") + skip_if_not_installed("withr") + trad_path <- withr::local_file("adsltrad.xpt") + metadata_path <- withr::local_file("adslmeta.xpt") dataset_spec_low <- setNames(dataset_spec, tolower(names(dataset_spec))) names(dataset_spec_low)[[2]] <- "label" From e2f7e252e2fc5e7badd3319912a08203d3018f7f Mon Sep 17 00:00:00 2001 From: EeethB Date: Mon, 22 Jan 2024 12:41:59 -0500 Subject: [PATCH 172/267] Fix unmatched paren in tests --- man/xportr.Rd | 56 +++++++++++++++++----------------- tests/testthat/test-metadata.R | 2 +- 2 files changed, 29 insertions(+), 29 deletions(-) diff --git a/man/xportr.Rd b/man/xportr.Rd index 0d2c3174..c810dae1 100644 --- a/man/xportr.Rd +++ b/man/xportr.Rd @@ -43,37 +43,37 @@ Returns the input dataframe invisibly Wrapper to apply all core xportr functions and write xpt } \examples{ +\dontshow{if (requireNamespace("magrittr")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +library(magrittr) +test_dir <- tempdir() -if (require(magrittr, quietly = TRUE)) { - test_dir <- tempdir() +pipeline_path <- file.path(test_dir, "adslpipe.xpt") +xportr_path <- file.path(test_dir, "adslxptr.xpt") - pipeline_path <- file.path(test_dir, "adslpipe.xpt") - xportr_path <- file.path(test_dir, "adslxptr.xpt") +dataset_spec_low <- setNames(dataset_spec, tolower(names(dataset_spec))) +names(dataset_spec_low)[[2]] <- "label" - dataset_spec_low <- setNames(dataset_spec, tolower(names(dataset_spec))) - names(dataset_spec_low)[[2]] <- "label" +var_spec_low <- setNames(var_spec, tolower(names(var_spec))) +names(var_spec_low)[[5]] <- "type" - var_spec_low <- setNames(var_spec, tolower(names(var_spec))) - names(var_spec_low)[[5]] <- "type" +adsl \%>\% + xportr_metadata(var_spec_low, "ADSL", verbose = "none") \%>\% + xportr_type() \%>\% + xportr_length() \%>\% + xportr_label() \%>\% + xportr_order() \%>\% + xportr_format() \%>\% + xportr_df_label(dataset_spec_low) \%>\% + xportr_write(pipeline_path) - adsl \%>\% - xportr_metadata(var_spec_low, "ADSL", verbose = "none") \%>\% - xportr_type() \%>\% - xportr_length() \%>\% - xportr_label() \%>\% - xportr_order() \%>\% - xportr_format() \%>\% - xportr_df_label(dataset_spec_low) \%>\% - xportr_write(pipeline_path) - - # `xportr()` can be used to apply a whole pipeline at once - xportr( - adsl, - var_metadata = var_spec_low, - df_metadata = dataset_spec_low, - domain = "ADSL", - verbose = "none", - path = xportr_path - ) -} +# `xportr()` can be used to apply a whole pipeline at once +xportr( + adsl, + var_metadata = var_spec_low, + df_metadata = dataset_spec_low, + domain = "ADSL", + verbose = "none", + path = xportr_path +) +\dontshow{\}) # examplesIf} } diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index 75ef09d4..61fe9112 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -652,7 +652,7 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { # Divert all messages to tempfile, instead of printing them # note: be aware as this should only be used in tests that don't track # messages - if (requireNamespace("withr", quiet = TRUE) { + if (requireNamespace("withr", quiet = TRUE)) { withr::local_message_sink(withr::local_tempfile()) } expect_equal( From 1e992a920812a7cd604fb70912de9ed7c3883c61 Mon Sep 17 00:00:00 2001 From: EeethB Date: Mon, 22 Jan 2024 12:46:09 -0500 Subject: [PATCH 173/267] Remove duplicate comment --- tests/testthat/test-xportr.R | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/tests/testthat/test-xportr.R b/tests/testthat/test-xportr.R index 70c2b8a5..097ad277 100644 --- a/tests/testthat/test-xportr.R +++ b/tests/testthat/test-xportr.R @@ -10,14 +10,10 @@ test_that("pipeline results match `xportr()` results", { var_spec_low <- setNames(var_spec, tolower(names(var_spec))) names(var_spec_low)[[5]] <- "type" - # Divert all messages to tempfile, instead of printing them - # note: be aware as this should only be used in tests that don't track - # messages - withr::local_message_sink(withr::local_tempfile()) - # Divert all messages to tempfile, instead of printing them - # note: be aware as this should only be used in tests that don't track - # messages - withr::local_message_sink(withr::local_tempfile()) + # Divert all messages to tempfile, instead of printing them + # note: be aware as this should only be used in tests that don't track + # messages + withr::local_message_sink(withr::local_tempfile()) pipeline_df <- adsl %>% xportr_metadata(var_spec_low, "ADSL", verbose = "none") %>% xportr_type() %>% From 065097fc7c29e8cbd56aea06136af571957a7907 Mon Sep 17 00:00:00 2001 From: EeethB Date: Mon, 22 Jan 2024 12:59:31 -0500 Subject: [PATCH 174/267] Fix error in test file path --- tests/testthat/test-xportr.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-xportr.R b/tests/testthat/test-xportr.R index 097ad277..60161a72 100644 --- a/tests/testthat/test-xportr.R +++ b/tests/testthat/test-xportr.R @@ -1,8 +1,8 @@ test_that("pipeline results match `xportr()` results", { if (require(magrittr, quietly = TRUE)) { skip_if_not_installed("withr") - trad_path <- withr::local_file("adslpipe.xpt") - metadata_path <- withr::local_file("adslxptr.xpt") + pipeline_path <- withr::local_file("adslpipe.xpt") + xportr_path <- withr::local_file("adslxptr.xpt") dataset_spec_low <- setNames(dataset_spec, tolower(names(dataset_spec))) names(dataset_spec_low)[[2]] <- "label" From a7d6775fd6079b58ad48d9b876a6bf1c092a16d7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 22 Jan 2024 23:03:54 +0100 Subject: [PATCH 175/267] revert: default arguments take NULL --- R/df_label.R | 16 ++++++++++++---- R/format.R | 16 ++++++++++++---- R/label.R | 16 ++++++++++++---- R/length.R | 16 ++++++++++++---- R/metadata.R | 18 +++++++++++++----- R/order.R | 16 ++++++++++++---- R/type.R | 16 ++++++++++++---- R/write.R | 11 ++++++++--- man/xportr_df_label.Rd | 7 +------ man/xportr_format.Rd | 7 +------ man/xportr_label.Rd | 4 ++-- man/xportr_length.Rd | 4 ++-- man/xportr_order.Rd | 4 ++-- man/xportr_type.Rd | 4 ++-- man/xportr_write.Rd | 2 +- 15 files changed, 104 insertions(+), 53 deletions(-) diff --git a/R/df_label.R b/R/df_label.R index 90f25e1e..6891d7c6 100644 --- a/R/df_label.R +++ b/R/df_label.R @@ -40,8 +40,8 @@ #' #' adsl <- xportr_df_label(adsl, metadata, domain = "adsl") xportr_df_label <- function(.df, - metadata = attr(.df, "_xportr.df_metadata_"), - domain = attr(.df, "_xportr.df_arg_"), + metadata = NULL, + domain = NULL, metacore = deprecated()) { if (!missing(metacore)) { lifecycle::deprecate_stop( @@ -50,12 +50,20 @@ xportr_df_label <- function(.df, with = "xportr_df_label(metadata = )" ) } + + ## Common section to detect default attributes + + domain <- domain %||% attr(.df, "_xportr.df_arg_") + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + + ## End of common section + assert_data_frame(.df) assert_string(domain, null.ok = TRUE) assert_metadata(metadata) - if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain - domain_name <- getOption("xportr.df_domain_name") label_name <- getOption("xportr.df_label") diff --git a/R/format.R b/R/format.R index 3033e09b..7a92acc5 100644 --- a/R/format.R +++ b/R/format.R @@ -42,8 +42,8 @@ #' #' adsl <- xportr_format(adsl, metadata, domain = "adsl") xportr_format <- function(.df, - metadata = attr(.df, "_xportr.df_metadata_"), - domain = attr(.df, "_xportr.df_arg_"), + metadata = NULL, + domain = NULL, metacore = deprecated()) { if (!missing(metacore)) { lifecycle::deprecate_stop( @@ -52,12 +52,20 @@ xportr_format <- function(.df, with = "xportr_format(metadata = )" ) } + + ## Common section to detect default attributes + + domain <- domain %||% attr(.df, "_xportr.df_arg_") + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + + ## End of common section + assert_data_frame(.df) assert_string(domain, null.ok = TRUE) assert_metadata(metadata) - if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain - domain_name <- getOption("xportr.domain_name") format_name <- getOption("xportr.format_name") variable_name <- getOption("xportr.variable_name") diff --git a/R/label.R b/R/label.R index f5b495ad..5df997e0 100644 --- a/R/label.R +++ b/R/label.R @@ -57,8 +57,8 @@ #' #' adsl <- xportr_label(adsl, metadata, domain = "adsl") xportr_label <- function(.df, - metadata = attr(.df, "_xportr.df_metadata_"), - domain = attr(.df, "_xportr.df_arg_"), + metadata = NULL, + domain = NULL, verbose = getOption("xportr.label_verbose", "none"), metacore = deprecated()) { if (!missing(metacore)) { @@ -68,13 +68,21 @@ xportr_label <- function(.df, with = "xportr_label(metadata = )" ) } + + ## Common section to detect default attributes + + domain <- domain %||% attr(.df, "_xportr.df_arg_") + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + + ## End of common section + assert_data_frame(.df) assert_string(domain, null.ok = TRUE) assert_metadata(metadata) assert_choice(verbose, choices = .internal_verbose_choices) - if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain - domain_name <- getOption("xportr.domain_name") variable_name <- getOption("xportr.variable_name") variable_label <- getOption("xportr.label") diff --git a/R/length.R b/R/length.R index b7ff15c3..76314cd7 100644 --- a/R/length.R +++ b/R/length.R @@ -64,8 +64,8 @@ #' #' adsl <- xportr_length(adsl, metadata, domain = "adsl") xportr_length <- function(.df, - metadata = attr(.df, "_xportr.df_metadata_"), - domain = attr(.df, "_xportr.df_arg_"), + metadata = NULL, + domain = NULL, verbose = getOption("xportr.length_verbose", "none"), metacore = deprecated()) { if (!missing(metacore)) { @@ -75,13 +75,21 @@ xportr_length <- function(.df, with = "xportr_length(metadata = )" ) } + + ## Common section to detect default attributes + + domain <- domain %||% attr(.df, "_xportr.df_arg_") + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + + ## End of common section + assert_data_frame(.df) assert_string(domain, null.ok = TRUE) assert_metadata(metadata) assert_choice(verbose, choices = .internal_verbose_choices) - if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain - domain_name <- getOption("xportr.domain_name") variable_length <- getOption("xportr.length") variable_name <- getOption("xportr.variable_name") diff --git a/R/metadata.R b/R/metadata.R index dd6a05e8..0fda0c42 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -41,16 +41,24 @@ #' xportr_order() #' } xportr_metadata <- function(.df, metadata = NULL, domain = NULL) { - assert_data_frame(.df) + if (is.null(metadata) && is.null(domain)) { 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 + ## Common section to detect default attributes + domain <- domain %||% attr(.df, "_xportr.df_arg_") if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain - structure(.df, "_xportr.df_metadata_" = metadata) + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + if (!is.null(metadata)) attr(.df, "_xportr.df_metadata_") <- metadata + + ## End of common section + + assert_data_frame(.df) + assert_metadata(metadata, include_fun_message = FALSE, null.ok = TRUE) + assert_string(domain, null.ok = TRUE) + + .df } diff --git a/R/order.R b/R/order.R index 02b9e259..fac37ccc 100644 --- a/R/order.R +++ b/R/order.R @@ -60,8 +60,8 @@ #' #' adsl <- xportr_order(adsl, metadata, domain = "adsl") xportr_order <- function(.df, - metadata = attr(.df, "_xportr.df_metadata_"), - domain = attr(.df, "_xportr.df_arg_"), + metadata = NULL, + domain = NULL, verbose = getOption("xportr.order_verbose", "none"), metacore = deprecated()) { if (!missing(metacore)) { @@ -71,13 +71,21 @@ xportr_order <- function(.df, with = "xportr_order(metadata = )" ) } + + ## Common section to detect default attributes + + domain <- domain %||% attr(.df, "_xportr.df_arg_") + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + + ## End of common section + assert_data_frame(.df) assert_string(domain, null.ok = TRUE) assert_metadata(metadata) assert_choice(verbose, choices = .internal_verbose_choices) - if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain - domain_name <- getOption("xportr.domain_name") order_name <- getOption("xportr.order_name") variable_name <- getOption("xportr.variable_name") diff --git a/R/type.R b/R/type.R index 90cd43ac..16ca8518 100644 --- a/R/type.R +++ b/R/type.R @@ -78,8 +78,8 @@ #' #' df2 <- xportr_type(.df, metadata, "test") xportr_type <- function(.df, - metadata = attr(.df, "_xportr.df_metadata_"), - domain = attr(.df, "_xportr.df_arg_"), + metadata = NULL, + domain = NULL, verbose = getOption("xportr.type_verbose", "none"), metacore = deprecated()) { if (!missing(metacore)) { @@ -89,13 +89,21 @@ xportr_type <- function(.df, with = "xportr_type(metadata = )" ) } + + ## Common section to detect default attributes + + domain <- domain %||% attr(.df, "_xportr.df_arg_") + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + + ## End of common section + assert_data_frame(.df) assert_string(domain, null.ok = TRUE) assert_metadata(metadata) assert_choice(verbose, choices = .internal_verbose_choices) - if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain - # Name of the columns for working with metadata domain_name <- getOption("xportr.domain_name") variable_name <- getOption("xportr.variable_name") diff --git a/R/write.R b/R/write.R index 0463eada..3cd7e65d 100644 --- a/R/write.R +++ b/R/write.R @@ -49,16 +49,21 @@ xportr_write <- function(.df, path, metadata = NULL, - domain = attr(.df, "_xportr.df_arg_"), + domain = NULL, strict_checks = FALSE, label = deprecated()) { + ## Common section to detect default attributes + + domain <- domain %||% attr(.df, "_xportr.df_arg_") + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + + ## End of common section + assert_data_frame(.df) assert_string(path) assert_metadata(metadata, null.ok = TRUE) assert_logical(strict_checks) - if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain - path <- normalizePath(path, mustWork = FALSE) name <- tools::file_path_sans_ext(basename(path)) diff --git a/man/xportr_df_label.Rd b/man/xportr_df_label.Rd index 7285571b..363c59c4 100644 --- a/man/xportr_df_label.Rd +++ b/man/xportr_df_label.Rd @@ -4,12 +4,7 @@ \alias{xportr_df_label} \title{Assign Dataset Label} \usage{ -xportr_df_label( - .df, - metadata = attr(.df, "_xportr.df_metadata_"), - domain = attr(.df, "_xportr.df_arg_"), - metacore = deprecated() -) +xportr_df_label(.df, metadata = NULL, domain = NULL, metacore = deprecated()) } \arguments{ \item{.df}{A data frame of CDISC standard.} diff --git a/man/xportr_format.Rd b/man/xportr_format.Rd index 5556439b..dd883554 100644 --- a/man/xportr_format.Rd +++ b/man/xportr_format.Rd @@ -4,12 +4,7 @@ \alias{xportr_format} \title{Assign SAS Format} \usage{ -xportr_format( - .df, - metadata = attr(.df, "_xportr.df_metadata_"), - domain = attr(.df, "_xportr.df_arg_"), - metacore = deprecated() -) +xportr_format(.df, metadata = NULL, domain = NULL, metacore = deprecated()) } \arguments{ \item{.df}{A data frame of CDISC standard.} diff --git a/man/xportr_label.Rd b/man/xportr_label.Rd index 881d646f..6af7ad9a 100644 --- a/man/xportr_label.Rd +++ b/man/xportr_label.Rd @@ -6,8 +6,8 @@ \usage{ xportr_label( .df, - metadata = attr(.df, "_xportr.df_metadata_"), - domain = attr(.df, "_xportr.df_arg_"), + metadata = NULL, + domain = NULL, verbose = getOption("xportr.label_verbose", "none"), metacore = deprecated() ) diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index ceecd8d0..b7f3e818 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -6,8 +6,8 @@ \usage{ xportr_length( .df, - metadata = attr(.df, "_xportr.df_metadata_"), - domain = attr(.df, "_xportr.df_arg_"), + metadata = NULL, + domain = NULL, verbose = getOption("xportr.length_verbose", "none"), metacore = deprecated() ) diff --git a/man/xportr_order.Rd b/man/xportr_order.Rd index 97de8fa2..50fd7e73 100644 --- a/man/xportr_order.Rd +++ b/man/xportr_order.Rd @@ -6,8 +6,8 @@ \usage{ xportr_order( .df, - metadata = attr(.df, "_xportr.df_metadata_"), - domain = attr(.df, "_xportr.df_arg_"), + metadata = NULL, + domain = NULL, verbose = getOption("xportr.order_verbose", "none"), metacore = deprecated() ) diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index 4a79b9da..f8c17945 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -6,8 +6,8 @@ \usage{ xportr_type( .df, - metadata = attr(.df, "_xportr.df_metadata_"), - domain = attr(.df, "_xportr.df_arg_"), + metadata = NULL, + domain = NULL, verbose = getOption("xportr.type_verbose", "none"), metacore = deprecated() ) diff --git a/man/xportr_write.Rd b/man/xportr_write.Rd index cea85a83..b85f1766 100644 --- a/man/xportr_write.Rd +++ b/man/xportr_write.Rd @@ -8,7 +8,7 @@ xportr_write( .df, path, metadata = NULL, - domain = attr(.df, "_xportr.df_arg_"), + domain = NULL, strict_checks = FALSE, label = deprecated() ) From e3b35d6c66c90629746363bfa9373180a8d91304 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 22 Jan 2024 23:13:14 +0100 Subject: [PATCH 176/267] docs: rename comment and move lifecycle check to top --- R/df_label.R | 2 +- R/format.R | 2 +- R/label.R | 2 +- R/length.R | 2 +- R/metadata.R | 2 +- R/order.R | 2 +- R/type.R | 2 +- R/write.R | 23 +++++++++++++---------- 8 files changed, 20 insertions(+), 17 deletions(-) diff --git a/R/df_label.R b/R/df_label.R index 6891d7c6..81a115ec 100644 --- a/R/df_label.R +++ b/R/df_label.R @@ -51,7 +51,7 @@ xportr_df_label <- function(.df, ) } - ## Common section to detect default attributes + ## Common section to detect default arguments domain <- domain %||% attr(.df, "_xportr.df_arg_") if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain diff --git a/R/format.R b/R/format.R index 7a92acc5..775e0e60 100644 --- a/R/format.R +++ b/R/format.R @@ -53,7 +53,7 @@ xportr_format <- function(.df, ) } - ## Common section to detect default attributes + ## Common section to detect default arguments domain <- domain %||% attr(.df, "_xportr.df_arg_") if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain diff --git a/R/label.R b/R/label.R index 5df997e0..f570bc56 100644 --- a/R/label.R +++ b/R/label.R @@ -69,7 +69,7 @@ xportr_label <- function(.df, ) } - ## Common section to detect default attributes + ## Common section to detect default arguments domain <- domain %||% attr(.df, "_xportr.df_arg_") if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain diff --git a/R/length.R b/R/length.R index 76314cd7..fa5ae278 100644 --- a/R/length.R +++ b/R/length.R @@ -76,7 +76,7 @@ xportr_length <- function(.df, ) } - ## Common section to detect default attributes + ## Common section to detect default arguments domain <- domain %||% attr(.df, "_xportr.df_arg_") if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain diff --git a/R/metadata.R b/R/metadata.R index 0fda0c42..16964945 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -46,7 +46,7 @@ xportr_metadata <- function(.df, metadata = NULL, domain = NULL) { stop("Assertion failed on `metadata` and `domain`: Must provide either `metadata` or `domain` argument") } - ## Common section to detect default attributes + ## Common section to detect default arguments domain <- domain %||% attr(.df, "_xportr.df_arg_") if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain diff --git a/R/order.R b/R/order.R index fac37ccc..84903466 100644 --- a/R/order.R +++ b/R/order.R @@ -72,7 +72,7 @@ xportr_order <- function(.df, ) } - ## Common section to detect default attributes + ## Common section to detect default arguments domain <- domain %||% attr(.df, "_xportr.df_arg_") if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain diff --git a/R/type.R b/R/type.R index 16ca8518..919b30a2 100644 --- a/R/type.R +++ b/R/type.R @@ -90,7 +90,7 @@ xportr_type <- function(.df, ) } - ## Common section to detect default attributes + ## Common section to detect default arguments domain <- domain %||% attr(.df, "_xportr.df_arg_") if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain diff --git a/R/write.R b/R/write.R index 3cd7e65d..ec201acb 100644 --- a/R/write.R +++ b/R/write.R @@ -52,11 +52,23 @@ xportr_write <- function(.df, domain = NULL, strict_checks = FALSE, label = deprecated()) { - ## Common section to detect default attributes + if (!missing(label)) { + lifecycle::deprecate_warn( + when = "0.3.2", + what = "xportr_write(label = )", + with = "xportr_write(metadata = )" + ) + assert_string(label, null.ok = TRUE, max.chars = 40) + metadata <- data.frame(dataset = domain, label = label) + } + + ## Common section to detect default arguments domain <- domain %||% attr(.df, "_xportr.df_arg_") if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + ## End of common section assert_data_frame(.df) @@ -68,15 +80,6 @@ xportr_write <- function(.df, name <- tools::file_path_sans_ext(basename(path)) - if (!missing(label)) { - lifecycle::deprecate_warn( - when = "0.3.2", - what = "xportr_write(label = )", - with = "xportr_write(metadata = )" - ) - assert_string(label, null.ok = TRUE, max.chars = 40) - metadata <- data.frame(dataset = domain, label = label) - } if (!is.null(metadata)) { .df <- xportr_df_label(.df, metadata = metadata, domain = domain) } From dd5bdc3b082f6b3528a3ceb8e5318f21ce2aec87 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 22 Jan 2024 23:18:05 +0100 Subject: [PATCH 177/267] fix: remove extra empty line --- R/metadata.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/metadata.R b/R/metadata.R index 16964945..83d30286 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -41,7 +41,6 @@ #' xportr_order() #' } xportr_metadata <- function(.df, metadata = NULL, domain = NULL) { - if (is.null(metadata) && is.null(domain)) { stop("Assertion failed on `metadata` and `domain`: Must provide either `metadata` or `domain` argument") } From 9836f8b0522f9693939451464d666d0b42f74f80 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 22 Jan 2024 23:25:36 +0100 Subject: [PATCH 178/267] revert: no longer retrieve metadata attribute as default --- R/metadata.R | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/R/metadata.R b/R/metadata.R index 83d30286..9211cca6 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -50,14 +50,11 @@ xportr_metadata <- function(.df, metadata = NULL, domain = NULL) { domain <- domain %||% attr(.df, "_xportr.df_arg_") if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain - metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") - if (!is.null(metadata)) attr(.df, "_xportr.df_metadata_") <- metadata - ## End of common section assert_data_frame(.df) assert_metadata(metadata, include_fun_message = FALSE, null.ok = TRUE) assert_string(domain, null.ok = TRUE) - .df + structure(.df, `_xportr.df_metadata_` = metadata) } From c984fe725844dc0cdbe224eabb3e2997d6a148c1 Mon Sep 17 00:00:00 2001 From: bms63 Date: Tue, 23 Jan 2024 13:06:04 +0000 Subject: [PATCH 179/267] [skip actions] Bump version to 0.3.1.9010 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index d905b330..640a92b5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9009 +Version: 0.3.1.9010 Authors@R: c( person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")), From 640cdac366507a108a775e26bc15a251ad10d453 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 25 Jan 2024 18:06:05 +0100 Subject: [PATCH 180/267] fix/revert: metadata is no longer inferred --- R/write.R | 6 ++++-- man/xportr_write.Rd | 20 ++++++++++++++++++-- 2 files changed, 22 insertions(+), 4 deletions(-) diff --git a/R/write.R b/R/write.R index ec201acb..0cd3310d 100644 --- a/R/write.R +++ b/R/write.R @@ -12,7 +12,8 @@ #' @param strict_checks If TRUE, xpt validation will report errors and not write #' out the dataset. If FALSE, xpt validation will report warnings and continue #' with writing out the dataset. Defaults to FALSE -#' @inheritParams xportr_length +#' @inheritParams xportr_df_label +#' @inheritSection xportr_df_label Metadata #' #' @details #' * Variable and dataset labels are stored in the "label" attribute. @@ -67,7 +68,8 @@ xportr_write <- function(.df, domain <- domain %||% attr(.df, "_xportr.df_arg_") if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain - metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + # metadata should not be inferred from the data frame if it is not provided + # by the user. ## End of common section diff --git a/man/xportr_write.Rd b/man/xportr_write.Rd index b85f1766..3617beec 100644 --- a/man/xportr_write.Rd +++ b/man/xportr_write.Rd @@ -19,8 +19,8 @@ xportr_write( \item{path}{Path where transport file will be written. File name sans will be used as \code{xpt} name.} -\item{metadata}{A data frame containing variable level metadata. See -'Metadata' section for details.} +\item{metadata}{A data frame containing dataset. See 'Metadata' section for +details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be @@ -49,6 +49,22 @@ to the FDA. \item SAS type are stored in the "SAStype" attribute. } } +\section{Metadata}{ + The argument passed in the 'metadata' argument can either +be a metacore object, or a data.frame containing the data listed below. If +metacore is used, no changes to options are required. + +For data.frame 'metadata' arguments two columns must be present: +\enumerate{ +\item Domain Name - passed as the 'xportr.df_domain_name' option. Default: +"dataset". This is the column subset by the 'domain' argument in the +function. +\item Label Name - passed as the 'xportr.df_label' option. Default: +"label". Character values to update the 'label' attribute of the +dataframe This is passed to \code{haven::write_xpt} to note the label. +} +} + \examples{ adsl <- data.frame( SUBL = as.character(123, 456, 789), From 50aa32443345e7d3badf3534de5793372eef4bf3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 25 Jan 2024 18:14:03 +0100 Subject: [PATCH 181/267] fix: move verbose inferrence to common section --- R/label.R | 12 ++++++------ R/length.R | 12 ++++++------ R/metadata.R | 1 + R/order.R | 12 ++++++------ R/type.R | 12 ++++++------ 5 files changed, 25 insertions(+), 24 deletions(-) diff --git a/R/label.R b/R/label.R index df003275..113d216e 100644 --- a/R/label.R +++ b/R/label.R @@ -76,6 +76,12 @@ xportr_label <- function(.df, metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + # Verbose should use an explicit verbose option first, then the value set in + # metadata, and finally fall back to the option value + verbose <- verbose %||% + attr(.df, "_xportr.df_verbose_") %||% + getOption("xportr.label_verbose", "none") + ## End of common section assert_data_frame(.df) @@ -101,12 +107,6 @@ xportr_label <- function(.df, # Check any variables missed in metadata but present in input data --- miss_vars <- setdiff(names(.df), metadata[[variable_name]]) - # Verbose should use an explicit verbose option first, then the value set in - # metadata, and finally fall back to the option value - verbose <- verbose %||% - attr(.df, "_xportr.df_verbose_") %||% - getOption("xportr.label_verbose", "none") - label_log(miss_vars, verbose) label <- metadata[[variable_label]] diff --git a/R/length.R b/R/length.R index 9e3f7293..d329d664 100644 --- a/R/length.R +++ b/R/length.R @@ -83,6 +83,12 @@ xportr_length <- function(.df, metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + # Verbose should use an explicit verbose option first, then the value set in + # metadata, and finally fall back to the option value + verbose <- verbose %||% + attr(.df, "_xportr.df_verbose_") %||% + getOption("xportr.length_verbose", "none") + ## End of common section assert_data_frame(.df) @@ -107,12 +113,6 @@ xportr_length <- function(.df, # Check any variables missed in metadata but present in input data --- miss_vars <- setdiff(names(.df), metadata[[variable_name]]) - # Verbose should use an explicit verbose option first, then the value set in - # metadata, and finally fall back to the option value - verbose <- verbose %||% - attr(.df, "_xportr.df_verbose_") %||% - getOption("xportr.length_verbose", "none") - length_log(miss_vars, verbose) length <- metadata[[variable_length]] diff --git a/R/metadata.R b/R/metadata.R index 5e09f44e..e6060ece 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -58,6 +58,7 @@ xportr_metadata <- function(.df, assert_data_frame(.df) assert_metadata(metadata, include_fun_message = FALSE, null.ok = TRUE) assert_string(domain, null.ok = TRUE) + assert_choice(verbose, choices = .internal_verbose_choices, null.ok = TRUE) structure(.df, `_xportr.df_metadata_` = metadata, diff --git a/R/order.R b/R/order.R index dc156606..39b4d528 100644 --- a/R/order.R +++ b/R/order.R @@ -79,6 +79,12 @@ xportr_order <- function(.df, metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + # Verbose should use an explicit verbose option first, then the value set in + # metadata, and finally fall back to the option value + verbose <- verbose %||% + attr(.df, "_xportr.df_verbose_") %||% + getOption("xportr.order_verbose", "none") + ## End of common section assert_data_frame(.df) @@ -122,12 +128,6 @@ xportr_order <- function(.df, # Used in warning message for how many vars have been moved reorder_vars <- names(df_re_ord)[names(df_re_ord) != names(.df)] - # Verbose should use an explicit verbose option first, then the value set in - # metadata, and finally fall back to the option value - verbose <- verbose %||% - attr(.df, "_xportr.df_verbose_") %||% - getOption("xportr.order_verbose", "none") - # Function is located in messages.R var_ord_msg(reorder_vars, names(drop_vars), verbose) diff --git a/R/type.R b/R/type.R index d3a916d5..df2264b0 100644 --- a/R/type.R +++ b/R/type.R @@ -97,6 +97,12 @@ xportr_type <- function(.df, metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + # Verbose should use an explicit verbose option first, then the value set in + # metadata, and finally fall back to the option value + verbose <- verbose %||% + attr(.df, "_xportr.df_verbose_") %||% + getOption("xportr.type_verbose", "none") + ## End of common section assert_data_frame(.df) @@ -148,12 +154,6 @@ xportr_type <- function(.df, type.y = if_else(type.y %in% numericTypes, "_numeric", type.y) ) - # Verbose should use an explicit verbose option first, then the value set in - # metadata, and finally fall back to the option value - verbose <- verbose %||% - attr(.df, "_xportr.df_verbose_") %||% - getOption("xportr.type_verbose", "none") - # It is possible that a variable exists in the table that isn't in the metadata # it will be silently ignored here. This may happen depending on what a user # passes and the options they choose. The check_core function is the place From 2d6b3bb6c9d0dcd49c03e5dd48dee838701ff3e3 Mon Sep 17 00:00:00 2001 From: Celine Piraux <69685640+cpiraux@users.noreply.github.com> Date: Fri, 26 Jan 2024 09:46:01 +0100 Subject: [PATCH 182/267] add match.args MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- R/length.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/length.R b/R/length.R index 313bacb0..2253618e 100644 --- a/R/length.R +++ b/R/length.R @@ -75,6 +75,7 @@ xportr_length <- function(.df, length = "metadata", verbose = getOption("xportr.length_verbose", "none"), metacore = deprecated()) { + length <- match.args(length) if (!missing(metacore)) { lifecycle::deprecate_stop( when = "0.3.1.9005", From 53c9cef7a8a6134cc0728750fce08c7bc903f8b1 Mon Sep 17 00:00:00 2001 From: Celine Piraux <69685640+cpiraux@users.noreply.github.com> Date: Fri, 26 Jan 2024 09:46:48 +0100 Subject: [PATCH 183/267] add assertion on parameter MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- R/utils-xportr.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/utils-xportr.R b/R/utils-xportr.R index b5e93ece..2a062fda 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -384,6 +384,8 @@ check_multiple_var_specs <- function(metadata, #' @export variable_max_length <- function(.df) { + assert_data_frame(.df) + variable_length <- getOption("xportr.length") variable_name <- getOption("xportr.variable_name") From 86c604f1e2b10f09e9cdbbef140129c5c39afc44 Mon Sep 17 00:00:00 2001 From: Celine Piraux <69685640+cpiraux@users.noreply.github.com> Date: Fri, 26 Jan 2024 09:47:37 +0100 Subject: [PATCH 184/267] add assertion on parameters MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- R/messages.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/messages.R b/R/messages.R index da86ba81..37b691a9 100644 --- a/R/messages.R +++ b/R/messages.R @@ -190,6 +190,9 @@ var_ord_msg <- function(reordered_vars, moved_vars, verbose) { #' @return Output to Console max_length_msg <- function(max_length, verbose) { + assert_data_frame(max_length) + assert_choice(verbose, choices = .internal_verbose_choices) + if (nrow(max_length) > 0) { cli_h2("Variable length is shorter than the length specified in the metadata.") From cd01549f34e6819b070d56cdbfc22dcf05000bed Mon Sep 17 00:00:00 2001 From: Celine Piraux <69685640+cpiraux@users.noreply.github.com> Date: Fri, 26 Jan 2024 09:47:58 +0100 Subject: [PATCH 185/267] remove blank line MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> --- R/utils-xportr.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/utils-xportr.R b/R/utils-xportr.R index 2a062fda..f83c9eb3 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -459,4 +459,3 @@ assert_metadata <- function(metadata, #' Internal choices for verbose option #' @noRd .internal_verbose_choices <- c("none", "warn", "message", "stop") - From da6f80e415d6e48a520d25f1c75952c11e720b86 Mon Sep 17 00:00:00 2001 From: Celine Date: Fri, 26 Jan 2024 03:55:03 -0500 Subject: [PATCH 186/267] run devtools::document() --- man/metadata.Rd | 4 ++-- man/xportr_df_label.Rd | 4 ++-- man/xportr_format.Rd | 4 ++-- man/xportr_label.Rd | 4 ++-- man/xportr_length.Rd | 4 ++-- man/xportr_options.Rd | 2 +- man/xportr_order.Rd | 4 ++-- man/xportr_type.Rd | 4 ++-- man/xportr_write.Rd | 4 ++-- 9 files changed, 17 insertions(+), 17 deletions(-) diff --git a/man/metadata.Rd b/man/metadata.Rd index 658fe0a4..71d2b4cd 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -13,8 +13,8 @@ xportr_metadata(.df, metadata = NULL, domain = NULL) 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be -called before hand to set the domain as an attribute of \code{.df}.} +the metadata object. If none is passed, then name of the dataset passed as +.df will be used.} } \value{ \code{.df} dataset with metadata and domain attributes set diff --git a/man/xportr_df_label.Rd b/man/xportr_df_label.Rd index 363c59c4..691de990 100644 --- a/man/xportr_df_label.Rd +++ b/man/xportr_df_label.Rd @@ -13,8 +13,8 @@ xportr_df_label(.df, metadata = NULL, domain = NULL, metacore = deprecated()) details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be -called before hand to set the domain as an attribute of \code{.df}.} +the metadata object. If none is passed, then name of the dataset passed as +.df will be used.} \item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass metadata now renamed with \code{metadata}} diff --git a/man/xportr_format.Rd b/man/xportr_format.Rd index dd883554..c1655dbd 100644 --- a/man/xportr_format.Rd +++ b/man/xportr_format.Rd @@ -13,8 +13,8 @@ xportr_format(.df, metadata = NULL, domain = NULL, metacore = deprecated()) 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be -called before hand to set the domain as an attribute of \code{.df}.} +the metadata object. If none is passed, then name of the dataset passed as +.df will be used.} \item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass metadata now renamed with \code{metadata}} diff --git a/man/xportr_label.Rd b/man/xportr_label.Rd index 6af7ad9a..4cd7d18c 100644 --- a/man/xportr_label.Rd +++ b/man/xportr_label.Rd @@ -19,8 +19,8 @@ xportr_label( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be -called before hand to set the domain as an attribute of \code{.df}.} +the metadata object. If none is passed, then name of the dataset passed as +.df will be used.} \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index 58360219..0e922374 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -20,8 +20,8 @@ xportr_length( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be -called before hand to set the domain as an attribute of \code{.df}.} +the metadata object. If none is passed, then name of the dataset passed as +.df will be used.} \item{length}{Choose the assigned length from either metadata or data. diff --git a/man/xportr_options.Rd b/man/xportr_options.Rd index 4194aa52..feb212cd 100644 --- a/man/xportr_options.Rd +++ b/man/xportr_options.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/options.R \name{xportr_options} \alias{xportr_options} -\title{Get or set Xportr options} +\title{Get or set xportr options} \usage{ xportr_options(...) } diff --git a/man/xportr_order.Rd b/man/xportr_order.Rd index 50fd7e73..7a796e37 100644 --- a/man/xportr_order.Rd +++ b/man/xportr_order.Rd @@ -19,8 +19,8 @@ xportr_order( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be -called before hand to set the domain as an attribute of \code{.df}.} +the metadata object. If none is passed, then name of the dataset passed as +.df will be used.} \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index f8c17945..8886e6d3 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -19,8 +19,8 @@ xportr_type( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be -called before hand to set the domain as an attribute of \code{.df}.} +the metadata object. If none is passed, then name of the dataset passed as +.df will be used.} \item{verbose}{The action this function takes when an action is taken on the dataset or function validation finds an issue. See 'Messaging' section for diff --git a/man/xportr_write.Rd b/man/xportr_write.Rd index b85f1766..db739e9c 100644 --- a/man/xportr_write.Rd +++ b/man/xportr_write.Rd @@ -23,8 +23,8 @@ used as \code{xpt} name.} 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be -called before hand to set the domain as an attribute of \code{.df}.} +the metadata object. If none is passed, then name of the dataset passed as +.df will be used.} \item{strict_checks}{If TRUE, xpt validation will report errors and not write out the dataset. If FALSE, xpt validation will report warnings and continue From 9c129cc7e955845b237427be39772d2250366686 Mon Sep 17 00:00:00 2001 From: Celine Date: Fri, 26 Jan 2024 04:27:11 -0500 Subject: [PATCH 187/267] Remove blank line --- R/messages.R | 2 +- R/utils-xportr.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/messages.R b/R/messages.R index 37b691a9..ebe43a69 100644 --- a/R/messages.R +++ b/R/messages.R @@ -192,7 +192,7 @@ var_ord_msg <- function(reordered_vars, moved_vars, verbose) { max_length_msg <- function(max_length, verbose) { assert_data_frame(max_length) assert_choice(verbose, choices = .internal_verbose_choices) - + if (nrow(max_length) > 0) { cli_h2("Variable length is shorter than the length specified in the metadata.") diff --git a/R/utils-xportr.R b/R/utils-xportr.R index f83c9eb3..a6b9077e 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -385,7 +385,7 @@ check_multiple_var_specs <- function(metadata, variable_max_length <- function(.df) { assert_data_frame(.df) - + variable_length <- getOption("xportr.length") variable_name <- getOption("xportr.variable_name") From 7bbfca89c9831b5ca8039354ba22a79ccbbc4581 Mon Sep 17 00:00:00 2001 From: bs832471 Date: Sun, 28 Jan 2024 22:36:53 +0000 Subject: [PATCH 188/267] fix: #91 typo in match.arg function --- R/length.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/length.R b/R/length.R index 2253618e..4301ff82 100644 --- a/R/length.R +++ b/R/length.R @@ -75,7 +75,7 @@ xportr_length <- function(.df, length = "metadata", verbose = getOption("xportr.length_verbose", "none"), metacore = deprecated()) { - length <- match.args(length) + length <- match.arg(length) if (!missing(metacore)) { lifecycle::deprecate_stop( when = "0.3.1.9005", From 5d971f221c043d2933651959c3074eed990dff59 Mon Sep 17 00:00:00 2001 From: EeethB Date: Mon, 29 Jan 2024 11:43:27 -0500 Subject: [PATCH 189/267] Add `xportr()` to README --- README.Rmd | 6 ++++++ README.md | 7 +++++++ 2 files changed, 13 insertions(+) diff --git a/README.Rmd b/README.Rmd index 8e8b5fd7..07d75c96 100644 --- a/README.Rmd +++ b/README.Rmd @@ -155,6 +155,12 @@ adsl %>% xportr_write("adsl.xpt") ``` +Furthermore, if you're calling all xportr functions at once with common metadata and verbosity, you can shorten it by simply using `xportr()`. + +```{r, warning=FALSE, message=FALSE, eval=FALSE} +xportr(adsl, var_spec, dataset_spec, "ADSL", verbose = "warn", "adsl.xpt") +``` + That's it! We now have a xpt file created in R with all appropriate types, lengths, labels, ordering and formats. Please check out the [Get Started](https://atorus-research.github.io/xportr/articles/xportr.html) for more information and detailed walk through of each `xportr_` function. We are in talks with other Pharma companies involved with the [`{pharmaverse}`](https://pharmaverse.org/) to enhance this package to play well with other downstream and upstream packages. diff --git a/README.md b/README.md index 6546d5b1..9d84dc0f 100644 --- a/README.md +++ b/README.md @@ -165,6 +165,13 @@ adsl %>% xportr_write("adsl.xpt") ``` +Furthermore, if you’re calling all xportr functions at once with common +metadata and verbosity, you can shorten it by simply using `xportr()`. + +``` r +xportr(adsl, var_spec, dataset_spec, "ADSL", verbose = "warn", "adsl.xpt") +``` + That’s it! We now have a xpt file created in R with all appropriate types, lengths, labels, ordering and formats. Please check out the [Get Started](https://atorus-research.github.io/xportr/articles/xportr.html) From 782161d741e8ae60275e062ff2f7a4a6b2b802e5 Mon Sep 17 00:00:00 2001 From: bms63 Date: Mon, 29 Jan 2024 18:19:04 +0000 Subject: [PATCH 190/267] [skip actions] Bump version to 0.3.1.9011 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 640a92b5..f45da4ce 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9010 +Version: 0.3.1.9011 Authors@R: c( person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")), From ea7c8e54d753d03bf59a21215eda81855487a43a Mon Sep 17 00:00:00 2001 From: bms63 Date: Mon, 29 Jan 2024 18:31:49 +0000 Subject: [PATCH 191/267] [skip actions] Bump version to 0.3.1.9012 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index f45da4ce..b2201a55 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9011 +Version: 0.3.1.9012 Authors@R: c( person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")), From 9ac78b029e09198f0168aedf9112d617c59f538b Mon Sep 17 00:00:00 2001 From: bs832471 Date: Mon, 29 Jan 2024 18:52:46 +0000 Subject: [PATCH 192/267] docs: #91 including data option. updating vignettes --- R/length.R | 4 ++-- man/xportr_length.Rd | 2 +- vignettes/deepdive.Rmd | 10 +++++----- vignettes/xportr.Rmd | 2 +- 4 files changed, 9 insertions(+), 9 deletions(-) diff --git a/R/length.R b/R/length.R index 4ed30c7e..d7cf31a5 100644 --- a/R/length.R +++ b/R/length.R @@ -72,10 +72,10 @@ xportr_length <- function(.df, metadata = NULL, domain = NULL, - length = "metadata", + length = c("metadata", "data"), verbose = NULL, metacore = deprecated()) { - length <- match.arg(length) + # length <- match.arg(length) if (!missing(metacore)) { lifecycle::deprecate_stop( when = "0.3.1.9005", diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index dc052d2a..8a5f0d18 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -8,7 +8,7 @@ xportr_length( .df, metadata = NULL, domain = NULL, - length = "metadata", + length = c("metadata", "data"), verbose = NULL, metacore = deprecated() ) diff --git a/vignettes/deepdive.Rmd b/vignettes/deepdive.Rmd index fc9f601d..ae0c070a 100644 --- a/vignettes/deepdive.Rmd +++ b/vignettes/deepdive.Rmd @@ -179,7 +179,7 @@ Each of the core `{xportr}` functions requires several inputs: A valid dataframe ```{r, eval = FALSE} adsl %>% xportr_type(var_spec, "ADSL", "message") %>% - xportr_length(var_spec, "ADSL", "message") %>% + xportr_length(var_spec, "ADSL", "message", length = "metadata") %>% xportr_label(var_spec, "ADSL", "message") %>% xportr_order(var_spec, "ADSL", "message") %>% xportr_format(var_spec, "ADSL") %>% @@ -194,7 +194,7 @@ To help reduce these repetitive calls, we have created `xportr_metadata()`. A us adsl %>% xportr_metadata(var_spec, "ADSL") %>% xportr_type() %>% - xportr_length() %>% + xportr_length(length = "metadata") %>% xportr_label() %>% xportr_order() %>% xportr_format() %>% @@ -310,7 +310,7 @@ str(adsl) ``` ```{r, echo = TRUE} -adsl_length <- xportr_length(.df = adsl, metadata = var_spec, domain = "ADSL", verbose = "warn") +adsl_length <- xportr_length(.df = adsl, metadata = var_spec, domain = "ADSL", verbose = "warn", length = "metadata") ``` Using `xportr_length()` with `verbose = "warn"` we can apply the length column to all the columns in the dataset. The function detects that two variables, `TRTDUR` and `DCREASCD` are missing from the metadata file. Note that the variables have slight misspellings in the dataset and metadata, which is a great catch! However, lengths are still applied with TRTDUR being give a length of 8 and DCREASCD a length of 200. @@ -325,7 +325,7 @@ str(adsl_length) Just like we did for `xportr_type()`, setting `verbose = "stop"` immediately stops R from processing the lengths. Here the function detects the missing variables and will not apply any lengths to the dataset until corrective action is applied. ```{r, echo = TRUE, error = TRUE} -adsl_length <- xportr_length(.df = adsl, metadata = var_spec, domain = "ADSL", verbose = "stop") +adsl_length <- xportr_length(.df = adsl, metadata = var_spec, domain = "ADSL", verbose = "stop", length = "metadata") ``` @@ -426,7 +426,7 @@ It is also note worthy that you can set the dataset label using the `xportr_df_l adsl %>% xportr_metadata(var_spec, "ADSL") %>% xportr_type() %>% - xportr_length() %>% + xportr_length(length = "metadata") %>% xportr_label() %>% xportr_order() %>% xportr_format() %>% diff --git a/vignettes/xportr.Rmd b/vignettes/xportr.Rmd index 2e39f386..53331e9f 100644 --- a/vignettes/xportr.Rmd +++ b/vignettes/xportr.Rmd @@ -274,7 +274,7 @@ Finally, we arrive at exporting the R data frame object as a `xpt` file with `xp ```{r} adsl %>% xportr_type(var_spec, "ADSL", "message") %>% - xportr_length(var_spec, "ADSL", "message") %>% + xportr_length(var_spec, "ADSL", "message", length = "metadata") %>% xportr_label(var_spec, "ADSL", "message") %>% xportr_order(var_spec, "ADSL", "message") %>% xportr_format(var_spec, "ADSL") %>% From d02431ef7792768b8be2e0446f57500db373a6fd Mon Sep 17 00:00:00 2001 From: bs832471 Date: Mon, 29 Jan 2024 19:01:51 +0000 Subject: [PATCH 193/267] fix: #91 global bindings and arguments --- R/length.R | 4 ++-- R/xportr-package.R | 2 +- man/xportr_length.Rd | 4 ++-- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/length.R b/R/length.R index d7cf31a5..0c3179bb 100644 --- a/R/length.R +++ b/R/length.R @@ -68,11 +68,11 @@ #' length = c(10, 8) #' ) #' -#' adsl <- xportr_length(adsl, metadata, domain = "adsl") +#' adsl <- xportr_length(adsl, metadata, domain = "adsl", length = "metadata") xportr_length <- function(.df, metadata = NULL, domain = NULL, - length = c("metadata", "data"), + length = "metadata", verbose = NULL, metacore = deprecated()) { # length <- match.arg(length) diff --git a/R/xportr-package.R b/R/xportr-package.R index 7ffeafcb..6168f506 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -117,7 +117,7 @@ globalVariables(c( "abbr_parsed", "abbr_stem", "adj_orig", "adj_parsed", "col_pos", "dict_varname", "lower_original_varname", "my_minlength", "num_st_ind", "original_varname", "renamed_n", "renamed_var", "use_bundle", "viable_start", "type.x", "type.y", - "variable" + "variable", "length.x", "lenght.y" )) # The following block is used by usethis to automatically manage diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index 8a5f0d18..c5fc1bd5 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -8,7 +8,7 @@ xportr_length( .df, metadata = NULL, domain = NULL, - length = c("metadata", "data"), + length = "metadata", verbose = NULL, metacore = deprecated() ) @@ -89,5 +89,5 @@ metadata <- data.frame( length = c(10, 8) ) -adsl <- xportr_length(adsl, metadata, domain = "adsl") +adsl <- xportr_length(adsl, metadata, domain = "adsl", length = "metadata") } From b8469998afe22f7aaa98e37b53f5e2a551c3e6c1 Mon Sep 17 00:00:00 2001 From: bs832471 Date: Mon, 29 Jan 2024 19:19:16 +0000 Subject: [PATCH 194/267] chore: #91 nolint commented code --- R/length.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/length.R b/R/length.R index 0c3179bb..fddcbf67 100644 --- a/R/length.R +++ b/R/length.R @@ -75,7 +75,7 @@ xportr_length <- function(.df, length = "metadata", verbose = NULL, metacore = deprecated()) { - # length <- match.arg(length) + # length <- match.arg(length) # nolint if (!missing(metacore)) { lifecycle::deprecate_stop( when = "0.3.1.9005", From 548821682e48fcb6c48b611123abd3f59a7ee9b9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 30 Jan 2024 19:28:29 +0100 Subject: [PATCH 195/267] fix: use match.arg for xportr_lenght lenght --- R/length.R | 4 ++-- man/xportr_length.Rd | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/length.R b/R/length.R index fddcbf67..de6fa9a8 100644 --- a/R/length.R +++ b/R/length.R @@ -72,10 +72,10 @@ xportr_length <- function(.df, metadata = NULL, domain = NULL, - length = "metadata", + length = c("metadata", "data"), verbose = NULL, metacore = deprecated()) { - # length <- match.arg(length) # nolint + length <- match.arg(length) if (!missing(metacore)) { lifecycle::deprecate_stop( when = "0.3.1.9005", diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index c5fc1bd5..5f944084 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -8,7 +8,7 @@ xportr_length( .df, metadata = NULL, domain = NULL, - length = "metadata", + length = c("metadata", "data"), verbose = NULL, metacore = deprecated() ) From 89f421ab33550edf7c5de46ff062dd7f4013a0bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 30 Jan 2024 19:46:50 +0100 Subject: [PATCH 196/267] fix: correct order of parameters on vignettes --- vignettes/deepdive.Rmd | 2 +- vignettes/xportr.Rmd | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/vignettes/deepdive.Rmd b/vignettes/deepdive.Rmd index ae0c070a..b245ad15 100644 --- a/vignettes/deepdive.Rmd +++ b/vignettes/deepdive.Rmd @@ -179,7 +179,7 @@ Each of the core `{xportr}` functions requires several inputs: A valid dataframe ```{r, eval = FALSE} adsl %>% xportr_type(var_spec, "ADSL", "message") %>% - xportr_length(var_spec, "ADSL", "message", length = "metadata") %>% + xportr_length(var_spec, "ADSL", verbose = "message") %>% xportr_label(var_spec, "ADSL", "message") %>% xportr_order(var_spec, "ADSL", "message") %>% xportr_format(var_spec, "ADSL") %>% diff --git a/vignettes/xportr.Rmd b/vignettes/xportr.Rmd index 53331e9f..7ea6eaa3 100644 --- a/vignettes/xportr.Rmd +++ b/vignettes/xportr.Rmd @@ -186,7 +186,7 @@ str(adsl) No lengths have been applied to the variables as seen in the printout - the lengths would be in the `attr()` part of each variables. Let's now use `xportr_length()` to apply our lengths from the specification file. ```{r} -adsl_length <- adsl %>% xportr_length(var_spec, domain = "ADSL", "message") +adsl_length <- adsl %>% xportr_length(var_spec, domain = "ADSL", verbose = "message") ``` @@ -274,7 +274,7 @@ Finally, we arrive at exporting the R data frame object as a `xpt` file with `xp ```{r} adsl %>% xportr_type(var_spec, "ADSL", "message") %>% - xportr_length(var_spec, "ADSL", "message", length = "metadata") %>% + xportr_length(var_spec, "ADSL", verbose = "message") %>% xportr_label(var_spec, "ADSL", "message") %>% xportr_order(var_spec, "ADSL", "message") %>% xportr_format(var_spec, "ADSL") %>% From 454e1a7f8e819ed93c4b18bd98b98c411672f064 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 30 Jan 2024 20:16:39 +0100 Subject: [PATCH 197/267] feat: remove uneeded depedencies --- DESCRIPTION | 4 ---- README.Rmd | 2 +- README.md | 4 ++-- 3 files changed, 3 insertions(+), 7 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index b2201a55..74a44307 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -41,17 +41,13 @@ Imports: tm Suggests: admiral, - devtools, DT, knitr, labelled, - lintr, metacore, readxl, rmarkdown, - spelling, testthat (>= 3.0.0), - usethis, withr VignetteBuilder: knitr diff --git a/README.Rmd b/README.Rmd index 462f205c..d875a81f 100644 --- a/README.Rmd +++ b/README.Rmd @@ -46,7 +46,7 @@ install.packages("xportr") ### Development version: ```{r, eval = FALSE} -devtools::install_github("https://github.com/atorus-research/xportr.git", ref = "devel") +install.packages("teal", repos = c("https://pharmaverse.r-universe.dev", getOption("repos"))) ``` # What is xportr? diff --git a/README.md b/README.md index bebb06c8..214fca27 100644 --- a/README.md +++ b/README.md @@ -36,7 +36,7 @@ install.packages("xportr") ### Development version: ``` r -devtools::install_github("https://github.com/atorus-research/xportr.git", ref = "devel") +install.packages("teal", repos = c("https://pharmaverse.r-universe.dev", getOption("repos"))) ``` # What is xportr? @@ -155,7 +155,7 @@ each function call. ``` r adsl %>% - xportr_metadata(var_spec, "ADSL") %>% + xportr_metadata(var_spec, "ADSL", verbose = "warn") %>% xportr_type() %>% xportr_length() %>% xportr_label() %>% From 278b098994e95acd3d2d365f50d013c3c2dd0d51 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 30 Jan 2024 20:20:35 +0100 Subject: [PATCH 198/267] fix: remove unnecessary magrittr conditionals --- R/metadata.R | 12 ++--- man/metadata.Rd | 12 ++--- tests/testthat/test-metadata.R | 84 +++++++++++++++++----------------- 3 files changed, 51 insertions(+), 57 deletions(-) diff --git a/R/metadata.R b/R/metadata.R index e6060ece..92116eca 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -32,14 +32,12 @@ #' #' xportr_metadata(adlb, metadata, "test") #' -#' if (rlang::is_installed("magrittr")) { -#' library(magrittr) +#' library(magrittr) #' -#' adlb %>% -#' xportr_metadata(metadata, "test") %>% -#' xportr_type() %>% -#' xportr_order() -#' } +#' adlb %>% +#' xportr_metadata(metadata, "test") %>% +#' xportr_type() %>% +#' xportr_order() xportr_metadata <- function(.df, metadata = NULL, domain = NULL, diff --git a/man/metadata.Rd b/man/metadata.Rd index da5de14c..0c542e1e 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -49,12 +49,10 @@ adlb <- data.frame( xportr_metadata(adlb, metadata, "test") -if (rlang::is_installed("magrittr")) { - library(magrittr) +library(magrittr) - adlb \%>\% - xportr_metadata(metadata, "test") \%>\% - xportr_type() \%>\% - xportr_order() -} +adlb \%>\% + xportr_metadata(metadata, "test") \%>\% + xportr_type() \%>\% + xportr_order() } diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index 55c91cde..0bc0549e 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -743,49 +743,47 @@ test_that("xportr_*: Domain is kept in between calls", { # end test_that("`xportr_metadata()` results match traditional results", { - if (require(magrittr, quietly = TRUE)) { - test_dir <- tempdir() - - trad_path <- file.path(test_dir, "adsltrad.xpt") - metadata_path <- file.path(test_dir, "adslmeta.xpt") - - dataset_spec_low <- setNames(dataset_spec, tolower(names(dataset_spec))) - names(dataset_spec_low)[[2]] <- "label" - - var_spec_low <- setNames(var_spec, tolower(names(var_spec))) - names(var_spec_low)[[5]] <- "type" - - metadata_df <- adsl %>% - xportr_metadata(var_spec_low, "ADSL", verbose = "none") %>% - xportr_type() %>% - xportr_length() %>% - xportr_label() %>% - xportr_order() %>% - xportr_format() %>% - xportr_df_label(dataset_spec_low) %>% - xportr_write(metadata_path) - - trad_df <- adsl %>% - xportr_type(var_spec_low, "ADSL", verbose = "none") %>% - xportr_length(var_spec_low, "ADSL", verbose = "none") %>% - xportr_label(var_spec_low, "ADSL", verbose = "none") %>% - xportr_order(var_spec_low, "ADSL", verbose = "none") %>% - xportr_format(var_spec_low, "ADSL") %>% - xportr_df_label(dataset_spec_low, "ADSL") %>% - xportr_write(trad_path) - - expect_identical( - metadata_df, - structure( - trad_df, - `_xportr.df_metadata_` = var_spec_low, - `_xportr.df_verbose_` = "none" - ) - ) + test_dir <- tempdir() + + trad_path <- file.path(test_dir, "adsltrad.xpt") + metadata_path <- file.path(test_dir, "adslmeta.xpt") + + dataset_spec_low <- setNames(dataset_spec, tolower(names(dataset_spec))) + names(dataset_spec_low)[[2]] <- "label" - expect_identical( - haven::read_xpt(metadata_path), - haven::read_xpt(trad_path) + var_spec_low <- setNames(var_spec, tolower(names(var_spec))) + names(var_spec_low)[[5]] <- "type" + + metadata_df <- adsl %>% + xportr_metadata(var_spec_low, "ADSL", verbose = "none") %>% + xportr_type() %>% + xportr_length() %>% + xportr_label() %>% + xportr_order() %>% + xportr_format() %>% + xportr_df_label(dataset_spec_low) %>% + xportr_write(metadata_path) + + trad_df <- adsl %>% + xportr_type(var_spec_low, "ADSL", verbose = "none") %>% + xportr_length(var_spec_low, "ADSL", verbose = "none") %>% + xportr_label(var_spec_low, "ADSL", verbose = "none") %>% + xportr_order(var_spec_low, "ADSL", verbose = "none") %>% + xportr_format(var_spec_low, "ADSL") %>% + xportr_df_label(dataset_spec_low, "ADSL") %>% + xportr_write(trad_path) + + expect_identical( + metadata_df, + structure( + trad_df, + `_xportr.df_metadata_` = var_spec_low, + `_xportr.df_verbose_` = "none" ) - } + ) + + expect_identical( + haven::read_xpt(metadata_path), + haven::read_xpt(trad_path) + ) }) From 30ba898d83590df93b95fc908bb1591020597ff7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 30 Jan 2024 20:27:53 +0100 Subject: [PATCH 199/267] fix: linting project (adds workflow dispatch) --- .github/workflows/lint.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml index 85e6a1b3..7556a66f 100644 --- a/.github/workflows/lint.yaml +++ b/.github/workflows/lint.yaml @@ -9,6 +9,7 @@ on: pull_request: branches: - main + workflow_dispatch: jobs: lint: @@ -25,7 +26,6 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: extra-packages: any::lintr, local::. - needs: lint - name: Lint run: lintr::lint_package() From 394a6a5c0a85891ceec870a3278e2ea828e77639 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 30 Jan 2024 20:45:11 +0100 Subject: [PATCH 200/267] fix: cleanup pkgdown from SASxport --- .github/workflows/pkgdown.yaml | 25 +++---------------------- 1 file changed, 3 insertions(+), 22 deletions(-) diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 967eb46d..227b1a87 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -17,29 +17,10 @@ jobs: - uses: r-lib/actions/setup-pandoc@v1 - - name: Query dependencies - run: | - install.packages('remotes') - saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) - writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") - shell: Rscript {0} - - - name: Restore R package cache - uses: actions/cache@v2 + - uses: r-lib/actions/setup-r-dependencies@v2 with: - path: ${{ env.R_LIBS_USER }} - key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} - restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- - - - name: Install dependencies - run: | - remotes::install_deps(dependencies = TRUE) - install.packages("pkgdown", type = "binary") - remotes::install_github("warnes/SASxport", ref = "master") - shell: Rscript {0} - - - name: Install package - run: R CMD INSTALL . + extra-packages: any::pkgdown, local::. + needs: website - name: Deploy package run: | From 101fc81197042960f22f3b1a32405e757fffda4c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 30 Jan 2024 21:02:01 +0100 Subject: [PATCH 201/267] fix: updates to all --- .github/workflows/check-links.yml | 2 + .github/workflows/check-standard.yaml | 7 +++- .github/workflows/lint.yaml | 3 ++ .github/workflows/pkgdown.yaml | 1 + .github/workflows/spellcheck.yml | 60 ++++----------------------- .github/workflows/style.yml | 36 ++++++++++++++-- .github/workflows/test-coverage.yaml | 24 ++--------- .github/workflows/vbump.yaml | 1 + 8 files changed, 59 insertions(+), 75 deletions(-) diff --git a/.github/workflows/check-links.yml b/.github/workflows/check-links.yml index 21e50fa5..98197598 100644 --- a/.github/workflows/check-links.yml +++ b/.github/workflows/check-links.yml @@ -1,3 +1,4 @@ +--- name: Check URLs 🔗 on: @@ -7,6 +8,7 @@ on: pull_request: branches: - main + workflow_dispatch: jobs: links: diff --git a/.github/workflows/check-standard.yaml b/.github/workflows/check-standard.yaml index 05c1b71c..ae9b1047 100644 --- a/.github/workflows/check-standard.yaml +++ b/.github/workflows/check-standard.yaml @@ -1,3 +1,4 @@ +--- # Workflow derived from https://github.com/r-lib/actions/tree/master/examples # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help name: R-CMD-check 📦 @@ -9,6 +10,7 @@ on: pull_request: branches: - main + workflow_dispatch: jobs: R-CMD-check: @@ -30,6 +32,9 @@ jobs: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} R_KEEP_PKG_SOURCE: yes + if: > + !contains(github.event.commits[0].message, '[skip checks]') + steps: - uses: actions/checkout@v3 @@ -43,6 +48,6 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: rcmdcheck + extra-packages: any::rcmdcheck - uses: r-lib/actions/check-r-package@v2 diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml index 7556a66f..2548a242 100644 --- a/.github/workflows/lint.yaml +++ b/.github/workflows/lint.yaml @@ -1,3 +1,4 @@ +--- # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help name: Check Lint 🧹 @@ -14,6 +15,8 @@ on: jobs: lint: runs-on: ubuntu-latest + if: > + !contains(github.event.commits[0].message, '[skip lint]') env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 227b1a87..d43e5feb 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -1,3 +1,4 @@ +--- name: Deploy pkgdown site 📜 on: diff --git a/.github/workflows/spellcheck.yml b/.github/workflows/spellcheck.yml index 5c7adb19..a5472a63 100644 --- a/.github/workflows/spellcheck.yml +++ b/.github/workflows/spellcheck.yml @@ -1,3 +1,4 @@ +--- name: Check Spelling 🆎 on: @@ -8,56 +9,13 @@ on: pull_request: branches: - main - -concurrency: - group: spelling-${{ github.event.pull_request.number || github.ref }} - cancel-in-progress: true + workflow_dispatch: jobs: - roxygen: - name: Spellcheck 🔠 - runs-on: ubuntu-20.04 - env: - GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} - if: > - !contains(github.event.commits[0].message, '[skip spellcheck]') - && github.event.pull_request.draft == false - steps: - - name: Checkout repo 🛎 - uses: actions/checkout@v3 - with: - persist-credentials: false - fetch-depth: 0 - - - name: Setup R 📊 - uses: r-lib/actions/setup-r@v2 - with: - r-version: 4.1.3 - - - uses: actions/cache@v2 - if: startsWith(runner.os, 'Linux') - with: - path: ~/.local/share/renv - key: ${{ runner.os }}-renv-${{ hashFiles('**/renv.lock') }} - restore-keys: | - ${{ runner.os }}-renv- - - name: Query dependencies - run: | - install.packages('remotes') - saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) - writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") - shell: Rscript {0} - - - name: Install system dependencies - if: runner.os == 'Linux' - run: | - while read -r cmd - do - eval sudo $cmd - done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))') - - - name: Run Spellcheck 👟 - uses: insightsengineering/r-spellcheck-action@v3 - with: - exclude: data/*,**/*.Rd,**/*.md,*.md - additional_options: "" + spelling: + name: Run Spellcheck 👟 + uses: insightsengineering/r-spellcheck-action@v3 + secrets: + REPO_GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + with: + exclude: data/*,**/*.Rd,**/*.md,*.md diff --git a/.github/workflows/style.yml b/.github/workflows/style.yml index 410da4b5..acbfe208 100644 --- a/.github/workflows/style.yml +++ b/.github/workflows/style.yml @@ -1,3 +1,4 @@ +--- name: Check Style 🎨 on: @@ -7,6 +8,7 @@ on: pull_request: branches: - main + workflow_dispatch: concurrency: group: style-${{ github.event.pull_request.number || github.ref }} @@ -30,14 +32,42 @@ jobs: with: use-public-rspm: true - - name: Install styler 🖌️ - run: install.packages(c("styler", "knitr", "roxygen2"), repos = "https://cloud.r-project.org") + - name: Install dependencies + uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::styler, any::roxygen2 + needs: styler + + - name: Enable styler cache + run: styler::cache_activate() shell: Rscript {0} + - name: Determine cache location + id: styler-location + run: | + cat( + "location=", + styler::cache_info(format = "tabular")$location, + "\n", + file = Sys.getenv("GITHUB_OUTPUT"), + append = TRUE, + sep = "" + ) + shell: Rscript {0} + + - name: Cache styler + uses: actions/cache@v4 + with: + path: ${{ steps.styler-location.outputs.location }} + key: ${{ runner.os }}-styler-${{ github.sha }} + restore-keys: | + ${{ runner.os }}-styler- + ${{ runner.os }}- + - name: Run styler 🖼️ run: | detect <- styler::style_pkg(dry = "on") - if (TRUE %in% detect$changed) { + if (any(detect$changed)) { problems <- subset(detect$file, detect$changed == T) cat(paste("Styling errors found in", length(problems), "files\n")) cat("Please run `styler::style_pkg()` to fix the style\n") diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 43ae648d..38c515b5 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -20,27 +20,11 @@ jobs: - uses: r-lib/actions/setup-pandoc@v1 - - name: Query dependencies - run: | - install.packages('remotes') - saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2) - writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version") - shell: Rscript {0} - - - name: Restore R package cache - uses: actions/cache@v2 + - name: Install R package dependencies + uses: r-lib/actions/setup-r-dependencies@v2 with: - path: ${{ env.R_LIBS_USER }} - key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} - restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- - - - name: Install dependencies - run: | - install.packages(c("remotes")) - remotes::install_deps(dependencies = TRUE) - remotes::install_cran("covr") - remotes::install_github("warnes/SASxport", ref = "master") - shell: Rscript {0} + # Necessary to avoid object usage linter errors. + extra-packages: local::., any::covr - name: Test coverage run: covr::codecov() diff --git a/.github/workflows/vbump.yaml b/.github/workflows/vbump.yaml index a2091019..11f9d4e5 100644 --- a/.github/workflows/vbump.yaml +++ b/.github/workflows/vbump.yaml @@ -1,3 +1,4 @@ +--- name: Version Bump ⬆️ on: From 4874088d7e6465a0ab605e237c2eb314b01370a7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 30 Jan 2024 23:36:15 +0100 Subject: [PATCH 202/267] fix: yaml file for spellcheck had duplicate entry --- .github/workflows/spellcheck.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/spellcheck.yml b/.github/workflows/spellcheck.yml index a5472a63..50109423 100644 --- a/.github/workflows/spellcheck.yml +++ b/.github/workflows/spellcheck.yml @@ -9,7 +9,6 @@ on: pull_request: branches: - main - workflow_dispatch: jobs: spelling: From 9edd32c8ab9ec7e3ae46a4c0a3809b642aa0e1b4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 30 Jan 2024 23:43:14 +0100 Subject: [PATCH 203/267] feat: spelling using generic job --- .github/workflows/spellcheck.yml | 29 ++++++++++++++++++++++++----- 1 file changed, 24 insertions(+), 5 deletions(-) diff --git a/.github/workflows/spellcheck.yml b/.github/workflows/spellcheck.yml index 50109423..695bc501 100644 --- a/.github/workflows/spellcheck.yml +++ b/.github/workflows/spellcheck.yml @@ -13,8 +13,27 @@ on: jobs: spelling: name: Run Spellcheck 👟 - uses: insightsengineering/r-spellcheck-action@v3 - secrets: - REPO_GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} - with: - exclude: data/*,**/*.Rd,**/*.md,*.md + runs-on: ubuntu-latest + # exclude: data/*,**/*.Rd,**/*.md,*.md + if: > + !contains(github.event.commits[0].message, '[skip spellcheck]') + steps: + - name: Checkout repository + uses: actions/checkout@v3 + + - name: Install R + uses: r-lib/actions/setup-r@v2 + + - name: Install R package dependencies + uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::spelling + + - name: Spell Check + run: | + spell_check <- spelling::spell_check_package(use_wordlist = TRUE) + if (nrow(spell_check) > 0) { + print(spell_check) + } + quit(status = nrow(spell_check) > 0) + shell: Rscript {0} From 9b1b9a198d76e57e9f03fef7bfcf1d4a69ee65b7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 30 Jan 2024 23:49:43 +0100 Subject: [PATCH 204/267] update wordlist --- NEWS.md | 2 +- README.md | 2 +- inst/WORDLIST | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/NEWS.md b/NEWS.md index d2114c91..048b7881 100644 --- a/NEWS.md +++ b/NEWS.md @@ -53,7 +53,7 @@ done to make the use of xportr functions more explicit. (#182) * Added function `xportr_metadata()` to explicitly set metadata at the start of a pipeline (#44) * Metadata order columns are now coerced to numeric by default in `xportr_order()` to prevent character sorting (#149) * Message is shown on `xportr_*` functions when the metadata being used has multiple variables with the same name in the same domain (#128) -* Fixed an issue with `xport_type()` where `DT`, `DTM` variables with a format specified in the metadata (e.g. date9., datetime20.) were being converted to numeric, which will cause a 10 year difference when reading it back by `read_xpt()`. SAS's uniform start date is 1960 whereas Linux's uniform start date is 1970 (#142). +* Fixed an issue with `xport_type()` where `DT`, `DTM` variables with a format specified in the metadata (e.g. `date9.`, `datetime20.`) were being converted to numeric, which will cause a 10 year difference when reading it back by `read_xpt()`. SAS's uniform start date is 1960 whereas Linux's uniform start date is 1970 (#142). * Fixed an issue with R's pipe `|>` that was causing functions to abort (#97) * Removed `<` and `>` as illegal characters in variable and dataset labels (#98) diff --git a/README.md b/README.md index 214fca27..31275d06 100644 --- a/README.md +++ b/README.md @@ -22,7 +22,7 @@ file(xpt)](https://documentation.sas.com/doc/en/pgmsascdc/9.4_3.5/movefile/n1xbw As always, we welcome your feedback. If you spot a bug, would like to see a new feature, or if any documentation is unclear - submit an issue -on [xportr’s GitHub +on [xportr's GitHub page](https://github.com/atorus-research/xportr/issues). ## Installation diff --git a/inst/WORDLIST b/inst/WORDLIST index 494ba288..0737fcba 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -12,12 +12,12 @@ DCREASCD DM GSK JPT -Lifecycle MMSE ORCID PHUSE Pharma Repostiory +SAS's SASformat SASlength SAStype @@ -33,7 +33,6 @@ acrf adrg bootswatch chr -cli deliverables df iso @@ -41,6 +40,7 @@ magrittr metacore pre repo +sas sdrg validator validators From ff7aeeb8e236a885559ae6c0e5b10319cb777300 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 30 Jan 2024 23:52:15 +0100 Subject: [PATCH 205/267] fix: extra whitespace --- .github/workflows/style.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/style.yml b/.github/workflows/style.yml index acbfe208..79cd8f72 100644 --- a/.github/workflows/style.yml +++ b/.github/workflows/style.yml @@ -42,7 +42,7 @@ jobs: run: styler::cache_activate() shell: Rscript {0} - - name: Determine cache location + - name: Determine cache location id: styler-location run: | cat( From c7cdee26d25f70f54d8c468d86a6d7fa6074a558 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 30 Jan 2024 23:57:37 +0100 Subject: [PATCH 206/267] bumps action version --- .github/workflows/style.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/style.yml b/.github/workflows/style.yml index 79cd8f72..2bc5c4d2 100644 --- a/.github/workflows/style.yml +++ b/.github/workflows/style.yml @@ -23,7 +23,7 @@ jobs: && github.event.pull_request.draft == false steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 with: path: ${{ github.event.repository.name }} fetch-depth: 0 From e83204bb8d99d07afa10a60441bbb4c9cd172c64 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 31 Jan 2024 00:03:09 +0100 Subject: [PATCH 207/267] revert: back to ie spellcheck action --- .github/workflows/spellcheck.yml | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/.github/workflows/spellcheck.yml b/.github/workflows/spellcheck.yml index 695bc501..f591e0d8 100644 --- a/.github/workflows/spellcheck.yml +++ b/.github/workflows/spellcheck.yml @@ -29,11 +29,5 @@ jobs: with: extra-packages: any::spelling - - name: Spell Check - run: | - spell_check <- spelling::spell_check_package(use_wordlist = TRUE) - if (nrow(spell_check) > 0) { - print(spell_check) - } - quit(status = nrow(spell_check) > 0) - shell: Rscript {0} + - name: Run Spelling Check test + uses: insightsengineering/r-spellcheck-action@v2 From e72cb0fc6ae2ead09adedb8b91a19733fb344dda Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 31 Jan 2024 00:04:30 +0100 Subject: [PATCH 208/267] fix: styler error --- .github/workflows/style.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/style.yml b/.github/workflows/style.yml index 2bc5c4d2..2211c0a7 100644 --- a/.github/workflows/style.yml +++ b/.github/workflows/style.yml @@ -35,7 +35,7 @@ jobs: - name: Install dependencies uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::styler, any::roxygen2 + extra-packages: any::styler, any::roxygen2, local::. needs: styler - name: Enable styler cache From 7a86d3ae4ffed5fe8b71d90bf9eeffcf77cebb68 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 31 Jan 2024 00:15:00 +0100 Subject: [PATCH 209/267] fix: remove path --- .github/workflows/style.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/style.yml b/.github/workflows/style.yml index 2211c0a7..82e2dbe3 100644 --- a/.github/workflows/style.yml +++ b/.github/workflows/style.yml @@ -25,14 +25,14 @@ jobs: steps: - uses: actions/checkout@v4 with: - path: ${{ github.event.repository.name }} fetch-depth: 0 - - uses: r-lib/actions/setup-r@v2 + - name: Setup R 📊 + uses: r-lib/actions/setup-r@v2 with: use-public-rspm: true - - name: Install dependencies + - name: Install R package dependencies 📦 uses: r-lib/actions/setup-r-dependencies@v2 with: extra-packages: any::styler, any::roxygen2, local::. From 200e56eaa6b08c347030f246bbff0dd642dc77ee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 31 Jan 2024 00:22:11 +0100 Subject: [PATCH 210/267] adds names to steps --- .github/workflows/check-links.yml | 3 ++- .github/workflows/check-standard.yaml | 14 ++++++++------ .github/workflows/lint.yaml | 8 +++++--- .github/workflows/pkgdown.yaml | 14 +++++++++----- .github/workflows/spellcheck.yml | 18 +++++++++++------- .github/workflows/test-coverage.yaml | 10 +++++----- 6 files changed, 40 insertions(+), 27 deletions(-) diff --git a/.github/workflows/check-links.yml b/.github/workflows/check-links.yml index 98197598..1af191af 100644 --- a/.github/workflows/check-links.yml +++ b/.github/workflows/check-links.yml @@ -17,7 +17,8 @@ jobs: if: > !contains(github.event.commits[0].message, '[skip links]') steps: - - uses: actions/checkout@v3 + - name: Checkout repository 🛎 + uses: actions/checkout@v4 - name: Check URLs in docs 📑 uses: lycheeverse/lychee-action@v1.5.1 diff --git a/.github/workflows/check-standard.yaml b/.github/workflows/check-standard.yaml index ae9b1047..14013bf9 100644 --- a/.github/workflows/check-standard.yaml +++ b/.github/workflows/check-standard.yaml @@ -36,18 +36,20 @@ jobs: !contains(github.event.commits[0].message, '[skip checks]') steps: - - uses: actions/checkout@v3 + - name: Checkout repository 🛎 + uses: actions/checkout@v4 - - uses: r-lib/actions/setup-pandoc@v2 - - - uses: r-lib/actions/setup-r@v2 + - name: Setup R 📊 + uses: r-lib/actions/setup-r@v2 with: r-version: ${{ matrix.config.r }} http-user-agent: ${{ matrix.config.http-user-agent }} use-public-rspm: true - - uses: r-lib/actions/setup-r-dependencies@v2 + - name: Install R package dependencies 📦 + uses: r-lib/actions/setup-r-dependencies@v2 with: extra-packages: any::rcmdcheck - - uses: r-lib/actions/check-r-package@v2 + - name: Run R CMD check 🎯 + uses: r-lib/actions/check-r-package@v2 diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml index 2548a242..5f5cb64c 100644 --- a/.github/workflows/lint.yaml +++ b/.github/workflows/lint.yaml @@ -20,9 +20,11 @@ jobs: env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v3 + - name: Checkout repository 🛎 + uses: actions/checkout@v4 - - uses: r-lib/actions/setup-r@v2 + - name: Setup R 📊 + uses: r-lib/actions/setup-r@v2 with: use-public-rspm: true @@ -30,7 +32,7 @@ jobs: with: extra-packages: any::lintr, local::. - - name: Lint + - name: Run Linter 👟 run: lintr::lint_package() shell: Rscript {0} env: diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index d43e5feb..e6c27271 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -12,18 +12,22 @@ jobs: env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v3 + - name: Checkout repository 🛎 + uses: actions/checkout@v4 - - uses: r-lib/actions/setup-r@v2 + - name: Setup R 📊 + uses: r-lib/actions/setup-r@v2 - - uses: r-lib/actions/setup-pandoc@v1 + - name: Install Pandoc + uses: r-lib/actions/setup-pandoc@v1 - - uses: r-lib/actions/setup-r-dependencies@v2 + - name: Install R package dependencies 📦 + uses: r-lib/actions/setup-r-dependencies@v2 with: extra-packages: any::pkgdown, local::. needs: website - - name: Deploy package + - name: Deploy package ☁️ run: | git config --local user.email "actions@github.com" git config --local user.name "GitHub Actions" diff --git a/.github/workflows/spellcheck.yml b/.github/workflows/spellcheck.yml index f591e0d8..3311daf7 100644 --- a/.github/workflows/spellcheck.yml +++ b/.github/workflows/spellcheck.yml @@ -12,22 +12,26 @@ on: jobs: spelling: - name: Run Spellcheck 👟 + name: Run Spellcheck 🔠 runs-on: ubuntu-latest - # exclude: data/*,**/*.Rd,**/*.md,*.md + if: > !contains(github.event.commits[0].message, '[skip spellcheck]') + steps: - - name: Checkout repository - uses: actions/checkout@v3 + - name: Checkout repository 🛎 + uses: actions/checkout@v4 - - name: Install R + - name: Setup R 📊 uses: r-lib/actions/setup-r@v2 - - name: Install R package dependencies + - name: Install R package dependencies 📦 uses: r-lib/actions/setup-r-dependencies@v2 with: extra-packages: any::spelling - - name: Run Spelling Check test + - name: Run Spellcheck 👟 uses: insightsengineering/r-spellcheck-action@v2 + with: + exclude: data/*,**/*.Rd,**/*.md,*.md + additional_options: "" diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 38c515b5..99b3da49 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -14,11 +14,11 @@ jobs: env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v3 + - name: Checkout repository 🛎 + uses: actions/checkout@v4 - - uses: r-lib/actions/setup-r@v2 - - - uses: r-lib/actions/setup-pandoc@v1 + - name: Setup R 📊 + uses: r-lib/actions/setup-r@v2 - name: Install R package dependencies uses: r-lib/actions/setup-r-dependencies@v2 @@ -26,6 +26,6 @@ jobs: # Necessary to avoid object usage linter errors. extra-packages: local::., any::covr - - name: Test coverage + - name: Run Test coverage 👟 run: covr::codecov() shell: Rscript {0} From 01679855e193f63a6affa43c5a54aeaeefc16a64 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 31 Jan 2024 00:23:18 +0100 Subject: [PATCH 211/267] fix: remove styler working directory --- .github/workflows/style.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/style.yml b/.github/workflows/style.yml index 82e2dbe3..61d5dfbe 100644 --- a/.github/workflows/style.yml +++ b/.github/workflows/style.yml @@ -74,4 +74,3 @@ jobs: quit(status = 1) } shell: Rscript {0} - working-directory: ${{ github.event.repository.name }} From b68751b1a0f6d2b4fa8ac11b4c537d516552aba8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 31 Jan 2024 00:31:02 +0100 Subject: [PATCH 212/267] fix: restore pandoc and update action version --- .github/workflows/check-standard.yaml | 3 +++ .github/workflows/pkgdown.yaml | 2 +- .github/workflows/spellcheck.yml | 3 +-- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/.github/workflows/check-standard.yaml b/.github/workflows/check-standard.yaml index 14013bf9..52f6a854 100644 --- a/.github/workflows/check-standard.yaml +++ b/.github/workflows/check-standard.yaml @@ -39,6 +39,9 @@ jobs: - name: Checkout repository 🛎 uses: actions/checkout@v4 + - name: Install Pandoc + uses: r-lib/actions/setup-pandoc@v2 + - name: Setup R 📊 uses: r-lib/actions/setup-r@v2 with: diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index e6c27271..28dbcbd8 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -19,7 +19,7 @@ jobs: uses: r-lib/actions/setup-r@v2 - name: Install Pandoc - uses: r-lib/actions/setup-pandoc@v1 + uses: r-lib/actions/setup-pandoc@v2 - name: Install R package dependencies 📦 uses: r-lib/actions/setup-r-dependencies@v2 diff --git a/.github/workflows/spellcheck.yml b/.github/workflows/spellcheck.yml index 3311daf7..ad9d1676 100644 --- a/.github/workflows/spellcheck.yml +++ b/.github/workflows/spellcheck.yml @@ -14,10 +14,9 @@ jobs: spelling: name: Run Spellcheck 🔠 runs-on: ubuntu-latest - if: > !contains(github.event.commits[0].message, '[skip spellcheck]') - + && github.event.pull_request.draft == false steps: - name: Checkout repository 🛎 uses: actions/checkout@v4 From bb11f919453305486f4bb81fa45f8405afee97cc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 31 Jan 2024 00:35:54 +0100 Subject: [PATCH 213/267] style: consistent spacing in workflows --- .github/workflows/check-links.yml | 4 ++++ .github/workflows/check-standard.yaml | 1 + .github/workflows/lint.yaml | 3 +++ .github/workflows/pkgdown.yaml | 2 ++ .github/workflows/spellcheck.yml | 3 +++ .github/workflows/style.yml | 2 ++ .github/workflows/test-coverage.yaml | 6 ++++++ 7 files changed, 21 insertions(+) diff --git a/.github/workflows/check-links.yml b/.github/workflows/check-links.yml index 1af191af..dbdbd69c 100644 --- a/.github/workflows/check-links.yml +++ b/.github/workflows/check-links.yml @@ -13,9 +13,13 @@ on: jobs: links: name: Validate Links 🕸️ + runs-on: ubuntu-latest + if: > !contains(github.event.commits[0].message, '[skip links]') + && github.event.pull_request.draft == false + steps: - name: Checkout repository 🛎 uses: actions/checkout@v4 diff --git a/.github/workflows/check-standard.yaml b/.github/workflows/check-standard.yaml index 52f6a854..ce68eef2 100644 --- a/.github/workflows/check-standard.yaml +++ b/.github/workflows/check-standard.yaml @@ -34,6 +34,7 @@ jobs: if: > !contains(github.event.commits[0].message, '[skip checks]') + && github.event.pull_request.draft == false steps: - name: Checkout repository 🛎 diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml index 5f5cb64c..7c33ac7e 100644 --- a/.github/workflows/lint.yaml +++ b/.github/workflows/lint.yaml @@ -15,10 +15,13 @@ on: jobs: lint: runs-on: ubuntu-latest + if: > !contains(github.event.commits[0].message, '[skip lint]') + env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: - name: Checkout repository 🛎 uses: actions/checkout@v4 diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 28dbcbd8..6065b0c4 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -9,8 +9,10 @@ on: jobs: pkgdown: runs-on: macOS-latest + env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: - name: Checkout repository 🛎 uses: actions/checkout@v4 diff --git a/.github/workflows/spellcheck.yml b/.github/workflows/spellcheck.yml index ad9d1676..dcba91ff 100644 --- a/.github/workflows/spellcheck.yml +++ b/.github/workflows/spellcheck.yml @@ -13,10 +13,13 @@ on: jobs: spelling: name: Run Spellcheck 🔠 + runs-on: ubuntu-latest + if: > !contains(github.event.commits[0].message, '[skip spellcheck]') && github.event.pull_request.draft == false + steps: - name: Checkout repository 🛎 uses: actions/checkout@v4 diff --git a/.github/workflows/style.yml b/.github/workflows/style.yml index 61d5dfbe..43097bb1 100644 --- a/.github/workflows/style.yml +++ b/.github/workflows/style.yml @@ -17,7 +17,9 @@ concurrency: jobs: style: name: Check code style 🧑‍🎨 + runs-on: ubuntu-latest + if: > !contains(github.event.commits[0].message, '[skip stylecheck]') && github.event.pull_request.draft == false diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 99b3da49..9c561d47 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -11,8 +11,14 @@ on: jobs: test-coverage: runs-on: macOS-latest + + if: > + !contains(github.event.commits[0].message, '[skip coverage]') + && github.event.pull_request.draft == false + env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: - name: Checkout repository 🛎 uses: actions/checkout@v4 From 2b9d814bc19e6c5158699342a67f03d4cdc8988c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 31 Jan 2024 00:43:28 +0100 Subject: [PATCH 214/267] style: standardization and adds concurrency for all but checks --- .github/workflows/check-links.yml | 7 ++++--- .github/workflows/check-standard.yaml | 7 +------ .github/workflows/lint.yaml | 8 +++++--- .github/workflows/pkgdown.yaml | 9 +++++++-- .github/workflows/spellcheck.yml | 7 ++++--- .github/workflows/style.yml | 3 --- .github/workflows/test-coverage.yaml | 10 ++++++---- 7 files changed, 27 insertions(+), 24 deletions(-) diff --git a/.github/workflows/check-links.yml b/.github/workflows/check-links.yml index dbdbd69c..1b3f3f2b 100644 --- a/.github/workflows/check-links.yml +++ b/.github/workflows/check-links.yml @@ -10,16 +10,17 @@ on: - main workflow_dispatch: +concurrency: + group: links-${{ github.event.pull_request.number || github.ref }} + cancel-in-progress: true + jobs: links: name: Validate Links 🕸️ - runs-on: ubuntu-latest - if: > !contains(github.event.commits[0].message, '[skip links]') && github.event.pull_request.draft == false - steps: - name: Checkout repository 🛎 uses: actions/checkout@v4 diff --git a/.github/workflows/check-standard.yaml b/.github/workflows/check-standard.yaml index ce68eef2..761664fa 100644 --- a/.github/workflows/check-standard.yaml +++ b/.github/workflows/check-standard.yaml @@ -14,10 +14,8 @@ on: jobs: R-CMD-check: - runs-on: ${{ matrix.config.os }} - name: ${{ matrix.config.os }} (${{ matrix.config.r }}) - + runs-on: ${{ matrix.config.os }} strategy: fail-fast: false matrix: @@ -27,15 +25,12 @@ jobs: - { os: ubuntu-latest, r: "devel", http-user-agent: "release" } - { os: ubuntu-latest, r: "release" } - { os: ubuntu-latest, r: "oldrel-1" } - env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} R_KEEP_PKG_SOURCE: yes - if: > !contains(github.event.commits[0].message, '[skip checks]') && github.event.pull_request.draft == false - steps: - name: Checkout repository 🛎 uses: actions/checkout@v4 diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml index 7c33ac7e..d4ed48c6 100644 --- a/.github/workflows/lint.yaml +++ b/.github/workflows/lint.yaml @@ -12,16 +12,18 @@ on: - main workflow_dispatch: +concurrency: + group: lint-${{ github.event.pull_request.number || github.ref }} + cancel-in-progress: true + jobs: lint: runs-on: ubuntu-latest - if: > !contains(github.event.commits[0].message, '[skip lint]') - + && github.event.pull_request.draft == false env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} - steps: - name: Checkout repository 🛎 uses: actions/checkout@v4 diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 6065b0c4..ff191a80 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -6,13 +6,18 @@ on: branches: - main +concurrency: + group: docs-${{ github.event.pull_request.number || github.ref }} + cancel-in-progress: true + jobs: pkgdown: runs-on: macOS-latest - env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} - + if: > + !contains(github.event.commits[0].message, '[skip docs]') + && github.event.pull_request.draft == false steps: - name: Checkout repository 🛎 uses: actions/checkout@v4 diff --git a/.github/workflows/spellcheck.yml b/.github/workflows/spellcheck.yml index dcba91ff..0b8d0a0f 100644 --- a/.github/workflows/spellcheck.yml +++ b/.github/workflows/spellcheck.yml @@ -10,16 +10,17 @@ on: branches: - main +concurrency: + group: spelling-${{ github.event.pull_request.number || github.ref }} + cancel-in-progress: true + jobs: spelling: name: Run Spellcheck 🔠 - runs-on: ubuntu-latest - if: > !contains(github.event.commits[0].message, '[skip spellcheck]') && github.event.pull_request.draft == false - steps: - name: Checkout repository 🛎 uses: actions/checkout@v4 diff --git a/.github/workflows/style.yml b/.github/workflows/style.yml index 43097bb1..0247c61a 100644 --- a/.github/workflows/style.yml +++ b/.github/workflows/style.yml @@ -17,13 +17,10 @@ concurrency: jobs: style: name: Check code style 🧑‍🎨 - runs-on: ubuntu-latest - if: > !contains(github.event.commits[0].message, '[skip stylecheck]') && github.event.pull_request.draft == false - steps: - uses: actions/checkout@v4 with: diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 9c561d47..18700621 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -8,17 +8,19 @@ on: branches: - main +concurrency: + group: coverage-${{ github.event.pull_request.number || github.ref }} + cancel-in-progress: true + jobs: test-coverage: - runs-on: macOS-latest - + name: Coverage 📔 + runs-on: ubuntu-latest if: > !contains(github.event.commits[0].message, '[skip coverage]') && github.event.pull_request.draft == false - env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} - steps: - name: Checkout repository 🛎 uses: actions/checkout@v4 From 12f247385cddc925668bdd8815681664c9c8c74e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 31 Jan 2024 00:48:49 +0100 Subject: [PATCH 215/267] cleanup: doesn't need to install package --- .github/workflows/style.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/style.yml b/.github/workflows/style.yml index 0247c61a..17343cdf 100644 --- a/.github/workflows/style.yml +++ b/.github/workflows/style.yml @@ -34,7 +34,7 @@ jobs: - name: Install R package dependencies 📦 uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::styler, any::roxygen2, local::. + extra-packages: any::styler, any::roxygen2 needs: styler - name: Enable styler cache From c828c060c238a8e8c65dd2203acfeb7b89d473df Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 31 Jan 2024 00:57:50 +0100 Subject: [PATCH 216/267] revert change --- R/metadata.R | 12 +++-- tests/testthat/test-metadata.R | 84 +++++++++++++++++----------------- 2 files changed, 50 insertions(+), 46 deletions(-) diff --git a/R/metadata.R b/R/metadata.R index 92116eca..e6060ece 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -32,12 +32,14 @@ #' #' xportr_metadata(adlb, metadata, "test") #' -#' library(magrittr) +#' if (rlang::is_installed("magrittr")) { +#' library(magrittr) #' -#' adlb %>% -#' xportr_metadata(metadata, "test") %>% -#' xportr_type() %>% -#' xportr_order() +#' adlb %>% +#' xportr_metadata(metadata, "test") %>% +#' xportr_type() %>% +#' xportr_order() +#' } xportr_metadata <- function(.df, metadata = NULL, domain = NULL, diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index 0bc0549e..55c91cde 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -743,47 +743,49 @@ test_that("xportr_*: Domain is kept in between calls", { # end test_that("`xportr_metadata()` results match traditional results", { - test_dir <- tempdir() - - trad_path <- file.path(test_dir, "adsltrad.xpt") - metadata_path <- file.path(test_dir, "adslmeta.xpt") - - dataset_spec_low <- setNames(dataset_spec, tolower(names(dataset_spec))) - names(dataset_spec_low)[[2]] <- "label" - - var_spec_low <- setNames(var_spec, tolower(names(var_spec))) - names(var_spec_low)[[5]] <- "type" - - metadata_df <- adsl %>% - xportr_metadata(var_spec_low, "ADSL", verbose = "none") %>% - xportr_type() %>% - xportr_length() %>% - xportr_label() %>% - xportr_order() %>% - xportr_format() %>% - xportr_df_label(dataset_spec_low) %>% - xportr_write(metadata_path) - - trad_df <- adsl %>% - xportr_type(var_spec_low, "ADSL", verbose = "none") %>% - xportr_length(var_spec_low, "ADSL", verbose = "none") %>% - xportr_label(var_spec_low, "ADSL", verbose = "none") %>% - xportr_order(var_spec_low, "ADSL", verbose = "none") %>% - xportr_format(var_spec_low, "ADSL") %>% - xportr_df_label(dataset_spec_low, "ADSL") %>% - xportr_write(trad_path) - - expect_identical( - metadata_df, - structure( - trad_df, - `_xportr.df_metadata_` = var_spec_low, - `_xportr.df_verbose_` = "none" + if (require(magrittr, quietly = TRUE)) { + test_dir <- tempdir() + + trad_path <- file.path(test_dir, "adsltrad.xpt") + metadata_path <- file.path(test_dir, "adslmeta.xpt") + + dataset_spec_low <- setNames(dataset_spec, tolower(names(dataset_spec))) + names(dataset_spec_low)[[2]] <- "label" + + var_spec_low <- setNames(var_spec, tolower(names(var_spec))) + names(var_spec_low)[[5]] <- "type" + + metadata_df <- adsl %>% + xportr_metadata(var_spec_low, "ADSL", verbose = "none") %>% + xportr_type() %>% + xportr_length() %>% + xportr_label() %>% + xportr_order() %>% + xportr_format() %>% + xportr_df_label(dataset_spec_low) %>% + xportr_write(metadata_path) + + trad_df <- adsl %>% + xportr_type(var_spec_low, "ADSL", verbose = "none") %>% + xportr_length(var_spec_low, "ADSL", verbose = "none") %>% + xportr_label(var_spec_low, "ADSL", verbose = "none") %>% + xportr_order(var_spec_low, "ADSL", verbose = "none") %>% + xportr_format(var_spec_low, "ADSL") %>% + xportr_df_label(dataset_spec_low, "ADSL") %>% + xportr_write(trad_path) + + expect_identical( + metadata_df, + structure( + trad_df, + `_xportr.df_metadata_` = var_spec_low, + `_xportr.df_verbose_` = "none" + ) ) - ) - expect_identical( - haven::read_xpt(metadata_path), - haven::read_xpt(trad_path) - ) + expect_identical( + haven::read_xpt(metadata_path), + haven::read_xpt(trad_path) + ) + } }) From 74554866450ed6530b3a3a6097bd2869f5e94e74 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 31 Jan 2024 01:00:01 +0100 Subject: [PATCH 217/267] docs: revert change --- man/metadata.Rd | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/man/metadata.Rd b/man/metadata.Rd index 0c542e1e..da5de14c 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -49,10 +49,12 @@ adlb <- data.frame( xportr_metadata(adlb, metadata, "test") -library(magrittr) +if (rlang::is_installed("magrittr")) { + library(magrittr) -adlb \%>\% - xportr_metadata(metadata, "test") \%>\% - xportr_type() \%>\% - xportr_order() + adlb \%>\% + xportr_metadata(metadata, "test") \%>\% + xportr_type() \%>\% + xportr_order() +} } From 40d4e80235294ca3a4929c01819c380203c7934d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 31 Jan 2024 01:03:26 +0100 Subject: [PATCH 218/267] tmp: add spelling, linter and styling error --- R/df_label.R | 7 ++++++- man/xportr_df_label.Rd | 2 +- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/R/df_label.R b/R/df_label.R index 81a115ec..6bebfcbf 100644 --- a/R/df_label.R +++ b/R/df_label.R @@ -1,6 +1,6 @@ #' Assign Dataset Label #' -#' Assigns dataset label from a dataset level metadata to a given data frame. +#' Assignadbcs dataset label from a dataset level metadata to a given data frame. #' This is stored in the 'label' attribute of the dataframe. #' #' @param metadata A data frame containing dataset. See 'Metadata' section for @@ -51,6 +51,11 @@ xportr_df_label <- function(.df, ) } + # start of temporary section to test linter and styling + # removeMe <- 2 # commmented code that will fail linter + if (FALSE) { 1 +2 } else {2+3} + # end of temporary section + ## Common section to detect default arguments domain <- domain %||% attr(.df, "_xportr.df_arg_") diff --git a/man/xportr_df_label.Rd b/man/xportr_df_label.Rd index 363c59c4..18a027ee 100644 --- a/man/xportr_df_label.Rd +++ b/man/xportr_df_label.Rd @@ -23,7 +23,7 @@ metadata now renamed with \code{metadata}} Data frame with label attributes. } \description{ -Assigns dataset label from a dataset level metadata to a given data frame. +Assignadbcs dataset label from a dataset level metadata to a given data frame. This is stored in the 'label' attribute of the dataframe. } \section{Metadata}{ From a649c198dbd46195cb5231bd4bfde205ece8c99f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 31 Jan 2024 01:06:51 +0100 Subject: [PATCH 219/267] Revert "tmp: add spelling, linter and styling error" This reverts commit 40d4e80235294ca3a4929c01819c380203c7934d. --- R/df_label.R | 7 +------ man/xportr_df_label.Rd | 2 +- 2 files changed, 2 insertions(+), 7 deletions(-) diff --git a/R/df_label.R b/R/df_label.R index 6bebfcbf..81a115ec 100644 --- a/R/df_label.R +++ b/R/df_label.R @@ -1,6 +1,6 @@ #' Assign Dataset Label #' -#' Assignadbcs dataset label from a dataset level metadata to a given data frame. +#' Assigns dataset label from a dataset level metadata to a given data frame. #' This is stored in the 'label' attribute of the dataframe. #' #' @param metadata A data frame containing dataset. See 'Metadata' section for @@ -51,11 +51,6 @@ xportr_df_label <- function(.df, ) } - # start of temporary section to test linter and styling - # removeMe <- 2 # commmented code that will fail linter - if (FALSE) { 1 +2 } else {2+3} - # end of temporary section - ## Common section to detect default arguments domain <- domain %||% attr(.df, "_xportr.df_arg_") diff --git a/man/xportr_df_label.Rd b/man/xportr_df_label.Rd index 18a027ee..363c59c4 100644 --- a/man/xportr_df_label.Rd +++ b/man/xportr_df_label.Rd @@ -23,7 +23,7 @@ metadata now renamed with \code{metadata}} Data frame with label attributes. } \description{ -Assignadbcs dataset label from a dataset level metadata to a given data frame. +Assigns dataset label from a dataset level metadata to a given data frame. This is stored in the 'label' attribute of the dataframe. } \section{Metadata}{ From 4933aa53570aa1051b91ec8f83d89d99fd52d7ea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 1 Feb 2024 15:16:59 +0100 Subject: [PATCH 220/267] pr: applies comments from @elimillera --- .github/workflows/spellcheck.yml | 2 +- README.Rmd | 2 +- README.md | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/spellcheck.yml b/.github/workflows/spellcheck.yml index 0b8d0a0f..05e2e52f 100644 --- a/.github/workflows/spellcheck.yml +++ b/.github/workflows/spellcheck.yml @@ -34,7 +34,7 @@ jobs: extra-packages: any::spelling - name: Run Spellcheck 👟 - uses: insightsengineering/r-spellcheck-action@v2 + uses: insightsengineering/r-spellcheck-action@v3 with: exclude: data/*,**/*.Rd,**/*.md,*.md additional_options: "" diff --git a/README.Rmd b/README.Rmd index d875a81f..13198ed4 100644 --- a/README.Rmd +++ b/README.Rmd @@ -46,7 +46,7 @@ install.packages("xportr") ### Development version: ```{r, eval = FALSE} -install.packages("teal", repos = c("https://pharmaverse.r-universe.dev", getOption("repos"))) +install.packages("xportr", repos = c("https://pharmaverse.r-universe.dev", getOption("repos"))) ``` # What is xportr? diff --git a/README.md b/README.md index 31275d06..91721df5 100644 --- a/README.md +++ b/README.md @@ -36,7 +36,7 @@ install.packages("xportr") ### Development version: ``` r -install.packages("teal", repos = c("https://pharmaverse.r-universe.dev", getOption("repos"))) +install.packages("xportr", repos = c("https://pharmaverse.r-universe.dev", getOption("repos"))) ``` # What is xportr? From 2d5fe41b75dec9fe35da3d3608115306bcff4a10 Mon Sep 17 00:00:00 2001 From: vedhav Date: Thu, 1 Feb 2024 19:49:24 +0530 Subject: [PATCH 221/267] fix: pass the domain name explicitly --- R/support-test.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/support-test.R b/R/support-test.R index d223a6d6..fa9cb048 100644 --- a/R/support-test.R +++ b/R/support-test.R @@ -152,7 +152,7 @@ multiple_vars_in_spec_helper <- function(FUN) { local_cli_theme() adsl %>% - FUN(metadata) %>% + FUN(metadata, "adsl") %>% testthat::expect_message("There are multiple specs for the same variable name") } @@ -181,6 +181,6 @@ multiple_vars_in_spec_helper2 <- function(FUN) { adsl %>% xportr_metadata(domain = "adsl") %>% - FUN(metadata) %>% + FUN(metadata, "adsl") %>% testthat::expect_no_message(message = "There are multiple specs for the same variable name") } From 0e1a305d9fb3faf78133da174a60b51d25fe167d Mon Sep 17 00:00:00 2001 From: EeethB Date: Thu, 1 Feb 2024 10:29:08 -0600 Subject: [PATCH 222/267] Add argument names to `xportr()` in README --- README.Rmd | 7 ++++++- README.md | 7 ++++++- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/README.Rmd b/README.Rmd index 07d75c96..fc74cc11 100644 --- a/README.Rmd +++ b/README.Rmd @@ -158,7 +158,12 @@ adsl %>% Furthermore, if you're calling all xportr functions at once with common metadata and verbosity, you can shorten it by simply using `xportr()`. ```{r, warning=FALSE, message=FALSE, eval=FALSE} -xportr(adsl, var_spec, dataset_spec, "ADSL", verbose = "warn", "adsl.xpt") +xportr(.df = adsl, + var_metadata = var_spec, + df_metadata = dataset_spec, + domain = "ADSL", + verbose = "warn", + "adsl.xpt") ``` That's it! We now have a xpt file created in R with all appropriate types, lengths, labels, ordering and formats. Please check out the [Get Started](https://atorus-research.github.io/xportr/articles/xportr.html) for more information and detailed walk through of each `xportr_` function. diff --git a/README.md b/README.md index 9d84dc0f..b4533ce5 100644 --- a/README.md +++ b/README.md @@ -169,7 +169,12 @@ Furthermore, if you’re calling all xportr functions at once with common metadata and verbosity, you can shorten it by simply using `xportr()`. ``` r -xportr(adsl, var_spec, dataset_spec, "ADSL", verbose = "warn", "adsl.xpt") +xportr(.df = adsl, + var_metadata = var_spec, + df_metadata = dataset_spec, + domain = "ADSL", + verbose = "warn", + "adsl.xpt") ``` That’s it! We now have a xpt file created in R with all appropriate From 8f5fc66bbf2b620fb0d8bf3879aab3fd0c075437 Mon Sep 17 00:00:00 2001 From: EeethB Date: Thu, 1 Feb 2024 10:37:18 -0600 Subject: [PATCH 223/267] Run styler --- README.Rmd | 14 ++++++++------ README.md | 14 ++++++++------ 2 files changed, 16 insertions(+), 12 deletions(-) diff --git a/README.Rmd b/README.Rmd index fc74cc11..8b71800d 100644 --- a/README.Rmd +++ b/README.Rmd @@ -158,12 +158,14 @@ adsl %>% Furthermore, if you're calling all xportr functions at once with common metadata and verbosity, you can shorten it by simply using `xportr()`. ```{r, warning=FALSE, message=FALSE, eval=FALSE} -xportr(.df = adsl, - var_metadata = var_spec, - df_metadata = dataset_spec, - domain = "ADSL", - verbose = "warn", - "adsl.xpt") +xportr( + .df = adsl, + var_metadata = var_spec, + df_metadata = dataset_spec, + domain = "ADSL", + verbose = "warn", + "adsl.xpt" +) ``` That's it! We now have a xpt file created in R with all appropriate types, lengths, labels, ordering and formats. Please check out the [Get Started](https://atorus-research.github.io/xportr/articles/xportr.html) for more information and detailed walk through of each `xportr_` function. diff --git a/README.md b/README.md index b4533ce5..e64b19ed 100644 --- a/README.md +++ b/README.md @@ -169,12 +169,14 @@ Furthermore, if you’re calling all xportr functions at once with common metadata and verbosity, you can shorten it by simply using `xportr()`. ``` r -xportr(.df = adsl, - var_metadata = var_spec, - df_metadata = dataset_spec, - domain = "ADSL", - verbose = "warn", - "adsl.xpt") +xportr( + .df = adsl, + var_metadata = var_spec, + df_metadata = dataset_spec, + domain = "ADSL", + verbose = "warn", + "adsl.xpt" +) ``` That’s it! We now have a xpt file created in R with all appropriate From f6c23b9b7285561c8e325fba4b9102e5607c4f75 Mon Sep 17 00:00:00 2001 From: sadchla-codes Date: Thu, 1 Feb 2024 11:46:44 -0500 Subject: [PATCH 224/267] Rremoving type test and type check --- R/utils-xportr.R | 22 ++-------------------- man/xportr_options.Rd | 2 +- tests/testthat/test-utils-xportr.R | 10 ---------- 3 files changed, 3 insertions(+), 31 deletions(-) diff --git a/R/utils-xportr.R b/R/utils-xportr.R index 71ae3f85..baab22a8 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -5,7 +5,7 @@ #' #' @return Character vector of attributes with column names assigned #' @noRd -extract_attr <- function(data, attr = c("label", "format.sas", "type")) { +extract_attr <- function(data, attr = c("label", "format.sas")) { attr <- match.arg(attr) out <- lapply(data, function(.x) attr(.x, attr)) out <- vapply(out, @@ -216,26 +216,8 @@ xpt_validate <- function(data) { ) } - # 3.0 VARIABLE TYPES ---- - types <- tolower(extract_attr(data, attr = "type")) - expected_types <- c( - "", "text", "integer", "float", "datetime", "date", "time", - "partialdate", "partialtime", "partialdatetime", - "incompletedatetime", "durationdatetime", "intervaldatetime" - ) - - # 3.1 Invalid types -- - chk_types <- types[which(!types %in% expected_types)] - - if (length(chk_types) > 0) { - err_cnd <- c( - err_cnd, - glue("{fmt_vars(names(types))} must have a valid type.") - ) - } - - # 4.0 Format Types ---- + # 3.0 Format Types ---- formats <- extract_attr(data, attr = "format.sas") ## The usual expected formats in clinical trials: characters, dates diff --git a/man/xportr_options.Rd b/man/xportr_options.Rd index 4194aa52..feb212cd 100644 --- a/man/xportr_options.Rd +++ b/man/xportr_options.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/options.R \name{xportr_options} \alias{xportr_options} -\title{Get or set Xportr options} +\title{Get or set xportr options} \usage{ xportr_options(...) } diff --git a/tests/testthat/test-utils-xportr.R b/tests/testthat/test-utils-xportr.R index cdbf5cf6..ba77d353 100644 --- a/tests/testthat/test-utils-xportr.R +++ b/tests/testthat/test-utils-xportr.R @@ -83,16 +83,6 @@ test_that("xpt_validate: Get error message when the label contains over 40 chara ) }) -test_that("xpt_validate: Get error message when the variable type is invalid", { - df <- data.frame(A = 1, B = 2) - attr(df$A, "type") <- "integer" - attr(df$B, "type") <- "list" - expect_equal( - xpt_validate(df), - "Variables `A` and `B` must have a valid type." - ) -}) - test_that("xpt_validate: Doesn't error out with iso8601 format", { df <- data.frame(A = 1, B = 2) attr(df$A, "format.sas") <- "E8601LX." From 17e70794be1aca4567876fac74377777917fc6ff Mon Sep 17 00:00:00 2001 From: EeethB Date: Thu, 1 Feb 2024 16:47:52 +0000 Subject: [PATCH 225/267] [skip actions] Bump version to 0.3.1.9013 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index b2201a55..fc08a4e0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9012 +Version: 0.3.1.9013 Authors@R: c( person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")), From 081eff028d91577e4d19680560db756629b54e0c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 1 Feb 2024 18:03:40 +0100 Subject: [PATCH 226/267] docs: add to NEWS.md --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 048b7881..5d39ec72 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,8 +3,8 @@ ## New Features and Bug Fixes * `xportr_metadata()` can set `verbose` for a whole pipeline, i.e. setting `verbose` in `xportr_metadata()` will populate to all `xportr` functions. (#151) - * All `xportr` functions now have `verbose = NULL` as the default (#151) +* Remove unused packages from Suggests (#221) ## Documentation From 7c1ccde1ebde7f1a5e5d0a45a1ebc7d68a86ca88 Mon Sep 17 00:00:00 2001 From: Celine Date: Mon, 5 Feb 2024 10:16:04 -0500 Subject: [PATCH 227/267] Add numeric to R numeric type --- R/options.R | 2 +- R/xportr-package.R | 2 +- R/zzz.R | 2 +- man/xportr-package.Rd | 4 ++-- man/xportr_options.Rd | 2 +- man/xportr_type.Rd | 9 +++++++-- 6 files changed, 13 insertions(+), 8 deletions(-) diff --git a/R/options.R b/R/options.R index 4ad5280a..c27628fa 100644 --- a/R/options.R +++ b/R/options.R @@ -49,7 +49,7 @@ #' The default character vector used to explicitly coerce R classes to character XPT types. #' \item{xportr.numeric_metadata_types}{defaults to `c("integer", "numeric", "num", "float")`}: #' The default character vector used to explicitly coerce R classes to numeric XPT types. -#' \item{xportr.numeric_types}{defaults to `c("integer", "float", "posixct", "posixt", "time", "date")`}: +#' \item{xportr.numeric_types}{defaults to `c("integer", "float", "numeric", "posixct", "posixt", "time", "date")`}: #' The default character vector used to explicitly coerce R classes to numeric XPT types. #' } #' diff --git a/R/xportr-package.R b/R/xportr-package.R index 60b3277a..19072ba2 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -79,7 +79,7 @@ #' } #' \item{ #' xportr.numeric_types - The default character vector used to explicitly -#' coerce R classes to numeric XPT types. Default: c("integer", "float", "posixct", "posixt", "time", "date") +#' coerce R classes to numeric XPT types. Default: c("integer", "float", "numeric", "posixct", "posixt", "time", "date") #' } #' } #' diff --git a/R/zzz.R b/R/zzz.R index d986c442..db793471 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -33,7 +33,7 @@ xportr_options_list <- list( ), xportr.numeric_types = getOption( "xportr.numeric_types", - c("integer", "float", "posixct", "posixt", "time", "date") + c("integer", "float", "numeric", "posixct", "posixt", "time", "date") ) ) diff --git a/man/xportr-package.Rd b/man/xportr-package.Rd index d70cc8bd..762cab17 100644 --- a/man/xportr-package.Rd +++ b/man/xportr-package.Rd @@ -78,7 +78,7 @@ xportr.character_metadata_types - The default character vector used to explicitl coerce R classes to character XPT types. Default: c("character", "char", "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", "partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", -"intervaldatetime") +"intervaldatetime")` } \item{ xportr.numeric_metadata_types - The default character vector used to explicitly @@ -86,7 +86,7 @@ coerce R classes to numeric XPT types. Default: c("integer", "numeric", "num", " } \item{ xportr.numeric_types - The default character vector used to explicitly -coerce R classes to numeric XPT types. Default: c("integer", "float", "posixct", "posixt", "time", "date") +coerce R classes to numeric XPT types. Default: c("integer", "float", "numeric", "posixct", "posixt", "time", "date") } } } diff --git a/man/xportr_options.Rd b/man/xportr_options.Rd index db020a29..9c07d0ad 100644 --- a/man/xportr_options.Rd +++ b/man/xportr_options.Rd @@ -55,7 +55,7 @@ The default character vector used to explicitly coerce R classes to character XP The default character vector used to explicitly coerce R classes to character XPT types. \item{xportr.numeric_metadata_types}{defaults to \code{c("integer", "numeric", "num", "float")}}: The default character vector used to explicitly coerce R classes to numeric XPT types. -\item{xportr.numeric_types}{defaults to \code{c("integer", "float", "posixct", "posixt", "time", "date")}}: +\item{xportr.numeric_types}{defaults to \code{c("integer", "float", "numeric", "posixct", "posixt", "time", "date")}}: The default character vector used to explicitly coerce R classes to numeric XPT types. } } diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index 515f4bd0..df1a6b6c 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -39,6 +39,7 @@ attempts to collapse R classes to those two XPT types. The column to character using \code{as.character}. Similarly, 'xportr.numeric_types' will collapse a column to a numeric type. If no type is passed for a variable, it is assumed to be numeric and coerced with \code{as.numeric()}. +} \details{ Certain care should be taken when using timing variables. R serializes dates based on a reference date of 01/01/1970 where XPT uses 01/01/1960. This can @@ -71,9 +72,13 @@ metadata. \item Variable Type - passed as the 'xportr.type_name'. Default: "type". This is used to note the XPT variable "type" options are numeric or character. \item (Option only) Character Types - The list of classes that should be -explicitly coerced to a XPT Character type. Default: \code{c( "character", "char", "text", "date", "posixct", "posixt", "datetime", "time", "partialdate", "partialtime", "partialdatetime", "incompletedatetime", "durationdatetime", "intervaldatetime")} +explicitly coerced to a XPT Character type. Default: c( "character", +"char", "text", "date", "posixct", "posixt", "datetime", "time", +"partialdate", "partialtime", "partialdatetime", "incompletedatetime", +"durationdatetime", "intervaldatetime")` \item (Option only) Numeric Types - The list of classes that should be -explicitly coerced to a XPT numeric type. Default: \code{c("integer", "numeric", "num", "float")} +explicitly coerced to a XPT numeric type. Default: c("integer", "numeric", +"num", "float") } } From 388223ce780b128ad3c32a6a34dac200a031f7e9 Mon Sep 17 00:00:00 2001 From: Celine Date: Mon, 5 Feb 2024 10:30:53 -0500 Subject: [PATCH 228/267] Split too long line --- R/xportr-package.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/xportr-package.R b/R/xportr-package.R index 19072ba2..4200890b 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -79,7 +79,8 @@ #' } #' \item{ #' xportr.numeric_types - The default character vector used to explicitly -#' coerce R classes to numeric XPT types. Default: c("integer", "float", "numeric", "posixct", "posixt", "time", "date") +#' coerce R classes to numeric XPT types. Default: c("integer", "float", +#' "numeric", "posixct", "posixt", "time", "date") #' } #' } #' From 63932b24ce1e5d4c755efcfe0904ad31893f3457 Mon Sep 17 00:00:00 2001 From: bms63 Date: Mon, 5 Feb 2024 15:53:27 +0000 Subject: [PATCH 229/267] [skip actions] Bump version to 0.3.1.9014 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index fc08a4e0..0746ec62 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9013 +Version: 0.3.1.9014 Authors@R: c( person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")), From 7177602734376fd555508b521b8a34ba463ebb46 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Sat, 3 Feb 2024 00:51:32 +0100 Subject: [PATCH 230/267] only workflow to run on draft is check --- .github/workflows/check-links.yml | 6 +++++- .github/workflows/check-standard.yaml | 6 +++++- .github/workflows/lint.yaml | 8 ++++++-- .github/workflows/pkgdown.yaml | 7 ------- .github/workflows/spellcheck.yml | 8 ++++++-- .github/workflows/style.yml | 6 +++++- .github/workflows/test-coverage.yaml | 7 ++++++- 7 files changed, 33 insertions(+), 15 deletions(-) diff --git a/.github/workflows/check-links.yml b/.github/workflows/check-links.yml index 1b3f3f2b..7d12d902 100644 --- a/.github/workflows/check-links.yml +++ b/.github/workflows/check-links.yml @@ -6,6 +6,11 @@ on: branches: - main pull_request: + types: + - opened + - synchronize + - reopened + - ready_for_review branches: - main workflow_dispatch: @@ -20,7 +25,6 @@ jobs: runs-on: ubuntu-latest if: > !contains(github.event.commits[0].message, '[skip links]') - && github.event.pull_request.draft == false steps: - name: Checkout repository 🛎 uses: actions/checkout@v4 diff --git a/.github/workflows/check-standard.yaml b/.github/workflows/check-standard.yaml index 761664fa..8ea5cb97 100644 --- a/.github/workflows/check-standard.yaml +++ b/.github/workflows/check-standard.yaml @@ -8,6 +8,11 @@ on: branches: - main pull_request: + types: + - opened + - synchronize + - reopened + - ready_for_review branches: - main workflow_dispatch: @@ -30,7 +35,6 @@ jobs: R_KEEP_PKG_SOURCE: yes if: > !contains(github.event.commits[0].message, '[skip checks]') - && github.event.pull_request.draft == false steps: - name: Checkout repository 🛎 uses: actions/checkout@v4 diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml index d4ed48c6..30166cf4 100644 --- a/.github/workflows/lint.yaml +++ b/.github/workflows/lint.yaml @@ -8,9 +8,14 @@ on: branches: - main pull_request: + types: + - opened + - synchronize + - reopened + - ready_for_review branches: - main - workflow_dispatch: + workflow_dispatch: concurrency: group: lint-${{ github.event.pull_request.number || github.ref }} @@ -21,7 +26,6 @@ jobs: runs-on: ubuntu-latest if: > !contains(github.event.commits[0].message, '[skip lint]') - && github.event.pull_request.draft == false env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index ff191a80..28dbcbd8 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -6,18 +6,11 @@ on: branches: - main -concurrency: - group: docs-${{ github.event.pull_request.number || github.ref }} - cancel-in-progress: true - jobs: pkgdown: runs-on: macOS-latest env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} - if: > - !contains(github.event.commits[0].message, '[skip docs]') - && github.event.pull_request.draft == false steps: - name: Checkout repository 🛎 uses: actions/checkout@v4 diff --git a/.github/workflows/spellcheck.yml b/.github/workflows/spellcheck.yml index 05e2e52f..9f3b1f35 100644 --- a/.github/workflows/spellcheck.yml +++ b/.github/workflows/spellcheck.yml @@ -2,13 +2,18 @@ name: Check Spelling 🆎 on: - workflow_dispatch: push: branches: - main pull_request: + types: + - opened + - synchronize + - reopened + - ready_for_review branches: - main + workflow_dispatch: concurrency: group: spelling-${{ github.event.pull_request.number || github.ref }} @@ -20,7 +25,6 @@ jobs: runs-on: ubuntu-latest if: > !contains(github.event.commits[0].message, '[skip spellcheck]') - && github.event.pull_request.draft == false steps: - name: Checkout repository 🛎 uses: actions/checkout@v4 diff --git a/.github/workflows/style.yml b/.github/workflows/style.yml index 17343cdf..2a2fab77 100644 --- a/.github/workflows/style.yml +++ b/.github/workflows/style.yml @@ -6,6 +6,11 @@ on: branches: - main pull_request: + types: + - opened + - synchronize + - reopened + - ready_for_review branches: - main workflow_dispatch: @@ -20,7 +25,6 @@ jobs: runs-on: ubuntu-latest if: > !contains(github.event.commits[0].message, '[skip stylecheck]') - && github.event.pull_request.draft == false steps: - uses: actions/checkout@v4 with: diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 18700621..f291b431 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -5,8 +5,14 @@ on: branches: - main pull_request: + types: + - opened + - synchronize + - reopened + - ready_for_review branches: - main + workflow_dispatch: concurrency: group: coverage-${{ github.event.pull_request.number || github.ref }} @@ -18,7 +24,6 @@ jobs: runs-on: ubuntu-latest if: > !contains(github.event.commits[0].message, '[skip coverage]') - && github.event.pull_request.draft == false env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: From c8da1218a2f47bf3e0e9f3fd0e57a1b61d1f04b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 6 Feb 2024 17:29:26 +0100 Subject: [PATCH 231/267] ci: adds admiralci --- .github/workflows/check-links.yml | 4 ++++ .github/workflows/check-standard.yaml | 7 +++++++ .github/workflows/lint.yaml | 6 ++++++ .github/workflows/spellcheck.yml | 6 ++++++ .github/workflows/style.yml | 7 +++++++ .github/workflows/test-coverage.yaml | 14 +++++++++++++- 6 files changed, 43 insertions(+), 1 deletion(-) diff --git a/.github/workflows/check-links.yml b/.github/workflows/check-links.yml index 7d12d902..f3e3ffd0 100644 --- a/.github/workflows/check-links.yml +++ b/.github/workflows/check-links.yml @@ -48,3 +48,7 @@ jobs: **/*.yml env: GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + links_admiral: + name: Links + uses: pharmaverse/admiralci/.github/workflows/links.yml@main + if: github.event_name == 'pull_request' diff --git a/.github/workflows/check-standard.yaml b/.github/workflows/check-standard.yaml index 8ea5cb97..9ba55709 100644 --- a/.github/workflows/check-standard.yaml +++ b/.github/workflows/check-standard.yaml @@ -56,3 +56,10 @@ jobs: - name: Run R CMD check 🎯 uses: r-lib/actions/check-r-package@v2 + + check_admiral: + name: Check + uses: pharmaverse/admiralci/.github/workflows/r-cmd-check.yml@main + with: + error-on: warning # TODO: find a way to ignore specific notes + if: github.event_name == 'pull_request' diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml index 30166cf4..2d70f40d 100644 --- a/.github/workflows/lint.yaml +++ b/.github/workflows/lint.yaml @@ -46,3 +46,9 @@ jobs: shell: Rscript {0} env: LINTR_ERROR_ON_LINT: true + linter_admiral: + name: Lint + uses: pharmaverse/admiralci/.github/workflows/lintr.yml@main + if: github.event_name == 'pull_request' + with: + r-version: "release" diff --git a/.github/workflows/spellcheck.yml b/.github/workflows/spellcheck.yml index 9f3b1f35..d6fb735d 100644 --- a/.github/workflows/spellcheck.yml +++ b/.github/workflows/spellcheck.yml @@ -42,3 +42,9 @@ jobs: with: exclude: data/*,**/*.Rd,**/*.md,*.md additional_options: "" + spellcheck_admiral: + name: Spelling + uses: pharmaverse/admiralci/.github/workflows/spellcheck.yml@main + if: github.event_name == 'pull_request' + with: + r-version: "release" diff --git a/.github/workflows/style.yml b/.github/workflows/style.yml index 2a2fab77..2e143e07 100644 --- a/.github/workflows/style.yml +++ b/.github/workflows/style.yml @@ -77,3 +77,10 @@ jobs: quit(status = 1) } shell: Rscript {0} + style_admiral: + name: Code Style + uses: pharmaverse/admiralci/.github/workflows/style.yml@main + if: github.event_name == 'pull_request' + needs: get_r_version + with: + r-version: "release" diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index f291b431..1b168cfb 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -19,7 +19,7 @@ concurrency: cancel-in-progress: true jobs: - test-coverage: + coverage: name: Coverage 📔 runs-on: ubuntu-latest if: > @@ -42,3 +42,15 @@ jobs: - name: Run Test coverage 👟 run: covr::codecov() shell: Rscript {0} + + coverage_admiral: + name: Code Coverage + uses: pharmaverse/admiralci/.github/workflows/code-coverage.yml@main + if: > + github.event_name != 'release' + with: + r-version: "true" + # Whether to skip code coverage badge creation + # Setting to 'false' will require you to create + # an orphan branch called 'badges' in your repository + skip-coverage-badges: true From 0037ab231f3e9b7d89ebe80d222fa2889a748e9f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 6 Feb 2024 17:31:11 +0100 Subject: [PATCH 232/267] add (admiral) suffix to better test --- .github/workflows/check-links.yml | 2 +- .github/workflows/check-standard.yaml | 2 +- .github/workflows/lint.yaml | 2 +- .github/workflows/spellcheck.yml | 2 +- .github/workflows/style.yml | 2 +- .github/workflows/test-coverage.yaml | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/.github/workflows/check-links.yml b/.github/workflows/check-links.yml index f3e3ffd0..85782806 100644 --- a/.github/workflows/check-links.yml +++ b/.github/workflows/check-links.yml @@ -49,6 +49,6 @@ jobs: env: GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} links_admiral: - name: Links + name: Links (admiral) uses: pharmaverse/admiralci/.github/workflows/links.yml@main if: github.event_name == 'pull_request' diff --git a/.github/workflows/check-standard.yaml b/.github/workflows/check-standard.yaml index 9ba55709..cd7b0340 100644 --- a/.github/workflows/check-standard.yaml +++ b/.github/workflows/check-standard.yaml @@ -58,7 +58,7 @@ jobs: uses: r-lib/actions/check-r-package@v2 check_admiral: - name: Check + name: Check (admiral) uses: pharmaverse/admiralci/.github/workflows/r-cmd-check.yml@main with: error-on: warning # TODO: find a way to ignore specific notes diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml index 2d70f40d..ad2c5118 100644 --- a/.github/workflows/lint.yaml +++ b/.github/workflows/lint.yaml @@ -47,7 +47,7 @@ jobs: env: LINTR_ERROR_ON_LINT: true linter_admiral: - name: Lint + name: Lint (admiral) uses: pharmaverse/admiralci/.github/workflows/lintr.yml@main if: github.event_name == 'pull_request' with: diff --git a/.github/workflows/spellcheck.yml b/.github/workflows/spellcheck.yml index d6fb735d..a7267a33 100644 --- a/.github/workflows/spellcheck.yml +++ b/.github/workflows/spellcheck.yml @@ -43,7 +43,7 @@ jobs: exclude: data/*,**/*.Rd,**/*.md,*.md additional_options: "" spellcheck_admiral: - name: Spelling + name: Spelling (admiral) uses: pharmaverse/admiralci/.github/workflows/spellcheck.yml@main if: github.event_name == 'pull_request' with: diff --git a/.github/workflows/style.yml b/.github/workflows/style.yml index 2e143e07..9a6d8339 100644 --- a/.github/workflows/style.yml +++ b/.github/workflows/style.yml @@ -78,7 +78,7 @@ jobs: } shell: Rscript {0} style_admiral: - name: Code Style + name: Code Style (admiral) uses: pharmaverse/admiralci/.github/workflows/style.yml@main if: github.event_name == 'pull_request' needs: get_r_version diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 1b168cfb..30cdd3d6 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -44,7 +44,7 @@ jobs: shell: Rscript {0} coverage_admiral: - name: Code Coverage + name: Code Coverage (admiral) uses: pharmaverse/admiralci/.github/workflows/code-coverage.yml@main if: > github.event_name != 'release' From 46218e502c350cbb16d3ded26b0e0f778fff465d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 6 Feb 2024 17:36:44 +0100 Subject: [PATCH 233/267] fix: remove typo --- .github/workflows/style.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/style.yml b/.github/workflows/style.yml index 9a6d8339..dbdc097e 100644 --- a/.github/workflows/style.yml +++ b/.github/workflows/style.yml @@ -81,6 +81,5 @@ jobs: name: Code Style (admiral) uses: pharmaverse/admiralci/.github/workflows/style.yml@main if: github.event_name == 'pull_request' - needs: get_r_version with: r-version: "release" From ab1d077576e1418dd10a0703ae1bd1f4ccb33d0a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 6 Feb 2024 17:49:37 +0100 Subject: [PATCH 234/267] move all admiral CI to 1 file --- .github/workflows/check-links.yml | 4 -- .github/workflows/check-standard.yaml | 7 --- .github/workflows/common.yaml | 75 +++++++++++++++++++++++++++ .github/workflows/lint.yaml | 6 --- .github/workflows/spellcheck.yml | 6 --- .github/workflows/style.yml | 6 --- .github/workflows/test-coverage.yaml | 12 ----- 7 files changed, 75 insertions(+), 41 deletions(-) create mode 100644 .github/workflows/common.yaml diff --git a/.github/workflows/check-links.yml b/.github/workflows/check-links.yml index 85782806..7d12d902 100644 --- a/.github/workflows/check-links.yml +++ b/.github/workflows/check-links.yml @@ -48,7 +48,3 @@ jobs: **/*.yml env: GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} - links_admiral: - name: Links (admiral) - uses: pharmaverse/admiralci/.github/workflows/links.yml@main - if: github.event_name == 'pull_request' diff --git a/.github/workflows/check-standard.yaml b/.github/workflows/check-standard.yaml index cd7b0340..8ea5cb97 100644 --- a/.github/workflows/check-standard.yaml +++ b/.github/workflows/check-standard.yaml @@ -56,10 +56,3 @@ jobs: - name: Run R CMD check 🎯 uses: r-lib/actions/check-r-package@v2 - - check_admiral: - name: Check (admiral) - uses: pharmaverse/admiralci/.github/workflows/r-cmd-check.yml@main - with: - error-on: warning # TODO: find a way to ignore specific notes - if: github.event_name == 'pull_request' diff --git a/.github/workflows/common.yaml b/.github/workflows/common.yaml new file mode 100644 index 00000000..55833aa5 --- /dev/null +++ b/.github/workflows/common.yaml @@ -0,0 +1,75 @@ +--- + # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples + # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help + name: xportr CI/CD Workflows + +on: + # 'push' events are triggered when commits + # are pushed to one of these branches + push: + branches: + - main + tags: + - "v*" + # 'pull_request' events are triggered when PRs are + # created against one of these target branches. + pull_request: + types: + - opened + - synchronize + - reopened + - ready_for_review + branches: + - main + # 'workflow_dispatch' gives you the ability + # to run this workflow on demand, anytime + workflow_dispatch: + +concurrency: + group: common-${{ github.event.pull_request.number || github.ref }} + cancel-in-progress: true + +jobs: + coverage: + name: Code Coverage (admiral) + uses: pharmaverse/admiralci/.github/workflows/code-coverage.yml@main + if: > + github.event_name != 'release' + with: + r-version: "release" + # Whether to skip code coverage badge creation + # Setting to 'false' will require you to create + # an orphan branch called 'badges' in your repository + skip-coverage-badges: true + style: + name: Code Style (admiral) + uses: pharmaverse/admiralci/.github/workflows/style.yml@main + if: github.event_name == 'pull_request' + with: + r-version: "release" + + check_admiral: + name: Check (admiral) + uses: pharmaverse/admiralci/.github/workflows/r-cmd-check.yml@main + with: + error-on: warning # TODO: find a way to ignore specific notes + if: github.event_name == 'pull_request' + + links_admiral: + name: Links (admiral) + uses: pharmaverse/admiralci/.github/workflows/links.yml@main + if: github.event_name == 'pull_request' + + linter_admiral: + name: Lint (admiral) + uses: pharmaverse/admiralci/.github/workflows/lintr.yml@main + if: github.event_name == 'pull_request' + with: + r-version: "release" + + spellcheck_admiral: + name: Spelling (admiral) + uses: pharmaverse/admiralci/.github/workflows/spellcheck.yml@main + if: github.event_name == 'pull_request' + with: + r-version: "release" diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml index ad2c5118..30166cf4 100644 --- a/.github/workflows/lint.yaml +++ b/.github/workflows/lint.yaml @@ -46,9 +46,3 @@ jobs: shell: Rscript {0} env: LINTR_ERROR_ON_LINT: true - linter_admiral: - name: Lint (admiral) - uses: pharmaverse/admiralci/.github/workflows/lintr.yml@main - if: github.event_name == 'pull_request' - with: - r-version: "release" diff --git a/.github/workflows/spellcheck.yml b/.github/workflows/spellcheck.yml index a7267a33..9f3b1f35 100644 --- a/.github/workflows/spellcheck.yml +++ b/.github/workflows/spellcheck.yml @@ -42,9 +42,3 @@ jobs: with: exclude: data/*,**/*.Rd,**/*.md,*.md additional_options: "" - spellcheck_admiral: - name: Spelling (admiral) - uses: pharmaverse/admiralci/.github/workflows/spellcheck.yml@main - if: github.event_name == 'pull_request' - with: - r-version: "release" diff --git a/.github/workflows/style.yml b/.github/workflows/style.yml index dbdc097e..2a2fab77 100644 --- a/.github/workflows/style.yml +++ b/.github/workflows/style.yml @@ -77,9 +77,3 @@ jobs: quit(status = 1) } shell: Rscript {0} - style_admiral: - name: Code Style (admiral) - uses: pharmaverse/admiralci/.github/workflows/style.yml@main - if: github.event_name == 'pull_request' - with: - r-version: "release" diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 30cdd3d6..e1d2e715 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -42,15 +42,3 @@ jobs: - name: Run Test coverage 👟 run: covr::codecov() shell: Rscript {0} - - coverage_admiral: - name: Code Coverage (admiral) - uses: pharmaverse/admiralci/.github/workflows/code-coverage.yml@main - if: > - github.event_name != 'release' - with: - r-version: "true" - # Whether to skip code coverage badge creation - # Setting to 'false' will require you to create - # an orphan branch called 'badges' in your repository - skip-coverage-badges: true From 7a25c3ab15e49a70490e86eda201e2c9bec6b067 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 6 Feb 2024 17:50:39 +0100 Subject: [PATCH 235/267] typo --- .github/workflows/common.yaml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/.github/workflows/common.yaml b/.github/workflows/common.yaml index 55833aa5..7aaa324e 100644 --- a/.github/workflows/common.yaml +++ b/.github/workflows/common.yaml @@ -1,7 +1,5 @@ --- - # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples - # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help - name: xportr CI/CD Workflows +name: xportr CI/CD Workflows on: # 'push' events are triggered when commits From d771e1fb0c39f14cdfbe8d95116260a0e8ca15c1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 6 Feb 2024 18:19:25 +0100 Subject: [PATCH 236/267] ci: small improvements --- .github/workflows/check-links.yml | 16 ++++++++++++---- .github/workflows/check-standard.yaml | 18 +++++++++++++----- .github/workflows/common.yaml | 2 ++ .github/workflows/pkgdown.yaml | 2 ++ .github/workflows/style.yml | 16 ++++++++++++---- .github/workflows/test-coverage.yaml | 16 ++++++++++++---- 6 files changed, 53 insertions(+), 17 deletions(-) diff --git a/.github/workflows/check-links.yml b/.github/workflows/check-links.yml index 7d12d902..515a0a52 100644 --- a/.github/workflows/check-links.yml +++ b/.github/workflows/check-links.yml @@ -2,17 +2,25 @@ name: Check URLs 🔗 on: + # 'push' events are triggered when commits + # are pushed to one of these branches push: branches: - main + tags: + - "v*" + # 'pull_request' events are triggered when PRs are + # created against one of these target branches. pull_request: types: - - opened - - synchronize - - reopened - - ready_for_review + - opened + - synchronize + - reopened + - ready_for_review branches: - main + # 'workflow_dispatch' gives you the ability + # to run this workflow on demand, anytime workflow_dispatch: concurrency: diff --git a/.github/workflows/check-standard.yaml b/.github/workflows/check-standard.yaml index 8ea5cb97..b15acc93 100644 --- a/.github/workflows/check-standard.yaml +++ b/.github/workflows/check-standard.yaml @@ -4,21 +4,29 @@ name: R-CMD-check 📦 on: + # 'push' events are triggered when commits + # are pushed to one of these branches push: branches: - main + tags: + - "v*" + # 'pull_request' events are triggered when PRs are + # created against one of these target branches. pull_request: types: - - opened - - synchronize - - reopened - - ready_for_review + - opened + - synchronize + - reopened + - ready_for_review branches: - main + # 'workflow_dispatch' gives you the ability + # to run this workflow on demand, anytime workflow_dispatch: jobs: - R-CMD-check: + check: name: ${{ matrix.config.os }} (${{ matrix.config.r }}) runs-on: ${{ matrix.config.os }} strategy: diff --git a/.github/workflows/common.yaml b/.github/workflows/common.yaml index 7aaa324e..9e70a89f 100644 --- a/.github/workflows/common.yaml +++ b/.github/workflows/common.yaml @@ -28,6 +28,8 @@ concurrency: cancel-in-progress: true jobs: + env: + release: "release" coverage: name: Code Coverage (admiral) uses: pharmaverse/admiralci/.github/workflows/code-coverage.yml@main diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 28dbcbd8..31219893 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -2,6 +2,8 @@ name: Deploy pkgdown site 📜 on: + # 'push' events are triggered when commits + # are pushed to one of these branches push: branches: - main diff --git a/.github/workflows/style.yml b/.github/workflows/style.yml index 2a2fab77..1c64c096 100644 --- a/.github/workflows/style.yml +++ b/.github/workflows/style.yml @@ -2,17 +2,25 @@ name: Check Style 🎨 on: + # 'push' events are triggered when commits + # are pushed to one of these branches push: branches: - main + tags: + - "v*" + # 'pull_request' events are triggered when PRs are + # created against one of these target branches. pull_request: types: - - opened - - synchronize - - reopened - - ready_for_review + - opened + - synchronize + - reopened + - ready_for_review branches: - main + # 'workflow_dispatch' gives you the ability + # to run this workflow on demand, anytime workflow_dispatch: concurrency: diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index e1d2e715..c06ffd57 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -1,17 +1,25 @@ name: Check Test Coverage 🧪 on: + # 'push' events are triggered when commits + # are pushed to one of these branches push: branches: - main + tags: + - "v*" + # 'pull_request' events are triggered when PRs are + # created against one of these target branches. pull_request: types: - - opened - - synchronize - - reopened - - ready_for_review + - opened + - synchronize + - reopened + - ready_for_review branches: - main + # 'workflow_dispatch' gives you the ability + # to run this workflow on demand, anytime workflow_dispatch: concurrency: From c1098e16efca3ec1065e9907048bcdd1c9b78173 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 6 Feb 2024 18:19:38 +0100 Subject: [PATCH 237/267] testing if CIs will catch errors --- R/messages.R | 4 ++++ R/metadata.R | 2 ++ man/length_log.Rd | 2 +- 3 files changed, 7 insertions(+), 1 deletion(-) diff --git a/R/messages.R b/R/messages.R index 50b4df7c..55660fdc 100644 --- a/R/messages.R +++ b/R/messages.R @@ -101,6 +101,8 @@ type_log <- function(meta_ordered, type_mismatch_ind, verbose) { #' Utility for Lengths #' +#' spellllling mistake +#' #' @param miss_vars Variables missing from metadata #' @param verbose Provides additional messaging for user #' @@ -110,6 +112,8 @@ length_log <- function(miss_vars, verbose) { assert_character(miss_vars) assert_choice(verbose, choices = .internal_verbose_choices) + if ( length(miss_vars) > 0 ) { TRUE && stop("this should trigger lint and styler"); 1+ 1 } + if (length(miss_vars) > 0) { cli_h2("Variable lengths missing from metadata.") cli_alert_success("{ length(miss_vars) } lengths resolved") diff --git a/R/metadata.R b/R/metadata.R index e6060ece..075007ac 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -6,6 +6,8 @@ #' details on the format of the metadata, see the 'Metadata' section for each #' function in question. #' +#' changing docs without updating documentation +#' #' @inheritParams xportr_length #' #' @return `.df` dataset with metadata and domain attributes set diff --git a/man/length_log.Rd b/man/length_log.Rd index 8b550292..49108ddd 100644 --- a/man/length_log.Rd +++ b/man/length_log.Rd @@ -15,5 +15,5 @@ length_log(miss_vars, verbose) Output to Console } \description{ -Utility for Lengths +spellllling mistake } From 87a48a4afa95d55b2dbe228796e5a17d97ec8af7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 6 Feb 2024 18:20:43 +0100 Subject: [PATCH 238/267] ci: corrects typo --- .github/workflows/common.yaml | 2 -- 1 file changed, 2 deletions(-) diff --git a/.github/workflows/common.yaml b/.github/workflows/common.yaml index 9e70a89f..7aaa324e 100644 --- a/.github/workflows/common.yaml +++ b/.github/workflows/common.yaml @@ -28,8 +28,6 @@ concurrency: cancel-in-progress: true jobs: - env: - release: "release" coverage: name: Code Coverage (admiral) uses: pharmaverse/admiralci/.github/workflows/code-coverage.yml@main From bf962798aad8ba66431de0fdc7ad18a5d6c68f4d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 6 Feb 2024 18:39:21 +0100 Subject: [PATCH 239/267] ci: spellcheck wasn't running for documentation --- .github/workflows/spellcheck.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/spellcheck.yml b/.github/workflows/spellcheck.yml index 9f3b1f35..f5ad817a 100644 --- a/.github/workflows/spellcheck.yml +++ b/.github/workflows/spellcheck.yml @@ -40,5 +40,5 @@ jobs: - name: Run Spellcheck 👟 uses: insightsengineering/r-spellcheck-action@v3 with: - exclude: data/*,**/*.Rd,**/*.md,*.md + exclude: data/* additional_options: "" From 9fe72a7a404046b284dc894c7e623288a4ff7a95 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 6 Feb 2024 18:40:47 +0100 Subject: [PATCH 240/267] ci: test with a broken link --- R/messages.R | 1 + man/length_log.Rd | 1 + 2 files changed, 2 insertions(+) diff --git a/R/messages.R b/R/messages.R index 55660fdc..5ba12108 100644 --- a/R/messages.R +++ b/R/messages.R @@ -102,6 +102,7 @@ type_log <- function(meta_ordered, type_mismatch_ind, verbose) { #' Utility for Lengths #' #' spellllling mistake +#' a [link](http://thisisarandompagethatdoesntexit.com) #' #' @param miss_vars Variables missing from metadata #' @param verbose Provides additional messaging for user diff --git a/man/length_log.Rd b/man/length_log.Rd index 49108ddd..20ee21fc 100644 --- a/man/length_log.Rd +++ b/man/length_log.Rd @@ -16,4 +16,5 @@ Output to Console } \description{ spellllling mistake +a \href{http://thisisarandompagethatdoesntexit.com}{link} } From cec27e021bb3165b187c6abfc9f9f66651f2f9cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 6 Feb 2024 18:42:13 +0100 Subject: [PATCH 241/267] adds a non-tested function --- R/messages.R | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/R/messages.R b/R/messages.R index 5ba12108..6d047318 100644 --- a/R/messages.R +++ b/R/messages.R @@ -129,6 +129,18 @@ length_log <- function(miss_vars, verbose) { } } +#' @noRd +a_new_function <- function() { + "this is not tested" + 1+1 + 3+3 + 4+4 + 5+5 + 6+6 + 7+7 + "adding lines to make a dent on 100% test coverage" +} + #' Utility for Variable Labels #' #' @param miss_vars Missing variables in metadata From d41682b8bb069f8f9601ff49d47013e9cd6b8421 Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 7 Feb 2024 14:31:15 -0500 Subject: [PATCH 242/267] change argument name length to length_source --- R/length.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/length.R b/R/length.R index 4b47831c..d43ed4f3 100644 --- a/R/length.R +++ b/R/length.R @@ -11,7 +11,7 @@ #' @param domain Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset #' the metadata object. If none is passed, then name of the dataset passed as #' .df will be used. -#' @param length Choose the assigned length from either metadata or data. +#' @param length_source Choose the assigned length from either metadata or data. #' #' If `"metadata"` is specified, the assigned length is from the metadata length. #' If `"data"` is specified, the assigned length is determined by the calculated maximum data length. @@ -72,10 +72,10 @@ xportr_length <- function(.df, metadata = NULL, domain = NULL, - length = c("metadata", "data"), + length_source = c("metadata", "data"), verbose = NULL, metacore = deprecated()) { - length <- match.arg(length) + length_source <- match.arg(length_source) if (!missing(metacore)) { lifecycle::deprecate_stop( when = "0.3.1.9005", @@ -123,7 +123,7 @@ xportr_length <- function(.df, length_log(miss_vars, verbose) - if (length == "metadata") { + if (length_source == "metadata") { length_metadata <- metadata[[variable_length]] names(length_metadata) <- metadata[[variable_name]] @@ -137,7 +137,7 @@ xportr_length <- function(.df, } # Assign length from data - if (length == "data") { + if (length_source == "data") { var_length_max <- variable_max_length(.df) length_data <- var_length_max[[variable_length]] From be567999e3caa9c232cf6db54571da3c05e20165 Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 7 Feb 2024 14:38:35 -0500 Subject: [PATCH 243/267] change order of argument --- R/length.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/length.R b/R/length.R index d43ed4f3..15acba9d 100644 --- a/R/length.R +++ b/R/length.R @@ -11,15 +11,15 @@ #' @param domain Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset #' the metadata object. If none is passed, then name of the dataset passed as #' .df will be used. +#' @param verbose The action this function takes when an action is taken on the +#' dataset or function validation finds an issue. See 'Messaging' section for +#' details. Options are 'stop', 'warn', 'message', and 'none' #' @param length_source Choose the assigned length from either metadata or data. #' #' If `"metadata"` is specified, the assigned length is from the metadata length. #' If `"data"` is specified, the assigned length is determined by the calculated maximum data length. #' #' *Permitted Values*: `"metadata"`, `"data"` -#' @param verbose The action this function takes when an action is taken on the -#' dataset or function validation finds an issue. See 'Messaging' section for -#' details. Options are 'stop', 'warn', 'message', and 'none' #' @param metacore `r lifecycle::badge("deprecated")` Previously used to pass #' metadata now renamed with `metadata` #' @@ -72,8 +72,8 @@ xportr_length <- function(.df, metadata = NULL, domain = NULL, - length_source = c("metadata", "data"), verbose = NULL, + length_source = c("metadata", "data"), metacore = deprecated()) { length_source <- match.arg(length_source) if (!missing(metacore)) { From 13dd326989bb3baaf71226551e1f564d5e85faf3 Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 7 Feb 2024 14:59:28 -0500 Subject: [PATCH 244/267] Added description in NEWS.md --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index 3a5891c0..dafe5599 100644 --- a/NEWS.md +++ b/NEWS.md @@ -21,6 +21,8 @@ * All core functions can be run together by using new function `xportr()` (#137) +*New argument in `xportr_length()` allows selection between the length from metadata, as previously done, or from the calculated maximum length per variable when `length_source` is set to “data” (#91) + ## Documentation ## Deprecation and Breaking Changes From d811cb7fe1b2a27f964bc3ba1e9f0c86c14ed2a8 Mon Sep 17 00:00:00 2001 From: Celine Date: Wed, 7 Feb 2024 15:01:46 -0500 Subject: [PATCH 245/267] Update documentation --- man/xportr_length.Rd | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index 6a964405..b288f984 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -8,8 +8,8 @@ xportr_length( .df, metadata = NULL, domain = NULL, - length = c("metadata", "data"), verbose = NULL, + length_source = c("metadata", "data"), metacore = deprecated() ) } @@ -23,17 +23,17 @@ xportr_length( the metadata object. If none is passed, then name of the dataset passed as .df will be used.} -\item{length}{Choose the assigned length from either metadata or data. +\item{verbose}{The action this function takes when an action is taken on the +dataset or function validation finds an issue. See 'Messaging' section for +details. Options are 'stop', 'warn', 'message', and 'none'} + +\item{length_source}{Choose the assigned length from either metadata or data. If \code{"metadata"} is specified, the assigned length is from the metadata length. If \code{"data"} is specified, the assigned length is determined by the calculated maximum data length. \emph{Permitted Values}: \code{"metadata"}, \code{"data"}} -\item{verbose}{The action this function takes when an action is taken on the -dataset or function validation finds an issue. See 'Messaging' section for -details. Options are 'stop', 'warn', 'message', and 'none'} - \item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass metadata now renamed with \code{metadata}} } From 7bf3770f84533db3225255226b60980972829900 Mon Sep 17 00:00:00 2001 From: Celine Date: Sun, 11 Feb 2024 02:41:44 -0500 Subject: [PATCH 246/267] Change argument name to source_length in test-length --- tests/testthat/test-length.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index 305a6e13..7235cb97 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -206,17 +206,17 @@ df <- data.frame( test_that("xportr_length: length assigned as expected from metadata or data", { result <- df %>% - xportr_length(meta_example, domain = "df", length = "metadata") %>% + xportr_length(meta_example, domain = "df", length_source = "metadata") %>% expect_attr_width(c(10, 8)) result <- df %>% - xportr_length(meta_example, domain = "df", length = "data") %>% + xportr_length(meta_example, domain = "df", length_source = "data") %>% expect_attr_width(c(3, 8)) }) test_that("xportr_length: Gets message when length in metadata longer than data length", { result <- df %>% - xportr_length(meta_example, domain = "df", length = "data") %>% + xportr_length(meta_example, domain = "df", length_source = "data") %>% expect_message() }) From 758846a4b147b77d41a64941cca321370e730be4 Mon Sep 17 00:00:00 2001 From: Celine Date: Sun, 11 Feb 2024 02:52:49 -0500 Subject: [PATCH 247/267] change argument name to length_source --- R/length.R | 2 +- man/xportr_length.Rd | 2 +- vignettes/deepdive.Rmd | 8 ++++---- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/length.R b/R/length.R index 15acba9d..d87fe2b2 100644 --- a/R/length.R +++ b/R/length.R @@ -68,7 +68,7 @@ #' length = c(10, 8) #' ) #' -#' adsl <- xportr_length(adsl, metadata, domain = "adsl", length = "metadata") +#' adsl <- xportr_length(adsl, metadata, domain = "adsl", length_source = "metadata") xportr_length <- function(.df, metadata = NULL, domain = NULL, diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index b288f984..8d034eb8 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -89,5 +89,5 @@ metadata <- data.frame( length = c(10, 8) ) -adsl <- xportr_length(adsl, metadata, domain = "adsl", length = "metadata") +adsl <- xportr_length(adsl, metadata, domain = "adsl", length_source = "metadata") } diff --git a/vignettes/deepdive.Rmd b/vignettes/deepdive.Rmd index b245ad15..ec342ba1 100644 --- a/vignettes/deepdive.Rmd +++ b/vignettes/deepdive.Rmd @@ -194,7 +194,7 @@ To help reduce these repetitive calls, we have created `xportr_metadata()`. A us adsl %>% xportr_metadata(var_spec, "ADSL") %>% xportr_type() %>% - xportr_length(length = "metadata") %>% + xportr_length(length_source = "metadata") %>% xportr_label() %>% xportr_order() %>% xportr_format() %>% @@ -310,7 +310,7 @@ str(adsl) ``` ```{r, echo = TRUE} -adsl_length <- xportr_length(.df = adsl, metadata = var_spec, domain = "ADSL", verbose = "warn", length = "metadata") +adsl_length <- xportr_length(.df = adsl, metadata = var_spec, domain = "ADSL", verbose = "warn", length_source = "metadata") ``` Using `xportr_length()` with `verbose = "warn"` we can apply the length column to all the columns in the dataset. The function detects that two variables, `TRTDUR` and `DCREASCD` are missing from the metadata file. Note that the variables have slight misspellings in the dataset and metadata, which is a great catch! However, lengths are still applied with TRTDUR being give a length of 8 and DCREASCD a length of 200. @@ -325,7 +325,7 @@ str(adsl_length) Just like we did for `xportr_type()`, setting `verbose = "stop"` immediately stops R from processing the lengths. Here the function detects the missing variables and will not apply any lengths to the dataset until corrective action is applied. ```{r, echo = TRUE, error = TRUE} -adsl_length <- xportr_length(.df = adsl, metadata = var_spec, domain = "ADSL", verbose = "stop", length = "metadata") +adsl_length <- xportr_length(.df = adsl, metadata = var_spec, domain = "ADSL", verbose = "stop", length_source = "metadata") ``` @@ -426,7 +426,7 @@ It is also note worthy that you can set the dataset label using the `xportr_df_l adsl %>% xportr_metadata(var_spec, "ADSL") %>% xportr_type() %>% - xportr_length(length = "metadata") %>% + xportr_length(length_source = "metadata") %>% xportr_label() %>% xportr_order() %>% xportr_format() %>% From cc9d0dfe1b2e20831d2af740b4fcce1b91f2fdd1 Mon Sep 17 00:00:00 2001 From: Celine Piraux <69685640+cpiraux@users.noreply.github.com> Date: Sun, 11 Feb 2024 08:54:49 +0100 Subject: [PATCH 248/267] Update NEWS.md Co-authored-by: Ben Straub --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index dafe5599..f8e0e33c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -21,7 +21,7 @@ * All core functions can be run together by using new function `xportr()` (#137) -*New argument in `xportr_length()` allows selection between the length from metadata, as previously done, or from the calculated maximum length per variable when `length_source` is set to “data” (#91) +* New argument in `xportr_length()` allows selection between the length from metadata, as previously done, or from the calculated maximum length per variable when `length_source` is set to “data” (#91) ## Documentation From c7a410b56e3239f556543462d17848a75be1d731 Mon Sep 17 00:00:00 2001 From: Celine Date: Sun, 11 Feb 2024 03:08:10 -0500 Subject: [PATCH 249/267] Reduce line length less than 120 characters --- vignettes/deepdive.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/deepdive.Rmd b/vignettes/deepdive.Rmd index ec342ba1..8bd27f1d 100644 --- a/vignettes/deepdive.Rmd +++ b/vignettes/deepdive.Rmd @@ -325,7 +325,7 @@ str(adsl_length) Just like we did for `xportr_type()`, setting `verbose = "stop"` immediately stops R from processing the lengths. Here the function detects the missing variables and will not apply any lengths to the dataset until corrective action is applied. ```{r, echo = TRUE, error = TRUE} -adsl_length <- xportr_length(.df = adsl, metadata = var_spec, domain = "ADSL", verbose = "stop", length_source = "metadata") +adsl_length <- xportr_length(.df = adsl, metadata = var_spec, domain = "ADSL", verbose = "stop") ``` From 98c075f025de11d56d5ce2bd5bbd3910e49a9157 Mon Sep 17 00:00:00 2001 From: Celine Date: Sun, 11 Feb 2024 03:27:41 -0500 Subject: [PATCH 250/267] lint:reduce lenght of line --- vignettes/deepdive.Rmd | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/vignettes/deepdive.Rmd b/vignettes/deepdive.Rmd index 8bd27f1d..ae920ef1 100644 --- a/vignettes/deepdive.Rmd +++ b/vignettes/deepdive.Rmd @@ -310,7 +310,13 @@ str(adsl) ``` ```{r, echo = TRUE} -adsl_length <- xportr_length(.df = adsl, metadata = var_spec, domain = "ADSL", verbose = "warn", length_source = "metadata") +adsl_length <- xportr_length( + .df = adsl, + metadata = var_spec, + domain = "ADSL", + verbose = "warn", + length_source = "metadata" +) ``` Using `xportr_length()` with `verbose = "warn"` we can apply the length column to all the columns in the dataset. The function detects that two variables, `TRTDUR` and `DCREASCD` are missing from the metadata file. Note that the variables have slight misspellings in the dataset and metadata, which is a great catch! However, lengths are still applied with TRTDUR being give a length of 8 and DCREASCD a length of 200. @@ -325,7 +331,13 @@ str(adsl_length) Just like we did for `xportr_type()`, setting `verbose = "stop"` immediately stops R from processing the lengths. Here the function detects the missing variables and will not apply any lengths to the dataset until corrective action is applied. ```{r, echo = TRUE, error = TRUE} -adsl_length <- xportr_length(.df = adsl, metadata = var_spec, domain = "ADSL", verbose = "stop") +adsl_length <- xportr_length( + .df = adsl, + metadata = var_spec, + domain = "ADSL", + verbose = "stop", + length_source = "metadata" +) ``` From ebf3a00c7e9e6de219541635cae3c2c391b8af20 Mon Sep 17 00:00:00 2001 From: bms63 Date: Sun, 11 Feb 2024 16:30:55 +0000 Subject: [PATCH 251/267] [skip actions] Bump version to 0.3.1.9015 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0746ec62..573e88a2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9014 +Version: 0.3.1.9015 Authors@R: c( person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")), From d198121ac8fec4920d7edf5b8898e191ff8fb50c Mon Sep 17 00:00:00 2001 From: bs832471 Date: Sun, 11 Feb 2024 16:41:21 +0000 Subject: [PATCH 252/267] docs: #230 #188 PR template tweaks --- .github/pull_request_template.md | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index d08d7254..775143ab 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -6,7 +6,7 @@ We have developed a Pull Request template to aid you and our reviewers. Completi `{xportr}`'s scope is to enable R users to write out submission compliant `xpt` files that can be delivered to a Health Authority or to downstream validation software programs. We see labels, lengths, types, ordering and formats from a dataset specification object (SDTM and ADaM) as being our primary focus. We also see messaging and warnings to users around applying information from the specification file as a primary focus. Please make sure your Pull Request meets this **scope of {xportr}**. If your Pull Request moves beyond this scope, please get in touch with the `{xportr}` team on [slack](https://pharmaverse.slack.com/archives/C030EB2M4GM) or create an issue to discuss. -Please check off each task box as an acknowledgment that you completed the task. This checklist is part of the Github Action workflows and the Pull Request will not be merged into the `devel` branch until you have checked off each task. +Please check off each task box as an acknowledgment that you completed the task. This checklist is part of the Github Action workflows and the Pull Request will not be merged into the `main` branch until you have checked off each task. ### Changes Description @@ -18,13 +18,14 @@ _(descriptions of changes)_ - [ ] Place Closes # into the beginning of your Pull Request Title (Use Edit button in top-right if you need to update) - [ ] Summary of changes filled out in the above Changes Description. Can be removed or left blank if changes are minor/self-explanatory. - [ ] Code is formatted according to the [tidyverse style guide](https://style.tidyverse.org/). Use `styler` package and functions to style files accordingly. +- [ ] New functions or arguments follow established convention found in the [Wiki](https://github.com/atorus-research/xportr/wiki/Style-Guide-for-Roxygen-Headers). - [ ] Updated relevant unit tests or have written new unit tests. See our [Wiki](https://github.com/atorus-research/xportr/wiki/Style-Guide-for-Unit-Tests) for conventions used in this package. - [ ] Creation/updated relevant roxygen headers and examples. See our [Wiki](https://github.com/atorus-research/xportr/wiki/Style-Guide-for-Roxygen-Headers) for conventions used in this package. - [ ] Run `devtools::document()` so all `.Rd` files in the `man` folder and the `NAMESPACE` file in the project root are updated appropriately - [ ] Run `pkgdown::build_site()` and check that all affected examples are displayed correctly and that all new/updated functions occur on the "Reference" page. - [ ] Update NEWS.md if the changes pertain to a user-facing function (i.e. it has an @export tag) or documentation aimed at users (rather than developers) -- [ ] Make sure that the package version in the NEWS.md and DESCRIPTION file is same. Don't worry about updating the version because it will be auto-updated using the `vbump.yaml` CI. -- [ ] Address any updates needed for vignettes and/or templates +- [ ] Make sure that the package version in the `NEWS.md` and `DESCRIPTION` file is same. Don't worry about updating the version because it will be auto-updated using the `vbump.yaml` CI. +- [ ] Address any updates needed for vignettes and/or templates. - [ ] Link the issue Development Panel so that it closes after successful merging. -- [ ] Fix merge conflicts +- [ ] The developer is responsible for fixing merge conflicts not the Reviewer. - [ ] Pat yourself on the back for a job well done! Much love to your accomplishment! From 9d818241a9ae34c8e0af9e32442036af8b3f26bd Mon Sep 17 00:00:00 2001 From: bs832471 Date: Sun, 11 Feb 2024 16:55:36 +0000 Subject: [PATCH 253/267] docs: #192 remove non-user functions from reference files Merge remote-tracking branch 'origin/91-max-length' into 192_188_230_grab_bag --- NAMESPACE | 7 ------- R/messages.R | 14 +++++++------- R/utils-xportr.R | 3 +-- _pkgdown.yml | 6 ------ man/label_log.Rd | 19 ------------------- man/length_log.Rd | 19 ------------------- man/max_length_msg.Rd | 19 ------------------- man/type_log.Rd | 21 --------------------- man/var_names_log.Rd | 19 ------------------- man/var_ord_msg.Rd | 21 --------------------- man/variable_max_length.Rd | 17 ----------------- man/xportr_logger.Rd | 22 ---------------------- 12 files changed, 8 insertions(+), 179 deletions(-) delete mode 100644 man/label_log.Rd delete mode 100644 man/length_log.Rd delete mode 100644 man/max_length_msg.Rd delete mode 100644 man/type_log.Rd delete mode 100644 man/var_names_log.Rd delete mode 100644 man/var_ord_msg.Rd delete mode 100644 man/variable_max_length.Rd delete mode 100644 man/xportr_logger.Rd diff --git a/NAMESPACE b/NAMESPACE index 1a6000cb..19e4f108 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,17 +1,10 @@ # Generated by roxygen2: do not edit by hand -export(label_log) -export(length_log) -export(type_log) -export(var_names_log) -export(var_ord_msg) -export(variable_max_length) export(xportr) export(xportr_df_label) export(xportr_format) export(xportr_label) export(xportr_length) -export(xportr_logger) export(xportr_metadata) export(xportr_options) export(xportr_order) diff --git a/R/messages.R b/R/messages.R index ebe43a69..e85d6875 100644 --- a/R/messages.R +++ b/R/messages.R @@ -8,7 +8,7 @@ #' @param ... additional arguments if needed #' #' @return Output to Console -#' @export +#' @noRd xportr_logger <- function(message, type = "none", ...) { assert_character(message) assert_choice(type, choices = .internal_verbose_choices) @@ -29,7 +29,7 @@ xportr_logger <- function(message, type = "none", ...) { #' @param verbose Provides additional messaging for user #' #' @return Output to Console -#' @export +#' @noRd var_names_log <- function(tidy_names_df, verbose) { assert_data_frame(tidy_names_df) assert_choice(verbose, choices = .internal_verbose_choices) @@ -80,7 +80,7 @@ var_names_log <- function(tidy_names_df, verbose) { #' @param verbose Provides additional messaging for user #' #' @return Output to Console -#' @export +#' @noRd type_log <- function(meta_ordered, type_mismatch_ind, verbose) { assert_data_frame(meta_ordered) assert_integer(type_mismatch_ind) @@ -105,7 +105,7 @@ type_log <- function(meta_ordered, type_mismatch_ind, verbose) { #' @param verbose Provides additional messaging for user #' #' @return Output to Console -#' @export +#' @noRd length_log <- function(miss_vars, verbose) { assert_character(miss_vars) assert_choice(verbose, choices = .internal_verbose_choices) @@ -130,7 +130,7 @@ length_log <- function(miss_vars, verbose) { #' @param verbose Provides additional messaging for user #' #' @return Output to Console -#' @export +#' @noRd label_log <- function(miss_vars, verbose) { assert_character(miss_vars) assert_choice(verbose, choices = .internal_verbose_choices) @@ -155,7 +155,7 @@ label_log <- function(miss_vars, verbose) { #' @param verbose Provides additional messaging for user #' #' @return Output to Console -#' @export +#' @noRd var_ord_msg <- function(reordered_vars, moved_vars, verbose) { assert_character(reordered_vars) assert_character(moved_vars) @@ -188,7 +188,7 @@ var_ord_msg <- function(reordered_vars, moved_vars, verbose) { #' @param verbose Provides additional messaging for user #' #' @return Output to Console - +#' @noRd max_length_msg <- function(max_length, verbose) { assert_data_frame(max_length) assert_choice(verbose, choices = .internal_verbose_choices) diff --git a/R/utils-xportr.R b/R/utils-xportr.R index 18349b9f..ca89ed74 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -363,8 +363,7 @@ check_multiple_var_specs <- function(metadata, #' #' @return Returns a dataframe with variables and their maximum length #' -#' @export - +#' @noRd variable_max_length <- function(.df) { assert_data_frame(.df) diff --git a/_pkgdown.yml b/_pkgdown.yml index d98fc629..f40ad3d5 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -38,12 +38,6 @@ reference: desc: Utility functions called within core xportr functions - contents: - xportr_options - - label_log - - length_log - - type_log - - var_names_log - - var_ord_msg - - xportr_logger - xpt_validate - title: xportr example datasets and specification files diff --git a/man/label_log.Rd b/man/label_log.Rd deleted file mode 100644 index aba9573c..00000000 --- a/man/label_log.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/messages.R -\name{label_log} -\alias{label_log} -\title{Utility for Variable Labels} -\usage{ -label_log(miss_vars, verbose) -} -\arguments{ -\item{miss_vars}{Missing variables in metadata} - -\item{verbose}{Provides additional messaging for user} -} -\value{ -Output to Console -} -\description{ -Utility for Variable Labels -} diff --git a/man/length_log.Rd b/man/length_log.Rd deleted file mode 100644 index 8b550292..00000000 --- a/man/length_log.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/messages.R -\name{length_log} -\alias{length_log} -\title{Utility for Lengths} -\usage{ -length_log(miss_vars, verbose) -} -\arguments{ -\item{miss_vars}{Variables missing from metadata} - -\item{verbose}{Provides additional messaging for user} -} -\value{ -Output to Console -} -\description{ -Utility for Lengths -} diff --git a/man/max_length_msg.Rd b/man/max_length_msg.Rd deleted file mode 100644 index 85bd35a7..00000000 --- a/man/max_length_msg.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/messages.R -\name{max_length_msg} -\alias{max_length_msg} -\title{Utility for data Lengths} -\usage{ -max_length_msg(max_length, verbose) -} -\arguments{ -\item{max_length}{Dataframe with data and metadata length} - -\item{verbose}{Provides additional messaging for user} -} -\value{ -Output to Console -} -\description{ -Utility for data Lengths -} diff --git a/man/type_log.Rd b/man/type_log.Rd deleted file mode 100644 index b070ca9d..00000000 --- a/man/type_log.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/messages.R -\name{type_log} -\alias{type_log} -\title{Utility for Types} -\usage{ -type_log(meta_ordered, type_mismatch_ind, verbose) -} -\arguments{ -\item{meta_ordered}{fill in later} - -\item{type_mismatch_ind}{fill in later} - -\item{verbose}{Provides additional messaging for user} -} -\value{ -Output to Console -} -\description{ -Utility for Types -} diff --git a/man/var_names_log.Rd b/man/var_names_log.Rd deleted file mode 100644 index 533cedbd..00000000 --- a/man/var_names_log.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/messages.R -\name{var_names_log} -\alias{var_names_log} -\title{Utility for Renaming Variables} -\usage{ -var_names_log(tidy_names_df, verbose) -} -\arguments{ -\item{tidy_names_df}{dataframe} - -\item{verbose}{Provides additional messaging for user} -} -\value{ -Output to Console -} -\description{ -Utility for Renaming Variables -} diff --git a/man/var_ord_msg.Rd b/man/var_ord_msg.Rd deleted file mode 100644 index be7f79dd..00000000 --- a/man/var_ord_msg.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/messages.R -\name{var_ord_msg} -\alias{var_ord_msg} -\title{Utility for Ordering} -\usage{ -var_ord_msg(reordered_vars, moved_vars, verbose) -} -\arguments{ -\item{reordered_vars}{Number of variables reordered} - -\item{moved_vars}{Number of variables moved in the dataset} - -\item{verbose}{Provides additional messaging for user} -} -\value{ -Output to Console -} -\description{ -Utility for Ordering -} diff --git a/man/variable_max_length.Rd b/man/variable_max_length.Rd deleted file mode 100644 index 3c478d7c..00000000 --- a/man/variable_max_length.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils-xportr.R -\name{variable_max_length} -\alias{variable_max_length} -\title{Calculate the maximum length of variables} -\usage{ -variable_max_length(.df) -} -\arguments{ -\item{.df}{A data frame of CDISC standard.} -} -\value{ -Returns a dataframe with variables and their maximum length -} -\description{ -Function to calculate the maximum length of variables in a given dataframe -} diff --git a/man/xportr_logger.Rd b/man/xportr_logger.Rd deleted file mode 100644 index cb1f8edf..00000000 --- a/man/xportr_logger.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/messages.R -\name{xportr_logger} -\alias{xportr_logger} -\title{Utility Logging Function} -\usage{ -xportr_logger(message, type = "none", ...) -} -\arguments{ -\item{message}{Output to be sent out for user} - -\item{type}{Three types: abort, warn, inform} - -\item{...}{additional arguments if needed} -} -\value{ -Output to Console -} -\description{ -Functions to output user messages, usually relating to differences -found between dataframe and the metacore/metadata object -} From cff269f08a959166e7168d4abe1bd67d63b5e6fe Mon Sep 17 00:00:00 2001 From: bs832471 Date: Sun, 11 Feb 2024 17:00:17 +0000 Subject: [PATCH 254/267] chore: breaking news - turn to channel 6! --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index f8e0e33c..4ee7e57f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -25,6 +25,8 @@ ## Documentation +* Removed non-user facing function documentation (#192) + ## Deprecation and Breaking Changes * The `domain` argument for xportr functions will no longer be dynamically From be43190ecb1e388fb66298c1a0abe29da080666b Mon Sep 17 00:00:00 2001 From: bs832471 Date: Sun, 11 Feb 2024 17:03:21 +0000 Subject: [PATCH 255/267] chore: removed duplicated documentation section in news --- NEWS.md | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/NEWS.md b/NEWS.md index 4ee7e57f..9c22f7a9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,13 +6,13 @@ * All `xportr` functions now have `verbose = NULL` as the default (#151) -## Documentation - * `xportr_write()` now accepts `metadata` argument which can be used to set the dataset label to stay consistent with the other `xportr_*` functions. It is noteworthy that the dataset label set using the `xportr_df_label()` function will be retained during the `xportr_write()`. * Exporting a new dataset `dataset_spec` that contains the Dataset Specification for ADSL. (#179) * 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) * `xportr_metadata()` can set `verbose` for a whole pipeline, i.e. setting `verbose` in `xportr_metadata()` will populate to all `xportr` functions. (#151) @@ -23,16 +23,14 @@ * New argument in `xportr_length()` allows selection between the length from metadata, as previously done, or from the calculated maximum length per variable when `length_source` is set to “data” (#91) -## Documentation - -* Removed non-user facing function documentation (#192) - ## 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`. * `SASlength` and `SAStype` were removed since they did not have an impact on `xpt_validate` or any other functions (#132) @@ -40,8 +38,11 @@ done to make the use of xportr functions more explicit. (#182) ## Documentation * Created development version of the website (#187) + * Additional guidance for options added in deep dive vignette (#81) +* Removed non-user facing function documentation (#192) + # xportr 0.3.1 ## New Features and Bug Fixes From fc2d2ee9a6b971c065ec712b1fd7ab76b89540bb Mon Sep 17 00:00:00 2001 From: Ben Straub Date: Sun, 11 Feb 2024 12:35:19 -0500 Subject: [PATCH 256/267] Update pull_request_template.md --- .github/pull_request_template.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index 775143ab..e4e2bab8 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -23,8 +23,8 @@ _(descriptions of changes)_ - [ ] Creation/updated relevant roxygen headers and examples. See our [Wiki](https://github.com/atorus-research/xportr/wiki/Style-Guide-for-Roxygen-Headers) for conventions used in this package. - [ ] Run `devtools::document()` so all `.Rd` files in the `man` folder and the `NAMESPACE` file in the project root are updated appropriately - [ ] Run `pkgdown::build_site()` and check that all affected examples are displayed correctly and that all new/updated functions occur on the "Reference" page. -- [ ] Update NEWS.md if the changes pertain to a user-facing function (i.e. it has an @export tag) or documentation aimed at users (rather than developers) -- [ ] Make sure that the package version in the `NEWS.md` and `DESCRIPTION` file is same. Don't worry about updating the version because it will be auto-updated using the `vbump.yaml` CI. +- [ ] Update `NEWS.md` if the changes pertain to a user-facing function (i.e. it has an `@export` tag) or documentation aimed at users (rather than developers) +- [ ] The `NEWS.md` entry should go under the `# xportr development version` section. Don't worry about updating the version because it will be auto-updated using the `vbump.yaml` CI. - [ ] Address any updates needed for vignettes and/or templates. - [ ] Link the issue Development Panel so that it closes after successful merging. - [ ] The developer is responsible for fixing merge conflicts not the Reviewer. From cdf8f5b3d938506ea1b9043da157e6e697e7d037 Mon Sep 17 00:00:00 2001 From: bms63 Date: Sun, 11 Feb 2024 17:36:51 +0000 Subject: [PATCH 257/267] [skip actions] Bump version to 0.3.1.9016 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 573e88a2..99d3dd9b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9015 +Version: 0.3.1.9016 Authors@R: c( person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")), From 9e6c11e2232ed7978e728426721773fcef5b394e Mon Sep 17 00:00:00 2001 From: EeethB Date: Tue, 13 Feb 2024 16:34:59 +0000 Subject: [PATCH 258/267] [skip actions] Bump version to 0.3.1.9017 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 99d3dd9b..c737bdc8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9016 +Version: 0.3.1.9017 Authors@R: c( person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")), From d778e8ed8f78e7d757f5cc047616908d7c5efcbf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 14 Feb 2024 15:03:40 +0100 Subject: [PATCH 259/267] ci: reusing workflows from admiralci --- .github/workflows/check-links.yml | 58 ------------------- .github/workflows/common.yaml | 68 +++++++++++++++++----- .github/workflows/lint.yaml | 48 --------------- .github/workflows/pkgdown.yaml | 36 ------------ .github/workflows/spellcheck.yml | 44 -------------- .github/workflows/style.yml | 87 ---------------------------- .github/workflows/test-coverage.yaml | 52 ----------------- .github/workflows/vbump.yaml | 15 ----- 8 files changed, 54 insertions(+), 354 deletions(-) delete mode 100644 .github/workflows/check-links.yml delete mode 100644 .github/workflows/lint.yaml delete mode 100644 .github/workflows/pkgdown.yaml delete mode 100644 .github/workflows/spellcheck.yml delete mode 100644 .github/workflows/style.yml delete mode 100644 .github/workflows/test-coverage.yaml delete mode 100644 .github/workflows/vbump.yaml diff --git a/.github/workflows/check-links.yml b/.github/workflows/check-links.yml deleted file mode 100644 index 515a0a52..00000000 --- a/.github/workflows/check-links.yml +++ /dev/null @@ -1,58 +0,0 @@ ---- -name: Check URLs 🔗 - -on: - # 'push' events are triggered when commits - # are pushed to one of these branches - push: - branches: - - main - tags: - - "v*" - # 'pull_request' events are triggered when PRs are - # created against one of these target branches. - pull_request: - types: - - opened - - synchronize - - reopened - - ready_for_review - branches: - - main - # 'workflow_dispatch' gives you the ability - # to run this workflow on demand, anytime - workflow_dispatch: - -concurrency: - group: links-${{ github.event.pull_request.number || github.ref }} - cancel-in-progress: true - -jobs: - links: - name: Validate Links 🕸️ - runs-on: ubuntu-latest - if: > - !contains(github.event.commits[0].message, '[skip links]') - steps: - - name: Checkout repository 🛎 - uses: actions/checkout@v4 - - - name: Check URLs in docs 📑 - uses: lycheeverse/lychee-action@v1.5.1 - with: - fail: true - jobSummary: true - format: markdown - output: links-results.md - args: >- - --exclude-private - --exclude "https://github.com.*.git|lycheeverse.*" - --verbose - --no-progress - **/*.md - **/*.html - **/*.Rmd - **/*.yaml - **/*.yml - env: - GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} diff --git a/.github/workflows/common.yaml b/.github/workflows/common.yaml index 7aaa324e..53fc550e 100644 --- a/.github/workflows/common.yaml +++ b/.github/workflows/common.yaml @@ -27,47 +27,87 @@ concurrency: group: common-${{ github.event.pull_request.number || github.ref }} cancel-in-progress: true +env: + R_VERSION: "release" + jobs: + # Get R version from environmental variable + # and use it in downstream jobs + get_r_version: + name: Get R version + runs-on: ubuntu-latest + outputs: + r-version: ${{ steps.get_r_version.outputs.R_VERSION }} + steps: + - name: Get R Version for Downstream Container Jobs + id: get_r_version + run: echo "R_VERSION=$R_VERSION" >> $GITHUB_OUTPUT + shell: bash + + # Test code coverage of R Package coverage: name: Code Coverage (admiral) uses: pharmaverse/admiralci/.github/workflows/code-coverage.yml@main if: > github.event_name != 'release' + needs: get_r_version with: - r-version: "release" + r-version: "${{ needs.get_r_version.outputs.r-version }}" # Whether to skip code coverage badge creation # Setting to 'false' will require you to create # an orphan branch called 'badges' in your repository skip-coverage-badges: true + + # Ensure that styling guidelines are followed style: name: Code Style (admiral) uses: pharmaverse/admiralci/.github/workflows/style.yml@main if: github.event_name == 'pull_request' + needs: get_r_version with: - r-version: "release" - - check_admiral: - name: Check (admiral) - uses: pharmaverse/admiralci/.github/workflows/r-cmd-check.yml@main - with: - error-on: warning # TODO: find a way to ignore specific notes - if: github.event_name == 'pull_request' + r-version: "${{ needs.get_r_version.outputs.r-version }}" - links_admiral: + # Ensure there are no broken URLs in the package documentation + links: name: Links (admiral) uses: pharmaverse/admiralci/.github/workflows/links.yml@main if: github.event_name == 'pull_request' - linter_admiral: + # Build the website and deploy to `gh-pages` branch + site: + name: Documentation + uses: pharmaverse/admiralci/.github/workflows/pkgdown.yml@main + if: github.event_name == 'push' || startsWith(github.ref, 'refs/tags/v') + needs: get_r_version + with: + r-version: "release" + skip-multiversion-docs: true + secrets: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + # Ensure there are no linter errors in the package + linter: name: Lint (admiral) uses: pharmaverse/admiralci/.github/workflows/lintr.yml@main if: github.event_name == 'pull_request' + needs: get_r_version with: - r-version: "release" + r-version: "${{ needs.get_r_version.outputs.r-version }}" - spellcheck_admiral: + # Ensure there are no spelling errors in the package + spellcheck: name: Spelling (admiral) uses: pharmaverse/admiralci/.github/workflows/spellcheck.yml@main if: github.event_name == 'pull_request' + needs: get_r_version with: - r-version: "release" + r-version: "${{ needs.get_r_version.outputs.r-version }}" + + # Bumps development version of the package + vbump: + name: Version Bump 🤜🤛 + if: github.event_name == 'push' + uses: insightsengineering/r.pkg.template/.github/workflows/version-bump.yaml@main + secrets: + REPO_GITHUB_TOKEN: ${{ secrets.REPO_GITHUB_TOKEN }} + diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml deleted file mode 100644 index 30166cf4..00000000 --- a/.github/workflows/lint.yaml +++ /dev/null @@ -1,48 +0,0 @@ ---- -# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples -# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help -name: Check Lint 🧹 - -on: - push: - branches: - - main - pull_request: - types: - - opened - - synchronize - - reopened - - ready_for_review - branches: - - main - workflow_dispatch: - -concurrency: - group: lint-${{ github.event.pull_request.number || github.ref }} - cancel-in-progress: true - -jobs: - lint: - runs-on: ubuntu-latest - if: > - !contains(github.event.commits[0].message, '[skip lint]') - env: - GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} - steps: - - name: Checkout repository 🛎 - uses: actions/checkout@v4 - - - name: Setup R 📊 - uses: r-lib/actions/setup-r@v2 - with: - use-public-rspm: true - - - uses: r-lib/actions/setup-r-dependencies@v2 - with: - extra-packages: any::lintr, local::. - - - name: Run Linter 👟 - run: lintr::lint_package() - shell: Rscript {0} - env: - LINTR_ERROR_ON_LINT: true diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml deleted file mode 100644 index 31219893..00000000 --- a/.github/workflows/pkgdown.yaml +++ /dev/null @@ -1,36 +0,0 @@ ---- -name: Deploy pkgdown site 📜 - -on: - # 'push' events are triggered when commits - # are pushed to one of these branches - push: - branches: - - main - -jobs: - pkgdown: - runs-on: macOS-latest - env: - GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} - steps: - - name: Checkout repository 🛎 - uses: actions/checkout@v4 - - - name: Setup R 📊 - uses: r-lib/actions/setup-r@v2 - - - name: Install Pandoc - uses: r-lib/actions/setup-pandoc@v2 - - - name: Install R package dependencies 📦 - uses: r-lib/actions/setup-r-dependencies@v2 - with: - extra-packages: any::pkgdown, local::. - needs: website - - - name: Deploy package ☁️ - run: | - git config --local user.email "actions@github.com" - git config --local user.name "GitHub Actions" - Rscript -e 'pkgdown::deploy_to_branch(new_process = FALSE)' diff --git a/.github/workflows/spellcheck.yml b/.github/workflows/spellcheck.yml deleted file mode 100644 index f5ad817a..00000000 --- a/.github/workflows/spellcheck.yml +++ /dev/null @@ -1,44 +0,0 @@ ---- -name: Check Spelling 🆎 - -on: - push: - branches: - - main - pull_request: - types: - - opened - - synchronize - - reopened - - ready_for_review - branches: - - main - workflow_dispatch: - -concurrency: - group: spelling-${{ github.event.pull_request.number || github.ref }} - cancel-in-progress: true - -jobs: - spelling: - name: Run Spellcheck 🔠 - runs-on: ubuntu-latest - if: > - !contains(github.event.commits[0].message, '[skip spellcheck]') - steps: - - name: Checkout repository 🛎 - uses: actions/checkout@v4 - - - name: Setup R 📊 - uses: r-lib/actions/setup-r@v2 - - - name: Install R package dependencies 📦 - uses: r-lib/actions/setup-r-dependencies@v2 - with: - extra-packages: any::spelling - - - name: Run Spellcheck 👟 - uses: insightsengineering/r-spellcheck-action@v3 - with: - exclude: data/* - additional_options: "" diff --git a/.github/workflows/style.yml b/.github/workflows/style.yml deleted file mode 100644 index 1c64c096..00000000 --- a/.github/workflows/style.yml +++ /dev/null @@ -1,87 +0,0 @@ ---- -name: Check Style 🎨 - -on: - # 'push' events are triggered when commits - # are pushed to one of these branches - push: - branches: - - main - tags: - - "v*" - # 'pull_request' events are triggered when PRs are - # created against one of these target branches. - pull_request: - types: - - opened - - synchronize - - reopened - - ready_for_review - branches: - - main - # 'workflow_dispatch' gives you the ability - # to run this workflow on demand, anytime - workflow_dispatch: - -concurrency: - group: style-${{ github.event.pull_request.number || github.ref }} - cancel-in-progress: true - -jobs: - style: - name: Check code style 🧑‍🎨 - runs-on: ubuntu-latest - if: > - !contains(github.event.commits[0].message, '[skip stylecheck]') - steps: - - uses: actions/checkout@v4 - with: - fetch-depth: 0 - - - name: Setup R 📊 - uses: r-lib/actions/setup-r@v2 - with: - use-public-rspm: true - - - name: Install R package dependencies 📦 - uses: r-lib/actions/setup-r-dependencies@v2 - with: - extra-packages: any::styler, any::roxygen2 - needs: styler - - - name: Enable styler cache - run: styler::cache_activate() - shell: Rscript {0} - - - name: Determine cache location - id: styler-location - run: | - cat( - "location=", - styler::cache_info(format = "tabular")$location, - "\n", - file = Sys.getenv("GITHUB_OUTPUT"), - append = TRUE, - sep = "" - ) - shell: Rscript {0} - - - name: Cache styler - uses: actions/cache@v4 - with: - path: ${{ steps.styler-location.outputs.location }} - key: ${{ runner.os }}-styler-${{ github.sha }} - restore-keys: | - ${{ runner.os }}-styler- - ${{ runner.os }}- - - - name: Run styler 🖼️ - run: | - detect <- styler::style_pkg(dry = "on") - if (any(detect$changed)) { - problems <- subset(detect$file, detect$changed == T) - cat(paste("Styling errors found in", length(problems), "files\n")) - cat("Please run `styler::style_pkg()` to fix the style\n") - quit(status = 1) - } - shell: Rscript {0} diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml deleted file mode 100644 index c06ffd57..00000000 --- a/.github/workflows/test-coverage.yaml +++ /dev/null @@ -1,52 +0,0 @@ -name: Check Test Coverage 🧪 - -on: - # 'push' events are triggered when commits - # are pushed to one of these branches - push: - branches: - - main - tags: - - "v*" - # 'pull_request' events are triggered when PRs are - # created against one of these target branches. - pull_request: - types: - - opened - - synchronize - - reopened - - ready_for_review - branches: - - main - # 'workflow_dispatch' gives you the ability - # to run this workflow on demand, anytime - workflow_dispatch: - -concurrency: - group: coverage-${{ github.event.pull_request.number || github.ref }} - cancel-in-progress: true - -jobs: - coverage: - name: Coverage 📔 - runs-on: ubuntu-latest - if: > - !contains(github.event.commits[0].message, '[skip coverage]') - env: - GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} - steps: - - name: Checkout repository 🛎 - uses: actions/checkout@v4 - - - name: Setup R 📊 - uses: r-lib/actions/setup-r@v2 - - - name: Install R package dependencies - uses: r-lib/actions/setup-r-dependencies@v2 - with: - # Necessary to avoid object usage linter errors. - extra-packages: local::., any::covr - - - name: Run Test coverage 👟 - run: covr::codecov() - shell: Rscript {0} diff --git a/.github/workflows/vbump.yaml b/.github/workflows/vbump.yaml deleted file mode 100644 index 11f9d4e5..00000000 --- a/.github/workflows/vbump.yaml +++ /dev/null @@ -1,15 +0,0 @@ ---- -name: Version Bump ⬆️ - -on: - push: - branches: - - main - -jobs: - vbump: - name: Version Bump 🤜🤛 - if: github.event_name == 'push' - uses: insightsengineering/r.pkg.template/.github/workflows/version-bump.yaml@main - secrets: - REPO_GITHUB_TOKEN: ${{ secrets.REPO_GITHUB_TOKEN }} From a82c4ac7f078b80498cf5efb621eac09f8ac162b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 14 Feb 2024 15:08:46 +0100 Subject: [PATCH 260/267] Trigger CI From 2ef251520ce1ef243303dccd23500004fb60c22b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 14 Feb 2024 15:23:19 +0100 Subject: [PATCH 261/267] revert deliberate errors --- R/messages.R | 17 ----------------- R/metadata.R | 2 -- man/length_log.Rd | 3 +-- 3 files changed, 1 insertion(+), 21 deletions(-) diff --git a/R/messages.R b/R/messages.R index 6d047318..50b4df7c 100644 --- a/R/messages.R +++ b/R/messages.R @@ -101,9 +101,6 @@ type_log <- function(meta_ordered, type_mismatch_ind, verbose) { #' Utility for Lengths #' -#' spellllling mistake -#' a [link](http://thisisarandompagethatdoesntexit.com) -#' #' @param miss_vars Variables missing from metadata #' @param verbose Provides additional messaging for user #' @@ -113,8 +110,6 @@ length_log <- function(miss_vars, verbose) { assert_character(miss_vars) assert_choice(verbose, choices = .internal_verbose_choices) - if ( length(miss_vars) > 0 ) { TRUE && stop("this should trigger lint and styler"); 1+ 1 } - if (length(miss_vars) > 0) { cli_h2("Variable lengths missing from metadata.") cli_alert_success("{ length(miss_vars) } lengths resolved") @@ -129,18 +124,6 @@ length_log <- function(miss_vars, verbose) { } } -#' @noRd -a_new_function <- function() { - "this is not tested" - 1+1 - 3+3 - 4+4 - 5+5 - 6+6 - 7+7 - "adding lines to make a dent on 100% test coverage" -} - #' Utility for Variable Labels #' #' @param miss_vars Missing variables in metadata diff --git a/R/metadata.R b/R/metadata.R index 075007ac..e6060ece 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -6,8 +6,6 @@ #' details on the format of the metadata, see the 'Metadata' section for each #' function in question. #' -#' changing docs without updating documentation -#' #' @inheritParams xportr_length #' #' @return `.df` dataset with metadata and domain attributes set diff --git a/man/length_log.Rd b/man/length_log.Rd index 20ee21fc..8b550292 100644 --- a/man/length_log.Rd +++ b/man/length_log.Rd @@ -15,6 +15,5 @@ length_log(miss_vars, verbose) Output to Console } \description{ -spellllling mistake -a \href{http://thisisarandompagethatdoesntexit.com}{link} +Utility for Lengths } From aa2cc1613c79c8f200e6c1a4a8791654b9dc2e80 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 14 Feb 2024 15:34:20 +0100 Subject: [PATCH 262/267] ci: remove admiral string that was helping identifying action on UI --- .github/workflows/common.yaml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/.github/workflows/common.yaml b/.github/workflows/common.yaml index 53fc550e..15c84c01 100644 --- a/.github/workflows/common.yaml +++ b/.github/workflows/common.yaml @@ -46,7 +46,7 @@ jobs: # Test code coverage of R Package coverage: - name: Code Coverage (admiral) + name: Code Coverage uses: pharmaverse/admiralci/.github/workflows/code-coverage.yml@main if: > github.event_name != 'release' @@ -60,7 +60,7 @@ jobs: # Ensure that styling guidelines are followed style: - name: Code Style (admiral) + name: Code Style uses: pharmaverse/admiralci/.github/workflows/style.yml@main if: github.event_name == 'pull_request' needs: get_r_version @@ -69,7 +69,7 @@ jobs: # Ensure there are no broken URLs in the package documentation links: - name: Links (admiral) + name: Links uses: pharmaverse/admiralci/.github/workflows/links.yml@main if: github.event_name == 'pull_request' @@ -87,7 +87,7 @@ jobs: # Ensure there are no linter errors in the package linter: - name: Lint (admiral) + name: Lint uses: pharmaverse/admiralci/.github/workflows/lintr.yml@main if: github.event_name == 'pull_request' needs: get_r_version @@ -96,7 +96,7 @@ jobs: # Ensure there are no spelling errors in the package spellcheck: - name: Spelling (admiral) + name: Spelling uses: pharmaverse/admiralci/.github/workflows/spellcheck.yml@main if: github.event_name == 'pull_request' needs: get_r_version From e4c6e72b707800d9ed9d11ab6927d1e9b8526398 Mon Sep 17 00:00:00 2001 From: bs832471 Date: Wed, 14 Feb 2024 16:08:40 +0000 Subject: [PATCH 263/267] chore: #221 update spelling --- inst/WORDLIST | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/inst/WORDLIST b/inst/WORDLIST index e7738dd7..5fcd3726 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -31,11 +31,21 @@ acrf adrg bootswatch chr +datetime deliverables df +durationdatetime +incompletedatetime +intervaldatetime iso magrittr metacore +num +partialdate +partialdatetime +partialtime +posixct +posixt pre repo sas From 0bea653904f99b62e30a55171b975024b3e9cc46 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 14 Feb 2024 18:14:57 +0100 Subject: [PATCH 264/267] corrects typo --- DESCRIPTION | 2 +- R/xportr.R | 2 +- inst/WORDLIST | 1 - man/metadata.Rd | 2 +- man/xportr-package.Rd | 1 - man/xportr.Rd | 2 +- man/xportr_df_label.Rd | 2 +- man/xportr_format.Rd | 2 +- man/xportr_label.Rd | 2 +- man/xportr_length.Rd | 2 +- man/xportr_order.Rd | 2 +- man/xportr_type.Rd | 2 +- man/xportr_write.Rd | 2 +- 13 files changed, 11 insertions(+), 13 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 03b411b3..6f58e829 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -55,4 +55,4 @@ Config/testthat/edition: 3 Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 diff --git a/R/xportr.R b/R/xportr.R index ed7c3ba1..003e5cce 100644 --- a/R/xportr.R +++ b/R/xportr.R @@ -2,7 +2,7 @@ #' #' @param .df A data frame of CDISC standard. #' @param var_metadata A data frame containing variable level metadata -#' @param domain Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset +#' @param domain Appropriate CDISC dataset name, e.g. ADAE, DM. Used to subset #' the metadata object. If none is passed, then name of the dataset passed as #' .df will be used. #' @param verbose The action this function takes when an action is taken on the diff --git a/inst/WORDLIST b/inst/WORDLIST index 5fcd3726..5c516068 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -5,7 +5,6 @@ AE Atorus BMI CDISC -CDSIC Codelist Completers DCREASCD diff --git a/man/metadata.Rd b/man/metadata.Rd index 30918a0c..9df1c6c8 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -12,7 +12,7 @@ xportr_metadata(.df, metadata = NULL, domain = NULL, verbose = NULL) \item{metadata}{A data frame containing variable level metadata. See 'Metadata' section for details.} -\item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset +\item{domain}{Appropriate CDISC dataset name, e.g. ADAE, DM. Used to subset the metadata object. If none is passed, then name of the dataset passed as .df will be used.} diff --git a/man/xportr-package.Rd b/man/xportr-package.Rd index 8f4327ff..2f38a255 100644 --- a/man/xportr-package.Rd +++ b/man/xportr-package.Rd @@ -3,7 +3,6 @@ \docType{package} \name{xportr-package} \alias{xportr-package} -\alias{_PACKAGE} \title{The \code{xportr} package} \description{ \code{xportr} is designed to be a clinical workflow friendly method for outputting diff --git a/man/xportr.Rd b/man/xportr.Rd index c810dae1..7e356559 100644 --- a/man/xportr.Rd +++ b/man/xportr.Rd @@ -21,7 +21,7 @@ xportr( \item{df_metadata}{A data frame containing dataset level metadata.} -\item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset +\item{domain}{Appropriate CDISC dataset name, e.g. ADAE, DM. Used to subset the metadata object. If none is passed, then name of the dataset passed as .df will be used.} diff --git a/man/xportr_df_label.Rd b/man/xportr_df_label.Rd index 691de990..5f95d771 100644 --- a/man/xportr_df_label.Rd +++ b/man/xportr_df_label.Rd @@ -12,7 +12,7 @@ xportr_df_label(.df, metadata = NULL, domain = NULL, metacore = deprecated()) \item{metadata}{A data frame containing dataset. See 'Metadata' section for details.} -\item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset +\item{domain}{Appropriate CDISC dataset name, e.g. ADAE, DM. Used to subset the metadata object. If none is passed, then name of the dataset passed as .df will be used.} diff --git a/man/xportr_format.Rd b/man/xportr_format.Rd index e085a345..0c00da1b 100644 --- a/man/xportr_format.Rd +++ b/man/xportr_format.Rd @@ -12,7 +12,7 @@ xportr_format(.df, metadata = NULL, domain = NULL, metacore = deprecated()) \item{metadata}{A data frame containing variable level metadata. See 'Metadata' section for details.} -\item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset +\item{domain}{Appropriate CDISC dataset name, e.g. ADAE, DM. Used to subset the metadata object. If none is passed, then name of the dataset passed as .df will be used.} diff --git a/man/xportr_label.Rd b/man/xportr_label.Rd index eb03df81..a61e0583 100644 --- a/man/xportr_label.Rd +++ b/man/xportr_label.Rd @@ -18,7 +18,7 @@ xportr_label( \item{metadata}{A data frame containing variable level metadata. See 'Metadata' section for details.} -\item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset +\item{domain}{Appropriate CDISC dataset name, e.g. ADAE, DM. Used to subset the metadata object. If none is passed, then name of the dataset passed as .df will be used.} diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index 8d034eb8..93425808 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -19,7 +19,7 @@ xportr_length( \item{metadata}{A data frame containing variable level metadata. See 'Metadata' section for details.} -\item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset +\item{domain}{Appropriate CDISC dataset name, e.g. ADAE, DM. Used to subset the metadata object. If none is passed, then name of the dataset passed as .df will be used.} diff --git a/man/xportr_order.Rd b/man/xportr_order.Rd index 26b87f42..03617d4f 100644 --- a/man/xportr_order.Rd +++ b/man/xportr_order.Rd @@ -18,7 +18,7 @@ xportr_order( \item{metadata}{A data frame containing variable level metadata. See 'Metadata' section for details.} -\item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset +\item{domain}{Appropriate CDISC dataset name, e.g. ADAE, DM. Used to subset the metadata object. If none is passed, then name of the dataset passed as .df will be used.} diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index 736fe0c6..05489fcf 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -18,7 +18,7 @@ xportr_type( \item{metadata}{A data frame containing variable level metadata. See 'Metadata' section for details.} -\item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset +\item{domain}{Appropriate CDISC dataset name, e.g. ADAE, DM. Used to subset the metadata object. If none is passed, then name of the dataset passed as .df will be used.} diff --git a/man/xportr_write.Rd b/man/xportr_write.Rd index c6bd4a1d..bde66844 100644 --- a/man/xportr_write.Rd +++ b/man/xportr_write.Rd @@ -22,7 +22,7 @@ used as \code{xpt} name.} \item{metadata}{A data frame containing dataset. See 'Metadata' section for details.} -\item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset +\item{domain}{Appropriate CDISC dataset name, e.g. ADAE, DM. Used to subset the metadata object. If none is passed, then name of the dataset passed as .df will be used.} From 87c212792c417882f571a6a50fdc62c6b0458d59 Mon Sep 17 00:00:00 2001 From: bms63 Date: Wed, 14 Feb 2024 17:44:23 +0000 Subject: [PATCH 265/267] [skip actions] Bump version to 0.3.1.9018 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6f58e829..a0b254df 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9017 +Version: 0.3.1.9018 Authors@R: c( person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")), From 1c9f556e2b2ef29a66e3dfc66836b30a65a1aafc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 15 Feb 2024 14:35:27 +0100 Subject: [PATCH 266/267] chore: correct error expectation and indentation --- tests/testthat/test-write.R | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index 7c263556..0517a462 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -81,7 +81,7 @@ test_that("xportr_write: expect error when file name is over 8 characters long", data_to_save(), withr::local_file(paste0(paste(letters[1:9], collapse = ""), ".xpt")) ), - "`\\.df` file name must be 8 characters or less\\." + "\\.df file name must be 8 characters or less\\." ) }) @@ -140,7 +140,8 @@ test_that("xportr_write: expect error when an xpt validation fails with strict_c expect_error( xportr_write( - local_data, withr::local_file("xyz.xpt"), + local_data, + withr::local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", @@ -159,7 +160,8 @@ test_that("xportr_write: expect warning when an xpt validation fails with strict expect_warning( xportr_write( - local_data, withr::local_file("xyz.xpt"), + local_data, + withr::local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", @@ -179,7 +181,8 @@ test_that("xportr_write: Capture errors by haven and report them as such", { expect_error( suppressWarnings( xportr_write( - local_data, withr::local_file("xyz.xpt"), + local_data, + withr::local_file("xyz.xpt"), domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", From 3f6c8db0c00425f69a2a2fb5457f3fe930a30b1a Mon Sep 17 00:00:00 2001 From: bms63 Date: Mon, 19 Feb 2024 13:23:10 +0000 Subject: [PATCH 267/267] [skip actions] Bump version to 0.3.1.9019 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index a0b254df..46da9b09 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.3.1.9018 +Version: 0.3.1.9019 Authors@R: c( person("Eli", "Miller", , "Eli.Miller@AtorusResearch.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-2127-9456")),