Merge pull request #139 from OuhscBbmc/dev

assert versions

DESCRIPTION

@@ -2,7 +2,7 @@ Package: OuhscMunge
 Title: Data Manipulation Operations
 Description: Data manipulation operations frequently used in OUHSC BBMC
     projects.
-Version: 0.2.0.9017
+Version: 1.0.0.9000
 Authors@R: person("Will", "Beasley", email="[email protected]", role=c("aut", "cre"),
     comment = c(ORCID = "0000-0002-5613-5006"))
 URL: https://github.com/OuhscBbmc/OuhscMunge, http://ouhsc.edu/bbmc/
@@ -36,4 +36,4 @@ Suggests:
 Encoding: UTF-8
 Language: en-US
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.0

NAMESPACE

@@ -2,6 +2,9 @@
 
 export(assert_non_na)
 export(assert_non_na_and_unique)
+export(assert_version_driver_sqlserver)
+export(assert_version_package)
+export(assert_version_r)
 export(clump_month_date)
 export(clump_week_date)
 export(column_class_headstart)

R/OuhscMunge-package.r

@@ -1,7 +1,6 @@
-#' OuhscMunge.
-#'
+#' @keywords internal
+"_PACKAGE"
 #' @name OuhscMunge
-#' @docType package
 #'
 #' @title Data manipulation operations frequently used in OUHSC BBMC projects. <http://www.ouhsc.edu/bbmc/>
 #'

R/assert-version.R

@@ -0,0 +1,192 @@
+#' @name assert_version
+#' @aliases
+#' assert_version_r
+#' assert_version_package
+#' assert_version_driver_sqlserver
+#' @title I that the local machine is using an acceptable version.
+#'
+#' @description Assert that the local machine is using a version that satisfies
+#' the minimum version specified.
+#'
+#' @param minimum A [package_version] or [character] that specifies
+#' the version of the software being examined
+#' (ie, R, a package, or an ODBC driver).
+#'
+#' @return An error if the minimum version is not met.
+#' If the local machine is using an acceptable version, an `invisible()` `TRUE`
+#' is returned.
+#'
+#' @note These functions help us assert the the local machine has an acceptable
+#' version of the software running.
+#'
+#' For [assert_version_r()], the current default value is "4.2.0" because
+#' it introduced the
+#' [placeholder](https://davidbudzynski.github.io/general/2022/04/23/r-native-placeholder.html)
+#' for the native pipe.  Future versions of OuhscMunge will likely increase
+#' the default value to keep pace with important developments to R.
+#'
+#' @author Will Beasley
+#'
+#' @examples
+#' # Check R
+#' assert_version_r("3.1.0")
+#' assert_version_r()
+#' # Fails:
+#' \dontrun{
+#' assert_version_r("99.1.0")
+#' }
+#'
+#' # Check packages
+#' assert_version_package("base", "3.1.0")
+#' assert_version_package("OuhscMunge", "0.1.0")
+#' # Fails:
+#' \dontrun{
+#' assert_version_package("base", "99.1.0")
+#' assert_version_package("OuhscMunge", "9.1.0")
+#' assert_version_package(
+#'   package_name      = "OuhscMunge",
+#'   minimum           = "9.1.0",
+#'   installation_code = 'remotes::install_github("OuhscBbmc/OuhscMunge")'
+#' )
+#' assert_version_package("OuhscMungeee", "9.1.0")
+#' }
+#'
+#' # Check ODBC driver version
+#' \dontrun{
+#' cnn <- DBI::dbConnect(odbc::odbc(), dsn = "dhs_waiver_eval_1")
+#' assert_version_driver_sqlserver(cnn, "3.1.0")
+#' # Fails: assert_version_driver_sqlserver(cnn, "99.1.0")
+#' DBI::dbDisconnect(cnn)
+#' }
+
+#' @export
+assert_version_r <- function(minimum = base::package_version("4.2.1")) {
+  checkmate::assert_vector(minimum, len = 1, any.missing = FALSE)
+  minimum <-
+    if (inherits(minimum, "package_version")) {
+      as.character(minimum)
+    } else if (inherits(minimum, "character")) {
+      # Make sure it can be recognized as a version
+      as.character(base::package_version(minimum))
+    } else {
+      stop("The value passed to `minimum` must inherit either from 'character' or `package_version`.")
+    }
+
+  current <- as.character(utils::packageVersion("base"))
+
+  comparison <-
+    utils::compareVersion(
+      current,
+      minimum
+    )
+
+  if (comparison < 0 ) {
+    "Your R version is too old.  It is %s, but needs to be at least %s.  Update it at <https://cloud.r-project.org>." |>
+      sprintf(
+        current,
+        minimum
+      ) |>
+      stop()
+  } else {
+    invisible(TRUE)
+  }
+}
+
+#' @export
+assert_version_package <- function(
+  package_name,
+  minimum,
+  installation_code = ""
+) {
+  checkmate::assert_character(package_name, len = 1, min.chars = 1, any.missing = FALSE)
+  checkmate::assert_vector(minimum, len = 1, any.missing = FALSE)
+  checkmate::assert_character(installation_code, len = 1, min.chars = 0, any.missing = FALSE)
+
+  package_is_installed <- requireNamespace(package_name, quietly = TRUE)
+
+  installation_message <-
+    if (1L <= nchar(installation_code)) {
+      "  Install the package with `%s`.  Afterwards, please restart the R session." |>
+        sprintf(installation_code)
+    } else {
+      "  Afterwards, please restart the R session."
+    }
+
+  if (!package_is_installed) {
+    "The package '%s' not installed.%s" |>
+      sprintf(package_name, installation_message) |>
+      stop()
+  }
+
+  minimum <-
+    if (inherits(minimum, "package_version")) {
+      as.character(minimum)
+    } else if (inherits(minimum, "character")) {
+      # Make sure it can be recognized as a version
+      as.character(base::package_version(minimum))
+    } else {
+      stop("The value passed to `minimum` must inherit either from 'character' or `package_version`.")
+    }
+
+  current <- as.character(utils::packageVersion(package_name))
+
+  comparison <-
+    utils::compareVersion(
+      current,
+      minimum
+    )
+
+  if (comparison < 0 ) {
+    "Your version of the `%s` package is too old.  It is %s, but needs to be at least %s.%s" |>
+      sprintf(
+        package_name,
+        current,
+        minimum,
+        installation_message
+      ) |>
+      stop()
+  } else {
+    invisible(TRUE)
+  }
+}
+
+#' @export
+assert_version_driver_sqlserver <- function(
+  connection,
+  minimum
+) { # nocov start
+  checkmate::assert_class(connection, "Microsoft SQL Server")
+  checkmate::assert_vector(minimum, len = 1, any.missing = FALSE)
+
+  installation_message <- "Please see the installation guidance at <https://ouhscbbmc.github.io/data-science-practices-1/workstation.html#workstation-odbc>."
+
+  minimum <-
+    if (inherits(minimum, "package_version")) {
+      as.character(minimum)
+    } else if (inherits(minimum, "character")) {
+      # Make sure it can be recognized as a version
+      as.character(base::package_version(minimum))
+    } else {
+      stop("The value passed to `minimum` must inherit either from 'character' or `package_version`.")
+    }
+
+  current <- connection@info$driver.version
+
+  comparison <-
+    utils::compareVersion(
+      current,
+      minimum
+    )
+
+  if (comparison < 0 ) {
+    "Your version of the driver is too old.  It is %s, but needs to be at least %s.%s" |>
+      sprintf(
+        current,
+        minimum,
+        installation_message
+      ) |>
+      stop()
+  } else {
+    invisible(TRUE)
+  }
+} # nocov end

