update package coverage

Author: Karim-Mane

R/column_name_standardization.R

@@ -122,11 +122,7 @@ retrieve_column_names <- function(data, target_columns) {
     all_column_names <- report[["colnames"]]
     idx              <- match(target_columns, all_column_names[["before"]])
     new_names        <- c(new_names, all_column_names[["after"]][idx])
-  } else {
-    stop("Could not find the following column names: ",
-         toString(target_columns))
   }
 
-
   return(new_names)
 }

R/convert_numeric_to_date.R

@@ -36,7 +36,6 @@ convert_numeric_to_date <- function(data, target_columns, ref_date,
   target_columns <- get_target_column_names(data, target_columns, cols = NULL)
 
   if (is.character(ref_date)) {
-    stopifnot("Unrecognised column name" = ref_date %in% colnames(data))
     ref_date <- data[[ref_date]]
   }
 

R/convert_to_numeric.R

@@ -86,25 +86,3 @@ detect_to_numeric_columns <- function(scan_res) {
   }
   return(to_numeric)
 }
-
-#' Convert values in a character vector into numeric
-#'
-#' The conversion is only applied on non-missing and non-numeric values found
-#' from the input vector
-#'
-#' @param x a vector of type character or numeric
-#'
-#' @returns a vector of type numeric with the same length as the input vector
-#' @keywords internal
-#'
-to_numeric_convert <- function(x) {
-  if (is.numeric(x)) {
-    return(as.numeric(x))
-  }
-  xx                        <- suppressWarnings(as.numeric(x))
-  after_conversion_is_na    <- setdiff(which(is.na(xx)), which(is.na(x)))
-  x[after_conversion_is_na] <- unlist(lapply(x[after_conversion_is_na],
-                                             numberize::numberize,
-                                             lang = "en"))
-  return(as.numeric(x))
-}

R/standardize_subject_ids.R

@@ -94,7 +94,7 @@ check_subject_ids <- function(data,
     bad_rows     <- unique(bad_rows)
     tmp_report   <- data.frame(idx = bad_rows,
                                ids = data[[target_columns]][bad_rows])
-    bad_rows     <- paste(bad_rows, sep = ", ")
+    bad_rows     <- toString(bad_rows)
     warning("Detected incorrect subject ids at lines: ", bad_rows,
             "\nUse the correct_subject_ids() function to adjust them.\n",
             call. = FALSE)

inst/CITATION

@@ -19,5 +19,5 @@ bibentry(
   title   = paste0(meta$Package, ": ", gsub("[[:space:]]+", " ", meta$Title)),
   author  = author,
   year    = date,
-  url     = meta$URL
+  url     = paste0(meta$URL, "/")
 )

man/to_numeric_convert.Rd

@@ -35,6 +35,9 @@ standardize_subject_ids <- list(target_columns = "study_id",
                                 nchar          = 7L)
 to_numeric              <- list(target_columns = "sex",
                                 lang           = "en")
+check_date_sequence     <- list(
+  target_columns = c("date_first_pcr_positive_test", "date.of.admission")
+)
 params <- list(
   standardize_column_names = standardize_col_names,
   remove_constants         = list(cutoff = 1.0),
@@ -43,7 +46,8 @@ params <- list(
   standardize_dates        = standardize_dates,
   standardize_subject_ids  = standardize_subject_ids,
   to_numeric               = to_numeric,
-  dictionary               = test_dictionary
+  dictionary               = test_dictionary,
+  check_date_sequence      = check_date_sequence
 )
 
 test_that("clean_data works as expected", {

tests/testthat/test-clean_data.R

@@ -100,6 +100,16 @@ test_that("check_subject_ids sends a message when duplicated IDs are found", {
   )
 })
 
+test_that("check_subject_ids when the id column is numeric", {
+  data <- readRDS(system.file("extdata", "test_df.RDS", package = "cleanepi"))
+  data[["case_id"]] <- seq_len(nrow(data))
+  dat <- check_subject_ids(data           = data,
+                           target_columns = "case_id")
+  expect_s3_class(dat, "data.frame")
+  expect_false(identical(data, dat))
+  expect_true(nrow(data) == nrow(dat))
+})
+
 data <- readRDS(system.file("extdata", "test_df.RDS", package = "cleanepi"))
 test_that("check_subject_ids works when relying on the nchar argument", {
   dat <- check_subject_ids(data           = data,

tests/testthat/test-standardize_subject_ids.R

@@ -27,6 +27,20 @@ test_that("get_target_column_names works with
             expect_identical(target_columns, c("dateOfBirth", "sex"))
           })
 
+test_that("get_target_column_names works with
+          target_columns as a vector of numeric values", {
+            target_columns <- get_target_column_names(
+              data           = readRDS(system.file("extdata",
+                                                   "test_df.RDS",
+                                                   package = "cleanepi")),
+              target_columns = c(6L, 8L),
+              cols           = NULL
+            )
+            expect_type(target_columns, "character")
+            expect_length(target_columns, 2L)
+            expect_identical(target_columns, c("dateOfBirth", "sex"))
+          })
+
 test_that("get_target_column_names works with target_columns and cols", {
   target_columns <- get_target_column_names(
     data           = readRDS(system.file("extdata",