P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-09 02:03:04 +02:00
Code Releases Activity

replaced bactid by mo

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2018-08-31 13:36:19 +02:00
parent 98ff131680
commit 5965d3c794
41 changed files with 786 additions and 411 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
R/data.R
View File

@ -125,7 +125,7 @@
#' A dataset containing 2,646 microorganisms. MO codes of the UMCG can be looked up using \code{\link{microorganisms.umcg}}.
#' @format A data.frame with 2,646 observations and 12 variables:
#' \describe{
#' \item{\code{bactid}}{ID of microorganism}
#' \item{\code{mo}}{ID of microorganism}
#' \item{\code{bactsys}}{Bactsyscode of microorganism}
#' \item{\code{family}}{Family name of microorganism}
#' \item{\code{genus}}{Genus name of microorganism, like \code{"Echerichia"}}
@ -140,27 +140,27 @@
#' }
# source MOLIS (LIS of Certe) - \url{https://www.certe.nl}
# new <- microorganisms %>% filter(genus == "Bacteroides") %>% .[1,]
# new[1, 'bactid'] <- "DIAPNU"
# new[1, 'mo'] <- "DIAPNU"
# new[1, 'bactsys'] <- "DIAPNU"
# new[1, 'family'] <- "Veillonellaceae"
# new[1, 'genus'] <- "Dialister"
# new[1, 'species'] <- "pneumosintes"
# new[1, 'subspecies'] <- NA
# new[1, 'fullname'] <- paste(new[1, 'genus'], new[1, 'species'])
# microorganisms <- microorganisms %>% bind_rows(new) %>% arrange(bactid)
#' @seealso \code{\link{guess_bactid}} \code{\link{antibiotics}} \code{\link{microorganisms.umcg}}
# microorganisms <- microorganisms %>% bind_rows(new) %>% arrange(mo)
#' @seealso \code{\link{guess_mo}} \code{\link{antibiotics}} \code{\link{microorganisms.umcg}}
"microorganisms"
#' Translation table for UMCG with ~1100 microorganisms
#'
#' A dataset containing all bacteria codes of UMCG MMB. These codes can be joined to data with an ID from \code{\link{microorganisms}$bactid} (using \code{\link{left_join_microorganisms}}). GLIMS codes can also be translated to valid \code{bactid}'s with \code{\link{guess_bactid}}.
#' A dataset containing all bacteria codes of UMCG MMB. These codes can be joined to data with an ID from \code{\link{microorganisms}$mo} (using \code{\link{left_join_microorganisms}}). GLIMS codes can also be translated to valid \code{mo}'s with \code{\link{guess_mo}}.
#' @format A data.frame with 1090 observations and 2 variables:
#' \describe{
#' \item{\code{mocode}}{Code of microorganism according to UMCG MMB}
#' \item{\code{bactid}}{Code of microorganism in \code{\link{microorganisms}}}
#' \item{\code{umcg}}{Code of microorganism according to UMCG MMB}
#' \item{\code{mo}}{Code of microorganism in \code{\link{microorganisms}}}
#' }
# source MOLIS (LIS of Certe) - \url{https://www.certe.nl} \cr \cr GLIMS (LIS of UMCG) - \url{https://www.umcg.nl}
#' @seealso \code{\link{guess_bactid}} \code{\link{microorganisms}}
#' @seealso \code{\link{guess_mo}} \code{\link{microorganisms}}
"microorganisms.umcg"
#' Dataset with 2000 blood culture isolates of septic patients
@ -176,7 +176,7 @@
#' \item{\code{age}}{age of the patient}
#' \item{\code{sex}}{sex of the patient}
#' \item{\code{patient_id}}{ID of the patient, first 10 characters of an SHA hash containing irretrievable information}
#' \item{\code{bactid}}{ID of microorganism, see \code{\link{microorganisms}}}
#' \item{\code{mo}}{ID of microorganism, see \code{\link{microorganisms}}}
#' \item{\code{peni:rifa}}{40 different antibiotics with class \code{rsi} (see \code{\link{as.rsi}}); these column names occur in \code{\link{antibiotics}} data set and can be translated with \code{\link{abname}}}
#' }
# source MOLIS (LIS of Certe) - \url{https://www.certe.nl}
@ -193,7 +193,7 @@
#'
#' # Add first isolates to our dataset:
#' my_data <- my_data %>%
#' mutate(first_isolates = first_isolate(my_data, "date", "patient_id", "bactid"))
#' mutate(first_isolates = first_isolate(my_data, "date", "patient_id", "mo"))
#'
#' # -------- #
#' # ANALYSIS #
@ -203,7 +203,7 @@
#' # and numbers (n) of E. coli, divided by hospital:
#'
#' my_data %>%
#' filter(bactid == guess_bactid("E. coli"),
#' filter(mo == guess_mo("E. coli"),
#' first_isolates == TRUE) %>%
#' group_by(hospital_id) %>%
#' summarise(n = n_rsi(amox),
@ -214,7 +214,7 @@
#' # percentages of E. coli, trend over the years:
#'
#' my_data %>%
#' filter(bactid == guess_bactid("E. coli"),
#' filter(mo == guess_mo("E. coli"),
#' first_isolates == TRUE) %>%
#' group_by(year = format(date, "%Y")) %>%
#' summarise(n = n_rsi(amcl),

65
R/deprecated.R Normal file
View File

