diff --git a/.github/ISSUE_TEMPLATE/01_bug_report.yml b/.github/ISSUE_TEMPLATE/01_bug_report.yml new file mode 100644 index 00000000..c89cc92d --- /dev/null +++ b/.github/ISSUE_TEMPLATE/01_bug_report.yml @@ -0,0 +1,33 @@ +name: Bug Report +description: Something is not working correctly or is not working at all! +title: "Bug: " +labels: ["bug", "programming"] +body: + - type: markdown + attributes: + value: | + **Example:** Bug: xportr_format() does not assign SAS format for `DATE9.` metadata + - type: textarea + id: what-happened + attributes: + label: What happened? + description: Also tell us what were you expecting to happen before the bug? + placeholder: "A bug happened!" + validations: + required: true + - type: textarea + id: session-info + attributes: + label: Session Information + description: Use `sessionInfo()` in the R console to gather all the details of your environment when the bug happened. + placeholder: "Place the console output here" + validations: + required: false + - type: textarea + id: logs + attributes: + label: Reproducible Example + description: We love code that can reproduce the bug. Check out [reprex](https://reprex.tidyverse.org/articles/reprex-dos-and-donts.html) + placeholder: "Please give us as many details as you can! The faster we can recreate the bug, the faster we can get a fix in the works. Warning, Error Messages and Screenshots are also great." + validations: + required: false diff --git a/.github/ISSUE_TEMPLATE/02_feature_request.yml b/.github/ISSUE_TEMPLATE/02_feature_request.yml new file mode 100644 index 00000000..e0b2597d --- /dev/null +++ b/.github/ISSUE_TEMPLATE/02_feature_request.yml @@ -0,0 +1,41 @@ +name: Feature Request +description: Enchancement to xportr functionality +title: "Feature Request: " +labels: ["enhancement", "programming"] +body: + - type: markdown + attributes: + value: | + Thanks for taking the time to fill out this feature request! We love keeping xportr fresh! + - type: textarea + id: feature + attributes: + label: Feature Idea + description: Tell us your idea in as few words as possible + placeholder: "`xportr_validate` should do x, y and z" + validations: + required: true + - type: textarea + id: input + attributes: + label: Relevant Input + description: Can you provide what the inputs should look like? + placeholder: "What should the input look like? REMINDER: No patient level data or company sensitive information should be shared via this open public issue" + validations: + required: false + - type: textarea + id: output + attributes: + label: Relevant Output + description: Can you provide what the final output should look like? + placeholder: "What should the output look like? REMINDER: No patient level data or company sensitive information should be shared via this open public issue" + validations: + required: false + - type: textarea + id: code + attributes: + label: Reproducible Example/Pseudo Code + description: Can you provide a working example or a sketch of how the code should work? + placeholder: "We love example code and it will speed up the process! REMINDER: No patient level data or company sensitive information should be shared via this open public issue" + validations: + required: false diff --git a/.github/PULL_REQUEST_TEMPLATE/release.md b/.github/PULL_REQUEST_TEMPLATE/release.md new file mode 100644 index 00000000..d15938a3 --- /dev/null +++ b/.github/PULL_REQUEST_TEMPLATE/release.md @@ -0,0 +1,22 @@ +# 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 new file mode 100644 index 00000000..a4786bff --- /dev/null +++ b/.github/pull_request_template.md @@ -0,0 +1,30 @@ +### 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. + +### 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. + +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)_ + +### 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. +- [ ] 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. +- [ ] 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) +- [ ] 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! diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 07dea56d..16404107 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -14,7 +14,7 @@ jobs: steps: - uses: actions/checkout@v3 - - uses: r-lib/actions/setup-r@v1 + - uses: r-lib/actions/setup-r@v2 - uses: r-lib/actions/setup-pandoc@v1 diff --git a/.github/workflows/spellcheck.yml b/.github/workflows/spellcheck.yml index 353b9682..42c7e327 100644 --- a/.github/workflows/spellcheck.yml +++ b/.github/workflows/spellcheck.yml @@ -32,7 +32,7 @@ jobs: fetch-depth: 0 - name: Setup R 📊 - uses: r-lib/actions/setup-r@v1 + uses: r-lib/actions/setup-r@v2 with: r-version: 4.1.3 diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 0a44f49a..dadf5abe 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -18,7 +18,7 @@ jobs: steps: - uses: actions/checkout@v3 - - uses: r-lib/actions/setup-r@v1 + - uses: r-lib/actions/setup-r@v2 - uses: r-lib/actions/setup-pandoc@v1 diff --git a/NEWS.md b/NEWS.md index 203387c4..262e0907 100644 --- a/NEWS.md +++ b/NEWS.md @@ -11,6 +11,7 @@ * 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. ## Documentation diff --git a/R/metadata.R b/R/metadata.R index 6c4f14c0..1dc9d603 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -21,6 +21,7 @@ #' dataset = "test", #' variable = c("Subj", "Param", "Val", "NotUsed"), #' type = c("numeric", "character", "numeric", "character"), +#' format = NA, #' order = c(1, 3, 4, 2) #' ) #' diff --git a/R/type.R b/R/type.R index 4146ee64..8fc44875 100644 --- a/R/type.R +++ b/R/type.R @@ -21,7 +21,8 @@ #' metadata <- data.frame( #' dataset = "test", #' variable = c("Subj", "Param", "Val", "NotUsed"), -#' type = c("numeric", "character", "numeric", "character") +#' type = c("numeric", "character", "numeric", "character"), +#' format = NA #' ) #' #' .df <- data.frame( @@ -51,6 +52,7 @@ xportr_type <- function(.df, type_name <- getOption("xportr.type_name") characterTypes <- c(getOption("xportr.character_types"), "_character") numericTypes <- c(getOption("xportr.numeric_types"), "_numeric") + format_name <- getOption("xportr.format_name") ## Common section to detect domain from argument or pipes @@ -73,8 +75,9 @@ xportr_type <- function(.df, metadata <- metadata %>% filter(!!sym(domain_name) == domain) } - metadata <- metadata %>% - select(!!sym(variable_name), !!sym(type_name)) + + metacore <- metadata %>% + select(!!sym(variable_name), !!sym(type_name), !!sym(format_name)) # Common check for multiple variables name check_multiple_var_specs(metadata, variable_name) @@ -92,9 +95,13 @@ 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, "_numeric", type.x), + type.x = if_else(type.x %in% numericTypes | (grepl("DT$|DTM$|TM$", variable) & !is.na(format)), + "_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, "_character", 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) ) @@ -105,7 +112,6 @@ xportr_type <- function(.df, type_mismatch_ind <- which(meta_ordered$type.x != meta_ordered$type.y) 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) # Use the original variable iff metadata is missing that variable @@ -128,6 +134,5 @@ xportr_type <- function(.df, } }, is_correct ) - .df } diff --git a/R/utils-xportr.R b/R/utils-xportr.R index 1d3a60d8..91f2cb15 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -357,9 +357,8 @@ first_class <- function(x) { #' @param metadata A data frame containing variable level metadata. #' @param variable_name string with `getOption('xportr.variable_name')` #' @noRd -check_multiple_var_specs <- function( - metadata, - variable_name = getOption("xportr.variable_name")) { +check_multiple_var_specs <- function(metadata, + variable_name = getOption("xportr.variable_name")) { variable_len <- pluck(metadata, variable_name) %||% c() if (NROW(variable_len) != NROW(unique(variable_len))) { cli_alert_info( diff --git a/R/xportr-package.R b/R/xportr-package.R index 8efbbf5b..c65382cd 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -26,7 +26,8 @@ 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" + "renamed_n", "renamed_var", "use_bundle", "viable_start", "type.x", "type.y", + "variable" )) # The following block is used by usethis to automatically manage diff --git a/man/xportr_metadata.Rd b/man/xportr_metadata.Rd index f92c62b1..ca3ce819 100644 --- a/man/xportr_metadata.Rd +++ b/man/xportr_metadata.Rd @@ -31,6 +31,7 @@ metadata <- data.frame( dataset = "test", variable = c("Subj", "Param", "Val", "NotUsed"), type = c("numeric", "character", "numeric", "character"), + format = NA, order = c(1, 3, 4, 2) ) diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index ce22475c..f6b99be0 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -39,7 +39,8 @@ columns_meta is a data.frame with names "Variables", "Type" metadata <- data.frame( dataset = "test", variable = c("Subj", "Param", "Val", "NotUsed"), - type = c("numeric", "character", "numeric", "character") + type = c("numeric", "character", "numeric", "character"), + format = NA ) .df <- data.frame( diff --git a/tests/testthat/test-depreciation.R b/tests/testthat/test-depreciation.R index e2167849..b3295295 100644 --- a/tests/testthat/test-depreciation.R +++ b/tests/testthat/test-depreciation.R @@ -92,7 +92,8 @@ test_that("xportr_type: deprecated metacore argument still works and gives warni df_meta <- data.frame( dataset = "df", variable = c("Subj", "Param", "Val", "NotUsed"), - type = c("numeric", "character", "numeric", "character") + type = c("numeric", "character", "numeric", "character"), + format = NA ) df2 <- xportr_type(df, metacore = df_meta) diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index 2e4fdf62..2c2ccd86 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -45,7 +45,7 @@ test_that("xportr_length: Accepts valid domain names in metadata object", { test_that("xportr_length: CDISC data frame is being piped after another xportr function", { adsl <- minimal_table(30) metadata <- minimal_metadata( - dataset = TRUE, length = TRUE, type = TRUE, var_names = colnames(adsl) + dataset = TRUE, length = TRUE, type = TRUE, format = TRUE, var_names = colnames(adsl) ) # Setup temporary options with active verbose diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index b99034d4..541c14bb 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -1,7 +1,8 @@ meta_example <- data.frame( dataset = "df", variable = c("Subj", "Param", "Val", "NotUsed"), - type = c("numeric", "character", "numeric", "character") + type = c("numeric", "character", "numeric", "character"), + format = NA ) df <- data.frame( @@ -23,7 +24,8 @@ test_that("xportr_type: NAs are handled as expected", { meta_example <- data.frame( dataset = "df", variable = c("Subj", "Param", "Val", "NotUsed"), - type = c("numeric", "character", "numeric", "character") + type = c("numeric", "character", "numeric", "character"), + format = NA ) df2 <- xportr_type(df, meta_example) @@ -176,6 +178,63 @@ test_that("xportr_type: error when metadata is not set", { ) }) +test_that("xportr_type: date variables are not converted to numeric", { + df <- data.frame(RFICDT = as.Date("2017-03-30"), RFICDTM = as.POSIXct("2017-03-30")) + metacore_meta <- suppressWarnings( + metacore::metacore( + var_spec = data.frame( + variable = c("RFICDT", "RFICDTM"), + type = "integer", + label = c("RFICDT Label", "RFICDTM Label"), + length = c(1, 2), + common = NA_character_, + format = c("date9.", "datetime20.") + ) + ) + ) + expect_message( + { + processed_df <- xportr_type(df, metacore_meta) + }, + NA + ) + expect_equal(lapply(df, class), lapply(processed_df, class)) + expect_equal(df$RFICDT, processed_df$RFICDT) + expect_equal(df$RFICDTM, processed_df$RFICDTM) + + xportr_write(processed_df, file.path(tempdir(), "dfdates.xpt")) + df_xpt <- read_xpt(file.path(tempdir(), "dfdates.xpt")) + + expect_equal(lapply(df, class), lapply(df_xpt, class)) + expect_equal(df$RFICDT, df_xpt$RFICDT, ignore_attr = TRUE) + expect_equal(as.character(df$RFICDTM), as.character(df_xpt$RFICDTM), ignore_attr = TRUE) + + metadata <- data.frame( + dataset = c("adsl", "adsl", "adsl", "adsl"), + variable = c("USUBJID", "DMDTC", "RFICDT", "RFICDTM"), + type = c("text", "date", "integer", "integer"), + format = c(NA, NA, "date9.", "datetime15.") + ) + + adsl_original <- data.frame( + USUBJID = c("test1", "test2"), + DMDTC = c("2017-03-30", "2017-01-08"), + RFICDT = c("2017-03-30", "2017-01-08"), + RFICDTM = c("2017-03-30", "2017-01-08") + ) + + + adsl_original$RFICDT <- as.Date(adsl_original$RFICDT) + adsl_original$RFICDTM <- as.POSIXct(adsl_original$RFICDTM) + + expect_message(adsl_xpt2 <- adsl_original %>% + xportr_type(metadata), NA) + + attr(adsl_original, "_xportr.df_arg_") <- "adsl_original" + + expect_equal(adsl_original, adsl_xpt2) +}) + test_that("xportr_type: Gets warning when metadata has multiple rows with same variable", { # This test uses the (2) functions below to reduce code duplication # All `expect_*` are being called inside the functions