atc_groups

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 0.2.0.9003
+Version: 0.2.0.9004
-Date: 2018-06-08
+Date: 2018-06-18
 Title: Antimicrobial Resistance Analysis
 Authors@R: c(
     person(
@@ -28,6 +28,7 @@ Depends:
     R (>= 3.0.0)
 Imports:
     backports,
+    curl,
     dplyr (>= 0.7.0),
     data.table (>= 1.10.0),
     reshape2 (>= 1.4.0),

NAMESPACE

@@ -24,6 +24,8 @@ export(abname)
 export(anti_join_microorganisms)
 export(as.mic)
 export(as.rsi)
+export(atc_ddd)
+export(atc_groups)
 export(atc_property)
 export(first_isolate)
 export(freq)
@@ -58,6 +60,7 @@ exportMethods(print.tbl)
 exportMethods(print.tbl_df)
 exportMethods(summary.mic)
 exportMethods(summary.rsi)
+importFrom(curl,nslookup)
 importFrom(data.table,data.table)
 importFrom(dplyr,"%>%")
 importFrom(dplyr,all_vars)
@@ -92,6 +95,8 @@ importFrom(graphics,barplot)
 importFrom(graphics,plot)
 importFrom(graphics,text)
 importFrom(reshape2,dcast)
+importFrom(rvest,html_children)
+importFrom(rvest,html_node)
 importFrom(rvest,html_nodes)
 importFrom(rvest,html_table)
 importFrom(stats,fivenum)

NEWS.md

@@ -1,11 +1,14 @@
 # 0.2.0.90xx (development version)
 
-* Vignettes about frequency tables
+* New vignette about frequency tables
-* Possibility to globally set the default for the amount of items to print in frequency tables (`freq` function), with `options(max.print.freq = n)`
+* Added possibility to globally set the default for the amount of items to print in frequency tables (`freq` function), with `options(max.print.freq = n)`
-* Renamed `toConsole` parameter of `freq` to `as.data.frame`
+* Renamed `toConsole` parameter of `freq` function to `as.data.frame`
 * Small translational improvements to the `septic_patients` dataset
-* Coerce RSI values from combined MIC/RSI values: `as.rsi("<=0.002; S")` will now return `"S"`
+* Combined MIC/RSI values will now be coerced by the `rsi` and `mic` functions: `as.rsi("<=0.002; S")` will return `S` and `as.mic("<=0.002; S")` will return `<=0.002`
-* Fix for warning **hybrid evaluation forced for row_number** ([`924b62`](https://github.com/tidyverse/dplyr/commit/924b62)) from the `dplyr` package v0.7.5 and above
+* It is now possible to coerce MIC values when there's a space between the operator and the value, i.e. `as.mic("<= 0.002")` now works
+* Added `"groups"` option for `atc_property(..., property)`. It will return a vector of the ATC hierarchy as defined by the [WHO](https://www.whocc.no/atc/structure_and_principles/). The new function `atc_groups` is a convenient wrapper around this. * Build-in host check for `atc_property` as it requires the host set by `url` to be responsive
+* Improved `first_isolate` algorithm to exclude isolates where bacteria ID or genus is unavailable
+* Fix for warning *hybrid evaluation forced for row_number* ([`924b62`](https://github.com/tidyverse/dplyr/commit/924b62)) from the `dplyr` package v0.7.5 and above
 * Support for 1 or 2 columns as input for `guess_bactid`
 * Fix for printing tibbles where characters would be accidentally transformed to factors
 

R/atc.R

@@ -18,13 +18,14 @@
 
 #' Properties of an ATC code
 #'
-#' Gets data from the WHO to determine properties of an ATC (e.g. an antibiotic) like name, defined daily dose (DDD) or standard unit. \strong{This function requires an internet connection.}
+#' Gets data from the WHO to determine properties of an ATC (e.g. an antibiotic) like name, defined daily dose (DDD) or standard unit. \cr \strong{This function requires an internet connection.}
 #' @param atc_code a character or character vector with ATC code(s) of antibiotic(s)
-#' @param property property of an ATC code. Valid values are \code{"ATC code"}, \code{"Name"}, \code{"DDD"}, \code{"U"} (\code{"unit"}), \code{"Adm.R"} en \code{"Note"}.
+#' @param property property of an ATC code. Valid values are \code{"ATC"}, \code{"Name"}, \code{"DDD"}, \code{"U"} (\code{"unit"}), \code{"Adm.R"}, \code{"Note"} and \code{groups}. For this last option, all hierarchical groups of an ATC code will be returned, see Examples.
-#' @param administration type of administration, see \emph{Details}
+#' @param administration type of administration when using \code{property = "Adm.R"}, see Details
 #' @param url url of website of the WHO. The sign \code{\%s} can be used as a placeholder for ATC codes.
+#' @param ... parameters to pass on to \code{atc_property}
 #' @details
-#' Abbreviations for the property \code{"Adm.R"} (parameter \code{administration}):
+#' Options for parameter \code{administration}:
 #' \itemize{
 #'   \item{\code{"Implant"}}{ = Implant}
 #'   \item{\code{"Inhal"}}{ = Inhalation}
@@ -38,7 +39,7 @@
 #'   \item{\code{"V"}}{ = vaginal}
 #' }
 #'
-#' Abbreviations for the property \code{"U"} (unit):
+#' Abbreviations of return values when using \code{property = "U"} (unit):
 #' \itemize{
 #'   \item{\code{"g"}}{ = gram}
 #'   \item{\code{"mg"}}{ = milligram}
@@ -50,36 +51,80 @@
 #'   \item{\code{"ml"}}{ = milliliter (e.g. eyedrops)}
 #' }
 #' @export
+#' @rdname atc_property
 #' @importFrom dplyr %>% progress_estimated
 #' @importFrom xml2 read_html
-#' @importFrom rvest html_nodes html_table
+#' @importFrom rvest html_children html_node html_nodes html_table
+#' @importFrom curl nslookup
 #' @source \url{https://www.whocc.no/atc_ddd_alterations__cumulative/ddd_alterations/abbrevations/}
 #' @examples
 #' \donttest{
-#' atc_property("J01CA04", "DDD", "O") # oral DDD (Defined Daily Dose) of amoxicillin
+#' # What's the ATC of amoxicillin?
-#' atc_property("J01CA04", "DDD", "P") # parenteral DDD (Defined Daily Dose) of amoxicillin
+#' guess_atc("Amoxicillin")
+#' # [1] "J01CA04"
+#'
+#' # oral DDD (Defined Daily Dose) of amoxicillin
+#' atc_property("J01CA04", "DDD", "O")
+#' # parenteral DDD (Defined Daily Dose) of amoxicillin
+#' atc_property("J01CA04", "DDD", "P")
+#'
+#' atc_property("J01CA04", property = "groups") # search hierarchical groups of amoxicillin
+#' # [1] "ANTIINFECTIVES FOR SYSTEMIC USE"
+#' # [2] "ANTIBACTERIALS FOR SYSTEMIC USE"
+#' # [3] "BETA-LACTAM ANTIBACTERIALS, PENICILLINS"
+#' # [4] "Penicillins with extended spectrum"
 #' }
 atc_property <- function(atc_code,
                          property,
                          administration = 'O',
                          url = 'https://www.whocc.no/atc_ddd_index/?code=%s&showdescription=no') {
 
-  # property <- property %>% tolower()
+  # check active network interface, from https://stackoverflow.com/a/5078002/4575331
-  #
+  has_internet <- function(url) {
+    # extract host from given url
+    # https://www.whocc.no/atc_ddd_index/ -> www.whocc.no
+    url <- url %>%
+      gsub("^(http://|https://)", "", .) %>%
+      strsplit('/', fixed = TRUE) %>%
+      unlist() %>%
+      .[1]
+    !is.null(curl::nslookup(url, error = FALSE))
+  }
+  # check for connection using the ATC of amoxicillin
+  if (!has_internet(url = url)) {
+    message("The URL could not be reached.")
+    return(rep(NA, length(atc_code)))
+  }
+
+  if (length(property) != 1L) {
+    stop('`property` must be of length 1', call. = FALSE)
+  }
+  if (length(administration) != 1L) {
+    stop('`administration` must be of length 1', call. = FALSE)
+  }
+
+  # also allow unit as property
   if (property %like% 'unit') {
     property <- 'U'
   }
 
   # validation of properties
-  valid_properties.bak <- c("ATC code", "Name", "DDD", "U", "Adm.R", "Note")
+  valid_properties <- c("ATC", "Name", "DDD", "U", "Adm.R", "Note", "groups")
-  valid_properties <- valid_properties.bak #%>% tolower()
+  valid_properties.bak <- valid_properties
+
+  property <- tolower(property)
+  valid_properties <- tolower(valid_properties)
+
   if (!property %in% valid_properties) {
-    stop('Invalid `property`, use one of ', paste(valid_properties, collapse = ", "), '.')
+    stop('Invalid `property`, use one of ', paste(valid_properties.bak, collapse = ", "), '.')
   }
 
-  returnvalue <- rep(NA_character_, length(atc_code))
+  if (property == 'ddd') {
-  if (property == 'DDD') {
     returnvalue <- rep(NA_real_, length(atc_code))
+  } else if (property == 'groups') {
+    returnvalue <- list()
+  } else {
+    returnvalue <- rep(NA_character_, length(atc_code))
   }
 
   progress <- progress_estimated(n = length(atc_code))
@@ -89,47 +134,80 @@ atc_property <- function(atc_code,
     progress$tick()$print()
 
     atc_url <- sub('%s', atc_code[i], url, fixed = TRUE)
-    tbl <- xml2::read_html(atc_url) %>%
-      rvest::html_nodes('table') %>%
-      rvest::html_table(header = TRUE)
 
-    if (length(tbl) == 0) {
+    if (property == "groups") {
-      warning('ATC not found: ', atc_code[i], '. Please check ', atc_url, '.', call. = FALSE)
+      tbl <- xml2::read_html(atc_url) %>%
-      returnvalue[i] <- NA
+        rvest::html_node("#content") %>%
-      next
+        rvest::html_children() %>%
-    }
+        rvest::html_node("a")
 
-    tbl <- tbl[[1]]
+      # get URLS of items
+      hrefs <- tbl %>% rvest::html_attr("href")
+      # get text of items
+      texts <- tbl %>% rvest::html_text()
+      # select only text items where URL like "code="
+      texts <- texts[grepl("?code=", tolower(hrefs), fixed = TRUE)]
+      # last one is antibiotics, skip it
+      texts <- texts[1:length(texts) - 1]
+      returnvalue <- c(list(texts), returnvalue)
 
-    if (property == 'Name') {
-      returnvalue[i] <- tbl[1, 2]
     } else {
+      tbl <- xml2::read_html(atc_url) %>%
+        rvest::html_nodes('table') %>%
+        rvest::html_table(header = TRUE) %>%
+        as.data.frame(stringsAsFactors = FALSE)
 
-      names(returnvalue)[i] <- tbl[1, 2] %>% as.character()
+      # case insensitive column names
+      colnames(tbl) <- tolower(colnames(tbl)) %>% gsub('^atc.*', 'atc', .)
 
-      if (!'Adm.R' %in% colnames(tbl) | is.na(tbl[1, 'Adm.R'])) {
+      if (length(tbl) == 0) {
+        warning('ATC not found: ', atc_code[i], '. Please check ', atc_url, '.', call. = FALSE)
         returnvalue[i] <- NA
         next
+      }
+
+      if (property %in% c('atc', 'name')) {
+        # ATC and name are only in first row
+        returnvalue[i] <- tbl[1, property]
       } else {
-        for (j in 1:nrow(tbl)) {
+        if (!'adm.r' %in% colnames(tbl) | is.na(tbl[1, 'adm.r'])) {
-          if (tbl[j, 'Adm.R'] == administration) {
+          returnvalue[i] <- NA
-            returnvalue[i] <- tbl[j, property]
+          next
+        } else {
+          for (j in 1:nrow(tbl)) {
+            if (tbl[j, 'adm.r'] == administration) {
+              returnvalue[i] <- tbl[j, property]
+            }
           }
         }
       }
     }
   }
 
-  cat('\n')
+  if (property == "groups" & length(returnvalue) == 1) {
-  returnvalue
+    returnvalue <- returnvalue[[1]]
+  }
 
+  returnvalue
+}
+
+#' @rdname atc_property
+#' @export
+atc_groups <- function(atc_code, ...) {
+  atc_property(atc_code = atc_code, property = "groups", ...)
+}
+
+#' @rdname atc_property
+#' @export
+atc_ddd <- function(atc_code, ...) {
+  atc_property(atc_code = atc_code, property = "ddd", ...)
 }
 
 #' Name of an antibiotic
 #'
 #' Convert antibiotic codes (from a laboratory information system like MOLIS or GLIMS) to a (trivial) antibiotic name or ATC code, or vice versa. This uses the data from \code{\link{antibiotics}}.
 #' @param abcode a code or name, like \code{"AMOX"}, \code{"AMCL"} or \code{"J01CA04"}
-#' @param from,to type to transform from and to. See \code{\link{antibiotics}} for its column names. WIth \code{from = "guess"} the from will be guessed from \code{"atc"}, \code{"molis"} and \code{"umcg"}.
+#' @param from,to type to transform from and to. See \code{\link{antibiotics}} for its column names. WIth \code{from = "guess"} the from will be guessed from \code{"atc"}, \code{"molis"} and \code{"umcg"}. When using \code{to = "atc"}, the ATC code will be search using \code{\link{guess_atc}}.
 #' @param textbetween text to put between multiple returned texts
 #' @param tolower return output as lower case with function \code{\link{tolower}}.
 #' @keywords ab antibiotics
@@ -156,6 +234,14 @@ atc_property <- function(atc_code,
 #' # "AMCL"
 abname <- function(abcode, from = c("guess", "atc", "molis", "umcg"), to = 'official', textbetween = ' + ', tolower = FALSE) {
 
+  if (length(to) != 1L) {
+    stop('`to` must be of length 1', call. = FALSE)
+  }
+
+  if (to == "atc") {
+    return(guess_atc(abcode))
+  }
+
   antibiotics <- AMR::antibiotics
 
   from <- from[1]
@@ -291,12 +377,12 @@ guess_atc <- function(x) {
 
     if (nrow(found) == 0) {
       # try abbreviation of molis and glims
-      found <- AMR::antibiotics %>% filter(molis == x[i] | umcg == x[i])
+      found <- AMR::antibiotics %>% filter(tolower(molis) == tolower(x[i]) | tolower(umcg) == tolower(x[i]))
     }
 
     if (nrow(found) == 0) {
       # try exact official name
-      found <- AMR::antibiotics[which(AMR::antibiotics$official == x[i]),]
+      found <- AMR::antibiotics[which(tolower(AMR::antibiotics$official) == tolower(x[i])),]
     }
 
     if (nrow(found) == 0) {

R/classes.R

@@ -30,6 +30,9 @@
 #' rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370), "A", "B", "C"))
 #' is.rsi(rsi_data)
 #'
+#' # this can also coerce combined MIC/RSI values:
+#' as.rsi("<= 0.002; R") # will return R
+#'
 #' plot(rsi_data)    # for percentages
 #' barplot(rsi_data) # for frequencies
 as.rsi <- function(x) {
@@ -204,6 +207,9 @@ barplot.rsi <- function(height, ...) {
 #' mic_data <- as.mic(c(">=32", "1.0", "1", "1.00", 8, "<=0.128", "8", "16", "16"))
 #' is.mic(mic_data)
 #'
+#' # this can also coerce combined MIC/RSI values:
+#' as.mic("<=0.002; R") # will return <=0.002
+#'
 #' plot(mic_data)
 #' barplot(mic_data)
 as.mic <- function(x, na.rm = FALSE) {
@@ -216,8 +222,10 @@ as.mic <- function(x, na.rm = FALSE) {
     }
     x.bak <- x
 
-    # comma to dot
+    # comma to period
     x <- gsub(',', '.', x, fixed = TRUE)
+    # remove space between operator and number ("<= 0.002" -> "<=0.002")
+    x <- gsub('(<|=|>) +', '\\1', x)
     # starting dots must start with 0
     x <- gsub('^[.]+', '0.', x)
     # <=0.2560.512 should be 0.512
@@ -228,8 +236,10 @@ as.mic <- function(x, na.rm = FALSE) {
     x <- gsub('[^0-9]+$', '', x)
     # remove last zeroes
     x <- gsub('[.]?0+$', '', x)
+    # force to be character
+    x <- as.character(x)
 
-    # these are alllowed MIC values and will be factor levels
+    # these are alllowed MIC values and will become factor levels
     lvls <- c("<0.002", "<=0.002", "0.002", ">=0.002", ">0.002",
               "<0.003", "<=0.003", "0.003", ">=0.003", ">0.003",
               "<0.004", "<=0.004", "0.004", ">=0.004", ">0.004",
@@ -286,7 +296,6 @@ as.mic <- function(x, na.rm = FALSE) {
               "<320", "<=320", "320", ">=320", ">320",
               "<512", "<=512", "512", ">=512", ">512",
               "<1024", "<=1024", "1024", ">=1024", ">1024")
-    x <- x %>% as.character()
 
     na_before <- x[is.na(x) | x == ''] %>% length()
     x[!x %in% lvls] <- NA

R/first_isolates.R

@@ -173,7 +173,6 @@ first_isolate <- function(tbl,
     filter_specimen <- ''
   }
 
-  specgroup.notice <- ''
   weighted.notice <- ''
   # filter on specimen group and keyantibiotics when they are filled in
   if (!is.na(filter_specimen) & filter_specimen != '') {
@@ -197,13 +196,12 @@ first_isolate <- function(tbl,
   # create new dataframe with original row index and right sorting
   tbl <- tbl %>%
     mutate(first_isolate_row_index = 1:nrow(tbl),
-           eersteisolaatbepaling = 0,
            date_lab = tbl %>% pull(col_date),
            patient_id = tbl %>% pull(col_patient_id),
            species = tbl %>% pull(col_species),
            genus = tbl %>% pull(col_genus)) %>%
-    mutate(species = if_else(is.na(species), '', species),
+    mutate(species = if_else(is.na(species) | species == "(no MO)", "", species),
-           genus = if_else(is.na(genus), '', genus))
+           genus = if_else(is.na(genus) | genus == "(no MO)", "", genus))
 
   if (filter_specimen == '') {
 
@@ -380,7 +378,7 @@ first_isolate <- function(tbl,
 
   # NA's where genus is unavailable
   all_first <- all_first %>%
-    mutate(real_first_isolate = if_else(genus == '', NA, real_first_isolate))
+    mutate(real_first_isolate = if_else(genus %in% c('', '(no MO)', NA), NA, real_first_isolate))
 
   all_first <- all_first %>%
     arrange(first_isolate_row_index) %>%

R/guess_bactid.R

@@ -44,7 +44,7 @@
 #' # and can even contain 2 columns, which is convenient for genus/species combinations:
 #' df$bactid <- df %>% select(genus, species) %>% guess_bactid()
 #' # same result:
-#' df <- df %>% mutate(bactid = paste(genus, species) %>% guess_bactid())
+#' df <- df %>% mutate(bactid = paste(genus, species)) %>% guess_bactid())
 #' }
 guess_bactid <- function(x) {
 

man/abname.Rd

@@ -13,7 +13,7 @@ abname(abcode, from = c("guess", "atc", "molis", "umcg"), to = "official",
 \arguments{
 \item{abcode}{a code or name, like \code{"AMOX"}, \code{"AMCL"} or \code{"J01CA04"}}
 
-\item{from, to}{type to transform from and to. See \code{\link{antibiotics}} for its column names. WIth \code{from = "guess"} the from will be guessed from \code{"atc"}, \code{"molis"} and \code{"umcg"}.}
+\item{from, to}{type to transform from and to. See \code{\link{antibiotics}} for its column names. WIth \code{from = "guess"} the from will be guessed from \code{"atc"}, \code{"molis"} and \code{"umcg"}. When using \code{to = "atc"}, the ATC code will be search using \code{\link{guess_atc}}.}
 
 \item{textbetween}{text to put between multiple returned texts}
 

man/as.mic.Rd

@@ -24,6 +24,9 @@ This transforms a vector to a new class\code{mic}, which is an ordered factor wi
 mic_data <- as.mic(c(">=32", "1.0", "1", "1.00", 8, "<=0.128", "8", "16", "16"))
 is.mic(mic_data)
 
+# this can also coerce combined MIC/RSI values:
+as.mic("<=0.002; R") # will return <=0.002
+
 plot(mic_data)
 barplot(mic_data)
 }

man/as.rsi.Rd

@@ -23,6 +23,9 @@ rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370)))
 rsi_data <- as.rsi(c(rep("S", 474), rep("I", 36), rep("R", 370), "A", "B", "C"))
 is.rsi(rsi_data)
 
+# this can also coerce combined MIC/RSI values:
+as.rsi("<= 0.002; R") # will return R
+
 plot(rsi_data)    # for percentages
 barplot(rsi_data) # for frequencies
 }

man/atc_property.Rd

@@ -2,6 +2,8 @@
 % Please edit documentation in R/atc.R
 \name{atc_property}
 \alias{atc_property}
+\alias{atc_groups}
+\alias{atc_ddd}
 \title{Properties of an ATC code}
 \source{
 \url{https://www.whocc.no/atc_ddd_alterations__cumulative/ddd_alterations/abbrevations/}
@@ -9,21 +11,27 @@
 \usage{
 atc_property(atc_code, property, administration = "O",
   url = "https://www.whocc.no/atc_ddd_index/?code=\%s&showdescription=no")
+
+atc_groups(atc_code, ...)
+
+atc_ddd(atc_code, ...)
 }
 \arguments{
 \item{atc_code}{a character or character vector with ATC code(s) of antibiotic(s)}
 
-\item{property}{property of an ATC code. Valid values are \code{"ATC code"}, \code{"Name"}, \code{"DDD"}, \code{"U"} (\code{"unit"}), \code{"Adm.R"} en \code{"Note"}.}
+\item{property}{property of an ATC code. Valid values are \code{"ATC"}, \code{"Name"}, \code{"DDD"}, \code{"U"} (\code{"unit"}), \code{"Adm.R"}, \code{"Note"} and \code{groups}. For this last option, all hierarchical groups of an ATC code will be returned, see Examples.}
 
-\item{administration}{type of administration, see \emph{Details}}
+\item{administration}{type of administration when using \code{property = "Adm.R"}, see Details}
 
 \item{url}{url of website of the WHO. The sign \code{\%s} can be used as a placeholder for ATC codes.}
+
+\item{...}{parameters to pass on to \code{atc_property}}
 }
 \description{
-Gets data from the WHO to determine properties of an ATC (e.g. an antibiotic) like name, defined daily dose (DDD) or standard unit. \strong{This function requires an internet connection.}
+Gets data from the WHO to determine properties of an ATC (e.g. an antibiotic) like name, defined daily dose (DDD) or standard unit. \cr \strong{This function requires an internet connection.}
 }
 \details{
-Abbreviations for the property \code{"Adm.R"} (parameter \code{administration}):
+Options for parameter \code{administration}:
 \itemize{
   \item{\code{"Implant"}}{ = Implant}
   \item{\code{"Inhal"}}{ = Inhalation}
@@ -37,7 +45,7 @@ Abbreviations for the property \code{"Adm.R"} (parameter \code{administration}):
   \item{\code{"V"}}{ = vaginal}
 }
 
-Abbreviations for the property \code{"U"} (unit):
+Abbreviations of return values when using \code{property = "U"} (unit):
 \itemize{
   \item{\code{"g"}}{ = gram}
   \item{\code{"mg"}}{ = milligram}
@@ -51,7 +59,19 @@ Abbreviations for the property \code{"U"} (unit):
 }
 \examples{
 \donttest{
-atc_property("J01CA04", "DDD", "O") # oral DDD (Defined Daily Dose) of amoxicillin
+# What's the ATC of amoxicillin?
-atc_property("J01CA04", "DDD", "P") # parenteral DDD (Defined Daily Dose) of amoxicillin
+guess_atc("Amoxicillin")
+# [1] "J01CA04"
+
+# oral DDD (Defined Daily Dose) of amoxicillin
+atc_property("J01CA04", "DDD", "O")
+# parenteral DDD (Defined Daily Dose) of amoxicillin
+atc_property("J01CA04", "DDD", "P")
+
+atc_property("J01CA04", property = "groups") # search hierarchical groups of amoxicillin
+# [1] "ANTIINFECTIVES FOR SYSTEMIC USE"
+# [2] "ANTIBACTERIALS FOR SYSTEMIC USE"
+# [3] "BETA-LACTAM ANTIBACTERIALS, PENICILLINS"
+# [4] "Penicillins with extended spectrum"
 }
 }

man/guess_bactid.Rd

@@ -35,7 +35,7 @@ df$bactid <- df \%>\% select(microorganism_name) \%>\% guess_bactid()
 # and can even contain 2 columns, which is convenient for genus/species combinations:
 df$bactid <- df \%>\% select(genus, species) \%>\% guess_bactid()
 # same result:
-df <- df \%>\% mutate(bactid = paste(genus, species) \%>\% guess_bactid())
+df <- df \%>\% mutate(bactid = paste(genus, species)) \%>\% guess_bactid())
 }
 }
 \seealso{

tests/testthat/test-atc.R

@@ -3,6 +3,9 @@ context("atc.R")
 test_that("atc_property works", {
   expect_equal(tolower(atc_property("J01CA04", property = "Name")), "amoxicillin")
   expect_equivalent(atc_property("J01CA04", "DDD"), 1)
+  expect_equal(length(atc_property("J01CA04", property = "Groups")), 4)
+  expect_error(atc_property("J01CA04", property = c(1:5)))
+  expect_error(atc_property("J01CA04", administration = c(1:5)))
 })
 
 test_that("abname works", {

tests/testthat/test-first_isolates.R

@@ -8,46 +8,57 @@ test_that("keyantibiotics work", {
 })
 
 test_that("first isolates work", {
-  # septic_patients contains 1960 out of 2000 first isolates
+  # septic_patients contains 1959 out of 2000 first isolates
-  #septic_ptns <- septic_patients
-  expect_equal(sum(first_isolate(tbl = septic_patients,
-                                 col_date = "date",
-                                 col_patient_id = "patient_id",
-                                 col_bactid = "bactid",
-                                 info = FALSE)), 1960)
-
-  # septic_patients contains 1962 out of 2000 first *weighted* isolates
   expect_equal(
-    suppressWarnings(sum(
+    sum(
-      first_isolate(tbl = septic_patients %>% mutate(keyab = key_antibiotics(.)),
+      first_isolate(tbl = septic_patients,
                     col_date = "date",
                     col_patient_id = "patient_id",
                     col_bactid = "bactid",
-                    col_keyantibiotics = "keyab",
+                    info = FALSE),
-                    type = "keyantibiotics",
+      na.rm = TRUE), 1959)
-                    info = TRUE))),
-    1962)
 
-  # septic_patients contains 1733 out of 2000 first non-ICU isolates
+  # septic_patients contains 1961 out of 2000 first *weighted* isolates
+  expect_equal(
+    suppressWarnings(
+      sum(
+        first_isolate(tbl = septic_patients %>% mutate(keyab = key_antibiotics(.)),
+                      col_date = "date",
+                      col_patient_id = "patient_id",
+                      col_bactid = "bactid",
+                      col_keyantibiotics = "keyab",
+                      type = "keyantibiotics",
+                      info = TRUE),
+        na.rm = TRUE)),
+    1961)
+
+  # septic_patients contains 1732 out of 2000 first non-ICU isolates
   expect_equal(
     sum(
-      first_isolate(septic_patients, col_bactid = "bactid", col_date = "date", col_patient_id = "patient_id", col_icu = "ward_icu", info = TRUE, icu_exclude = TRUE)),
+      first_isolate(septic_patients,
-    1733
+                    col_bactid = "bactid",
-  )
+                    col_date = "date",
+                    col_patient_id = "patient_id",
+                    col_icu = "ward_icu",
+                    info = TRUE,
+                    icu_exclude = TRUE),
+      na.rm = TRUE),
+    1732)
 
   # set 1500 random observations to be of specimen type 'Urine'
   random_rows <- sample(x = 1:2000, size = 1500, replace = FALSE)
-  expect_lt(sum(
+  expect_lt(
-    first_isolate(tbl = mutate(septic_patients,
+    sum(
-                               specimen = if_else(row_number() %in% random_rows,
+      first_isolate(tbl = mutate(septic_patients,
-                                                  "Urine",
+                                 specimen = if_else(row_number() %in% random_rows,
-                                                  "Unknown")),
+                                                    "Urine",
-                  col_date = "date",
+                                                    "Unknown")),
-                  col_patient_id = "patient_id",
+                    col_date = "date",
-                  col_bactid = "bactid",
+                    col_patient_id = "patient_id",
-                  col_specimen = "specimen",
+                    col_bactid = "bactid",
-                  filter_specimen = "Urine",
+                    col_specimen = "specimen",
-                  info = TRUE)),
+                    filter_specimen = "Urine",
+                    info = TRUE),
+      na.rm = TRUE),
     1501)
-
 })