R/package-janitor.R

@@ -101,7 +101,7 @@ package_janitor_remote <- function(
 
   # ---- tweak-data --------------------------------------------------------------
   missing_columns <- base::setdiff(required_columns, colnames(ds_packages))
-  if( length(missing_columns) > 0 )
+  if (1L <= length(missing_columns))
     stop(paste("The data.frame of the required packages is missing the following columns:", missing_columns))
 
   ds_install_from_cran    <- ds_packages[ds_packages$install &  ds_packages$on_cran, ]

R/readr-spec-aligned.R

@@ -29,7 +29,7 @@ readr_spec_aligned <- function(...) {
   # pattern <- "^[ ]+`?(.+?)`? = .+?(col_.+)\\\\.+$"
   pattern <- "^[ ]+`?(.+?)`? = (col_.+).*$"
   # pattern <- "^[ ]+(`?)(.+?)\\1 = (col_.+)$"
-  . <- NULL   # This is solely for the sake of avoiding the R CMD check error.
+  aligned <- . <- NULL   # This is solely for the sake of avoiding the R CMD check error.
 
   out <-
     readr::spec_csv(...) %>%
@@ -51,7 +51,7 @@ readr_spec_aligned <- function(...) {
       # Pad the left side before appending the right side.
       aligned = sprintf("  %-*s = readr::%s", .data$padding, .data$left, .data$right)
     ) %>%
-    dplyr::select(.data$aligned) %>%
+    dplyr::select(aligned) %>%
     # tibble::add_row(
     #   aligned = "col_types <- readr::cols_only(",
     #   .before = 1

R/retrieve-key-value.R

@@ -77,7 +77,6 @@ retrieve_key_value <- function(
       # query     <- DBI::dbSendQuery(channel, sql, immediate = FALSE)
       # bind      <- DBI::dbBind(query, list(project_name, key))
       # ds_value  <- DBI::dbFetch(query)
-
     }, finally = {
       # if (exists("query"))       DBI::dbClearResult(query)
       # if (exists("bind"))        DBI::dbClearResult(bind)

R/row.R

@@ -81,13 +81,13 @@
 
 #' @export
 row_sum <- function(
-    d,
-    columns_to_average        = character(0),
-    pattern                   = "",
-    new_column_name           = "row_sum",
-    threshold_proportion      = .75,
-    nonmissing_count_name     = NA_character_,
-    verbose                   = FALSE
+  d,
+  columns_to_average        = character(0),
+  pattern                   = "",
+  new_column_name           = "row_sum",
+  threshold_proportion      = .75,
+  nonmissing_count_name     = NA_character_,
+  verbose                   = FALSE
 ) {
   checkmate::assert_data_frame(d)
   checkmate::assert_character(columns_to_average  , any.missing = FALSE)
@@ -138,7 +138,9 @@ row_sum <- function(
         rowSums(
           dplyr::across(
             !!columns_to_average,
-            .fns = \(x) { !is.na(x) }
+            .fns = \(x) {
+              !is.na(x)
+            }
           )
         ),
       .nonmissing_proportion = .nonmissing_count / length(columns_to_average),

inst/WORDLIST

@@ -11,6 +11,7 @@ MIECHV
 NIGMS
 NSE
 ODBC
+ORCID
 OUHSC
 OuhscBbmc
 PatientDOB