(v1.4.0.9021) more robust class setting

.github/workflows/check.yaml

@@ -64,8 +64,7 @@ jobs:
           - {os: ubuntu-16.04,   r: '3.5',     allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
           - {os: ubuntu-16.04,   r: '3.4',     allowfail: true,  rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
           - {os: ubuntu-16.04,   r: '3.3',     allowfail: true,  rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
-          - {os: ubuntu-16.04,   r: '3.2',     allowfail: true,  rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
-          
+          # older R versions cannot be tested, since tidyverse only supports last 4 R x.x versions
     env:
       R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
       RSPM: ${{ matrix.config.rspm }}

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: AMR
-Version: 1.4.0.9020
+Version: 1.4.0.9021
 Date: 2020-11-16
 Title: Antimicrobial Resistance Analysis
 Authors@R: c(

NEWS.md

@@ -1,4 +1,4 @@
-# AMR 1.4.0.9020
+# AMR 1.4.0.9021
 ## <small>Last updated: 16 November 2020</small>
 
 ### New

R/aa_helper_functions.R

@@ -670,7 +670,7 @@ progress_ticker <- function(n = 1, n_min = 0, ...) {
     pb$kill <- function() {
       invisible()
     }
-    structure(pb, class = "txtProgressBar")
+    set_clean_class(pb, new_class = "txtProgressBar")
   } else if (n >= n_min) {
     pb <- utils::txtProgressBar(max = n, style = 3)
     pb$tick <- function() {
@@ -680,6 +680,21 @@ progress_ticker <- function(n = 1, n_min = 0, ...) {
   }
 }
 
+set_clean_class <- function(x, new_class) {
+  if (is.null(x)) {
+    x <- NA_character_
+  }
+  if (is.factor(x)) {
+    lvls <- levels(x)
+    attributes(x) <- NULL
+    levels(x) <- lvls
+  } else {
+    attributes(x) <- NULL
+  }
+  class(x) <- new_class
+  x
+}
+
 create_pillar_column <- function(x, ...) {
   new_pillar_shaft_simple <- import_fn("new_pillar_shaft_simple", "pillar", error_on_fail = FALSE)
   if (!is.null(new_pillar_shaft_simple)) {

R/ab.R

@@ -97,8 +97,8 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) {
   
   if (all(toupper(x) %in% antibiotics$ab)) {
     # valid AB code, but not yet right class
-    return(structure(.Data = toupper(x),
-                     class = c("ab", "character")))
+    return(set_clean_class(toupper(x),
+                           new_class = c("ab", "character")))
   }
   
   x_bak <- x
@@ -455,8 +455,8 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) {
     x_result <- NA_character_
   }
   
-  structure(.Data = x_result,
-            class = c("ab", "character"))
+  set_clean_class(x_result,
+                  new_class = c("ab", "character"))
 }
 
 #' @rdname as.ab

R/ab_property.R

@@ -263,7 +263,7 @@ ab_validate <- function(x, property, ...) {
      pm_pull(property)
   }
   if (property == "ab") {
-    return(structure(x, class = property))
+    return(set_clean_class(x, new_class = c("ab", "character")))
   } else if (property == "cid") {
     return(as.integer(x))
   } else if (property %like% "ddd") {

R/age.R

@@ -139,7 +139,7 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
 #'
 #' \donttest{
 #' # resistance of ciprofloxacin per age group
-#' library(dplyr)
+#' if (require("dplyr")) {
 #'   example_isolates %>%
 #'     filter_first_isolate() %>%
 #'     filter(mo == as.mo("E. coli")) %>%
@@ -147,6 +147,7 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
 #'     select(age_group, CIP) %>%
 #'     ggplot_rsi(x = "age_group", minimum = 0)
 #' }
+#' }
 age_groups <- function(x, split_at = c(12, 25, 55, 75), na.rm = FALSE) {
   meet_criteria(x, allow_class = c("numeric", "integer"))
   meet_criteria(split_at, allow_class = c("numeric", "integer", "character"))

R/bug_drug_combinations.R

@@ -106,7 +106,8 @@ bug_drug_combinations <- function(x,
     out <- rbind(out, out_group, stringsAsFactors = FALSE)
   }
   
-  structure(.Data = out, class = c("bug_drug_combinations", x_class))
+  set_clean_class(out,
+                  new_class = c("bug_drug_combinations", x_class))
 }
 
 #' @method format bug_drug_combinations
@@ -245,7 +246,8 @@ format.bug_drug_combinations <- function(x,
 #' @export
 print.bug_drug_combinations <- function(x, ...) {
   x_class <- class(x)
-  print(structure(x, class = x_class[x_class != "bug_drug_combinations"]),
+  print(set_clean_class(x, 
+                        new_class = x_class[x_class != "bug_drug_combinations"]),
         ...)
   message_("Use 'format()' on this result to get a publishable/printable format.", as_note = FALSE)
 }

R/catalogue_of_life.R

@@ -107,8 +107,8 @@ catalogue_of_life_version <- function() {
                   n_total_species = nrow(microorganisms),
                   n_total_synonyms = nrow(microorganisms.old)))
   
-  structure(.Data = lst,
-            class = c("catalogue_of_life_version", "list"))
+  set_clean_class(lst,
+                  new_class = c("catalogue_of_life_version", "list"))
 }
 
 #' @method print catalogue_of_life_version

R/disk.R

@@ -39,7 +39,6 @@
 #' @examples
 #' \donttest{
 #' # transform existing disk zones to the `disk` class
-#' library(dplyr)
 #' df <- data.frame(microorganism = "E. coli",
 #'                  AMP = 20,
 #'                  CIP = 14,
@@ -107,8 +106,8 @@ as.disk <- function(x, na.rm = FALSE) {
                list_missing, call = FALSE)
     }
   }
-  structure(as.integer(x),
-            class = c("disk", "integer"))
+  set_clean_class(as.integer(x),
+                  new_class = c("disk", "integer"))
 }
 
 all_valid_disks <- function(x) {

R/mic.R

@@ -131,8 +131,8 @@ as.mic <- function(x, na.rm = FALSE) {
                list_missing, call = FALSE)
     }
     
-    structure(.Data = factor(x, levels = lvls, ordered = TRUE),
-              class =  c("mic", "ordered", "factor"))
+    set_clean_class(factor(x, levels = lvls, ordered = TRUE),
+                    new_class =  c("mic", "ordered", "factor"))
   }
 }
 

R/mo.R

@@ -175,7 +175,7 @@ as.mo <- function(x,
                & isFALSE(Lancefield), error = function(e) FALSE)) {
     # don't look into valid MO codes, just return them
     # is.mo() won't work - MO codes might change between package versions
-    return(to_class_mo(x))
+    return(set_clean_class(x, new_class = c("mo", "character")))
   }
 
   if (tryCatch(all(x == "" | gsub(".*(unknown ).*", "unknown name", tolower(x), perl = TRUE) %in% MO_lookup$fullname_lower, na.rm = TRUE)
@@ -228,12 +228,8 @@ as.mo <- function(x,
                      ...)
   }
 
-  to_class_mo(y)
-}
-
-to_class_mo <- function(x) {
-  structure(.Data = x,
-            class = c("mo", "character"))
+  set_clean_class(y,
+                  new_class = c("mo", "character"))
 }
 
 #' @rdname as.mo
@@ -399,7 +395,8 @@ exec_as.mo <- function(x,
   # all empty
   if (all(identical(trimws(x_input), "") | is.na(x_input) | length(x) == 0)) {
     if (property == "mo") {
-      return(to_class_mo(rep(NA_character_, length(x_input))))
+      return(set_clean_class(rep(NA_character_, length(x_input)),
+                             new_class = c("mo", "character")))
     } else {
       return(rep(NA_character_, length(x_input)))
     }
@@ -1499,7 +1496,7 @@ exec_as.mo <- function(x,
   x <- df_found$found[match(df_input$input, df_found$input)]
 
   if (property == "mo") {
-    x <- to_class_mo(x)
+    x <- set_clean_class(x, new_class = c("mo", "character"))
   }
 
   if (length(mo_renamed()) > 0) {
@@ -1740,8 +1737,9 @@ mo_uncertainties <- function() {
   if (is.null(getOption("mo_uncertainties"))) {
     return(NULL)
   }
-  structure(.Data = as.data.frame(getOption("mo_uncertainties"), stringsAsFactors = FALSE),
-            class = c("mo_uncertainties", "data.frame"))
+  set_clean_class(as.data.frame(getOption("mo_uncertainties"), 
+                                stringsAsFactors = FALSE),
+                  new_class = c("mo_uncertainties", "data.frame"))
 }
 
 #' @method print mo_uncertainties
@@ -1814,8 +1812,9 @@ mo_renamed <- function() {
   } else {
     items <- pm_distinct(items, old_name, .keep_all = TRUE)
   }
-  structure(.Data = items,
-            class = c("mo_renamed", "data.frame"))
+  set_clean_class(as.data.frame(items,
+                                stringsAsFactors = FALSE),
+                  new_class = c("mo_renamed", "data.frame"))
 }
 
 #' @method print mo_renamed

R/rsi.R

@@ -223,17 +223,15 @@ is.rsi.eligible <- function(x, threshold = 0.05) {
 #' @export
 as.rsi.default <- function(x, ...) {
   if (is.rsi(x)) {
-    x
-  } else if (all(is.na(x)) || identical(levels(x), c("S", "I", "R"))) {
-    structure(.Data = factor(x, levels = c("S", "I", "R"), ordered = TRUE),
-              class =  c("rsi", "ordered", "factor"))
-  } else if (inherits(x, "integer") & all(x %in% c(1:3, NA))) {
+    return(x)
+  }
+  
+  if (inherits(x, "integer") & all(x %in% c(1:3, NA))) {
     x[x == 1] <- "S"
     x[x == 2] <- "I"
     x[x == 3] <- "R"
-    structure(.Data = factor(x, levels = c("S", "I", "R"), ordered = TRUE),
-              class =  c("rsi", "ordered", "factor"))
-  } else {
+    
+  } else if (!all(is.na(x)) && !identical(levels(x), c("S", "I", "R"))) {
     
     if (!any(x %like% "(R|S|I)", na.rm = TRUE)) {
       # check if they are actually MICs or disks now that the antibiotic name is valid
@@ -280,10 +278,10 @@ as.rsi.default <- function(x, ...) {
                  list_missing, call = FALSE)
       }
     }
-    
-    structure(.Data = factor(x, levels = c("S", "I", "R"), ordered = TRUE),
-              class =  c("rsi", "ordered", "factor"))
   }
+  
+  set_clean_class(factor(x, levels = c("S", "I", "R"), ordered = TRUE),
+                  new_class =  c("rsi", "ordered", "factor"))
 }
 
 #' @rdname as.rsi
@@ -804,8 +802,8 @@ exec_as.rsi <- function(method,
   
   load_mo_failures_uncertainties_renamed(metadata_mo)
   
-  structure(.Data = factor(new_rsi, levels = c("S", "I", "R"), ordered = TRUE),
-            class =  c("rsi", "ordered", "factor"))
+  set_clean_class(factor(new_rsi, levels = c("S", "I", "R"), ordered = TRUE),
+                  new_class =  c("rsi", "ordered", "factor"))
 }
 
 # will be exported using s3_register() in R/zzz.R

docs/404.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="https://msberends.github.io/AMR//index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9020</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9021</span>
       </span>
     </div>
 

docs/LICENSE-text.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9020</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9021</span>
       </span>
     </div>
 

docs/articles/index.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9020</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9021</span>
       </span>
     </div>
 

docs/authors.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9020</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9021</span>
       </span>
     </div>
 

docs/index.html

@@ -43,7 +43,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9020</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9021</span>
       </span>
     </div>
 

docs/news/index.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9020</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9021</span>
       </span>
     </div>
 
@@ -236,9 +236,9 @@
       <small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small>
     </div>
 
-    <div id="amr-1409020" class="section level1">
-<h1 class="page-header" data-toc-text="1.4.0.9020">
-<a href="#amr-1409020" class="anchor"></a>AMR 1.4.0.9020<small> Unreleased </small>
+    <div id="amr-1409021" class="section level1">
+<h1 class="page-header" data-toc-text="1.4.0.9021">
+<a href="#amr-1409021" class="anchor"></a>AMR 1.4.0.9021<small> Unreleased </small>
 </h1>
 <div id="last-updated-16-november-2020" class="section level2">
 <h2 class="hasAnchor">

docs/pkgdown.yml

@@ -12,7 +12,7 @@ articles:
   datasets: datasets.html
   resistance_predict: resistance_predict.html
   welcome_to_AMR: welcome_to_AMR.html
-last_built: 2020-11-16T09:57Z
+last_built: 2020-11-16T15:57Z
 urls:
   reference: https://msberends.github.io/AMR//reference
   article: https://msberends.github.io/AMR//articles

docs/reference/age_groups.html

@@ -82,7 +82,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9008</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9021</span>
       </span>
     </div>
 
@@ -316,13 +316,14 @@ The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>stable</s
 
 <span class='co'># \donttest{</span>
 <span class='co'># resistance of ciprofloxacin per age group</span>
-<span class='kw'><a href='https://rdrr.io/r/base/library.html'>library</a></span><span class='op'>(</span><span class='va'><a href='https://dplyr.tidyverse.org'>dplyr</a></span><span class='op'>)</span>
+<span class='kw'>if</span> <span class='op'>(</span><span class='kw'><a href='https://rdrr.io/r/base/library.html'>require</a></span><span class='op'>(</span><span class='st'><a href='https://dplyr.tidyverse.org'>"dplyr"</a></span><span class='op'>)</span><span class='op'>)</span> <span class='op'>{</span>
   <span class='va'>example_isolates</span> <span class='op'>%&gt;%</span>
     <span class='fu'><a href='first_isolate.html'>filter_first_isolate</a></span><span class='op'>(</span><span class='op'>)</span> <span class='op'>%&gt;%</span>
     <span class='fu'><a href='https://dplyr.tidyverse.org/reference/filter.html'>filter</a></span><span class='op'>(</span><span class='va'>mo</span> <span class='op'>==</span> <span class='fu'><a href='as.mo.html'>as.mo</a></span><span class='op'>(</span><span class='st'>"E. coli"</span><span class='op'>)</span><span class='op'>)</span> <span class='op'>%&gt;%</span>
     <span class='fu'><a href='https://dplyr.tidyverse.org/reference/group_by.html'>group_by</a></span><span class='op'>(</span>age_group <span class='op'>=</span> <span class='fu'>age_groups</span><span class='op'>(</span><span class='va'>age</span><span class='op'>)</span><span class='op'>)</span> <span class='op'>%&gt;%</span>
     <span class='fu'><a href='https://dplyr.tidyverse.org/reference/select.html'>select</a></span><span class='op'>(</span><span class='va'>age_group</span>, <span class='va'>CIP</span><span class='op'>)</span> <span class='op'>%&gt;%</span>
     <span class='fu'><a href='ggplot_rsi.html'>ggplot_rsi</a></span><span class='op'>(</span>x <span class='op'>=</span> <span class='st'>"age_group"</span>, minimum <span class='op'>=</span> <span class='fl'>0</span><span class='op'>)</span>
+<span class='op'>}</span>
 <span class='co'># }</span>
 </pre>
   </div>

docs/reference/antibiotic_class_selectors.html

@@ -82,7 +82,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9020</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9021</span>
       </span>
     </div>
 

docs/reference/as.disk.html

@@ -82,7 +82,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9000</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9021</span>
       </span>
     </div>
 
@@ -284,7 +284,6 @@ The <a href='lifecycle.html'>lifecycle</a> of this function is <strong>stable</s
     <h2 class="hasAnchor" id="examples"><a class="anchor" href="#examples"></a>Examples</h2>
     <pre class="examples"><span class='co'># \donttest{</span>
 <span class='co'># transform existing disk zones to the `disk` class</span>
-<span class='kw'><a href='https://rdrr.io/r/base/library.html'>library</a></span><span class='op'>(</span><span class='va'><a href='https://dplyr.tidyverse.org'>dplyr</a></span><span class='op'>)</span>
 <span class='va'>df</span> <span class='op'>&lt;-</span> <span class='fu'><a href='https://rdrr.io/r/base/data.frame.html'>data.frame</a></span><span class='op'>(</span>microorganism <span class='op'>=</span> <span class='st'>"E. coli"</span>,
                  AMP <span class='op'>=</span> <span class='fl'>20</span>,
                  CIP <span class='op'>=</span> <span class='fl'>14</span>,

docs/reference/as.mo.html

@@ -82,7 +82,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9020</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9021</span>
       </span>
     </div>
 

docs/reference/index.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9020</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9021</span>
       </span>
     </div>
 

docs/reference/mo_property.html

@@ -82,7 +82,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9020</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9021</span>
       </span>
     </div>
 

docs/survey.html

@@ -81,7 +81,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9020</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9021</span>
       </span>
     </div>
 

man/age_groups.Rd

@@ -69,7 +69,7 @@ age_groups(ages, "children")
 
 \donttest{
 # resistance of ciprofloxacin per age group
-library(dplyr)
+if (require("dplyr")) {
   example_isolates \%>\%
     filter_first_isolate() \%>\%
     filter(mo == as.mo("E. coli")) \%>\%
@@ -78,6 +78,7 @@ example_isolates \%>\%
     ggplot_rsi(x = "age_group", minimum = 0)
 }
 }
+}
 \seealso{
 To determine ages, based on one or more reference dates, use the \code{\link[=age]{age()}} function.
 }

man/as.disk.Rd

@@ -40,7 +40,6 @@ On our website \url{https://msberends.github.io/AMR/} you can find \href{https:/
 \examples{
 \donttest{
 # transform existing disk zones to the `disk` class
-library(dplyr)
 df <- data.frame(microorganism = "E. coli",
                  AMP = 20,
                  CIP = 14,