unit tests

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 1.8.2.9103
+Version: 1.8.2.9105
-Date: 2023-01-24
+Date: 2023-01-30
 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

NEWS.md

@@ -1,4 +1,4 @@
-# AMR 1.8.2.9103
+# AMR 1.8.2.9105
 
 *(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)*
 

R/aa_helper_functions.R

@@ -722,9 +722,9 @@ format_class <- function(class, plural = FALSE) {
     class <- "input created with `custom_eucast_rules()`"
   }
   if (any(c("mo", "ab", "sir") %in% class)) {
-    class <- paste0("of class <", class[1L], ">")
+    class <- paste0("of class '", class[1L], "'")
   }
-  class[class == class.bak] <- paste0("of class <", class[class == class.bak], ">")
+  class[class == class.bak] <- paste0("of class '", class[class == class.bak], "'")
   # output
   vector_or(class, quotes = FALSE, sort = FALSE)
 }
@@ -854,7 +854,7 @@ meet_criteria <- function(object,
         }
       ), na.rm = TRUE),
       "the data provided in argument `", obj_name,
-      "` must contain at least one column of class <", contains_column_class, ">. ",
+      "` must contain at least one column of class '", contains_column_class, "'. ",
       "See ?as.", contains_column_class, ".",
       call = call_depth
     )

R/g.test.R