@ -0,0 +1,65 @@
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Analysis #
# #
# AUTHORS #
# Berends MS (m.s.berends@umcg.nl), Luz CF (c.f.luz@umcg.nl) #
# #
# LICENCE #
# This program is free software; you can redistribute it and/or modify #
# it under the terms of the GNU General Public License version 2.0, #
# as published by the Free Software Foundation. #
# #
# This program is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# ==================================================================== #
#' Deprecated functions
#'
#' These functions are \link{Deprecated}. They will be removed in a future release. Using the functions will give a warning with the name of the function it has been replaced by.
#' @export
#' @keywords internal
#' @name AMR-deprecated
#' @rdname AMR-deprecated
as.bactid <- function(...) {
.Deprecated("as.mo", package = "AMR")
as.mo(...)
}
#' @rdname AMR-deprecated
#' @export
is.bactid <- function(...) {
.Deprecated(new = "is.mo", package = "AMR")
is.mo(...)
}
#' @rdname AMR-deprecated
#' @export
guess_bactid <- function(...) {
.Deprecated(new = "guess_mo", package = "AMR")
guess_mo(...)
}
#' @rdname AMR-deprecated
#' @export
ratio <- function(x, ratio) {
.Deprecated(package = "AMR")
if (!all(is.numeric(x))) {
stop('`x` must be a vector of numeric values.')
}
if (length(ratio) == 1) {
if (ratio %like% '^([0-9]+([.][0-9]+)?[-,:])+[0-9]+([.][0-9]+)?$') {
# support for "1:2:1", "1-2-1", "1,2,1" and even "1.75:2:1.5"
ratio <- ratio %>% base::strsplit("[-,:]") %>% base::unlist() %>% base::as.double()
} else {
stop('Invalid `ratio`: ', ratio, '.')
}
}
if (length(x) != length(ratio)) {
stop('`x` and `ratio` must be of same size.')
}
base::sum(x, na.rm = TRUE) * (ratio / base::sum(ratio, na.rm = TRUE))
}

46
R/eucast.R
View File

