diff --git a/.Rbuildignore b/.Rbuildignore index b00c0003..cc5cc94a 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -20,3 +20,4 @@ ^dev$ ^advs\.xpt$ ^advs_Define-Excel-Spec_match_admiral\.xlsx +^cran-comments\.md$ diff --git a/.gitignore b/.gitignore index 18e4efa8..7bda4869 100644 --- a/.gitignore +++ b/.gitignore @@ -17,3 +17,4 @@ docs xportr.Rcheck/ xportr*.tar.gz xportr*.tgz +docs/* \ No newline at end of file diff --git a/DESCRIPTION b/DESCRIPTION index 47306124..1a3fd1fc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xportr Title: Utilities to Output CDISC SDTM/ADaM XPT Files -Version: 0.0.0.9001 +Version: 0.1.0 Authors@R: c( person(given = "Eli", @@ -11,8 +11,7 @@ Authors@R: person(given = "Vignesh ", family = "Thanikachalam", role = c("aut"), - email = "vignesh.x.thanikachalam@gsk.com", - comment = c(ORCID = "")), + email = "vignesh.x.thanikachalam@gsk.com"), person(given = "Ben", family = "Straub", email = "ben.x.straub@gsk.com", @@ -20,8 +19,7 @@ Authors@R: person(given = "Ross", family = "Didenko", email = "Ross.Didenko@AtorusResearch.com", - role = "aut", - comment = c(ORCID = "")), + role = "aut"), person(given = "Atorus/GSK JPT", role = "cph") ) @@ -30,7 +28,6 @@ URL: https://github.com/atorus-research/xportr BugReports: https://github.com/atorus-research/xportr/issues Imports: dplyr (>= 1.0.2), - tidyr, purrr (>= 0.3.4), stringr (>= 1.4.0), magrittr, @@ -59,7 +56,6 @@ Suggests: devtools, spelling, usethis, - styler, lintr, styler Config/testthat/edition: 3 diff --git a/R/.gitignore b/R/.gitignore deleted file mode 100644 index e222c50e..00000000 --- a/R/.gitignore +++ /dev/null @@ -1 +0,0 @@ -messages.R diff --git a/R/format.R b/R/format.R index 7d5478b5..c2ee7551 100644 --- a/R/format.R +++ b/R/format.R @@ -37,7 +37,7 @@ xportr_format <- function(.df, metacore, domain = NULL, verbose = getOption("xpo df_arg <- as_name(enexpr(.df)) if (!is.null(attr(.df, "_xportr.df_arg_"))) df_arg <- attr(.df, "_xportr.df_arg_") - else if(identical(df_arg, ".")){ + else if (identical(df_arg, ".")) { attr(.df, "_xportr.df_arg_") <- get_pipe_call() df_arg <- attr(.df, "_xportr.df_arg_") } @@ -50,12 +50,12 @@ xportr_format <- function(.df, metacore, domain = NULL, verbose = getOption("xpo df_arg <- domain %||% df_arg - if(!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain if (inherits(metacore, "Metacore")) metacore <- metacore$var_spec - if(domain_name %in% names(metacore)) { + if (domain_name %in% names(metacore)) { metadata <- metacore %>% dplyr::filter(!!sym(domain_name) == df_arg & !is.na(!!sym(format_name))) } else { diff --git a/R/globals.R b/R/globals.R deleted file mode 100644 index 3f4ea102..00000000 --- a/R/globals.R +++ /dev/null @@ -1,17 +0,0 @@ -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", - "stem", - "use_bundle", - "viable_start" -)) \ No newline at end of file diff --git a/R/label.R b/R/label.R index 1aaa4ace..c346823f 100644 --- a/R/label.R +++ b/R/label.R @@ -39,7 +39,7 @@ xportr_label <- function(.df, metacore, domain = NULL, df_arg <- as_name(enexpr(.df)) if (!is.null(attr(.df, "_xportr.df_arg_"))) df_arg <- attr(.df, "_xportr.df_arg_") - else if(identical(df_arg, ".")){ + else if (identical(df_arg, ".")) { attr(.df, "_xportr.df_arg_") <- get_pipe_call() df_arg <- attr(.df, "_xportr.df_arg_") } @@ -52,12 +52,12 @@ xportr_label <- function(.df, metacore, domain = NULL, df_arg <- domain %||% df_arg - if(!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain if (inherits(metacore, "Metacore")) metacore <- metacore$var_spec - if(domain_name %in% names(metacore)) { + if (domain_name %in% names(metacore)) { metadata <- metacore %>% dplyr::filter(!!sym(domain_name) == df_arg) } else { @@ -85,7 +85,7 @@ xportr_label <- function(.df, metacore, domain = NULL, } for (i in names(.df)) { - if(i %in% miss_vars) attr(.df[[i]], "label") <- "" + if (i %in% miss_vars) attr(.df[[i]], "label") <- "" else attr(.df[[i]], "label") <- label[[i]] } diff --git a/R/length.R b/R/length.R index 53ad21d1..2ed45027 100644 --- a/R/length.R +++ b/R/length.R @@ -37,7 +37,7 @@ xportr_length <- function(.df, metacore, domain = NULL, df_arg <- as_name(enexpr(.df)) if (!is.null(attr(.df, "_xportr.df_arg_"))) df_arg <- attr(.df, "_xportr.df_arg_") - else if(identical(df_arg, ".")){ + else if (identical(df_arg, ".")) { attr(.df, "_xportr.df_arg_") <- get_pipe_call() df_arg <- attr(.df, "_xportr.df_arg_") } @@ -50,12 +50,12 @@ xportr_length <- function(.df, metacore, domain = NULL, df_arg <- domain %||% df_arg - if(!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain if (inherits(metacore, "Metacore")) metacore <- metacore$var_spec - if(domain_name %in% names(metacore)){ + if (domain_name %in% names(metacore)) { metadata <- metacore %>% dplyr::filter(!!sym(domain_name) == df_arg) } else { diff --git a/R/messages.R b/R/messages.R index 3472c7ed..2dae3051 100644 --- a/R/messages.R +++ b/R/messages.R @@ -37,19 +37,19 @@ var_names_log <- function(tidy_names_df, verbose){ "' was renamed to '", renamed_var, "'")) # Message regarding number of variables that were renamed/ modified - num_renamed <-nrow(only_renames) + num_renamed <- nrow(only_renames) tot_num_vars <- nrow(tidy_names_df) message("\n") cli::cli_h2(paste0( num_renamed, " of ", tot_num_vars, " (", round(100*(num_renamed/tot_num_vars), 1), "%) variables were renamed")) # Message stating any renamed variables each original variable and it's new name - if(nrow(only_renames) > 0) message(paste0(paste(only_renames$renamed_msg, collapse = "\n"), "\n")) + if (nrow(only_renames) > 0) message(paste0(paste(only_renames$renamed_msg, collapse = "\n"), "\n")) # Message checking for duplicate variable names after renamed (Pretty sure # this is impossible) but good to have a check none-the-less. dups <- tidy_names_df %>% filter(renamed_n > 1) - if(nrow(dups) != 0) { + if (nrow(dups) != 0) { cli::cli_alert_danger( paste("Duplicate renamed term(s) were created. Consider creating dictionary terms for:", paste(unique(dups$renamed_var), collapse = ", ") @@ -67,7 +67,7 @@ var_names_log <- function(tidy_names_df, verbose){ #' @export type_log <- function(meta_ordered, type_mismatch_ind, verbose){ - if(length(type_mismatch_ind) > 0) { + if (length(type_mismatch_ind) > 0) { message <- glue( "Variable type(s) in dataframe don't match metadata: ", @@ -135,21 +135,7 @@ label_log <- function(miss_vars, verbose){ #' @export var_ord_msg <- function(moved_vars, verbose){ - # if (moved_vars > 0) { - # cli_alert_info(c( - # "I have orderd {ordered_vars} variables according to {vendor} {df1} Spec and moved {moved_vars} variables that were not in the {vendor} {df1} Spec to the end of {df1} dataset")) - # - # } else if (moved_vars == 0){ - # cli_alert_info(c( - # "Zero variables were ordered according to {vendor} {tab_model} {df1} Spec for {df1}")) - # } - # - # else { - # xportr_logger("Opps! Something went wrong...", type = "stop") - # } - - - if(moved_vars > 0){ + if (moved_vars > 0) { cli_h2("{ length(moved_vars) } variables not in spec and moved to end") message <- glue( "Variable reordered in `.df`: ", diff --git a/R/order.R b/R/order.R index 4ce8daa4..ee1c056b 100644 --- a/R/order.R +++ b/R/order.R @@ -19,7 +19,7 @@ xportr_order <- function(.df, metacore, domain = NULL, verbose = getOption("xpor df_arg <- as_name(enexpr(.df)) if (!is.null(attr(.df, "_xportr.df_arg_"))) df_arg <- attr(.df, "_xportr.df_arg_") - else if(identical(df_arg, ".")){ + else if (identical(df_arg, ".")) { attr(.df, "_xportr.df_arg_") <- get_pipe_call() df_arg <- attr(.df, "_xportr.df_arg_") } @@ -32,12 +32,12 @@ xportr_order <- function(.df, metacore, domain = NULL, verbose = getOption("xpor df_arg <- domain %||% df_arg - if(!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain if (inherits(metacore, "Metacore")) metacore <- metacore$ds_vars - if(domain_name %in% names(metacore)){ + if (domain_name %in% names(metacore)) { metadata <- metacore %>% dplyr::filter(!!sym(domain_name) == df_arg & !is.na(!!sym(order_name))) } else { diff --git a/R/type.R b/R/type.R index beea8c8d..b3c98740 100644 --- a/R/type.R +++ b/R/type.R @@ -49,19 +49,19 @@ xportr_type <- function(.df, metacore, domain = NULL, df_arg <- as_name(enexpr(.df)) if (!is.null(attr(.df, "_xportr.df_arg_"))) df_arg <- attr(.df, "_xportr.df_arg_") - else if(identical(df_arg, ".")){ + else if (identical(df_arg, ".")) { attr(.df, "_xportr.df_arg_") <- get_pipe_call() df_arg <- attr(.df, "_xportr.df_arg_") } domain <- domain %||% df_arg - if(!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## Pull out correct metadata - if("Metacore" %in% class(metacore)) metacore <- metacore$var_spec + if ("Metacore" %in% class(metacore)) metacore <- metacore$var_spec - if(domain_name %in% names(metacore)){ + if (domain_name %in% names(metacore)) { metacore <- metacore %>% filter(!!sym(domain_name) == domain) } @@ -95,8 +95,8 @@ xportr_type <- function(.df, metacore, domain = NULL, # Directly instead of something like map_dfc to preserve any attributes. walk2(correct_type, seq_along(correct_type), function(x, i, is_correct) { - if(!is_correct[i]) { - if(correct_type[i] %in% characterTypes) + if (!is_correct[i]) { + if (correct_type[i] %in% characterTypes) .df[[i]] <<- as.character(.df[[i]]) else .df[[i]] <<- as.numeric(.df[[i]]) } diff --git a/R/utils-xportr.R b/R/utils-xportr.R index 01b9028d..d787b2d1 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -91,15 +91,6 @@ xpt_validate <- function(data) { glue("{fmt_vars(names(types))} must have a valid type.")) } -# 3.2 Character datetime types -- - # chk_datetime <- types[which(toupper(stringr::str_sub(names(types), start = -3L)) == "DTC")] - # - # if (length(chk_datetime) > 0) { - # err_cnd <- c(err_cnd, - # glue("{fmt_vars(names(types))} must have a datetime related type.")) - # } - # - # err_cnd } extract_attr <- function(data, attr = c("label", "SASformat", "SAStype", "SASlength")) { @@ -154,19 +145,6 @@ get_pipe_call <- function() { trimws(strsplit(call_str, "%>%", fixed = TRUE)[[1]][[1]]) } -# get_pipe_call <- function() { -# call <- sys.call(sys.parent()) -# call2 <- sys.call(sys.parent() - 1L) -# -# if(grepl("\\.", as_label(call))) { -# res <- trimws(strsplit(as_label(call2), "%>%")[[1]][[1]]) -# } else { -# res <- as_label(f_lhs(call)) -# if(res == "NULL") res <- f_name(call) -# } -# res -# } - # Helper function to get the first class attribute first_class <- function(x) { characterTypes <- getOption("xportr.character_types") diff --git a/R/write.R b/R/write.R index 5c99cc65..b60d2c49 100644 --- a/R/write.R +++ b/R/write.R @@ -43,11 +43,6 @@ xportr_write <- function(.df, path, label = NULL) { attr(.df, "label") <- label } - - - # Rename variables if applicable, using default args - #if(tidy_names) colnames(.df) <- xportr_tidy_rename(original_varname = colnames(.df)) - checks <- xpt_validate(.df) @@ -55,8 +50,6 @@ xportr_write <- function(.df, path, label = NULL) { abort(c("The following validation failed:", checks)) } - - # `write.xport` supports only the class data.frame data <- as.data.frame(.df) write_xpt(data, path = path, version = 5, name = name) diff --git a/R/zzz.R b/R/zzz.R index 8dcd789e..ecbb1aea 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -18,7 +18,7 @@ xportr.order_name = "order" ) toset <- !(names(op.devtools) %in% names(op)) - if(any(toset)) options(op.devtools[toset]) + if (any(toset)) options(op.devtools[toset]) invisible() } \ No newline at end of file diff --git a/README.Rmd b/README.Rmd index cea2f28b..2e254b89 100644 --- a/README.Rmd +++ b/README.Rmd @@ -21,7 +21,7 @@ library(fontawesome) [](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://codecov.io/gh/atorus-research/xportr) +[](https://app.codecov.io/gh/atorus-research/xportr) [](https://github.com/atorus-research/xportr/blob/master/LICENSE) [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental-1) diff --git a/README.md b/README.md index 59659616..34895e84 100644 --- a/README.md +++ b/README.md @@ -8,7 +8,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://codecov.io/gh/atorus-research/xportr) +[](https://app.codecov.io/gh/atorus-research/xportr) [](https://github.com/atorus-research/xportr/blob/master/LICENSE) [![Lifecycle: experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental-1) diff --git a/cran-comments.md b/cran-comments.md new file mode 100644 index 00000000..dc9a0c23 --- /dev/null +++ b/cran-comments.md @@ -0,0 +1,26 @@ +## xportr 0.1.0 + + +Check Results: + No Errors or warnings + +### Notes: + + - New Submission + - Possibly misspelled words in DESCRIPTION. + +All words in description are common accronyms in industry: + + - ADaM - Analysis Dataset Model + - CDISC - Clinical Data Interchange Standards Consortium + - SDTM - Standard Data Tabulation Model + - XPT - SAS Transport File + +### Tested on: + + - RHub Check Windows, Fedora, Ubuntu + - Windows Latest + - MacOS Latest + - Ubuntu Oldrel-1 + - Ubuntu release + - Ubuntu Develop