@@ -179,7 +179,7 @@ g.test <- function(x,
     V <- outer(sr, sc, v, n)
     dimnames(E) <- dimnames(x)
 
-    STATISTIC <- 2 * sum(x * log(x / E)) # sum((abs(x - E) - YATES)^2/E) for chisq.test
+    STATISTIC <- 2 * sum(x * log(x / E), na.rm = TRUE) # sum((abs(x - E) - YATES)^2/E) for chisq.test
     PARAMETER <- (nr - 1L) * (nc - 1L)
     PVAL <- pchisq(STATISTIC, PARAMETER, lower.tail = FALSE)
   } else {

R/mo.R

@@ -210,7 +210,7 @@ as.mo <- function(x,
   # From known codes ----
   out[is.na(out) & toupper(x) %in% AMR::microorganisms.codes$code] <- AMR::microorganisms.codes$mo[match(toupper(x)[is.na(out) & toupper(x) %in% AMR::microorganisms.codes$code], AMR::microorganisms.codes$code)]
   # From SNOMED ----
-  if (any(is.na(out) & !is.na(x)) && any(is.na(out) & x %in% unlist(microorganisms$snomed), na.rm = TRUE)) {
+  if (any(is.na(out) & !is.na(x)) && any(is.na(out) & x %in% unlist(AMR_env$MO_lookup$snomed), na.rm = TRUE)) {
     # found this extremely fast gem here: https://stackoverflow.com/a/11002456/4575331
     out[is.na(out) & x %in% unlist(AMR_env$MO_lookup$snomed)] <- AMR_env$MO_lookup$mo[rep(seq_along(AMR_env$MO_lookup$snomed), vapply(FUN.VALUE = double(1), AMR_env$MO_lookup$snomed, length))[match(x[is.na(out) & x %in% unlist(AMR_env$MO_lookup$snomed)], unlist(AMR_env$MO_lookup$snomed))]]
   }
@@ -800,25 +800,31 @@ print.mo_uncertainties <- function(x, ...) {
     return(invisible(NULL))
   }
 
+  cat(word_wrap("Matching scores are based on the resemblance between the input and the full taxonomic name, and the pathogenicity in humans. See `?mo_matching_score`.\n\n", add_fn = font_blue))
+  
   add_MO_lookup_to_AMR_env()
   
-  cat(word_wrap("Matching scores are based on the resemblance between the input and the full taxonomic name, and the pathogenicity in humans. See `?mo_matching_score`.\n\n", add_fn = font_blue))
+  col_red <- function(x) font_rose_bg(font_black(x, collapse = NULL), collapse = NULL)
+  col_orange <- function(x) font_orange_bg(font_black(x, collapse = NULL), collapse = NULL)
+  col_yellow <- function(x) font_yellow_bg(font_black(x, collapse = NULL), collapse = NULL)
+  col_green <- function(x) font_green_bg(font_black(x, collapse = NULL), collapse = NULL)
+  
   if (has_colour()) {
     cat(word_wrap("Colour keys: ",
-      font_red_bg(" 0.000-0.499 "),
+      col_red(" 0.000-0.499 "),
-      font_orange_bg(" 0.500-0.599 "),
+      col_orange(" 0.500-0.599 "),
-      font_yellow_bg(" 0.600-0.699 "),
+      col_yellow(" 0.600-0.699 "),
-      font_green_bg(" 0.700-1.000"),
+      col_green(" 0.700-1.000"),
       add_fn = font_blue
     ), font_green_bg(" "), "\n", sep = "")
   }
   
   score_set_colour <- function(text, scores) {
     # set colours to scores
-    text[scores >= 0.7] <- font_green_bg(text[scores >= 0.7], collapse = NULL)
+    text[scores >= 0.7] <- col_green(text[scores >= 0.7])
-    text[scores >= 0.6 & scores < 0.7] <- font_yellow_bg(text[scores >= 0.6 & scores < 0.7], collapse = NULL)
+    text[scores >= 0.6 & scores < 0.7] <- col_yellow(text[scores >= 0.6 & scores < 0.7])
-    text[scores >= 0.5 & scores < 0.6] <- font_orange_bg(text[scores >= 0.5 & scores < 0.6], collapse = NULL)
+    text[scores >= 0.5 & scores < 0.6] <- col_orange(text[scores >= 0.5 & scores < 0.6])
-    text[scores < 0.5] <- font_red_bg(text[scores < 0.5], collapse = NULL)
+    text[scores < 0.5] <- col_red(text[scores < 0.5])
     text
   }
 

inst/tinytest/test-rsi.R

@@ -195,6 +195,20 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
     as.sir(guideline = "CLSI") %>%
     pull(amox_disk) %>%
     is.sir())
+  
+  # used by group_by() on sir_calc_df(), check some internals to see if grouped calculation without tidyverse works
+  groups <- example_isolates %>%
+    group_by(mo) %>%
+    attributes() %>%
+    .$groups
+  expect_equal(nrow(groups),
+               90)
+  expect_equal(class(groups$.rows),
+               c("vctrs_list_of", "vctrs_vctr", "list"))
+  expect_equal(groups$.rows[[1]],
+               c(101, 524, 1368))
+  expect_equal(example_isolates[c(101, 524, 1368), "mo", drop = TRUE],
+               rep(groups$mo[1], 3))
 }
 # frequency tables
 if (AMR:::pkg_is_available("cleaner")) {

man/antibiogram_wisca.Rd

@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/antibiogram.R
+\name{antibiogram_wisca}
+\alias{antibiogram_wisca}
+\title{Generate Antibiogram: Traditional, Combined, Syndromic, or Weighted (WISCA)}
+\usage{
+antibiogram_wisca(
+  x,
+  ...,
+  antibiotics = where(is.sir),
+  type = c("traditional", "combined", "syndromic", "WISCA"),
+  col_mo = NULL,
+  minimum = 30
+)
+}
+\arguments{
+\item{x}{a \link{data.frame} containing at least a column with microorganisms and columns with antibiotic results (class 'sir', see \code{\link[=as.sir]{as.sir()}})}
+}
+\description{
+Generate Antibiogram: Traditional, Combined, Syndromic, or Weighted (WISCA)
+}

pkgdown/extra.css

@@ -49,6 +49,11 @@
   content: 'Maintainers';
 }
 
+/* marked words for after using the search box */
+mark, .mark {
+  background: rgba(17, 143, 118, 0.25) !important;
+}
+
 
 /* SYNTAX */
 /* These are simple changes for the syntax highlighting */