diff --git a/DESCRIPTION b/DESCRIPTION index e02add6c..0bd2818e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.8.2.9096 -Date: 2023-01-21 +Version: 1.8.2.9098 +Date: 2023-01-23 Title: Antimicrobial Resistance Data Analysis Description: Functions to simplify and standardise antimicrobial resistance (AMR) data analysis and to work with microbial and antimicrobial properties by diff --git a/NEWS.md b/NEWS.md index b4e911e3..17bcef3f 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 1.8.2.9096 +# AMR 1.8.2.9098 *(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)* diff --git a/R/aa_amr-package.R b/R/aa_amr-package.R index 106c75d1..8041b77d 100755 --- a/R/aa_amr-package.R +++ b/R/aa_amr-package.R @@ -33,11 +33,11 @@ #' Welcome to the `AMR` package. #' #' The `AMR` package is a [free and open-source](https://msberends.github.io/AMR/#copyright) R package with [zero dependencies](https://en.wikipedia.org/wiki/Dependency_hell) to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting. [Many different researchers](https://msberends.github.io/AMR/authors.html) from around the globe are continually helping us to make this a successful and durable project! -#' +#' #' This work was published in the Journal of Statistical Software (Volume 104(3); [DOI 10.18637/jss.v104.i03](https://doi.org/10.18637/jss.v104.i03)) and formed the basis of two PhD theses ([DOI 10.33612/diss.177417131](https://doi.org/10.33612/diss.177417131) and [DOI 10.33612/diss.192486375](https://doi.org/10.33612/diss.192486375)). -#' +#' #' After installing this package, R knows [**`r format_included_data_number(AMR::microorganisms)`**](https://msberends.github.io/AMR/reference/microorganisms.html) (updated December 2022) and all [**~600 antibiotic, antimycotic and antiviral drugs**](https://msberends.github.io/AMR/reference/antibiotics.html) by name and code (including ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid SIR and MIC values. The integral breakpoint guidelines from CLSI and EUCAST are included from the last 10 years. It supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl), in collaboration with non-profit organisations [Certe Medical Diagnostics and Advice Foundation](https://www.certe.nl) and [University Medical Center Groningen](https://www.umcg.nl). -#' +#' #' The `AMR` package is available in English, Chinese, Danish, Dutch, French, German, Greek, Italian, Japanese, Polish, Portuguese, Russian, Spanish, Swedish, Turkish and Ukrainian. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages. #' @section Reference Data Publicly Available: #' All data sets in this `AMR` package (about microorganisms, antibiotics, SIR interpretation, EUCAST rules, etc.) are publicly and freely available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. We also provide tab-separated plain text files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw). diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index bd0dc6a2..dc81656c 100755 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -49,12 +49,13 @@ pm_left_join <- function(x, y, by = NULL, suffix = c(".x", ".y")) { merged <- cbind( x, - y[match( - x[, by[1], drop = TRUE], - y[, by[2], drop = TRUE] - ), - colnames(y)[!colnames(y) %in% colnames(x) & !colnames(y) == by[2]], - drop = FALSE + y[ + match( + x[, by[1], drop = TRUE], + y[, by[2], drop = TRUE] + ), + colnames(y)[!colnames(y) %in% colnames(x) & !colnames(y) == by[2]], + drop = FALSE ] ) @@ -190,12 +191,13 @@ addin_insert_like <- function() { ) } replace_pos <- function(old, with) { - modifyRange(document_range( - document_position(current_row, current_col - nchar(old)), - document_position(current_row, current_col) - ), - text = with, - id = context$id + modifyRange( + document_range( + document_position(current_row, current_col - nchar(old)), + document_position(current_row, current_col) + ), + text = with, + id = context$id ) } @@ -226,7 +228,7 @@ search_type_in_df <- function(x, type, info = TRUE) { # -- mo if (type == "mo") { add_MO_lookup_to_AMR_env() - + if (any(vapply(FUN.VALUE = logical(1), x, is.mo))) { # take first 'mo' column found <- colnames(x)[vapply(FUN.VALUE = logical(1), x, is.mo)] @@ -253,11 +255,12 @@ search_type_in_df <- function(x, type, info = TRUE) { # WHONET support found <- sort(colnames(x)[colnames_formatted %like_case% "^(specimen date|specimen_date|spec_date)"]) if (!inherits(pm_pull(x, found), c("Date", "POSIXct"))) { - stop(font_red(paste0( - "Found column '", font_bold(found), "' to be used as input for `col_", type, - "`, but this column contains no valid dates. Transform its values to valid dates first." - )), - call. = FALSE + stop( + font_red(paste0( + "Found column '", font_bold(found), "' to be used as input for `col_", type, + "`, but this column contains no valid dates. Transform its values to valid dates first." + )), + call. = FALSE ) } } else if (any(vapply(FUN.VALUE = logical(1), x, function(x) inherits(x, c("Date", "POSIXct"))))) { @@ -319,21 +322,23 @@ search_type_in_df <- function(x, type, info = TRUE) { } is_valid_regex <- function(x) { - regex_at_all <- tryCatch(vapply( - FUN.VALUE = logical(1), - X = strsplit(x, "", fixed = TRUE), - FUN = function(y) { - any(y %in% c( - "$", "(", ")", "*", "+", "-", - ".", "?", "[", "]", "^", "{", - "|", "}", "\\" - ), - na.rm = TRUE - ) - }, - USE.NAMES = FALSE - ), - error = function(e) rep(TRUE, length(x)) + regex_at_all <- tryCatch( + vapply( + FUN.VALUE = logical(1), + X = strsplit(x, "", fixed = TRUE), + FUN = function(y) { + any( + y %in% c( + "$", "(", ")", "*", "+", "-", + ".", "?", "[", "]", "^", "{", + "|", "}", "\\" + ), + na.rm = TRUE + ) + }, + USE.NAMES = FALSE + ), + error = function(e) rep(TRUE, length(x)) ) regex_valid <- vapply( FUN.VALUE = logical(1), @@ -410,16 +415,17 @@ word_wrap <- function(..., if (msg %like% "\n") { # run word_wraps() over every line here, bind them and return again - return(paste0(vapply( - FUN.VALUE = character(1), - trimws(unlist(strsplit(msg, "\n", fixed = TRUE)), which = "right"), - word_wrap, - add_fn = add_fn, - as_note = FALSE, - width = width, - extra_indent = extra_indent - ), - collapse = "\n" + return(paste0( + vapply( + FUN.VALUE = character(1), + trimws(unlist(strsplit(msg, "\n", fixed = TRUE)), which = "right"), + word_wrap, + add_fn = add_fn, + as_note = FALSE, + width = width, + extra_indent = extra_indent + ), + collapse = "\n" )) } @@ -429,11 +435,12 @@ word_wrap <- function(..., # we need to correct for already applied style, that adds text like "\033[31m\" msg_stripped <- font_stripstyle(msg) # where are the spaces now? - msg_stripped_wrapped <- paste0(strwrap(msg_stripped, - simplify = TRUE, - width = width - ), - collapse = "\n" + msg_stripped_wrapped <- paste0( + strwrap(msg_stripped, + simplify = TRUE, + width = width + ), + collapse = "\n" ) msg_stripped_wrapped <- paste0(unlist(strsplit(msg_stripped_wrapped, "(\n|\\*\\|\\*)")), collapse = "\n" @@ -487,11 +494,12 @@ message_ <- function(..., appendLF = TRUE, add_fn = list(font_blue), as_note = TRUE) { - message(word_wrap(..., - add_fn = add_fn, - as_note = as_note - ), - appendLF = appendLF + message( + word_wrap(..., + add_fn = add_fn, + as_note = as_note + ), + appendLF = appendLF ) } @@ -499,12 +507,13 @@ warning_ <- function(..., add_fn = list(), immediate = FALSE, call = FALSE) { - warning(word_wrap(..., - add_fn = add_fn, - as_note = FALSE - ), - immediate. = immediate, - call. = call + warning( + word_wrap(..., + add_fn = add_fn, + as_note = FALSE + ), + immediate. = immediate, + call. = call ) } @@ -836,17 +845,18 @@ meet_criteria <- function(object, ) } if (!is.null(contains_column_class)) { - stop_ifnot(any(vapply( - FUN.VALUE = logical(1), - object, - function(col, columns_class = contains_column_class) { - inherits(col, columns_class) - } - ), na.rm = TRUE), - "the data provided in argument `", obj_name, - "` must contain at least one column of class <", contains_column_class, ">. ", - "See ?as.", contains_column_class, ".", - call = call_depth + stop_ifnot( + any(vapply( + FUN.VALUE = logical(1), + object, + function(col, columns_class = contains_column_class) { + inherits(col, columns_class) + } + ), na.rm = TRUE), + "the data provided in argument `", obj_name, + "` must contain at least one column of class <", contains_column_class, ">. ", + "See ?as.", contains_column_class, ".", + call = call_depth ) } return(invisible()) @@ -1314,7 +1324,6 @@ round2 <- function(x, digits = 1, force_zero = TRUE) { # percentage from our other package: 'cleaner' percentage <- function(x, digits = NULL, ...) { - # getdecimalplaces() function getdecimalplaces <- function(x, minimum = 0, maximum = 3) { if (maximum < minimum) { @@ -1330,12 +1339,13 @@ percentage <- function(x, digits = NULL, ...) { ), ".", fixed = TRUE), function(y) ifelse(length(y) == 2, nchar(y[2]), 0) )), na.rm = TRUE) - max(min(max_places, - maximum, + max( + min(max_places, + maximum, + na.rm = TRUE + ), + minimum, na.rm = TRUE - ), - minimum, - na.rm = TRUE ) } @@ -1366,11 +1376,12 @@ percentage <- function(x, digits = NULL, ...) { # max one digit if undefined digits <- getdecimalplaces(x, minimum = 0, maximum = 1) } - format_percentage(structure( - .Data = as.double(x), - class = c("percentage", "numeric") - ), - digits = digits, ... + format_percentage( + structure( + .Data = as.double(x), + class = c("percentage", "numeric") + ), + digits = digits, ... ) } @@ -1385,7 +1396,7 @@ add_MO_lookup_to_AMR_env <- function() { # for all MO functions, saves a lot of time on package load and in package size if (is.null(AMR_env$MO_lookup)) { MO_lookup <- AMR::microorganisms - + MO_lookup$kingdom_index <- NA_real_ MO_lookup[which(MO_lookup$kingdom == "Bacteria" | MO_lookup$mo == "UNKNOWN"), "kingdom_index"] <- 1 MO_lookup[which(MO_lookup$kingdom == "Fungi"), "kingdom_index"] <- 2 @@ -1393,7 +1404,7 @@ add_MO_lookup_to_AMR_env <- function() { MO_lookup[which(MO_lookup$kingdom == "Archaea"), "kingdom_index"] <- 4 # all the rest MO_lookup[which(is.na(MO_lookup$kingdom_index)), "kingdom_index"] <- 5 - + # the fullname lowercase, important for the internal algorithms in as.mo() MO_lookup$fullname_lower <- tolower(trimws(paste( MO_lookup$genus, @@ -1405,7 +1416,7 @@ add_MO_lookup_to_AMR_env <- function() { MO_lookup$fullname_lower <- trimws(gsub("[^.a-z0-9/ \\-]+", "", MO_lookup$fullname_lower, perl = TRUE)) # special for Salmonella - they have cities as subspecies but not the species (enterica) in the fullname: MO_lookup$fullname_lower[which(MO_lookup$subspecies %like_case% "^[A-Z]")] <- gsub(" enterica ", " ", MO_lookup$fullname_lower[which(MO_lookup$subspecies %like_case% "^[A-Z]")], fixed = TRUE) - + MO_lookup$full_first <- substr(MO_lookup$fullname_lower, 1, 1) MO_lookup$species_first <- tolower(substr(MO_lookup$species, 1, 1)) # tolower for groups (Streptococcus, Salmonella) MO_lookup$subspecies_first <- tolower(substr(MO_lookup$subspecies, 1, 1)) # tolower for Salmonella serovars diff --git a/R/ab.R b/R/ab.R index f80644f6..6b4e9e06 100755 --- a/R/ab.R +++ b/R/ab.R @@ -87,7 +87,6 @@ #' #' \donttest{ #' if (require("dplyr")) { -#' #' # you can quickly rename 'sir' columns using set_ab_names() with dplyr: #' example_isolates %>% #' set_ab_names(where(is.sir), property = "atc") @@ -338,22 +337,23 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) { } # transform back from other languages and try again - x_translated <- paste(lapply( - strsplit(x[i], "[^A-Z0-9]"), - function(y) { - for (i in seq_len(length(y))) { - for (lang in LANGUAGES_SUPPORTED[LANGUAGES_SUPPORTED != "en"]) { - y[i] <- ifelse(tolower(y[i]) %in% tolower(TRANSLATIONS[, lang, drop = TRUE]), - TRANSLATIONS[which(tolower(TRANSLATIONS[, lang, drop = TRUE]) == tolower(y[i]) & - !isFALSE(TRANSLATIONS$fixed)), "pattern"], - y[i] - ) + x_translated <- paste( + lapply( + strsplit(x[i], "[^A-Z0-9]"), + function(y) { + for (i in seq_len(length(y))) { + for (lang in LANGUAGES_SUPPORTED[LANGUAGES_SUPPORTED != "en"]) { + y[i] <- ifelse(tolower(y[i]) %in% tolower(TRANSLATIONS[, lang, drop = TRUE]), + TRANSLATIONS[which(tolower(TRANSLATIONS[, lang, drop = TRUE]) == tolower(y[i]) & + !isFALSE(TRANSLATIONS$fixed)), "pattern"], + y[i] + ) + } } + generalise_antibiotic_name(y) } - generalise_antibiotic_name(y) - } - )[[1]], - collapse = "/" + )[[1]], + collapse = "/" ) x_translated_guess <- suppressWarnings(as.ab(x_translated, initial_search = FALSE)) if (!is.na(x_translated_guess)) { @@ -362,20 +362,21 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) { } # now also try to coerce brandname combinations like "Amoxy/clavulanic acid" - x_translated <- paste(lapply( - strsplit(x_translated, "[^A-Z0-9 ]"), - function(y) { - for (i in seq_len(length(y))) { - y_name <- suppressWarnings(ab_name(y[i], language = NULL, initial_search = FALSE)) - y[i] <- ifelse(!is.na(y_name), - y_name, - y[i] - ) + x_translated <- paste( + lapply( + strsplit(x_translated, "[^A-Z0-9 ]"), + function(y) { + for (i in seq_len(length(y))) { + y_name <- suppressWarnings(ab_name(y[i], language = NULL, initial_search = FALSE)) + y[i] <- ifelse(!is.na(y_name), + y_name, + y[i] + ) + } + generalise_antibiotic_name(y) } - generalise_antibiotic_name(y) - } - )[[1]], - collapse = "/" + )[[1]], + collapse = "/" ) x_translated_guess <- suppressWarnings(as.ab(x_translated, initial_search = FALSE)) if (!is.na(x_translated_guess)) { @@ -513,8 +514,10 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) { ) } x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs] - x_unknown <- c(x_unknown, - AMR_env$ab_previously_coerced$x_bak[which(AMR_env$ab_previously_coerced$x %in% x & is.na(AMR_env$ab_previously_coerced$ab))]) + x_unknown <- c( + x_unknown, + AMR_env$ab_previously_coerced$x_bak[which(AMR_env$ab_previously_coerced$x %in% x & is.na(AMR_env$ab_previously_coerced$ab))] + ) if (length(x_unknown) > 0 && fast_mode == FALSE) { warning_( "in `as.ab()`: these values could not be coerced to a valid antimicrobial ID: ", @@ -660,9 +663,9 @@ get_translate_ab <- function(translate_ab) { } else { translate_ab <- tolower(translate_ab) stop_ifnot(translate_ab %in% colnames(AMR::antibiotics), - "invalid value for 'translate_ab', this must be a column name of the antibiotics data set\n", - "or TRUE (equals 'name') or FALSE to not translate at all.", - call = FALSE + "invalid value for 'translate_ab', this must be a column name of the antibiotics data set\n", + "or TRUE (equals 'name') or FALSE to not translate at all.", + call = FALSE ) translate_ab } diff --git a/R/ab_selectors.R b/R/ab_selectors.R index ffcacd78..ac61c1d0 100755 --- a/R/ab_selectors.R +++ b/R/ab_selectors.R @@ -95,20 +95,17 @@ #' # dplyr ------------------------------------------------------------------- #' \donttest{ #' if (require("dplyr")) { -#' #' # get AMR for all aminoglycosides e.g., per ward: #' example_isolates %>% #' group_by(ward) %>% #' summarise(across(aminoglycosides(), resistance)) #' } #' if (require("dplyr")) { -#' #' # You can combine selectors with '&' to be more specific: #' example_isolates %>% #' select(penicillins() & administrable_per_os()) #' } #' if (require("dplyr")) { -#' #' # get AMR for only drugs that matter - no intrinsic resistance: #' example_isolates %>% #' filter(mo_genus() %in% c("Escherichia", "Klebsiella")) %>% @@ -116,7 +113,6 @@ #' summarise(across(not_intrinsic_resistant(), resistance)) #' } #' if (require("dplyr")) { -#' #' # get susceptibility for antibiotics whose name contains "trim": #' example_isolates %>% #' filter(first_isolate()) %>% @@ -124,19 +120,16 @@ #' summarise(across(ab_selector(name %like% "trim"), susceptibility)) #' } #' if (require("dplyr")) { -#' #' # this will select columns 'IPM' (imipenem) and 'MEM' (meropenem): #' example_isolates %>% #' select(carbapenems()) #' } #' if (require("dplyr")) { -#' #' # this will select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB': #' example_isolates %>% #' select(mo, aminoglycosides()) #' } #' if (require("dplyr")) { -#' #' # any() and all() work in dplyr's filter() too: #' example_isolates %>% #' filter( @@ -145,25 +138,21 @@ #' ) #' } #' if (require("dplyr")) { -#' #' # also works with c(): #' example_isolates %>% #' filter(any(c(carbapenems(), aminoglycosides()) == "R")) #' } #' if (require("dplyr")) { -#' #' # not setting any/all will automatically apply all(): #' example_isolates %>% #' filter(aminoglycosides() == "R") #' } #' if (require("dplyr")) { -#' #' # this will select columns 'mo' and all antimycobacterial drugs ('RIF'): #' example_isolates %>% #' select(mo, ab_class("mycobact")) #' } #' if (require("dplyr")) { -#' #' # get bug/drug combinations for only glycopeptides in Gram-positives: #' example_isolates %>% #' filter(mo_is_gram_positive()) %>% @@ -179,7 +168,6 @@ #' select(penicillins()) # only the 'J01CA01' column will be selected #' } #' if (require("dplyr")) { -#' #' # with recent versions of dplyr this is all equal: #' x <- example_isolates[carbapenems() == "R", ] #' y <- example_isolates %>% filter(carbapenems() == "R") @@ -433,14 +421,16 @@ administrable_per_os <- function(only_sir_columns = FALSE, ...) { ab_group = "administrable_per_os", examples = paste0( " (such as ", - vector_or(ab_name(sample(agents_all, - size = min(5, length(agents_all)), - replace = FALSE - ), - tolower = TRUE, - language = NULL - ), - quotes = FALSE + vector_or( + ab_name( + sample(agents_all, + size = min(5, length(agents_all)), + replace = FALSE + ), + tolower = TRUE, + language = NULL + ), + quotes = FALSE ), ")" ) @@ -491,20 +481,21 @@ not_intrinsic_resistant <- function(only_sir_columns = FALSE, col_mo = NULL, ver sort = FALSE, fn = "not_intrinsic_resistant" ) # intrinsic vars - vars_df_R <- tryCatch(sapply( - eucast_rules(vars_df, - col_mo = col_mo, - version_expertrules = version_expertrules, - rules = "expert", - info = FALSE + vars_df_R <- tryCatch( + sapply( + eucast_rules(vars_df, + col_mo = col_mo, + version_expertrules = version_expertrules, + rules = "expert", + info = FALSE + ), + function(col) { + tryCatch(!any(is.na(col)) && all(col == "R"), + error = function(e) FALSE + ) + } ), - function(col) { - tryCatch(!any(is.na(col)) && all(col == "R"), - error = function(e) FALSE - ) - } - ), - error = function(e) stop_("in not_intrinsic_resistant(): ", e$message, call = FALSE) + error = function(e) stop_("in not_intrinsic_resistant(): ", e$message, call = FALSE) ) agents <- ab_in_data[ab_in_data %in% names(vars_df_R[which(vars_df_R)])] @@ -549,12 +540,13 @@ ab_select_exec <- function(function_name, if (message_not_thrown_before(function_name, "ab_class", "untreatable", entire_session = TRUE)) { warning_( "in `", function_name, "()`: some drugs were ignored since they cannot be used for treating patients: ", - vector_and(ab_name(names(ab_in_data)[names(ab_in_data) %in% untreatable], - language = NULL, - tolower = TRUE - ), - quotes = FALSE, - sort = TRUE + vector_and( + ab_name(names(ab_in_data)[names(ab_in_data) %in% untreatable], + language = NULL, + tolower = TRUE + ), + quotes = FALSE, + sort = TRUE ), ". They can be included using `", function_name, "(only_treatable = FALSE)`. ", "This warning will be shown once per session." ) @@ -593,11 +585,12 @@ ab_select_exec <- function(function_name, } ab_group <- function_name } - examples <- paste0(" (such as ", vector_or(ab_name(sample(abx, size = min(2, length(abx)), replace = FALSE), - tolower = TRUE, - language = NULL - ), - quotes = FALSE + examples <- paste0(" (such as ", vector_or( + ab_name(sample(abx, size = min(2, length(abx)), replace = FALSE), + tolower = TRUE, + language = NULL + ), + quotes = FALSE ), ")") } else { # this for the 'manual' ab_class() function @@ -821,11 +814,12 @@ find_ab_names <- function(ab_group, n = 3) { if (length(drugs) == 0) { return("??") } - vector_or(ab_name(sample(drugs, size = min(n, length(drugs)), replace = FALSE), - tolower = TRUE, - language = NULL - ), - quotes = FALSE + vector_or( + ab_name(sample(drugs, size = min(n, length(drugs)), replace = FALSE), + tolower = TRUE, + language = NULL + ), + quotes = FALSE ) } diff --git a/R/age.R b/R/age.R index 72843e27..02968656 100755 --- a/R/age.R +++ b/R/age.R @@ -83,11 +83,12 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) { # add decimals if (exact == TRUE) { # get dates of `x` when `x` would have the year of `reference` - x_in_reference_year <- as.POSIXlt(paste0( - format(as.Date(reference), "%Y"), - format(as.Date(x), "-%m-%d") - ), - format = "%Y-%m-%d" + x_in_reference_year <- as.POSIXlt( + paste0( + format(as.Date(reference), "%Y"), + format(as.Date(x), "-%m-%d") + ), + format = "%Y-%m-%d" ) # get differences in days n_days_x_rest <- as.double(difftime(as.Date(reference), diff --git a/R/av.R b/R/av.R index 786a1f39..c48b70f4 100755 --- a/R/av.R +++ b/R/av.R @@ -308,22 +308,23 @@ as.av <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) { } # transform back from other languages and try again - x_translated <- paste(lapply( - strsplit(x[i], "[^A-Z0-9]"), - function(y) { - for (i in seq_len(length(y))) { - for (lang in LANGUAGES_SUPPORTED[LANGUAGES_SUPPORTED != "en"]) { - y[i] <- ifelse(tolower(y[i]) %in% tolower(TRANSLATIONS[, lang, drop = TRUE]), - TRANSLATIONS[which(tolower(TRANSLATIONS[, lang, drop = TRUE]) == tolower(y[i]) & - !isFALSE(TRANSLATIONS$fixed)), "pattern"], - y[i] - ) + x_translated <- paste( + lapply( + strsplit(x[i], "[^A-Z0-9]"), + function(y) { + for (i in seq_len(length(y))) { + for (lang in LANGUAGES_SUPPORTED[LANGUAGES_SUPPORTED != "en"]) { + y[i] <- ifelse(tolower(y[i]) %in% tolower(TRANSLATIONS[, lang, drop = TRUE]), + TRANSLATIONS[which(tolower(TRANSLATIONS[, lang, drop = TRUE]) == tolower(y[i]) & + !isFALSE(TRANSLATIONS$fixed)), "pattern"], + y[i] + ) + } } + generalise_antibiotic_name(y) } - generalise_antibiotic_name(y) - } - )[[1]], - collapse = "/" + )[[1]], + collapse = "/" ) x_translated_guess <- suppressWarnings(as.av(x_translated, initial_search = FALSE)) if (!is.na(x_translated_guess)) { @@ -332,20 +333,21 @@ as.av <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) { } # now also try to coerce brandname combinations like "Amoxy/clavulanic acid" - x_translated <- paste(lapply( - strsplit(x_translated, "[^A-Z0-9 ]"), - function(y) { - for (i in seq_len(length(y))) { - y_name <- suppressWarnings(av_name(y[i], language = NULL, initial_search = FALSE)) - y[i] <- ifelse(!is.na(y_name), - y_name, - y[i] - ) + x_translated <- paste( + lapply( + strsplit(x_translated, "[^A-Z0-9 ]"), + function(y) { + for (i in seq_len(length(y))) { + y_name <- suppressWarnings(av_name(y[i], language = NULL, initial_search = FALSE)) + y[i] <- ifelse(!is.na(y_name), + y_name, + y[i] + ) + } + generalise_antibiotic_name(y) } - generalise_antibiotic_name(y) - } - )[[1]], - collapse = "/" + )[[1]], + collapse = "/" ) x_translated_guess <- suppressWarnings(as.av(x_translated, initial_search = FALSE)) if (!is.na(x_translated_guess)) { @@ -478,8 +480,10 @@ as.av <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) { ) } x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs] - x_unknown <- c(x_unknown, - AMR_env$av_previously_coerced$x_bak[which(AMR_env$av_previously_coerced$x %in% x & is.na(AMR_env$av_previously_coerced$av))]) + x_unknown <- c( + x_unknown, + AMR_env$av_previously_coerced$x_bak[which(AMR_env$av_previously_coerced$x %in% x & is.na(AMR_env$av_previously_coerced$av))] + ) if (length(x_unknown) > 0 && fast_mode == FALSE) { warning_( "in `as.av()`: these values could not be coerced to a valid antiviral drug ID: ", @@ -604,9 +608,9 @@ get_translate_av <- function(translate_av) { } else { translate_av <- tolower(translate_av) stop_ifnot(translate_av %in% colnames(AMR::antivirals), - "invalid value for 'translate_av', this must be a column name of the antivirals data set\n", - "or TRUE (equals 'name') or FALSE to not translate at all.", - call = FALSE + "invalid value for 'translate_av', this must be a column name of the antivirals data set\n", + "or TRUE (equals 'name') or FALSE to not translate at all.", + call = FALSE ) translate_av } diff --git a/R/av_from_text.R b/R/av_from_text.R index c90a2a98..4a35d1b4 100755 --- a/R/av_from_text.R +++ b/R/av_from_text.R @@ -69,26 +69,26 @@ av_from_text <- function(text, if (missing(type)) { type <- type[1L] } - + meet_criteria(text) meet_criteria(type, allow_class = "character", has_length = 1) meet_criteria(collapse, has_length = 1, allow_NULL = TRUE) meet_criteria(translate_av, allow_NULL = FALSE) # get_translate_av() will be more informative about what's allowed meet_criteria(thorough_search, allow_class = "logical", has_length = 1, allow_NULL = TRUE) meet_criteria(info, allow_class = "logical", has_length = 1) - + type <- tolower(trimws2(type)) - + text <- tolower(as.character(text)) text_split_all <- strsplit(text, "[ ;.,:\\|]") progress <- progress_ticker(n = length(text_split_all), n_min = 5, print = info) on.exit(close(progress)) - + if (type %like% "(drug|ab|anti)") { translate_av <- get_translate_av(translate_av) - + if (isTRUE(thorough_search) || - (isTRUE(is.null(thorough_search)) && max(vapply(FUN.VALUE = double(1), text_split_all, length), na.rm = TRUE) <= 3)) { + (isTRUE(is.null(thorough_search)) && max(vapply(FUN.VALUE = double(1), text_split_all, length), na.rm = TRUE) <= 3)) { text_split_all <- text_split_all[nchar(text_split_all) >= 4 & grepl("[a-z]+", text_split_all)] result <- lapply(text_split_all, function(text_split) { progress$tick() @@ -125,9 +125,9 @@ av_from_text <- function(text, ) }) } - + close(progress) - + result <- lapply(result, function(out) { out <- out[!is.na(out)] if (length(out) == 0) { @@ -149,7 +149,7 @@ av_from_text <- function(text, text_split <- as.double(gsub("[^0-9.]", "", text_split)) # minimal 100 units/mg and no years that unlikely doses text_split <- text_split[text_split >= 100 & !text_split %in% c(1951:1999, 2001:2049)] - + if (length(text_split) > 0) { text_split } else { @@ -170,7 +170,7 @@ av_from_text <- function(text, } else { stop_("`type` must be either 'drug', 'dose' or 'administration'") } - + # collapse text if needed if (!is.null(collapse)) { result <- vapply(FUN.VALUE = character(1), result, function(x) { @@ -181,6 +181,6 @@ av_from_text <- function(text, } }) } - + result } diff --git a/R/av_property.R b/R/av_property.R index 39eb8b1e..415f0212 100755 --- a/R/av_property.R +++ b/R/av_property.R @@ -84,7 +84,7 @@ av_name <- function(x, language = get_AMR_locale(), tolower = FALSE, ...) { meet_criteria(x, allow_NA = TRUE) language <- validate_language(language) meet_criteria(tolower, allow_class = "logical", has_length = 1) - + x <- translate_into_language(av_validate(x = x, property = "name", ...), language = language, only_affect_ab_names = TRUE) if (tolower == TRUE) { # use perl to only transform the first character @@ -155,11 +155,11 @@ av_loinc <- function(x, ...) { av_ddd <- function(x, administration = "oral", ...) { meet_criteria(x, allow_NA = TRUE) meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1) - + x <- as.av(x, ...) ddd_prop <- paste0(administration, "_ddd") out <- av_validate(x = x, property = ddd_prop) - + if (any(av_name(x, language = NULL) %like% "/" & is.na(out))) { warning_( "in `av_ddd()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.", @@ -175,11 +175,11 @@ av_ddd <- function(x, administration = "oral", ...) { av_ddd_units <- function(x, administration = "oral", ...) { meet_criteria(x, allow_NA = TRUE) meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1) - + x <- as.av(x, ...) ddd_prop <- paste0(administration, "_units") out <- av_validate(x = x, property = ddd_prop) - + if (any(av_name(x, language = NULL) %like% "/" & is.na(out))) { warning_( "in `av_ddd_units()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.", @@ -195,7 +195,7 @@ av_ddd_units <- function(x, administration = "oral", ...) { av_info <- function(x, language = get_AMR_locale(), ...) { meet_criteria(x, allow_NA = TRUE) language <- validate_language(language) - + x <- as.av(x, ...) list( av = as.character(x), @@ -224,18 +224,18 @@ av_info <- function(x, language = get_AMR_locale(), ...) { av_url <- function(x, open = FALSE, ...) { meet_criteria(x, allow_NA = TRUE) meet_criteria(open, allow_class = "logical", has_length = 1) - + av <- as.av(x = x, ...) atcs <- av_atc(av, only_first = TRUE) u <- paste0("https://www.whocc.no/atc_ddd_index/?code=", atcs, "&showdescription=no") u[is.na(atcs)] <- NA_character_ names(u) <- av_name(av) - + NAs <- av_name(av, tolower = TRUE, language = NULL)[!is.na(av) & is.na(atcs)] if (length(NAs) > 0) { warning_("in `av_url()`: no ATC code available for ", vector_and(NAs, quotes = FALSE), ".") } - + if (open == TRUE) { if (length(u) > 1 && !is.na(u[1L])) { warning_("in `av_url()`: only the first URL will be opened, as `browseURL()` only suports one string.") @@ -264,9 +264,9 @@ av_validate <- function(x, property, ...) { # try to catch an error when inputting an invalid argument # so the 'call.' can be set to FALSE tryCatch(x[1L] %in% AMR_env$AV_lookup[1, property, drop = TRUE], - error = function(e) stop(e$message, call. = FALSE) + error = function(e) stop(e$message, call. = FALSE) ) - + if (!all(x %in% AMR_env$AV_lookup[, property, drop = TRUE])) { x <- as.av(x, ...) if (all(is.na(x)) && is.list(AMR_env$AV_lookup[, property, drop = TRUE])) { @@ -276,7 +276,7 @@ av_validate <- function(x, property, ...) { } } } - + if (property == "av") { return(set_clean_class(x, new_class = c("av", "character"))) } else if (property == "cid") { diff --git a/R/custom_antimicrobials.R b/R/custom_antimicrobials.R index 78a4f8af..08f7fcbb 100755 --- a/R/custom_antimicrobials.R +++ b/R/custom_antimicrobials.R @@ -31,25 +31,25 @@ #' #' With [add_custom_antimicrobials()] you can add your own custom antimicrobial drug names and codes. #' @param x a [data.frame] resembling the [antibiotics] data set, at least containing columns "ab" and "name" -#' @details **Important:** Due to how \R works, the [add_custom_antimicrobials()] function has to be run in every \R session - added antimicrobials are not stored between sessions and are thus lost when \R is exited. -#' +#' @details **Important:** Due to how \R works, the [add_custom_antimicrobials()] function has to be run in every \R session - added antimicrobials are not stored between sessions and are thus lost when \R is exited. +#' #' There are two ways to automate this process: -#' +#' #' **Method 1:** Save the antimicrobials to a local or remote file (can even be the internet). To use this method: -#' +#' #' 1. Create a data set in the structure of the [antibiotics] data set (containing at the very least columns "ab" and "name") and save it with [saveRDS()] to a location of choice, e.g. `"~/my_custom_ab.rds"`, or any remote location. -#' +#' #' 2. Set the file location to the `AMR_custom_ab` \R option: `options(AMR_custom_ab = "~/my_custom_ab.rds")`. This can even be a remote file location, such as an https URL. Since options are not saved between \R sessions, it is best to save this option to the `.Rprofile` file so that it will loaded on start-up of \R. To do this, open the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`, add this text and save the file: #' #' ```r #' # Add custom antibiotic drug codes: #' options(AMR_custom_ab = "~/my_custom_ab.rds") #' ``` -#' +#' #' Upon package load, this file will be loaded and run through the [add_custom_antimicrobials()] function. -#' +#' #' **Method 2:** Save the antimicrobial additions directly to your `.Rprofile` file. An important downside is that this requires to load the `AMR` package at every start-up. To use this method: -#' +#' #' 1. Edit the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`. #' #' 2. Add a text like below and save the file: @@ -139,10 +139,10 @@ add_custom_antimicrobials <- function(x) { x[, col] <- as.list(x[, col, drop = TRUE]) } } - + AMR_env$custom_ab_codes <- c(AMR_env$custom_ab_codes, x$ab) class(AMR_env$AB_lookup$ab) <- "character" - + new_df <- AMR_env$AB_lookup[0, , drop = FALSE][seq_len(NROW(x)), , drop = FALSE] rownames(new_df) <- NULL list_cols <- vapply(FUN.VALUE = logical(1), new_df, is.list) @@ -155,7 +155,7 @@ add_custom_antimicrobials <- function(x) { new_df[, col] <- x[, col, drop = TRUE] } AMR_env$AB_lookup <- unique(rbind(AMR_env$AB_lookup, new_df)) - + AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(!AMR_env$ab_previously_coerced$ab %in% x$ab), , drop = FALSE] class(AMR_env$AB_lookup$ab) <- c("ab", "character") message_("Added ", nr2char(nrow(x)), " record", ifelse(nrow(x) > 1, "s", ""), " to the internal `antibiotics` data set.") diff --git a/R/custom_eucast_rules.R b/R/custom_eucast_rules.R index f77a76d0..b02c6a42 100755 --- a/R/custom_eucast_rules.R +++ b/R/custom_eucast_rules.R @@ -240,11 +240,12 @@ print.custom_eucast_rules <- function(x, ...) { " (", rule$result_group, ")" ) agents <- sort(agents) - rule_if <- word_wrap(paste0( - i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then "), - "set to {result}:" - ), - extra_indent = 5 + rule_if <- word_wrap( + paste0( + i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then "), + "set to {result}:" + ), + extra_indent = 5 ) rule_if <- gsub("{result}", val, rule_if, fixed = TRUE) rule_then <- paste0(" ", word_wrap(paste0(agents, collapse = ", "), extra_indent = 5)) diff --git a/R/custom_microorganisms.R b/R/custom_microorganisms.R index 466d392e..39272f62 100755 --- a/R/custom_microorganisms.R +++ b/R/custom_microorganisms.R @@ -32,26 +32,26 @@ #' With [add_custom_microorganisms()] you can add your own custom microorganisms, such the non-taxonomic outcome of laboratory analysis. #' @param x a [data.frame] resembling the [microorganisms] data set, at least containing column "genus" (case-insensitive) #' @details This function will fill in missing taxonomy for you, if specific taxonomic columns are missing, see *Examples*. -#' -#' **Important:** Due to how \R works, the [add_custom_microorganisms()] function has to be run in every \R session - added microorganisms are not stored between sessions and are thus lost when \R is exited. -#' +#' +#' **Important:** Due to how \R works, the [add_custom_microorganisms()] function has to be run in every \R session - added microorganisms are not stored between sessions and are thus lost when \R is exited. +#' #' There are two ways to automate this process: -#' +#' #' **Method 1:** Using the option [`AMR_custom_mo`][AMR-options], which is the preferred method. To use this method: -#' +#' #' 1. Create a data set in the structure of the [microorganisms] data set (containing at the very least column "genus") and save it with [saveRDS()] to a location of choice, e.g. `"~/my_custom_mo.rds"`, or any remote location. -#' +#' #' 2. Set the file location to the `AMR_custom_mo` \R option: `options(AMR_custom_mo = "~/my_custom_mo.rds")`. This can even be a remote file location, such as an https URL. Since options are not saved between \R sessions, it is best to save this option to the `.Rprofile` file so that it will be loaded on start-up of \R. To do this, open the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`, add this text and save the file: #' #' ```r #' # Add custom microorganism codes: #' options(AMR_custom_mo = "~/my_custom_mo.rds") #' ``` -#' +#' #' Upon package load, this file will be loaded and run through the [add_custom_microorganisms()] function. -#' +#' #' **Method 2:** Loading the microorganism directly from your `.Rprofile` file. An important downside is that this requires the `AMR` package to be installed or else this method will fail. To use this method: -#' +#' #' 1. Edit the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`. #' #' 2. Add a text like below and save the file: @@ -77,44 +77,49 @@ #' # now add a custom entry - it will be considered by as.mo() and #' # all mo_*() functions #' add_custom_microorganisms( -#' data.frame(genus = "Enterobacter", -#' species = "asburiae/cloacae" +#' data.frame( +#' genus = "Enterobacter", +#' species = "asburiae/cloacae" #' ) #' ) #' #' # E. asburiae/cloacae is now a new microorganism: #' mo_name("Enterobacter asburiae/cloacae") -#' +#' #' # its code: #' as.mo("Enterobacter asburiae/cloacae") -#' +#' #' # all internal algorithms will work as well: #' mo_name("Ent asburia cloacae") -#' +#' #' # and even the taxonomy was added based on the genus! #' mo_family("E. asburiae/cloacae") #' mo_gramstain("Enterobacter asburiae/cloacae") #' #' mo_info("Enterobacter asburiae/cloacae") -#' -#' +#' +#' #' # the function tries to be forgiving: #' add_custom_microorganisms( -#' data.frame(GENUS = "BACTEROIDES / PARABACTEROIDES SLASHLINE", -#' SPECIES = "SPECIES") +#' data.frame( +#' GENUS = "BACTEROIDES / PARABACTEROIDES SLASHLINE", +#' SPECIES = "SPECIES" +#' ) #' ) #' mo_name("BACTEROIDES / PARABACTEROIDES") #' mo_rank("BACTEROIDES / PARABACTEROIDES") -#' +#' #' # taxonomy still works, although a slashline genus was given as input: #' mo_family("Bacteroides/Parabacteroides") -#' -#' +#' +#' #' # for groups and complexes, set them as species or subspecies: #' add_custom_microorganisms( -#' data.frame(genus = "Citrobacter", -#' species = c("freundii", "braakii complex"), -#' subspecies = c("complex", "")) +#' data.frame( +#' genus = "Citrobacter", +#' species = c("freundii", "braakii complex"), +#' subspecies = c("complex", "") +#' ) #' ) #' mo_name(c("C. freundii complex", "C. braakii complex")) #' mo_species(c("C. freundii complex", "C. braakii complex")) @@ -123,9 +128,9 @@ add_custom_microorganisms <- function(x) { meet_criteria(x, allow_class = "data.frame") stop_ifnot("genus" %in% tolower(colnames(x)), paste0("`x` must contain column 'genus'.")) - + add_MO_lookup_to_AMR_env() - + # remove any extra class/type, such as grouped tbl, or data.table: x <- as.data.frame(x, stringsAsFactors = FALSE) colnames(x) <- tolower(colnames(x)) @@ -135,7 +140,7 @@ add_custom_microorganisms <- function(x) { } # keep only columns available in the microorganisms data set x <- x[, colnames(AMR_env$MO_lookup)[colnames(AMR_env$MO_lookup) %in% colnames(x)], drop = FALSE] - + # clean the input ---- for (col in c("genus", "species", "subspecies")) { if (!col %in% colnames(x)) { @@ -152,7 +157,7 @@ add_custom_microorganisms <- function(x) { col_ <- gsub(" *([/-]) *", "\\1", col_, perl = TRUE) # groups are in our taxonomic table with a capital G col_ <- gsub(" group( |$)", " Group\\1", col_, perl = TRUE) - + col_[is.na(col_)] <- "" if (col == "genus") { substr(col_, 1, 1) <- toupper(substr(col_, 1, 1)) @@ -163,19 +168,27 @@ add_custom_microorganisms <- function(x) { x[, col] <- col_ } # if subspecies is a group or complex, add it to the species and empty the subspecies - x$species[which(x$subspecies %in% c("group", "Group", "complex"))] <- paste(x$species[which(x$subspecies %in% c("group", "Group", "complex"))], - x$subspecies[which(x$subspecies %in% c("group", "Group", "complex"))]) + x$species[which(x$subspecies %in% c("group", "Group", "complex"))] <- paste( + x$species[which(x$subspecies %in% c("group", "Group", "complex"))], + x$subspecies[which(x$subspecies %in% c("group", "Group", "complex"))] + ) x$subspecies[which(x$subspecies %in% c("group", "Group", "complex"))] <- "" - + if ("rank" %in% colnames(x)) { - stop_ifnot(all(x$rank %in% AMR_env$MO_lookup$rank), - "the 'rank' column can only contain these values: ", vector_or(AMR_env$MO_lookup$rank)) + stop_ifnot( + all(x$rank %in% AMR_env$MO_lookup$rank), + "the 'rank' column can only contain these values: ", vector_or(AMR_env$MO_lookup$rank) + ) } else { x$rank <- ifelse(x$subspecies != "", "subspecies", - ifelse(x$species != "", "species", - ifelse(x$genus != "", "genus", - stop("in add_custom_microorganisms(): only microorganisms up to the genus level can be added", - call. = FALSE)))) + ifelse(x$species != "", "species", + ifelse(x$genus != "", "genus", + stop("in add_custom_microorganisms(): only microorganisms up to the genus level can be added", + call. = FALSE + ) + ) + ) + ) } x$source <- "Added by user" if (!"fullname" %in% colnames(x)) { @@ -191,7 +204,7 @@ add_custom_microorganisms <- function(x) { x$class[is.na(x$class)] <- "" x$order[is.na(x$order)] <- "" x$family[is.na(x$family)] <- "" - + for (col in colnames(x)) { if (is.factor(x[, col, drop = TRUE])) { x[, col] <- as.character(x[, col, drop = TRUE]) @@ -200,7 +213,7 @@ add_custom_microorganisms <- function(x) { x[, col] <- as.list(x[, col, drop = TRUE]) } } - + # fill in taxonomy based on genus genus_to_check <- gsub("^(.*)[^a-zA-Z].*", "\\1", x$genus, perl = TRUE) x$kingdom[which(x$kingdom == "" & genus_to_check != "")] <- AMR_env$MO_lookup$kingdom[match(genus_to_check[which(x$kingdom == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)] @@ -208,7 +221,7 @@ add_custom_microorganisms <- function(x) { x$class[which(x$class == "" & genus_to_check != "")] <- AMR_env$MO_lookup$class[match(genus_to_check[which(x$class == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)] x$order[which(x$order == "" & genus_to_check != "")] <- AMR_env$MO_lookup$order[match(genus_to_check[which(x$order == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)] x$family[which(x$family == "" & genus_to_check != "")] <- AMR_env$MO_lookup$family[match(genus_to_check[which(x$family == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)] - + # fill in other columns that are used in internal algorithms x$prevalence <- NA_real_ x$prevalence[which(genus_to_check != "")] <- AMR_env$MO_lookup$prevalence[match(genus_to_check[which(genus_to_check != "")], AMR_env$MO_lookup$genus)] @@ -222,7 +235,7 @@ add_custom_microorganisms <- function(x) { x$full_first <- substr(x$fullname_lower, 1, 1) x$species_first <- tolower(substr(x$species, 1, 1)) x$subspecies_first <- tolower(substr(x$subspecies, 1, 1)) - + if (!"mo" %in% colnames(x)) { # create the mo code x$mo <- NA_character_ @@ -230,19 +243,27 @@ add_custom_microorganisms <- function(x) { x$mo <- trimws2(as.character(x$mo)) x$mo[x$mo == ""] <- NA_character_ current <- sum(AMR_env$MO_lookup$source == "Added by user", na.rm = TRUE) - x$mo[is.na(x$mo)] <- paste0("CUSTOM", - seq.int(from = current + 1, to = current + nrow(x), by = 1), - "_", - toupper(unname(abbreviate(gsub(" +", " _ ", - gsub("[^A-Za-z0-9-]", " ", - trimws2(paste(x$genus, x$species, x$subspecies)))), - minlength = 10)))) + x$mo[is.na(x$mo)] <- paste0( + "CUSTOM", + seq.int(from = current + 1, to = current + nrow(x), by = 1), + "_", + toupper(unname(abbreviate( + gsub( + " +", " _ ", + gsub( + "[^A-Za-z0-9-]", " ", + trimws2(paste(x$genus, x$species, x$subspecies)) + ) + ), + minlength = 10 + ))) + ) stop_if(anyDuplicated(c(as.character(AMR_env$MO_lookup$mo), x$mo)), "MO codes must be unique and not match existing MO codes of the AMR package") - + # add to package ---- AMR_env$custom_mo_codes <- c(AMR_env$custom_mo_codes, x$mo) class(AMR_env$MO_lookup$mo) <- "character" - + new_df <- AMR_env$MO_lookup[0, , drop = FALSE][seq_len(NROW(x)), , drop = FALSE] rownames(new_df) <- NULL list_cols <- vapply(FUN.VALUE = logical(1), new_df, is.list) @@ -254,10 +275,10 @@ add_custom_microorganisms <- function(x) { # assign new values new_df[, col] <- x[, col, drop = TRUE] } - + # clear previous coercions suppressMessages(mo_reset_session()) - + AMR_env$MO_lookup <- unique(rbind(AMR_env$MO_lookup, new_df)) class(AMR_env$MO_lookup$mo) <- c("mo", "character") if (nrow(x) <= 3) { @@ -271,11 +292,11 @@ add_custom_microorganisms <- function(x) { #' @export clear_custom_microorganisms <- function() { n <- nrow(AMR_env$MO_lookup) - + # reset AMR_env$MO_lookup <- NULL add_MO_lookup_to_AMR_env() - + n2 <- nrow(AMR_env$MO_lookup) AMR_env$custom_mo_codes <- character(0) AMR_env$mo_previously_coerced <- AMR_env$mo_previously_coerced[which(AMR_env$mo_previously_coerced$mo %in% AMR_env$MO_lookup$mo), , drop = FALSE] diff --git a/R/data.R b/R/data.R index ab81c241..5edbc4ab 100755 --- a/R/data.R +++ b/R/data.R @@ -65,10 +65,10 @@ #' #' ### Direct download #' Like all data sets in this package, these data sets are publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw). -#' @source -#' +#' @source +#' #' * World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology (WHOCC): -#' +#' #' * `r TAXONOMY_VERSION$LOINC$citation` Accessed from <`r TAXONOMY_VERSION$LOINC$url`> on `r documentation_date(TAXONOMY_VERSION$LOINC$accessed_date)`. #' #' * European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: @@ -141,9 +141,9 @@ #' * `r TAXONOMY_VERSION$GBIF$citation` Accessed from <`r TAXONOMY_VERSION$GBIF$url`> on `r documentation_date(TAXONOMY_VERSION$GBIF$accessed_date)`. #' #' * `r TAXONOMY_VERSION$SNOMED$citation` URL: <`r TAXONOMY_VERSION$SNOMED$url`> -#' +#' #' * Grimont *et al.* (2007). Antigenic Formulae of the Salmonella Serovars, 9th Edition. WHO Collaborating Centre for Reference and Research on *Salmonella* (WHOCC-SALM). -#' +#' #' * Bartlett *et al.* (2022). **A comprehensive list of bacterial pathogens infecting humans** *Microbiology* 168:001269; \doi{10.1099/mic.0.001269} #' @seealso [as.mo()], [mo_property()], [microorganisms.codes], [intrinsic_resistant] #' @examples diff --git a/R/disk.R b/R/disk.R index 5be9ca65..5278ab3b 100755 --- a/R/disk.R +++ b/R/disk.R @@ -120,13 +120,13 @@ as.disk <- function(x, na.rm = FALSE) { vector_and(quotes = TRUE) cur_col <- get_current_column() warning_("in `as.disk()`: ", na_after - na_before, " result", - ifelse(na_after - na_before > 1, "s", ""), - ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")), - " truncated (", - round(((na_after - na_before) / length(x)) * 100), - "%) that were invalid disk zones: ", - list_missing, - call = FALSE + ifelse(na_after - na_before > 1, "s", ""), + ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")), + " truncated (", + round(((na_after - na_before) / length(x)) * 100), + "%) that were invalid disk zones: ", + list_missing, + call = FALSE ) } } diff --git a/R/episode.R b/R/episode.R index 71595744..c94f4759 100755 --- a/R/episode.R +++ b/R/episode.R @@ -57,11 +57,12 @@ #' df[which(get_episode(df$date, 60) == 3), ] #' #' # the functions also work for less than a day, e.g. to include one per hour: -#' get_episode(c( -#' Sys.time(), -#' Sys.time() + 60 * 60 -#' ), -#' episode_days = 1 / 24 +#' get_episode( +#' c( +#' Sys.time(), +#' Sys.time() + 60 * 60 +#' ), +#' episode_days = 1 / 24 #' ) #' #' \donttest{ @@ -98,7 +99,6 @@ #' ) #' } #' if (require("dplyr")) { -#' #' # grouping on patients and microorganisms leads to the same #' # results as first_isolate() when using 'episode-based': #' x <- df %>% @@ -115,7 +115,6 @@ #' identical(x, y) #' } #' if (require("dplyr")) { -#' #' # but is_new_episode() has a lot more flexibility than first_isolate(), #' # since you can now group on anything that seems relevant: #' df %>% diff --git a/R/eucast_rules.R b/R/eucast_rules.R index 67171081..bc325ae3 100755 --- a/R/eucast_rules.R +++ b/R/eucast_rules.R @@ -702,11 +702,12 @@ eucast_rules <- function(x, # Print rule ------------------------------------------------------------- if (rule_current != rule_previous) { # is new rule within group, print its name - cat(italicise_taxonomy(word_wrap(rule_current, - width = getOption("width") - 30, - extra_indent = 6 - ), - type = "ansi" + cat(italicise_taxonomy( + word_wrap(rule_current, + width = getOption("width") - 30, + extra_indent = 6 + ), + type = "ansi" )) warned <- FALSE } @@ -721,21 +722,23 @@ eucast_rules <- function(x, if (mo_value %like% "coagulase" && any(x$genus == "Staphylococcus", na.rm = TRUE)) { if (mo_value %like% "negative") { eucast_rules_df[i, "this_value"] <- paste0( - "^(", paste0(all_staph[which(all_staph$CNS_CPS %like% "negative"), - "fullname", - drop = TRUE - ], - collapse = "|" + "^(", paste0( + all_staph[which(all_staph$CNS_CPS %like% "negative"), + "fullname", + drop = TRUE + ], + collapse = "|" ), ")$" ) } else { eucast_rules_df[i, "this_value"] <- paste0( - "^(", paste0(all_staph[which(all_staph$CNS_CPS %like% "positive"), - "fullname", - drop = TRUE - ], - collapse = "|" + "^(", paste0( + all_staph[which(all_staph$CNS_CPS %like% "positive"), + "fullname", + drop = TRUE + ], + collapse = "|" ), ")$" ) @@ -745,11 +748,12 @@ eucast_rules <- function(x, # be sure to comprise all beta-haemolytic Streptococci (Lancefield groups A, B, C and G) when they are mentioned if (mo_value %like% "group [ABCG]" && any(x$genus == "Streptococcus", na.rm = TRUE)) { eucast_rules_df[i, "this_value"] <- paste0( - "^(", paste0(all_strep[which(all_strep$Lancefield %like% "group [ABCG]"), - "fullname", - drop = TRUE - ], - collapse = "|" + "^(", paste0( + all_strep[which(all_strep$Lancefield %like% "group [ABCG]"), + "fullname", + drop = TRUE + ], + collapse = "|" ), ")$" ) @@ -789,15 +793,17 @@ eucast_rules <- function(x, if (length(source_antibiotics) == 0) { rows <- integer(0) } else if (length(source_antibiotics) == 1) { - rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like% mo_value & - as.sir_no_warning(x[, source_antibiotics[1L]]) == source_value[1L]), - error = function(e) integer(0) + rows <- tryCatch( + which(x[, if_mo_property, drop = TRUE] %like% mo_value & + as.sir_no_warning(x[, source_antibiotics[1L]]) == source_value[1L]), + error = function(e) integer(0) ) } else if (length(source_antibiotics) == 2) { - rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like% mo_value & - as.sir_no_warning(x[, source_antibiotics[1L]]) == source_value[1L] & - as.sir_no_warning(x[, source_antibiotics[2L]]) == source_value[2L]), - error = function(e) integer(0) + rows <- tryCatch( + which(x[, if_mo_property, drop = TRUE] %like% mo_value & + as.sir_no_warning(x[, source_antibiotics[1L]]) == source_value[1L] & + as.sir_no_warning(x[, source_antibiotics[2L]]) == source_value[2L]), + error = function(e) integer(0) ) # nolint start # } else if (length(source_antibiotics) == 3) { @@ -872,11 +878,12 @@ eucast_rules <- function(x, ) if (isTRUE(info)) { # print rule - cat(italicise_taxonomy(word_wrap(format_custom_query_rule(rule$query, colours = FALSE), - width = getOption("width") - 30, - extra_indent = 6 - ), - type = "ansi" + cat(italicise_taxonomy( + word_wrap(format_custom_query_rule(rule$query, colours = FALSE), + width = getOption("width") - 30, + extra_indent = 6 + ), + type = "ansi" )) warned <- FALSE } @@ -1117,14 +1124,15 @@ edit_sir <- function(x, }, error = function(e) { txt_error() - stop(paste0( - "In row(s) ", paste(rows[seq_len(min(length(rows), 10))], collapse = ","), - ifelse(length(rows) > 10, "...", ""), - " while writing value '", to, - "' to column(s) `", paste(cols, collapse = "`, `"), - "`:\n", e$message - ), - call. = FALSE + stop( + paste0( + "In row(s) ", paste(rows[seq_len(min(length(rows), 10))], collapse = ","), + ifelse(length(rows) > 10, "...", ""), + " while writing value '", to, + "' to column(s) `", paste(cols, collapse = "`, `"), + "`:\n", e$message + ), + call. = FALSE ) } ) diff --git a/R/first_isolate.R b/R/first_isolate.R index 06eaf8df..89c1c1cb 100755 --- a/R/first_isolate.R +++ b/R/first_isolate.R @@ -144,13 +144,11 @@ #' filter(first_isolate()) #' } #' if (require("dplyr")) { -#' #' # short-hand version: #' example_isolates %>% #' filter_first_isolate(info = FALSE) #' } #' if (require("dplyr")) { -#' #' # flag the first isolates per group: #' example_isolates %>% #' group_by(ward) %>% @@ -244,18 +242,19 @@ first_isolate <- function(x = NULL, method <- "episode-based" } if (isTRUE(info) && message_not_thrown_before("first_isolate", "method")) { - message_(paste0( - "Determining first isolates ", - ifelse(method %in% c("episode-based", "phenotype-based"), - ifelse(is.infinite(episode_days), - "without a specified episode length", - paste("using an episode length of", episode_days, "days") - ), - "" - ) - ), - as_note = FALSE, - add_fn = font_black + message_( + paste0( + "Determining first isolates ", + ifelse(method %in% c("episode-based", "phenotype-based"), + ifelse(is.infinite(episode_days), + "without a specified episode length", + paste("using an episode length of", episode_days, "days") + ), + "" + ) + ), + as_note = FALSE, + add_fn = font_black ) } @@ -469,15 +468,17 @@ first_isolate <- function(x = NULL, x$other_pat_or_mo <- !(x$newvar_patient_id == pm_lag(x$newvar_patient_id) & x$newvar_genus_species == pm_lag(x$newvar_genus_species)) x$episode_group <- paste(x$newvar_patient_id, x$newvar_genus_species) - x$more_than_episode_ago <- unlist(lapply(split( - x$newvar_date, - x$episode_group - ), - exec_episode, # this will skip meet_criteria() in is_new_episode(), saving time - type = "logical", - episode_days = episode_days - ), - use.names = FALSE + x$more_than_episode_ago <- unlist( + lapply( + split( + x$newvar_date, + x$episode_group + ), + exec_episode, # this will skip meet_criteria() in is_new_episode(), saving time + type = "logical", + episode_days = episode_days + ), + use.names = FALSE ) if (!is.null(col_keyantimicrobials)) { @@ -606,21 +607,22 @@ first_isolate <- function(x = NULL, } # mark up number of found n_found <- format(n_found, big.mark = big.mark, decimal.mark = decimal.mark) - message_(paste0( - "=> Found ", - font_bold(paste0( - n_found, - ifelse(method == "isolate-based", "", paste0(" '", method, "'")), - " first isolates" - )), - " (", - ifelse(p_found_total != p_found_scope, - paste0(p_found_scope, " within scope and "), - "" + message_( + paste0( + "=> Found ", + font_bold(paste0( + n_found, + ifelse(method == "isolate-based", "", paste0(" '", method, "'")), + " first isolates" + )), + " (", + ifelse(p_found_total != p_found_scope, + paste0(p_found_scope, " within scope and "), + "" + ), + p_found_total, " of total where a microbial ID was available)" ), - p_found_total, " of total where a microbial ID was available)" - ), - add_fn = font_black, as_note = FALSE + add_fn = font_black, as_note = FALSE ) } diff --git a/R/ggplot_pca.R b/R/ggplot_pca.R index 3c541003..4bd1767c 100755 --- a/R/ggplot_pca.R +++ b/R/ggplot_pca.R @@ -414,13 +414,14 @@ pca_calculations <- function(pca_model, sigma <- var(cbind(x$xvar, x$yvar)) mu <- c(mean(x$xvar), mean(x$yvar)) ed <- sqrt(qchisq(ellipse_prob, df = 2)) - data.frame(sweep(circle %*% chol(sigma) * ed, - MARGIN = 2, - STATS = mu, - FUN = "+" - ), - groups = x$groups[1], - stringsAsFactors = FALSE + data.frame( + sweep(circle %*% chol(sigma) * ed, + MARGIN = 2, + STATS = mu, + FUN = "+" + ), + groups = x$groups[1], + stringsAsFactors = FALSE ) }) ell <- do.call(rbind, df.groups) diff --git a/R/ggplot_sir.R b/R/ggplot_sir.R index dd9dade4..ea2e50b3 100755 --- a/R/ggplot_sir.R +++ b/R/ggplot_sir.R @@ -71,13 +71,11 @@ #' @examples #' \donttest{ #' if (require("ggplot2") && require("dplyr")) { -#' #' # get antimicrobial results for drugs against a UTI: #' ggplot(example_isolates %>% select(AMX, NIT, FOS, TMP, CIP)) + #' geom_sir() #' } #' if (require("ggplot2") && require("dplyr")) { -#' #' # prettify the plot using some additional functions: #' df <- example_isolates %>% select(AMX, NIT, FOS, TMP, CIP) #' ggplot(df) + @@ -88,21 +86,18 @@ #' theme_sir() #' } #' if (require("ggplot2") && require("dplyr")) { -#' #' # or better yet, simplify this using the wrapper function - a single command: #' example_isolates %>% #' select(AMX, NIT, FOS, TMP, CIP) %>% #' ggplot_sir() #' } #' if (require("ggplot2") && require("dplyr")) { -#' #' # get only proportions and no counts: #' example_isolates %>% #' select(AMX, NIT, FOS, TMP, CIP) %>% #' ggplot_sir(datalabels = FALSE) #' } #' if (require("ggplot2") && require("dplyr")) { -#' #' # add other ggplot2 arguments as you like: #' example_isolates %>% #' select(AMX, NIT, FOS, TMP, CIP) %>% @@ -115,14 +110,12 @@ #' ) #' } #' if (require("ggplot2") && require("dplyr")) { -#' #' # you can alter the colours with colour names: #' example_isolates %>% #' select(AMX) %>% #' ggplot_sir(colours = c(SI = "yellow")) #' } #' if (require("ggplot2") && require("dplyr")) { -#' #' # but you can also use the built-in colour-blind friendly colours for #' # your plots, where "S" is green, "I" is yellow and "R" is red: #' data.frame( @@ -135,7 +128,6 @@ #' scale_sir_colours(Value4 = "S", Value5 = "I", Value6 = "R") #' } #' if (require("ggplot2") && require("dplyr")) { -#' #' # resistance of ciprofloxacine per age group #' example_isolates %>% #' mutate(first_isolate = first_isolate()) %>% @@ -149,14 +141,12 @@ #' ggplot_sir(x = "age_group") #' } #' if (require("ggplot2") && require("dplyr")) { -#' #' # a shorter version which also adjusts data label colours: #' example_isolates %>% #' select(AMX, NIT, FOS, TMP, CIP) %>% #' ggplot_sir(colours = FALSE) #' } #' if (require("ggplot2") && require("dplyr")) { -#' #' # it also supports groups (don't forget to use the group var on `x` or `facet`): #' example_isolates %>% #' filter(mo_is_gram_negative(), ward != "Outpatient") %>% diff --git a/R/guess_ab_col.R b/R/guess_ab_col.R index e14341d5..697d49d9 100755 --- a/R/guess_ab_col.R +++ b/R/guess_ab_col.R @@ -274,14 +274,15 @@ get_column_abx <- function(x, } if (names(out[i]) %in% names(duplicates)) { already_set_as <- out[unname(out) == unname(out[i])][1L] - warning_(paste0( - "Column '", font_bold(out[i]), "' will not be used for ", - names(out)[i], " (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ")", - ", as it is already set for ", - names(already_set_as), " (", ab_name(names(already_set_as), tolower = TRUE, language = NULL), ")" - ), - add_fn = font_red, - immediate = verbose + warning_( + paste0( + "Column '", font_bold(out[i]), "' will not be used for ", + names(out)[i], " (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ")", + ", as it is already set for ", + names(already_set_as), " (", ab_name(names(already_set_as), tolower = TRUE, language = NULL), ")" + ), + add_fn = font_red, + immediate = verbose ) } } @@ -307,11 +308,12 @@ get_column_abx <- function(x, if (isTRUE(info) && !all(soft_dependencies %in% names(out))) { # missing a soft dependency may lower the reliability missing <- soft_dependencies[!soft_dependencies %in% names(out)] - missing_msg <- vector_and(paste0( - ab_name(missing, tolower = TRUE, language = NULL), - " (", font_bold(missing, collapse = NULL), ")" - ), - quotes = FALSE + missing_msg <- vector_and( + paste0( + ab_name(missing, tolower = TRUE, language = NULL), + " (", font_bold(missing, collapse = NULL), ")" + ), + quotes = FALSE ) message_( "Reliability would be improved if these antimicrobial results would be available too: ", @@ -355,10 +357,11 @@ generate_warning_abs_missing <- function(missing, any = FALSE) { } else { any_txt <- c("", "are") } - warning_(paste0( - "Introducing NAs since", any_txt[1], " these antimicrobials ", any_txt[2], " required: ", - vector_and(missing, quotes = FALSE) - ), - immediate = TRUE + warning_( + paste0( + "Introducing NAs since", any_txt[1], " these antimicrobials ", any_txt[2], " required: ", + vector_and(missing, quotes = FALSE) + ), + immediate = TRUE ) } diff --git a/R/italicise_taxonomy.R b/R/italicise_taxonomy.R index 7e9758be..30f584a5 100755 --- a/R/italicise_taxonomy.R +++ b/R/italicise_taxonomy.R @@ -73,41 +73,44 @@ italicise_taxonomy <- function(string, type = c("markdown", "ansi")) { search_strings <- gsub("[^a-zA-Z-]", "", s_split) ind_species <- search_strings != "" & - search_strings %in% AMR_env$MO_lookup[which(AMR_env$MO_lookup$rank %in% c( - "family", - "genus", + search_strings %in% AMR_env$MO_lookup[ + which(AMR_env$MO_lookup$rank %in% c( + "family", + "genus", + "species", + "subspecies", + "infraspecies", + "subsp." + )), "species", - "subspecies", - "infraspecies", - "subsp." - )), - "species", - drop = TRUE + drop = TRUE ] ind_fullname <- search_strings != "" & search_strings %in% c( - AMR_env$MO_lookup[which(AMR_env$MO_lookup$rank %in% c( - "family", - "genus", - "species", - "subspecies", - "infraspecies", - "subsp." - )), - "fullname", - drop = TRUE + AMR_env$MO_lookup[ + which(AMR_env$MO_lookup$rank %in% c( + "family", + "genus", + "species", + "subspecies", + "infraspecies", + "subsp." + )), + "fullname", + drop = TRUE ], - AMR_env$MO_lookup[which(AMR_env$MO_lookup$rank %in% c( - "family", - "genus", - "species", + AMR_env$MO_lookup[ + which(AMR_env$MO_lookup$rank %in% c( + "family", + "genus", + "species", + "subspecies", + "infraspecies", + "subsp." + )), "subspecies", - "infraspecies", - "subsp." - )), - "subspecies", - drop = TRUE + drop = TRUE ] ) diff --git a/R/join_microorganisms.R b/R/join_microorganisms.R index b29d6542..e3817ff9 100755 --- a/R/join_microorganisms.R +++ b/R/join_microorganisms.R @@ -128,7 +128,7 @@ anti_join_microorganisms <- function(x, by = NULL, ...) { join_microorganisms <- function(type, x, by, suffix, ...) { add_MO_lookup_to_AMR_env() - + if (!is.data.frame(x)) { if (pkg_is_available("tibble", also_load = FALSE)) { x <- import_fn("tibble", "tibble")(mo = x) diff --git a/R/mdro.R b/R/mdro.R index 8c2f4bd2..65f07697 100755 --- a/R/mdro.R +++ b/R/mdro.R @@ -193,17 +193,17 @@ mdro <- function(x = NULL, meet_criteria(combine_SI, allow_class = "logical", has_length = 1) meet_criteria(verbose, allow_class = "logical", has_length = 1) meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1) - + if (!any(is_sir_eligible(x))) { stop_("There were no possible SIR columns found in the data set. Transform columns with `as.sir()` for valid antimicrobial interpretations.") } - + info.bak <- info # don't thrown info's more than once per call if (isTRUE(info)) { info <- message_not_thrown_before("mdro") } - + if (interactive() && isTRUE(verbose) && isTRUE(info)) { txt <- paste0( "WARNING: In Verbose mode, the mdro() function does not return the MDRO results, but instead returns a data set in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not.", @@ -221,7 +221,7 @@ mdro <- function(x = NULL, return(x) } } - + group_msg <- "" if (isTRUE(info.bak)) { # print group name if used in dplyr::group_by() @@ -243,15 +243,15 @@ mdro <- function(x = NULL, } } } - + # force regular [data.frame], not a tibble or data.table x <- as.data.frame(x, stringsAsFactors = FALSE) - + if (pct_required_classes > 1) { # allow pct_required_classes = 75 -> pct_required_classes = 0.75 pct_required_classes <- pct_required_classes / 100 } - + guideline.bak <- guideline if (is.list(guideline)) { # Custom MDRO guideline --------------------------------------------------- @@ -260,8 +260,8 @@ mdro <- function(x = NULL, txt <- paste0( "Determining MDROs based on custom rules", ifelse(isTRUE(attributes(guideline)$as_factor), - paste0(", resulting in factor levels: ", paste0(attributes(guideline)$values, collapse = " < ")), - "" + paste0(", resulting in factor levels: ", paste0(attributes(guideline)$values, collapse = " < ")), + "" ), "." ) @@ -314,7 +314,7 @@ mdro <- function(x = NULL, "invalid guideline: ", guideline.bak ) guideline <- list(code = guideline) - + # try to find columns based on type # -- mo if (is.null(col_mo)) { @@ -329,7 +329,7 @@ mdro <- function(x = NULL, col_mo <- "mo" } stop_if(is.null(col_mo), "`col_mo` must be set") - + if (guideline$code == "cmi2012") { guideline$name <- "Multidrug-resistant, extensively drug-resistant and pandrug-resistant bacteria: an international expert proposal for interim standard definitions for acquired resistance." guideline$author <- "Magiorakos AP, Srinivasan A, Carey RB, ..., Vatopoulos A, Weber JT, Monnet DL" @@ -360,7 +360,7 @@ mdro <- function(x = NULL, guideline$version <- "WHO/HTM/TB/2014.11, 2014" guideline$source_url <- font_url("https://www.who.int/publications/i/item/9789241548809", "Direct download") guideline$type <- "MDR-TB's" - + # support per country: } else if (guideline$code == "mrgn") { guideline$name <- "Cross-border comparison of the Dutch and German guidelines on multidrug-resistant Gram-negative microorganisms" @@ -377,7 +377,7 @@ mdro <- function(x = NULL, } else { stop("This guideline is currently unsupported: ", guideline$code, call. = FALSE) } - + if (guideline$code == "cmi2012") { cols_ab <- get_column_abx( x = x, @@ -456,7 +456,7 @@ mdro <- function(x = NULL, } cols_ab <- c(cols_ab, c(AMP = unname(cols_ab[names(cols_ab) == "AMX"]))) } - + # nolint start AMC <- cols_ab["AMC"] AMK <- cols_ab["AMK"] @@ -601,13 +601,13 @@ mdro <- function(x = NULL, abx_tb <- abx_tb[!is.na(abx_tb)] stop_if(guideline$code == "tb" & length(abx_tb) == 0, "no antimycobacterials found in data set") # nolint end - + if (isTRUE(combine_SI)) { search_result <- "R" } else { search_result <- c("R", "I") } - + if (isTRUE(info)) { if (isTRUE(combine_SI)) { cat(font_red("\nOnly results with 'R' are considered as resistance. Use `combine_SI = FALSE` to also consider 'I' as resistance.\n")) @@ -615,18 +615,18 @@ mdro <- function(x = NULL, cat(font_red("\nResults with 'R' or 'I' are considered as resistance. Use `combine_SI = TRUE` to only consider 'R' as resistance.\n")) } cat("\n", word_wrap("Determining multidrug-resistant organisms (MDRO), according to:"), "\n", - word_wrap(paste0(font_bold("Guideline: "), font_italic(guideline$name)), extra_indent = 11, as_note = FALSE), "\n", - word_wrap(paste0(font_bold("Author(s): "), guideline$author), extra_indent = 11, as_note = FALSE), "\n", - ifelse(!is.na(guideline$version), - paste0(word_wrap(paste0(font_bold("Version: "), guideline$version), extra_indent = 11, as_note = FALSE), "\n"), - "" - ), - paste0(font_bold("Source: "), guideline$source_url), - "\n\n", - sep = "" + word_wrap(paste0(font_bold("Guideline: "), font_italic(guideline$name)), extra_indent = 11, as_note = FALSE), "\n", + word_wrap(paste0(font_bold("Author(s): "), guideline$author), extra_indent = 11, as_note = FALSE), "\n", + ifelse(!is.na(guideline$version), + paste0(word_wrap(paste0(font_bold("Version: "), guideline$version), extra_indent = 11, as_note = FALSE), "\n"), + "" + ), + paste0(font_bold("Source: "), guideline$source_url), + "\n\n", + sep = "" ) } - + ab_missing <- function(ab) { isTRUE(ab %in% c(NULL, NA)) | length(ab) == 0 } @@ -638,7 +638,7 @@ mdro <- function(x = NULL, out[is.na(out)] <- FALSE out } - + # antibiotic classes # nolint start aminoglycosides <- c(TOB, GEN) @@ -649,17 +649,18 @@ mdro <- function(x = NULL, carbapenems <- c(DOR, ETP, IPM, MEM, MEV) fluoroquinolones <- c(CIP, ENX, FLE, GAT, GEM, GRX, LVX, LOM, MFX, NOR, OFX, PAZ, PEF, PRU, RFL, SPX, TMX, TVA) # nolint end - + # helper function for editing the table trans_tbl <- function(to, rows, cols, any_all) { cols <- cols[!ab_missing(cols)] cols <- cols[!is.na(cols)] if (length(rows) > 0 && length(cols) > 0) { - x[, cols] <- as.data.frame(lapply( - x[, cols, drop = FALSE], - function(col) as.sir(col) - ), - stringsAsFactors = FALSE + x[, cols] <- as.data.frame( + lapply( + x[, cols, drop = FALSE], + function(col) as.sir(col) + ), + stringsAsFactors = FALSE ) x[rows, "columns_nonsusceptible"] <<- vapply( FUN.VALUE = character(1), @@ -670,22 +671,23 @@ mdro <- function(x = NULL, x[row, group_vct, drop = FALSE], function(y) y %in% search_result ) - paste(sort(c( - unlist(strsplit(x[row, "columns_nonsusceptible", drop = TRUE], ", ", fixed = TRUE)), - names(cols_nonsus)[cols_nonsus] - )), - collapse = ", " + paste( + sort(c( + unlist(strsplit(x[row, "columns_nonsusceptible", drop = TRUE], ", ", fixed = TRUE)), + names(cols_nonsus)[cols_nonsus] + )), + collapse = ", " ) } ) - + if (any_all == "any") { search_function <- any } else if (any_all == "all") { search_function <- all } x_transposed <- as.list(as.data.frame(t(x[, cols, drop = FALSE]), - stringsAsFactors = FALSE + stringsAsFactors = FALSE )) rows_affected <- vapply( FUN.VALUE = logical(1), @@ -704,7 +706,7 @@ mdro <- function(x = NULL, ) } } - + trans_tbl2 <- function(txt, rows, lst) { if (isTRUE(info)) { message_(txt, "...", appendLF = FALSE, as_note = FALSE) @@ -714,12 +716,13 @@ mdro <- function(x = NULL, lst_vector <- unlist(lst)[!is.na(unlist(lst))] # keep only unique ones: lst_vector <- lst_vector[!duplicated(paste(lst_vector, names(lst_vector)))] - - x[, lst_vector] <- as.data.frame(lapply( - x[, lst_vector, drop = FALSE], - function(col) as.sir(col) - ), - stringsAsFactors = FALSE + + x[, lst_vector] <- as.data.frame( + lapply( + x[, lst_vector, drop = FALSE], + function(col) as.sir(col) + ), + stringsAsFactors = FALSE ) x[rows, "classes_in_guideline"] <<- length(lst) x[rows, "classes_available"] <<- vapply( @@ -733,7 +736,7 @@ mdro <- function(x = NULL, )) } ) - + if (isTRUE(verbose)) { x[rows, "columns_nonsusceptible"] <<- vapply( FUN.VALUE = character(1), @@ -748,30 +751,31 @@ mdro <- function(x = NULL, FUN.VALUE = double(1), rows, function(row, group_tbl = lst) { - sum(vapply( - FUN.VALUE = logical(1), - group_tbl, - function(group) { - any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% search_result, na.rm = TRUE) - } - ), - na.rm = TRUE + sum( + vapply( + FUN.VALUE = logical(1), + group_tbl, + function(group) { + any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% search_result, na.rm = TRUE) + } + ), + na.rm = TRUE ) } ) # for PDR; all drugs are R (or I if combine_SI = FALSE) x_transposed <- as.list(as.data.frame(t(x[rows, lst_vector, drop = FALSE]), - stringsAsFactors = FALSE + stringsAsFactors = FALSE )) row_filter <- vapply(FUN.VALUE = logical(1), x_transposed, function(y) all(y %in% search_result, na.rm = TRUE)) x[which(row_filter), "classes_affected"] <<- 999 } - + if (isTRUE(info)) { message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE) } } - + x[, col_mo] <- as.mo(as.character(x[, col_mo, drop = TRUE])) # rename col_mo to prevent interference with joined columns colnames(x)[colnames(x) == col_mo] <- ".col_mo" @@ -782,12 +786,12 @@ mdro <- function(x = NULL, x$row_number <- seq_len(nrow(x)) x$reason <- paste0("not covered by ", toupper(guideline$code), " guideline") x$columns_nonsusceptible <- "" - + if (guideline$code == "cmi2012") { # CMI, 2012 --------------------------------------------------------------- # Non-susceptible = R and I # (see header 'Approaches to Creating Definitions for MDR, XDR and PDR' in paper) - + # take amoxicillin if ampicillin is unavailable if (is.na(AMP) && !is.na(AMX)) { if (isTRUE(verbose)) { @@ -808,87 +812,87 @@ mdro <- function(x = NULL, } CTX <- CRO } - + # intrinsic resistant must not be considered for the determination of MDR, # so let's just remove them, meticulously following the paper x[which(x$genus == "Enterococcus" & x$species == "faecium"), ab_NA(IPM)] <- NA x[which(x$genus == "Enterococcus" & x$species == "faecalis"), ab_NA(QDA)] <- NA x[which((x$genus == "Providencia" & x$species == "rettgeri") | - (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(c(GEN, TOB, NET))] <- NA + (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(c(GEN, TOB, NET))] <- NA x[which(x$genus == "Escherichia" & x$species == "hermannii"), ab_NA(c(TCC, TZP))] <- NA x[which((x$genus == "Citrobacter" & x$species == "freundii") | - (x$genus == "Enterobacter" & x$species == "aerogenes") | - (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017) - | (x$genus == "Enterobacter" & x$species == "cloacae") | - (x$genus == "Hafnia" & x$species == "alvei") | - (x$genus == "Morganella" & x$species == "morganii") | - (x$genus == "Proteus" & x$species == "penneri") | - (x$genus == "Proteus" & x$species == "vulgaris") | - (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(CZO)] <- NA + (x$genus == "Enterobacter" & x$species == "aerogenes") | + (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017) + | (x$genus == "Enterobacter" & x$species == "cloacae") | + (x$genus == "Hafnia" & x$species == "alvei") | + (x$genus == "Morganella" & x$species == "morganii") | + (x$genus == "Proteus" & x$species == "penneri") | + (x$genus == "Proteus" & x$species == "vulgaris") | + (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(CZO)] <- NA x[which((x$genus == "Morganella" & x$species == "morganii") | - (x$genus == "Proteus" & x$species == "penneri") | - (x$genus == "Proteus" & x$species == "vulgaris") | - (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(CXM)] <- NA + (x$genus == "Proteus" & x$species == "penneri") | + (x$genus == "Proteus" & x$species == "vulgaris") | + (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(CXM)] <- NA x[which((x$genus == "Morganella" & x$species == "morganii") | - (x$genus == "Proteus" & x$species == "mirabilis") | - (x$genus == "Proteus" & x$species == "penneri") | - (x$genus == "Proteus" & x$species == "vulgaris") | - (x$genus == "Providencia" & x$species == "rettgeri") | - (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(TGC)] <- NA + (x$genus == "Proteus" & x$species == "mirabilis") | + (x$genus == "Proteus" & x$species == "penneri") | + (x$genus == "Proteus" & x$species == "vulgaris") | + (x$genus == "Providencia" & x$species == "rettgeri") | + (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(TGC)] <- NA x[which((x$genus == "Citrobacter" & x$species == "koseri") | - (x$genus == "Citrobacter" & x$species == "freundii") | - (x$genus == "Enterobacter" & x$species == "aerogenes") | - (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017) - | (x$genus == "Enterobacter" & x$species == "cloacae") | - (x$genus == "Escherichia" & x$species == "hermannii") | - (x$genus == "Hafnia" & x$species == "alvei") | - (x$genus == "Klebsiella") | - (x$genus == "Morganella" & x$species == "morganii") | - (x$genus == "Proteus" & x$species == "penneri") | - (x$genus == "Proteus" & x$species == "vulgaris") | - (x$genus == "Providencia" & x$species == "rettgeri") | - (x$genus == "Providencia" & x$species == "stuartii") | - (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(AMP)] <- NA + (x$genus == "Citrobacter" & x$species == "freundii") | + (x$genus == "Enterobacter" & x$species == "aerogenes") | + (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017) + | (x$genus == "Enterobacter" & x$species == "cloacae") | + (x$genus == "Escherichia" & x$species == "hermannii") | + (x$genus == "Hafnia" & x$species == "alvei") | + (x$genus == "Klebsiella") | + (x$genus == "Morganella" & x$species == "morganii") | + (x$genus == "Proteus" & x$species == "penneri") | + (x$genus == "Proteus" & x$species == "vulgaris") | + (x$genus == "Providencia" & x$species == "rettgeri") | + (x$genus == "Providencia" & x$species == "stuartii") | + (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(AMP)] <- NA x[which((x$genus == "Citrobacter" & x$species == "freundii") | - (x$genus == "Enterobacter" & x$species == "aerogenes") | - (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017) - | (x$genus == "Enterobacter" & x$species == "cloacae") | - (x$genus == "Hafnia" & x$species == "alvei") | - (x$genus == "Morganella" & x$species == "morganii") | - (x$genus == "Providencia" & x$species == "rettgeri") | - (x$genus == "Providencia" & x$species == "stuartii") | - (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(AMC)] <- NA + (x$genus == "Enterobacter" & x$species == "aerogenes") | + (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017) + | (x$genus == "Enterobacter" & x$species == "cloacae") | + (x$genus == "Hafnia" & x$species == "alvei") | + (x$genus == "Morganella" & x$species == "morganii") | + (x$genus == "Providencia" & x$species == "rettgeri") | + (x$genus == "Providencia" & x$species == "stuartii") | + (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(AMC)] <- NA x[which((x$genus == "Citrobacter" & x$species == "freundii") | - (x$genus == "Citrobacter" & x$species == "koseri") | - (x$genus == "Enterobacter" & x$species == "aerogenes") | - (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017) - | (x$genus == "Enterobacter" & x$species == "cloacae") | - (x$genus == "Hafnia" & x$species == "alvei") | - (x$genus == "Providencia" & x$species == "rettgeri") | - (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(SAM)] <- NA + (x$genus == "Citrobacter" & x$species == "koseri") | + (x$genus == "Enterobacter" & x$species == "aerogenes") | + (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017) + | (x$genus == "Enterobacter" & x$species == "cloacae") | + (x$genus == "Hafnia" & x$species == "alvei") | + (x$genus == "Providencia" & x$species == "rettgeri") | + (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(SAM)] <- NA x[which((x$genus == "Morganella" & x$species == "morganii") | - (x$genus == "Proteus" & x$species == "mirabilis") | - (x$genus == "Proteus" & x$species == "penneri") | - (x$genus == "Proteus" & x$species == "vulgaris") | - (x$genus == "Providencia" & x$species == "rettgeri") | - (x$genus == "Providencia" & x$species == "stuartii") | - (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(COL)] <- NA + (x$genus == "Proteus" & x$species == "mirabilis") | + (x$genus == "Proteus" & x$species == "penneri") | + (x$genus == "Proteus" & x$species == "vulgaris") | + (x$genus == "Providencia" & x$species == "rettgeri") | + (x$genus == "Providencia" & x$species == "stuartii") | + (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(COL)] <- NA x[which((x$genus == "Morganella" & x$species == "morganii") | - (x$genus == "Proteus" & x$species == "mirabilis") | - (x$genus == "Proteus" & x$species == "penneri") | - (x$genus == "Proteus" & x$species == "vulgaris") | - (x$genus == "Providencia" & x$species == "rettgeri") | - (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(TCY)] <- NA + (x$genus == "Proteus" & x$species == "mirabilis") | + (x$genus == "Proteus" & x$species == "penneri") | + (x$genus == "Proteus" & x$species == "vulgaris") | + (x$genus == "Providencia" & x$species == "rettgeri") | + (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(TCY)] <- NA x[which((x$genus == "Morganella" & x$species == "morganii") | - (x$genus == "Proteus" & x$species == "penneri") | - (x$genus == "Proteus" & x$species == "vulgaris") | - (x$genus == "Providencia" & x$species == "rettgeri") | - (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(c(DOX, MNO))] <- NA - + (x$genus == "Proteus" & x$species == "penneri") | + (x$genus == "Proteus" & x$species == "vulgaris") | + (x$genus == "Providencia" & x$species == "rettgeri") | + (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(c(DOX, MNO))] <- NA + x$classes_in_guideline <- NA_integer_ x$classes_available <- NA_integer_ x$classes_affected <- NA_integer_ - + # now add the MDR levels to the data trans_tbl( 2, @@ -990,7 +994,7 @@ mdro <- function(x = NULL, c(TCY, DOX, MNO) ) ) - + # now set MDROs: # MDR (=2): >=3 classes affected x[which(x$classes_affected >= 3), "MDRO"] <- 2 @@ -1002,7 +1006,7 @@ mdro <- function(x = NULL, " out of ", x$classes_available[which(x$classes_affected >= 3)], " available classes" ) } - + # XDR (=3): all but <=2 classes affected x[which((x$classes_in_guideline - x$classes_affected) <= 2), "MDRO"] <- 3 if (isTRUE(verbose)) { @@ -1011,7 +1015,7 @@ mdro <- function(x = NULL, " out of ", x$classes_in_guideline[which(x$MDRO == 3)], " classes)" ) } - + # PDR (=4): all drugs are R x[which(x$classes_affected == 999 & x$classes_in_guideline == x$classes_available), "MDRO"] <- 4 if (isTRUE(verbose)) { @@ -1022,7 +1026,7 @@ mdro <- function(x = NULL, ifelse(!isTRUE(combine_SI), " or I", "") ) } - + # not enough classes available x[which(x$MDRO %in% c(1, 3) & x$classes_available < floor(x$classes_in_guideline * pct_required_classes)), "MDRO"] <- -1 if (isTRUE(verbose)) { @@ -1032,18 +1036,18 @@ mdro <- function(x = NULL, " (~", percentage(pct_required_classes), " of ", x$classes_in_guideline[which(x$MDRO == -1)], ")" ) } - + # add antibiotic names of resistant ones to verbose output } - + if (guideline$code == "eucast3.1") { # EUCAST 3.1 -------------------------------------------------------------- # Table 5 trans_tbl( 3, which(x$order == "Enterobacterales" | - (x$genus == "Pseudomonas" & x$species == "aeruginosa") | - x$genus == "Acinetobacter"), + (x$genus == "Pseudomonas" & x$species == "aeruginosa") | + x$genus == "Acinetobacter"), COL, "all" ) @@ -1128,17 +1132,17 @@ mdro <- function(x = NULL, "any" ) } - + if (guideline$code == "eucast3.2") { # EUCAST 3.2 -------------------------------------------------------------- # Table 6 trans_tbl( 3, which((x$order == "Enterobacterales" & - !x$family == "Morganellaceae" & - !(x$genus == "Serratia" & x$species == "marcescens")) | - (x$genus == "Pseudomonas" & x$species == "aeruginosa") | - x$genus == "Acinetobacter"), + !x$family == "Morganellaceae" & + !(x$genus == "Serratia" & x$species == "marcescens")) | + (x$genus == "Pseudomonas" & x$species == "aeruginosa") | + x$genus == "Acinetobacter"), COL, "all" ) @@ -1229,7 +1233,7 @@ mdro <- function(x = NULL, "any" ) } - + if (guideline$code == "eucast3.3") { # EUCAST 3.3 -------------------------------------------------------------- # note: this guideline is equal to EUCAST 3.2 - no MDRO insights changed @@ -1237,10 +1241,10 @@ mdro <- function(x = NULL, trans_tbl( 3, which((x$order == "Enterobacterales" & - !x$family == "Morganellaceae" & - !(x$genus == "Serratia" & x$species == "marcescens")) | - (x$genus == "Pseudomonas" & x$species == "aeruginosa") | - x$genus == "Acinetobacter"), + !x$family == "Morganellaceae" & + !(x$genus == "Serratia" & x$species == "marcescens")) | + (x$genus == "Pseudomonas" & x$species == "aeruginosa") | + x$genus == "Acinetobacter"), COL, "all" ) @@ -1331,72 +1335,72 @@ mdro <- function(x = NULL, "any" ) } - + if (guideline$code == "mrgn") { # Germany ----------------------------------------------------------------- - + # Table 1 trans_tbl( 2, # 3MRGN which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification - (x$genus == "Acinetobacter" & x$species == "baumannii")) & - try_ab(x[, PIP, drop = TRUE] == "R") & - (try_ab(x[, CTX, drop = TRUE] == "R") | try_ab(x[, CAZ, drop = TRUE] == "R")) & - (try_ab(x[, IPM, drop = TRUE] != "R") | try_ab(x[, MEM, drop = TRUE] != "R")) & - try_ab(x[, CIP, drop = TRUE] == "R")), + (x$genus == "Acinetobacter" & x$species == "baumannii")) & + try_ab(x[, PIP, drop = TRUE] == "R") & + (try_ab(x[, CTX, drop = TRUE] == "R") | try_ab(x[, CAZ, drop = TRUE] == "R")) & + (try_ab(x[, IPM, drop = TRUE] != "R") | try_ab(x[, MEM, drop = TRUE] != "R")) & + try_ab(x[, CIP, drop = TRUE] == "R")), c(PIP, CTX, CAZ, IPM, MEM, CIP), "any" ) - + trans_tbl( 3, # 4MRGN, overwrites 3MRGN if applicable which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification - (x$genus == "Acinetobacter" & x$species == "baumannii")) & - try_ab(x[, PIP, drop = TRUE] == "R") & - (try_ab(x[, CTX, drop = TRUE] == "R") | try_ab(x[, CAZ, drop = TRUE] == "R")) & - (try_ab(x[, IPM, drop = TRUE] == "R") | try_ab(x[, MEM, drop = TRUE] == "R")) & - try_ab(x[, CIP, drop = TRUE] == "R")), + (x$genus == "Acinetobacter" & x$species == "baumannii")) & + try_ab(x[, PIP, drop = TRUE] == "R") & + (try_ab(x[, CTX, drop = TRUE] == "R") | try_ab(x[, CAZ, drop = TRUE] == "R")) & + (try_ab(x[, IPM, drop = TRUE] == "R") | try_ab(x[, MEM, drop = TRUE] == "R")) & + try_ab(x[, CIP, drop = TRUE] == "R")), c(PIP, CTX, CAZ, IPM, MEM, CIP), "any" ) - + trans_tbl( 3, # 4MRGN, overwrites 3MRGN if applicable which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification - (x$genus == "Acinetobacter" & x$species == "baumannii")) & - (try_ab(x[, IPM, drop = TRUE] == "R") | try_ab(x[, MEM, drop = TRUE] == "R"))), + (x$genus == "Acinetobacter" & x$species == "baumannii")) & + (try_ab(x[, IPM, drop = TRUE] == "R") | try_ab(x[, MEM, drop = TRUE] == "R"))), c(IPM, MEM), "any" ) - + trans_tbl( 2, # 3MRGN, if only 1 group is S which(x$genus == "Pseudomonas" & x$species == "aeruginosa" & - try_ab(x[, PIP, drop = TRUE] == "S") + - try_ab(x[, CTX, drop = TRUE] == "S") + - try_ab(x[, CAZ, drop = TRUE] == "S") + - try_ab(x[, IPM, drop = TRUE] == "S") + - try_ab(x[, MEM, drop = TRUE] == "S") + - try_ab(x[, CIP, drop = TRUE] == "S") == 1), + try_ab(x[, PIP, drop = TRUE] == "S") + + try_ab(x[, CTX, drop = TRUE] == "S") + + try_ab(x[, CAZ, drop = TRUE] == "S") + + try_ab(x[, IPM, drop = TRUE] == "S") + + try_ab(x[, MEM, drop = TRUE] == "S") + + try_ab(x[, CIP, drop = TRUE] == "S") == 1), c(PIP, CTX, CAZ, IPM, MEM, CIP), "any" ) - + trans_tbl( 3, # 4MRGN otherwise which((x$genus == "Pseudomonas" & x$species == "aeruginosa") & - try_ab(x[, PIP, drop = TRUE] == "R") & - (try_ab(x[, CTX, drop = TRUE] == "R") | try_ab(x[, CAZ, drop = TRUE] == "R")) & - (try_ab(x[, IPM, drop = TRUE] == "R") | try_ab(x[, MEM, drop = TRUE] == "R")) & - try_ab(x[, CIP, drop = TRUE] == "R")), + try_ab(x[, PIP, drop = TRUE] == "R") & + (try_ab(x[, CTX, drop = TRUE] == "R") | try_ab(x[, CAZ, drop = TRUE] == "R")) & + (try_ab(x[, IPM, drop = TRUE] == "R") | try_ab(x[, MEM, drop = TRUE] == "R")) & + try_ab(x[, CIP, drop = TRUE] == "R")), c(PIP, CTX, CAZ, IPM, MEM, CIP), "any" ) - + x[which(x$MDRO == 2), "reason"] <- "3MRGN" x[which(x$MDRO == 3), "reason"] <- "4MRGN" } - + if (guideline$code == "brmo") { # Netherlands ------------------------------------------------------------- aminoglycosides <- aminoglycosides[!is.na(aminoglycosides)] @@ -1409,7 +1413,7 @@ mdro <- function(x = NULL, if (length(ESBLs) != 2) { ESBLs <- character(0) } - + # Table 1 trans_tbl( 3, @@ -1417,21 +1421,21 @@ mdro <- function(x = NULL, c(aminoglycosides, fluoroquinolones), "all" ) - + trans_tbl( 2, which(x$order == "Enterobacterales"), # following in fact the old Enterobacteriaceae classification carbapenems, "any" ) - + trans_tbl( 2, which(x$order == "Enterobacterales"), # following in fact the old Enterobacteriaceae classification ESBLs, "all" ) - + # Table 2 trans_tbl( 2, @@ -1445,19 +1449,19 @@ mdro <- function(x = NULL, c(aminoglycosides, fluoroquinolones), "all" ) - + trans_tbl( 3, which(x$genus == "Stenotrophomonas" & x$species == "maltophilia"), SXT, "all" ) - + if (!ab_missing(MEM) && !ab_missing(IPM) && - !ab_missing(GEN) && !ab_missing(TOB) && - !ab_missing(CIP) && - !ab_missing(CAZ) && - !ab_missing(TZP)) { + !ab_missing(GEN) && !ab_missing(TOB) && + !ab_missing(CIP) && + !ab_missing(CAZ) && + !ab_missing(TZP)) { x$psae <- 0 x[which(x[, MEM, drop = TRUE] == "R" | x[, IPM, drop = TRUE] == "R"), "psae"] <- 1 + x[which(x[, MEM, drop = TRUE] == "R" | x[, IPM, drop = TRUE] == "R"), "psae"] x[which(x[, GEN, drop = TRUE] == "R" & x[, TOB, drop = TRUE] == "R"), "psae"] <- 1 + x[which(x[, GEN, drop = TRUE] == "R" & x[, TOB, drop = TRUE] == "R"), "psae"] @@ -1477,7 +1481,7 @@ mdro <- function(x = NULL, x$genus == "Pseudomonas" & x$species == "aeruginosa" & x$psae >= 3 ), "reason"] <- paste0("at least 3 classes contain R", ifelse(!isTRUE(combine_SI), " or I", "")) - + # Table 3 trans_tbl( 3, @@ -1498,7 +1502,7 @@ mdro <- function(x = NULL, "all" ) } - + if (guideline$code == "tb") { # Tuberculosis ------------------------------------------------------------ prepare_drug <- function(ab) { @@ -1535,7 +1539,7 @@ mdro <- function(x = NULL, ab != "R" } } - + x$mono_count <- 0 x[drug_is_R(INH), "mono_count"] <- x[drug_is_R(INH), "mono_count", drop = TRUE] + 1 x[drug_is_R(RIF), "mono_count"] <- x[drug_is_R(RIF), "mono_count", drop = TRUE] + 1 @@ -1543,7 +1547,7 @@ mdro <- function(x = NULL, x[drug_is_R(PZA), "mono_count"] <- x[drug_is_R(PZA), "mono_count", drop = TRUE] + 1 x[drug_is_R(RIB), "mono_count"] <- x[drug_is_R(RIB), "mono_count", drop = TRUE] + 1 x[drug_is_R(RFP), "mono_count"] <- x[drug_is_R(RFP), "mono_count", drop = TRUE] + 1 - + x$mono <- x$mono_count > 0 x$poly <- x$mono_count > 1 & drug_is_not_R(RIF) & drug_is_not_R(INH) x$mdr <- drug_is_R(RIF) & drug_is_R(INH) @@ -1551,19 +1555,19 @@ mdro <- function(x = NULL, x$second <- drug_is_R(CAP) | drug_is_R(KAN) | drug_is_R(AMK) x$xdr <- x$mdr & x$xdr & x$second x$MDRO <- ifelse(x$xdr, 5, - ifelse(x$mdr, 4, - ifelse(x$poly, 3, - ifelse(x$mono, 2, - 1 - ) - ) - ) + ifelse(x$mdr, 4, + ifelse(x$poly, 3, + ifelse(x$mono, 2, + 1 + ) + ) + ) ) # keep all real TB, make other species NA x$MDRO <- ifelse(x$fullname == "Mycobacterium tuberculosis", x$MDRO, NA_real_) x$reason <- "PDR/MDR/XDR criteria were met" } - + # some more info on negative results if (isTRUE(verbose)) { if (guideline$code == "cmi2012") { @@ -1579,7 +1583,7 @@ mdro <- function(x = NULL, x[which(x$MDRO == 1), "reason"] <- "too few antibiotics are R" } } - + if (isTRUE(info.bak)) { cat(group_msg) if (sum(!is.na(x$MDRO)) == 0) { @@ -1591,11 +1595,11 @@ mdro <- function(x = NULL, ))) } } - + # Fill in blanks ---- # for rows that have no results x_transposed <- as.list(as.data.frame(t(x[, cols_ab, drop = FALSE]), - stringsAsFactors = FALSE + stringsAsFactors = FALSE )) rows_empty <- which(vapply( FUN.VALUE = logical(1), @@ -1609,7 +1613,7 @@ mdro <- function(x = NULL, } else { cat("\n") } - + # Results ---- if (guideline$code == "cmi2012") { if (any(x$MDRO == -1, na.rm = TRUE)) { @@ -1656,7 +1660,7 @@ mdro <- function(x = NULL, ordered = TRUE ) } - + if (isTRUE(verbose)) { colnames(x)[colnames(x) == col_mo] <- "microorganism" x$microorganism <- mo_name(x$microorganism, language = NULL) @@ -1678,9 +1682,9 @@ mdro <- function(x = NULL, #' @export custom_mdro_guideline <- function(..., as_factor = TRUE) { meet_criteria(as_factor, allow_class = "logical", has_length = 1) - + dots <- tryCatch(list(...), - error = function(e) "error" + error = function(e) "error" ) stop_if( identical(dots, "error"), @@ -1694,7 +1698,7 @@ custom_mdro_guideline <- function(..., as_factor = TRUE) { inherits(dots[[i]], "formula"), "rule ", i, " must be a valid formula input (e.g., using '~'), see `?mdro`" ) - + # Query qry <- dots[[i]][[2]] if (inherits(qry, "call")) { @@ -1710,14 +1714,14 @@ custom_mdro_guideline <- function(..., as_factor = TRUE) { qry <- gsub(" *([&|+-/*^><==]+) *", " \\1 ", qry) qry <- gsub("'", "\"", qry, fixed = TRUE) out[[i]]$query <- as.expression(qry) - + # Value val <- tryCatch(eval(dots[[i]][[3]]), error = function(e) NULL) stop_if(is.null(val), "rule ", i, " must return a valid value, it now returns an error: ", tryCatch(eval(dots[[i]][[3]]), error = function(e) e$message)) stop_if(length(val) > 1, "rule ", i, " must return a value of length 1, not ", length(val)) out[[i]]$value <- as.character(val) } - + names(out) <- paste0("rule", seq_len(n_dots)) out <- set_clean_class(out, new_class = c("custom_mdro_guideline", "list")) attr(out, "values") <- unname(c("Negative", vapply(FUN.VALUE = character(1), unclass(out), function(x) x$value))) @@ -1739,8 +1743,8 @@ c.custom_mdro_guideline <- function(x, ..., as_factor = NULL) { } for (g in list(...)) { stop_ifnot(inherits(g, "custom_mdro_guideline"), - "for combining custom MDRO guidelines, all rules must be created with `custom_mdro_guideline()`", - call = FALSE + "for combining custom MDRO guidelines, all rules must be created with `custom_mdro_guideline()`", + call = FALSE ) vals <- attributes(x)$values if (!all(attributes(g)$values %in% vals)) { @@ -1790,28 +1794,28 @@ run_custom_mdro_guideline <- function(df, guideline, info) { reasons <- character(length = NROW(df)) for (i in seq_len(n_dots)) { qry <- tryCatch(eval(parse(text = guideline[[i]]$query), envir = df, enclos = parent.frame()), - error = function(e) { - AMR_env$err_msg <- e$message - return("error") - } + error = function(e) { + AMR_env$err_msg <- e$message + return("error") + } ) if (identical(qry, "error")) { warning_("in `custom_mdro_guideline()`: rule ", i, - " (`", as.character(guideline[[i]]$query), "`) was ignored because of this error message: ", - AMR_env$err_msg, - call = FALSE, - add_fn = font_red + " (`", as.character(guideline[[i]]$query), "`) was ignored because of this error message: ", + AMR_env$err_msg, + call = FALSE, + add_fn = font_red ) next } stop_ifnot(is.logical(qry), "in custom_mdro_guideline(): rule ", i, " (`", guideline[[i]]$query, - "`) must return `TRUE` or `FALSE`, not ", - format_class(class(qry), plural = FALSE), - call = FALSE + "`) must return `TRUE` or `FALSE`, not ", + format_class(class(qry), plural = FALSE), + call = FALSE ) - + new_mdros <- which(qry == TRUE & out == "") - + if (isTRUE(info)) { cat(word_wrap( "- Custom MDRO rule ", i, ": `", as.character(guideline[[i]]$query), @@ -1827,11 +1831,11 @@ run_custom_mdro_guideline <- function(df, guideline, info) { } out[out == ""] <- "Negative" reasons[out == "Negative"] <- "no rules matched" - + if (isTRUE(attributes(guideline)$as_factor)) { out <- factor(out, levels = attributes(guideline)$values, ordered = TRUE) } - + columns_nonsusceptible <- as.data.frame(t(df[, is.sir(df), drop = FALSE] == "R")) columns_nonsusceptible <- vapply( FUN.VALUE = character(1), @@ -1839,7 +1843,7 @@ run_custom_mdro_guideline <- function(df, guideline, info) { function(x) paste0(rownames(columns_nonsusceptible)[which(x)], collapse = " ") ) columns_nonsusceptible[is.na(out)] <- NA_character_ - + data.frame( row_number = seq_len(NROW(df)), MDRO = out, diff --git a/R/mean_amr_distance.R b/R/mean_amr_distance.R index 218e36da..34311469 100755 --- a/R/mean_amr_distance.R +++ b/R/mean_amr_distance.R @@ -49,13 +49,13 @@ #' sir <- random_sir(10) #' sir #' mean_amr_distance(sir) -#' +#' #' mic <- random_mic(10) #' mic #' mean_amr_distance(mic) #' # equal to the Z-score of their log2: #' (log2(mic) - mean(log2(mic))) / sd(log2(mic)) -#' +#' #' disk <- random_disk(10) #' disk #' mean_amr_distance(disk) @@ -143,7 +143,7 @@ mean_amr_distance.data.frame <- function(x, ..., combine_SI = TRUE) { df_classes <- colnames(df)[vapply(FUN.VALUE = logical(1), df, function(x) is.disk(x) | is.mic(x) | is.disk(x), USE.NAMES = FALSE)] df_antibiotics <- unname(get_column_abx(df, info = FALSE)) df <- df[, colnames(df)[colnames(df) %in% union(df_classes, df_antibiotics)], drop = FALSE] - + stop_if(ncol(df) < 2, "data set must contain at least two variables", call = -2 @@ -151,7 +151,7 @@ mean_amr_distance.data.frame <- function(x, ..., combine_SI = TRUE) { if (message_not_thrown_before("mean_amr_distance", "groups")) { message_("Calculating mean AMR distance based on columns ", vector_and(colnames(df), sort = FALSE)) } - + res <- vapply( FUN.VALUE = double(nrow(df)), df, diff --git a/R/mic.R b/R/mic.R index 1b98473d..3091a485 100755 --- a/R/mic.R +++ b/R/mic.R @@ -230,13 +230,13 @@ as.mic <- function(x, na.rm = FALSE) { vector_and(quotes = TRUE) cur_col <- get_current_column() warning_("in `as.mic()`: ", na_after - na_before, " result", - ifelse(na_after - na_before > 1, "s", ""), - ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")), - " truncated (", - round(((na_after - na_before) / length(x)) * 100), - "%) that were invalid MICs: ", - list_missing, - call = FALSE + ifelse(na_after - na_before > 1, "s", ""), + ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")), + " truncated (", + round(((na_after - na_before) / length(x)) * 100), + "%) that were invalid MICs: ", + list_missing, + call = FALSE ) } diff --git a/R/mo.R b/R/mo.R index 9d66f99d..7050b23c 100755 --- a/R/mo.R +++ b/R/mo.R @@ -183,12 +183,12 @@ as.mo <- function(x, x <- replace_ignore_pattern(x, ignore_pattern) x_lower <- tolower(x) - + complexes <- x[trimws2(x_lower) %like_case% " (complex|group)$"] if (length(complexes) > 0 && identical(remove_from_input, mo_cleaning_regex()) && !any(AMR_env$MO_lookup$fullname[which(AMR_env$MO_lookup$source == "Added by user")] %like% "(group|complex)", na.rm = TRUE)) { warning_("in `as.mo()`: 'complex' and 'group' were ignored from the input in ", length(complexes), " case", ifelse(length(complexes) > 1, "s", ""), ", as they are currently not supported.\nYou can add your own microorganism with `add_custom_microorganisms()`.", call = FALSE) } - + # WHONET: xxx = no growth x[x_lower %in% c("", "xxx", "na", "nan")] <- NA_character_ @@ -274,7 +274,7 @@ as.mo <- function(x, # take out the parts, split by space x_parts <- strsplit(gsub("-", " ", x_out, fixed = TRUE), " ", fixed = TRUE)[[1]] - + # do a pre-match on first character (and if it contains a space, first chars of first two terms) if (length(x_parts) %in% c(2, 3)) { # for genus + species + subspecies @@ -313,13 +313,13 @@ as.mo <- function(x, } else { minimum_matching_score_current <- minimum_matching_score } - + if (sum(m >= minimum_matching_score_current) > 10) { # at least 10 are left over, make the ones under `m` NA - m[m < minimum_matching_score_current] <- NA_real_ + m[m < minimum_matching_score_current] <- NA_real_ } - - top_hits <- mo_to_search[order(m, decreasing = TRUE, na.last = NA)] # na.last = NA will remove the NAs + + top_hits <- mo_to_search[order(m, decreasing = TRUE, na.last = NA)] # na.last = NA will remove the NAs if (length(top_hits) == 0) { warning_("No hits found for \"", x_search, "\" with minimum_matching_score = ", ifelse(is.null(minimum_matching_score), paste0("NULL (=", round(min(minimum_matching_score_current, na.rm = TRUE), 3), ")"), minimum_matching_score), ". Try setting this value lower or even to 0.", call = FALSE) result_mo <- NA_character_ @@ -365,18 +365,19 @@ as.mo <- function(x, plural <- c("s", "these uncertainties") } if (length(AMR_env$mo_uncertainties$original_input) <= 3) { - examples <- vector_and(paste0( - '"', AMR_env$mo_uncertainties$original_input, - '" (assumed ', italicise(AMR_env$mo_uncertainties$fullname), ")" - ), - quotes = FALSE + examples <- vector_and( + paste0( + '"', AMR_env$mo_uncertainties$original_input, + '" (assumed ', italicise(AMR_env$mo_uncertainties$fullname), ")" + ), + quotes = FALSE ) } else { examples <- paste0(nr2char(length(AMR_env$mo_uncertainties$original_input)), " microorganism", plural[1]) } msg <- c(msg, paste0( "Microorganism translation was uncertain for ", examples, - ". Run `mo_uncertainties()` to review ", plural[2], ", or use `add_custom_microorganisms()` to add own entries." + ". Run `mo_uncertainties()` to review ", plural[2], ", or use `add_custom_microorganisms()` to add custom entries." )) for (m in msg) { @@ -442,7 +443,7 @@ as.mo <- function(x, # Apply Lancefield ---- if (isTRUE(Lancefield) || Lancefield == "all") { # (using `%like_case%` to also match subspecies) - + # group A - S. pyogenes out[out %like_case% "^B_STRPT_PYGN(_|$)"] <- "B_STRPT_GRPA" # group B - S. agalactiae @@ -560,7 +561,7 @@ pillar_shaft.mo <- function(x, ...) { # markup NA and UNKNOWN out[is.na(x)] <- font_na(" NA") out[x == "UNKNOWN"] <- font_na(" UNKNOWN") - + # markup manual codes out[x %in% AMR_env$MO_lookup$mo & !x %in% AMR::microorganisms$mo] <- font_blue(out[x %in% AMR_env$MO_lookup$mo & !x %in% AMR::microorganisms$mo], collapse = NULL) @@ -577,10 +578,11 @@ pillar_shaft.mo <- function(x, ...) { if (!all(x %in% all_mos) || (!is.null(df) && !all(unlist(df[, which(mo_cols), drop = FALSE]) %in% all_mos))) { # markup old mo codes - out[!x %in% all_mos] <- font_italic(font_na(x[!x %in% all_mos], + out[!x %in% all_mos] <- font_italic( + font_na(x[!x %in% all_mos], + collapse = NULL + ), collapse = NULL - ), - collapse = NULL ) # throw a warning with the affected column name(s) if (!is.null(mo_cols)) { @@ -797,7 +799,7 @@ print.mo_uncertainties <- function(x, ...) { cat(word_wrap("No uncertainties to show. Only uncertainties of the last call of `as.mo()` or any `mo_*()` function are stored.\n\n", add_fn = font_blue)) return(invisible(NULL)) } - + add_MO_lookup_to_AMR_env() cat(word_wrap("Matching scores are based on the resemblance between the input and the full taxonomic name, and the pathogenicity in humans. See `?mo_matching_score`.\n\n", add_fn = font_blue)) @@ -819,7 +821,7 @@ print.mo_uncertainties <- function(x, ...) { text[scores < 0.5] <- font_red_bg(text[scores < 0.5], collapse = NULL) text } - + txt <- "" for (i in seq_len(nrow(x))) { if (x[i, ]$candidates != "") { @@ -835,21 +837,23 @@ print.mo_uncertainties <- function(x, ...) { candidates_formatted <- candidates_formatted[order(1 - scores)] scores_formatted <- scores_formatted[order(1 - scores)] - candidates <- word_wrap(paste0( - "Also matched: ", - vector_and(paste0( - candidates_formatted, - font_blue(paste0(" (", scores_formatted, ")"), collapse = NULL) + candidates <- word_wrap( + paste0( + "Also matched: ", + vector_and( + paste0( + candidates_formatted, + font_blue(paste0(" (", scores_formatted, ")"), collapse = NULL) + ), + quotes = FALSE, sort = FALSE + ), + ifelse(n_candidates == 25, + font_grey(" [showing first 25]"), + "" + ) ), - quotes = FALSE, sort = FALSE - ), - ifelse(n_candidates == 25, - font_grey(" [showing first 25]"), - "" - ) - ), - extra_indent = nchar("Also matched: "), - width = 0.9 * getOption("width", 100) + extra_indent = nchar("Also matched: "), + width = 0.9 * getOption("width", 100) ) } else { candidates <- "" @@ -954,17 +958,17 @@ convert_colloquial_input <- function(x) { out[x %like_case% "mil+er+i gr"] <- "B_STRPT_MILL" out[x %like_case% "((strepto|^s).* viridans|^vgs[^a-z]*$)"] <- "B_STRPT_VIRI" out[x %like_case% "(viridans.* (strepto|^s).*|^vgs[^a-z]*$)"] <- "B_STRPT_VIRI" - + # Salmonella in different languages, like "Salmonella grupo B" out[x %like_case% "salmonella.* [bcd]$"] <- gsub(".*salmonella.* ([bcd])$", - "B_SLMNL_GRP\\U\\1", - x[x %like_case% "salmonella.* [bcd]$"], - perl = TRUE + "B_SLMNL_GRP\\U\\1", + x[x %like_case% "salmonella.* [bcd]$"], + perl = TRUE ) out[x %like_case% "group [bcd] salmonella"] <- gsub(".*group ([bcd]) salmonella*", - "B_SLMNL_GRP\\U\\1", - x[x %like_case% "group [bcd] salmonella"], - perl = TRUE + "B_SLMNL_GRP\\U\\1", + x[x %like_case% "group [bcd] salmonella"], + perl = TRUE ) # CoNS/CoPS in different languages (support for German, Dutch, Spanish, Portuguese) @@ -999,10 +1003,14 @@ convert_colloquial_input <- function(x) { italicise <- function(x) { out <- font_italic(x, collapse = NULL) - out[x %like_case% "Salmonella [A-Z]"] <- paste(font_italic("Salmonella"), - gsub("Salmonella ", "", x[x %like_case% "Salmonella [A-Z]"])) - out[x %like_case% "Streptococcus [A-Z]"] <- paste(font_italic("Streptococcus"), - gsub("Streptococcus ", "", x[x %like_case% "Streptococcus [A-Z]"])) + out[x %like_case% "Salmonella [A-Z]"] <- paste( + font_italic("Salmonella"), + gsub("Salmonella ", "", x[x %like_case% "Salmonella [A-Z]"]) + ) + out[x %like_case% "Streptococcus [A-Z]"] <- paste( + font_italic("Streptococcus"), + gsub("Streptococcus ", "", x[x %like_case% "Streptococcus [A-Z]"]) + ) if (has_colour()) { out <- gsub("(Group|group|Complex|complex)(\033\\[23m)?", "\033[23m\\1", out, perl = TRUE) } diff --git a/R/mo_matching_score.R b/R/mo_matching_score.R index 6b730552..67ac2071 100755 --- a/R/mo_matching_score.R +++ b/R/mo_matching_score.R @@ -34,13 +34,13 @@ #' @param x Any user input value(s) #' @param n A full taxonomic name, that exists in [`microorganisms$fullname`][microorganisms] #' @note This algorithm was originally described in: Berends MS *et al.* (2022). **AMR: An R Package for Working with Antimicrobial Resistance Data**. *Journal of Statistical Software*, 104(3), 1-31; \doi{10.18637/jss.v104.i03}. -#' +#' #' Later, the work of Bartlett A *et al.* about bacterial pathogens infecting humans (2022, \doi{10.1099/mic.0.001269}) was incorporated. #' @section Matching Score for Microorganisms: #' With ambiguous user input in [as.mo()] and all the [`mo_*`][mo_property()] functions, the returned results are chosen based on their matching score using [mo_matching_score()]. This matching score \eqn{m}, is calculated as: #' #' \ifelse{latex}{\deqn{m_{(x, n)} = \frac{l_{n} - 0.5 \cdot \min \begin{cases}l_{n} \\ \textrm{lev}(x, n)\end{cases}}{l_{n} \cdot p_{n} \cdot k_{n}}}}{ -#' +#' #' \ifelse{html}{\figure{mo_matching_score.png}{options: width="300" alt="mo matching score"}}{m(x, n) = ( l_n * min(l_n, lev(x, n) ) ) / ( l_n * p_n * k_n )}} #' #' where: @@ -53,12 +53,12 @@ #' * \eqn{k_n} is the taxonomic kingdom of \eqn{n}, set as Bacteria = 1, Fungi = 2, Protozoa = 3, Archaea = 4, others = 5. #' #' The grouping into human pathogenic prevalence \eqn{p} is based on recent work from Bartlett *et al.* (2022, \doi{10.1099/mic.0.001269}) who extensively studied medical-scientific literature to categorise all bacterial species into these groups: -#' +#' #' - **Established**, if a taxonomic species has infected at least three persons in three or more references. These records have `prevalence = 1.0` in the [microorganisms] data set; #' - **Putative**, if a taxonomic species has fewer than three known cases. These records have `prevalence = 1.25` in the [microorganisms] data set. -#' +#' #' Furthermore, -#' +#' #' - Any genus present in the **established** list also has `prevalence = 1.0` in the [microorganisms] data set; #' - Any other genus present in the **putative** list has `prevalence = 1.25` in the [microorganisms] data set; #' - Any other species or subspecies of which the genus is present in the two aforementioned groups, has `prevalence = 1.5` in the [microorganisms] data set; @@ -72,7 +72,7 @@ #' @inheritSection AMR Reference Data Publicly Available #' @examples #' mo_reset_session() -#' +#' #' as.mo("E. coli") #' mo_uncertainties() #' @@ -95,7 +95,7 @@ mo_matching_score <- function(x, n) { # force a capital letter, so this conversion will not count as a substitution substr(x, 1, 1) <- toupper(substr(x, 1, 1)) - + # n is always a taxonomically valid full name if (length(n) == 1) { n <- rep(n, length(x)) @@ -103,7 +103,7 @@ mo_matching_score <- function(x, n) { if (length(x) == 1) { x <- rep(x, length(n)) } - + # length of fullname l_n <- nchar(n) lev <- double(length = length(x)) @@ -126,7 +126,7 @@ mo_matching_score <- function(x, n) { p_n <- AMR_env$MO_lookup[match(n, AMR_env$MO_lookup$fullname), "prevalence", drop = TRUE] # kingdom index (Bacteria = 1, Fungi = 2, Protozoa = 3, Archaea = 4, others = 5) k_n <- AMR_env$MO_lookup[match(n, AMR_env$MO_lookup$fullname), "kingdom_index", drop = TRUE] - + # matching score: (l_n - 0.5 * l_n.lev) / (l_n * p_n * k_n) } diff --git a/R/mo_property.R b/R/mo_property.R index 26858742..34f7abbf 100755 --- a/R/mo_property.R +++ b/R/mo_property.R @@ -133,7 +133,6 @@ #' mo_fullname("K. pneu rh") #' mo_shortname("K. pneu rh") #' -#' #' \donttest{ #' # Becker classification, see ?as.mo ---------------------------------------- #' @@ -158,7 +157,7 @@ #' mo_gramstain("Klebsiella pneumoniae", language = "es") # Spanish #' mo_gramstain("Klebsiella pneumoniae", language = "el") # Greek #' mo_gramstain("Klebsiella pneumoniae", language = "uk") # Ukrainian -#' +#' #' # mo_type is equal to mo_kingdom, but mo_kingdom will remain untranslated #' mo_kingdom("Klebsiella pneumoniae") #' mo_type("Klebsiella pneumoniae") @@ -426,17 +425,23 @@ mo_pathogenicity <- function(x, language = get_AMR_locale(), keep_synonyms = get kngd <- AMR_env$MO_lookup$kingdom[match(x.mo, AMR_env$MO_lookup$mo)] rank <- AMR_env$MO_lookup$rank[match(x.mo, AMR_env$MO_lookup$mo)] - out <- factor(ifelse(prev == 1 & kngd == "Bacteria" & rank != "genus", - "Pathogenic", - ifelse(prev < 2 & kngd == "Fungi", - "Potentially pathogenic", - ifelse(prev == 2 & kngd == "Bacteria", - "Non-pathogenic", - ifelse(kngd == "Bacteria", - "Potentially pathogenic", - "Unknown")))), - levels = c("Pathogenic", "Potentially pathogenic", "Non-pathogenic", "Unknown"), - ordered = TRUE) + out <- factor( + ifelse(prev == 1 & kngd == "Bacteria" & rank != "genus", + "Pathogenic", + ifelse(prev < 2 & kngd == "Fungi", + "Potentially pathogenic", + ifelse(prev == 2 & kngd == "Bacteria", + "Non-pathogenic", + ifelse(kngd == "Bacteria", + "Potentially pathogenic", + "Unknown" + ) + ) + ) + ), + levels = c("Pathogenic", "Potentially pathogenic", "Non-pathogenic", "Unknown"), + ordered = TRUE + ) load_mo_uncertainties(metadata) out @@ -727,7 +732,7 @@ mo_synonyms <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio meet_criteria(x, allow_NA = TRUE) language <- validate_language(language) meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1) - + add_MO_lookup_to_AMR_env() x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...) @@ -815,7 +820,7 @@ mo_url <- function(x, open = FALSE, language = get_AMR_locale(), keep_synonyms = meet_criteria(open, allow_class = "logical", has_length = 1) language <- validate_language(language) meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1) - + add_MO_lookup_to_AMR_env() x.mo <- as.mo(x = x, language = language, keep_synonyms = keep_synonyms, ... = ...) @@ -862,7 +867,7 @@ mo_property <- function(x, property = "fullname", language = get_AMR_locale(), k mo_validate <- function(x, property, language, keep_synonyms = keep_synonyms, ...) { add_MO_lookup_to_AMR_env() - + # try to catch an error when inputting an invalid argument # so the 'call.' can be set to FALSE tryCatch(x[1L] %in% unlist(AMR_env$MO_lookup[1, property, drop = TRUE]), diff --git a/R/mo_source.R b/R/mo_source.R index f55fe494..74fe5784 100755 --- a/R/mo_source.R +++ b/R/mo_source.R @@ -262,7 +262,7 @@ get_mo_source <- function(destination = getOption("AMR_mo_source", "~/mo_source. check_validity_mo_source <- function(x, refer_to_name = "`reference_df`", stop_on_error = TRUE) { add_MO_lookup_to_AMR_env() - + if (paste(deparse(substitute(x)), collapse = "") == "get_mo_source()") { return(TRUE) } diff --git a/R/proportion.R b/R/proportion.R index 310bb37e..0ff939b5 100755 --- a/R/proportion.R +++ b/R/proportion.R @@ -140,7 +140,6 @@ #' ) #' } #' if (require("dplyr")) { -#' #' # scoped dplyr verbs with antibiotic selectors #' # (you could also use across() of course) #' example_isolates %>% diff --git a/R/resistance_predict.R b/R/resistance_predict.R index 7a8878b9..378b489c 100755 --- a/R/resistance_predict.R +++ b/R/resistance_predict.R @@ -274,7 +274,7 @@ resistance_predict <- function(x, df_prediction$value <- ifelse(df_prediction$value > 1, 1, pmax(df_prediction$value, 0)) df_prediction <- df_prediction[order(df_prediction$year), , drop = FALSE] - out <- as_original_data_class(df_prediction, class(x.bak)) # will remove tibble groups + out <- as_original_data_class(df_prediction, class(x.bak)) # will remove tibble groups structure(out, class = c("resistance_predict", class(out)), I_as_S = I_as_S, diff --git a/R/sir.R b/R/sir.R index 69dc8b39..faa24afb 100755 --- a/R/sir.R +++ b/R/sir.R @@ -64,16 +64,16 @@ #' ``` #' 4. For **interpreting a complete data set**, with automatic determination of MIC values, disk diffusion diameters, microorganism names or codes, and antimicrobial test results. This is done very simply by running `as.sir(your_data)`. #' -#' For points 2, 3 and 4: Use [sir_interpretation_history()] to retrieve a [data.frame] (or [tibble][tibble::tibble()] if the `tibble` package is installed) with all results of the last [as.sir()] call. +#' **For points 2, 3 and 4: Use [sir_interpretation_history()]** to retrieve a [data.frame] (or [tibble][tibble::tibble()] if the `tibble` package is installed) with all results of the last [as.sir()] call. #' #' ### Supported Guidelines #' #' For interpreting MIC values as well as disk diffusion diameters, currently implemented guidelines are EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`). #' #' Thus, the `guideline` argument must be set to e.g., ``r paste0('"', subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline[1], '"')`` or ``r paste0('"', subset(clinical_breakpoints, guideline %like% "CLSI")$guideline[1], '"')``. By simply using `"EUCAST"` (the default) or `"CLSI"` as input, the latest included version of that guideline will automatically be selected. You can set your own data set using the `reference_data` argument. The `guideline` argument will then be ignored. -#' +#' #' You can set the default guideline with the `AMR_guideline` [option][options()] (e.g. in your `.Rprofile` file), such as: -#' +#' #' ``` #' options(AMR_guideline = "CLSI") #' options(AMR_guideline = "CLSI 2018") @@ -104,7 +104,7 @@ #' A microorganism is categorised as "Susceptible, Increased exposure*" when there is a high likelihood of therapeutic success because exposure to the agent is increased by adjusting the dosing regimen or by its concentration at the site of infection. #' - **R = Resistant**\cr #' A microorganism is categorised as "Resistant" when there is a high likelihood of therapeutic failure even when there is increased exposure. -#' +#' #' * *Exposure* is a function of how the mode of administration, dose, dosing interval, infusion time, as well as distribution and excretion of the antimicrobial agent will influence the infecting organism at the site of infection. #' #' This AMR package honours this insight. Use [susceptibility()] (equal to [proportion_SI()]) to determine antimicrobial susceptibility and [count_susceptible()] (equal to [count_SI()]) to count susceptible isolates. @@ -297,7 +297,7 @@ as.sir.default <- function(x, ...) { x.bak <- x x <- as.character(x) # this is needed to prevent the vctrs pkg from throwing an error - + if (inherits(x.bak, c("integer", "numeric", "double")) && all(x %in% c(1:3, NA))) { # support haven package for importing e.g., from SPSS - it adds the 'labels' attribute lbls <- attributes(x.bak)$labels @@ -328,7 +328,7 @@ as.sir.default <- function(x, ...) { x <- trimws2(as.character(unlist(x))) x[x %in% c(NA, "", "-", "NULL")] <- NA_character_ x.bak <- x - + na_before <- length(x[is.na(x)]) # correct for translations @@ -768,13 +768,13 @@ as_sir_method <- function(method_short, if (length(uti) == 1) { uti <- rep(uti, length(x)) } - + if (isTRUE(add_intrinsic_resistance) && guideline_coerced %unlike% "EUCAST") { if (message_not_thrown_before("as.sir", "intrinsic")) { warning_("in `as.sir()`: using 'add_intrinsic_resistance' is only useful when using EUCAST guidelines, since the rules for intrinsic resistance are based on EUCAST.") } } - + agent_formatted <- paste0("'", font_bold(ab.bak), "'") agent_name <- ab_name(ab, tolower = TRUE, language = NULL) if (generalise_antibiotic_name(ab.bak) == generalise_antibiotic_name(agent_name)) { @@ -801,27 +801,31 @@ as_sir_method <- function(method_short, appendLF = FALSE, as_note = FALSE ) - + msg_note <- function(messages) { for (i in seq_len(length(messages))) { messages[i] <- word_wrap(extra_indent = 5, messages[i]) } - message(font_green(font_bold(" Note:\n")), - paste0(" ", font_black(AMR_env$bullet_icon)," ", font_black(messages, collapse = NULL) , collapse = "\n")) + message( + font_green(font_bold(" Note:\n")), + paste0(" ", font_black(AMR_env$bullet_icon), " ", font_black(messages, collapse = NULL), collapse = "\n") + ) } method <- method_short metadata_mo <- get_mo_uncertainties() - df <- data.frame(values = x, - mo = mo, - result = NA_sir_, - uti = uti, - stringsAsFactors = FALSE) + df <- data.frame( + values = x, + mo = mo, + result = NA_sir_, + uti = uti, + stringsAsFactors = FALSE + ) if (method == "mic") { # when as.sir.mic is called directly - df$values <- as.mic(df$values) + df$values <- as.mic(df$values) } else if (method == "disk") { # when as.sir.disk is called directly df$values <- as.disk(df$values) @@ -832,7 +836,7 @@ as_sir_method <- function(method_short, method_coerced <- toupper(method) ab_coerced <- ab mo_coerced <- mo - + if (identical(reference_data, AMR::clinical_breakpoints)) { breakpoints <- reference_data %pm>% subset(guideline == guideline_coerced & method == method_coerced & ab == ab_coerced) @@ -845,30 +849,31 @@ as_sir_method <- function(method_short, breakpoints <- reference_data %pm>% subset(method == method_coerced & ab == ab_coerced) } - + msgs <- character(0) if (nrow(breakpoints) == 0) { # apparently no breakpoints found - msg_note(paste0("No ", method_coerced, " breakpoints available for ", - suppressMessages(suppressWarnings(ab_name(ab_coerced, language = NULL, tolower = TRUE))), - " (", ab_coerced, ")")) + msg_note(paste0( + "No ", method_coerced, " breakpoints available for ", + suppressMessages(suppressWarnings(ab_name(ab_coerced, language = NULL, tolower = TRUE))), + " (", ab_coerced, ")" + )) load_mo_uncertainties(metadata_mo) return(rep(NA_sir_, nrow(df))) } - + if (guideline_coerced %like% "EUCAST") { any_is_intrinsic_resistant <- FALSE add_intrinsic_resistance_to_AMR_env() } - + # run the rules for (mo_unique in unique(df$mo)) { - rows <- which(df$mo == mo_unique) values <- df[rows, "values", drop = TRUE] uti <- df[rows, "uti", drop = TRUE] new_sir <- rep(NA_sir_, length(rows)) - + # find different mo properties mo_current_genus <- as.mo(mo_genus(mo_unique, language = NULL)) mo_current_family <- as.mo(mo_family(mo_unique, language = NULL)) @@ -890,17 +895,21 @@ as_sir_method <- function(method_short, if (!mo_rank(mo_unique) %in% c("kingdom", "phylum", "class", "order")) { mo_formatted <- font_italic(mo_formatted) } - ab_formatted <- paste0(suppressMessages(suppressWarnings(ab_name(ab_coerced, language = NULL, tolower = TRUE))), - " (", ab_coerced, ")") - - # gather all available breakpoints for current MO and sort on taxonomic rank + ab_formatted <- paste0( + suppressMessages(suppressWarnings(ab_name(ab_coerced, language = NULL, tolower = TRUE))), + " (", ab_coerced, ")" + ) + + # gather all available breakpoints for current MO and sort on taxonomic rank # (this will prefer species breakpoints over order breakpoints) breakpoints_current <- breakpoints %pm>% - subset(mo %in% c(mo_current_genus, mo_current_family, - mo_current_order, mo_current_class, - mo_current_becker, mo_current_lancefield, - mo_current_other)) - + subset(mo %in% c( + mo_current_genus, mo_current_family, + mo_current_order, mo_current_class, + mo_current_becker, mo_current_lancefield, + mo_current_other + )) + if (any(df[rows, "uti", drop = TRUE], na.rm = TRUE)) { breakpoints_current <- breakpoints_current %pm>% # be as specific as possible (i.e. prefer species over genus): @@ -911,7 +920,7 @@ as_sir_method <- function(method_short, # sort UTI = FALSE first, then UTI = TRUE pm_arrange(rank_index, uti) } - + # throw notes for different body sites if (nrow(breakpoints_current) == 1 && all(breakpoints_current$uti == TRUE) && any(uti %in% c(FALSE, NA)) && message_not_thrown_before("as.sir", "uti", ab_coerced)) { # only UTI breakpoints available @@ -932,16 +941,15 @@ as_sir_method <- function(method_short, } msgs <- c(msgs, paste0("Multiple breakpoints available for ", ab_formatted, " in ", mo_formatted, " - assuming ", site, ".")) } - + # first check if mo is intrinsic resistant if (isTRUE(add_intrinsic_resistance) && guideline_coerced %like% "EUCAST" && paste(mo_unique, ab_coerced) %in% AMR_env$intrinsic_resistant) { msgs <- c(msgs, paste0("Intrinsic resistance applied for ", ab_formatted, " in ", mo_formatted, "")) new_sir <- rep(as.sir("R"), length(rows)) - } else { # then run the rules breakpoints_current <- breakpoints_current[1L, , drop = FALSE] - + if (method == "mic") { new_sir <- quick_case_when( is.na(values) ~ NA_sir_, @@ -953,7 +961,6 @@ as_sir_method <- function(method_short, # and NA otherwise TRUE ~ NA_sir_ ) - } else if (method == "disk") { new_sir <- quick_case_when( is.na(values) ~ NA_sir_, @@ -988,10 +995,10 @@ as_sir_method <- function(method_short, ) ) } - + df[rows, "result"] <- new_sir } - + if (isTRUE(rise_warning)) { message(font_yellow(font_bold(" * WARNING *"))) } else if (length(msgs) == 0) { @@ -999,9 +1006,9 @@ as_sir_method <- function(method_short, } else { msg_note(sort(msgs)) } - + load_mo_uncertainties(metadata_mo) - + df$result } @@ -1027,6 +1034,9 @@ sir_interpretation_history <- function(clean = FALSE) { AMR_env$sir_interpretation_history <- out.bak } + # sort descending on time + out <- out[order(out$datetime, decreasing = TRUE), , drop = FALSE] + if (pkg_is_available("tibble", also_load = FALSE)) { import_fn("as_tibble", "tibble")(out) } else { diff --git a/R/sysdata.rda b/R/sysdata.rda index ddff74bd..d5b23637 100755 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/R/translate.R b/R/translate.R index fb076cc8..91c7b92e 100755 --- a/R/translate.R +++ b/R/translate.R @@ -141,10 +141,11 @@ reset_AMR_locale <- function() { #' @export translate_AMR <- function(x, language = get_AMR_locale()) { translate_into_language(x, - language = language, - only_unknown = FALSE, - only_affect_ab_names = FALSE, - only_affect_mo_names = FALSE) + language = language, + only_unknown = FALSE, + only_affect_ab_names = FALSE, + only_affect_mo_names = FALSE + ) } @@ -170,14 +171,15 @@ find_language <- function(language, fallback = TRUE) { language <- Map(LANGUAGES_SUPPORTED_NAMES, LANGUAGES_SUPPORTED, f = function(l, n, check = language) { - grepl(paste0( - "^(", l[1], "|", l[2], "|", - n, "(_|$)|", toupper(n), "(_|$))" - ), - check, - ignore.case = TRUE, - perl = TRUE, - useBytes = FALSE + grepl( + paste0( + "^(", l[1], "|", l[2], "|", + n, "(_|$)|", toupper(n), "(_|$))" + ), + check, + ignore.case = TRUE, + perl = TRUE, + useBytes = FALSE ) }, USE.NAMES = TRUE @@ -196,7 +198,6 @@ translate_into_language <- function(from, only_unknown = FALSE, only_affect_ab_names = FALSE, only_affect_mo_names = FALSE) { - # get ISO-639-1 of language lang <- validate_language(language) if (lang == "en") { @@ -260,10 +261,10 @@ translate_into_language <- function(from, # force UTF-8 for diacritics from_unique_translated <- enc2utf8(from_unique_translated) - + # a kind of left join to get all results back out <- from_unique_translated[match(from.bak, from_unique)] - + if (!identical(from.bak, out) && get_AMR_locale() == lang && message_not_thrown_before("translation", entire_session = TRUE) && interactive()) { message(word_wrap( "Assuming the ", LANGUAGES_SUPPORTED_NAMES[[lang]]$exonym, " language (", @@ -271,6 +272,6 @@ translate_into_language <- function(from, add_fn = list(font_blue), as_note = TRUE )) } - + out } diff --git a/R/zz_deprecated.R b/R/zz_deprecated.R index 81325f08..d54537c2 100755 --- a/R/zz_deprecated.R +++ b/R/zz_deprecated.R @@ -35,7 +35,8 @@ #' @rdname AMR-deprecated #' @export NA_rsi_ <- set_clean_class(factor(NA_character_, levels = c("S", "I", "R"), ordered = TRUE), - new_class = c("rsi", "ordered", "factor")) + new_class = c("rsi", "ordered", "factor") +) #' @rdname AMR-deprecated #' @export as.rsi <- function(x, ...) { @@ -197,14 +198,18 @@ deprecation_warning <- function(old = NULL, new = NULL, extra_msg = NULL) { env <- paste0("deprecated_", old) if (!env %in% names(AMR_env)) { AMR_env[[paste0("deprecated_", old)]] <- 1 - warning_(ifelse(is.null(new), - paste0("The `", old, "()` function is no longer in use"), - paste0("The `", old, "()` function has been replaced with `", new, "()`")), - ", see `?AMR-deprecated`.", - ifelse(!is.null(extra_msg), - paste0(" ", extra_msg), - ""), - "\nThis warning will be shown once per session.") + warning_( + ifelse(is.null(new), + paste0("The `", old, "()` function is no longer in use"), + paste0("The `", old, "()` function has been replaced with `", new, "()`") + ), + ", see `?AMR-deprecated`.", + ifelse(!is.null(extra_msg), + paste0(" ", extra_msg), + "" + ), + "\nThis warning will be shown once per session." + ) } } } diff --git a/R/zzz.R b/R/zzz.R index 77aaa2ed..1cc10a1b 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -192,18 +192,24 @@ if (utf8_supported && !is_latex) { if (!is.null(getOption("AMR_custom_ab")) && file.exists(getOption("AMR_custom_ab", default = ""))) { packageStartupMessage("Adding custom antimicrobials from '", getOption("AMR_custom_ab"), "'...", appendLF = FALSE) x <- readRDS2(getOption("AMR_custom_ab")) - tryCatch({ - suppressWarnings(suppressMessages(add_custom_antimicrobials(x))) - packageStartupMessage("OK.") - }, error = function(e) packageStartupMessage("Failed: ", e$message)) + tryCatch( + { + suppressWarnings(suppressMessages(add_custom_antimicrobials(x))) + packageStartupMessage("OK.") + }, + error = function(e) packageStartupMessage("Failed: ", e$message) + ) } # if custom mo option is available, load it if (!is.null(getOption("AMR_custom_mo")) && file.exists(getOption("AMR_custom_mo", default = ""))) { packageStartupMessage("Adding custom microorganisms from '", getOption("AMR_custom_mo"), "'...", appendLF = FALSE) x <- readRDS2(getOption("AMR_custom_mo")) - tryCatch({ - suppressWarnings(suppressMessages(add_custom_microorganisms(x))) - packageStartupMessage("OK.") - }, error = function(e) packageStartupMessage("Failed: ", e$message)) + tryCatch( + { + suppressWarnings(suppressMessages(add_custom_microorganisms(x))) + packageStartupMessage("OK.") + }, + error = function(e) packageStartupMessage("Failed: ", e$message) + ) } } diff --git a/data-raw/_pre_commit_hook.R b/data-raw/_pre_commit_hook.R index 8925df92..9e8c6be0 100644 --- a/data-raw/_pre_commit_hook.R +++ b/data-raw/_pre_commit_hook.R @@ -101,46 +101,48 @@ create_species_cons_cops <- function(type = c("CoNS", "CoPS")) { MO_staph <- AMR::microorganisms MO_staph <- MO_staph[which(MO_staph$genus == "Staphylococcus"), , drop = FALSE] if (type == "CoNS") { - MO_staph[which(MO_staph$species %in% c( - "coagulase-negative", "argensis", "arlettae", - "auricularis", "borealis", "caeli", "capitis", "caprae", - "carnosus", "casei", "caseolyticus", "chromogenes", "cohnii", "condimenti", - "croceilyticus", - "debuckii", "devriesei", "edaphicus", "epidermidis", - "equorum", "felis", "fleurettii", "gallinarum", - "haemolyticus", "hominis", "jettensis", "kloosii", - "lentus", "lugdunensis", "massiliensis", "microti", - "muscae", "nepalensis", "pasteuri", "petrasii", - "pettenkoferi", "piscifermentans", "pragensis", "pseudoxylosus", - "pulvereri", "rostri", "saccharolyticus", "saprophyticus", - "sciuri", "simulans", "stepanovicii", "succinus", - "ureilyticus", - "vitulinus", "vitulus", "warneri", "xylosus", - "caledonicus", "canis", - "durrellii", "lloydii", - "ratti", "taiwanensis", "veratri", "urealyticus" - ) | - # old, now renamed to S. schleiferi (but still as synonym in our data of course): - (MO_staph$species == "schleiferi" & MO_staph$subspecies %in% c("schleiferi", ""))), - "mo", - drop = TRUE + MO_staph[ + which(MO_staph$species %in% c( + "coagulase-negative", "argensis", "arlettae", + "auricularis", "borealis", "caeli", "capitis", "caprae", + "carnosus", "casei", "caseolyticus", "chromogenes", "cohnii", "condimenti", + "croceilyticus", + "debuckii", "devriesei", "edaphicus", "epidermidis", + "equorum", "felis", "fleurettii", "gallinarum", + "haemolyticus", "hominis", "jettensis", "kloosii", + "lentus", "lugdunensis", "massiliensis", "microti", + "muscae", "nepalensis", "pasteuri", "petrasii", + "pettenkoferi", "piscifermentans", "pragensis", "pseudoxylosus", + "pulvereri", "rostri", "saccharolyticus", "saprophyticus", + "sciuri", "simulans", "stepanovicii", "succinus", + "ureilyticus", + "vitulinus", "vitulus", "warneri", "xylosus", + "caledonicus", "canis", + "durrellii", "lloydii", + "ratti", "taiwanensis", "veratri", "urealyticus" + ) | + # old, now renamed to S. schleiferi (but still as synonym in our data of course): + (MO_staph$species == "schleiferi" & MO_staph$subspecies %in% c("schleiferi", ""))), + "mo", + drop = TRUE ] } else if (type == "CoPS") { - MO_staph[which(MO_staph$species %in% c( - "coagulase-positive", "coagulans", - "agnetis", "argenteus", - "cornubiensis", - "delphini", "lutrae", - "hyicus", "intermedius", - "pseudintermedius", "pseudointermedius", - "schweitzeri", "simiae", - "roterodami", - "singaporensis" - ) | - # old, now renamed to S. coagulans (but still as synonym in our data of course): - (MO_staph$species == "schleiferi" & MO_staph$subspecies == "coagulans")), - "mo", - drop = TRUE + MO_staph[ + which(MO_staph$species %in% c( + "coagulase-positive", "coagulans", + "agnetis", "argenteus", + "cornubiensis", + "delphini", "lutrae", + "hyicus", "intermedius", + "pseudintermedius", "pseudointermedius", + "schweitzeri", "simiae", + "roterodami", + "singaporensis" + ) | + # old, now renamed to S. coagulans (but still as synonym in our data of course): + (MO_staph$species == "schleiferi" & MO_staph$subspecies == "coagulans")), + "mo", + drop = TRUE ] } } @@ -254,14 +256,15 @@ create_AB_AV_lookup <- function(df) { } new_df$generalised_loinc <- lapply(new_df$loinc, generalise_antibiotic_name) new_df$generalised_all <- unname(lapply( - as.list(as.data.frame(t(new_df[, - c( - colnames(new_df)[colnames(new_df) %in% c("ab", "av", "atc", "cid", "name")], - colnames(new_df)[colnames(new_df) %like% "generalised"] - ), - drop = FALSE - ]), - stringsAsFactors = FALSE + as.list(as.data.frame( + t(new_df[, + c( + colnames(new_df)[colnames(new_df) %in% c("ab", "av", "atc", "cid", "name")], + colnames(new_df)[colnames(new_df) %like% "generalised"] + ), + drop = FALSE + ]), + stringsAsFactors = FALSE )), function(x) { x <- generalise_antibiotic_name(unname(unlist(x))) @@ -472,7 +475,7 @@ suppressMessages(devtools::document(quiet = TRUE)) if (!"styler" %in% rownames(utils::installed.packages())) { message("Package 'styler' not installed!") } else if (interactive()) { - # # only when sourcing this file ourselves + # only when sourcing this file ourselves # usethis::ui_info("Styling package") # styler::style_pkg( # style = styler::tidyverse_style, diff --git a/data-raw/create_survey_page.R b/data-raw/create_survey_page.R index c36f80a8..71f069a5 100644 --- a/data-raw/create_survey_page.R +++ b/data-raw/create_survey_page.R @@ -1,4 +1,3 @@ - license_text <- readLines("docs/LICENSE-text.html") license_text <- paste(license_text, collapse = "|||") license_text <- gsub("licen(s|c)e", "Survey", license_text, ignore.case = TRUE) diff --git a/data-raw/read_EUCAST.R b/data-raw/read_EUCAST.R index f96d1ffd..a52d3153 100644 --- a/data-raw/read_EUCAST.R +++ b/data-raw/read_EUCAST.R @@ -66,33 +66,36 @@ read_EUCAST <- function(sheet, file, guideline_name) { # in the info header in the Excel file, EUCAST mentions which genera are targeted if (sheet %like% "anaerob.*Gram.*posi") { - sheet <- paste0(c( - "Actinomyces", "Bifidobacterium", "Clostridioides", - "Clostridium", "Cutibacterium", "Eggerthella", - "Eubacterium", "Lactobacillus", "Propionibacterium", - "Staphylococcus saccharolyticus" - ), - collapse = "_" + sheet <- paste0( + c( + "Actinomyces", "Bifidobacterium", "Clostridioides", + "Clostridium", "Cutibacterium", "Eggerthella", + "Eubacterium", "Lactobacillus", "Propionibacterium", + "Staphylococcus saccharolyticus" + ), + collapse = "_" ) } else if (sheet %like% "anaerob.*Gram.*nega") { - sheet <- paste0(c( - "Bacteroides", - "Bilophila", - "Fusobacterium", - "Mobiluncus", - "Parabacteroides", - "Porphyromonas", - "Prevotella" - ), - collapse = "_" + sheet <- paste0( + c( + "Bacteroides", + "Bilophila", + "Fusobacterium", + "Mobiluncus", + "Parabacteroides", + "Porphyromonas", + "Prevotella" + ), + collapse = "_" ) } else if (sheet == "Streptococcus A,B,C,G") { - sheet <- paste0(microorganisms %>% - filter(genus == "Streptococcus") %>% - mutate(lancefield = mo_name(mo, Lancefield = TRUE)) %>% - filter(lancefield %like% "^Streptococcus group") %>% - pull(fullname), - collapse = "_" + sheet <- paste0( + microorganisms %>% + filter(genus == "Streptococcus") %>% + mutate(lancefield = mo_name(mo, Lancefield = TRUE)) %>% + filter(lancefield %like% "^Streptococcus group") %>% + pull(fullname), + collapse = "_" ) } else if (sheet %like% "PK.*PD") { sheet <- "UNKNOWN" diff --git a/data-raw/reproduction_of_antibiotics.R b/data-raw/reproduction_of_antibiotics.R index 7a8b980c..90a02b69 100644 --- a/data-raw/reproduction_of_antibiotics.R +++ b/data-raw/reproduction_of_antibiotics.R @@ -142,14 +142,15 @@ abx2 <- bind_rows(abx_atc1, abx_atc2) rm(abx_atc1) rm(abx_atc2) -abx2$ab[is.na(abx2$ab)] <- toupper(abbreviate(gsub( - "[/0-9-]", - " ", - abx2$name[is.na(abx2$ab)] -), -minlength = 3, -method = "left.kept", -strict = TRUE +abx2$ab[is.na(abx2$ab)] <- toupper(abbreviate( + gsub( + "[/0-9-]", + " ", + abx2$name[is.na(abx2$ab)] + ), + minlength = 3, + method = "left.kept", + strict = TRUE )) n_distinct(abx2$ab) @@ -197,24 +198,26 @@ get_CID <- function(ab) { p$tick() CID[i] <- tryCatch( - data.table::fread(paste0( - "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/", - URLencode(ab[i], reserved = TRUE), - "/cids/TXT?name_type=complete" - ), - showProgress = FALSE + data.table::fread( + paste0( + "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/", + URLencode(ab[i], reserved = TRUE), + "/cids/TXT?name_type=complete" + ), + showProgress = FALSE )[[1]][1], error = function(e) NA_integer_ ) if (is.na(CID[i])) { # try with removing the text in brackets CID[i] <- tryCatch( - data.table::fread(paste0( - "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/", - URLencode(trimws(gsub("[(].*[)]", "", ab[i])), reserved = TRUE), - "/cids/TXT?name_type=complete" - ), - showProgress = FALSE + data.table::fread( + paste0( + "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/", + URLencode(trimws(gsub("[(].*[)]", "", ab[i])), reserved = TRUE), + "/cids/TXT?name_type=complete" + ), + showProgress = FALSE )[[1]][1], error = function(e) NA_integer_ ) @@ -223,12 +226,13 @@ get_CID <- function(ab) { # try match on word and take the lowest CID value (sorted) ab[i] <- gsub("[^a-z0-9]+", " ", ab[i], ignore.case = TRUE) CID[i] <- tryCatch( - data.table::fread(paste0( - "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/", - URLencode(ab[i], reserved = TRUE), - "/cids/TXT?name_type=word" - ), - showProgress = FALSE + data.table::fread( + paste0( + "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/", + URLencode(ab[i], reserved = TRUE), + "/cids/TXT?name_type=word" + ), + showProgress = FALSE )[[1]][1], error = function(e) NA_integer_ ) @@ -260,13 +264,14 @@ get_synonyms <- function(CID, clean = TRUE) { } synonyms_txt <- tryCatch( - data.table::fread(paste0( - "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/fastidentity/cid/", - CID[i], - "/synonyms/TXT" - ), - sep = "\n", - showProgress = FALSE + data.table::fread( + paste0( + "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/fastidentity/cid/", + CID[i], + "/synonyms/TXT" + ), + sep = "\n", + showProgress = FALSE )[[1]], error = function(e) NA_character_ ) diff --git a/data-raw/reproduction_of_antivirals.R b/data-raw/reproduction_of_antivirals.R index 49591034..6287870a 100644 --- a/data-raw/reproduction_of_antivirals.R +++ b/data-raw/reproduction_of_antivirals.R @@ -106,31 +106,32 @@ antivirals <- antivirals %>% oral_units, iv_ddd, iv_units - ) %>% + ) %>% AMR:::dataset_UTF8_to_ASCII() av_codes <- tibble(name = antivirals$name %>% - strsplit("(, | and )") %>% - unlist() %>% - unique() %>% - sort()) %>% - mutate(av_1st = toupper(abbreviate(name, minlength = 3, use.classes = FALSE))) %>% + strsplit("(, | and )") %>% + unlist() %>% + unique() %>% + sort()) %>% + mutate(av_1st = toupper(abbreviate(name, minlength = 3, use.classes = FALSE))) %>% filter(!name %in% c("acid", "dipivoxil", "disoproxil", "marboxil", "alafenamide")) replace_with_av_code <- function(name) { unname(av_codes$av_1st[match(name, av_codes$name)]) } -names_codes <- antivirals %>% +names_codes <- antivirals %>% separate(name, - into = paste0("name", c(1:7)), - sep = "(, | and )", - remove = FALSE, - fill = "right") %>% + into = paste0("name", c(1:7)), + sep = "(, | and )", + remove = FALSE, + fill = "right" + ) %>% # remove empty columns - select(!where(function(x) all(is.na(x)))) %>% - mutate_at(vars(matches("name[1-9]")), replace_with_av_code) %>% - unite(av, matches("name[1-9]"), sep = "+", na.rm = TRUE) %>% + select(!where(function(x) all(is.na(x)))) %>% + mutate_at(vars(matches("name[1-9]")), replace_with_av_code) %>% + unite(av, matches("name[1-9]"), sep = "+", na.rm = TRUE) %>% mutate(name = gsub("(, | and )", "/", name)) substr(names_codes$name, 1, 1) <- toupper(substr(names_codes$name, 1, 1)) @@ -143,8 +144,9 @@ antivirals <- antivirals %>% AMR:::dataset_UTF8_to_ASCII() # add loinc, see 'data-raw/loinc.R' loinc_df <- read.csv("data-raw/Loinc.csv", - row.names = NULL, - stringsAsFactors = FALSE) + row.names = NULL, + stringsAsFactors = FALSE +) loinc_df <- loinc_df %>% filter(CLASS == "DRUG/TOX") av_names <- antivirals %>% diff --git a/data-raw/reproduction_of_dosage.R b/data-raw/reproduction_of_dosage.R index 456e05cc..177c3445 100644 --- a/data-raw/reproduction_of_dosage.R +++ b/data-raw/reproduction_of_dosage.R @@ -173,7 +173,7 @@ dosage_new <- bind_rows( as.data.frame(stringsAsFactors = FALSE) rownames(dosage_new) <- NULL -dosage <- bind_rows(dosage_new, AMR::dosage) %>% +dosage <- bind_rows(dosage_new, AMR::dosage) %>% dataset_UTF8_to_ASCII() usethis::use_data(dosage, internal = FALSE, overwrite = TRUE, version = 2) diff --git a/data-raw/reproduction_of_microorganisms.R b/data-raw/reproduction_of_microorganisms.R index 09a55f7f..76592f21 100644 --- a/data-raw/reproduction_of_microorganisms.R +++ b/data-raw/reproduction_of_microorganisms.R @@ -37,10 +37,10 @@ # CSV file (~12,5 MB) as "taxonomy.csv". Their API unfortunately does # not include the full taxonomy and is currently (2022) pretty worthless. # 3. For data about human pathogens, we use Bartlett et al. (2022), -# https://doi.org/10.1099/mic.0.001269. Their latest supplementary material +# https://doi.org/10.1099/mic.0.001269. Their latest supplementary material # can be found here: https://github.com/padpadpadpad/bartlett_et_al_2022_human_pathogens. -#. Download their latest xlsx file in the `data` folder and save it to our -#. `data-raw` folder. +# . Download their latest xlsx file in the `data` folder and save it to our +# . `data-raw` folder. # 4. Set this folder_location to the path where these two files are: folder_location <- "~/Downloads/backbone/" file_gbif <- paste0(folder_location, "Taxon.tsv") @@ -65,7 +65,7 @@ devtools::load_all(".") # load AMR package get_author_year <- function(ref) { # Only keep first author, e.g. transform 'Smith, Jones, 2011' to 'Smith et al., 2011' - + authors2 <- iconv(ref, from = "UTF-8", to = "ASCII//TRANSLIT") authors2 <- gsub(" ?\\(Approved Lists [0-9]+\\) ?", " () ", authors2) authors2 <- gsub(" [)(]+ $", "", authors2) @@ -73,21 +73,21 @@ get_author_year <- function(ref) { authors2 <- trimws(gsub("^[(](.*)[)]$", "\\1", authors2)) # only take part after brackets if there's a name authors2 <- ifelse(grepl(".*[)] [a-zA-Z]+.*", authors2), - gsub(".*[)] (.*)", "\\1", authors2), - authors2 + gsub(".*[)] (.*)", "\\1", authors2), + authors2 ) # replace parentheses with emend. to get the latest authors authors2 <- gsub("(", " emend. ", authors2, fixed = TRUE) authors2 <- gsub(")", "", authors2, fixed = TRUE) authors2 <- gsub(" +", " ", authors2) authors2 <- trimws(authors2) - + # get year from last 4 digits lastyear <- as.integer(gsub(".*([0-9]{4})$", "\\1", authors2)) # can never be later than now lastyear <- ifelse(lastyear > as.integer(format(Sys.Date(), "%Y")), - NA, - lastyear + NA, + lastyear ) # get authors without last year authors <- gsub("(.*)[0-9]{4}$", "\\1", authors2) @@ -119,8 +119,8 @@ get_author_year <- function(ref) { authors[nchar(authors) <= 3] <- "" # combine author and year if year is available ref <- ifelse(!is.na(lastyear), - paste0(authors, ", ", lastyear), - authors + paste0(authors, ", ", lastyear), + authors ) # fix beginning and ending ref <- gsub(", $", "", ref) @@ -128,7 +128,7 @@ get_author_year <- function(ref) { ref <- gsub("^(emend|et al.,?)", "", ref) ref <- trimws(ref) ref <- gsub("'", "", ref) - + # a lot start with a lowercase character - fix that ref[!grepl("^d[A-Z]", ref)] <- gsub("^([a-z])", "\\U\\1", ref[!grepl("^d[A-Z]", ref)], perl = TRUE) # specific one for the French that are named dOrbigny @@ -222,9 +222,9 @@ include_fungal_orders <- c( # get latest taxonomic names of these fungal orders include_fungal_orders_ids <- taxonomy_gbif.bak %>% filter(order %in% include_fungal_orders) -include_fungal_orders <- taxonomy_gbif.bak %>% - filter(taxonID %in% c(include_fungal_orders_ids$taxonID, include_fungal_orders_ids$acceptedNameUsageID)) %>% - distinct(order) %>% +include_fungal_orders <- taxonomy_gbif.bak %>% + filter(taxonID %in% c(include_fungal_orders_ids$taxonID, include_fungal_orders_ids$acceptedNameUsageID)) %>% + distinct(order) %>% pull(order) # check some columns to validate below filters @@ -361,7 +361,7 @@ for (page in LETTERS) { names <- names[ranks != "species"] ranks <- ranks[ranks != "species"] ranks[ranks == "domain"] <- "kingdom" - + df <- names %>% tibble() %>% t() %>% @@ -369,7 +369,7 @@ for (page in LETTERS) { setNames(ranks) %>% # no candidates please filter(genus %unlike% "^(Candidatus|\\[)") - + taxonomy_lpsn_missing <- taxonomy_lpsn_missing %>% bind_rows(df) } @@ -491,14 +491,14 @@ saveRDS(taxonomy_lpsn, "data-raw/taxonomy_lpsn.rds", version = 2) taxonomy_gbif <- taxonomy_gbif %>% # clean NAs and add fullname mutate(across(kingdom:subspecies, function(x) ifelse(is.na(x), "", x)), - fullname = trimws(case_when( - rank == "family" ~ family, - rank == "order" ~ order, - rank == "class" ~ class, - rank == "phylum" ~ phylum, - rank == "kingdom" ~ kingdom, - TRUE ~ paste(genus, species, subspecies) - )), .before = 1 + fullname = trimws(case_when( + rank == "family" ~ family, + rank == "order" ~ order, + rank == "class" ~ class, + rank == "phylum" ~ phylum, + rank == "kingdom" ~ kingdom, + TRUE ~ paste(genus, species, subspecies) + )), .before = 1 ) %>% # keep only one GBIF taxon ID per full name arrange(fullname, gbif) %>% @@ -507,14 +507,14 @@ taxonomy_gbif <- taxonomy_gbif %>% taxonomy_lpsn <- taxonomy_lpsn %>% # clean NAs and add fullname mutate(across(kingdom:subspecies, function(x) ifelse(is.na(x), "", x)), - fullname = trimws(case_when( - rank == "family" ~ family, - rank == "order" ~ order, - rank == "class" ~ class, - rank == "phylum" ~ phylum, - rank == "kingdom" ~ kingdom, - TRUE ~ paste(genus, species, subspecies) - )), .before = 1 + fullname = trimws(case_when( + rank == "family" ~ family, + rank == "order" ~ order, + rank == "class" ~ class, + rank == "phylum" ~ phylum, + rank == "kingdom" ~ kingdom, + TRUE ~ paste(genus, species, subspecies) + )), .before = 1 ) %>% # keep only one LPSN record ID per full name arrange(fullname, lpsn) %>% @@ -536,23 +536,25 @@ taxonomy_lpsn$lpsn_parent[taxonomy_lpsn$rank == "subspecies"] <- taxonomy_lpsn$l taxonomy <- taxonomy_lpsn %>% # join GBIF identifiers to them left_join(taxonomy_gbif %>% select(kingdom, fullname, starts_with("gbif")), - by = c("kingdom", "fullname") + by = c("kingdom", "fullname") ) # for everything else, add the GBIF data taxonomy <- taxonomy %>% bind_rows(taxonomy_gbif %>% - filter(!paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname))) %>% + filter(!paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname))) %>% arrange(fullname) %>% filter(fullname != "") # get missing entries from existing microorganisms data set taxonomy <- taxonomy %>% bind_rows(AMR::microorganisms %>% - select(all_of(colnames(taxonomy))) %>% - filter(!paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname), - # these will be added later: - source != "manually added")) %>% + select(all_of(colnames(taxonomy))) %>% + filter( + !paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname), + # these will be added later: + source != "manually added" + )) %>% arrange(fullname) %>% filter(fullname != "") @@ -602,9 +604,10 @@ taxonomy <- taxonomy %>% source = "manually added" ) %>% filter(!paste(kingdom, rank) %in% paste(taxonomy$kingdom, taxonomy$rank)) %>% - left_join(current_gbif %>% - select(kingdom, rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID), - by = c("kingdom", "rank") + left_join( + current_gbif %>% + select(kingdom, rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID), + by = c("kingdom", "rank") ) %>% mutate(source = ifelse(!is.na(gbif), "GBIF", source)) ) @@ -625,17 +628,18 @@ for (i in 2:6) { source = "manually added" ) %>% filter(!paste(kingdom, .[[ncol(.) - 4]], rank) %in% paste(taxonomy$kingdom, taxonomy[[i + 1]], taxonomy$rank)) %>% - # get GBIF identifier where available - left_join(current_gbif %>% - select(kingdom, all_of(i_name), rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID), - by = c("kingdom", "rank", i_name) - ) %>% - mutate(source = ifelse(!is.na(gbif), "GBIF", source)) + # get GBIF identifier where available + left_join( + current_gbif %>% + select(kingdom, all_of(i_name), rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID), + by = c("kingdom", "rank", i_name) + ) %>% + mutate(source = ifelse(!is.na(gbif), "GBIF", source)) message("n = ", nrow(to_add)) if (is.null(taxonomy_all_missing)) { taxonomy_all_missing <- to_add } else { - taxonomy_all_missing <- taxonomy_all_missing %>% + taxonomy_all_missing <- taxonomy_all_missing %>% bind_rows(to_add) } } @@ -645,20 +649,24 @@ taxonomy <- taxonomy %>% bind_rows(taxonomy_all_missing) # fix for duplicate fullnames within a kingdom (such as Nitrospira which is the name of the genus AND its class) -taxonomy <- taxonomy %>% - mutate(rank_index = case_when(rank == "subspecies" ~ 1, - rank == "species" ~ 2, - rank == "genus" ~ 3, - rank == "family" ~ 4, - rank == "order" ~ 5, - rank == "class" ~ 6, - TRUE ~ 7), - fullname_rank = paste0(fullname, " {", rank, "}")) %>% - arrange(kingdom, fullname, rank_index) %>% - group_by(kingdom, fullname) %>% - mutate(fullname = if_else(row_number() > 1, fullname_rank, fullname)) %>% - ungroup() %>% - select(-fullname_rank, -rank_index) %>% +taxonomy <- taxonomy %>% + mutate( + rank_index = case_when( + rank == "subspecies" ~ 1, + rank == "species" ~ 2, + rank == "genus" ~ 3, + rank == "family" ~ 4, + rank == "order" ~ 5, + rank == "class" ~ 6, + TRUE ~ 7 + ), + fullname_rank = paste0(fullname, " {", rank, "}") + ) %>% + arrange(kingdom, fullname, rank_index) %>% + group_by(kingdom, fullname) %>% + mutate(fullname = if_else(row_number() > 1, fullname_rank, fullname)) %>% + ungroup() %>% + select(-fullname_rank, -rank_index) %>% arrange(fullname) # now also add missing species (requires combination with genus) @@ -676,12 +684,13 @@ taxonomy <- taxonomy %>% ) %>% filter(!paste(kingdom, genus, species, rank) %in% paste(taxonomy$kingdom, taxonomy$genus, taxonomy$species, taxonomy$rank)) %>% # get GBIF identifier where available - left_join(current_gbif %>% - select(kingdom, genus, species = specificEpithet, rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID), - by = c("kingdom", "rank", "genus", "species") + left_join( + current_gbif %>% + select(kingdom, genus, species = specificEpithet, rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID), + by = c("kingdom", "rank", "genus", "species") ) %>% mutate(source = ifelse(!is.na(gbif), "GBIF", source)) - ) + ) # remove NAs from taxonomy again, and keep unique full names @@ -702,7 +711,7 @@ manually_added <- AMR::microorganisms %>% filter(source == "manually added", !paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname)) %>% select(fullname:subspecies, ref, source, rank) -manually_added <- manually_added %>% +manually_added <- manually_added %>% bind_rows(salmonellae) # get latest taxonomy for those entries @@ -805,76 +814,83 @@ taxonomy <- taxonomy %>% pathogens <- read_excel(file_bartlett, sheet = "Tab 6 Full List") # get all established, both old and current taxonomic names -established <- pathogens %>% - filter(status == "established") %>% +established <- pathogens %>% + filter(status == "established") %>% mutate(fullname = paste(genus, species)) %>% - pull(fullname) %>% - c(unlist(mo_current(.)), - unlist(mo_synonyms(., keep_synonyms = FALSE))) %>% - strsplit(" ", fixed = TRUE) %>% - sapply(function(x) ifelse(length(x) == 1, x, paste(x[1], x[2]))) %>% - sort() %>% + pull(fullname) %>% + c( + unlist(mo_current(.)), + unlist(mo_synonyms(., keep_synonyms = FALSE)) + ) %>% + strsplit(" ", fixed = TRUE) %>% + sapply(function(x) ifelse(length(x) == 1, x, paste(x[1], x[2]))) %>% + sort() %>% unique() # get all putative, both old and current taxonomic names -putative <- pathogens %>% - filter(status == "putative") %>% +putative <- pathogens %>% + filter(status == "putative") %>% mutate(fullname = paste(genus, species)) %>% - pull(fullname) %>% - c(unlist(mo_current(.)), - unlist(mo_synonyms(., keep_synonyms = FALSE))) %>% - strsplit(" ", fixed = TRUE) %>% - sapply(function(x) ifelse(length(x) == 1, x, paste(x[1], x[2]))) %>% - sort() %>% + pull(fullname) %>% + c( + unlist(mo_current(.)), + unlist(mo_synonyms(., keep_synonyms = FALSE)) + ) %>% + strsplit(" ", fixed = TRUE) %>% + sapply(function(x) ifelse(length(x) == 1, x, paste(x[1], x[2]))) %>% + sort() %>% unique() established <- established[established %unlike% "unknown"] putative <- putative[putative %unlike% "unknown"] -established_genera <- established %>% - strsplit(" ", fixed = TRUE) %>% - sapply(function(x) x[1]) %>% - sort() %>% +established_genera <- established %>% + strsplit(" ", fixed = TRUE) %>% + sapply(function(x) x[1]) %>% + sort() %>% unique() -putative_genera <- putative %>% - strsplit(" ", fixed = TRUE) %>% - sapply(function(x) x[1]) %>% - sort() %>% +putative_genera <- putative %>% + strsplit(" ", fixed = TRUE) %>% + sapply(function(x) x[1]) %>% + sort() %>% unique() -nonbacterial_genera <- AMR:::MO_PREVALENT_GENERA %>% - c(unlist(mo_current(.)), - unlist(mo_synonyms(., keep_synonyms = FALSE))) %>% - strsplit(" ", fixed = TRUE) %>% - sapply(function(x) x[1]) %>% - sort() %>% +nonbacterial_genera <- AMR:::MO_PREVALENT_GENERA %>% + c( + unlist(mo_current(.)), + unlist(mo_synonyms(., keep_synonyms = FALSE)) + ) %>% + strsplit(" ", fixed = TRUE) %>% + sapply(function(x) x[1]) %>% + sort() %>% unique() nonbacterial_genera <- nonbacterial_genera[nonbacterial_genera %unlike% "unknown"] # update prevalence based on taxonomy (following the recent and thorough work of Bartlett et al., 2022) # see https://doi.org/10.1099/mic.0.001269 -taxonomy <- taxonomy %>% +taxonomy <- taxonomy %>% mutate(prevalence = case_when( # 'established' means 'have infected at least three persons in three or more references' paste(genus, species) %in% established & rank %in% c("species", "subspecies") ~ 1.0, # other genera in the 'established' group genus %in% established_genera & rank == "genus" ~ 1.0, - + # 'putative' means 'fewer than three known cases' paste(genus, species) %in% putative & rank %in% c("species", "subspecies") ~ 1.25, # other genera in the 'putative' group genus %in% putative_genera & rank == "genus" ~ 1.25, - + # species and subspecies in 'established' and 'putative' groups genus %in% c(established_genera, putative_genera) & rank %in% c("species", "subspecies") ~ 1.5, # other species from a genus in either group genus %in% nonbacterial_genera & rank %in% c("genus", "species", "subspecies") ~ 1.5, # we keep track of prevalent genera too of non-bacterial species genus %in% AMR:::MO_PREVALENT_GENERA & kingdom != "Bacteria" & rank %in% c("genus", "species", "subspecies") ~ 1.5, - + # all others - TRUE ~ 2.0)) + TRUE ~ 2.0 + )) table(taxonomy$prevalence, useNA = "always") # (a lot will be removed further below) @@ -909,13 +925,14 @@ mo_kingdom <- taxonomy %>% mo_phylum <- taxonomy %>% filter(rank == "phylum") %>% distinct(kingdom, phylum) %>% - left_join(AMR::microorganisms %>% - filter(rank == "phylum") %>% - transmute(kingdom, - phylum = fullname, - mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo)) - ), - by = c("kingdom", "phylum") + left_join( + AMR::microorganisms %>% + filter(rank == "phylum") %>% + transmute(kingdom, + phylum = fullname, + mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo)) + ), + by = c("kingdom", "phylum") ) %>% group_by(kingdom) %>% mutate( @@ -935,13 +952,14 @@ mo_phylum <- mo_phylum %>% mo_class <- taxonomy %>% filter(rank == "class") %>% distinct(kingdom, class) %>% - left_join(AMR::microorganisms %>% - filter(rank == "class") %>% - transmute(kingdom, - class = fullname, - mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo)) - ), - by = c("kingdom", "class") + left_join( + AMR::microorganisms %>% + filter(rank == "class") %>% + transmute(kingdom, + class = fullname, + mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo)) + ), + by = c("kingdom", "class") ) %>% group_by(kingdom) %>% mutate( @@ -961,13 +979,14 @@ mo_class <- mo_class %>% mo_order <- taxonomy %>% filter(rank == "order") %>% distinct(kingdom, order) %>% - left_join(AMR::microorganisms %>% - filter(rank == "order") %>% - transmute(kingdom, - order = fullname, - mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo)) - ), - by = c("kingdom", "order") + left_join( + AMR::microorganisms %>% + filter(rank == "order") %>% + transmute(kingdom, + order = fullname, + mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo)) + ), + by = c("kingdom", "order") ) %>% group_by(kingdom) %>% mutate( @@ -987,13 +1006,14 @@ mo_order <- mo_order %>% mo_family <- taxonomy %>% filter(rank == "family") %>% distinct(kingdom, family) %>% - left_join(AMR::microorganisms %>% - filter(rank == "family") %>% - transmute(kingdom, - family = fullname, - mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo)) - ), - by = c("kingdom", "family") + left_join( + AMR::microorganisms %>% + filter(rank == "family") %>% + transmute(kingdom, + family = fullname, + mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo)) + ), + by = c("kingdom", "family") ) %>% group_by(kingdom) %>% mutate( @@ -1014,11 +1034,12 @@ mo_genus <- taxonomy %>% filter(rank == "genus") %>% distinct(kingdom, genus) %>% # get available old MO codes - left_join(AMR::microorganisms %>% - filter(rank == "genus") %>% - transmute(mo_genus_old = gsub("^[A-Z]+_", "", as.character(mo)), kingdom, genus) %>% - distinct(kingdom, genus, .keep_all = TRUE), - by = c("kingdom", "genus") + left_join( + AMR::microorganisms %>% + filter(rank == "genus") %>% + transmute(mo_genus_old = gsub("^[A-Z]+_", "", as.character(mo)), kingdom, genus) %>% + distinct(kingdom, genus, .keep_all = TRUE), + by = c("kingdom", "genus") ) %>% distinct(kingdom, genus, .keep_all = TRUE) %>% # since kingdom is part of the code, genus abbreviations may be duplicated between kingdoms @@ -1060,12 +1081,13 @@ mo_genus <- mo_genus %>% mo_species <- taxonomy %>% filter(rank == "species") %>% distinct(kingdom, genus, species) %>% - left_join(AMR::microorganisms %>% - filter(rank == "species") %>% - transmute(mo_species_old = gsub("^[A-Z]+_[A-Z]+_", "", as.character(mo)), kingdom, genus, species) %>% - filter(mo_species_old %unlike% "-") %>% - distinct(kingdom, genus, species, .keep_all = TRUE), - by = c("kingdom", "genus", "species") + left_join( + AMR::microorganisms %>% + filter(rank == "species") %>% + transmute(mo_species_old = gsub("^[A-Z]+_[A-Z]+_", "", as.character(mo)), kingdom, genus, species) %>% + filter(mo_species_old %unlike% "-") %>% + distinct(kingdom, genus, species, .keep_all = TRUE), + by = c("kingdom", "genus", "species") ) %>% distinct(kingdom, genus, species, .keep_all = TRUE) %>% group_by(kingdom, genus) %>% @@ -1108,12 +1130,13 @@ mo_species <- mo_species %>% mo_subspecies <- taxonomy %>% filter(rank == "subspecies") %>% distinct(kingdom, genus, species, subspecies) %>% - left_join(AMR::microorganisms %>% - filter(rank %in% c("subspecies", "subsp.", "infraspecies")) %>% - transmute(mo_subspecies_old = gsub("^[A-Z]+_[A-Z]+_[A-Z]+_", "", as.character(mo)), kingdom, genus, species, subspecies) %>% - filter(mo_subspecies_old %unlike% "-") %>% - distinct(kingdom, genus, species, subspecies, .keep_all = TRUE), - by = c("kingdom", "genus", "species", "subspecies") + left_join( + AMR::microorganisms %>% + filter(rank %in% c("subspecies", "subsp.", "infraspecies")) %>% + transmute(mo_subspecies_old = gsub("^[A-Z]+_[A-Z]+_[A-Z]+_", "", as.character(mo)), kingdom, genus, species, subspecies) %>% + filter(mo_subspecies_old %unlike% "-") %>% + distinct(kingdom, genus, species, subspecies, .keep_all = TRUE), + by = c("kingdom", "genus", "species", "subspecies") ) %>% distinct(kingdom, genus, species, subspecies, .keep_all = TRUE) %>% group_by(kingdom, genus, species) %>% @@ -1187,20 +1210,26 @@ taxonomy <- taxonomy %>% arrange(fullname) # now check these - e.g. Nitrospira is the name of a genus AND its class -taxonomy %>% filter(fullname %in% .[duplicated(fullname), "fullname", drop = TRUE]) %>% View() +taxonomy %>% + filter(fullname %in% .[duplicated(fullname), "fullname", drop = TRUE]) %>% + View() taxonomy <- taxonomy %>% - mutate(rank_index = case_when(kingdom == "Bacteria" ~ 1, - kingdom == "Fungi" ~ 2, - kingdom == "Protozoa" ~ 3, - kingdom == "Archaea" ~ 4, - TRUE ~ 5)) %>% - arrange(fullname, rank_index) %>% - distinct(fullname, .keep_all = TRUE) %>% - select(-rank_index) %>% + mutate(rank_index = case_when( + kingdom == "Bacteria" ~ 1, + kingdom == "Fungi" ~ 2, + kingdom == "Protozoa" ~ 3, + kingdom == "Archaea" ~ 4, + TRUE ~ 5 + )) %>% + arrange(fullname, rank_index) %>% + distinct(fullname, .keep_all = TRUE) %>% + select(-rank_index) %>% filter(mo != "") # this must not exist: -taxonomy %>% filter(mo %like% "__") %>% View() +taxonomy %>% + filter(mo %like% "__") %>% + View() taxonomy <- taxonomy %>% filter(mo %unlike% "__") @@ -1214,14 +1243,20 @@ taxonomy <- taxonomy %>% distinct(mo, .keep_all = TRUE) taxonomy %>% filter(fullname %in% .[duplicated(fullname), "fullname", drop = TRUE]) # are all GBIFs available? -taxonomy %>% filter(!gbif_parent %in% gbif) %>% count(rank) +taxonomy %>% + filter(!gbif_parent %in% gbif) %>% + count(rank) # try to find the right gbif IDs taxonomy$gbif_parent[which(!taxonomy$gbif_parent %in% taxonomy$gbif & taxonomy$rank == "species")] <- taxonomy$gbif[match(taxonomy$genus[which(!taxonomy$gbif_parent %in% taxonomy$gbif & taxonomy$rank == "species")], taxonomy$genus)] taxonomy$gbif_parent[which(!taxonomy$gbif_parent %in% taxonomy$gbif & taxonomy$rank == "class")] <- taxonomy$gbif[match(taxonomy$phylum[which(!taxonomy$gbif_parent %in% taxonomy$gbif & taxonomy$rank == "class")], taxonomy$phylum)] -taxonomy %>% filter(!gbif_parent %in% gbif) %>% count(rank) +taxonomy %>% + filter(!gbif_parent %in% gbif) %>% + count(rank) # are all LPSNs available? -taxonomy %>% filter(!lpsn_parent %in% lpsn) %>% count(rank) +taxonomy %>% + filter(!lpsn_parent %in% lpsn) %>% + count(rank) # make GBIF refer to newest renaming according to LPSN taxonomy$gbif_renamed_to[which(!is.na(taxonomy$gbif_renamed_to) & !is.na(taxonomy$lpsn_renamed_to))] <- taxonomy$gbif[match(taxonomy$lpsn_renamed_to[which(!is.na(taxonomy$gbif_renamed_to) & !is.na(taxonomy$lpsn_renamed_to))], taxonomy$lpsn)] @@ -1251,21 +1286,33 @@ taxonomy <- taxonomy %>% # no ghost families, orders classes, phyla taxonomy <- taxonomy %>% - group_by(kingdom, family) %>% filter(n() > 1 | fullname %like% "unknown" | rank == "kingdom") %>% - group_by(kingdom, order) %>% filter(n() > 1 | fullname %like% "unknown" | rank == "kingdom") %>% - group_by(kingdom, class) %>% filter(n() > 1 | fullname %like% "unknown" | rank == "kingdom") %>% - group_by(kingdom, phylum) %>% filter(n() > 1 | fullname %like% "unknown" | rank == "kingdom") %>% + group_by(kingdom, family) %>% + filter(n() > 1 | fullname %like% "unknown" | rank == "kingdom") %>% + group_by(kingdom, order) %>% + filter(n() > 1 | fullname %like% "unknown" | rank == "kingdom") %>% + group_by(kingdom, class) %>% + filter(n() > 1 | fullname %like% "unknown" | rank == "kingdom") %>% + group_by(kingdom, phylum) %>% + filter(n() > 1 | fullname %like% "unknown" | rank == "kingdom") %>% ungroup() -message("\nCongratulations! The new taxonomic table will contain ", format(nrow(taxonomy), big.mark = ","), " rows.\n", - "This was ", format(nrow(AMR::microorganisms), big.mark = ","), " rows.\n") +message( + "\nCongratulations! The new taxonomic table will contain ", format(nrow(taxonomy), big.mark = ","), " rows.\n", + "This was ", format(nrow(AMR::microorganisms), big.mark = ","), " rows.\n" +) # these are the new ones: -taxonomy %>% filter(!paste(kingdom, fullname) %in% paste(AMR::microorganisms$kingdom, AMR::microorganisms$fullname)) %>% View() +taxonomy %>% + filter(!paste(kingdom, fullname) %in% paste(AMR::microorganisms$kingdom, AMR::microorganisms$fullname)) %>% + View() # these were removed: -AMR::microorganisms %>% filter(!paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname)) %>% View() -AMR::microorganisms %>% filter(!fullname %in% taxonomy$fullname) %>% View() +AMR::microorganisms %>% + filter(!paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname)) %>% + View() +AMR::microorganisms %>% + filter(!fullname %in% taxonomy$fullname) %>% + View() # Add SNOMED CT ----------------------------------------------------------- diff --git a/data-raw/salmonellae.R b/data-raw/salmonellae.R index 195fce89..2e9623d8 100644 --- a/data-raw/salmonellae.R +++ b/data-raw/salmonellae.R @@ -35,1522 +35,1524 @@ # WHO Collaborating Centre for Reference and Research on Salmonella # https://www.researchgate.net/publication/283428414 -serovars <- c("Aachen", - "Aarhus", - "Aba", - "Abadina", - "Abaetetuba", - "Aberdeen", - "Abidjan", - "Ablogame", - "Abobo", - "Abony", - "Abortusequi", - "Abortusovis", - "Abuja", - "Accra", - "Ackwepe", - "Adabraka", - "Adamstown", - "Adamstua", - "Adana", - "Adelaide", - "Adeoyo", - "Aderike", - "Adime", - "Adjame", - "Aequatoria", - "Aesch", - "Aflao", - "Africana", - "Afula", - "Agama", - "Agbara", - "Agbeni", - "Agege", - "Ago", - "Agodi", - "Agona", - "Agoueve", - "Ahanou", - "Ahepe", - "Ahmadi", - "Ahoutoue", - "Ahuza", - "Ajiobo", - "Akanji", - "Akuafo", - "Alabama", - "Alachua", - "Alagbon", - "Alamo", - "Albany", - "Albert", - "Albertbanjul", - "Albertslund", - "Albuquerque", - "Alexanderplatz", - "Alexanderpolder", - "Alfort", - "Alger", - "Alkmaar", - "Allandale", - "Allerton", - "Alma", - "Alminko", - "Alpenquai", - "Altendorf", - "Amager", - "Amberg", - "Amersfoort", - "Amherstiana", - "Amina", - "Aminatu", - "Amounderness", - "Amoutive", - "Amsterdam", - "Amunigun", - "Anderlecht", - "Anecho", - "Anfo", - "Angers", - "Angoda", - "Angouleme", - "Ank", - "Anna", - "Annedal", - "Antarctica", - "Antonio", - "Antsalova", - "Antwerpen", - "Apapa", - "Apeyeme", - "Aprad", - "Aqua", - "Aragua", - "Arapahoe", - "Arechavaleta", - "Argenteuil", - "Arusha", - "Aschersleben", - "Ashanti", - "Assen", - "Assinie", - "Astridplein", - "Asylanta", - "Atakpame", - "Atento", - "Athens", - "Athinai", - "Ati", - "Augustenborg", - "Aurelianis", - "Austin", - "Australia", - "Avignon", - "Avonmouth", - "Axim", - "Ayinde", - "Ayton", - "Azteca", - "Babelsberg", - "Babili", - "Badagry", - "Baguida", - "Baguirmi", - "Bahati", - "Bahrenfeld", - "Baiboukoum", - "Baildon", - "Bakau", - "Balcones", - "Ball", - "Bama", - "Bamboye", - "Bambylor", - "Banalia", - "Banana", - "Banco", - "Bandia", - "Bandim", - "Bangkok", - "Bangui", - "Banjul", - "Bardo", - "Bareilly", - "Bargny", - "Barmbek", - "Barranquilla", - "Barry", - "Basingstoke", - "Bassa", - "Bassadji", - "Bata", - "Batonrouge", - "Battle", - "Bazenheid", - "Be", - "Beaudesert", - "Bedford", - "Belem", - "Belfast", - "Bellevue", - "Benfica", - "Benguella", - "Benin", - "Benue", - "Bere", - "Bergedorf", - "Bergen", - "Bergues", - "Berkeley", - "Berlin", - "Berta", - "Bessi", - "Bethune", - "Biafra", - "Bida", - "Bietri", - "Bignona", - "Bijlmer", - "Bilu", - "Binche", - "Bingerville", - "Binningen", - "Birkenhead", - "Birmingham", - "Bispebjerg", - "Bissau", - "Blancmesnil", - "Blegdam", - "Blijdorp", - "Blitta", - "Blockley", - "Bloomsbury", - "Blukwa", - "Bobo", - "Bochum", - "Bodjonegoro", - "Boecker", - "Bofflens", - "Bokanjac", - "Bolama", - "Bolombo", - "Bolton", - "Bonames", - "Bonariensis", - "Bonn", - "Bootle", - "Borbeck", - "Bordeaux", - "Borreze", - "Borromea", - "Bouake", - "Bournemouth", - "Bousso", - "Bovismorbificans", - "Brackenridge", - "Bracknell", - "Bradford", - "Braenderup", - "Brancaster", - "Brandenburg", - "Brazil", - "Brazos", - "Brazzaville", - "Breda", - "Bredeney", - "Brefet", - "Breukelen", - "Brevik", - "Brezany", - "Brijbhumi", - "Brikama", - "Brindisi", - "Brisbane", - "Bristol", - "Brive", - "Broc", - "Bron", - "Bronx", - "Brooklyn", - "Broughton", - "Bruck", - "Bruebach", - "Brunei", - "Brunflo", - "Bsilla", - "Buckeye", - "Budapest", - "Bukavu", - "Bukuru", - "Bulgaria", - "Bullbay", - "Bulovka", - "Burgas", - "Burundi", - "Bury", - "Butantan", - "Butare", - "Buzu", - "Caen", - "Cairina", - "Cairns", - "Calabar", - "California", - "Camberene", - "Camberwell", - "Campinense", - "Canada", - "Canary", - "Cannobio", - "Cannonhill", - "Cannstatt", - "Canton", - "Caracas", - "Cardoner", - "Carmel", - "Carnac", - "Carno", - "Carpentras", - "Carrau", - "Carswell", - "Casablanca", - "Casamance", - "Catalunia", - "Catanzaro", - "Catumagos", - "Cayar", - "Cerro", - "Ceyco", - "Chagoua", - "Chailey", - "Champaign", - "Chandans", - "Charity", - "Charlottenburg", - "Chartres", - "Cheltenham", - "Chennai", - "Chester", - "Chicago", - "Chichester", - "Chichiri", - "Chile", - "Chincol", - "Chingola", - "Chiredzi", - "Chittagong", - "Choleraesuis", - "Chomedey", - "Christiansborg", - "Clackamas", - "Claibornei", - "Clanvillian", - "Clerkenwell", - "Cleveland", - "Clontarf", - "Cochin", - "Cochise", - "Cocody", - "Coeln", - "Coleypark", - "Colindale", - "Colobane", - "Colombo", - "Colorado", - "Concord", - "Connecticut", - "Coogee", - "Coquilhatville", - "Coromandel", - "Corvallis", - "Cotham", - "Cotia", - "Cotonou", - "Cremieu", - "Crewe", - "Croft", - "Crossness", - "Cubana", - "Cuckmere", - "Cullingworth", - "Cumberland", - "Curacao", - "Cyprus", - "Czernyring", - "Daarle", - "Dabou", - "Dadzie", - "Dahlem", - "Dahomey", - "Dahra", - "Dakar", - "Dakota", - "Dallgow", - "Damman", - "Dan", - "Dapango", - "Daula", - "Daytona", - "Deckstein", - "Delan", - "Delmenhorst", - "Dembe", - "Demerara", - "Denver", - "Derby", - "Derkle", - "Dessau", - "Detmold", - "Deversoir", - "Dibra", - "Dietrichsdorf", - "Dieuppeul", - "Diguel", - "Dingiri", - "Diogoye", - "Diourbel", - "Djakarta", - "Djama", - "Djelfa", - "Djermaia", - "Djibouti", - "Djinten", - "Djugu", - "Doba", - "Doel", - "Doncaster", - "Donna", - "Doorn", - "Dortmund", - "Douala", - "Dougi", - "Doulassame", - "Drac", - "Dresden", - "Driffield", - "Dublin", - "Duesseldorf", - "Dugbe", - "Duisburg", - "Dumfries", - "Dunkwa", - "Durban", - "Durham", - "Duval", - "Ealing", - "Eastbourne", - "Eastglam", - "Eaubonne", - "Eberswalde", - "Eboko", - "Ebrie", - "Echa", - "Ede", - "Edinburg", - "Edmonton", - "Egusi", - "Egusitoo", - "Eingedi", - "Eko", - "Ekotedo", - "Ekpoui", - "Elbeuf", - "Elisabethville", - "Elokate", - "Elomrane", - "Emek", - "Emmastad", - "Encino", - "Enschede", - "Entebbe", - "Enteritidis", - "Enugu", - "Epalinges", - "Epicrates", - "Epinay", - "Eppendorf", - "Erfurt", - "Escanaba", - "Eschberg", - "Eschweiler", - "Essen", - "Essingen", - "Etterbeek", - "Euston", - "Everleigh", - "Evry", - "Ezra", - "Fairfield", - "Fajara", - "Faji", - "Falkensee", - "Fallowfield", - "Fann", - "Fanti", - "Farakan", - "Farcha", - "Fareham", - "Farmingdale", - "Farmsen", - "Farsta", - "Fass", - "Fayed", - "Fehrbellin", - "Ferlo", - "Ferruch", - "Fillmore", - "Finaghy", - "Findorff", - "Finkenwerder", - "Fischerhuette", - "Fischerkietz", - "Fischerstrasse", - "Fitzroy", - "Florian", - "Florida", - "Flottbek", - "Fluntern", - "Fomeco", - "Fortlamy", - "Fortune", - "Franken", - "Frankfurt", - "Frederiksberg", - "Freefalls", - "Freetown", - "Freiburg", - "Fresno", - "Friedenau", - "Friedrichsfelde", - "Frintrop", - "Fufu", - "Fulda", - "Fulica", - "Fyris", - "Gabon", - "Gafsa", - "Gaillac", - "Galiema", - "Galil", - "Gallen", - "Gallinarum", - "Gamaba", - "Gambaga", - "Gambia", - "Gaminara", - "Garba", - "Garoli", - "Gassi", - "Gateshead", - "Gatineau", - "Gatow", - "Gatuni", - "Gbadago", - "Gdansk", - "Gege", - "Georgia", - "Gera", - "Geraldton", - "Gerland", - "Ghana", - "Giessen", - "Give", - "Giza", - "Glasgow", - "Glidji", - "Glostrup", - "Gloucester", - "Gnesta", - "Godesberg", - "Goelzau", - "Goeteborg", - "Goettingen", - "Gokul", - "Goldcoast", - "Goma", - "Gombe", - "Good", - "Gori", - "Goulfey", - "Gouloumbo", - "Goverdhan", - "Gozo", - "Grampian", - "Grancanaria", - "Grandhaven", - "Granlo", - "Graz", - "Greiz", - "Groenekan", - "Grumpensis", - "Guarapiranga", - "Guerin", - "Gueuletapee", - "Guildford", - "Guinea", - "Gustavia", - "Gwale", - "Gwoza", - "Haardt", - "Hadar", - "Hadejia", - "Haduna", - "Haelsingborg", - "Haferbreite", - "Haga", - "Haifa", - "Halle", - "Hallfold", - "Handen", - "Hann", - "Hannover", - "Haouaria", - "Harburg", - "Harcourt", - "Harleystreet", - "Hartford", - "Harvestehude", - "Hatfield", - "Hato", - "Havana", - "Hayindogo", - "Heerlen", - "Hegau", - "Heidelberg", - "Heistopdenberg", - "Hemingford", - "Hennekamp", - "Hermannswerder", - "Heron", - "Herston", - "Herzliya", - "Hessarek", - "Hidalgo", - "Hiduddify", - "Hillegersberg", - "Hillingdon", - "Hillsborough", - "Hilversum", - "Hindmarsh", - "Hisingen", - "Hissar", - "Hithergreen", - "Hoboken", - "Hofit", - "Hoghton", - "Hohentwiel", - "Holcomb", - "Homosassa", - "Honelis", - "Hongkong", - "Horsham", - "Houston", - "Huddinge", - "Huettwilen", - "Hull", - "Hvittingfoss", - "Hydra", - "Ibadan", - "Ibaragi", - "Idikan", - "Ikayi", - "Ikeja", - "Ilala", - "Ilugun", - "Imo", - "Inchpark", - "India", - "Indiana", - "Infantis", - "Inganda", - "Inglis", - "Inpraw", - "Inverness", - "Ipeko", - "Ipswich", - "Irchel", - "Irenea", - "Irigny", - "Irumu", - "Isangi", - "Isaszeg", - "Israel", - "Istanbul", - "Istoria", - "Isuge", - "Itami", - "Ituri", - "Itutaba", - "Ivory", - "Ivorycoast", - "Ivrysurseine", - "Jaffna", - "Jalisco", - "Jamaica", - "Jambur", - "Jangwani", - "Javiana", - "Jedburgh", - "Jericho", - "Jerusalem", - "Joal", - "Jodhpur", - "Johannesburg", - "Jos", - "Juba", - "Jubilee", - "Jukestown", - "Kaapstad", - "Kabete", - "Kaduna", - "Kaevlinge", - "Kahla", - "Kainji", - "Kaitaan", - "Kalamu", - "Kalina", - "Kallo", - "Kalumburu", - "Kambole", - "Kamoru", - "Kampala", - "Kande", - "Kandla", - "Kaneshie", - "Kanifing", - "Kano", - "Kaolack", - "Kapemba", - "Karachi", - "Karamoja", - "Karaya", - "Karlshamn", - "Kasenyi", - "Kassberg", - "Kassel", - "Kastrup", - "Kedougou", - "Kentucky", - "Kenya", - "Kermel", - "Kethiabarny", - "Keurmassar", - "Keve", - "Kiambu", - "Kibi", - "Kibusi", - "Kidderminster", - "Kiel", - "Kikoma", - "Kimberley", - "Kimpese", - "Kimuenza", - "Kindia", - "Kingabwa", - "Kingston", - "Kinondoni", - "Kinson", - "Kintambo", - "Kirkee", - "Kisangani", - "Kisarawe", - "Kisii", - "Kitenge", - "Kivu", - "Klouto", - "Koblenz", - "Kodjovi", - "Koenigstuhl", - "Koessen", - "Kofandoka", - "Koketime", - "Kokoli", - "Kokomlemle", - "Kolar", - "Kolda", - "Konolfingen", - "Konongo", - "Konstanz", - "Korbol", - "Korkeasaari", - "Korlebu", - "Korovi", - "Kortrijk", - "Kottbus", - "Kotte", - "Kotu", - "Kouka", - "Koumra", - "Kpeme", - "Kralingen", - "Krefeld", - "Kristianstad", - "Kua", - "Kubacha", - "Kuessel", - "Kumasi", - "Kunduchi", - "Kuntair", - "Kuru", - "Labadi", - "Lagos", - "Lamberhurst", - "Lamin", - "Lamphun", - "Lancaster", - "Landala", - "Landau", - "Landwasser", - "Langenhorn", - "Langensalza", - "Langeveld", - "Langford", - "Lansing", - "Laredo", - "Larochelle", - "Larose", - "Lattenkamp", - "Lawndale", - "Lawra", - "Leatherhead", - "Lechler", - "Leda", - "Leer", - "Leeuwarden", - "Legon", - "Lehrte", - "Leiden", - "Leipzig", - "Leith", - "Lekke", - "Lemmer", - "Lene", - "Leoben", - "Leopoldville", - "Lerum", - "Lexington", - "Lezennes", - "Libreville", - "Ligeo", - "Ligna", - "Lika", - "Lille", - "Limete", - "Lindenburg", - "Lindern", - "Lindi", - "Linguere", - "Lingwala", - "Linton", - "Lisboa", - "Lishabi", - "Litchfield", - "Liverpool", - "Livingstone", - "Livulu", - "Ljubljana", - "Llandoff", - "Llobregat", - "Loanda", - "Lockleaze", - "Lode", - "Lodz", - "Loenga", - "Logone", - "Lokomo", - "Lokstedt", - "Lomalinda", - "Lome", - "Lomita", - "Lomnava", - "London", - "Lonestar", - "Losangeles", - "Loubomo", - "Louga", - "Louisiana", - "Lovelace", - "Lowestoft", - "Lubumbashi", - "Luciana", - "Luckenwalde", - "Luedinghausen", - "Luke", - "Lund", - "Lutetia", - "Lyon", - "Maastricht", - "Macallen", - "Macclesfield", - "Machaga", - "Madelia", - "Madiago", - "Madigan", - "Madison", - "Madjorio", - "Madras", - "Magherafelt", - "Magumeri", - "Magwa", - "Mahina", - "Maiduguri", - "Makiling", - "Makiso", - "Malakal", - "Malaysia", - "Malika", - "Malmoe", - "Malstatt", - "Mampeza", - "Mampong", - "Mana", - "Manchester", - "Mandera", - "Mango", - "Manhattan", - "Mannheim", - "Mapo", - "Mara", - "Maracaibo", - "Marburg", - "Maricopa", - "Marienthal", - "Maritzburg", - "Marmande", - "Maron", - "Maroua", - "Marsabit", - "Marseille", - "Marshall", - "Martonos", - "Maryland", - "Marylebone", - "Masembe", - "Maska", - "Massakory", - "Massenya", - "Massilia", - "Matadi", - "Mathura", - "Matopeni", - "Mattenhof", - "Maumee", - "Mayday", - "Mbandaka", - "Mbao", - "Meekatharra", - "Melaka", - "Melbourne", - "Meleagridis", - "Memphis", - "Menden", - "Mendoza", - "Menston", - "Mesbit", - "Meskin", - "Messina", - "Mgulani", - "Miami", - "Michigan", - "Middlesbrough", - "Midway", - "Mikawasima", - "Millesi", - "Milwaukee", - "Mim", - "Minna", - "Minnesota", - "Mishmarhaemek", - "Mississippi", - "Missouri", - "Miyazaki", - "Mjordan", - "Mkamba", - "Moabit", - "Mocamedes", - "Moero", - "Moers", - "Mokola", - "Molade", - "Molesey", - "Mono", - "Mons", - "Monschaui", - "Montaigu", - "Montevideo", - "Montreal", - "Morbihan", - "Morehead", - "Morillons", - "Morningside", - "Mornington", - "Morocco", - "Morotai", - "Moroto", - "Moscow", - "Moualine", - "Moundou", - "Mountmagnet", - "Mountpleasant", - "Moussoro", - "Mowanjum", - "Mpouto", - "Muenchen", - "Muguga", - "Mulhouse", - "Mundonobo", - "Mundubbera", - "Mura", - "Mygdal", - "Myrria", - "Naestved", - "Nagoya", - "Nakuru", - "Namibia", - "Namoda", - "Namur", - "Nanergou", - "Nanga", - "Nantes", - "Napoli", - "Narashino", - "Nashua", - "Natal", - "Naware", - "Nchanga", - "Ndjamena", - "Ndolo", - "Neftenbach", - "Nessa", - "Nessziona", - "Neudorf", - "Neukoelln", - "Neumuenster", - "Neunkirchen", - "Newholland", - "Newjersey", - "Newlands", - "Newmexico", - "Newport", - "Newrochelle", - "Newyork", - "Ngaparou", - "Ngili", - "Ngor", - "Niakhar", - "Niamey", - "Niarembe", - "Niederoderwitz", - "Nieukerk", - "Nigeria", - "Nijmegen", - "Nikolaifleet", - "Niloese", - "Nima", - "Nimes", - "Nitra", - "Niumi", - "Njala", - "Nola", - "Nordrhein", - "Nordufer", - "Norton", - "Norwich", - "Nottingham", - "Nowawes", - "Noya", - "Nuatja", - "Nyborg", - "Nyeko", - "Oakey", - "Oakland", - "Obogu", - "Ochiogu", - "Ochsenwerder", - "Ockenheim", - "Odienne", - "Odozi", - "Oerlikon", - "Oesterbro", - "Offa", - "Ogbete", - "Ohlstedt", - "Okatie", - "Okefoko", - "Okerara", - "Oldenburg", - "Olten", - "Omifisan", - "Omuna", - "Ona", - "Onarimon", - "Onderstepoort", - "Onireke", - "Ontario", - "Oran", - "Oranienburg", - "Orbe", - "Ord", - "Ordonez", - "Orientalis", - "Orion", - "Oritamerin", - "Orlando", - "Orleans", - "Os", - "Oskarshamn", - "Oslo", - "Osnabrueck", - "Othmarschen", - "Ottawa", - "Ouagadougou", - "Ouakam", - "Oudwijk", - "Overchurch", - "Overschie", - "Overvecht", - "Oxford", - "Oyonnax", - "Pakistan", - "Palamaner", - "Palime", - "Panama", - "Papuana", - "Parakou", - "Paris", - "Parkroyal", - "Pasing", - "Patience", - "Penarth", - "Penilla", - "Pensacola", - "Perth", - "Petahtikve", - "Phaliron", - "Pharr", - "Picpus", - "Pietersburg", - "Pisa", - "Planckendael", - "Ploufragan", - "Plumaugat", - "Plymouth", - "Poano", - "Podiensis", - "Poeseldorf", - "Poitiers", - "Pomona", - "Pontypridd", - "Poona", - "Portanigra", - "Portland", - "Potengi", - "Potosi", - "Potsdam", - "Potto", - "Powell", - "Praha", - "Pramiso", - "Presov", - "Preston", - "Pretoria", - "Putten", - "Quebec", - "Quentin", - "Quincy", - "Quinhon", - "Quiniela", - "Ramatgan", - "Ramsey", - "Ratchaburi", - "Raus", - "Rawash", - "Reading", - "Rechovot", - "Redba", - "Redhill", - "Redlands", - "Regent", - "Reinickendorf", - "Remete", - "Remiremont", - "Remo", - "Reubeuss", - "Rhone", - "Rhydyfelin", - "Richmond", - "Rideau", - "Ridge", - "Ried", - "Riggil", - "Riogrande", - "Rissen", - "Rittersbach", - "Riverside", - "Roan", - "Rochdale", - "Rogy", - "Romanby", - "Roodepoort", - "Rosenberg", - "Rossleben", - "Rostock", - "Rothenburgsort", - "Rottnest", - "Rovaniemi", - "Royan", - "Ruanda", - "Rubislaw", - "Ruiru", - "Rumford", - "Runby", - "Ruzizi", - "Saarbruecken", - "Saboya", - "Sada", - "Saintemarie", - "Saintpaul", - "Salford", - "Salinas", - "Sally", - "Saloniki", - "Samaru", - "Sambre", - "Sandaga", - "Sandiego", - "Sandow", - "Sanga", - "Sangalkam", - "Sangera", - "Sanjuan", - "Sanktgeorg", - "Sanktjohann", - "Sanktmarx", - "Santander", - "Santhiaba", - "Santiago", - "Sao", - "Sapele", - "Saphra", - "Sara", - "Sarajane", - "Saugus", - "Scarborough", - "Schalkwijk", - "Schleissheim", - "Schoeneberg", - "Schwabach", - "Schwarzengrund", - "Schwerin", - "Sculcoates", - "Seattle", - "Sedgwick", - "Seegefeld", - "Sekondi", - "Selby", - "Sendai", - "Senegal", - "Senftenberg", - "Senneville", - "Seremban", - "Serrekunda", - "Shahalam", - "Shamba", - "Shangani", - "Shanghai", - "Shannon", - "Sharon", - "Sheffield", - "Sherbrooke", - "Shikmonah", - "Shipley", - "Shomolu", - "Shoreditch", - "Shubra", - "Sica", - "Simi", - "Sinchew", - "Sindelfingen", - "Singapore", - "Sinstorf", - "Sinthia", - "Sipane", - "Skansen", - "Slade", - "Sljeme", - "Sloterdijk", - "Soahanina", - "Soerenga", - "Sokode", - "Solna", - "Solt", - "Somone", - "Sontheim", - "Soumbedioune", - "Southbank", - "Souza", - "Spalentor", - "Spartel", - "Splott", - "Stachus", - "Stanley", - "Stanleyville", - "Staoueli", - "Steinplatz", - "Steinwerder", - "Stellingen", - "Stendal", - "Sternschanze", - "Sterrenbos", - "Stockholm", - "Stoneferry", - "Stormont", - "Stourbridge", - "Straengnaes", - "Strasbourg", - "Stratford", - "Strathcona", - "Stuivenberg", - "Stuttgart", - "Suberu", - "Sudan", - "Suelldorf", - "Sundsvall", - "Sunnycove", - "Surat", - "Surrey", - "Svedvi", - "Sya", - "Sylvania", - "Szentes", - "Tabligbo", - "Tado", - "Tafo", - "Taiping", - "Takoradi", - "Taksony", - "Tallahassee", - "Tamale", - "Tambacounda", - "Tamberma", - "Tamilnadu", - "Tampico", - "Tananarive", - "Tanger", - "Tanzania", - "Tarshyne", - "Taset", - "Taunton", - "Taylor", - "Tchad", - "Tchamba", - "Techimani", - "Teddington", - "Tees", - "Tejas", - "Teko", - "Telaviv", - "Telelkebir", - "Telhashomer", - "Teltow", - "Tema", - "Tempe", - "Tendeba", - "Tennenlohe", - "Tennessee", - "Tennyson", - "Teshie", - "Texas", - "Thayngen", - "Thetford", - "Thiaroye", - "Thies", - "Thompson", - "Tibati", - "Tienba", - "Tiergarten", - "Tiko", - "Tilburg", - "Tilene", - "Tinda", - "Tione", - "Togba", - "Togo", - "Tokoin", - "Tomegbe", - "Tomelilla", - "Tonev", - "Toowong", - "Torhout", - "Toricada", - "Tornow", - "Toronto", - "Toucra", - "Toulon", - "Tounouma", - "Tours", - "Trachau", - "Transvaal", - "Travis", - "Treforest", - "Treguier", - "Trier", - "Trimdon", - "Tripoli", - "Trotha", - "Troy", - "Truro", - "Tschangu", - "Tsevie", - "Tshiongwe", - "Tucson", - "Tudu", - "Tumodi", - "Typhi", - "Typhisuis", - "Tyresoe", - "Uccle", - "Uganda", - "Ughelli", - "Uhlenhorst", - "Uithof", - "Ullevi", - "Umbadah", - "Umbilo", - "Umhlali", - "Umhlatazana", - "Uno", - "Uppsala", - "Urbana", - "Ursenbach", - "Usumbura", - "Utah", - "Utrecht", - "Uzaramo", - "Vaertan", - "Valdosta", - "Vancouver", - "Vanier", - "Vaugirard", - "Vegesack", - "Vejle", - "Vellore", - "Veneziana", - "Verona", - "Verviers", - "Victoria", - "Victoriaborg", - "Vietnam", - "Vilvoorde", - "Vinohrady", - "Virchow", - "Virginia", - "Visby", - "Vitkin", - "Vleuten", - "Vogan", - "Volkmarsdorf", - "Volta", - "Vom", - "Voulte", - "Vridi", - "Vuadens", - "Wa", - "Waedenswil", - "Wagadugu", - "Wagenia", - "Wanatah", - "Wandsworth", - "Wangata", - "Waral", - "Warengo", - "Warmsen", - "Warnemuende", - "Warnow", - "Warragul", - "Warri", - "Washington", - "Waycross", - "Wayne", - "Wedding", - "Welikade", - "Weltevreden", - "Wenatchee", - "Wentworth", - "Wernigerode", - "Weslaco", - "Westafrica", - "Westeinde", - "Westerstede", - "Westhampton", - "Westminster", - "Weston", - "Westphalia", - "Weybridge", - "Wichita", - "Widemarsh", - "Wien", - "Wil", - "Wilhelmsburg", - "Willamette", - "Willemstad", - "Wilmington", - "Wimborne", - "Windermere", - "Windsheim", - "Wingrove", - "Winneba", - "Winnipeg", - "Winslow", - "Winston", - "Winterthur", - "Wippra", - "Wisbech", - "Wohlen", - "Woodhull", - "Woodinville", - "Worb", - "Worthington", - "Woumbou", - "Wuiti", - "Wuppertal", - "Wyldegreen", - "Yaba", - "Yalding", - "Yaounde", - "Yardley", - "Yarm", - "Yarrabah", - "Yeerongpilly", - "Yehuda", - "Yekepa", - "Yellowknife", - "Yenne", - "Yerba", - "Yoff", - "Yokoe", - "Yolo", - "Yombesali", - "Yopougon", - "York", - "Yoruba", - "Yovokome", - "Yundum", - "Zadar", - "Zaiman", - "Zaire", - "Zanzibar", - "Zaria", - "Zega", - "Zehlendorf", - "Zerifin", - "Zigong", - "Zinder", - "Zongo", - "Zuilen", - "Zwickau") +serovars <- c( + "Aachen", + "Aarhus", + "Aba", + "Abadina", + "Abaetetuba", + "Aberdeen", + "Abidjan", + "Ablogame", + "Abobo", + "Abony", + "Abortusequi", + "Abortusovis", + "Abuja", + "Accra", + "Ackwepe", + "Adabraka", + "Adamstown", + "Adamstua", + "Adana", + "Adelaide", + "Adeoyo", + "Aderike", + "Adime", + "Adjame", + "Aequatoria", + "Aesch", + "Aflao", + "Africana", + "Afula", + "Agama", + "Agbara", + "Agbeni", + "Agege", + "Ago", + "Agodi", + "Agona", + "Agoueve", + "Ahanou", + "Ahepe", + "Ahmadi", + "Ahoutoue", + "Ahuza", + "Ajiobo", + "Akanji", + "Akuafo", + "Alabama", + "Alachua", + "Alagbon", + "Alamo", + "Albany", + "Albert", + "Albertbanjul", + "Albertslund", + "Albuquerque", + "Alexanderplatz", + "Alexanderpolder", + "Alfort", + "Alger", + "Alkmaar", + "Allandale", + "Allerton", + "Alma", + "Alminko", + "Alpenquai", + "Altendorf", + "Amager", + "Amberg", + "Amersfoort", + "Amherstiana", + "Amina", + "Aminatu", + "Amounderness", + "Amoutive", + "Amsterdam", + "Amunigun", + "Anderlecht", + "Anecho", + "Anfo", + "Angers", + "Angoda", + "Angouleme", + "Ank", + "Anna", + "Annedal", + "Antarctica", + "Antonio", + "Antsalova", + "Antwerpen", + "Apapa", + "Apeyeme", + "Aprad", + "Aqua", + "Aragua", + "Arapahoe", + "Arechavaleta", + "Argenteuil", + "Arusha", + "Aschersleben", + "Ashanti", + "Assen", + "Assinie", + "Astridplein", + "Asylanta", + "Atakpame", + "Atento", + "Athens", + "Athinai", + "Ati", + "Augustenborg", + "Aurelianis", + "Austin", + "Australia", + "Avignon", + "Avonmouth", + "Axim", + "Ayinde", + "Ayton", + "Azteca", + "Babelsberg", + "Babili", + "Badagry", + "Baguida", + "Baguirmi", + "Bahati", + "Bahrenfeld", + "Baiboukoum", + "Baildon", + "Bakau", + "Balcones", + "Ball", + "Bama", + "Bamboye", + "Bambylor", + "Banalia", + "Banana", + "Banco", + "Bandia", + "Bandim", + "Bangkok", + "Bangui", + "Banjul", + "Bardo", + "Bareilly", + "Bargny", + "Barmbek", + "Barranquilla", + "Barry", + "Basingstoke", + "Bassa", + "Bassadji", + "Bata", + "Batonrouge", + "Battle", + "Bazenheid", + "Be", + "Beaudesert", + "Bedford", + "Belem", + "Belfast", + "Bellevue", + "Benfica", + "Benguella", + "Benin", + "Benue", + "Bere", + "Bergedorf", + "Bergen", + "Bergues", + "Berkeley", + "Berlin", + "Berta", + "Bessi", + "Bethune", + "Biafra", + "Bida", + "Bietri", + "Bignona", + "Bijlmer", + "Bilu", + "Binche", + "Bingerville", + "Binningen", + "Birkenhead", + "Birmingham", + "Bispebjerg", + "Bissau", + "Blancmesnil", + "Blegdam", + "Blijdorp", + "Blitta", + "Blockley", + "Bloomsbury", + "Blukwa", + "Bobo", + "Bochum", + "Bodjonegoro", + "Boecker", + "Bofflens", + "Bokanjac", + "Bolama", + "Bolombo", + "Bolton", + "Bonames", + "Bonariensis", + "Bonn", + "Bootle", + "Borbeck", + "Bordeaux", + "Borreze", + "Borromea", + "Bouake", + "Bournemouth", + "Bousso", + "Bovismorbificans", + "Brackenridge", + "Bracknell", + "Bradford", + "Braenderup", + "Brancaster", + "Brandenburg", + "Brazil", + "Brazos", + "Brazzaville", + "Breda", + "Bredeney", + "Brefet", + "Breukelen", + "Brevik", + "Brezany", + "Brijbhumi", + "Brikama", + "Brindisi", + "Brisbane", + "Bristol", + "Brive", + "Broc", + "Bron", + "Bronx", + "Brooklyn", + "Broughton", + "Bruck", + "Bruebach", + "Brunei", + "Brunflo", + "Bsilla", + "Buckeye", + "Budapest", + "Bukavu", + "Bukuru", + "Bulgaria", + "Bullbay", + "Bulovka", + "Burgas", + "Burundi", + "Bury", + "Butantan", + "Butare", + "Buzu", + "Caen", + "Cairina", + "Cairns", + "Calabar", + "California", + "Camberene", + "Camberwell", + "Campinense", + "Canada", + "Canary", + "Cannobio", + "Cannonhill", + "Cannstatt", + "Canton", + "Caracas", + "Cardoner", + "Carmel", + "Carnac", + "Carno", + "Carpentras", + "Carrau", + "Carswell", + "Casablanca", + "Casamance", + "Catalunia", + "Catanzaro", + "Catumagos", + "Cayar", + "Cerro", + "Ceyco", + "Chagoua", + "Chailey", + "Champaign", + "Chandans", + "Charity", + "Charlottenburg", + "Chartres", + "Cheltenham", + "Chennai", + "Chester", + "Chicago", + "Chichester", + "Chichiri", + "Chile", + "Chincol", + "Chingola", + "Chiredzi", + "Chittagong", + "Choleraesuis", + "Chomedey", + "Christiansborg", + "Clackamas", + "Claibornei", + "Clanvillian", + "Clerkenwell", + "Cleveland", + "Clontarf", + "Cochin", + "Cochise", + "Cocody", + "Coeln", + "Coleypark", + "Colindale", + "Colobane", + "Colombo", + "Colorado", + "Concord", + "Connecticut", + "Coogee", + "Coquilhatville", + "Coromandel", + "Corvallis", + "Cotham", + "Cotia", + "Cotonou", + "Cremieu", + "Crewe", + "Croft", + "Crossness", + "Cubana", + "Cuckmere", + "Cullingworth", + "Cumberland", + "Curacao", + "Cyprus", + "Czernyring", + "Daarle", + "Dabou", + "Dadzie", + "Dahlem", + "Dahomey", + "Dahra", + "Dakar", + "Dakota", + "Dallgow", + "Damman", + "Dan", + "Dapango", + "Daula", + "Daytona", + "Deckstein", + "Delan", + "Delmenhorst", + "Dembe", + "Demerara", + "Denver", + "Derby", + "Derkle", + "Dessau", + "Detmold", + "Deversoir", + "Dibra", + "Dietrichsdorf", + "Dieuppeul", + "Diguel", + "Dingiri", + "Diogoye", + "Diourbel", + "Djakarta", + "Djama", + "Djelfa", + "Djermaia", + "Djibouti", + "Djinten", + "Djugu", + "Doba", + "Doel", + "Doncaster", + "Donna", + "Doorn", + "Dortmund", + "Douala", + "Dougi", + "Doulassame", + "Drac", + "Dresden", + "Driffield", + "Dublin", + "Duesseldorf", + "Dugbe", + "Duisburg", + "Dumfries", + "Dunkwa", + "Durban", + "Durham", + "Duval", + "Ealing", + "Eastbourne", + "Eastglam", + "Eaubonne", + "Eberswalde", + "Eboko", + "Ebrie", + "Echa", + "Ede", + "Edinburg", + "Edmonton", + "Egusi", + "Egusitoo", + "Eingedi", + "Eko", + "Ekotedo", + "Ekpoui", + "Elbeuf", + "Elisabethville", + "Elokate", + "Elomrane", + "Emek", + "Emmastad", + "Encino", + "Enschede", + "Entebbe", + "Enteritidis", + "Enugu", + "Epalinges", + "Epicrates", + "Epinay", + "Eppendorf", + "Erfurt", + "Escanaba", + "Eschberg", + "Eschweiler", + "Essen", + "Essingen", + "Etterbeek", + "Euston", + "Everleigh", + "Evry", + "Ezra", + "Fairfield", + "Fajara", + "Faji", + "Falkensee", + "Fallowfield", + "Fann", + "Fanti", + "Farakan", + "Farcha", + "Fareham", + "Farmingdale", + "Farmsen", + "Farsta", + "Fass", + "Fayed", + "Fehrbellin", + "Ferlo", + "Ferruch", + "Fillmore", + "Finaghy", + "Findorff", + "Finkenwerder", + "Fischerhuette", + "Fischerkietz", + "Fischerstrasse", + "Fitzroy", + "Florian", + "Florida", + "Flottbek", + "Fluntern", + "Fomeco", + "Fortlamy", + "Fortune", + "Franken", + "Frankfurt", + "Frederiksberg", + "Freefalls", + "Freetown", + "Freiburg", + "Fresno", + "Friedenau", + "Friedrichsfelde", + "Frintrop", + "Fufu", + "Fulda", + "Fulica", + "Fyris", + "Gabon", + "Gafsa", + "Gaillac", + "Galiema", + "Galil", + "Gallen", + "Gallinarum", + "Gamaba", + "Gambaga", + "Gambia", + "Gaminara", + "Garba", + "Garoli", + "Gassi", + "Gateshead", + "Gatineau", + "Gatow", + "Gatuni", + "Gbadago", + "Gdansk", + "Gege", + "Georgia", + "Gera", + "Geraldton", + "Gerland", + "Ghana", + "Giessen", + "Give", + "Giza", + "Glasgow", + "Glidji", + "Glostrup", + "Gloucester", + "Gnesta", + "Godesberg", + "Goelzau", + "Goeteborg", + "Goettingen", + "Gokul", + "Goldcoast", + "Goma", + "Gombe", + "Good", + "Gori", + "Goulfey", + "Gouloumbo", + "Goverdhan", + "Gozo", + "Grampian", + "Grancanaria", + "Grandhaven", + "Granlo", + "Graz", + "Greiz", + "Groenekan", + "Grumpensis", + "Guarapiranga", + "Guerin", + "Gueuletapee", + "Guildford", + "Guinea", + "Gustavia", + "Gwale", + "Gwoza", + "Haardt", + "Hadar", + "Hadejia", + "Haduna", + "Haelsingborg", + "Haferbreite", + "Haga", + "Haifa", + "Halle", + "Hallfold", + "Handen", + "Hann", + "Hannover", + "Haouaria", + "Harburg", + "Harcourt", + "Harleystreet", + "Hartford", + "Harvestehude", + "Hatfield", + "Hato", + "Havana", + "Hayindogo", + "Heerlen", + "Hegau", + "Heidelberg", + "Heistopdenberg", + "Hemingford", + "Hennekamp", + "Hermannswerder", + "Heron", + "Herston", + "Herzliya", + "Hessarek", + "Hidalgo", + "Hiduddify", + "Hillegersberg", + "Hillingdon", + "Hillsborough", + "Hilversum", + "Hindmarsh", + "Hisingen", + "Hissar", + "Hithergreen", + "Hoboken", + "Hofit", + "Hoghton", + "Hohentwiel", + "Holcomb", + "Homosassa", + "Honelis", + "Hongkong", + "Horsham", + "Houston", + "Huddinge", + "Huettwilen", + "Hull", + "Hvittingfoss", + "Hydra", + "Ibadan", + "Ibaragi", + "Idikan", + "Ikayi", + "Ikeja", + "Ilala", + "Ilugun", + "Imo", + "Inchpark", + "India", + "Indiana", + "Infantis", + "Inganda", + "Inglis", + "Inpraw", + "Inverness", + "Ipeko", + "Ipswich", + "Irchel", + "Irenea", + "Irigny", + "Irumu", + "Isangi", + "Isaszeg", + "Israel", + "Istanbul", + "Istoria", + "Isuge", + "Itami", + "Ituri", + "Itutaba", + "Ivory", + "Ivorycoast", + "Ivrysurseine", + "Jaffna", + "Jalisco", + "Jamaica", + "Jambur", + "Jangwani", + "Javiana", + "Jedburgh", + "Jericho", + "Jerusalem", + "Joal", + "Jodhpur", + "Johannesburg", + "Jos", + "Juba", + "Jubilee", + "Jukestown", + "Kaapstad", + "Kabete", + "Kaduna", + "Kaevlinge", + "Kahla", + "Kainji", + "Kaitaan", + "Kalamu", + "Kalina", + "Kallo", + "Kalumburu", + "Kambole", + "Kamoru", + "Kampala", + "Kande", + "Kandla", + "Kaneshie", + "Kanifing", + "Kano", + "Kaolack", + "Kapemba", + "Karachi", + "Karamoja", + "Karaya", + "Karlshamn", + "Kasenyi", + "Kassberg", + "Kassel", + "Kastrup", + "Kedougou", + "Kentucky", + "Kenya", + "Kermel", + "Kethiabarny", + "Keurmassar", + "Keve", + "Kiambu", + "Kibi", + "Kibusi", + "Kidderminster", + "Kiel", + "Kikoma", + "Kimberley", + "Kimpese", + "Kimuenza", + "Kindia", + "Kingabwa", + "Kingston", + "Kinondoni", + "Kinson", + "Kintambo", + "Kirkee", + "Kisangani", + "Kisarawe", + "Kisii", + "Kitenge", + "Kivu", + "Klouto", + "Koblenz", + "Kodjovi", + "Koenigstuhl", + "Koessen", + "Kofandoka", + "Koketime", + "Kokoli", + "Kokomlemle", + "Kolar", + "Kolda", + "Konolfingen", + "Konongo", + "Konstanz", + "Korbol", + "Korkeasaari", + "Korlebu", + "Korovi", + "Kortrijk", + "Kottbus", + "Kotte", + "Kotu", + "Kouka", + "Koumra", + "Kpeme", + "Kralingen", + "Krefeld", + "Kristianstad", + "Kua", + "Kubacha", + "Kuessel", + "Kumasi", + "Kunduchi", + "Kuntair", + "Kuru", + "Labadi", + "Lagos", + "Lamberhurst", + "Lamin", + "Lamphun", + "Lancaster", + "Landala", + "Landau", + "Landwasser", + "Langenhorn", + "Langensalza", + "Langeveld", + "Langford", + "Lansing", + "Laredo", + "Larochelle", + "Larose", + "Lattenkamp", + "Lawndale", + "Lawra", + "Leatherhead", + "Lechler", + "Leda", + "Leer", + "Leeuwarden", + "Legon", + "Lehrte", + "Leiden", + "Leipzig", + "Leith", + "Lekke", + "Lemmer", + "Lene", + "Leoben", + "Leopoldville", + "Lerum", + "Lexington", + "Lezennes", + "Libreville", + "Ligeo", + "Ligna", + "Lika", + "Lille", + "Limete", + "Lindenburg", + "Lindern", + "Lindi", + "Linguere", + "Lingwala", + "Linton", + "Lisboa", + "Lishabi", + "Litchfield", + "Liverpool", + "Livingstone", + "Livulu", + "Ljubljana", + "Llandoff", + "Llobregat", + "Loanda", + "Lockleaze", + "Lode", + "Lodz", + "Loenga", + "Logone", + "Lokomo", + "Lokstedt", + "Lomalinda", + "Lome", + "Lomita", + "Lomnava", + "London", + "Lonestar", + "Losangeles", + "Loubomo", + "Louga", + "Louisiana", + "Lovelace", + "Lowestoft", + "Lubumbashi", + "Luciana", + "Luckenwalde", + "Luedinghausen", + "Luke", + "Lund", + "Lutetia", + "Lyon", + "Maastricht", + "Macallen", + "Macclesfield", + "Machaga", + "Madelia", + "Madiago", + "Madigan", + "Madison", + "Madjorio", + "Madras", + "Magherafelt", + "Magumeri", + "Magwa", + "Mahina", + "Maiduguri", + "Makiling", + "Makiso", + "Malakal", + "Malaysia", + "Malika", + "Malmoe", + "Malstatt", + "Mampeza", + "Mampong", + "Mana", + "Manchester", + "Mandera", + "Mango", + "Manhattan", + "Mannheim", + "Mapo", + "Mara", + "Maracaibo", + "Marburg", + "Maricopa", + "Marienthal", + "Maritzburg", + "Marmande", + "Maron", + "Maroua", + "Marsabit", + "Marseille", + "Marshall", + "Martonos", + "Maryland", + "Marylebone", + "Masembe", + "Maska", + "Massakory", + "Massenya", + "Massilia", + "Matadi", + "Mathura", + "Matopeni", + "Mattenhof", + "Maumee", + "Mayday", + "Mbandaka", + "Mbao", + "Meekatharra", + "Melaka", + "Melbourne", + "Meleagridis", + "Memphis", + "Menden", + "Mendoza", + "Menston", + "Mesbit", + "Meskin", + "Messina", + "Mgulani", + "Miami", + "Michigan", + "Middlesbrough", + "Midway", + "Mikawasima", + "Millesi", + "Milwaukee", + "Mim", + "Minna", + "Minnesota", + "Mishmarhaemek", + "Mississippi", + "Missouri", + "Miyazaki", + "Mjordan", + "Mkamba", + "Moabit", + "Mocamedes", + "Moero", + "Moers", + "Mokola", + "Molade", + "Molesey", + "Mono", + "Mons", + "Monschaui", + "Montaigu", + "Montevideo", + "Montreal", + "Morbihan", + "Morehead", + "Morillons", + "Morningside", + "Mornington", + "Morocco", + "Morotai", + "Moroto", + "Moscow", + "Moualine", + "Moundou", + "Mountmagnet", + "Mountpleasant", + "Moussoro", + "Mowanjum", + "Mpouto", + "Muenchen", + "Muguga", + "Mulhouse", + "Mundonobo", + "Mundubbera", + "Mura", + "Mygdal", + "Myrria", + "Naestved", + "Nagoya", + "Nakuru", + "Namibia", + "Namoda", + "Namur", + "Nanergou", + "Nanga", + "Nantes", + "Napoli", + "Narashino", + "Nashua", + "Natal", + "Naware", + "Nchanga", + "Ndjamena", + "Ndolo", + "Neftenbach", + "Nessa", + "Nessziona", + "Neudorf", + "Neukoelln", + "Neumuenster", + "Neunkirchen", + "Newholland", + "Newjersey", + "Newlands", + "Newmexico", + "Newport", + "Newrochelle", + "Newyork", + "Ngaparou", + "Ngili", + "Ngor", + "Niakhar", + "Niamey", + "Niarembe", + "Niederoderwitz", + "Nieukerk", + "Nigeria", + "Nijmegen", + "Nikolaifleet", + "Niloese", + "Nima", + "Nimes", + "Nitra", + "Niumi", + "Njala", + "Nola", + "Nordrhein", + "Nordufer", + "Norton", + "Norwich", + "Nottingham", + "Nowawes", + "Noya", + "Nuatja", + "Nyborg", + "Nyeko", + "Oakey", + "Oakland", + "Obogu", + "Ochiogu", + "Ochsenwerder", + "Ockenheim", + "Odienne", + "Odozi", + "Oerlikon", + "Oesterbro", + "Offa", + "Ogbete", + "Ohlstedt", + "Okatie", + "Okefoko", + "Okerara", + "Oldenburg", + "Olten", + "Omifisan", + "Omuna", + "Ona", + "Onarimon", + "Onderstepoort", + "Onireke", + "Ontario", + "Oran", + "Oranienburg", + "Orbe", + "Ord", + "Ordonez", + "Orientalis", + "Orion", + "Oritamerin", + "Orlando", + "Orleans", + "Os", + "Oskarshamn", + "Oslo", + "Osnabrueck", + "Othmarschen", + "Ottawa", + "Ouagadougou", + "Ouakam", + "Oudwijk", + "Overchurch", + "Overschie", + "Overvecht", + "Oxford", + "Oyonnax", + "Pakistan", + "Palamaner", + "Palime", + "Panama", + "Papuana", + "Parakou", + "Paris", + "Parkroyal", + "Pasing", + "Patience", + "Penarth", + "Penilla", + "Pensacola", + "Perth", + "Petahtikve", + "Phaliron", + "Pharr", + "Picpus", + "Pietersburg", + "Pisa", + "Planckendael", + "Ploufragan", + "Plumaugat", + "Plymouth", + "Poano", + "Podiensis", + "Poeseldorf", + "Poitiers", + "Pomona", + "Pontypridd", + "Poona", + "Portanigra", + "Portland", + "Potengi", + "Potosi", + "Potsdam", + "Potto", + "Powell", + "Praha", + "Pramiso", + "Presov", + "Preston", + "Pretoria", + "Putten", + "Quebec", + "Quentin", + "Quincy", + "Quinhon", + "Quiniela", + "Ramatgan", + "Ramsey", + "Ratchaburi", + "Raus", + "Rawash", + "Reading", + "Rechovot", + "Redba", + "Redhill", + "Redlands", + "Regent", + "Reinickendorf", + "Remete", + "Remiremont", + "Remo", + "Reubeuss", + "Rhone", + "Rhydyfelin", + "Richmond", + "Rideau", + "Ridge", + "Ried", + "Riggil", + "Riogrande", + "Rissen", + "Rittersbach", + "Riverside", + "Roan", + "Rochdale", + "Rogy", + "Romanby", + "Roodepoort", + "Rosenberg", + "Rossleben", + "Rostock", + "Rothenburgsort", + "Rottnest", + "Rovaniemi", + "Royan", + "Ruanda", + "Rubislaw", + "Ruiru", + "Rumford", + "Runby", + "Ruzizi", + "Saarbruecken", + "Saboya", + "Sada", + "Saintemarie", + "Saintpaul", + "Salford", + "Salinas", + "Sally", + "Saloniki", + "Samaru", + "Sambre", + "Sandaga", + "Sandiego", + "Sandow", + "Sanga", + "Sangalkam", + "Sangera", + "Sanjuan", + "Sanktgeorg", + "Sanktjohann", + "Sanktmarx", + "Santander", + "Santhiaba", + "Santiago", + "Sao", + "Sapele", + "Saphra", + "Sara", + "Sarajane", + "Saugus", + "Scarborough", + "Schalkwijk", + "Schleissheim", + "Schoeneberg", + "Schwabach", + "Schwarzengrund", + "Schwerin", + "Sculcoates", + "Seattle", + "Sedgwick", + "Seegefeld", + "Sekondi", + "Selby", + "Sendai", + "Senegal", + "Senftenberg", + "Senneville", + "Seremban", + "Serrekunda", + "Shahalam", + "Shamba", + "Shangani", + "Shanghai", + "Shannon", + "Sharon", + "Sheffield", + "Sherbrooke", + "Shikmonah", + "Shipley", + "Shomolu", + "Shoreditch", + "Shubra", + "Sica", + "Simi", + "Sinchew", + "Sindelfingen", + "Singapore", + "Sinstorf", + "Sinthia", + "Sipane", + "Skansen", + "Slade", + "Sljeme", + "Sloterdijk", + "Soahanina", + "Soerenga", + "Sokode", + "Solna", + "Solt", + "Somone", + "Sontheim", + "Soumbedioune", + "Southbank", + "Souza", + "Spalentor", + "Spartel", + "Splott", + "Stachus", + "Stanley", + "Stanleyville", + "Staoueli", + "Steinplatz", + "Steinwerder", + "Stellingen", + "Stendal", + "Sternschanze", + "Sterrenbos", + "Stockholm", + "Stoneferry", + "Stormont", + "Stourbridge", + "Straengnaes", + "Strasbourg", + "Stratford", + "Strathcona", + "Stuivenberg", + "Stuttgart", + "Suberu", + "Sudan", + "Suelldorf", + "Sundsvall", + "Sunnycove", + "Surat", + "Surrey", + "Svedvi", + "Sya", + "Sylvania", + "Szentes", + "Tabligbo", + "Tado", + "Tafo", + "Taiping", + "Takoradi", + "Taksony", + "Tallahassee", + "Tamale", + "Tambacounda", + "Tamberma", + "Tamilnadu", + "Tampico", + "Tananarive", + "Tanger", + "Tanzania", + "Tarshyne", + "Taset", + "Taunton", + "Taylor", + "Tchad", + "Tchamba", + "Techimani", + "Teddington", + "Tees", + "Tejas", + "Teko", + "Telaviv", + "Telelkebir", + "Telhashomer", + "Teltow", + "Tema", + "Tempe", + "Tendeba", + "Tennenlohe", + "Tennessee", + "Tennyson", + "Teshie", + "Texas", + "Thayngen", + "Thetford", + "Thiaroye", + "Thies", + "Thompson", + "Tibati", + "Tienba", + "Tiergarten", + "Tiko", + "Tilburg", + "Tilene", + "Tinda", + "Tione", + "Togba", + "Togo", + "Tokoin", + "Tomegbe", + "Tomelilla", + "Tonev", + "Toowong", + "Torhout", + "Toricada", + "Tornow", + "Toronto", + "Toucra", + "Toulon", + "Tounouma", + "Tours", + "Trachau", + "Transvaal", + "Travis", + "Treforest", + "Treguier", + "Trier", + "Trimdon", + "Tripoli", + "Trotha", + "Troy", + "Truro", + "Tschangu", + "Tsevie", + "Tshiongwe", + "Tucson", + "Tudu", + "Tumodi", + "Typhi", + "Typhisuis", + "Tyresoe", + "Uccle", + "Uganda", + "Ughelli", + "Uhlenhorst", + "Uithof", + "Ullevi", + "Umbadah", + "Umbilo", + "Umhlali", + "Umhlatazana", + "Uno", + "Uppsala", + "Urbana", + "Ursenbach", + "Usumbura", + "Utah", + "Utrecht", + "Uzaramo", + "Vaertan", + "Valdosta", + "Vancouver", + "Vanier", + "Vaugirard", + "Vegesack", + "Vejle", + "Vellore", + "Veneziana", + "Verona", + "Verviers", + "Victoria", + "Victoriaborg", + "Vietnam", + "Vilvoorde", + "Vinohrady", + "Virchow", + "Virginia", + "Visby", + "Vitkin", + "Vleuten", + "Vogan", + "Volkmarsdorf", + "Volta", + "Vom", + "Voulte", + "Vridi", + "Vuadens", + "Wa", + "Waedenswil", + "Wagadugu", + "Wagenia", + "Wanatah", + "Wandsworth", + "Wangata", + "Waral", + "Warengo", + "Warmsen", + "Warnemuende", + "Warnow", + "Warragul", + "Warri", + "Washington", + "Waycross", + "Wayne", + "Wedding", + "Welikade", + "Weltevreden", + "Wenatchee", + "Wentworth", + "Wernigerode", + "Weslaco", + "Westafrica", + "Westeinde", + "Westerstede", + "Westhampton", + "Westminster", + "Weston", + "Westphalia", + "Weybridge", + "Wichita", + "Widemarsh", + "Wien", + "Wil", + "Wilhelmsburg", + "Willamette", + "Willemstad", + "Wilmington", + "Wimborne", + "Windermere", + "Windsheim", + "Wingrove", + "Winneba", + "Winnipeg", + "Winslow", + "Winston", + "Winterthur", + "Wippra", + "Wisbech", + "Wohlen", + "Woodhull", + "Woodinville", + "Worb", + "Worthington", + "Woumbou", + "Wuiti", + "Wuppertal", + "Wyldegreen", + "Yaba", + "Yalding", + "Yaounde", + "Yardley", + "Yarm", + "Yarrabah", + "Yeerongpilly", + "Yehuda", + "Yekepa", + "Yellowknife", + "Yenne", + "Yerba", + "Yoff", + "Yokoe", + "Yolo", + "Yombesali", + "Yopougon", + "York", + "Yoruba", + "Yovokome", + "Yundum", + "Zadar", + "Zaiman", + "Zaire", + "Zanzibar", + "Zaria", + "Zega", + "Zehlendorf", + "Zerifin", + "Zigong", + "Zinder", + "Zongo", + "Zuilen", + "Zwickau" +) library(dplyr) salmonellae <- tibble( @@ -1562,20 +1564,22 @@ salmonellae <- tibble( source = "manually added", status = "accepted", lpsn_parent = 784857, - gbif_parent = 9701185 + gbif_parent = 9701185 ) -salmonellae <- salmonellae %>% +salmonellae <- salmonellae %>% # remove e.g. Salmonella Enteritidis if Salmonella enteritidis already existed filter(!tolower(fullname) %in% tolower(AMR::microorganisms$fullname)) -groups <- c("Paratyphi A", - "Paratyphi B", - "Paratyphi C", - "Group B", - "Group C", - "Group D") -salmonellae <- salmonellae %>% +groups <- c( + "Paratyphi A", + "Paratyphi B", + "Paratyphi C", + "Group B", + "Group C", + "Group D" +) +salmonellae <- salmonellae %>% bind_rows(tibble( genus = "Salmonella", species = groups, diff --git a/man/add_custom_microorganisms.Rd b/man/add_custom_microorganisms.Rd index 81f63b6e..1435bab9 100755 --- a/man/add_custom_microorganisms.Rd +++ b/man/add_custom_microorganisms.Rd @@ -58,8 +58,9 @@ mo_name("Enterobacter asburiae/cloacae") # now add a custom entry - it will be considered by as.mo() and # all mo_*() functions add_custom_microorganisms( - data.frame(genus = "Enterobacter", - species = "asburiae/cloacae" + data.frame( + genus = "Enterobacter", + species = "asburiae/cloacae" ) ) @@ -81,8 +82,10 @@ mo_info("Enterobacter asburiae/cloacae") # the function tries to be forgiving: add_custom_microorganisms( - data.frame(GENUS = "BACTEROIDES / PARABACTEROIDES SLASHLINE", - SPECIES = "SPECIES") + data.frame( + GENUS = "BACTEROIDES / PARABACTEROIDES SLASHLINE", + SPECIES = "SPECIES" + ) ) mo_name("BACTEROIDES / PARABACTEROIDES") mo_rank("BACTEROIDES / PARABACTEROIDES") @@ -93,9 +96,11 @@ mo_family("Bacteroides/Parabacteroides") # for groups and complexes, set them as species or subspecies: add_custom_microorganisms( - data.frame(genus = "Citrobacter", - species = c("freundii", "braakii complex"), - subspecies = c("complex", "")) + data.frame( + genus = "Citrobacter", + species = c("freundii", "braakii complex"), + subspecies = c("complex", "") + ) ) mo_name(c("C. freundii complex", "C. braakii complex")) mo_species(c("C. freundii complex", "C. braakii complex")) diff --git a/man/antibiotic_class_selectors.Rd b/man/antibiotic_class_selectors.Rd index df584cbe..63789862 100755 --- a/man/antibiotic_class_selectors.Rd +++ b/man/antibiotic_class_selectors.Rd @@ -214,20 +214,17 @@ example_isolates[, ab_selector(oral_ddd > 1 & oral_units == "g")] # dplyr ------------------------------------------------------------------- \donttest{ if (require("dplyr")) { - # get AMR for all aminoglycosides e.g., per ward: example_isolates \%>\% group_by(ward) \%>\% summarise(across(aminoglycosides(), resistance)) } if (require("dplyr")) { - # You can combine selectors with '&' to be more specific: example_isolates \%>\% select(penicillins() & administrable_per_os()) } if (require("dplyr")) { - # get AMR for only drugs that matter - no intrinsic resistance: example_isolates \%>\% filter(mo_genus() \%in\% c("Escherichia", "Klebsiella")) \%>\% @@ -235,7 +232,6 @@ if (require("dplyr")) { summarise(across(not_intrinsic_resistant(), resistance)) } if (require("dplyr")) { - # get susceptibility for antibiotics whose name contains "trim": example_isolates \%>\% filter(first_isolate()) \%>\% @@ -243,19 +239,16 @@ if (require("dplyr")) { summarise(across(ab_selector(name \%like\% "trim"), susceptibility)) } if (require("dplyr")) { - # this will select columns 'IPM' (imipenem) and 'MEM' (meropenem): example_isolates \%>\% select(carbapenems()) } if (require("dplyr")) { - # this will select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB': example_isolates \%>\% select(mo, aminoglycosides()) } if (require("dplyr")) { - # any() and all() work in dplyr's filter() too: example_isolates \%>\% filter( @@ -264,25 +257,21 @@ if (require("dplyr")) { ) } if (require("dplyr")) { - # also works with c(): example_isolates \%>\% filter(any(c(carbapenems(), aminoglycosides()) == "R")) } if (require("dplyr")) { - # not setting any/all will automatically apply all(): example_isolates \%>\% filter(aminoglycosides() == "R") } if (require("dplyr")) { - # this will select columns 'mo' and all antimycobacterial drugs ('RIF'): example_isolates \%>\% select(mo, ab_class("mycobact")) } if (require("dplyr")) { - # get bug/drug combinations for only glycopeptides in Gram-positives: example_isolates \%>\% filter(mo_is_gram_positive()) \%>\% @@ -298,7 +287,6 @@ if (require("dplyr")) { select(penicillins()) # only the 'J01CA01' column will be selected } if (require("dplyr")) { - # with recent versions of dplyr this is all equal: x <- example_isolates[carbapenems() == "R", ] y <- example_isolates \%>\% filter(carbapenems() == "R") diff --git a/man/as.ab.Rd b/man/as.ab.Rd index 2cce65e3..85ba01de 100755 --- a/man/as.ab.Rd +++ b/man/as.ab.Rd @@ -91,7 +91,6 @@ ab_name("eryt") \donttest{ if (require("dplyr")) { - # you can quickly rename 'sir' columns using set_ab_names() with dplyr: example_isolates \%>\% set_ab_names(where(is.sir), property = "atc") diff --git a/man/as.sir.Rd b/man/as.sir.Rd index 517a69a7..b34ec3e8 100644 --- a/man/as.sir.Rd +++ b/man/as.sir.Rd @@ -125,7 +125,7 @@ your_data \%>\% mutate(across(where(is.disk), as.sir)) \item For \strong{interpreting a complete data set}, with automatic determination of MIC values, disk diffusion diameters, microorganism names or codes, and antimicrobial test results. This is done very simply by running \code{as.sir(your_data)}. } -For points 2, 3 and 4: Use \code{\link[=sir_interpretation_history]{sir_interpretation_history()}} to retrieve a \link{data.frame} (or \link[tibble:tibble]{tibble} if the \code{tibble} package is installed) with all results of the last \code{\link[=as.sir]{as.sir()}} call. +\strong{For points 2, 3 and 4: Use \code{\link[=sir_interpretation_history]{sir_interpretation_history()}}} to retrieve a \link{data.frame} (or \link[tibble:tibble]{tibble} if the \code{tibble} package is installed) with all results of the last \code{\link[=as.sir]{as.sir()}} call. } \subsection{Supported Guidelines}{ diff --git a/man/first_isolate.Rd b/man/first_isolate.Rd index d8eb9e03..8069d151 100755 --- a/man/first_isolate.Rd +++ b/man/first_isolate.Rd @@ -179,13 +179,11 @@ if (require("dplyr")) { filter(first_isolate()) } if (require("dplyr")) { - # short-hand version: example_isolates \%>\% filter_first_isolate(info = FALSE) } if (require("dplyr")) { - # flag the first isolates per group: example_isolates \%>\% group_by(ward) \%>\% diff --git a/man/get_episode.Rd b/man/get_episode.Rd index f2523828..3cef19c9 100755 --- a/man/get_episode.Rd +++ b/man/get_episode.Rd @@ -44,11 +44,12 @@ is_new_episode(df$date, episode_days = 60) # TRUE/FALSE df[which(get_episode(df$date, 60) == 3), ] # the functions also work for less than a day, e.g. to include one per hour: -get_episode(c( - Sys.time(), - Sys.time() + 60 * 60 -), -episode_days = 1 / 24 +get_episode( + c( + Sys.time(), + Sys.time() + 60 * 60 + ), + episode_days = 1 / 24 ) \donttest{ @@ -85,7 +86,6 @@ if (require("dplyr")) { ) } if (require("dplyr")) { - # grouping on patients and microorganisms leads to the same # results as first_isolate() when using 'episode-based': x <- df \%>\% @@ -102,7 +102,6 @@ if (require("dplyr")) { identical(x, y) } if (require("dplyr")) { - # but is_new_episode() has a lot more flexibility than first_isolate(), # since you can now group on anything that seems relevant: df \%>\% diff --git a/man/ggplot_sir.Rd b/man/ggplot_sir.Rd index 98bd3665..bc60a213 100644 --- a/man/ggplot_sir.Rd +++ b/man/ggplot_sir.Rd @@ -138,13 +138,11 @@ At default, the names of antibiotics will be shown on the plots using \code{\lin \examples{ \donttest{ if (require("ggplot2") && require("dplyr")) { - # get antimicrobial results for drugs against a UTI: ggplot(example_isolates \%>\% select(AMX, NIT, FOS, TMP, CIP)) + geom_sir() } if (require("ggplot2") && require("dplyr")) { - # prettify the plot using some additional functions: df <- example_isolates \%>\% select(AMX, NIT, FOS, TMP, CIP) ggplot(df) + @@ -155,21 +153,18 @@ if (require("ggplot2") && require("dplyr")) { theme_sir() } if (require("ggplot2") && require("dplyr")) { - # or better yet, simplify this using the wrapper function - a single command: example_isolates \%>\% select(AMX, NIT, FOS, TMP, CIP) \%>\% ggplot_sir() } if (require("ggplot2") && require("dplyr")) { - # get only proportions and no counts: example_isolates \%>\% select(AMX, NIT, FOS, TMP, CIP) \%>\% ggplot_sir(datalabels = FALSE) } if (require("ggplot2") && require("dplyr")) { - # add other ggplot2 arguments as you like: example_isolates \%>\% select(AMX, NIT, FOS, TMP, CIP) \%>\% @@ -182,14 +177,12 @@ if (require("ggplot2") && require("dplyr")) { ) } if (require("ggplot2") && require("dplyr")) { - # you can alter the colours with colour names: example_isolates \%>\% select(AMX) \%>\% ggplot_sir(colours = c(SI = "yellow")) } if (require("ggplot2") && require("dplyr")) { - # but you can also use the built-in colour-blind friendly colours for # your plots, where "S" is green, "I" is yellow and "R" is red: data.frame( @@ -202,7 +195,6 @@ if (require("ggplot2") && require("dplyr")) { scale_sir_colours(Value4 = "S", Value5 = "I", Value6 = "R") } if (require("ggplot2") && require("dplyr")) { - # resistance of ciprofloxacine per age group example_isolates \%>\% mutate(first_isolate = first_isolate()) \%>\% @@ -216,14 +208,12 @@ if (require("ggplot2") && require("dplyr")) { ggplot_sir(x = "age_group") } if (require("ggplot2") && require("dplyr")) { - # a shorter version which also adjusts data label colours: example_isolates \%>\% select(AMX, NIT, FOS, TMP, CIP) \%>\% ggplot_sir(colours = FALSE) } if (require("ggplot2") && require("dplyr")) { - # it also supports groups (don't forget to use the group var on `x` or `facet`): example_isolates \%>\% filter(mo_is_gram_negative(), ward != "Outpatient") \%>\% diff --git a/man/mo_property.Rd b/man/mo_property.Rd index ec46c967..e59e6f79 100755 --- a/man/mo_property.Rd +++ b/man/mo_property.Rd @@ -405,7 +405,6 @@ mo_species("EHEC") mo_fullname("K. pneu rh") mo_shortname("K. pneu rh") - \donttest{ # Becker classification, see ?as.mo ---------------------------------------- diff --git a/man/proportion.Rd b/man/proportion.Rd index 419089c8..ac0f6e96 100755 --- a/man/proportion.Rd +++ b/man/proportion.Rd @@ -204,7 +204,6 @@ if (require("dplyr")) { ) } if (require("dplyr")) { - # scoped dplyr verbs with antibiotic selectors # (you could also use across() of course) example_isolates \%>\% diff --git a/tests/tinytest.R b/tests/tinytest.R index a62d4bb3..01ef1c7f 100644 --- a/tests/tinytest.R +++ b/tests/tinytest.R @@ -34,7 +34,7 @@ # test only on GitHub Actions and at using RStudio jobs - not on CRAN as tests are lengthy if (tryCatch(isTRUE(AMR:::import_fn("isJob", "rstudioapi")()), error = function(e) FALSE) || - identical(Sys.getenv("R_RUN_TINYTEST"), "true")) { + identical(Sys.getenv("R_RUN_TINYTEST"), "true")) { # env var 'R_LIBS_USER' got overwritten during 'R CMD check' in GitHub Actions, so: .libPaths(c(Sys.getenv("R_LIBS_USER_GH_ACTIONS"), .libPaths())) if (AMR:::pkg_is_available("tinytest", also_load = TRUE)) { diff --git a/vignettes/AMR.Rmd b/vignettes/AMR.Rmd index 25da5af9..008835c6 100755 --- a/vignettes/AMR.Rmd +++ b/vignettes/AMR.Rmd @@ -48,15 +48,16 @@ For this tutorial, we will create fake demonstration data to work with. You can skip to [Cleaning the data](#cleaning-the-data) if you already have your own data ready. If you start your analysis, try to make the structure of your data generally look like this: ```{r example table, echo = FALSE, results = 'asis'} -knitr::kable(data.frame( - date = Sys.Date(), - patient_id = c("abcd", "abcd", "efgh"), - mo = "Escherichia coli", - AMX = c("S", "S", "R"), - CIP = c("S", "R", "S"), - stringsAsFactors = FALSE -), -align = "c" +knitr::kable( + data.frame( + date = Sys.Date(), + patient_id = c("abcd", "abcd", "efgh"), + mo = "Escherichia coli", + AMX = c("S", "S", "R"), + CIP = c("S", "R", "S"), + stringsAsFactors = FALSE + ), + align = "c" ) ``` @@ -129,14 +130,15 @@ sample_size <- 20000 data <- data.frame( date = sample(dates, size = sample_size, replace = TRUE), patient_id = sample(patients, size = sample_size, replace = TRUE), - hospital = sample(c( - "Hospital A", - "Hospital B", - "Hospital C", - "Hospital D" - ), - size = sample_size, replace = TRUE, - prob = c(0.30, 0.35, 0.15, 0.20) + hospital = sample( + c( + "Hospital A", + "Hospital B", + "Hospital C", + "Hospital D" + ), + size = sample_size, replace = TRUE, + prob = c(0.30, 0.35, 0.15, 0.20) ), bacteria = sample(bacteria, size = sample_size, replace = TRUE, @@ -293,10 +295,11 @@ data_1st %>% ``` ```{r bug_drg 2b, echo = FALSE, results = 'asis'} -knitr::kable(data_1st %>% - filter(any(aminoglycosides() == "R")) %>% - head(), -align = "c" +knitr::kable( + data_1st %>% + filter(any(aminoglycosides() == "R")) %>% + head(), + align = "c" ) ``` @@ -309,10 +312,11 @@ data_1st %>% ``` ```{r bug_drg 1b, echo = FALSE, results = 'asis'} -knitr::kable(data_1st %>% - bug_drug_combinations() %>% - head(), -align = "c" +knitr::kable( + data_1st %>% + bug_drug_combinations() %>% + head(), + align = "c" ) ``` @@ -325,10 +329,11 @@ data_1st %>% ```{r bug_drg 3b, echo = FALSE, results = 'asis'} -knitr::kable(data_1st %>% - select(bacteria, aminoglycosides()) %>% - bug_drug_combinations(), -align = "c" +knitr::kable( + data_1st %>% + select(bacteria, aminoglycosides()) %>% + bug_drug_combinations(), + align = "c" ) ``` diff --git a/vignettes/WHONET.Rmd b/vignettes/WHONET.Rmd index 2a8e4881..17af8a39 100644 --- a/vignettes/WHONET.Rmd +++ b/vignettes/WHONET.Rmd @@ -88,11 +88,12 @@ data %>% ```{r, echo = FALSE} # on very old and some new releases of R, this may lead to an error -tryCatch(data %>% - group_by(Country) %>% - select(Country, AMP_ND2, AMC_ED20, CAZ_ED10, CIP_ED5) %>% - ggplot_sir(translate_ab = "ab", facet = "Country", datalabels = FALSE) %>% - print(), -error = function(e) base::invisible() +tryCatch( + data %>% + group_by(Country) %>% + select(Country, AMP_ND2, AMC_ED20, CAZ_ED10, CIP_ED5) %>% + ggplot_sir(translate_ab = "ab", facet = "Country", datalabels = FALSE) %>% + print(), + error = function(e) base::invisible() ) ```