From bdc860e29ccafa2d562b7d650891649931614354 Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Tue, 19 Jun 2018 10:05:38 +0200 Subject: [PATCH] atc_groups --- DESCRIPTION | 5 +- NAMESPACE | 5 + NEWS.md | 13 ++- R/atc.R | 158 +++++++++++++++++++++------ R/classes.R | 15 ++- R/first_isolates.R | 8 +- R/guess_bactid.R | 2 +- man/abname.Rd | 2 +- man/as.mic.Rd | 3 + man/as.rsi.Rd | 3 + man/atc_property.Rd | 34 ++++-- man/guess_bactid.Rd | 2 +- tests/testthat/test-atc.R | 3 + tests/testthat/test-first_isolates.R | 73 +++++++------ 14 files changed, 234 insertions(+), 92 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 37bbb549..19612e20 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 0.2.0.9003 -Date: 2018-06-08 +Version: 0.2.0.9004 +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), diff --git a/NAMESPACE b/NAMESPACE index c74fb9c2..7b08ed4e 100755 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index c94f4c8f..2d487ebc 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,11 +1,14 @@ # 0.2.0.90xx (development version) -* Vignettes 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)` -* Renamed `toConsole` parameter of `freq` to `as.data.frame` +* New vignette about frequency tables +* 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` 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"` -* 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 +* 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` +* 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 diff --git a/R/atc.R b/R/atc.R index 444d4610..a0737dce 100755 --- a/R/atc.R +++ b/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 administration type of administration, see \emph{Details} +#' @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 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 -#' atc_property("J01CA04", "DDD", "P") # parenteral DDD (Defined Daily Dose) of amoxicillin +#' # What's the ATC 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 <- valid_properties.bak #%>% tolower() + valid_properties <- c("ATC", "Name", "DDD", "U", "Adm.R", "Note", "groups") + 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) { - warning('ATC not found: ', atc_code[i], '. Please check ', atc_url, '.', call. = FALSE) - returnvalue[i] <- NA - next - } + if (property == "groups") { + tbl <- xml2::read_html(atc_url) %>% + rvest::html_node("#content") %>% + 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 (tbl[j, 'Adm.R'] == administration) { - returnvalue[i] <- tbl[j, property] + if (!'adm.r' %in% colnames(tbl) | is.na(tbl[1, 'adm.r'])) { + returnvalue[i] <- NA + next + } else { + for (j in 1:nrow(tbl)) { + if (tbl[j, 'adm.r'] == administration) { + returnvalue[i] <- tbl[j, property] + } } } } } } - cat('\n') - returnvalue + if (property == "groups" & length(returnvalue) == 1) { + 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) { diff --git a/R/classes.R b/R/classes.R index 4a55d210..fa353cc1 100755 --- a/R/classes.R +++ b/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 diff --git a/R/first_isolates.R b/R/first_isolates.R index f64847d1..a9d459a7 100755 --- a/R/first_isolates.R +++ b/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), - genus = if_else(is.na(genus), '', genus)) + mutate(species = if_else(is.na(species) | species == "(no MO)", "", species), + 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) %>% diff --git a/R/guess_bactid.R b/R/guess_bactid.R index 9194c4c8..7d52960a 100644 --- a/R/guess_bactid.R +++ b/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) { diff --git a/man/abname.Rd b/man/abname.Rd index 6163e2ca..9338498b 100755 --- a/man/abname.Rd +++ b/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} diff --git a/man/as.mic.Rd b/man/as.mic.Rd index f72ff003..448c0aa2 100755 --- a/man/as.mic.Rd +++ b/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) } diff --git a/man/as.rsi.Rd b/man/as.rsi.Rd index f7eec124..d9d9a641 100755 --- a/man/as.rsi.Rd +++ b/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 } diff --git a/man/atc_property.Rd b/man/atc_property.Rd index c4e5a6cd..afda0e59 100755 --- a/man/atc_property.Rd +++ b/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 -atc_property("J01CA04", "DDD", "P") # parenteral DDD (Defined Daily Dose) of amoxicillin +# What's the ATC 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" } } diff --git a/man/guess_bactid.Rd b/man/guess_bactid.Rd index 729a478a..f86c197d 100755 --- a/man/guess_bactid.Rd +++ b/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{ diff --git a/tests/testthat/test-atc.R b/tests/testthat/test-atc.R index 8fc674ef..81da027f 100755 --- a/tests/testthat/test-atc.R +++ b/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", { diff --git a/tests/testthat/test-first_isolates.R b/tests/testthat/test-first_isolates.R index f8228250..4a3e62c9 100755 --- a/tests/testthat/test-first_isolates.R +++ b/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_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 + # septic_patients contains 1959 out of 2000 first isolates expect_equal( - suppressWarnings(sum( - first_isolate(tbl = septic_patients %>% mutate(keyab = key_antibiotics(.)), + sum( + first_isolate(tbl = septic_patients, col_date = "date", col_patient_id = "patient_id", col_bactid = "bactid", - col_keyantibiotics = "keyab", - type = "keyantibiotics", - info = TRUE))), - 1962) + info = FALSE), + na.rm = TRUE), 1959) - # 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)), - 1733 - ) + first_isolate(septic_patients, + 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( - first_isolate(tbl = mutate(septic_patients, - specimen = if_else(row_number() %in% random_rows, - "Urine", - "Unknown")), - col_date = "date", - col_patient_id = "patient_id", - col_bactid = "bactid", - col_specimen = "specimen", - filter_specimen = "Urine", - info = TRUE)), + expect_lt( + sum( + first_isolate(tbl = mutate(septic_patients, + specimen = if_else(row_number() %in% random_rows, + "Urine", + "Unknown")), + col_date = "date", + col_patient_id = "patient_id", + col_bactid = "bactid", + col_specimen = "specimen", + filter_specimen = "Urine", + info = TRUE), + na.rm = TRUE), 1501) - })