(v2.1.1.9136) console colours, updated Suggests, added as.ab() improvement

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 2.1.1.9135
+Version: 2.1.1.9136
-Date: 2025-01-28
+Date: 2025-01-31
 Title: Antimicrobial Resistance Data Analysis
 Description: Functions to simplify and standardise antimicrobial resistance (AMR)
   data analysis and to work with microbial and antimicrobial properties by
@@ -36,14 +36,18 @@ Depends: R (>= 3.0.0)
 Suggests: 
   cleaner,
   cli,
+  crayon,
   curl,
   data.table,
   dplyr,
   ggplot2,
   knitr,
+  openxlsx,
+  pillar,
   progress,
   readxl,
   rmarkdown,
+  rstudioapi,
   rvest,
   skimr,
   testthat,

NEWS.md

@@ -1,4 +1,4 @@
-# AMR 2.1.1.9135
+# AMR 2.1.1.9136
 
 *(this beta version will eventually become v3.0. We're happy to reach a new major milestone soon, which will be all about the new One Health support! Install this beta using [the instructions here](https://msberends.github.io/AMR/#latest-development-version).)*
 
@@ -85,6 +85,7 @@ This package now supports not only tools for AMR data analysis in clinical setti
 * MDRO determination (using `mdro()`)
   * Implemented the new Dutch national MDRO guideline (SRI-richtlijn BRMO, Nov 2024)
   * Added arguments `esbl`, `carbapenemase`, `mecA`, `mecC`, `vanA`, `vanB` to denote column names or logical values indicating presence of these genes (or production of their proteins)
+* Added console colours support of `sir` class for Positron
 
 ## Other
 * Added Dr. Larisse Bolton as contributor for her fantastic implementation of WISCA in a mathematically solid way

PythonPackage/AMR/AMR.egg-info/PKG-INFO

@@ -1,6 +1,6 @@
 Metadata-Version: 2.2
 Name: AMR
-Version: 2.1.1.9135
+Version: 2.1.1.9136
 Summary: A Python wrapper for the AMR R package
 Home-page: https://github.com/msberends/AMR
 Author: Matthijs Berends

PythonPackage/AMR/setup.py

@@ -2,7 +2,7 @@ from setuptools import setup, find_packages
 
 setup(
     name='AMR',
-    version='2.1.1.9135',
+    version='2.1.1.9136',
     packages=find_packages(),
     install_requires=[
         'rpy2',

R/aa_helper_functions.R

@@ -1169,57 +1169,12 @@ message_not_thrown_before <- function(fn, ..., entire_session = FALSE) {
 }
 
 has_colour <- function() {
-  # this is a base R version of crayon::has_color, but disables colours on emacs
-
   if (Sys.getenv("EMACS") != "" || Sys.getenv("INSIDE_EMACS") != "") {
     # disable on emacs, which only supports 8 colours
     return(FALSE)
   }
-  enabled <- getOption("crayon.enabled")
+  has_color <- import_fn("has_color", "crayon")
-  if (!is.null(enabled)) {
+  !is.null(has_color) && isTRUE(has_color())
-    return(isTRUE(enabled))
-  }
-  rstudio_with_ansi_support <- function(x) {
-    if (Sys.getenv("RSTUDIO", "") == "") {
-      return(FALSE)
-    }
-    if ((cols <- Sys.getenv("RSTUDIO_CONSOLE_COLOR", "")) != "" && !is.na(as.double(cols))) {
-      return(TRUE)
-    }
-    tryCatch(getExportedValue("isAvailable", ns = asNamespace("rstudioapi"))(), error = function(e) {
-      return(FALSE)
-    }) &&
-      tryCatch(getExportedValue("hasFun", ns = asNamespace("rstudioapi"))("getConsoleHasColor"), error = function(e) {
-        return(FALSE)
-      })
-  }
-  if (rstudio_with_ansi_support() && sink.number() == 0) {
-    return(TRUE)
-  }
-  if (!isatty(stdout())) {
-    return(FALSE)
-  }
-  if (tolower(Sys.info()["sysname"]) == "windows") {
-    if (Sys.getenv("ConEmuANSI") == "ON") {
-      return(TRUE)
-    }
-    if (Sys.getenv("CMDER_ROOT") != "") {
-      return(TRUE)
-    }
-    return(FALSE)
-  }
-  if ("COLORTERM" %in% names(Sys.getenv())) {
-    return(TRUE)
-  }
-  if (Sys.getenv("TERM") == "dumb") {
-    return(FALSE)
-  }
-  grepl(
-    pattern = "^screen|^xterm|^vt100|color|ansi|cygwin|linux",
-    x = Sys.getenv("TERM"),
-    ignore.case = TRUE,
-    perl = TRUE
-  )
 }
 
 # set colours if console has_colour()

R/ab.R

@@ -343,6 +343,40 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
         }
       }
       
+      # reverse a combination, e.g. clavulanic acid/amoxicillin
+      if (x[i] %like% " ") {
+        split <- strsplit(x[i], " ")[[1]]
+        permute <- function(x) {
+          if (length(x) == 1) return(list(x))
+          result <- vector("list", factorial(length(x)))
+          index <- 1
+          for (i in seq_along(x)) {
+            sub_perms <- permute(x[-i])  # Recursively get permutations of remaining elements
+            for (sub in sub_perms) {
+              result[[index]] <- c(x[i], sub)
+              index <- index + 1
+            }
+          }
+          return(result)
+        }
+        permutations <- permute(split)
+        found_perms <- character(length(permutations))
+        for (s in seq_len(length(permutations))) {
+          concat <- paste0(permutations[[s]], collapse = " ")
+          if (concat %in% AMR_env$AB_lookup$generalised_name) {
+            found_perms[s] <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$generalised_name == concat), "ab", drop = TRUE]
+          } else {
+            found_perms[s] <- suppressWarnings(as.ab(concat, loop_time = loop_time + 2))
+          }
+        }
+        found_perms <- found_perms[!is.na(found_perms)]
+        if (length(found_perms) > 0) {
+          found <- found_perms[order(nchar(found_perms), decreasing = TRUE)][1]
+          x_new[i] <- note_if_more_than_one_found(found, i, from_text)
+          next
+        }
+      }
+
       # transform back from other languages and try again
       x_translated <- paste(
         lapply(

R/mo.R

@@ -340,17 +340,17 @@ as.mo <- function(x,
         filtr <- which(MO_lookup_current$full_first %like_case% first_chars)
       } else if (nchar(x_out) == 3) {
         # no space and 3 characters - probably a code such as SAU or ECO
-        msg <<- c(msg, paste0("Input \"", x_search, "\" was assumed to be a microorganism code - tried to match on \"", totitle(substr(x_out, 1, 1)), AMR_env$dots, " ", substr(x_out, 2, 3), AMR_env$dots, "\""))
+        msg <<- c(msg, paste0("Input \"", x_search, "\" was assumed to be a microorganism code - tried to match on \"", totitle(substr(x_out, 1, 1)), AMR_env$ellipsis_icon, " ", substr(x_out, 2, 3), AMR_env$ellipsis_icon, "\""))
         filtr <- which(MO_lookup_current$fullname_lower %like_case% paste0("(^| )", substr(x_out, 1, 1), ".* ", substr(x_out, 2, 3)))
       } else if (nchar(x_out) == 4) {
         # no space and 4 characters - probably a code such as STAU or ESCO
-        msg <<- c(msg, paste0("Input \"", x_search, "\" was assumed to be a microorganism code - tried to match on \"", totitle(substr(x_out, 1, 2)), AMR_env$dots, " ", substr(x_out, 3, 4), AMR_env$dots, "\""))
+        msg <<- c(msg, paste0("Input \"", x_search, "\" was assumed to be a microorganism code - tried to match on \"", totitle(substr(x_out, 1, 2)), AMR_env$ellipsis_icon, " ", substr(x_out, 3, 4), AMR_env$ellipsis_icon, "\""))
         filtr <- which(MO_lookup_current$fullname_lower %like_case% paste0("(^| )", substr(x_out, 1, 2), ".* ", substr(x_out, 3, 4)))
       } else if (nchar(x_out) <= 6) {
         # no space and 5-6 characters - probably a code such as STAAUR or ESCCOL
         first_part <- paste0(substr(x_out, 1, 2), "[a-z]*", substr(x_out, 3, 3))
         second_part <- substr(x_out, 4, nchar(x_out))
-        msg <<- c(msg, paste0("Input \"", x_search, "\" was assumed to be a microorganism code - tried to match on \"", gsub("[a-z]*", AMR_env$dots, totitle(first_part), fixed = TRUE), " ", second_part, AMR_env$dots, "\""))
+        msg <<- c(msg, paste0("Input \"", x_search, "\" was assumed to be a microorganism code - tried to match on \"", gsub("[a-z]*", AMR_env$ellipsis_icon, totitle(first_part), fixed = TRUE), " ", second_part, AMR_env$ellipsis_icon, "\""))
         filtr <- which(MO_lookup_current$fullname_lower %like_case% paste0("(^| )", first_part, ".* ", second_part))
       } else {
         # for genus or species or subspecies

R/zzz.R

@@ -82,15 +82,15 @@ AMR_env$chmatch <- import_fn("chmatch", "data.table", error_on_fail = FALSE)
 AMR_env$chin <- import_fn("%chin%", "data.table", error_on_fail = FALSE)
 
 # take cli symbols and error function if available
-AMR_env$info_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$info %or% "i"
 AMR_env$bullet_icon   <- import_fn("symbol", "cli", error_on_fail = FALSE)$bullet %or% "*"
+AMR_env$ellipsis_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$ellipsis %or% "..."
+AMR_env$info_icon     <- import_fn("symbol", "cli", error_on_fail = FALSE)$info %or% "i"
+AMR_env$sup_1_icon    <- import_fn("symbol", "cli", error_on_fail = FALSE)$sup_1 %or% "*"
+
+AMR_env$cli_abort <- import_fn("cli_abort", "cli", error_on_fail = FALSE)
 
 AMR_env$cross_icon <- if (isTRUE(base::l10n_info()$`UTF-8`)) "\u00d7" else "x"
 
-AMR_env$dots <- import_fn("symbol", "cli", error_on_fail = FALSE)$ellipsis %or% "..."
-AMR_env$sup_1_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$sup_1 %or% "*"
-AMR_env$cli_abort <- import_fn("cli_abort", "cli", error_on_fail = FALSE)
-
 .onLoad <- function(lib, pkg) {
   # Support for tibble headers (type_sum) and tibble columns content (pillar_shaft)
   # without the need to depend on other packages. This was suggested by the

data-raw/gpt_training_text_v2.1.1.9136.txt

@@ -1,6 +1,6 @@
 This knowledge base contains all context you must know about the AMR package for R. You are a GPT trained to be an assistant for the AMR package in R. You are an incredible R specialist, especially trained in this package and in the tidyverse.
 
-First and foremost, you are trained on version 2.1.1.9135. Remember this whenever someone asks which AMR package version you’re at.
+First and foremost, you are trained on version 2.1.1.9136. Remember this whenever someone asks which AMR package version you’re at.
 
 Below are the contents of the  file, the  file, and all the  files (documentation) in the package. Every file content is split using 100 hypens.
 ----------------------------------------------------------------------------------------------------

tests/testthat/test-zzz.R

@@ -34,10 +34,17 @@
 import_functions <- c(
   "%chin%" = "data.table",
   "anti_join" = "dplyr",
+  "as.data.table" = "data.table",
+  "as_tibble" = "tibble",
   "chmatch" = "data.table",
   "cli_abort" = "cli",
   "cur_column" = "dplyr",
+  "cur_group" = "dplyr",
+  "document_position" = "rstudioapi",
+  "document_range" = "rstudioapi",
   "full_join" = "dplyr",
+  "getActiveDocumentContext" = "rstudioapi",
+  "has_color" = "crayon",
   "has_internet" = "curl",
   "html_attr" = "rvest",
   "html_children" = "rvest",
@@ -48,26 +55,28 @@ import_functions <- c(
   "inner_join" = "dplyr",
   "insertText" = "rstudioapi",
   "left_join" = "dplyr",
+  "modifyRange" = "rstudioapi",
   "new_pillar_shaft_simple" = "pillar",
   "progress_bar" = "progress",
   "read_html" = "xml2",
   "right_join" = "dplyr",
   "semi_join" = "dplyr",
-  "showQuestion" = "rstudioapi"
+  "showQuestion" = "rstudioapi",
+  "symbol" = "cli",
+  "tibble" = "tibble",
+  "write.xlsx" = "openxlsx"
 )
 
 # functions that are called directly with ::
 call_functions <- c(
   # cleaner
+  "freq" = "cleaner",
   "freq.default" = "cleaner",
+  "percentage" = "cleaner",
   # cli
   "symbol" = "cli",
-  "ansi_has_hyperlink_support" = "cli",
+  # curl
-  # rstudioapi (RStudio)
+  "has_internet" = "curl",
-  "isAvailable" = "rstudioapi",
-  "versionInfo" = "rstudioapi",
-  # readxl
-  "read_excel" = "readxl",
   # ggplot2
   "aes" = "ggplot2",
   "arrow" = "ggplot2",
@@ -77,6 +86,8 @@ call_functions <- c(
   "element_text" = "ggplot2",
   "expand_limits" = "ggplot2",
   "facet_wrap" = "ggplot2",
+  "fortify" = "ggplot2",
+  "geom_col" = "ggplot2",
   "geom_errorbar" = "ggplot2",
   "geom_path" = "ggplot2",
   "geom_point" = "ggplot2",
@@ -85,10 +96,10 @@ call_functions <- c(
   "geom_text" = "ggplot2",
   "ggplot" = "ggplot2",
   "labs" = "ggplot2",
-  "layer" = "ggplot2",
   "position_dodge2" = "ggplot2",
   "position_fill" = "ggplot2",
   "scale_colour_discrete" = "ggplot2",
+  "scale_discrete_manual" = "ggplot2",
   "scale_fill_discrete" = "ggplot2",
   "scale_fill_manual" = "ggplot2",
   "scale_x_discrete" = "ggplot2",
@@ -99,51 +110,61 @@ call_functions <- c(
   "unit" = "ggplot2",
   "xlab" = "ggplot2",
   "ylab" = "ggplot2",
-  "vec_arith" = "vctrs"
+  # knitr
-)
+  "asis_output" = "knitr",
-if (AMR:::pkg_is_available("skimr", min_version = "2.0.0")) {
+  "kable" = "knitr",
-  call_functions <- c(call_functions,
+  "knit_print" = "knitr",
-    # skimr
+  "opts_chunk" = "knitr",
-    "inline_hist" = "skimr",
+  "rmarkdown" = "knitr",
-    "sfl" = "skimr"
+  # pillar
-  )
-}
-
-extended_functions <- c(
-  "freq" = "cleaner",
-  "autoplot" = "ggplot2",
   "pillar_shaft" = "pillar",
-  "get_skimmers" = "skimr",
+  "tbl_format_footer" = "pillar",
+  "tbl_sum" = "pillar",
   "type_sum" = "pillar",
+  # readxl
+  "read_excel" = "readxl",
+  # rmarkdown
+  "html_vignette" = "rmarkdown",
+  # skimr
+  "get_skimmers" = "skimr",
+  "inline_hist" = "skimr",
+  "sfl" = "skimr",
+  # tibble
+  "tibble" = "tibble",
+  # vctrs
+  "vec_arith" = "vctrs",
   "vec_cast" = "vctrs",
   "vec_math" = "vctrs",
-  "vec_ptype2" = "vctrs"
+  "vec_ptype2" = "vctrs",
+  "vec_ptype_abbr" = "vctrs",
+  "vec_ptype_full" = "vctrs"
 )
 
-import_functions <- c(import_functions, call_functions, extended_functions)
+import_functions <- c(import_functions, call_functions)
+suggests <- desc::desc(".")$get_deps()
+suggests <- suggests[which(suggests$type == "Suggests"), ]$package
 for (i in seq_len(length(import_functions))) {
   fn <- names(import_functions)[i]
   pkg <- unname(import_functions[i])
+  expect_true(pkg %in% suggests,
+              info = paste0("package `", pkg, "` is not in Suggests"))
   # function should exist in foreign pkg namespace
   if (AMR:::pkg_is_available(pkg,
                              also_load = FALSE,
                              min_version = if (pkg == "dplyr") "1.0.0" else NULL
   )) {
     expect_true(!is.null(AMR:::import_fn(name = fn, pkg = pkg, error_on_fail = FALSE)),
-      info = paste0("does not exist (anymore): function `", pkg, "::", fn, "()`")
+                info = paste0("Function does not exist (anymore): function `", pkg, "::", fn, "()`"))
-    )
   } else if (pkg != "rstudioapi") {
-    warning("Package '", pkg, "' does not exist anymore")
+    warning("Package '", pkg, "' not available")
   }
 }
 
 if (AMR:::pkg_is_available("cli")) {
-  expect_true(!is.null(cli::symbol$info))
+  expect_true(!is.null(cli::symbol$bullet) && is.character(cli::symbol$bullet) && length(cli::symbol$bullet) == 1)
-}
+  expect_true(!is.null(cli::symbol$ellipsis) && is.character(cli::symbol$ellipsis) && length(cli::symbol$ellipsis) == 1)
-if (AMR:::pkg_is_available("cli")) {
+  expect_true(!is.null(cli::symbol$info) && is.character(cli::symbol$info) && length(cli::symbol$info) == 1)
-}
+  expect_true(!is.null(cli::symbol$sup_1) && is.character(cli::symbol$sup_1) && length(cli::symbol$sup_1) == 1)
-if (AMR:::pkg_is_available("cli")) {
-  expect_true(!is.null(cli::symbol$ellipsis))
 }
 if (AMR:::pkg_is_available("ggplot2")) {
   # the scale_*_mic() functions rely on these
@@ -152,5 +173,3 @@ if (AMR:::pkg_is_available("ggplot2")) {
   expect_true(is.function(ggplot2::scale_colour_discrete()$transform))
   expect_true(is.function(ggplot2::scale_fill_discrete()$transform))
 }
-
-