@ -20,11 +20,12 @@
#'
#' Apply expert rules (like intrinsic resistance), as defined by the European Committee on Antimicrobial Susceptibility Testing (EUCAST, \url{http://eucast.org}), see \emph{Source}.
#' @param tbl table with antibiotic columns, like e.g. \code{amox} and \code{amcl}
#' @param col_bactid column name of the bacteria ID in \code{tbl} - values of this column should be present in \code{microorganisms$bactid}, see \code{\link{microorganisms}}
#' @param col_mo column name of the bacteria ID in \code{tbl} - values of this column should be present in \code{microorganisms$mo}, see \code{\link{microorganisms}}
#' @param info print progress
#' @param amcl,amik,amox,ampi,azit,azlo,aztr,cefa,cfep,cfot,cfox,cfra,cfta,cftr,cfur,chlo,cipr,clar,clin,clox,coli,czol,dapt,doxy,erta,eryt,fosf,fusi,gent,imip,kana,levo,linc,line,mero,mezl,mino,moxi,nali,neom,neti,nitr,norf,novo,oflo,peni,pita,poly,pris,qida,rifa,roxi,siso,teic,tetr,tica,tige,tobr,trim,trsu,vanc column names of antibiotics. Use \code{NA} to skip a column, like \code{tica = NA}. Non-existing columns will anyway be skipped. See the Antibiotics section for an explanation of the abbreviations.
#' @param amcl,amik,amox,ampi,azit,azlo,aztr,cefa,cfep,cfot,cfox,cfra,cfta,cftr,cfur,chlo,cipr,clar,clin,clox,coli,czol,dapt,doxy,erta,eryt,fosf,fusi,gent,imip,kana,levo,linc,line,mero,mezl,mino,moxi,nali,neom,neti,nitr,norf,novo,oflo,peni,pita,poly,pris,qida,rifa,roxi,siso,teic,tetr,tica,tige,tobr,trim,trsu,vanc column name of an antibiotic. Use \code{NA} to skip a column, like \code{tica = NA}. Non-existing columns will anyway be skipped. See the Antibiotics section for an explanation of the abbreviations.
#' @param col_bactid Deprecated. Use \code{col_mo} instead.
#' @param ... parameters that are passed on to \code{EUCAST_rules}
#' @section Abbrevations of antibiotics:
#' @section Antibiotics:
#' Abbrevations of the column containing antibiotics:
#'
#' \strong{amcl}: amoxicillin and beta-lactamase inhibitor (\emph{J01CR02}),
@ -102,23 +103,23 @@
#' \url{http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf}
#' @examples
#' a <- EUCAST_rules(septic_patients)
#' a <- data.frame(bactid = c("STAAUR", # Staphylococcus aureus
#' "ENCFAE", # Enterococcus faecalis
#' "ESCCOL", # Escherichia coli
#' "KLEPNE", # Klebsiella pneumoniae
#' "PSEAER"), # Pseudomonas aeruginosa
#' vanc = "-", # Vancomycin
#' amox = "-", # Amoxicillin
#' coli = "-", # Colistin
#' cfta = "-", # Ceftazidime
#' cfur = "-", # Cefuroxime
#' a <- data.frame(mo = c("STAAUR", # Staphylococcus aureus
#' "ENCFAE", # Enterococcus faecalis
#' "ESCCOL", # Escherichia coli
#' "KLEPNE", # Klebsiella pneumoniae
#' "PSEAER"), # Pseudomonas aeruginosa
#' vanc = "-", # Vancomycin
#' amox = "-", # Amoxicillin
#' coli = "-", # Colistin
#' cfta = "-", # Ceftazidime
#' cfur = "-", # Cefuroxime
#' stringsAsFactors = FALSE)
#' a
#'
#' b <- EUCAST_rules(a)
#' b
EUCAST_rules <- function(tbl,
col_bactid = 'bactid',
col_mo = 'mo',
info = TRUE,
amcl = 'amcl',
amik = 'amik',
@ -180,12 +181,17 @@ EUCAST_rules <- function(tbl,
tobr = 'tobr',
trim = 'trim',
trsu = 'trsu',
vanc = 'vanc') {
vanc = 'vanc',
col_bactid = 'bactid') {
EUCAST_VERSION <- "3.1"
if (!col_bactid %in% colnames(tbl)) {
stop('Column ', col_bactid, ' not found.', call. = FALSE)
if (col_bactid %in% colnames(tbl)) {
col_mo <- col_bactid
warning("Use of `col_bactid` is deprecated. Use `col_mo` instead.")
}
if (!col_mo %in% colnames(tbl)) {
stop('Column ', col_mo, ' not found.', call. = FALSE)
}
# check columns
@ -274,10 +280,10 @@ EUCAST_rules <- function(tbl,
}
# join to microorganisms data set
if (!tbl %>% pull(col_bactid) %>% is.bactid()) {
warning("Improve integrity of the `", col_bactid, "` column by transforming it with 'as.bactid'.")
if (!tbl %>% pull(col_mo) %>% is.mo()) {
warning("Improve integrity of the `", col_mo, "` column by transforming it with 'as.mo'.")
}
tbl <- tbl %>% left_join_microorganisms(by = col_bactid, suffix = c("_tempmicroorganisms", ""))
tbl <- tbl %>% left_join_microorganisms(by = col_mo, suffix = c("_tempmicroorganisms", ""))
# antibiotic classes
aminoglycosides <- c(tobr, gent, kana, neom, neti, siso)

30
R/first_isolate.R
View File

@ -22,7 +22,7 @@
#' @param tbl a \code{data.frame} containing isolates.
#' @param col_date column name of the result date (or date that is was received on the lab)
#' @param col_patient_id column name of the unique IDs of the patients
#' @param col_bactid column name of the unique IDs of the microorganisms: \code{bactid}'s. If this column has another class than \code{"bactid"}, values will be coerced using \code{\link{as.bactid}}.
#' @param col_mo column name of the unique IDs of the microorganisms, see \code{\link{mo}}. If this column has another class than \code{"mo"}, values will be coerced using \code{\link{as.mo}}.
#' @param col_testcode column name of the test codes. Use \code{col_testcode = NA} to \strong{not} exclude certain test codes (like test codes for screening). In that case \code{testcodes_exclude} will be ignored. Supports tidyverse-like quotation.
#' @param col_specimen column name of the specimen type or group
#' @param col_icu column name of the logicals (\code{TRUE}/\code{FALSE}) whether a ward or department is an Intensive Care Unit (ICU)
@ -36,8 +36,9 @@
#' @param ignore_I logical to determine whether antibiotic interpretations with \code{"I"} will be ignored when \code{type = "keyantibiotics"}, see Details
#' @param points_threshold points until the comparison of key antibiotics will lead to inclusion of an isolate when \code{type = "points"}, see Details
#' @param info print progress
#' @param col_genus (deprecated, use \code{col_bactid} instead) column name of the genus of the microorganisms
#' @param col_species (deprecated, use \code{col_bactid} instead) column name of the species of the microorganisms
#' @param col_bactid (deprecated, use \code{col_mo} instead)
#' @param col_genus (deprecated, use \code{col_mo} instead) column name of the genus of the microorganisms
#' @param col_species (deprecated, use \code{col_mo} instead) column name of the species of the microorganisms
#' @details \strong{WHY THIS IS SO IMPORTANT} \cr
#' To conduct an analysis of antimicrobial resistance, you should only include the first isolate of every patient per episode \href{https://www.ncbi.nlm.nih.gov/pubmed/17304462}{[1]}. If you would not do this, you could easily get an overestimate or underestimate of the resistance of an antibiotic. Imagine that a patient was admitted with an MRSA and that it was found in 5 different blood cultures the following week. The resistance percentage of oxacillin of all \emph{S. aureus} isolates would be overestimated, because you included this MRSA more than once. It would be \href{https://en.wikipedia.org/wiki/Selection_bias}{selection bias}.
#' @section Key antibiotics:
@ -63,7 +64,7 @@
#' mutate(first_isolate = first_isolate(.,
#' col_date = "date",
#' col_patient_id = "patient_id",
#' col_bactid = "bactid"))
#' col_mo = "mo"))
#'
#' # Now let's see if first isolates matter:
#' A <- my_patients %>%
@ -126,7 +127,7 @@
first_isolate <- function(tbl,
col_date,
col_patient_id,
col_bactid = NA,
col_mo = NA,
col_testcode = NA,
col_specimen = NA,
col_icu = NA,
@ -140,12 +141,17 @@ first_isolate <- function(tbl,
ignore_I = TRUE,
points_threshold = 2,
info = TRUE,
col_bactid = NA,
col_genus = NA,
col_species = NA) {
if (!is.na(col_bactid)) {
col_mo <- col_bactid
warning("Use of `col_bactid` is deprecated. Use `col_mo` instead.")
}
# bactid OR genus+species must be available
if (is.na(col_bactid) & (is.na(col_genus) | is.na(col_species))) {
stop('`col_bactid` or both `col_genus` and `col_species` must be available.')
if (is.na(col_mo) & (is.na(col_genus) | is.na(col_species))) {
stop('`col_mo` or both `col_genus` and `col_species` must be available.')
}
# check if columns exist
@ -163,19 +169,19 @@ first_isolate <- function(tbl,
check_columns_existance(col_date)
check_columns_existance(col_patient_id)
check_columns_existance(col_bactid)
check_columns_existance(col_mo)
check_columns_existance(col_genus)
check_columns_existance(col_species)
check_columns_existance(col_testcode)
check_columns_existance(col_icu)
check_columns_existance(col_keyantibiotics)
if (!is.na(col_bactid)) {
if (!tbl %>% pull(col_bactid) %>% is.bactid()) {
warning("Improve integrity of the `", col_bactid, "` column by transforming it with 'as.bactid'.")
if (!is.na(col_mo)) {
if (!tbl %>% pull(col_mo) %>% is.mo()) {
warning("Improve integrity of the `", col_mo, "` column by transforming it with 'as.mo'.")
}
# join to microorganisms data set
tbl <- tbl %>% left_join_microorganisms(by = col_bactid)
tbl <- tbl %>% left_join_microorganisms(by = col_mo)
col_genus <- "genus"
col_species <- "species"
}

4
R/freq.R
View File

@ -76,7 +76,7 @@
#' # you could also use `select` or `pull` to get your variables
#' septic_patients %>%
#' filter(hospital_id == "A") %>%
#' select(bactid) %>%
#' select(mo) %>%
#' freq()
#'
#' # multiple selected variables will be pasted together
@ -88,7 +88,7 @@
#' # get top 10 bugs of hospital A as a vector
#' septic_patients %>%
#' filter(hospital_id == "A") %>%
#' freq(bactid) %>%
#' freq(mo) %>%
#' top_freq(10)
#'
#' # save frequency table to an object

8
R/ggplot_rsi.R
View File

@ -100,14 +100,14 @@
#' # genuine analysis: check 2 most prevalent microorganisms
#' septic_patients %>%
#' # create new bacterial ID's, with all CoNS under the same group (Becker et al.)
#' mutate(bactid = as.bactid(bactid, Becker = TRUE)) %>%
#' mutate(mo = as.mo(mo, Becker = TRUE)) %>%
#' # filter on top 2 bacterial ID's
#' filter(bactid %in% top_freq(freq(.$bactid), 2)) %>%
#' filter(mo %in% top_freq(freq(.$mo), 2)) %>%
#' # determine first isolates
#' mutate(first_isolate = first_isolate(.,
#' col_date = "date",
#' col_patient_id = "patient_id",
#' col_bactid = "bactid")) %>%
#' col_mo = "mo")) %>%
#' # filter on first isolates
#' filter(first_isolate == TRUE) %>%
#' # join the `microorganisms` data set
@ -121,7 +121,7 @@
#' ggplot_rsi(x = "Antibiotic",
#' facet = "mo") +
#' labs(title = "AMR of Top Two Microorganisms In Blood Culture Isolates",
#' subtitle = "Only First Isolates, CoNS grouped according to Becker et al.",
#' subtitle = "Only First Isolates, CoNS grouped according to Becker et al. (2014)",
#' x = "Microorganisms")
#' }
ggplot_rsi <- function(data,

26
R/join_microorganisms.R
View File

@ -5,7 +5,7 @@
#' @name join
#' @aliases join inner_join
#' @param x existing table to join, also supports character vectors
#' @param by a variable to join by - could be a column name of \code{x} with values that exist in \code{microorganisms$bactid} (like \code{by = "bacteria_id"}), or another column in \code{\link{microorganisms}} (but then it should be named, like \code{by = c("my_genus_species" = "fullname")})
#' @param by a variable to join by - could be a column name of \code{x} with values that exist in \code{microorganisms$mo} (like \code{by = "bacteria_id"}), or another column in \code{\link{microorganisms}} (but then it should be named, like \code{by = c("my_genus_species" = "fullname")})
#' @param suffix if there are non-joined duplicate variables in \code{x} and \code{y}, these suffixes will be added to the output to disambiguate them. Should be a character vector of length 2.
#' @param ... other parameters to pass on to \code{dplyr::\link[dplyr]{join}}.
#' @details As opposed to the \code{\link[dplyr]{join}} functions of \code{dplyr}, characters vectors are supported and at default existing columns will get a suffix \code{"2"} and the newly joined columns will not get a suffix. See \code{\link[dplyr]{join}} for more information.
@ -25,9 +25,9 @@
#' colnames(df)
#' df2 <- left_join_microorganisms(df, "bacteria_id")
#' colnames(df2)
inner_join_microorganisms <- function(x, by = 'bactid', suffix = c("2", ""), ...) {
inner_join_microorganisms <- function(x, by = 'mo', suffix = c("2", ""), ...) {
if (!any(class(x) %in% c("data.frame", "matrix"))) {
x <- data.frame(bactid = as.character(x), stringsAsFactors = FALSE)
x <- data.frame(mo = as.character(x), stringsAsFactors = FALSE)
}
# no name set to `by` parameter
if (is.null(names(by))) {
@ -47,9 +47,9 @@ inner_join_microorganisms <- function(x, by = 'bactid', suffix = c("2", ""), ...
#' @rdname join
#' @export
left_join_microorganisms <- function(x, by = 'bactid', suffix = c("2", ""), ...) {
left_join_microorganisms <- function(x, by = 'mo', suffix = c("2", ""), ...) {
if (!any(class(x) %in% c("data.frame", "matrix"))) {
x <- data.frame(bactid = as.character(x), stringsAsFactors = FALSE)
x <- data.frame(mo = as.character(x), stringsAsFactors = FALSE)
}
# no name set to `by` parameter
if (is.null(names(by))) {
@ -69,9 +69,9 @@ left_join_microorganisms <- function(x, by = 'bactid', suffix = c("2", ""), ...)
#' @rdname join
#' @export
right_join_microorganisms <- function(x, by = 'bactid', suffix = c("2", ""), ...) {
right_join_microorganisms <- function(x, by = 'mo', suffix = c("2", ""), ...) {
if (!any(class(x) %in% c("data.frame", "matrix"))) {
x <- data.frame(bactid = as.character(x), stringsAsFactors = FALSE)
x <- data.frame(mo = as.character(x), stringsAsFactors = FALSE)
}
# no name set to `by` parameter
if (is.null(names(by))) {
@ -91,9 +91,9 @@ right_join_microorganisms <- function(x, by = 'bactid', suffix = c("2", ""), ...
#' @rdname join
#' @export
full_join_microorganisms <- function(x, by = 'bactid', suffix = c("2", ""), ...) {
full_join_microorganisms <- function(x, by = 'mo', suffix = c("2", ""), ...) {
if (!any(class(x) %in% c("data.frame", "matrix"))) {
x <- data.frame(bactid = as.character(x), stringsAsFactors = FALSE)
x <- data.frame(mo = as.character(x), stringsAsFactors = FALSE)
}
# no name set to `by` parameter
if (is.null(names(by))) {
@ -113,9 +113,9 @@ full_join_microorganisms <- function(x, by = 'bactid', suffix = c("2", ""), ...)
#' @rdname join
#' @export
semi_join_microorganisms <- function(x, by = 'bactid', ...) {
semi_join_microorganisms <- function(x, by = 'mo', ...) {
if (!any(class(x) %in% c("data.frame", "matrix"))) {
x <- data.frame(bactid = as.character(x), stringsAsFactors = FALSE)
x <- data.frame(mo = as.character(x), stringsAsFactors = FALSE)
}
# no name set to `by` parameter
if (is.null(names(by))) {
@ -131,9 +131,9 @@ semi_join_microorganisms <- function(x, by = 'bactid', ...) {
#' @rdname join
#' @export
anti_join_microorganisms <- function(x, by = 'bactid', ...) {
anti_join_microorganisms <- function(x, by = 'mo', ...) {
if (!any(class(x) %in% c("data.frame", "matrix"))) {
x <- data.frame(bactid = as.character(x), stringsAsFactors = FALSE)
x <- data.frame(mo = as.character(x), stringsAsFactors = FALSE)
}
# no name set to `by` parameter
if (is.null(names(by))) {

19
R/key_antibiotics.R
View File

@ -52,9 +52,9 @@
#' mutate(keyab = key_antibiotics(.)) %>%
#' mutate(
#' # now calculate first isolates
#' first_regular = first_isolate(., "date", "patient_id", "bactid"),
#' first_regular = first_isolate(., "date", "patient_id", "mo"),
#' # and first WEIGHTED isolates
#' first_weighted = first_isolate(., "date", "patient_id", "bactid",
#' first_weighted = first_isolate(., "date", "patient_id", "mo",
#' col_keyantibiotics = "keyab")
#' )
#'
@ -73,7 +73,7 @@
#' key_antibiotics_equal(strainA, strainB, ignore_I = FALSE)
#' # FALSE, because I is not ignored and so the 4th value differs
key_antibiotics <- function(tbl,
col_bactid = "bactid",
col_mo = "mo",
universal_1 = "amox",
universal_2 = "amcl",
universal_3 = "cfur",
@ -92,10 +92,15 @@ key_antibiotics <- function(tbl,
GramNeg_4 = "cfot",
GramNeg_5 = "cfta",
GramNeg_6 = "mero",
warnings = TRUE) {
warnings = TRUE,
col_bactid = "bactid") {
if (!col_bactid %in% colnames(tbl)) {
stop('Column ', col_bactid, ' not found.', call. = FALSE)
if (col_bactid %in% colnames(tbl)) {
col_mo <- col_bactid
warning("Use of `col_bactid` is deprecated. Use `col_mo` instead.")
}
if (!col_mo %in% colnames(tbl)) {
stop('Column ', col_mo, ' not found.', call. = FALSE)
}
# check columns
@ -136,7 +141,7 @@ key_antibiotics <- function(tbl,
gram_negative <- gram_negative[!is.na(gram_negative)]
# join microorganisms
tbl <- tbl %>% left_join_microorganisms(col_bactid)
tbl <- tbl %>% left_join_microorganisms(col_mo)
tbl$key_ab <- NA_character_

22
R/mdro.R
View File

@ -21,10 +21,11 @@
#' Determine which isolates are multidrug-resistant organisms (MDRO) according to country-specific guidelines.
#' @param tbl table with antibiotic columns, like e.g. \code{amox} and \code{amcl}
#' @param country country code to determine guidelines. EUCAST rules will be used when left empty, see Details. Should be or a code from the \href{https://en.wikipedia.org/wiki/ISO_3166-1_alpha-2#Officially_assigned_code_elements}{list of ISO 3166-1 alpha-2 country codes}. Case-insensitive. Currently supported are \code{de} (Germany) and \code{nl} (the Netherlands).
#' @param col_bactid column name of the bacteria ID in \code{tbl} - values of this column should be present in \code{microorganisms$bactid}, see \code{\link{microorganisms}}
#' @param info print progress
#' @param amcl,amik,amox,ampi,azit,aztr,cefa,cfra,cfep,cfot,cfox,cfta,cftr,cfur,chlo,cipr,clar,clin,clox,coli,czol,dapt,doxy,erta,eryt,fosf,fusi,gent,imip,kana,levo,linc,line,mero,metr,mino,moxi,nali,neom,neti,nitr,novo,norf,oflo,peni,pita,poly,qida,rifa,roxi,siso,teic,tetr,tica,tige,tobr,trim,trsu,vanc column names of antibiotics. column names of antibiotics
#' @inheritParams EUCAST_rules
#' @param metr column name of an antibiotic. Use \code{NA} to skip a column, like \code{tica = NA}. Non-existing columns will anyway be skipped. See the Antibiotics section for an explanation of the abbreviations.
#' @param ... parameters that are passed on to methods
#' @inheritSection EUCAST_rules Antibiotics
#' @details When \code{country} will be left blank, guidelines will be taken from EUCAST Expert Rules Version 3.1 "Intrinsic Resistance and Exceptional Phenotypes Tables" (\url{http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf}).
#' @return Ordered factor with levels \code{Unknown < Negative < Unconfirmed < Positive}.
#' @rdname MDRO
@ -34,10 +35,10 @@
#'
#' septic_patients %>%
#' mutate(EUCAST = MDRO(.),
#' BRMO = MDRO(., "nl"))
#' BRMO = BRMO(.))
MDRO <- function(tbl,
country = NULL,
col_bactid = 'bactid',
col_mo = 'mo',
info = TRUE,
amcl = 'amcl',
amik = 'amik',
@ -97,10 +98,15 @@ MDRO <- function(tbl,
tobr = 'tobr',
trim = 'trim',
trsu = 'trsu',
vanc = 'vanc') {
vanc = 'vanc',
col_bactid = 'bactid') {
if (!col_bactid %in% colnames(tbl)) {
stop('Column ', col_bactid, ' not found.', call. = FALSE)
if (col_bactid %in% colnames(tbl)) {
col_mo <- col_bactid
warning("Use of `col_bactid` is deprecated. Use `col_mo` instead.")
}
if (!col_mo %in% colnames(tbl)) {
stop('Column ', col_mo, ' not found.', call. = FALSE)
}
# strip whitespaces
@ -249,7 +255,7 @@ MDRO <- function(tbl,
}
# join microorganisms
tbl <- tbl %>% left_join_microorganisms(col_bactid)
tbl <- tbl %>% left_join_microorganisms(col_mo)
tbl$MDRO <- NA_integer_

134
R/bactid.R → R/mo.R
View File

@ -16,18 +16,18 @@
# GNU General Public License for more details. #
# ==================================================================== #
#' Transform to bacteria ID
#' Transform to microorganism ID
#'
#' Use this function to determine a valid ID based on a genus (and species). This input can be a full name (like \code{"Staphylococcus aureus"}), an abbreviated name (like \code{"S. aureus"}), or just a genus. You could also \code{\link{select}} a genus and species column, zie Examples.
#' @param x a character vector or a dataframe with one or two columns
#' @param Becker a logical to indicate whether \emph{Staphylococci} should be categorised into Coagulase Negative \emph{Staphylococci} ("CoNS") and Coagulase Positive \emph{Staphylococci} ("CoPS") instead of their own species, according to Karsten Becker \emph{et al.} [1]. This excludes \emph{Staphylococcus aureus} at default, use \code{Becker = "all"} to also categorise \emph{S. aureus} as "CoPS".
#' @param Lancefield a logical to indicate whether beta-haemolytic \emph{Streptococci} should be categorised into Lancefield groups instead of their own species, according to Rebecca C. Lancefield [2]. These \emph{Streptococci} will be categorised in their first group, i.e. \emph{Streptococcus dysgalactiae} will be group C, although officially it was also categorised into groups G and L. Groups D and E will be ignored, since they are \emph{Enterococci}.
#' @rdname as.bactid
#' @aliases bactid
#' @keywords bactid Becker becker Lancefield lancefield guess
#' @details \code{guess_bactid} is an alias of \code{as.bactid}.
#' @rdname as.mo
#' @aliases mo
#' @keywords mo Becker becker Lancefield lancefield guess
#' @details \code{guess_mo} is an alias of \code{as.mo}.
#'
#' Use the \code{\link{mo_property}} functions to get properties based on the returned bactid, see Examples.
#' Use the \code{\link{mo_property}} functions to get properties based on the returned mo, see Examples.
#'
#' Some exceptions have been built in to get more logical results, based on prevalence of human pathogens. These are:
#' \itemize{
@ -45,51 +45,51 @@
#' \url{https://dx.doi.org/10.1084/jem.57.4.571}
#' @export
#' @importFrom dplyr %>% pull left_join
#' @return Character (vector) with class \code{"bactid"}. Unknown values will return \code{NA}.
#' @return Character (vector) with class \code{"mo"}. Unknown values will return \code{NA}.
#' @seealso \code{\link{microorganisms}} for the dataframe that is being used to determine ID's.
#' @examples
#' # These examples all return "STAAUR", the ID of S. aureus:
#' as.bactid("stau")
#' as.bactid("STAU")
#' as.bactid("staaur")
#' as.bactid("S. aureus")
#' as.bactid("S aureus")
#' as.bactid("Staphylococcus aureus")
#' as.bactid("MRSA") # Methicillin Resistant S. aureus
#' as.bactid("VISA") # Vancomycin Intermediate S. aureus
#' as.bactid("VRSA") # Vancomycin Resistant S. aureus
#' as.mo("stau")
#' as.mo("STAU")
#' as.mo("staaur")
#' as.mo("S. aureus")
#' as.mo("S aureus")
#' as.mo("Staphylococcus aureus")
#' as.mo("MRSA") # Methicillin Resistant S. aureus
#' as.mo("VISA") # Vancomycin Intermediate S. aureus
#' as.mo("VRSA") # Vancomycin Resistant S. aureus
#'
#' # guess_bactid is an alias of as.bactid and works the same
#' guess_bactid("S. epidermidis") # will remain species: STAEPI
#' guess_bactid("S. epidermidis", Becker = TRUE) # will not remain species: STACNS
#' # guess_mo is an alias of as.mo and works the same
#' guess_mo("S. epidermidis") # will remain species: STAEPI
#' guess_mo("S. epidermidis", Becker = TRUE) # will not remain species: STACNS
#'
#' guess_bactid("S. pyogenes") # will remain species: STCAGA
#' guess_bactid("S. pyogenes", Lancefield = TRUE) # will not remain species: STCGRA
#' guess_mo("S. pyogenes") # will remain species: STCAGA
#' guess_mo("S. pyogenes", Lancefield = TRUE) # will not remain species: STCGRA
#'
#' # Use mo_* functions to get a specific property based on a bactid
#' Ecoli <- as.bactid("E. coli") # returns `ESCCOL`
#' # Use mo_* functions to get a specific property based on `mo`
#' Ecoli <- as.mo("E. coli") # returns `ESCCOL`
#' mo_genus(Ecoli) # returns "Escherichia"
#' mo_gramstain(Ecoli) # returns "Negative rods"
#'
#' \dontrun{
#' df$bactid <- as.bactid(df$microorganism_name)
#' df$mo <- as.mo(df$microorganism_name)
#'
#' # the select function of tidyverse is also supported:
#' library(dplyr)
#' df$bactid <- df %>%
#' df$mo <- df %>%
#' select(microorganism_name) %>%
#' guess_bactid()
#' guess_mo()
#'
#' # and can even contain 2 columns, which is convenient for genus/species combinations:
#' df$bactid <- df %>%
#' df$mo <- df %>%
#' select(genus, species) %>%
#' guess_bactid()
#' guess_mo()
#'
#' # same result:
#' df <- df %>%
#' mutate(bactid = guess_bactid(paste(genus, species)))
#' mutate(mo = guess_mo(paste(genus, species)))
#' }
as.bactid <- function(x, Becker = FALSE, Lancefield = FALSE) {
as.mo <- function(x, Becker = FALSE, Lancefield = FALSE) {
if (NCOL(x) == 2) {
@ -111,7 +111,7 @@ as.bactid <- function(x, Becker = FALSE, Lancefield = FALSE) {
}
}
MOs <- AMR::microorganisms %>% filter(!bactid %like% '^_FAM') # dont search in those
MOs <- AMR::microorganisms %>% filter(!mo %like% '^_FAM') # dont search in those
failures <- character(0)
x_input <- x
@ -136,7 +136,7 @@ as.bactid <- function(x, Becker = FALSE, Lancefield = FALSE) {
for (i in 1:length(x)) {
if (Becker == TRUE | Becker == "all") {
mo <- suppressWarnings(guess_bactid(x_backup[i]))
mo <- suppressWarnings(guess_mo(x_backup[i]))
if (mo %like% '^STA') {
# See Source. It's this figure:
# https://www.ncbi.nlm.nih.gov/pmc/articles/PMC4187637/figure/F3/
@ -167,7 +167,7 @@ as.bactid <- function(x, Becker = FALSE, Lancefield = FALSE) {
}
if (Lancefield == TRUE) {
mo <- suppressWarnings(guess_bactid(x_backup[i]))
mo <- suppressWarnings(guess_mo(x_backup[i]))
if (mo %like% '^STC') {
# See Source
species <- left_join_microorganisms(mo)$species
@ -205,13 +205,13 @@ as.bactid <- function(x, Becker = FALSE, Lancefield = FALSE) {
failures <- c(failures, x_backup[i])
next
}
if (x_backup[i] %in% AMR::microorganisms$bactid) {
# is already a valid bactid
if (x_backup[i] %in% AMR::microorganisms$mo) {
# is already a valid mo
x[i] <- x_backup[i]
next
}
if (x_trimmed[i] %in% AMR::microorganisms$bactid) {
# is already a valid bactid
if (x_trimmed[i] %in% AMR::microorganisms$mo) {
# is already a valid mo
x[i] <- x_trimmed[i]
next
}
@ -275,14 +275,14 @@ as.bactid <- function(x, Becker = FALSE, Lancefield = FALSE) {
}
# try any match keeping spaces
found <- MOs[which(MOs$fullname %like% x_withspaces[i]),]$bactid
found <- MOs[which(MOs$fullname %like% x_withspaces[i]),]$mo
if (length(found) > 0) {
x[i] <- found[1L]
next
}
# try any match diregarding spaces
found <- MOs[which(MOs$fullname %like% x[i]),]$bactid
found <- MOs[which(MOs$fullname %like% x[i]),]$mo
if (length(found) > 0) {
x[i] <- found[1L]
next
@ -290,21 +290,21 @@ as.bactid <- function(x, Becker = FALSE, Lancefield = FALSE) {
# try exact match of only genus, with 'species' attached
# (this prevents Streptococcus from becoming Peptostreptococcus, since "p" < "s")
found <- MOs[which(MOs$fullname == x_species[i]),]$bactid
found <- MOs[which(MOs$fullname == x_species[i]),]$mo
if (length(found) > 0) {
x[i] <- found[1L]
next
}
# try any match of only genus, with 'species' attached
found <- MOs[which(MOs$fullname %like% x_species[i]),]$bactid
found <- MOs[which(MOs$fullname %like% x_species[i]),]$mo
if (length(found) > 0) {
x[i] <- found[1L]
next
}
# search for GLIMS code
found <- AMR::microorganisms.umcg[which(toupper(AMR::microorganisms.umcg$mocode) == toupper(x_trimmed[i])),]$bactid
found <- AMR::microorganisms.umcg[which(toupper(AMR::microorganisms.umcg$umcg) == toupper(x_trimmed[i])),]$mo
if (length(found) > 0) {
x[i] <- found[1L]
next
@ -317,7 +317,7 @@ as.bactid <- function(x, Becker = FALSE, Lancefield = FALSE) {
x_split[i] <- paste0(x_trimmed[i] %>% substr(1, x_length / 2) %>% trimws(),
'.* ',
x_trimmed[i] %>% substr((x_length / 2) + 1, x_length) %>% trimws())
found <- MOs[which(MOs$fullname %like% paste0('^', x_split[i])),]$bactid
found <- MOs[which(MOs$fullname %like% paste0('^', x_split[i])),]$mo
if (length(found) > 0) {
x[i] <- found[1L]
next
@ -331,7 +331,7 @@ as.bactid <- function(x, Becker = FALSE, Lancefield = FALSE) {
x_trimmed[i] <- trimws(x_trimmed[i], which = "both")
}
if (!is.na(x_trimmed[i])) {
found <- MOs[which(MOs$fullname %like% x_trimmed[i]),]$bactid
found <- MOs[which(MOs$fullname %like% x_trimmed[i]),]$mo
if (length(found) > 0) {
x[i] <- found[1L]
next
@ -346,7 +346,7 @@ as.bactid <- function(x, Becker = FALSE, Lancefield = FALSE) {
failures <- failures[!failures %in% c(NA, NULL, NaN)]
if (length(failures) > 0) {
warning("These values could not be coerced to a valid bactid: ",
warning("These values could not be coerced to a valid mo: ",
paste('"', unique(failures), '"', sep = "", collapse = ', '),
".",
call. = FALSE)
@ -364,19 +364,51 @@ as.bactid <- function(x, Becker = FALSE, Lancefield = FALSE) {
by = "input") %>%
pull(found)
class(x) <- "bactid"
class(x) <- "mo"
attr(x, 'package') <- 'AMR'
x
}
#' @rdname as.bactid
#' @rdname as.mo
#' @export
guess_bactid <- as.bactid
is.mo <- function(x) {
# bactid for older releases
# remove when is.bactid will be removed
identical(class(x), "mo") | identical(class(x), "bactid")
}
#' @rdname as.bactid
#' @rdname as.mo
#' @export
is.bactid <- function(x) {
identical(class(x), "bactid")
guess_mo <- as.mo
#' @exportMethod print.mo
#' @export
#' @noRd
print.mo <- function(x, ...) {
cat("Class 'mo'\n")
print.default(as.character(x), quote = FALSE)
}
#' @exportMethod as.data.frame.mo
#' @export
#' @noRd
as.data.frame.mo <- function (x, ...) {
# same as as.data.frame.character but with removed stringsAsFactors
nm <- paste(deparse(substitute(x), width.cutoff = 500L),
collapse = " ")
if (!"nm" %in% names(list(...))) {
as.data.frame.vector(x, ..., nm = nm)
} else {
as.data.frame.vector(x, ...)
}
}
#' @exportMethod pull.mo
#' @export
#' @importFrom dplyr pull
#' @noRd
pull.mo <- function(.data, ...) {
pull(as.data.frame(.data), ...)
}
#' @exportMethod print.bactid

14
R/mo_property.R
View File

@ -18,9 +18,9 @@
#' Property of a microorganism
#'
#' Use these functions to return a specific property of a microorganism from the \code{\link{microorganisms}} data set, based on their \code{bactid}. Get such an ID with \code{\link{as.bactid}}.
#' @param x a (vector of a) valid \code{\link{bactid}} or any text that can be coerced to a valid bactid with \code{\link{as.bactid}}
#' @param property one of the column names of one of the \code{\link{microorganisms}} data set, like \code{"bactid"}, \code{"bactsys"}, \code{"family"}, \code{"genus"}, \code{"species"}, \code{"fullname"}, \code{"gramstain"} and \code{"aerobic"}
#' Use these functions to return a specific property of a microorganism from the \code{\link{microorganisms}} data set, based on their \code{mo}. Get such an ID with \code{\link{as.mo}}.
#' @param x a (vector of a) valid \code{\link{mo}} or any text that can be coerced to a valid microorganism code with \code{\link{as.mo}}
#' @param property one of the column names of one of the \code{\link{microorganisms}} data set, like \code{"mo"}, \code{"bactsys"}, \code{"family"}, \code{"genus"}, \code{"species"}, \code{"fullname"}, \code{"gramstain"} and \code{"aerobic"}
#' @rdname mo_property
#' @export
#' @importFrom dplyr %>% left_join pull
@ -68,12 +68,12 @@ mo_property <- function(x, property = 'fullname') {
if (!property %in% colnames(microorganisms)) {
stop("invalid property: ", property, " - use a column name of `microorganisms`")
}
if (!is.bactid(x)) {
x <- as.bactid(x) # this will give a warning if x cannot be coerced
if (!is.mo(x)) {
x <- as.mo(x) # this will give a warning if x cannot be coerced
}
suppressWarnings(
data.frame(bactid = x, stringsAsFactors = FALSE) %>%
left_join(AMR::microorganisms, by = "bactid") %>%
data.frame(mo = x, stringsAsFactors = FALSE) %>%
left_join(AMR::microorganisms, by = "mo") %>%
pull(property)
)
}

6
R/resistance_predict.R
View File

@ -65,13 +65,13 @@
#' library(dplyr)
#' septic_patients %>%
#' # get bacteria properties like genus and species
#' left_join_microorganisms("bactid") %>%
#' left_join_microorganisms("mo") %>%
#' # calculate first isolates
#' mutate(first_isolate =
#' first_isolate(.,
#' "date",
#' "patient_id",
#' "bactid",
#' "mo",
#' col_specimen = NA,
#' col_icu = NA)) %>%
#' # filter on first E. coli isolates
@ -89,7 +89,7 @@
#' if (!require(ggplot2)) {
#'
#' data <- septic_patients %>%
#' filter(bactid == "ESCCOL") %>%
#' filter(mo == "ESCCOL") %>%
#' resistance_predict(col_ab = "amox",
#' col_date = "date",
#' info = FALSE,