check fix

DESCRIPTION

@@ -27,7 +27,8 @@ Imports:
     stringr,
     tibble,
     tidyr,
-    tidyselect
+    tidyselect,
+    utils
 Suggests: 
     callr,
     crosstable,

NAMESPACE

@@ -22,6 +22,7 @@ export(read_trialmaster_example)
 export(reset_manual_correction)
 export(save_list)
 export(split_mixed_datasets)
+export(tibble)
 export(unify)
 importFrom(cli,cli_abort)
 importFrom(cli,cli_bullets)
@@ -81,10 +82,13 @@ importFrom(rlang,as_function)
 importFrom(rlang,caller_arg)
 importFrom(rlang,check_dots_empty)
 importFrom(rlang,check_installed)
+importFrom(rlang,current_env)
+importFrom(rlang,enquo)
 importFrom(rlang,is_error)
 importFrom(rlang,is_formula)
 importFrom(rlang,is_installed)
 importFrom(rlang,is_named)
+importFrom(rlang,quo_name)
 importFrom(rlang,set_names)
 importFrom(rlang,sym)
 importFrom(stats,na.omit)
@@ -111,3 +115,5 @@ importFrom(tidyselect,everything)
 importFrom(tidyselect,last_col)
 importFrom(tidyselect,matches)
 importFrom(tidyselect,where)
+importFrom(utils,head)
+importFrom(utils,object.size)

R/helpers.R

@@ -123,6 +123,7 @@ load_list = function(x, env=parent.frame(), remove=TRUE){
 #' @param verbose whether to print informations (once)
 #'
 #' @return nothing, used for side effects
+#' @importFrom rlang enquo quo_name set_names
 #' @export
 #'
 #' @examples
@@ -172,7 +173,7 @@ manual_correction = function(data, col, rows, wrong, correct,
                                      i="New: {correct}"))
     data[[col]][rows] = correct
     assign(data_name, data, envir=parent.frame())
-    options(setNames(list(TRUE), opt_key))
+    options(set_names(list(TRUE), opt_key))
   } else if(all(is.na(val)) && !all(is.na(wrong))) {
     if(isTRUE(verbose)) cli_warn("Manual correction of {.val {label}}: nothing done (NA)")
     return(invisible(TRUE))
@@ -189,7 +190,6 @@ manual_correction = function(data, col, rows, wrong, correct,
 #'
 #' @param x the subject ID column to check
 #' @param ref the reference for subject ID. Should usually be set through `options(edc_subjid_ref=xxx)`. See example.
-#' @param lookup the lookup table, 
 #'
 #' @return nothing, called for warnings
 #' @export
@@ -226,6 +226,8 @@ check_subjid = function(x, ref=getOption("edc_subjid_ref")){
 #'
 #' @return the `df` dataset, unchanged
 #' @importFrom cli qty
+#' @importFrom rlang current_env
+#' @importFrom utils head
 #' @export
 #'
 #' @examples
@@ -238,8 +240,13 @@ assert_no_duplicate = function(df, id_col=get_key_cols()){
   if(is.list(id_col)) id_col = id_col$patient_id
   env = current_env()
   x = df %>% select(any_of2(id_col))
+  if(ncol(x)==0){
+    cli_abort("Cannot assert the absence of duplicates: no ID column ({.val {id_col}}).", 
+              call=env, class="edcimport_assert_no_duplicate_no_col")
+  }
+
   y = x %>% map(duplicated) %>% head(1) #y is scalar
-  if(length(y)>0){
+  if(any(unlist(y))){
     dups = x[[1]][unlist(y)] %>% unique() %>% sort() 
     dups = head(dups, 10) #because of https://github.com/r-lib/cli/issues/617
     cli_abort("Duplicate on column {.val { names(y)}} for {qty(length(dups))} value{?s} {.val {dups}}.", 
@@ -301,6 +308,7 @@ get_lookup = function(data_list){
 
 
 #' @rdname get_lookup
+#' @usage NULL
 set_lookup = function(lookup){
   if(!is.null(getOption("edc_lookup", NULL))){
     cli_warn("Option {.val edc_lookup} has been overwritten.", 

R/reexport.R

@@ -2,3 +2,7 @@
 #' @importFrom dplyr %>%
 #' @export
 dplyr::`%>%`
+
+#' @importFrom tibble tibble
+#' @export
+tibble::tibble

R/trialmaster.R

@@ -6,19 +6,20 @@
 #' If `7zip` is not installed or available, use [read_tm_all_xpt()] instead.
 #'
 #' @param archive \[`character(1)`]\cr the path to the archive
-#' @param use_cache \[`mixed(1)`: \sQuote{TRUE}]\cr controls the `.rds` cache. If `TRUE`, read the cache if any or extract the archive and create a cache. If `FALSE` extract the archive without creating a cache file. Can also be `"read"` or `"write"`
+#' @param use_cache \[`mixed(1)`: "write"]\cr controls the `.rds` cache. If `TRUE`, read the cache if any or extract the archive and create a cache. If `FALSE` extract the archive without creating a cache file. Can also be `"read"` or `"write"`.
 #' @param pw \[`character(1)`]\cr The password if the archive is protected. To avoid writing passwords in plain text, it is probably better to use `options(trialmaster_pw="xxx")` instead though.
-#' @param verbose \[`logical(1)`]\cr one of `c(0, 1, 2)`. The higher, the more information will be printed.
 #' @param ... unused
 #'
 #' @inherit read_tm_all_xpt return
 #' @inheritParams read_tm_all_xpt
+#' 
 #' @export
 #' @importFrom cli cli_abort cli_inform cli_warn
 #' @importFrom glue glue
 #' @importFrom rlang check_dots_empty
 #' @importFrom stringr str_remove
 read_trialmaster = function(archive, ..., use_cache=FALSE, 
+#' @importFrom utils object.size
                             clean_names_fun=NULL,
                             split_mixed=FALSE,
                             extend_lookup=TRUE,
@@ -102,6 +103,7 @@ read_trialmaster = function(archive, ..., use_cache=FALSE,
 #' @param split_mixed \[`logical(1): FALSE`]\cr whether to split mixed datasets. See [split_mixed_datasets]. 
 #' @param extend_lookup \[`character(1): FALSE`]\cr whether to enrich the lookup table. See [extend_lookup].
 #' @param clean_names_fun \[`function`]\cr a function to clean column names, e.g. [janitor::clean_names()]
+#' @param verbose \[`logical(1)`]\cr one of `c(0, 1, 2)`. The higher, the more information will be printed.
 #' @param key_columns deprecated
 #'
 #' @return a list containing one dataframe for each `.xpt` file in the folder, the extraction date (`datetime_extraction`), and a summary of all imported tables (`.lookup`). If not set yet, option `edc_lookup` is automatically set to `.lookup`.

R/utils.R

@@ -108,14 +108,12 @@ is_invalid_utf8 = function(x){
 
 #' @noRd
 #' @keywords internal
-check_invalid_utf8 = function(lookup=.lookup, warn=FALSE){
+check_invalid_utf8 = function(lookup=getOption("edc_lookup"), warn=FALSE){
+  stopifnot(!is.null(lookup))
   x = lookup %>% 
     arrange(desc(nrow)) %>% 
     unnest(c(names, labels)) %>% 
-    mutate(
-      invalid=is_invalid_utf8(labels)
-    ) %>% 
-    filter(invalid) %>% 
+    filter(is_invalid_utf8(labels)) %>% 
     mutate(
       dataset, names, labels, 
       valid_labels=iconv(labels, to="UTF-8"),