(v1.6.0.9062) code consistency

R/aa_helper_functions.R

@@ -727,7 +727,7 @@ get_current_data <- function(arg_name, call) {
     }
   }
 
-  if (current_R_older_than(3.2)) {
+  if (getRversion() < "3.2") {
     # R-3.0 and R-3.1 do not have an `x` element in the call stack, rendering this function useless
     if (is.na(arg_name)) {
       # like in carbapenems() etc.
@@ -893,7 +893,7 @@ has_colour <- function() {
     if (Sys.getenv("RSTUDIO", "") == "") {
       return(FALSE)
     }
-    if ((cols <- Sys.getenv("RSTUDIO_CONSOLE_COLOR", "")) != "" && !is.na(as.numeric(cols))) {
+    if ((cols <- Sys.getenv("RSTUDIO_CONSOLE_COLOR", "")) != "" && !is.na(as.double(cols))) {
       return(TRUE)
     }
     tryCatch(get("isAvailable", envir = asNamespace("rstudioapi"))(), error = function(e) return(FALSE)) &&
@@ -1186,15 +1186,11 @@ percentage <- function(x, digits = NULL, ...) {
 }
 
 time_start_tracking <- function() {
-  pkg_env$time_start <- round(as.numeric(Sys.time()) * 1000)
+  pkg_env$time_start <- round(as.double(Sys.time()) * 1000)
 }
 
 time_track <- function(name = NULL) {
-  paste("(until now:", trimws(round(as.numeric(Sys.time()) * 1000) - pkg_env$time_start), "ms)")
-}
-
-current_R_older_than <- function(version) {
-  as.double(R.Version()$major) + (as.double(R.Version()$minor) / 10) < version
+  paste("(until now:", trimws(round(as.double(Sys.time()) * 1000) - pkg_env$time_start), "ms)")
 }
 
 # prevent dependency on package 'backports' ----
@@ -1245,7 +1241,7 @@ lengths <- function(x, use.names = TRUE) {
   vapply(x, length, FUN.VALUE = NA_integer_, USE.NAMES = use.names)
 }
 
-if (current_R_older_than(3.1)) {
+if (getRversion() < "3.1") {
   # R-3.0 does not contain these functions, set them here to prevent installation failure
   # (required for extension of the <mic> class)
   cospi <- function(...) 1

R/ab_class_selectors.R

@@ -25,11 +25,11 @@
 
 #' Antibiotic Class Selectors
 #' 
-#' These functions help to filter and select columns with antibiotic test results that are of a specific antibiotic class, without the need to define the columns or antibiotic abbreviations. \strong{\Sexpr{ifelse(as.double(R.Version()$major) + (as.double(R.Version()$minor) / 10) < 3.2, paste0("NOTE: THESE FUNCTIONS DO NOT WORK ON YOUR CURRENT R VERSION. These functions require R version 3.2 or later - you have ", R.version.string, "."), "")}}
+#' These functions help to filter and select columns with antibiotic test results that are of a specific antibiotic class, without the need to define the columns or antibiotic abbreviations. \strong{\Sexpr{ifelse(getRversion() < "3.2", paste0("NOTE: THESE FUNCTIONS DO NOT WORK ON YOUR CURRENT R VERSION. These functions require R version 3.2 or later - you have ", R.version.string, "."), "")}}
 #' @inheritSection lifecycle Stable Lifecycle
 #' @param ab_class an antimicrobial class, such as `"carbapenems"`. The columns `group`, `atc_group1` and `atc_group2` of the [antibiotics] data set will be searched (case-insensitive) for this value.
 #' @param only_rsi_columns a [logical] to indicate whether only columns of class `<rsi>` must be selected (defaults to `FALSE`), see [as.rsi()]
-#' @details \strong{\Sexpr{ifelse(as.double(R.Version()$major) + (as.double(R.Version()$minor) / 10) < 3.2, paste0("NOTE: THESE FUNCTIONS DO NOT WORK ON YOUR CURRENT R VERSION. These functions require R version 3.2 or later - you have ", R.version.string, "."), "")}}
+#' @details \strong{\Sexpr{ifelse(getRversion() < "3.2", paste0("NOTE: THESE FUNCTIONS DO NOT WORK ON YOUR CURRENT R VERSION. These functions require R version 3.2 or later - you have ", R.version.string, "."), "")}}
 #' 
 #' 
 #' These functions can be used in data set calls for selecting columns and filtering rows, see *Examples*. They support base R, but work more convenient in dplyr functions such as [`select()`][dplyr::select()], [`filter()`][dplyr::filter()] and [`summarise()`][dplyr::summarise()].
@@ -220,7 +220,7 @@ ab_selector <- function(ab_class,
   meet_criteria(function_name, allow_class = "character", has_length = 1, .call_depth = 1)
   meet_criteria(only_rsi_columns, allow_class = "logical", has_length = 1, .call_depth = 1)
   
-  if (current_R_older_than(3.2)) {
+  if (getRversion() < "3.2") {
     warning_("antibiotic class selectors such as ", function_name, 
              "() require R version 3.2 or later - you have ", R.version.string,
              call = FALSE)

R/age.R

@@ -75,11 +75,16 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
   # add decimals
   if (exact == TRUE) {
     # get dates of `x` when `x` would have the year of `reference`
-    x_in_reference_year <- as.POSIXlt(paste0(format(as.Date(reference), "%Y"), format(as.Date(x), "-%m-%d")))
+    x_in_reference_year <- as.POSIXlt(paste0(format(as.Date(reference), "%Y"),
+                                             format(as.Date(x), "-%m-%d")),
+                                      format = "%Y-%m-%d")
     # get differences in days
-    n_days_x_rest <- as.double(difftime(as.Date(reference), as.Date(x_in_reference_year), units = "days"))
+    n_days_x_rest <- as.double(difftime(as.Date(reference), 
+                                        as.Date(x_in_reference_year),
+                                        units = "days"))
     # get numbers of days the years of `reference` has for a reliable denominator
-    n_days_reference_year <- as.POSIXlt(paste0(format(as.Date(reference), "%Y"), "-12-31"))$yday + 1
+    n_days_reference_year <- as.POSIXlt(paste0(format(as.Date(reference), "%Y"), "-12-31"),
+                                        format = "%Y-%m-%d")$yday + 1
     # add decimal parts of year
     mod <- n_days_x_rest / n_days_reference_year
     # negative mods are cases where `x_in_reference_year` > `reference` - so 'add' a year
@@ -100,7 +105,11 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
     ages <- ages[!is.na(ages)]
   }
   
-  ages
+  if (exact == TRUE) {
+    as.double(ages)
+  } else {
+    as.integer(ages)
+  }
 }
 
 #' Split Ages into Age Groups

R/disk.R

@@ -85,7 +85,7 @@ as.disk <- function(x, na.rm = FALSE) {
                fixed = TRUE)
       x_clean <- gsub(remove, "", x, ignore.case = TRUE, fixed = fixed)
       # remove everything that is not a number or dot
-      as.numeric(gsub("[^0-9.]+", "", x_clean))
+      as.double(gsub("[^0-9.]+", "", x_clean))
     }
     
     # round up and make it an integer

R/pca.R

@@ -120,7 +120,7 @@ pca <- function(x,
   message_("Columns selected for PCA: ", vector_and(font_bold(colnames(pca_data), collapse = NULL), quotes = TRUE),
            ". Total observations available: ", nrow(pca_data), ".")
   
-  if (current_R_older_than(3.4)) {
+  if (getRversion() < "3.4.0") {
     # stats::prcomp prior to 3.4.0 does not have the 'rank.' argument
     pca_model <- prcomp(pca_data, retx = retx, center = center, scale. = scale., tol = tol)
   } else {