Updates for CRAN submission:

- Increment Version
- Remove tidyr from imports, never used
- Remove styler from suggests, duplicated
- Update URL for covr report, redirected
- Remove globals.R, covered in zzz.R
- Misc linting and removal of comments

.Rbuildignore

@@ -20,3 +20,4 @@
 ^dev$
 ^advs\.xpt$
 ^advs_Define-Excel-Spec_match_admiral\.xlsx
+^cran-comments\.md$

.gitignore

@@ -17,3 +17,4 @@ docs
 xportr.Rcheck/
 xportr*.tar.gz
 xportr*.tgz
+docs/*

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,17 +11,15 @@ 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", 
  role = "aut"),
  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

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 {

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]]
  }
 

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 {

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`: ",

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 {

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]])
  }

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")

R/write.R

@@ -43,20 +43,13 @@ 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)
 
  if (length(checks) > 0) {
  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)

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()
 }

README.Rmd

@@ -21,7 +21,7 @@ library(fontawesome)
 <!-- badges: start -->
 [<img src="https://img.shields.io/badge/Slack-RValidationHub-blue?style=flat&logo=slack">](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)
-[<img src="https://img.shields.io/codecov/c/github/atorus-research/xportr">](https://codecov.io/gh/atorus-research/xportr)
+[<img src="https://img.shields.io/codecov/c/github/atorus-research/xportr">](https://app.codecov.io/gh/atorus-research/xportr)
 [<img src="https://img.shields.io/badge/License-MIT-blue.svg">](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)
 <!-- badges: end -->

README.md

@@ -8,7 +8,7 @@
 [<img src="https://img.shields.io/badge/Slack-RValidationHub-blue?style=flat&logo=slack">](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)
-[<img src="https://img.shields.io/codecov/c/github/atorus-research/xportr">](https://codecov.io/gh/atorus-research/xportr)
+[<img src="https://img.shields.io/codecov/c/github/atorus-research/xportr">](https://app.codecov.io/gh/atorus-research/xportr)
 [<img src="https://img.shields.io/badge/License-MIT-blue.svg">](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)

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