unit test fix

.github/workflows/check-old.yaml

@@ -49,6 +49,7 @@ jobs:
           # Test all old versions of R >= 3.0, we support them all!
           # For these old versions, dependencies and vignettes will not be checked.
           # For recent R versions, see check-recent.yaml (r-lib and tidyverse support the latest 5 major R releases).
+          - {os: ubuntu-latest, r: '3.6', allowfail: false}
           # - {os: windows-latest, r: '3.5', allowfail: true} # always fails, horrible with UTF-8
           - {os: ubuntu-latest, r: '3.4', allowfail: false}
           - {os: ubuntu-latest, r: '3.3', allowfail: false}

.github/workflows/check-recent.yaml

@@ -63,10 +63,10 @@ jobs:
           - {os: ubuntu-latest,  r: 'release', allowfail: false}
 
           # older versions (see also check-old.yaml for even older versions):
+          - {os: ubuntu-latest, r: '4.3', allowfail: false}
           - {os: ubuntu-latest, r: '4.2', allowfail: false}
           - {os: ubuntu-latest, r: '4.1', allowfail: false}
-          - {os: ubuntu-latest, r: '4.0', allowfail: false}
+          - {os: ubuntu-latest, r: '4.0', allowfail: false} # when a new R releases, this one has to move to check-old.yaml
-          - {os: ubuntu-latest, r: '3.6', allowfail: false} # when a new R releases, this one has to move to check-old.yaml
 
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: AMR
-Version: 2.1.1.9030
+Version: 2.1.1.9031
 Date: 2024-05-20
 Title: Antimicrobial Resistance Data Analysis
 Description: Functions to simplify and standardise antimicrobial resistance (AMR)

NEWS.md

@@ -1,4 +1,4 @@
-# AMR 2.1.1.9030
+# AMR 2.1.1.9031
 
 *(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!)*
 

R/bug_drug_combinations.R

@@ -108,6 +108,7 @@ bug_drug_combinations <- function(x,
       SDD = integer(0),
       I = integer(0),
       R = integer(0),
+      N = integer(0),
       total = integer(0),
       stringsAsFactors = FALSE
     )
@@ -122,18 +123,19 @@ bug_drug_combinations <- function(x,
       x_mo_filter <- x[which(x[, col_mo, drop = TRUE] == unique_mo[i]), names(which(vapply(FUN.VALUE = logical(1), x, is.sir))), drop = FALSE]
       # turn and merge everything
       pivot <- lapply(x_mo_filter, function(x) {
-        m <- as.matrix(table(x))
+        m <- as.matrix(table(as.sir(x)))
-        data.frame(S = m["S", ], SDD = m["SDD", ], I = m["I", ], R = m["R", ], stringsAsFactors = FALSE)
+        data.frame(S = m["S", ], SDD = m["SDD", ], I = m["I", ], R = m["R", ], N = m["N", ], stringsAsFactors = FALSE)
       })
       merged <- do.call(rbind_AMR, pivot)
       out_group <- data.frame(
         mo = rep(unique_mo[i], NROW(merged)),
         ab = rownames(merged),
         S = merged$S,
-        SDD = merged$SSD,
+        SDD = merged$SDD,
         I = merged$I,
         R = merged$R,
-        total = merged$S + merged$I + merged$R,
+        N = merged$N,
+        total = merged$S + merged$SDD + merged$I + merged$R + merged$N,
         stringsAsFactors = FALSE
       )
       if (data_has_groups) {
@@ -208,11 +210,13 @@ format.bug_drug_combinations <- function(x,
       SDD = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$SDD[i], na.rm = TRUE)),
       I = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$I[i], na.rm = TRUE)),
       R = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$R[i], na.rm = TRUE)),
+      N = vapply(FUN.VALUE = double(1), idx, function(i) sum(x$R[i], na.rm = TRUE)),
       total = vapply(FUN.VALUE = double(1), idx, function(i) {
         sum(x$S[i], na.rm = TRUE) +
           sum(x$SDD[i], na.rm = TRUE) +
           sum(x$I[i], na.rm = TRUE) +
-          sum(x$R[i], na.rm = TRUE)
+          sum(x$R[i], na.rm = TRUE) +
+          sum(x$N[i], na.rm = TRUE)
       }),
       stringsAsFactors = FALSE
     )

R/plot.R

@@ -713,12 +713,12 @@ barplot.sir <- function(height,
   if (length(colours_SIR) == 1) {
     colours_SIR <- rep(colours_SIR, 3)
   }
-  # add SSD and N to colours
+  # add SDD and N to colours
   colours_SIR <- c(colours_SIR[1:2], colours_SIR[2], colours_SIR[3], "#888888")
   main <- gsub(" +", " ", paste0(main, collapse = " "))
 
   x <- table(height)
-  # remove missing I, SSD, and N
+  # remove missing I, SDD, and N
   colours_SIR <- colours_SIR[!(names(x) %in% c("SDD", "I", "N") & x == 0)]
   x <- x[!(names(x) %in% c("SDD", "I", "N") & x == 0)]
   # plot it

R/sir.R

@@ -327,7 +327,7 @@ is_sir_eligible <- function(x, threshold = 0.05) {
 # extra param: warn (logical, to never throw a warning)
 as.sir.default <- function(x, S = "^(S|U)+$", I = "^(I|H)+$", R = "^(R)+$", N = "^(N|V)+$", SDD = "^(SDD|D)+$", ...) {
   if (inherits(x, "sir")) {
-    return(x)
+    return(as_sir_structure(x))
   }
 
   x.bak <- x