as.mo

NEWS.md

@@ -9,7 +9,7 @@
 * New functions `set_mo_source()` and `get_mo_source()` to use your own predefined MO codes as input for `as.mo()` and consequently all `mo_*` functions
 * Support for the upcoming [`dplyr`](https://dplyr.tidyverse.org) version 0.8.0
 * New function `guess_ab_col()` to find an antibiotic column in a table
-* New function `mo_failures()` to review values that could not be coerced to a valid MO code, using `as.mo()`. This latter function will now only show a maximum of 25 uncoerced values.
+* New function `mo_failures()` to review values that could not be coerced to a valid MO code, using `as.mo()`. This latter function will now only show a maximum of 10 uncoerced values and will refer to `mo_failures()`.
 * New function `mo_renamed()` to get a list of all returned values from `as.mo()` that have had taxonomic renaming
 * New function `age()` to calculate the (patients) age in years
 * New function `age_groups()` to split ages into custom or predefined groups (like children or elderly). This allows for easier demographic antimicrobial resistance analysis per age group.

R/mo.R

@@ -316,18 +316,21 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE,
         next
       }
 
+      # no nonsense text
+      if (toupper(x_trimmed[i]) %in% c('OTHER', 'NONE', 'UNKNOWN')) {
+        x[i] <- NA_character_
+        failures <- c(failures, x_backup[i])
+        next
+      }
+
 
       # translate known trivial abbreviations to genus + species ----
       if (!is.na(x_trimmed[i])) {
-        if (toupper(x_trimmed[i]) == 'MRSA'
+        if (toupper(x_trimmed[i]) %in% c('MRSA', 'MSSA', 'VISA', 'VRSA')) {
-            | toupper(x_trimmed[i]) == 'MSSA'
-            | toupper(x_trimmed[i]) == 'VISA'
-            | toupper(x_trimmed[i]) == 'VRSA') {
           x[i] <- microorganismsDT[mo == 'B_STPHY_AUR', ..property][[1]][1L]
           next
         }
-        if (toupper(x_trimmed[i]) == 'MRSE'
+        if (toupper(x_trimmed[i]) %in% c('MRSE', 'MSSE')) {
-            | toupper(x_trimmed[i]) == 'MSSE') {
           x[i] <- microorganismsDT[mo == 'B_STPHY_EPI', ..property][[1]][1L]
           next
         }
@@ -508,7 +511,7 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE,
       }
 
       # try fullname without start and stop regex, to also find subspecies ----
-      # like "K. pneu rhino" -> "Klebsiella pneumoniae (rhinoscleromatis)" = KLEPNERH
+      # like "K. pneu rhino" >> "Klebsiella pneumoniae (rhinoscleromatis)" = KLEPNERH
       found <- microorganisms.prevDT[fullname %like% x_withspaces_start[i], ..property][[1]]
       if (length(found) > 0) {
         x[i] <- found[1L]
@@ -579,7 +582,7 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE,
       }
 
       # try fullname without start and stop regex, to also find subspecies ----
-      # like "K. pneu rhino" -> "Klebsiella pneumoniae (rhinoscleromatis)" = KLEPNERH
+      # like "K. pneu rhino" >> "Klebsiella pneumoniae (rhinoscleromatis)" = KLEPNERH
       found <- microorganisms.unprevDT[fullname %like% x_withspaces_start[i], ..property][[1]]
       if (length(found) > 0) {
         x[i] <- found[1L]
@@ -627,8 +630,8 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE,
             } else {
               x <- microorganismsDT[tsn == found[1, tsn_new], ..property][[1]]
             }
-            warning(red(paste0('UNCERTAIN - "',
+            warning(red(paste0('(UNCERTAIN) "',
-                               a.x_backup, '" -> ', italic(found[1, name]))),
+                               a.x_backup, '" >> ', italic(found[1, name]), " (TSN ", found[1, tsn], ")")),
                     call. = FALSE, immediate. = FALSE)
             notes <<- c(notes,
                         renamed_note(name_old = found[1, name],
@@ -644,9 +647,10 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE,
           a.x_backup_stripped <- trimws(gsub("  ", " ", a.x_backup_stripped, fixed = TRUE))
           found <- suppressMessages(suppressWarnings(exec_as.mo(a.x_backup_stripped, clear_options = FALSE, allow_uncertain = FALSE)))
           if (!is.na(found) & nchar(b.x_trimmed) >= 6) {
+            found_result <- found
             found <- microorganismsDT[mo == found, ..property][[1]]
-            warning(red(paste0('UNCERTAIN - "',
+            warning(red(paste0('(UNCERTAIN) "',
-                               a.x_backup, '" -> ', italic(microorganismsDT[mo == found[1L], fullname][[1]]), " (", found[1L], ")")),
+                               a.x_backup, '" >> ', italic(microorganismsDT[mo == found_result[1L], fullname][[1]]), " (", found_result[1L], ")")),
                     call. = FALSE, immediate. = FALSE)
             return(found[1L])
           }
@@ -658,9 +662,10 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE,
               x_strip_collapsed <- paste(x_strip[1:(length(x_strip) - i)], collapse = " ")
               found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, clear_options = FALSE, allow_uncertain = FALSE)))
               if (!is.na(found)) {
+                found_result <- found
                 found <- microorganismsDT[mo == found, ..property][[1]]
-                warning(red(paste0('UNCERTAIN - "',
+                warning(red(paste0('(UNCERTAIN) "',
-                                   a.x_backup, '" -> ', italic(microorganismsDT[mo == found[1L], fullname][[1]]), " (", found[1L], ")")),
+                                   a.x_backup, '" >> ', italic(microorganismsDT[mo == found_result[1L], fullname][[1]]), " (", found_result[1L], ")")),
                         call. = FALSE, immediate. = FALSE)
                 return(found[1L])
               }
@@ -668,11 +673,12 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE,
           }
 
           # (4) not yet implemented taxonomic changes in ITIS
-          found <- suppressMessages(suppressWarnings(exec_as.mo(temp_changes(b.x_trimmed), clear_options = FALSE, allow_uncertain = FALSE)))
+          found <- suppressMessages(suppressWarnings(exec_as.mo(TEMPORARY_TAXONOMY(b.x_trimmed), clear_options = FALSE, allow_uncertain = FALSE)))
           if (!is.na(found)) {
+            found_result <- found
             found <- microorganismsDT[mo == found, ..property][[1]]
-            warning(red(paste0('UNCERTAIN - "',
+            warning(red(paste0('(UNCERTAIN) "',
-                               a.x_backup, '" -> ', italic(microorganismsDT[mo == found[1L], fullname][[1]]), " (", found[1L], ")")),
+                               a.x_backup, '" >> ', italic(microorganismsDT[mo == found_result[1L], fullname][[1]]), " (", found_result[1L], ")")),
                     call. = FALSE, immediate. = FALSE)
             return(found[1L])
           }
@@ -697,16 +703,18 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE,
   failures <- failures[!failures %in% c(NA, NULL, NaN)]
   if (length(failures) > 0) {
     options(mo_failures = sort(unique(failures)))
-    if (n_distinct(failures) > 25) {
+    plural <- ""
-      warning(n_distinct(failures), " different values could not be coerced to a valid MO code. See mo_failures() to review them.",
+    if (n_distinct(failures) > 1) {
-              call. = FALSE)
+      plural <- "s"
-    } else {
-      warning(red(paste0("These ", length(failures) , " values could not be coerced to a valid MO code: ",
-                         paste('"', unique(failures), '"', sep = "", collapse = ', '),
-                         ". See mo_failures() to review them.")),
-              call. = FALSE,
-              immediate. = TRUE) # thus will always be shown, even if >= warnings
     }
+    msg <- paste0("\n", n_distinct(failures), " unique value", plural, " could not be coerced to a valid MO code")
+    if (n_distinct(failures) <= 10) {
+      msg <- paste0(msg, ": ", paste('"', unique(failures), '"', sep = "", collapse = ', '))
+    }
+    msg <- paste0(msg,  ". Use mo_failures() to review failured input.")
+    warning(red(msg),
+            call. = FALSE,
+            immediate. = TRUE) # thus will always be shown, even if >= warnings
   }
 
   # Becker ----
@@ -792,8 +800,9 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE,
   x
 }
 
-temp_changes <- function(x) {
+TEMPORARY_TAXONOMY <- function(x) {
   x[x %like% 'Cutibacterium'] <- gsub('Cutibacterium', 'Propionibacterium', x[x %like% 'Cutibacterium'])
+  x
 }
 
 #' @importFrom crayon blue italic
@@ -815,7 +824,7 @@ renamed_note <- function(name_old, name_new, ref_old = "", ref_new = "", mo = ""
   }
   msg <- paste0(italic(name_old), ref_old, " was renamed ", italic(name_new), ref_new, mo)
   msg <- gsub("et al.", italic("et al."), msg)
-  msg_plain <- paste0(name_old, ref_old, " -> ", name_new, ref_new)
+  msg_plain <- paste0(name_old, ref_old, " >> ", name_new, ref_new)
   msg_plain <- c(getOption("mo_renamed", character(0)), msg_plain)
   options(mo_renamed = sort(msg_plain))
   return(blue(paste("Note:", msg)))

docs/extra.js

@@ -21,9 +21,6 @@
 # ==================================================================== #
 */
 
-// Keep GitLab as original source
-// window.location.replace("github", "gitlab");
-
 // Add updated Font Awesome 5.6.3 library
 $('head').append('<!-- Updated Font Awesome library --><link rel="stylesheet" href="https://use.fontawesome.com/releases/v5.6.3/css/all.css" integrity="sha384-UHRtZLI+pbxtHCWp1t77Bi1L4ZtiqrqD80Kn4Z8NTSRyMA2Fd33n5dQ8lWUE00s/" crossorigin="anonymous">');
 
@@ -34,7 +31,7 @@ $( document ).ready(function() {
   var url_old = window.location.href;
   var url_new = url_old.replace("github", "gitlab");
   if (url_old != url_new) {
-    window.location.replace(url);
+    window.location.replace(url_new);
   }
 
   $('footer').html('<p>' +
@@ -47,4 +44,4 @@ $( document ).ready(function() {
   $('.template-reference-index h1').text('Manual');
 });
 
-$('head').append("<!-- Matomo --><script type='text/javascript'> var _paq = _paq || []; /* tracker methods like 'setCustomDimension' should be called before 'trackPageView' */ _paq.push(['setDomains', ['*.msberends.gitlab.io/AMR','*.msberends.github.io/AMR']]); _paq.push(['enableCrossDomainLinking']); _paq.push(['trackPageView']); _paq.push(['enableLinkTracking']); (function() { var u='https://analyse.uscloud.nl/'; _paq.push(['setTrackerUrl', u+'piwik.php']); _paq.push(['setSiteId', '3']); var d=document, g=d.createElement('script'), s=d.getElementsByTagName('script')[0]; g.type='text/javascript'; g.async=true; g.defer=true; g.src=u+'piwik.js'; s.parentNode.insertBefore(g,s);  })();</script><!-- End Matomo Code -->");
+$('head').append("<!-- Matomo --><script type='text/javascript'> var _paq = _paq || []; /* tracker methods like 'setCustomDimension' should be called before 'trackPageView' */ _paq.push(['setDomains', ['*.msberends.gitlab.io/AMR']]); _paq.push(['enableCrossDomainLinking']); _paq.push(['trackPageView']); _paq.push(['enableLinkTracking']); (function() { var u='https://analyse.uscloud.nl/'; _paq.push(['setTrackerUrl', u+'piwik.php']); _paq.push(['setSiteId', '3']); var d=document, g=d.createElement('script'), s=d.getElementsByTagName('script')[0]; g.type='text/javascript'; g.async=true; g.defer=true; g.src=u+'piwik.js'; s.parentNode.insertBefore(g,s);  })();</script><!-- End Matomo Code -->");

docs/news/index.html

@@ -238,7 +238,7 @@
 <li>New functions <code><a href="../reference/mo_source.html">set_mo_source()</a></code> and <code><a href="../reference/mo_source.html">get_mo_source()</a></code> to use your own predefined MO codes as input for <code><a href="../reference/as.mo.html">as.mo()</a></code> and consequently all <code>mo_*</code> functions</li>
 <li>Support for the upcoming <a href="https://dplyr.tidyverse.org"><code>dplyr</code></a> version 0.8.0</li>
 <li>New function <code><a href="../reference/guess_ab_col.html">guess_ab_col()</a></code> to find an antibiotic column in a table</li>
-<li>New function <code><a href="../reference/mo_failures.html">mo_failures()</a></code> to review values that could not be coerced to a valid MO code, using <code><a href="../reference/as.mo.html">as.mo()</a></code>. This latter function will now only show a maximum of 25 uncoerced values.</li>
+<li>New function <code><a href="../reference/mo_failures.html">mo_failures()</a></code> to review values that could not be coerced to a valid MO code, using <code><a href="../reference/as.mo.html">as.mo()</a></code>. This latter function will now only show a maximum of 10 uncoerced values and will refer to <code><a href="../reference/mo_failures.html">mo_failures()</a></code>.</li>
 <li>New function <code><a href="../reference/mo_renamed.html">mo_renamed()</a></code> to get a list of all returned values from <code><a href="../reference/as.mo.html">as.mo()</a></code> that have had taxonomic renaming</li>
 <li>New function <code><a href="../reference/age.html">age()</a></code> to calculate the (patients) age in years</li>
 <li>New function <code><a href="../reference/age_groups.html">age_groups()</a></code> to split ages into custom or predefined groups (like children or elderly). This allows for easier demographic antimicrobial resistance analysis per age group.</li>

pkgdown/extra.js

@@ -21,9 +21,6 @@
 # ==================================================================== #
 */
 
-// Keep GitLab as original source
-// window.location.replace("github", "gitlab");
-
 // Add updated Font Awesome 5.6.3 library
 $('head').append('<!-- Updated Font Awesome library --><link rel="stylesheet" href="https://use.fontawesome.com/releases/v5.6.3/css/all.css" integrity="sha384-UHRtZLI+pbxtHCWp1t77Bi1L4ZtiqrqD80Kn4Z8NTSRyMA2Fd33n5dQ8lWUE00s/" crossorigin="anonymous">');
 
@@ -34,7 +31,7 @@ $( document ).ready(function() {
   var url_old = window.location.href;
   var url_new = url_old.replace("github", "gitlab");
   if (url_old != url_new) {
-    window.location.replace(url);
+    window.location.replace(url_new);
   }
 
   $('footer').html('<p>' +
@@ -47,4 +44,4 @@ $( document ).ready(function() {
   $('.template-reference-index h1').text('Manual');
 });
 
-$('head').append("<!-- Matomo --><script type='text/javascript'> var _paq = _paq || []; /* tracker methods like 'setCustomDimension' should be called before 'trackPageView' */ _paq.push(['setDomains', ['*.msberends.gitlab.io/AMR','*.msberends.github.io/AMR']]); _paq.push(['enableCrossDomainLinking']); _paq.push(['trackPageView']); _paq.push(['enableLinkTracking']); (function() { var u='https://analyse.uscloud.nl/'; _paq.push(['setTrackerUrl', u+'piwik.php']); _paq.push(['setSiteId', '3']); var d=document, g=d.createElement('script'), s=d.getElementsByTagName('script')[0]; g.type='text/javascript'; g.async=true; g.defer=true; g.src=u+'piwik.js'; s.parentNode.insertBefore(g,s);  })();</script><!-- End Matomo Code -->");
+$('head').append("<!-- Matomo --><script type='text/javascript'> var _paq = _paq || []; /* tracker methods like 'setCustomDimension' should be called before 'trackPageView' */ _paq.push(['setDomains', ['*.msberends.gitlab.io/AMR']]); _paq.push(['enableCrossDomainLinking']); _paq.push(['trackPageView']); _paq.push(['enableLinkTracking']); (function() { var u='https://analyse.uscloud.nl/'; _paq.push(['setTrackerUrl', u+'piwik.php']); _paq.push(['setSiteId', '3']); var d=document, g=d.createElement('script'), s=d.getElementsByTagName('script')[0]; g.type='text/javascript'; g.async=true; g.defer=true; g.src=u+'piwik.js'; s.parentNode.insertBefore(g,s);  })();</script><!-- End Matomo Code -->");