mirror of https://github.com/msberends/AMR.git
sort sir history
This commit is contained in:
parent
af139a3c82
commit
19fd0ef121
|
|
@ -1,6 +1,6 @@
|
||||||
Package: AMR
|
Package: AMR
|
||||||
Version: 1.8.2.9096
|
Version: 1.8.2.9098
|
||||||
Date: 2023-01-21
|
Date: 2023-01-23
|
||||||
Title: Antimicrobial Resistance Data Analysis
|
Title: Antimicrobial Resistance Data Analysis
|
||||||
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
|
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
|
||||||
data analysis and to work with microbial and antimicrobial properties by
|
data analysis and to work with microbial and antimicrobial properties by
|
||||||
|
|
|
||||||
2
NEWS.md
2
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!)*
|
*(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)*
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -33,11 +33,11 @@
|
||||||
#' Welcome to the `AMR` package.
|
#' 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!
|
#' 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)).
|
#' 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).
|
#' 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.
|
#' 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:
|
#' @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).
|
#' 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).
|
||||||
|
|
|
||||||
|
|
@ -49,12 +49,13 @@ pm_left_join <- function(x, y, by = NULL, suffix = c(".x", ".y")) {
|
||||||
|
|
||||||
merged <- cbind(
|
merged <- cbind(
|
||||||
x,
|
x,
|
||||||
y[match(
|
y[
|
||||||
x[, by[1], drop = TRUE],
|
match(
|
||||||
y[, by[2], drop = TRUE]
|
x[, by[1], drop = TRUE],
|
||||||
),
|
y[, by[2], drop = TRUE]
|
||||||
colnames(y)[!colnames(y) %in% colnames(x) & !colnames(y) == by[2]],
|
),
|
||||||
drop = FALSE
|
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) {
|
replace_pos <- function(old, with) {
|
||||||
modifyRange(document_range(
|
modifyRange(
|
||||||
document_position(current_row, current_col - nchar(old)),
|
document_range(
|
||||||
document_position(current_row, current_col)
|
document_position(current_row, current_col - nchar(old)),
|
||||||
),
|
document_position(current_row, current_col)
|
||||||
text = with,
|
),
|
||||||
id = context$id
|
text = with,
|
||||||
|
id = context$id
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -226,7 +228,7 @@ search_type_in_df <- function(x, type, info = TRUE) {
|
||||||
# -- mo
|
# -- mo
|
||||||
if (type == "mo") {
|
if (type == "mo") {
|
||||||
add_MO_lookup_to_AMR_env()
|
add_MO_lookup_to_AMR_env()
|
||||||
|
|
||||||
if (any(vapply(FUN.VALUE = logical(1), x, is.mo))) {
|
if (any(vapply(FUN.VALUE = logical(1), x, is.mo))) {
|
||||||
# take first 'mo' column
|
# take first 'mo' column
|
||||||
found <- colnames(x)[vapply(FUN.VALUE = logical(1), x, is.mo)]
|
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
|
# WHONET support
|
||||||
found <- sort(colnames(x)[colnames_formatted %like_case% "^(specimen date|specimen_date|spec_date)"])
|
found <- sort(colnames(x)[colnames_formatted %like_case% "^(specimen date|specimen_date|spec_date)"])
|
||||||
if (!inherits(pm_pull(x, found), c("Date", "POSIXct"))) {
|
if (!inherits(pm_pull(x, found), c("Date", "POSIXct"))) {
|
||||||
stop(font_red(paste0(
|
stop(
|
||||||
"Found column '", font_bold(found), "' to be used as input for `col_", type,
|
font_red(paste0(
|
||||||
"`, but this column contains no valid dates. Transform its values to valid dates first."
|
"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
|
)),
|
||||||
|
call. = FALSE
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
} else if (any(vapply(FUN.VALUE = logical(1), x, function(x) inherits(x, c("Date", "POSIXct"))))) {
|
} 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) {
|
is_valid_regex <- function(x) {
|
||||||
regex_at_all <- tryCatch(vapply(
|
regex_at_all <- tryCatch(
|
||||||
FUN.VALUE = logical(1),
|
vapply(
|
||||||
X = strsplit(x, "", fixed = TRUE),
|
FUN.VALUE = logical(1),
|
||||||
FUN = function(y) {
|
X = strsplit(x, "", fixed = TRUE),
|
||||||
any(y %in% c(
|
FUN = function(y) {
|
||||||
"$", "(", ")", "*", "+", "-",
|
any(
|
||||||
".", "?", "[", "]", "^", "{",
|
y %in% c(
|
||||||
"|", "}", "\\"
|
"$", "(", ")", "*", "+", "-",
|
||||||
),
|
".", "?", "[", "]", "^", "{",
|
||||||
na.rm = TRUE
|
"|", "}", "\\"
|
||||||
)
|
),
|
||||||
},
|
na.rm = TRUE
|
||||||
USE.NAMES = FALSE
|
)
|
||||||
),
|
},
|
||||||
error = function(e) rep(TRUE, length(x))
|
USE.NAMES = FALSE
|
||||||
|
),
|
||||||
|
error = function(e) rep(TRUE, length(x))
|
||||||
)
|
)
|
||||||
regex_valid <- vapply(
|
regex_valid <- vapply(
|
||||||
FUN.VALUE = logical(1),
|
FUN.VALUE = logical(1),
|
||||||
|
|
@ -410,16 +415,17 @@ word_wrap <- function(...,
|
||||||
|
|
||||||
if (msg %like% "\n") {
|
if (msg %like% "\n") {
|
||||||
# run word_wraps() over every line here, bind them and return again
|
# run word_wraps() over every line here, bind them and return again
|
||||||
return(paste0(vapply(
|
return(paste0(
|
||||||
FUN.VALUE = character(1),
|
vapply(
|
||||||
trimws(unlist(strsplit(msg, "\n", fixed = TRUE)), which = "right"),
|
FUN.VALUE = character(1),
|
||||||
word_wrap,
|
trimws(unlist(strsplit(msg, "\n", fixed = TRUE)), which = "right"),
|
||||||
add_fn = add_fn,
|
word_wrap,
|
||||||
as_note = FALSE,
|
add_fn = add_fn,
|
||||||
width = width,
|
as_note = FALSE,
|
||||||
extra_indent = extra_indent
|
width = width,
|
||||||
),
|
extra_indent = extra_indent
|
||||||
collapse = "\n"
|
),
|
||||||
|
collapse = "\n"
|
||||||
))
|
))
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -429,11 +435,12 @@ word_wrap <- function(...,
|
||||||
# we need to correct for already applied style, that adds text like "\033[31m\"
|
# we need to correct for already applied style, that adds text like "\033[31m\"
|
||||||
msg_stripped <- font_stripstyle(msg)
|
msg_stripped <- font_stripstyle(msg)
|
||||||
# where are the spaces now?
|
# where are the spaces now?
|
||||||
msg_stripped_wrapped <- paste0(strwrap(msg_stripped,
|
msg_stripped_wrapped <- paste0(
|
||||||
simplify = TRUE,
|
strwrap(msg_stripped,
|
||||||
width = width
|
simplify = TRUE,
|
||||||
),
|
width = width
|
||||||
collapse = "\n"
|
),
|
||||||
|
collapse = "\n"
|
||||||
)
|
)
|
||||||
msg_stripped_wrapped <- paste0(unlist(strsplit(msg_stripped_wrapped, "(\n|\\*\\|\\*)")),
|
msg_stripped_wrapped <- paste0(unlist(strsplit(msg_stripped_wrapped, "(\n|\\*\\|\\*)")),
|
||||||
collapse = "\n"
|
collapse = "\n"
|
||||||
|
|
@ -487,11 +494,12 @@ message_ <- function(...,
|
||||||
appendLF = TRUE,
|
appendLF = TRUE,
|
||||||
add_fn = list(font_blue),
|
add_fn = list(font_blue),
|
||||||
as_note = TRUE) {
|
as_note = TRUE) {
|
||||||
message(word_wrap(...,
|
message(
|
||||||
add_fn = add_fn,
|
word_wrap(...,
|
||||||
as_note = as_note
|
add_fn = add_fn,
|
||||||
),
|
as_note = as_note
|
||||||
appendLF = appendLF
|
),
|
||||||
|
appendLF = appendLF
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -499,12 +507,13 @@ warning_ <- function(...,
|
||||||
add_fn = list(),
|
add_fn = list(),
|
||||||
immediate = FALSE,
|
immediate = FALSE,
|
||||||
call = FALSE) {
|
call = FALSE) {
|
||||||
warning(word_wrap(...,
|
warning(
|
||||||
add_fn = add_fn,
|
word_wrap(...,
|
||||||
as_note = FALSE
|
add_fn = add_fn,
|
||||||
),
|
as_note = FALSE
|
||||||
immediate. = immediate,
|
),
|
||||||
call. = call
|
immediate. = immediate,
|
||||||
|
call. = call
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -836,17 +845,18 @@ meet_criteria <- function(object,
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
if (!is.null(contains_column_class)) {
|
if (!is.null(contains_column_class)) {
|
||||||
stop_ifnot(any(vapply(
|
stop_ifnot(
|
||||||
FUN.VALUE = logical(1),
|
any(vapply(
|
||||||
object,
|
FUN.VALUE = logical(1),
|
||||||
function(col, columns_class = contains_column_class) {
|
object,
|
||||||
inherits(col, columns_class)
|
function(col, columns_class = contains_column_class) {
|
||||||
}
|
inherits(col, columns_class)
|
||||||
), na.rm = TRUE),
|
}
|
||||||
"the data provided in argument `", obj_name,
|
), na.rm = TRUE),
|
||||||
"` must contain at least one column of class <", contains_column_class, ">. ",
|
"the data provided in argument `", obj_name,
|
||||||
"See ?as.", contains_column_class, ".",
|
"` must contain at least one column of class <", contains_column_class, ">. ",
|
||||||
call = call_depth
|
"See ?as.", contains_column_class, ".",
|
||||||
|
call = call_depth
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
return(invisible())
|
return(invisible())
|
||||||
|
|
@ -1314,7 +1324,6 @@ round2 <- function(x, digits = 1, force_zero = TRUE) {
|
||||||
|
|
||||||
# percentage from our other package: 'cleaner'
|
# percentage from our other package: 'cleaner'
|
||||||
percentage <- function(x, digits = NULL, ...) {
|
percentage <- function(x, digits = NULL, ...) {
|
||||||
|
|
||||||
# getdecimalplaces() function
|
# getdecimalplaces() function
|
||||||
getdecimalplaces <- function(x, minimum = 0, maximum = 3) {
|
getdecimalplaces <- function(x, minimum = 0, maximum = 3) {
|
||||||
if (maximum < minimum) {
|
if (maximum < minimum) {
|
||||||
|
|
@ -1330,12 +1339,13 @@ percentage <- function(x, digits = NULL, ...) {
|
||||||
), ".", fixed = TRUE),
|
), ".", fixed = TRUE),
|
||||||
function(y) ifelse(length(y) == 2, nchar(y[2]), 0)
|
function(y) ifelse(length(y) == 2, nchar(y[2]), 0)
|
||||||
)), na.rm = TRUE)
|
)), na.rm = TRUE)
|
||||||
max(min(max_places,
|
max(
|
||||||
maximum,
|
min(max_places,
|
||||||
|
maximum,
|
||||||
|
na.rm = TRUE
|
||||||
|
),
|
||||||
|
minimum,
|
||||||
na.rm = TRUE
|
na.rm = TRUE
|
||||||
),
|
|
||||||
minimum,
|
|
||||||
na.rm = TRUE
|
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -1366,11 +1376,12 @@ percentage <- function(x, digits = NULL, ...) {
|
||||||
# max one digit if undefined
|
# max one digit if undefined
|
||||||
digits <- getdecimalplaces(x, minimum = 0, maximum = 1)
|
digits <- getdecimalplaces(x, minimum = 0, maximum = 1)
|
||||||
}
|
}
|
||||||
format_percentage(structure(
|
format_percentage(
|
||||||
.Data = as.double(x),
|
structure(
|
||||||
class = c("percentage", "numeric")
|
.Data = as.double(x),
|
||||||
),
|
class = c("percentage", "numeric")
|
||||||
digits = digits, ...
|
),
|
||||||
|
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
|
# for all MO functions, saves a lot of time on package load and in package size
|
||||||
if (is.null(AMR_env$MO_lookup)) {
|
if (is.null(AMR_env$MO_lookup)) {
|
||||||
MO_lookup <- AMR::microorganisms
|
MO_lookup <- AMR::microorganisms
|
||||||
|
|
||||||
MO_lookup$kingdom_index <- NA_real_
|
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 == "Bacteria" | MO_lookup$mo == "UNKNOWN"), "kingdom_index"] <- 1
|
||||||
MO_lookup[which(MO_lookup$kingdom == "Fungi"), "kingdom_index"] <- 2
|
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
|
MO_lookup[which(MO_lookup$kingdom == "Archaea"), "kingdom_index"] <- 4
|
||||||
# all the rest
|
# all the rest
|
||||||
MO_lookup[which(is.na(MO_lookup$kingdom_index)), "kingdom_index"] <- 5
|
MO_lookup[which(is.na(MO_lookup$kingdom_index)), "kingdom_index"] <- 5
|
||||||
|
|
||||||
# the fullname lowercase, important for the internal algorithms in as.mo()
|
# the fullname lowercase, important for the internal algorithms in as.mo()
|
||||||
MO_lookup$fullname_lower <- tolower(trimws(paste(
|
MO_lookup$fullname_lower <- tolower(trimws(paste(
|
||||||
MO_lookup$genus,
|
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))
|
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:
|
# 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$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$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$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
|
MO_lookup$subspecies_first <- tolower(substr(MO_lookup$subspecies, 1, 1)) # tolower for Salmonella serovars
|
||||||
|
|
|
||||||
69
R/ab.R
69
R/ab.R
|
|
@ -87,7 +87,6 @@
|
||||||
#'
|
#'
|
||||||
#' \donttest{
|
#' \donttest{
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # you can quickly rename 'sir' columns using set_ab_names() with dplyr:
|
#' # you can quickly rename 'sir' columns using set_ab_names() with dplyr:
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' set_ab_names(where(is.sir), property = "atc")
|
#' 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
|
# transform back from other languages and try again
|
||||||
x_translated <- paste(lapply(
|
x_translated <- paste(
|
||||||
strsplit(x[i], "[^A-Z0-9]"),
|
lapply(
|
||||||
function(y) {
|
strsplit(x[i], "[^A-Z0-9]"),
|
||||||
for (i in seq_len(length(y))) {
|
function(y) {
|
||||||
for (lang in LANGUAGES_SUPPORTED[LANGUAGES_SUPPORTED != "en"]) {
|
for (i in seq_len(length(y))) {
|
||||||
y[i] <- ifelse(tolower(y[i]) %in% tolower(TRANSLATIONS[, lang, drop = TRUE]),
|
for (lang in LANGUAGES_SUPPORTED[LANGUAGES_SUPPORTED != "en"]) {
|
||||||
TRANSLATIONS[which(tolower(TRANSLATIONS[, lang, drop = TRUE]) == tolower(y[i]) &
|
y[i] <- ifelse(tolower(y[i]) %in% tolower(TRANSLATIONS[, lang, drop = TRUE]),
|
||||||
!isFALSE(TRANSLATIONS$fixed)), "pattern"],
|
TRANSLATIONS[which(tolower(TRANSLATIONS[, lang, drop = TRUE]) == tolower(y[i]) &
|
||||||
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))
|
x_translated_guess <- suppressWarnings(as.ab(x_translated, initial_search = FALSE))
|
||||||
if (!is.na(x_translated_guess)) {
|
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"
|
# now also try to coerce brandname combinations like "Amoxy/clavulanic acid"
|
||||||
x_translated <- paste(lapply(
|
x_translated <- paste(
|
||||||
strsplit(x_translated, "[^A-Z0-9 ]"),
|
lapply(
|
||||||
function(y) {
|
strsplit(x_translated, "[^A-Z0-9 ]"),
|
||||||
for (i in seq_len(length(y))) {
|
function(y) {
|
||||||
y_name <- suppressWarnings(ab_name(y[i], language = NULL, initial_search = FALSE))
|
for (i in seq_len(length(y))) {
|
||||||
y[i] <- ifelse(!is.na(y_name),
|
y_name <- suppressWarnings(ab_name(y[i], language = NULL, initial_search = FALSE))
|
||||||
y_name,
|
y[i] <- ifelse(!is.na(y_name),
|
||||||
y[i]
|
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))
|
x_translated_guess <- suppressWarnings(as.ab(x_translated, initial_search = FALSE))
|
||||||
if (!is.na(x_translated_guess)) {
|
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 <- x_unknown[!x_unknown %in% x_unknown_ATCs]
|
||||||
x_unknown <- c(x_unknown,
|
x_unknown <- c(
|
||||||
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,
|
||||||
|
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) {
|
if (length(x_unknown) > 0 && fast_mode == FALSE) {
|
||||||
warning_(
|
warning_(
|
||||||
"in `as.ab()`: these values could not be coerced to a valid antimicrobial ID: ",
|
"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 {
|
} else {
|
||||||
translate_ab <- tolower(translate_ab)
|
translate_ab <- tolower(translate_ab)
|
||||||
stop_ifnot(translate_ab %in% colnames(AMR::antibiotics),
|
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",
|
"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.",
|
"or TRUE (equals 'name') or FALSE to not translate at all.",
|
||||||
call = FALSE
|
call = FALSE
|
||||||
)
|
)
|
||||||
translate_ab
|
translate_ab
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -95,20 +95,17 @@
|
||||||
#' # dplyr -------------------------------------------------------------------
|
#' # dplyr -------------------------------------------------------------------
|
||||||
#' \donttest{
|
#' \donttest{
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # get AMR for all aminoglycosides e.g., per ward:
|
#' # get AMR for all aminoglycosides e.g., per ward:
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' group_by(ward) %>%
|
#' group_by(ward) %>%
|
||||||
#' summarise(across(aminoglycosides(), resistance))
|
#' summarise(across(aminoglycosides(), resistance))
|
||||||
#' }
|
#' }
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # You can combine selectors with '&' to be more specific:
|
#' # You can combine selectors with '&' to be more specific:
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' select(penicillins() & administrable_per_os())
|
#' select(penicillins() & administrable_per_os())
|
||||||
#' }
|
#' }
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # get AMR for only drugs that matter - no intrinsic resistance:
|
#' # get AMR for only drugs that matter - no intrinsic resistance:
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' filter(mo_genus() %in% c("Escherichia", "Klebsiella")) %>%
|
#' filter(mo_genus() %in% c("Escherichia", "Klebsiella")) %>%
|
||||||
|
|
@ -116,7 +113,6 @@
|
||||||
#' summarise(across(not_intrinsic_resistant(), resistance))
|
#' summarise(across(not_intrinsic_resistant(), resistance))
|
||||||
#' }
|
#' }
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # get susceptibility for antibiotics whose name contains "trim":
|
#' # get susceptibility for antibiotics whose name contains "trim":
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' filter(first_isolate()) %>%
|
#' filter(first_isolate()) %>%
|
||||||
|
|
@ -124,19 +120,16 @@
|
||||||
#' summarise(across(ab_selector(name %like% "trim"), susceptibility))
|
#' summarise(across(ab_selector(name %like% "trim"), susceptibility))
|
||||||
#' }
|
#' }
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # this will select columns 'IPM' (imipenem) and 'MEM' (meropenem):
|
#' # this will select columns 'IPM' (imipenem) and 'MEM' (meropenem):
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' select(carbapenems())
|
#' select(carbapenems())
|
||||||
#' }
|
#' }
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # this will select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB':
|
#' # this will select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB':
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' select(mo, aminoglycosides())
|
#' select(mo, aminoglycosides())
|
||||||
#' }
|
#' }
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # any() and all() work in dplyr's filter() too:
|
#' # any() and all() work in dplyr's filter() too:
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' filter(
|
#' filter(
|
||||||
|
|
@ -145,25 +138,21 @@
|
||||||
#' )
|
#' )
|
||||||
#' }
|
#' }
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # also works with c():
|
#' # also works with c():
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' filter(any(c(carbapenems(), aminoglycosides()) == "R"))
|
#' filter(any(c(carbapenems(), aminoglycosides()) == "R"))
|
||||||
#' }
|
#' }
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # not setting any/all will automatically apply all():
|
#' # not setting any/all will automatically apply all():
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' filter(aminoglycosides() == "R")
|
#' filter(aminoglycosides() == "R")
|
||||||
#' }
|
#' }
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # this will select columns 'mo' and all antimycobacterial drugs ('RIF'):
|
#' # this will select columns 'mo' and all antimycobacterial drugs ('RIF'):
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' select(mo, ab_class("mycobact"))
|
#' select(mo, ab_class("mycobact"))
|
||||||
#' }
|
#' }
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # get bug/drug combinations for only glycopeptides in Gram-positives:
|
#' # get bug/drug combinations for only glycopeptides in Gram-positives:
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' filter(mo_is_gram_positive()) %>%
|
#' filter(mo_is_gram_positive()) %>%
|
||||||
|
|
@ -179,7 +168,6 @@
|
||||||
#' select(penicillins()) # only the 'J01CA01' column will be selected
|
#' select(penicillins()) # only the 'J01CA01' column will be selected
|
||||||
#' }
|
#' }
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # with recent versions of dplyr this is all equal:
|
#' # with recent versions of dplyr this is all equal:
|
||||||
#' x <- example_isolates[carbapenems() == "R", ]
|
#' x <- example_isolates[carbapenems() == "R", ]
|
||||||
#' y <- example_isolates %>% filter(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",
|
ab_group = "administrable_per_os",
|
||||||
examples = paste0(
|
examples = paste0(
|
||||||
" (such as ",
|
" (such as ",
|
||||||
vector_or(ab_name(sample(agents_all,
|
vector_or(
|
||||||
size = min(5, length(agents_all)),
|
ab_name(
|
||||||
replace = FALSE
|
sample(agents_all,
|
||||||
),
|
size = min(5, length(agents_all)),
|
||||||
tolower = TRUE,
|
replace = FALSE
|
||||||
language = NULL
|
),
|
||||||
),
|
tolower = TRUE,
|
||||||
quotes = FALSE
|
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"
|
sort = FALSE, fn = "not_intrinsic_resistant"
|
||||||
)
|
)
|
||||||
# intrinsic vars
|
# intrinsic vars
|
||||||
vars_df_R <- tryCatch(sapply(
|
vars_df_R <- tryCatch(
|
||||||
eucast_rules(vars_df,
|
sapply(
|
||||||
col_mo = col_mo,
|
eucast_rules(vars_df,
|
||||||
version_expertrules = version_expertrules,
|
col_mo = col_mo,
|
||||||
rules = "expert",
|
version_expertrules = version_expertrules,
|
||||||
info = FALSE
|
rules = "expert",
|
||||||
|
info = FALSE
|
||||||
|
),
|
||||||
|
function(col) {
|
||||||
|
tryCatch(!any(is.na(col)) && all(col == "R"),
|
||||||
|
error = function(e) FALSE
|
||||||
|
)
|
||||||
|
}
|
||||||
),
|
),
|
||||||
function(col) {
|
error = function(e) stop_("in not_intrinsic_resistant(): ", e$message, call = FALSE)
|
||||||
tryCatch(!any(is.na(col)) && all(col == "R"),
|
|
||||||
error = function(e) 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)])]
|
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)) {
|
if (message_not_thrown_before(function_name, "ab_class", "untreatable", entire_session = TRUE)) {
|
||||||
warning_(
|
warning_(
|
||||||
"in `", function_name, "()`: some drugs were ignored since they cannot be used for treating patients: ",
|
"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],
|
vector_and(
|
||||||
language = NULL,
|
ab_name(names(ab_in_data)[names(ab_in_data) %in% untreatable],
|
||||||
tolower = TRUE
|
language = NULL,
|
||||||
),
|
tolower = TRUE
|
||||||
quotes = FALSE,
|
),
|
||||||
sort = TRUE
|
quotes = FALSE,
|
||||||
|
sort = TRUE
|
||||||
), ". They can be included using `", function_name, "(only_treatable = FALSE)`. ",
|
), ". They can be included using `", function_name, "(only_treatable = FALSE)`. ",
|
||||||
"This warning will be shown once per session."
|
"This warning will be shown once per session."
|
||||||
)
|
)
|
||||||
|
|
@ -593,11 +585,12 @@ ab_select_exec <- function(function_name,
|
||||||
}
|
}
|
||||||
ab_group <- function_name
|
ab_group <- function_name
|
||||||
}
|
}
|
||||||
examples <- paste0(" (such as ", vector_or(ab_name(sample(abx, size = min(2, length(abx)), replace = FALSE),
|
examples <- paste0(" (such as ", vector_or(
|
||||||
tolower = TRUE,
|
ab_name(sample(abx, size = min(2, length(abx)), replace = FALSE),
|
||||||
language = NULL
|
tolower = TRUE,
|
||||||
),
|
language = NULL
|
||||||
quotes = FALSE
|
),
|
||||||
|
quotes = FALSE
|
||||||
), ")")
|
), ")")
|
||||||
} else {
|
} else {
|
||||||
# this for the 'manual' ab_class() function
|
# this for the 'manual' ab_class() function
|
||||||
|
|
@ -821,11 +814,12 @@ find_ab_names <- function(ab_group, n = 3) {
|
||||||
if (length(drugs) == 0) {
|
if (length(drugs) == 0) {
|
||||||
return("??")
|
return("??")
|
||||||
}
|
}
|
||||||
vector_or(ab_name(sample(drugs, size = min(n, length(drugs)), replace = FALSE),
|
vector_or(
|
||||||
tolower = TRUE,
|
ab_name(sample(drugs, size = min(n, length(drugs)), replace = FALSE),
|
||||||
language = NULL
|
tolower = TRUE,
|
||||||
),
|
language = NULL
|
||||||
quotes = FALSE
|
),
|
||||||
|
quotes = FALSE
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
||||||
11
R/age.R
11
R/age.R
|
|
@ -83,11 +83,12 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
|
||||||
# add decimals
|
# add decimals
|
||||||
if (exact == TRUE) {
|
if (exact == TRUE) {
|
||||||
# get dates of `x` when `x` would have the year of `reference`
|
# get dates of `x` when `x` would have the year of `reference`
|
||||||
x_in_reference_year <- as.POSIXlt(paste0(
|
x_in_reference_year <- as.POSIXlt(
|
||||||
format(as.Date(reference), "%Y"),
|
paste0(
|
||||||
format(as.Date(x), "-%m-%d")
|
format(as.Date(reference), "%Y"),
|
||||||
),
|
format(as.Date(x), "-%m-%d")
|
||||||
format = "%Y-%m-%d"
|
),
|
||||||
|
format = "%Y-%m-%d"
|
||||||
)
|
)
|
||||||
# get differences in days
|
# get differences in days
|
||||||
n_days_x_rest <- as.double(difftime(as.Date(reference),
|
n_days_x_rest <- as.double(difftime(as.Date(reference),
|
||||||
|
|
|
||||||
68
R/av.R
68
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
|
# transform back from other languages and try again
|
||||||
x_translated <- paste(lapply(
|
x_translated <- paste(
|
||||||
strsplit(x[i], "[^A-Z0-9]"),
|
lapply(
|
||||||
function(y) {
|
strsplit(x[i], "[^A-Z0-9]"),
|
||||||
for (i in seq_len(length(y))) {
|
function(y) {
|
||||||
for (lang in LANGUAGES_SUPPORTED[LANGUAGES_SUPPORTED != "en"]) {
|
for (i in seq_len(length(y))) {
|
||||||
y[i] <- ifelse(tolower(y[i]) %in% tolower(TRANSLATIONS[, lang, drop = TRUE]),
|
for (lang in LANGUAGES_SUPPORTED[LANGUAGES_SUPPORTED != "en"]) {
|
||||||
TRANSLATIONS[which(tolower(TRANSLATIONS[, lang, drop = TRUE]) == tolower(y[i]) &
|
y[i] <- ifelse(tolower(y[i]) %in% tolower(TRANSLATIONS[, lang, drop = TRUE]),
|
||||||
!isFALSE(TRANSLATIONS$fixed)), "pattern"],
|
TRANSLATIONS[which(tolower(TRANSLATIONS[, lang, drop = TRUE]) == tolower(y[i]) &
|
||||||
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))
|
x_translated_guess <- suppressWarnings(as.av(x_translated, initial_search = FALSE))
|
||||||
if (!is.na(x_translated_guess)) {
|
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"
|
# now also try to coerce brandname combinations like "Amoxy/clavulanic acid"
|
||||||
x_translated <- paste(lapply(
|
x_translated <- paste(
|
||||||
strsplit(x_translated, "[^A-Z0-9 ]"),
|
lapply(
|
||||||
function(y) {
|
strsplit(x_translated, "[^A-Z0-9 ]"),
|
||||||
for (i in seq_len(length(y))) {
|
function(y) {
|
||||||
y_name <- suppressWarnings(av_name(y[i], language = NULL, initial_search = FALSE))
|
for (i in seq_len(length(y))) {
|
||||||
y[i] <- ifelse(!is.na(y_name),
|
y_name <- suppressWarnings(av_name(y[i], language = NULL, initial_search = FALSE))
|
||||||
y_name,
|
y[i] <- ifelse(!is.na(y_name),
|
||||||
y[i]
|
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))
|
x_translated_guess <- suppressWarnings(as.av(x_translated, initial_search = FALSE))
|
||||||
if (!is.na(x_translated_guess)) {
|
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 <- x_unknown[!x_unknown %in% x_unknown_ATCs]
|
||||||
x_unknown <- c(x_unknown,
|
x_unknown <- c(
|
||||||
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,
|
||||||
|
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) {
|
if (length(x_unknown) > 0 && fast_mode == FALSE) {
|
||||||
warning_(
|
warning_(
|
||||||
"in `as.av()`: these values could not be coerced to a valid antiviral drug ID: ",
|
"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 {
|
} else {
|
||||||
translate_av <- tolower(translate_av)
|
translate_av <- tolower(translate_av)
|
||||||
stop_ifnot(translate_av %in% colnames(AMR::antivirals),
|
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",
|
"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.",
|
"or TRUE (equals 'name') or FALSE to not translate at all.",
|
||||||
call = FALSE
|
call = FALSE
|
||||||
)
|
)
|
||||||
translate_av
|
translate_av
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -69,26 +69,26 @@ av_from_text <- function(text,
|
||||||
if (missing(type)) {
|
if (missing(type)) {
|
||||||
type <- type[1L]
|
type <- type[1L]
|
||||||
}
|
}
|
||||||
|
|
||||||
meet_criteria(text)
|
meet_criteria(text)
|
||||||
meet_criteria(type, allow_class = "character", has_length = 1)
|
meet_criteria(type, allow_class = "character", has_length = 1)
|
||||||
meet_criteria(collapse, has_length = 1, allow_NULL = TRUE)
|
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(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(thorough_search, allow_class = "logical", has_length = 1, allow_NULL = TRUE)
|
||||||
meet_criteria(info, allow_class = "logical", has_length = 1)
|
meet_criteria(info, allow_class = "logical", has_length = 1)
|
||||||
|
|
||||||
type <- tolower(trimws2(type))
|
type <- tolower(trimws2(type))
|
||||||
|
|
||||||
text <- tolower(as.character(text))
|
text <- tolower(as.character(text))
|
||||||
text_split_all <- strsplit(text, "[ ;.,:\\|]")
|
text_split_all <- strsplit(text, "[ ;.,:\\|]")
|
||||||
progress <- progress_ticker(n = length(text_split_all), n_min = 5, print = info)
|
progress <- progress_ticker(n = length(text_split_all), n_min = 5, print = info)
|
||||||
on.exit(close(progress))
|
on.exit(close(progress))
|
||||||
|
|
||||||
if (type %like% "(drug|ab|anti)") {
|
if (type %like% "(drug|ab|anti)") {
|
||||||
translate_av <- get_translate_av(translate_av)
|
translate_av <- get_translate_av(translate_av)
|
||||||
|
|
||||||
if (isTRUE(thorough_search) ||
|
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)]
|
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) {
|
result <- lapply(text_split_all, function(text_split) {
|
||||||
progress$tick()
|
progress$tick()
|
||||||
|
|
@ -125,9 +125,9 @@ av_from_text <- function(text,
|
||||||
)
|
)
|
||||||
})
|
})
|
||||||
}
|
}
|
||||||
|
|
||||||
close(progress)
|
close(progress)
|
||||||
|
|
||||||
result <- lapply(result, function(out) {
|
result <- lapply(result, function(out) {
|
||||||
out <- out[!is.na(out)]
|
out <- out[!is.na(out)]
|
||||||
if (length(out) == 0) {
|
if (length(out) == 0) {
|
||||||
|
|
@ -149,7 +149,7 @@ av_from_text <- function(text,
|
||||||
text_split <- as.double(gsub("[^0-9.]", "", text_split))
|
text_split <- as.double(gsub("[^0-9.]", "", text_split))
|
||||||
# minimal 100 units/mg and no years that unlikely doses
|
# 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)]
|
text_split <- text_split[text_split >= 100 & !text_split %in% c(1951:1999, 2001:2049)]
|
||||||
|
|
||||||
if (length(text_split) > 0) {
|
if (length(text_split) > 0) {
|
||||||
text_split
|
text_split
|
||||||
} else {
|
} else {
|
||||||
|
|
@ -170,7 +170,7 @@ av_from_text <- function(text,
|
||||||
} else {
|
} else {
|
||||||
stop_("`type` must be either 'drug', 'dose' or 'administration'")
|
stop_("`type` must be either 'drug', 'dose' or 'administration'")
|
||||||
}
|
}
|
||||||
|
|
||||||
# collapse text if needed
|
# collapse text if needed
|
||||||
if (!is.null(collapse)) {
|
if (!is.null(collapse)) {
|
||||||
result <- vapply(FUN.VALUE = character(1), result, function(x) {
|
result <- vapply(FUN.VALUE = character(1), result, function(x) {
|
||||||
|
|
@ -181,6 +181,6 @@ av_from_text <- function(text,
|
||||||
}
|
}
|
||||||
})
|
})
|
||||||
}
|
}
|
||||||
|
|
||||||
result
|
result
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -84,7 +84,7 @@ av_name <- function(x, language = get_AMR_locale(), tolower = FALSE, ...) {
|
||||||
meet_criteria(x, allow_NA = TRUE)
|
meet_criteria(x, allow_NA = TRUE)
|
||||||
language <- validate_language(language)
|
language <- validate_language(language)
|
||||||
meet_criteria(tolower, allow_class = "logical", has_length = 1)
|
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)
|
x <- translate_into_language(av_validate(x = x, property = "name", ...), language = language, only_affect_ab_names = TRUE)
|
||||||
if (tolower == TRUE) {
|
if (tolower == TRUE) {
|
||||||
# use perl to only transform the first character
|
# use perl to only transform the first character
|
||||||
|
|
@ -155,11 +155,11 @@ av_loinc <- function(x, ...) {
|
||||||
av_ddd <- function(x, administration = "oral", ...) {
|
av_ddd <- function(x, administration = "oral", ...) {
|
||||||
meet_criteria(x, allow_NA = TRUE)
|
meet_criteria(x, allow_NA = TRUE)
|
||||||
meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1)
|
meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1)
|
||||||
|
|
||||||
x <- as.av(x, ...)
|
x <- as.av(x, ...)
|
||||||
ddd_prop <- paste0(administration, "_ddd")
|
ddd_prop <- paste0(administration, "_ddd")
|
||||||
out <- av_validate(x = x, property = ddd_prop)
|
out <- av_validate(x = x, property = ddd_prop)
|
||||||
|
|
||||||
if (any(av_name(x, language = NULL) %like% "/" & is.na(out))) {
|
if (any(av_name(x, language = NULL) %like% "/" & is.na(out))) {
|
||||||
warning_(
|
warning_(
|
||||||
"in `av_ddd()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
"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", ...) {
|
av_ddd_units <- function(x, administration = "oral", ...) {
|
||||||
meet_criteria(x, allow_NA = TRUE)
|
meet_criteria(x, allow_NA = TRUE)
|
||||||
meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1)
|
meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1)
|
||||||
|
|
||||||
x <- as.av(x, ...)
|
x <- as.av(x, ...)
|
||||||
ddd_prop <- paste0(administration, "_units")
|
ddd_prop <- paste0(administration, "_units")
|
||||||
out <- av_validate(x = x, property = ddd_prop)
|
out <- av_validate(x = x, property = ddd_prop)
|
||||||
|
|
||||||
if (any(av_name(x, language = NULL) %like% "/" & is.na(out))) {
|
if (any(av_name(x, language = NULL) %like% "/" & is.na(out))) {
|
||||||
warning_(
|
warning_(
|
||||||
"in `av_ddd_units()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
|
"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(), ...) {
|
av_info <- function(x, language = get_AMR_locale(), ...) {
|
||||||
meet_criteria(x, allow_NA = TRUE)
|
meet_criteria(x, allow_NA = TRUE)
|
||||||
language <- validate_language(language)
|
language <- validate_language(language)
|
||||||
|
|
||||||
x <- as.av(x, ...)
|
x <- as.av(x, ...)
|
||||||
list(
|
list(
|
||||||
av = as.character(x),
|
av = as.character(x),
|
||||||
|
|
@ -224,18 +224,18 @@ av_info <- function(x, language = get_AMR_locale(), ...) {
|
||||||
av_url <- function(x, open = FALSE, ...) {
|
av_url <- function(x, open = FALSE, ...) {
|
||||||
meet_criteria(x, allow_NA = TRUE)
|
meet_criteria(x, allow_NA = TRUE)
|
||||||
meet_criteria(open, allow_class = "logical", has_length = 1)
|
meet_criteria(open, allow_class = "logical", has_length = 1)
|
||||||
|
|
||||||
av <- as.av(x = x, ...)
|
av <- as.av(x = x, ...)
|
||||||
atcs <- av_atc(av, only_first = TRUE)
|
atcs <- av_atc(av, only_first = TRUE)
|
||||||
u <- paste0("https://www.whocc.no/atc_ddd_index/?code=", atcs, "&showdescription=no")
|
u <- paste0("https://www.whocc.no/atc_ddd_index/?code=", atcs, "&showdescription=no")
|
||||||
u[is.na(atcs)] <- NA_character_
|
u[is.na(atcs)] <- NA_character_
|
||||||
names(u) <- av_name(av)
|
names(u) <- av_name(av)
|
||||||
|
|
||||||
NAs <- av_name(av, tolower = TRUE, language = NULL)[!is.na(av) & is.na(atcs)]
|
NAs <- av_name(av, tolower = TRUE, language = NULL)[!is.na(av) & is.na(atcs)]
|
||||||
if (length(NAs) > 0) {
|
if (length(NAs) > 0) {
|
||||||
warning_("in `av_url()`: no ATC code available for ", vector_and(NAs, quotes = FALSE), ".")
|
warning_("in `av_url()`: no ATC code available for ", vector_and(NAs, quotes = FALSE), ".")
|
||||||
}
|
}
|
||||||
|
|
||||||
if (open == TRUE) {
|
if (open == TRUE) {
|
||||||
if (length(u) > 1 && !is.na(u[1L])) {
|
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.")
|
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
|
# try to catch an error when inputting an invalid argument
|
||||||
# so the 'call.' can be set to FALSE
|
# so the 'call.' can be set to FALSE
|
||||||
tryCatch(x[1L] %in% AMR_env$AV_lookup[1, property, drop = TRUE],
|
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])) {
|
if (!all(x %in% AMR_env$AV_lookup[, property, drop = TRUE])) {
|
||||||
x <- as.av(x, ...)
|
x <- as.av(x, ...)
|
||||||
if (all(is.na(x)) && is.list(AMR_env$AV_lookup[, property, drop = TRUE])) {
|
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") {
|
if (property == "av") {
|
||||||
return(set_clean_class(x, new_class = c("av", "character")))
|
return(set_clean_class(x, new_class = c("av", "character")))
|
||||||
} else if (property == "cid") {
|
} else if (property == "cid") {
|
||||||
|
|
|
||||||
|
|
@ -31,25 +31,25 @@
|
||||||
#'
|
#'
|
||||||
#' With [add_custom_antimicrobials()] you can add your own custom antimicrobial drug names and codes.
|
#' 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"
|
#' @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:
|
#' 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:
|
#' **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.
|
#' 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:
|
#' 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
|
#' ```r
|
||||||
#' # Add custom antibiotic drug codes:
|
#' # Add custom antibiotic drug codes:
|
||||||
#' options(AMR_custom_ab = "~/my_custom_ab.rds")
|
#' options(AMR_custom_ab = "~/my_custom_ab.rds")
|
||||||
#' ```
|
#' ```
|
||||||
#'
|
#'
|
||||||
#' Upon package load, this file will be loaded and run through the [add_custom_antimicrobials()] function.
|
#' 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:
|
#' **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")`.
|
#' 1. Edit the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`.
|
||||||
#'
|
#'
|
||||||
#' 2. Add a text like below and save the file:
|
#' 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])
|
x[, col] <- as.list(x[, col, drop = TRUE])
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
AMR_env$custom_ab_codes <- c(AMR_env$custom_ab_codes, x$ab)
|
AMR_env$custom_ab_codes <- c(AMR_env$custom_ab_codes, x$ab)
|
||||||
class(AMR_env$AB_lookup$ab) <- "character"
|
class(AMR_env$AB_lookup$ab) <- "character"
|
||||||
|
|
||||||
new_df <- AMR_env$AB_lookup[0, , drop = FALSE][seq_len(NROW(x)), , drop = FALSE]
|
new_df <- AMR_env$AB_lookup[0, , drop = FALSE][seq_len(NROW(x)), , drop = FALSE]
|
||||||
rownames(new_df) <- NULL
|
rownames(new_df) <- NULL
|
||||||
list_cols <- vapply(FUN.VALUE = logical(1), new_df, is.list)
|
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]
|
new_df[, col] <- x[, col, drop = TRUE]
|
||||||
}
|
}
|
||||||
AMR_env$AB_lookup <- unique(rbind(AMR_env$AB_lookup, new_df))
|
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]
|
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")
|
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.")
|
message_("Added ", nr2char(nrow(x)), " record", ifelse(nrow(x) > 1, "s", ""), " to the internal `antibiotics` data set.")
|
||||||
|
|
|
||||||
|
|
@ -240,11 +240,12 @@ print.custom_eucast_rules <- function(x, ...) {
|
||||||
" (", rule$result_group, ")"
|
" (", rule$result_group, ")"
|
||||||
)
|
)
|
||||||
agents <- sort(agents)
|
agents <- sort(agents)
|
||||||
rule_if <- word_wrap(paste0(
|
rule_if <- word_wrap(
|
||||||
i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then "),
|
paste0(
|
||||||
"set to {result}:"
|
i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then "),
|
||||||
),
|
"set to {result}:"
|
||||||
extra_indent = 5
|
),
|
||||||
|
extra_indent = 5
|
||||||
)
|
)
|
||||||
rule_if <- gsub("{result}", val, rule_if, fixed = TRUE)
|
rule_if <- gsub("{result}", val, rule_if, fixed = TRUE)
|
||||||
rule_then <- paste0(" ", word_wrap(paste0(agents, collapse = ", "), extra_indent = 5))
|
rule_then <- paste0(" ", word_wrap(paste0(agents, collapse = ", "), extra_indent = 5))
|
||||||
|
|
|
||||||
|
|
@ -32,26 +32,26 @@
|
||||||
#' With [add_custom_microorganisms()] you can add your own custom microorganisms, such the non-taxonomic outcome of laboratory analysis.
|
#' 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)
|
#' @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*.
|
#' @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:
|
#' 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:
|
#' **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.
|
#' 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:
|
#' 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
|
#' ```r
|
||||||
#' # Add custom microorganism codes:
|
#' # Add custom microorganism codes:
|
||||||
#' options(AMR_custom_mo = "~/my_custom_mo.rds")
|
#' options(AMR_custom_mo = "~/my_custom_mo.rds")
|
||||||
#' ```
|
#' ```
|
||||||
#'
|
#'
|
||||||
#' Upon package load, this file will be loaded and run through the [add_custom_microorganisms()] function.
|
#' 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:
|
#' **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")`.
|
#' 1. Edit the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`.
|
||||||
#'
|
#'
|
||||||
#' 2. Add a text like below and save the file:
|
#' 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
|
#' # now add a custom entry - it will be considered by as.mo() and
|
||||||
#' # all mo_*() functions
|
#' # all mo_*() functions
|
||||||
#' add_custom_microorganisms(
|
#' add_custom_microorganisms(
|
||||||
#' data.frame(genus = "Enterobacter",
|
#' data.frame(
|
||||||
#' species = "asburiae/cloacae"
|
#' genus = "Enterobacter",
|
||||||
|
#' species = "asburiae/cloacae"
|
||||||
#' )
|
#' )
|
||||||
#' )
|
#' )
|
||||||
#'
|
#'
|
||||||
#' # E. asburiae/cloacae is now a new microorganism:
|
#' # E. asburiae/cloacae is now a new microorganism:
|
||||||
#' mo_name("Enterobacter asburiae/cloacae")
|
#' mo_name("Enterobacter asburiae/cloacae")
|
||||||
#'
|
#'
|
||||||
#' # its code:
|
#' # its code:
|
||||||
#' as.mo("Enterobacter asburiae/cloacae")
|
#' as.mo("Enterobacter asburiae/cloacae")
|
||||||
#'
|
#'
|
||||||
#' # all internal algorithms will work as well:
|
#' # all internal algorithms will work as well:
|
||||||
#' mo_name("Ent asburia cloacae")
|
#' mo_name("Ent asburia cloacae")
|
||||||
#'
|
#'
|
||||||
#' # and even the taxonomy was added based on the genus!
|
#' # and even the taxonomy was added based on the genus!
|
||||||
#' mo_family("E. asburiae/cloacae")
|
#' mo_family("E. asburiae/cloacae")
|
||||||
#' mo_gramstain("Enterobacter asburiae/cloacae")
|
#' mo_gramstain("Enterobacter asburiae/cloacae")
|
||||||
#'
|
#'
|
||||||
#' mo_info("Enterobacter asburiae/cloacae")
|
#' mo_info("Enterobacter asburiae/cloacae")
|
||||||
#'
|
#'
|
||||||
#'
|
#'
|
||||||
#' # the function tries to be forgiving:
|
#' # the function tries to be forgiving:
|
||||||
#' add_custom_microorganisms(
|
#' add_custom_microorganisms(
|
||||||
#' data.frame(GENUS = "BACTEROIDES / PARABACTEROIDES SLASHLINE",
|
#' data.frame(
|
||||||
#' SPECIES = "SPECIES")
|
#' GENUS = "BACTEROIDES / PARABACTEROIDES SLASHLINE",
|
||||||
|
#' SPECIES = "SPECIES"
|
||||||
|
#' )
|
||||||
#' )
|
#' )
|
||||||
#' mo_name("BACTEROIDES / PARABACTEROIDES")
|
#' mo_name("BACTEROIDES / PARABACTEROIDES")
|
||||||
#' mo_rank("BACTEROIDES / PARABACTEROIDES")
|
#' mo_rank("BACTEROIDES / PARABACTEROIDES")
|
||||||
#'
|
#'
|
||||||
#' # taxonomy still works, although a slashline genus was given as input:
|
#' # taxonomy still works, although a slashline genus was given as input:
|
||||||
#' mo_family("Bacteroides/Parabacteroides")
|
#' mo_family("Bacteroides/Parabacteroides")
|
||||||
#'
|
#'
|
||||||
#'
|
#'
|
||||||
#' # for groups and complexes, set them as species or subspecies:
|
#' # for groups and complexes, set them as species or subspecies:
|
||||||
#' add_custom_microorganisms(
|
#' add_custom_microorganisms(
|
||||||
#' data.frame(genus = "Citrobacter",
|
#' data.frame(
|
||||||
#' species = c("freundii", "braakii complex"),
|
#' genus = "Citrobacter",
|
||||||
#' subspecies = c("complex", ""))
|
#' species = c("freundii", "braakii complex"),
|
||||||
|
#' subspecies = c("complex", "")
|
||||||
|
#' )
|
||||||
#' )
|
#' )
|
||||||
#' mo_name(c("C. freundii complex", "C. braakii complex"))
|
#' mo_name(c("C. freundii complex", "C. braakii complex"))
|
||||||
#' mo_species(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) {
|
add_custom_microorganisms <- function(x) {
|
||||||
meet_criteria(x, allow_class = "data.frame")
|
meet_criteria(x, allow_class = "data.frame")
|
||||||
stop_ifnot("genus" %in% tolower(colnames(x)), paste0("`x` must contain column 'genus'."))
|
stop_ifnot("genus" %in% tolower(colnames(x)), paste0("`x` must contain column 'genus'."))
|
||||||
|
|
||||||
add_MO_lookup_to_AMR_env()
|
add_MO_lookup_to_AMR_env()
|
||||||
|
|
||||||
# remove any extra class/type, such as grouped tbl, or data.table:
|
# remove any extra class/type, such as grouped tbl, or data.table:
|
||||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||||
colnames(x) <- tolower(colnames(x))
|
colnames(x) <- tolower(colnames(x))
|
||||||
|
|
@ -135,7 +140,7 @@ add_custom_microorganisms <- function(x) {
|
||||||
}
|
}
|
||||||
# keep only columns available in the microorganisms data set
|
# 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]
|
x <- x[, colnames(AMR_env$MO_lookup)[colnames(AMR_env$MO_lookup) %in% colnames(x)], drop = FALSE]
|
||||||
|
|
||||||
# clean the input ----
|
# clean the input ----
|
||||||
for (col in c("genus", "species", "subspecies")) {
|
for (col in c("genus", "species", "subspecies")) {
|
||||||
if (!col %in% colnames(x)) {
|
if (!col %in% colnames(x)) {
|
||||||
|
|
@ -152,7 +157,7 @@ add_custom_microorganisms <- function(x) {
|
||||||
col_ <- gsub(" *([/-]) *", "\\1", col_, perl = TRUE)
|
col_ <- gsub(" *([/-]) *", "\\1", col_, perl = TRUE)
|
||||||
# groups are in our taxonomic table with a capital G
|
# groups are in our taxonomic table with a capital G
|
||||||
col_ <- gsub(" group( |$)", " Group\\1", col_, perl = TRUE)
|
col_ <- gsub(" group( |$)", " Group\\1", col_, perl = TRUE)
|
||||||
|
|
||||||
col_[is.na(col_)] <- ""
|
col_[is.na(col_)] <- ""
|
||||||
if (col == "genus") {
|
if (col == "genus") {
|
||||||
substr(col_, 1, 1) <- toupper(substr(col_, 1, 1))
|
substr(col_, 1, 1) <- toupper(substr(col_, 1, 1))
|
||||||
|
|
@ -163,19 +168,27 @@ add_custom_microorganisms <- function(x) {
|
||||||
x[, col] <- col_
|
x[, col] <- col_
|
||||||
}
|
}
|
||||||
# if subspecies is a group or complex, add it to the species and empty the subspecies
|
# 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$species[which(x$subspecies %in% c("group", "Group", "complex"))] <- paste(
|
||||||
x$subspecies[which(x$subspecies %in% c("group", "Group", "complex"))])
|
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"))] <- ""
|
x$subspecies[which(x$subspecies %in% c("group", "Group", "complex"))] <- ""
|
||||||
|
|
||||||
if ("rank" %in% colnames(x)) {
|
if ("rank" %in% colnames(x)) {
|
||||||
stop_ifnot(all(x$rank %in% AMR_env$MO_lookup$rank),
|
stop_ifnot(
|
||||||
"the 'rank' column can only contain these values: ", vector_or(AMR_env$MO_lookup$rank))
|
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 {
|
} else {
|
||||||
x$rank <- ifelse(x$subspecies != "", "subspecies",
|
x$rank <- ifelse(x$subspecies != "", "subspecies",
|
||||||
ifelse(x$species != "", "species",
|
ifelse(x$species != "", "species",
|
||||||
ifelse(x$genus != "", "genus",
|
ifelse(x$genus != "", "genus",
|
||||||
stop("in add_custom_microorganisms(): only microorganisms up to the genus level can be added",
|
stop("in add_custom_microorganisms(): only microorganisms up to the genus level can be added",
|
||||||
call. = FALSE))))
|
call. = FALSE
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
}
|
}
|
||||||
x$source <- "Added by user"
|
x$source <- "Added by user"
|
||||||
if (!"fullname" %in% colnames(x)) {
|
if (!"fullname" %in% colnames(x)) {
|
||||||
|
|
@ -191,7 +204,7 @@ add_custom_microorganisms <- function(x) {
|
||||||
x$class[is.na(x$class)] <- ""
|
x$class[is.na(x$class)] <- ""
|
||||||
x$order[is.na(x$order)] <- ""
|
x$order[is.na(x$order)] <- ""
|
||||||
x$family[is.na(x$family)] <- ""
|
x$family[is.na(x$family)] <- ""
|
||||||
|
|
||||||
for (col in colnames(x)) {
|
for (col in colnames(x)) {
|
||||||
if (is.factor(x[, col, drop = TRUE])) {
|
if (is.factor(x[, col, drop = TRUE])) {
|
||||||
x[, col] <- as.character(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])
|
x[, col] <- as.list(x[, col, drop = TRUE])
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# fill in taxonomy based on genus
|
# fill in taxonomy based on genus
|
||||||
genus_to_check <- gsub("^(.*)[^a-zA-Z].*", "\\1", x$genus, perl = TRUE)
|
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)]
|
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$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$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)]
|
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
|
# fill in other columns that are used in internal algorithms
|
||||||
x$prevalence <- NA_real_
|
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)]
|
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$full_first <- substr(x$fullname_lower, 1, 1)
|
||||||
x$species_first <- tolower(substr(x$species, 1, 1))
|
x$species_first <- tolower(substr(x$species, 1, 1))
|
||||||
x$subspecies_first <- tolower(substr(x$subspecies, 1, 1))
|
x$subspecies_first <- tolower(substr(x$subspecies, 1, 1))
|
||||||
|
|
||||||
if (!"mo" %in% colnames(x)) {
|
if (!"mo" %in% colnames(x)) {
|
||||||
# create the mo code
|
# create the mo code
|
||||||
x$mo <- NA_character_
|
x$mo <- NA_character_
|
||||||
|
|
@ -230,19 +243,27 @@ add_custom_microorganisms <- function(x) {
|
||||||
x$mo <- trimws2(as.character(x$mo))
|
x$mo <- trimws2(as.character(x$mo))
|
||||||
x$mo[x$mo == ""] <- NA_character_
|
x$mo[x$mo == ""] <- NA_character_
|
||||||
current <- sum(AMR_env$MO_lookup$source == "Added by user", na.rm = TRUE)
|
current <- sum(AMR_env$MO_lookup$source == "Added by user", na.rm = TRUE)
|
||||||
x$mo[is.na(x$mo)] <- paste0("CUSTOM",
|
x$mo[is.na(x$mo)] <- paste0(
|
||||||
seq.int(from = current + 1, to = current + nrow(x), by = 1),
|
"CUSTOM",
|
||||||
"_",
|
seq.int(from = current + 1, to = current + nrow(x), by = 1),
|
||||||
toupper(unname(abbreviate(gsub(" +", " _ ",
|
"_",
|
||||||
gsub("[^A-Za-z0-9-]", " ",
|
toupper(unname(abbreviate(
|
||||||
trimws2(paste(x$genus, x$species, x$subspecies)))),
|
gsub(
|
||||||
minlength = 10))))
|
" +", " _ ",
|
||||||
|
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")
|
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 ----
|
# add to package ----
|
||||||
AMR_env$custom_mo_codes <- c(AMR_env$custom_mo_codes, x$mo)
|
AMR_env$custom_mo_codes <- c(AMR_env$custom_mo_codes, x$mo)
|
||||||
class(AMR_env$MO_lookup$mo) <- "character"
|
class(AMR_env$MO_lookup$mo) <- "character"
|
||||||
|
|
||||||
new_df <- AMR_env$MO_lookup[0, , drop = FALSE][seq_len(NROW(x)), , drop = FALSE]
|
new_df <- AMR_env$MO_lookup[0, , drop = FALSE][seq_len(NROW(x)), , drop = FALSE]
|
||||||
rownames(new_df) <- NULL
|
rownames(new_df) <- NULL
|
||||||
list_cols <- vapply(FUN.VALUE = logical(1), new_df, is.list)
|
list_cols <- vapply(FUN.VALUE = logical(1), new_df, is.list)
|
||||||
|
|
@ -254,10 +275,10 @@ add_custom_microorganisms <- function(x) {
|
||||||
# assign new values
|
# assign new values
|
||||||
new_df[, col] <- x[, col, drop = TRUE]
|
new_df[, col] <- x[, col, drop = TRUE]
|
||||||
}
|
}
|
||||||
|
|
||||||
# clear previous coercions
|
# clear previous coercions
|
||||||
suppressMessages(mo_reset_session())
|
suppressMessages(mo_reset_session())
|
||||||
|
|
||||||
AMR_env$MO_lookup <- unique(rbind(AMR_env$MO_lookup, new_df))
|
AMR_env$MO_lookup <- unique(rbind(AMR_env$MO_lookup, new_df))
|
||||||
class(AMR_env$MO_lookup$mo) <- c("mo", "character")
|
class(AMR_env$MO_lookup$mo) <- c("mo", "character")
|
||||||
if (nrow(x) <= 3) {
|
if (nrow(x) <= 3) {
|
||||||
|
|
@ -271,11 +292,11 @@ add_custom_microorganisms <- function(x) {
|
||||||
#' @export
|
#' @export
|
||||||
clear_custom_microorganisms <- function() {
|
clear_custom_microorganisms <- function() {
|
||||||
n <- nrow(AMR_env$MO_lookup)
|
n <- nrow(AMR_env$MO_lookup)
|
||||||
|
|
||||||
# reset
|
# reset
|
||||||
AMR_env$MO_lookup <- NULL
|
AMR_env$MO_lookup <- NULL
|
||||||
add_MO_lookup_to_AMR_env()
|
add_MO_lookup_to_AMR_env()
|
||||||
|
|
||||||
n2 <- nrow(AMR_env$MO_lookup)
|
n2 <- nrow(AMR_env$MO_lookup)
|
||||||
AMR_env$custom_mo_codes <- character(0)
|
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]
|
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]
|
||||||
|
|
|
||||||
10
R/data.R
10
R/data.R
|
|
@ -65,10 +65,10 @@
|
||||||
#'
|
#'
|
||||||
#' ### Direct download
|
#' ### 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).
|
#' 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): <https://www.whocc.no/atc_ddd_index/>
|
#' * World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology (WHOCC): <https://www.whocc.no/atc_ddd_index/>
|
||||||
#'
|
#'
|
||||||
#' * `r TAXONOMY_VERSION$LOINC$citation` Accessed from <`r TAXONOMY_VERSION$LOINC$url`> on `r documentation_date(TAXONOMY_VERSION$LOINC$accessed_date)`.
|
#' * `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: <https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm>
|
#' * European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: <https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm>
|
||||||
|
|
@ -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$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`>
|
#' * `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).
|
#' * 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}
|
#' * 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]
|
#' @seealso [as.mo()], [mo_property()], [microorganisms.codes], [intrinsic_resistant]
|
||||||
#' @examples
|
#' @examples
|
||||||
|
|
|
||||||
14
R/disk.R
14
R/disk.R
|
|
@ -120,13 +120,13 @@ as.disk <- function(x, na.rm = FALSE) {
|
||||||
vector_and(quotes = TRUE)
|
vector_and(quotes = TRUE)
|
||||||
cur_col <- get_current_column()
|
cur_col <- get_current_column()
|
||||||
warning_("in `as.disk()`: ", na_after - na_before, " result",
|
warning_("in `as.disk()`: ", na_after - na_before, " result",
|
||||||
ifelse(na_after - na_before > 1, "s", ""),
|
ifelse(na_after - na_before > 1, "s", ""),
|
||||||
ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")),
|
ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")),
|
||||||
" truncated (",
|
" truncated (",
|
||||||
round(((na_after - na_before) / length(x)) * 100),
|
round(((na_after - na_before) / length(x)) * 100),
|
||||||
"%) that were invalid disk zones: ",
|
"%) that were invalid disk zones: ",
|
||||||
list_missing,
|
list_missing,
|
||||||
call = FALSE
|
call = FALSE
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
||||||
13
R/episode.R
13
R/episode.R
|
|
@ -57,11 +57,12 @@
|
||||||
#' df[which(get_episode(df$date, 60) == 3), ]
|
#' df[which(get_episode(df$date, 60) == 3), ]
|
||||||
#'
|
#'
|
||||||
#' # the functions also work for less than a day, e.g. to include one per hour:
|
#' # the functions also work for less than a day, e.g. to include one per hour:
|
||||||
#' get_episode(c(
|
#' get_episode(
|
||||||
#' Sys.time(),
|
#' c(
|
||||||
#' Sys.time() + 60 * 60
|
#' Sys.time(),
|
||||||
#' ),
|
#' Sys.time() + 60 * 60
|
||||||
#' episode_days = 1 / 24
|
#' ),
|
||||||
|
#' episode_days = 1 / 24
|
||||||
#' )
|
#' )
|
||||||
#'
|
#'
|
||||||
#' \donttest{
|
#' \donttest{
|
||||||
|
|
@ -98,7 +99,6 @@
|
||||||
#' )
|
#' )
|
||||||
#' }
|
#' }
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # grouping on patients and microorganisms leads to the same
|
#' # grouping on patients and microorganisms leads to the same
|
||||||
#' # results as first_isolate() when using 'episode-based':
|
#' # results as first_isolate() when using 'episode-based':
|
||||||
#' x <- df %>%
|
#' x <- df %>%
|
||||||
|
|
@ -115,7 +115,6 @@
|
||||||
#' identical(x, y)
|
#' identical(x, y)
|
||||||
#' }
|
#' }
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # but is_new_episode() has a lot more flexibility than first_isolate(),
|
#' # but is_new_episode() has a lot more flexibility than first_isolate(),
|
||||||
#' # since you can now group on anything that seems relevant:
|
#' # since you can now group on anything that seems relevant:
|
||||||
#' df %>%
|
#' df %>%
|
||||||
|
|
|
||||||
|
|
@ -702,11 +702,12 @@ eucast_rules <- function(x,
|
||||||
# Print rule -------------------------------------------------------------
|
# Print rule -------------------------------------------------------------
|
||||||
if (rule_current != rule_previous) {
|
if (rule_current != rule_previous) {
|
||||||
# is new rule within group, print its name
|
# is new rule within group, print its name
|
||||||
cat(italicise_taxonomy(word_wrap(rule_current,
|
cat(italicise_taxonomy(
|
||||||
width = getOption("width") - 30,
|
word_wrap(rule_current,
|
||||||
extra_indent = 6
|
width = getOption("width") - 30,
|
||||||
),
|
extra_indent = 6
|
||||||
type = "ansi"
|
),
|
||||||
|
type = "ansi"
|
||||||
))
|
))
|
||||||
warned <- FALSE
|
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% "coagulase" && any(x$genus == "Staphylococcus", na.rm = TRUE)) {
|
||||||
if (mo_value %like% "negative") {
|
if (mo_value %like% "negative") {
|
||||||
eucast_rules_df[i, "this_value"] <- paste0(
|
eucast_rules_df[i, "this_value"] <- paste0(
|
||||||
"^(", paste0(all_staph[which(all_staph$CNS_CPS %like% "negative"),
|
"^(", paste0(
|
||||||
"fullname",
|
all_staph[which(all_staph$CNS_CPS %like% "negative"),
|
||||||
drop = TRUE
|
"fullname",
|
||||||
],
|
drop = TRUE
|
||||||
collapse = "|"
|
],
|
||||||
|
collapse = "|"
|
||||||
),
|
),
|
||||||
")$"
|
")$"
|
||||||
)
|
)
|
||||||
} else {
|
} else {
|
||||||
eucast_rules_df[i, "this_value"] <- paste0(
|
eucast_rules_df[i, "this_value"] <- paste0(
|
||||||
"^(", paste0(all_staph[which(all_staph$CNS_CPS %like% "positive"),
|
"^(", paste0(
|
||||||
"fullname",
|
all_staph[which(all_staph$CNS_CPS %like% "positive"),
|
||||||
drop = TRUE
|
"fullname",
|
||||||
],
|
drop = TRUE
|
||||||
collapse = "|"
|
],
|
||||||
|
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
|
# 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)) {
|
if (mo_value %like% "group [ABCG]" && any(x$genus == "Streptococcus", na.rm = TRUE)) {
|
||||||
eucast_rules_df[i, "this_value"] <- paste0(
|
eucast_rules_df[i, "this_value"] <- paste0(
|
||||||
"^(", paste0(all_strep[which(all_strep$Lancefield %like% "group [ABCG]"),
|
"^(", paste0(
|
||||||
"fullname",
|
all_strep[which(all_strep$Lancefield %like% "group [ABCG]"),
|
||||||
drop = TRUE
|
"fullname",
|
||||||
],
|
drop = TRUE
|
||||||
collapse = "|"
|
],
|
||||||
|
collapse = "|"
|
||||||
),
|
),
|
||||||
")$"
|
")$"
|
||||||
)
|
)
|
||||||
|
|
@ -789,15 +793,17 @@ eucast_rules <- function(x,
|
||||||
if (length(source_antibiotics) == 0) {
|
if (length(source_antibiotics) == 0) {
|
||||||
rows <- integer(0)
|
rows <- integer(0)
|
||||||
} else if (length(source_antibiotics) == 1) {
|
} else if (length(source_antibiotics) == 1) {
|
||||||
rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like% mo_value &
|
rows <- tryCatch(
|
||||||
as.sir_no_warning(x[, source_antibiotics[1L]]) == source_value[1L]),
|
which(x[, if_mo_property, drop = TRUE] %like% mo_value &
|
||||||
error = function(e) integer(0)
|
as.sir_no_warning(x[, source_antibiotics[1L]]) == source_value[1L]),
|
||||||
|
error = function(e) integer(0)
|
||||||
)
|
)
|
||||||
} else if (length(source_antibiotics) == 2) {
|
} else if (length(source_antibiotics) == 2) {
|
||||||
rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like% mo_value &
|
rows <- tryCatch(
|
||||||
as.sir_no_warning(x[, source_antibiotics[1L]]) == source_value[1L] &
|
which(x[, if_mo_property, drop = TRUE] %like% mo_value &
|
||||||
as.sir_no_warning(x[, source_antibiotics[2L]]) == source_value[2L]),
|
as.sir_no_warning(x[, source_antibiotics[1L]]) == source_value[1L] &
|
||||||
error = function(e) integer(0)
|
as.sir_no_warning(x[, source_antibiotics[2L]]) == source_value[2L]),
|
||||||
|
error = function(e) integer(0)
|
||||||
)
|
)
|
||||||
# nolint start
|
# nolint start
|
||||||
# } else if (length(source_antibiotics) == 3) {
|
# } else if (length(source_antibiotics) == 3) {
|
||||||
|
|
@ -872,11 +878,12 @@ eucast_rules <- function(x,
|
||||||
)
|
)
|
||||||
if (isTRUE(info)) {
|
if (isTRUE(info)) {
|
||||||
# print rule
|
# print rule
|
||||||
cat(italicise_taxonomy(word_wrap(format_custom_query_rule(rule$query, colours = FALSE),
|
cat(italicise_taxonomy(
|
||||||
width = getOption("width") - 30,
|
word_wrap(format_custom_query_rule(rule$query, colours = FALSE),
|
||||||
extra_indent = 6
|
width = getOption("width") - 30,
|
||||||
),
|
extra_indent = 6
|
||||||
type = "ansi"
|
),
|
||||||
|
type = "ansi"
|
||||||
))
|
))
|
||||||
warned <- FALSE
|
warned <- FALSE
|
||||||
}
|
}
|
||||||
|
|
@ -1117,14 +1124,15 @@ edit_sir <- function(x,
|
||||||
},
|
},
|
||||||
error = function(e) {
|
error = function(e) {
|
||||||
txt_error()
|
txt_error()
|
||||||
stop(paste0(
|
stop(
|
||||||
"In row(s) ", paste(rows[seq_len(min(length(rows), 10))], collapse = ","),
|
paste0(
|
||||||
ifelse(length(rows) > 10, "...", ""),
|
"In row(s) ", paste(rows[seq_len(min(length(rows), 10))], collapse = ","),
|
||||||
" while writing value '", to,
|
ifelse(length(rows) > 10, "...", ""),
|
||||||
"' to column(s) `", paste(cols, collapse = "`, `"),
|
" while writing value '", to,
|
||||||
"`:\n", e$message
|
"' to column(s) `", paste(cols, collapse = "`, `"),
|
||||||
),
|
"`:\n", e$message
|
||||||
call. = FALSE
|
),
|
||||||
|
call. = FALSE
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
|
||||||
|
|
@ -144,13 +144,11 @@
|
||||||
#' filter(first_isolate())
|
#' filter(first_isolate())
|
||||||
#' }
|
#' }
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # short-hand version:
|
#' # short-hand version:
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' filter_first_isolate(info = FALSE)
|
#' filter_first_isolate(info = FALSE)
|
||||||
#' }
|
#' }
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # flag the first isolates per group:
|
#' # flag the first isolates per group:
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' group_by(ward) %>%
|
#' group_by(ward) %>%
|
||||||
|
|
@ -244,18 +242,19 @@ first_isolate <- function(x = NULL,
|
||||||
method <- "episode-based"
|
method <- "episode-based"
|
||||||
}
|
}
|
||||||
if (isTRUE(info) && message_not_thrown_before("first_isolate", "method")) {
|
if (isTRUE(info) && message_not_thrown_before("first_isolate", "method")) {
|
||||||
message_(paste0(
|
message_(
|
||||||
"Determining first isolates ",
|
paste0(
|
||||||
ifelse(method %in% c("episode-based", "phenotype-based"),
|
"Determining first isolates ",
|
||||||
ifelse(is.infinite(episode_days),
|
ifelse(method %in% c("episode-based", "phenotype-based"),
|
||||||
"without a specified episode length",
|
ifelse(is.infinite(episode_days),
|
||||||
paste("using an episode length of", episode_days, "days")
|
"without a specified episode length",
|
||||||
),
|
paste("using an episode length of", episode_days, "days")
|
||||||
""
|
),
|
||||||
)
|
""
|
||||||
),
|
)
|
||||||
as_note = FALSE,
|
),
|
||||||
add_fn = font_black
|
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$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$episode_group <- paste(x$newvar_patient_id, x$newvar_genus_species)
|
||||||
x$more_than_episode_ago <- unlist(lapply(split(
|
x$more_than_episode_ago <- unlist(
|
||||||
x$newvar_date,
|
lapply(
|
||||||
x$episode_group
|
split(
|
||||||
),
|
x$newvar_date,
|
||||||
exec_episode, # this will skip meet_criteria() in is_new_episode(), saving time
|
x$episode_group
|
||||||
type = "logical",
|
),
|
||||||
episode_days = episode_days
|
exec_episode, # this will skip meet_criteria() in is_new_episode(), saving time
|
||||||
),
|
type = "logical",
|
||||||
use.names = FALSE
|
episode_days = episode_days
|
||||||
|
),
|
||||||
|
use.names = FALSE
|
||||||
)
|
)
|
||||||
|
|
||||||
if (!is.null(col_keyantimicrobials)) {
|
if (!is.null(col_keyantimicrobials)) {
|
||||||
|
|
@ -606,21 +607,22 @@ first_isolate <- function(x = NULL,
|
||||||
}
|
}
|
||||||
# mark up number of found
|
# mark up number of found
|
||||||
n_found <- format(n_found, big.mark = big.mark, decimal.mark = decimal.mark)
|
n_found <- format(n_found, big.mark = big.mark, decimal.mark = decimal.mark)
|
||||||
message_(paste0(
|
message_(
|
||||||
"=> Found ",
|
paste0(
|
||||||
font_bold(paste0(
|
"=> Found ",
|
||||||
n_found,
|
font_bold(paste0(
|
||||||
ifelse(method == "isolate-based", "", paste0(" '", method, "'")),
|
n_found,
|
||||||
" first isolates"
|
ifelse(method == "isolate-based", "", paste0(" '", method, "'")),
|
||||||
)),
|
" first isolates"
|
||||||
" (",
|
)),
|
||||||
ifelse(p_found_total != p_found_scope,
|
" (",
|
||||||
paste0(p_found_scope, " within scope and "),
|
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
|
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -414,13 +414,14 @@ pca_calculations <- function(pca_model,
|
||||||
sigma <- var(cbind(x$xvar, x$yvar))
|
sigma <- var(cbind(x$xvar, x$yvar))
|
||||||
mu <- c(mean(x$xvar), mean(x$yvar))
|
mu <- c(mean(x$xvar), mean(x$yvar))
|
||||||
ed <- sqrt(qchisq(ellipse_prob, df = 2))
|
ed <- sqrt(qchisq(ellipse_prob, df = 2))
|
||||||
data.frame(sweep(circle %*% chol(sigma) * ed,
|
data.frame(
|
||||||
MARGIN = 2,
|
sweep(circle %*% chol(sigma) * ed,
|
||||||
STATS = mu,
|
MARGIN = 2,
|
||||||
FUN = "+"
|
STATS = mu,
|
||||||
),
|
FUN = "+"
|
||||||
groups = x$groups[1],
|
),
|
||||||
stringsAsFactors = FALSE
|
groups = x$groups[1],
|
||||||
|
stringsAsFactors = FALSE
|
||||||
)
|
)
|
||||||
})
|
})
|
||||||
ell <- do.call(rbind, df.groups)
|
ell <- do.call(rbind, df.groups)
|
||||||
|
|
|
||||||
|
|
@ -71,13 +71,11 @@
|
||||||
#' @examples
|
#' @examples
|
||||||
#' \donttest{
|
#' \donttest{
|
||||||
#' if (require("ggplot2") && require("dplyr")) {
|
#' if (require("ggplot2") && require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # get antimicrobial results for drugs against a UTI:
|
#' # get antimicrobial results for drugs against a UTI:
|
||||||
#' ggplot(example_isolates %>% select(AMX, NIT, FOS, TMP, CIP)) +
|
#' ggplot(example_isolates %>% select(AMX, NIT, FOS, TMP, CIP)) +
|
||||||
#' geom_sir()
|
#' geom_sir()
|
||||||
#' }
|
#' }
|
||||||
#' if (require("ggplot2") && require("dplyr")) {
|
#' if (require("ggplot2") && require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # prettify the plot using some additional functions:
|
#' # prettify the plot using some additional functions:
|
||||||
#' df <- example_isolates %>% select(AMX, NIT, FOS, TMP, CIP)
|
#' df <- example_isolates %>% select(AMX, NIT, FOS, TMP, CIP)
|
||||||
#' ggplot(df) +
|
#' ggplot(df) +
|
||||||
|
|
@ -88,21 +86,18 @@
|
||||||
#' theme_sir()
|
#' theme_sir()
|
||||||
#' }
|
#' }
|
||||||
#' if (require("ggplot2") && require("dplyr")) {
|
#' if (require("ggplot2") && require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # or better yet, simplify this using the wrapper function - a single command:
|
#' # or better yet, simplify this using the wrapper function - a single command:
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' select(AMX, NIT, FOS, TMP, CIP) %>%
|
#' select(AMX, NIT, FOS, TMP, CIP) %>%
|
||||||
#' ggplot_sir()
|
#' ggplot_sir()
|
||||||
#' }
|
#' }
|
||||||
#' if (require("ggplot2") && require("dplyr")) {
|
#' if (require("ggplot2") && require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # get only proportions and no counts:
|
#' # get only proportions and no counts:
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' select(AMX, NIT, FOS, TMP, CIP) %>%
|
#' select(AMX, NIT, FOS, TMP, CIP) %>%
|
||||||
#' ggplot_sir(datalabels = FALSE)
|
#' ggplot_sir(datalabels = FALSE)
|
||||||
#' }
|
#' }
|
||||||
#' if (require("ggplot2") && require("dplyr")) {
|
#' if (require("ggplot2") && require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # add other ggplot2 arguments as you like:
|
#' # add other ggplot2 arguments as you like:
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' select(AMX, NIT, FOS, TMP, CIP) %>%
|
#' select(AMX, NIT, FOS, TMP, CIP) %>%
|
||||||
|
|
@ -115,14 +110,12 @@
|
||||||
#' )
|
#' )
|
||||||
#' }
|
#' }
|
||||||
#' if (require("ggplot2") && require("dplyr")) {
|
#' if (require("ggplot2") && require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # you can alter the colours with colour names:
|
#' # you can alter the colours with colour names:
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' select(AMX) %>%
|
#' select(AMX) %>%
|
||||||
#' ggplot_sir(colours = c(SI = "yellow"))
|
#' ggplot_sir(colours = c(SI = "yellow"))
|
||||||
#' }
|
#' }
|
||||||
#' if (require("ggplot2") && require("dplyr")) {
|
#' if (require("ggplot2") && require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # but you can also use the built-in colour-blind friendly colours for
|
#' # 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:
|
#' # your plots, where "S" is green, "I" is yellow and "R" is red:
|
||||||
#' data.frame(
|
#' data.frame(
|
||||||
|
|
@ -135,7 +128,6 @@
|
||||||
#' scale_sir_colours(Value4 = "S", Value5 = "I", Value6 = "R")
|
#' scale_sir_colours(Value4 = "S", Value5 = "I", Value6 = "R")
|
||||||
#' }
|
#' }
|
||||||
#' if (require("ggplot2") && require("dplyr")) {
|
#' if (require("ggplot2") && require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # resistance of ciprofloxacine per age group
|
#' # resistance of ciprofloxacine per age group
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' mutate(first_isolate = first_isolate()) %>%
|
#' mutate(first_isolate = first_isolate()) %>%
|
||||||
|
|
@ -149,14 +141,12 @@
|
||||||
#' ggplot_sir(x = "age_group")
|
#' ggplot_sir(x = "age_group")
|
||||||
#' }
|
#' }
|
||||||
#' if (require("ggplot2") && require("dplyr")) {
|
#' if (require("ggplot2") && require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # a shorter version which also adjusts data label colours:
|
#' # a shorter version which also adjusts data label colours:
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' select(AMX, NIT, FOS, TMP, CIP) %>%
|
#' select(AMX, NIT, FOS, TMP, CIP) %>%
|
||||||
#' ggplot_sir(colours = FALSE)
|
#' ggplot_sir(colours = FALSE)
|
||||||
#' }
|
#' }
|
||||||
#' if (require("ggplot2") && require("dplyr")) {
|
#' if (require("ggplot2") && require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # it also supports groups (don't forget to use the group var on `x` or `facet`):
|
#' # it also supports groups (don't forget to use the group var on `x` or `facet`):
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
#' filter(mo_is_gram_negative(), ward != "Outpatient") %>%
|
#' filter(mo_is_gram_negative(), ward != "Outpatient") %>%
|
||||||
|
|
|
||||||
|
|
@ -274,14 +274,15 @@ get_column_abx <- function(x,
|
||||||
}
|
}
|
||||||
if (names(out[i]) %in% names(duplicates)) {
|
if (names(out[i]) %in% names(duplicates)) {
|
||||||
already_set_as <- out[unname(out) == unname(out[i])][1L]
|
already_set_as <- out[unname(out) == unname(out[i])][1L]
|
||||||
warning_(paste0(
|
warning_(
|
||||||
"Column '", font_bold(out[i]), "' will not be used for ",
|
paste0(
|
||||||
names(out)[i], " (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ")",
|
"Column '", font_bold(out[i]), "' will not be used for ",
|
||||||
", as it is already set for ",
|
names(out)[i], " (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ")",
|
||||||
names(already_set_as), " (", ab_name(names(already_set_as), 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
|
add_fn = font_red,
|
||||||
|
immediate = verbose
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
@ -307,11 +308,12 @@ get_column_abx <- function(x,
|
||||||
if (isTRUE(info) && !all(soft_dependencies %in% names(out))) {
|
if (isTRUE(info) && !all(soft_dependencies %in% names(out))) {
|
||||||
# missing a soft dependency may lower the reliability
|
# missing a soft dependency may lower the reliability
|
||||||
missing <- soft_dependencies[!soft_dependencies %in% names(out)]
|
missing <- soft_dependencies[!soft_dependencies %in% names(out)]
|
||||||
missing_msg <- vector_and(paste0(
|
missing_msg <- vector_and(
|
||||||
ab_name(missing, tolower = TRUE, language = NULL),
|
paste0(
|
||||||
" (", font_bold(missing, collapse = NULL), ")"
|
ab_name(missing, tolower = TRUE, language = NULL),
|
||||||
),
|
" (", font_bold(missing, collapse = NULL), ")"
|
||||||
quotes = FALSE
|
),
|
||||||
|
quotes = FALSE
|
||||||
)
|
)
|
||||||
message_(
|
message_(
|
||||||
"Reliability would be improved if these antimicrobial results would be available too: ",
|
"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 {
|
} else {
|
||||||
any_txt <- c("", "are")
|
any_txt <- c("", "are")
|
||||||
}
|
}
|
||||||
warning_(paste0(
|
warning_(
|
||||||
"Introducing NAs since", any_txt[1], " these antimicrobials ", any_txt[2], " required: ",
|
paste0(
|
||||||
vector_and(missing, quotes = FALSE)
|
"Introducing NAs since", any_txt[1], " these antimicrobials ", any_txt[2], " required: ",
|
||||||
),
|
vector_and(missing, quotes = FALSE)
|
||||||
immediate = TRUE
|
),
|
||||||
|
immediate = TRUE
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -73,41 +73,44 @@ italicise_taxonomy <- function(string, type = c("markdown", "ansi")) {
|
||||||
search_strings <- gsub("[^a-zA-Z-]", "", s_split)
|
search_strings <- gsub("[^a-zA-Z-]", "", s_split)
|
||||||
|
|
||||||
ind_species <- search_strings != "" &
|
ind_species <- search_strings != "" &
|
||||||
search_strings %in% AMR_env$MO_lookup[which(AMR_env$MO_lookup$rank %in% c(
|
search_strings %in% AMR_env$MO_lookup[
|
||||||
"family",
|
which(AMR_env$MO_lookup$rank %in% c(
|
||||||
"genus",
|
"family",
|
||||||
|
"genus",
|
||||||
|
"species",
|
||||||
|
"subspecies",
|
||||||
|
"infraspecies",
|
||||||
|
"subsp."
|
||||||
|
)),
|
||||||
"species",
|
"species",
|
||||||
"subspecies",
|
drop = TRUE
|
||||||
"infraspecies",
|
|
||||||
"subsp."
|
|
||||||
)),
|
|
||||||
"species",
|
|
||||||
drop = TRUE
|
|
||||||
]
|
]
|
||||||
|
|
||||||
ind_fullname <- search_strings != "" &
|
ind_fullname <- search_strings != "" &
|
||||||
search_strings %in% c(
|
search_strings %in% c(
|
||||||
AMR_env$MO_lookup[which(AMR_env$MO_lookup$rank %in% c(
|
AMR_env$MO_lookup[
|
||||||
"family",
|
which(AMR_env$MO_lookup$rank %in% c(
|
||||||
"genus",
|
"family",
|
||||||
"species",
|
"genus",
|
||||||
"subspecies",
|
"species",
|
||||||
"infraspecies",
|
"subspecies",
|
||||||
"subsp."
|
"infraspecies",
|
||||||
)),
|
"subsp."
|
||||||
"fullname",
|
)),
|
||||||
drop = TRUE
|
"fullname",
|
||||||
|
drop = TRUE
|
||||||
],
|
],
|
||||||
AMR_env$MO_lookup[which(AMR_env$MO_lookup$rank %in% c(
|
AMR_env$MO_lookup[
|
||||||
"family",
|
which(AMR_env$MO_lookup$rank %in% c(
|
||||||
"genus",
|
"family",
|
||||||
"species",
|
"genus",
|
||||||
|
"species",
|
||||||
|
"subspecies",
|
||||||
|
"infraspecies",
|
||||||
|
"subsp."
|
||||||
|
)),
|
||||||
"subspecies",
|
"subspecies",
|
||||||
"infraspecies",
|
drop = TRUE
|
||||||
"subsp."
|
|
||||||
)),
|
|
||||||
"subspecies",
|
|
||||||
drop = TRUE
|
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -128,7 +128,7 @@ anti_join_microorganisms <- function(x, by = NULL, ...) {
|
||||||
|
|
||||||
join_microorganisms <- function(type, x, by, suffix, ...) {
|
join_microorganisms <- function(type, x, by, suffix, ...) {
|
||||||
add_MO_lookup_to_AMR_env()
|
add_MO_lookup_to_AMR_env()
|
||||||
|
|
||||||
if (!is.data.frame(x)) {
|
if (!is.data.frame(x)) {
|
||||||
if (pkg_is_available("tibble", also_load = FALSE)) {
|
if (pkg_is_available("tibble", also_load = FALSE)) {
|
||||||
x <- import_fn("tibble", "tibble")(mo = x)
|
x <- import_fn("tibble", "tibble")(mo = x)
|
||||||
|
|
|
||||||
448
R/mdro.R
448
R/mdro.R
|
|
@ -193,17 +193,17 @@ mdro <- function(x = NULL,
|
||||||
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
|
||||||
meet_criteria(verbose, 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)
|
meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
|
||||||
|
|
||||||
if (!any(is_sir_eligible(x))) {
|
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.")
|
stop_("There were no possible SIR columns found in the data set. Transform columns with `as.sir()` for valid antimicrobial interpretations.")
|
||||||
}
|
}
|
||||||
|
|
||||||
info.bak <- info
|
info.bak <- info
|
||||||
# don't thrown info's more than once per call
|
# don't thrown info's more than once per call
|
||||||
if (isTRUE(info)) {
|
if (isTRUE(info)) {
|
||||||
info <- message_not_thrown_before("mdro")
|
info <- message_not_thrown_before("mdro")
|
||||||
}
|
}
|
||||||
|
|
||||||
if (interactive() && isTRUE(verbose) && isTRUE(info)) {
|
if (interactive() && isTRUE(verbose) && isTRUE(info)) {
|
||||||
txt <- paste0(
|
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.",
|
"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)
|
return(x)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
group_msg <- ""
|
group_msg <- ""
|
||||||
if (isTRUE(info.bak)) {
|
if (isTRUE(info.bak)) {
|
||||||
# print group name if used in dplyr::group_by()
|
# 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
|
# force regular [data.frame], not a tibble or data.table
|
||||||
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
x <- as.data.frame(x, stringsAsFactors = FALSE)
|
||||||
|
|
||||||
if (pct_required_classes > 1) {
|
if (pct_required_classes > 1) {
|
||||||
# allow pct_required_classes = 75 -> pct_required_classes = 0.75
|
# allow pct_required_classes = 75 -> pct_required_classes = 0.75
|
||||||
pct_required_classes <- pct_required_classes / 100
|
pct_required_classes <- pct_required_classes / 100
|
||||||
}
|
}
|
||||||
|
|
||||||
guideline.bak <- guideline
|
guideline.bak <- guideline
|
||||||
if (is.list(guideline)) {
|
if (is.list(guideline)) {
|
||||||
# Custom MDRO guideline ---------------------------------------------------
|
# Custom MDRO guideline ---------------------------------------------------
|
||||||
|
|
@ -260,8 +260,8 @@ mdro <- function(x = NULL,
|
||||||
txt <- paste0(
|
txt <- paste0(
|
||||||
"Determining MDROs based on custom rules",
|
"Determining MDROs based on custom rules",
|
||||||
ifelse(isTRUE(attributes(guideline)$as_factor),
|
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
|
"invalid guideline: ", guideline.bak
|
||||||
)
|
)
|
||||||
guideline <- list(code = guideline)
|
guideline <- list(code = guideline)
|
||||||
|
|
||||||
# try to find columns based on type
|
# try to find columns based on type
|
||||||
# -- mo
|
# -- mo
|
||||||
if (is.null(col_mo)) {
|
if (is.null(col_mo)) {
|
||||||
|
|
@ -329,7 +329,7 @@ mdro <- function(x = NULL,
|
||||||
col_mo <- "mo"
|
col_mo <- "mo"
|
||||||
}
|
}
|
||||||
stop_if(is.null(col_mo), "`col_mo` must be set")
|
stop_if(is.null(col_mo), "`col_mo` must be set")
|
||||||
|
|
||||||
if (guideline$code == "cmi2012") {
|
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$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"
|
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$version <- "WHO/HTM/TB/2014.11, 2014"
|
||||||
guideline$source_url <- font_url("https://www.who.int/publications/i/item/9789241548809", "Direct download")
|
guideline$source_url <- font_url("https://www.who.int/publications/i/item/9789241548809", "Direct download")
|
||||||
guideline$type <- "MDR-TB's"
|
guideline$type <- "MDR-TB's"
|
||||||
|
|
||||||
# support per country:
|
# support per country:
|
||||||
} else if (guideline$code == "mrgn") {
|
} else if (guideline$code == "mrgn") {
|
||||||
guideline$name <- "Cross-border comparison of the Dutch and German guidelines on multidrug-resistant Gram-negative microorganisms"
|
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 {
|
} else {
|
||||||
stop("This guideline is currently unsupported: ", guideline$code, call. = FALSE)
|
stop("This guideline is currently unsupported: ", guideline$code, call. = FALSE)
|
||||||
}
|
}
|
||||||
|
|
||||||
if (guideline$code == "cmi2012") {
|
if (guideline$code == "cmi2012") {
|
||||||
cols_ab <- get_column_abx(
|
cols_ab <- get_column_abx(
|
||||||
x = x,
|
x = x,
|
||||||
|
|
@ -456,7 +456,7 @@ mdro <- function(x = NULL,
|
||||||
}
|
}
|
||||||
cols_ab <- c(cols_ab, c(AMP = unname(cols_ab[names(cols_ab) == "AMX"])))
|
cols_ab <- c(cols_ab, c(AMP = unname(cols_ab[names(cols_ab) == "AMX"])))
|
||||||
}
|
}
|
||||||
|
|
||||||
# nolint start
|
# nolint start
|
||||||
AMC <- cols_ab["AMC"]
|
AMC <- cols_ab["AMC"]
|
||||||
AMK <- cols_ab["AMK"]
|
AMK <- cols_ab["AMK"]
|
||||||
|
|
@ -601,13 +601,13 @@ mdro <- function(x = NULL,
|
||||||
abx_tb <- abx_tb[!is.na(abx_tb)]
|
abx_tb <- abx_tb[!is.na(abx_tb)]
|
||||||
stop_if(guideline$code == "tb" & length(abx_tb) == 0, "no antimycobacterials found in data set")
|
stop_if(guideline$code == "tb" & length(abx_tb) == 0, "no antimycobacterials found in data set")
|
||||||
# nolint end
|
# nolint end
|
||||||
|
|
||||||
if (isTRUE(combine_SI)) {
|
if (isTRUE(combine_SI)) {
|
||||||
search_result <- "R"
|
search_result <- "R"
|
||||||
} else {
|
} else {
|
||||||
search_result <- c("R", "I")
|
search_result <- c("R", "I")
|
||||||
}
|
}
|
||||||
|
|
||||||
if (isTRUE(info)) {
|
if (isTRUE(info)) {
|
||||||
if (isTRUE(combine_SI)) {
|
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"))
|
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(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",
|
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("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",
|
word_wrap(paste0(font_bold("Author(s): "), guideline$author), extra_indent = 11, as_note = FALSE), "\n",
|
||||||
ifelse(!is.na(guideline$version),
|
ifelse(!is.na(guideline$version),
|
||||||
paste0(word_wrap(paste0(font_bold("Version: "), guideline$version), extra_indent = 11, as_note = FALSE), "\n"),
|
paste0(word_wrap(paste0(font_bold("Version: "), guideline$version), extra_indent = 11, as_note = FALSE), "\n"),
|
||||||
""
|
""
|
||||||
),
|
),
|
||||||
paste0(font_bold("Source: "), guideline$source_url),
|
paste0(font_bold("Source: "), guideline$source_url),
|
||||||
"\n\n",
|
"\n\n",
|
||||||
sep = ""
|
sep = ""
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
ab_missing <- function(ab) {
|
ab_missing <- function(ab) {
|
||||||
isTRUE(ab %in% c(NULL, NA)) | length(ab) == 0
|
isTRUE(ab %in% c(NULL, NA)) | length(ab) == 0
|
||||||
}
|
}
|
||||||
|
|
@ -638,7 +638,7 @@ mdro <- function(x = NULL,
|
||||||
out[is.na(out)] <- FALSE
|
out[is.na(out)] <- FALSE
|
||||||
out
|
out
|
||||||
}
|
}
|
||||||
|
|
||||||
# antibiotic classes
|
# antibiotic classes
|
||||||
# nolint start
|
# nolint start
|
||||||
aminoglycosides <- c(TOB, GEN)
|
aminoglycosides <- c(TOB, GEN)
|
||||||
|
|
@ -649,17 +649,18 @@ mdro <- function(x = NULL,
|
||||||
carbapenems <- c(DOR, ETP, IPM, MEM, MEV)
|
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)
|
fluoroquinolones <- c(CIP, ENX, FLE, GAT, GEM, GRX, LVX, LOM, MFX, NOR, OFX, PAZ, PEF, PRU, RFL, SPX, TMX, TVA)
|
||||||
# nolint end
|
# nolint end
|
||||||
|
|
||||||
# helper function for editing the table
|
# helper function for editing the table
|
||||||
trans_tbl <- function(to, rows, cols, any_all) {
|
trans_tbl <- function(to, rows, cols, any_all) {
|
||||||
cols <- cols[!ab_missing(cols)]
|
cols <- cols[!ab_missing(cols)]
|
||||||
cols <- cols[!is.na(cols)]
|
cols <- cols[!is.na(cols)]
|
||||||
if (length(rows) > 0 && length(cols) > 0) {
|
if (length(rows) > 0 && length(cols) > 0) {
|
||||||
x[, cols] <- as.data.frame(lapply(
|
x[, cols] <- as.data.frame(
|
||||||
x[, cols, drop = FALSE],
|
lapply(
|
||||||
function(col) as.sir(col)
|
x[, cols, drop = FALSE],
|
||||||
),
|
function(col) as.sir(col)
|
||||||
stringsAsFactors = FALSE
|
),
|
||||||
|
stringsAsFactors = FALSE
|
||||||
)
|
)
|
||||||
x[rows, "columns_nonsusceptible"] <<- vapply(
|
x[rows, "columns_nonsusceptible"] <<- vapply(
|
||||||
FUN.VALUE = character(1),
|
FUN.VALUE = character(1),
|
||||||
|
|
@ -670,22 +671,23 @@ mdro <- function(x = NULL,
|
||||||
x[row, group_vct, drop = FALSE],
|
x[row, group_vct, drop = FALSE],
|
||||||
function(y) y %in% search_result
|
function(y) y %in% search_result
|
||||||
)
|
)
|
||||||
paste(sort(c(
|
paste(
|
||||||
unlist(strsplit(x[row, "columns_nonsusceptible", drop = TRUE], ", ", fixed = TRUE)),
|
sort(c(
|
||||||
names(cols_nonsus)[cols_nonsus]
|
unlist(strsplit(x[row, "columns_nonsusceptible", drop = TRUE], ", ", fixed = TRUE)),
|
||||||
)),
|
names(cols_nonsus)[cols_nonsus]
|
||||||
collapse = ", "
|
)),
|
||||||
|
collapse = ", "
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
if (any_all == "any") {
|
if (any_all == "any") {
|
||||||
search_function <- any
|
search_function <- any
|
||||||
} else if (any_all == "all") {
|
} else if (any_all == "all") {
|
||||||
search_function <- all
|
search_function <- all
|
||||||
}
|
}
|
||||||
x_transposed <- as.list(as.data.frame(t(x[, cols, drop = FALSE]),
|
x_transposed <- as.list(as.data.frame(t(x[, cols, drop = FALSE]),
|
||||||
stringsAsFactors = FALSE
|
stringsAsFactors = FALSE
|
||||||
))
|
))
|
||||||
rows_affected <- vapply(
|
rows_affected <- vapply(
|
||||||
FUN.VALUE = logical(1),
|
FUN.VALUE = logical(1),
|
||||||
|
|
@ -704,7 +706,7 @@ mdro <- function(x = NULL,
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
trans_tbl2 <- function(txt, rows, lst) {
|
trans_tbl2 <- function(txt, rows, lst) {
|
||||||
if (isTRUE(info)) {
|
if (isTRUE(info)) {
|
||||||
message_(txt, "...", appendLF = FALSE, as_note = FALSE)
|
message_(txt, "...", appendLF = FALSE, as_note = FALSE)
|
||||||
|
|
@ -714,12 +716,13 @@ mdro <- function(x = NULL,
|
||||||
lst_vector <- unlist(lst)[!is.na(unlist(lst))]
|
lst_vector <- unlist(lst)[!is.na(unlist(lst))]
|
||||||
# keep only unique ones:
|
# keep only unique ones:
|
||||||
lst_vector <- lst_vector[!duplicated(paste(lst_vector, names(lst_vector)))]
|
lst_vector <- lst_vector[!duplicated(paste(lst_vector, names(lst_vector)))]
|
||||||
|
|
||||||
x[, lst_vector] <- as.data.frame(lapply(
|
x[, lst_vector] <- as.data.frame(
|
||||||
x[, lst_vector, drop = FALSE],
|
lapply(
|
||||||
function(col) as.sir(col)
|
x[, lst_vector, drop = FALSE],
|
||||||
),
|
function(col) as.sir(col)
|
||||||
stringsAsFactors = FALSE
|
),
|
||||||
|
stringsAsFactors = FALSE
|
||||||
)
|
)
|
||||||
x[rows, "classes_in_guideline"] <<- length(lst)
|
x[rows, "classes_in_guideline"] <<- length(lst)
|
||||||
x[rows, "classes_available"] <<- vapply(
|
x[rows, "classes_available"] <<- vapply(
|
||||||
|
|
@ -733,7 +736,7 @@ mdro <- function(x = NULL,
|
||||||
))
|
))
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
if (isTRUE(verbose)) {
|
if (isTRUE(verbose)) {
|
||||||
x[rows, "columns_nonsusceptible"] <<- vapply(
|
x[rows, "columns_nonsusceptible"] <<- vapply(
|
||||||
FUN.VALUE = character(1),
|
FUN.VALUE = character(1),
|
||||||
|
|
@ -748,30 +751,31 @@ mdro <- function(x = NULL,
|
||||||
FUN.VALUE = double(1),
|
FUN.VALUE = double(1),
|
||||||
rows,
|
rows,
|
||||||
function(row, group_tbl = lst) {
|
function(row, group_tbl = lst) {
|
||||||
sum(vapply(
|
sum(
|
||||||
FUN.VALUE = logical(1),
|
vapply(
|
||||||
group_tbl,
|
FUN.VALUE = logical(1),
|
||||||
function(group) {
|
group_tbl,
|
||||||
any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% search_result, na.rm = TRUE)
|
function(group) {
|
||||||
}
|
any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% search_result, na.rm = TRUE)
|
||||||
),
|
}
|
||||||
na.rm = TRUE
|
),
|
||||||
|
na.rm = TRUE
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
# for PDR; all drugs are R (or I if combine_SI = FALSE)
|
# 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]),
|
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))
|
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
|
x[which(row_filter), "classes_affected"] <<- 999
|
||||||
}
|
}
|
||||||
|
|
||||||
if (isTRUE(info)) {
|
if (isTRUE(info)) {
|
||||||
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
|
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
x[, col_mo] <- as.mo(as.character(x[, col_mo, drop = TRUE]))
|
x[, col_mo] <- as.mo(as.character(x[, col_mo, drop = TRUE]))
|
||||||
# rename col_mo to prevent interference with joined columns
|
# rename col_mo to prevent interference with joined columns
|
||||||
colnames(x)[colnames(x) == col_mo] <- ".col_mo"
|
colnames(x)[colnames(x) == col_mo] <- ".col_mo"
|
||||||
|
|
@ -782,12 +786,12 @@ mdro <- function(x = NULL,
|
||||||
x$row_number <- seq_len(nrow(x))
|
x$row_number <- seq_len(nrow(x))
|
||||||
x$reason <- paste0("not covered by ", toupper(guideline$code), " guideline")
|
x$reason <- paste0("not covered by ", toupper(guideline$code), " guideline")
|
||||||
x$columns_nonsusceptible <- ""
|
x$columns_nonsusceptible <- ""
|
||||||
|
|
||||||
if (guideline$code == "cmi2012") {
|
if (guideline$code == "cmi2012") {
|
||||||
# CMI, 2012 ---------------------------------------------------------------
|
# CMI, 2012 ---------------------------------------------------------------
|
||||||
# Non-susceptible = R and I
|
# Non-susceptible = R and I
|
||||||
# (see header 'Approaches to Creating Definitions for MDR, XDR and PDR' in paper)
|
# (see header 'Approaches to Creating Definitions for MDR, XDR and PDR' in paper)
|
||||||
|
|
||||||
# take amoxicillin if ampicillin is unavailable
|
# take amoxicillin if ampicillin is unavailable
|
||||||
if (is.na(AMP) && !is.na(AMX)) {
|
if (is.na(AMP) && !is.na(AMX)) {
|
||||||
if (isTRUE(verbose)) {
|
if (isTRUE(verbose)) {
|
||||||
|
|
@ -808,87 +812,87 @@ mdro <- function(x = NULL,
|
||||||
}
|
}
|
||||||
CTX <- CRO
|
CTX <- CRO
|
||||||
}
|
}
|
||||||
|
|
||||||
# intrinsic resistant must not be considered for the determination of MDR,
|
# intrinsic resistant must not be considered for the determination of MDR,
|
||||||
# so let's just remove them, meticulously following the paper
|
# 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 == "faecium"), ab_NA(IPM)] <- NA
|
||||||
x[which(x$genus == "Enterococcus" & x$species == "faecalis"), ab_NA(QDA)] <- NA
|
x[which(x$genus == "Enterococcus" & x$species == "faecalis"), ab_NA(QDA)] <- NA
|
||||||
x[which((x$genus == "Providencia" & x$species == "rettgeri") |
|
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 == "Escherichia" & x$species == "hermannii"), ab_NA(c(TCC, TZP))] <- NA
|
||||||
x[which((x$genus == "Citrobacter" & x$species == "freundii") |
|
x[which((x$genus == "Citrobacter" & x$species == "freundii") |
|
||||||
(x$genus == "Enterobacter" & x$species == "aerogenes") |
|
(x$genus == "Enterobacter" & x$species == "aerogenes") |
|
||||||
(x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
|
(x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
|
||||||
| (x$genus == "Enterobacter" & x$species == "cloacae") |
|
| (x$genus == "Enterobacter" & x$species == "cloacae") |
|
||||||
(x$genus == "Hafnia" & x$species == "alvei") |
|
(x$genus == "Hafnia" & x$species == "alvei") |
|
||||||
(x$genus == "Morganella" & x$species == "morganii") |
|
(x$genus == "Morganella" & x$species == "morganii") |
|
||||||
(x$genus == "Proteus" & x$species == "penneri") |
|
(x$genus == "Proteus" & x$species == "penneri") |
|
||||||
(x$genus == "Proteus" & x$species == "vulgaris") |
|
(x$genus == "Proteus" & x$species == "vulgaris") |
|
||||||
(x$genus == "Serratia" & x$species == "marcescens")), ab_NA(CZO)] <- NA
|
(x$genus == "Serratia" & x$species == "marcescens")), ab_NA(CZO)] <- NA
|
||||||
x[which((x$genus == "Morganella" & x$species == "morganii") |
|
x[which((x$genus == "Morganella" & x$species == "morganii") |
|
||||||
(x$genus == "Proteus" & x$species == "penneri") |
|
(x$genus == "Proteus" & x$species == "penneri") |
|
||||||
(x$genus == "Proteus" & x$species == "vulgaris") |
|
(x$genus == "Proteus" & x$species == "vulgaris") |
|
||||||
(x$genus == "Serratia" & x$species == "marcescens")), ab_NA(CXM)] <- NA
|
(x$genus == "Serratia" & x$species == "marcescens")), ab_NA(CXM)] <- NA
|
||||||
x[which((x$genus == "Morganella" & x$species == "morganii") |
|
x[which((x$genus == "Morganella" & x$species == "morganii") |
|
||||||
(x$genus == "Proteus" & x$species == "mirabilis") |
|
(x$genus == "Proteus" & x$species == "mirabilis") |
|
||||||
(x$genus == "Proteus" & x$species == "penneri") |
|
(x$genus == "Proteus" & x$species == "penneri") |
|
||||||
(x$genus == "Proteus" & x$species == "vulgaris") |
|
(x$genus == "Proteus" & x$species == "vulgaris") |
|
||||||
(x$genus == "Providencia" & x$species == "rettgeri") |
|
(x$genus == "Providencia" & x$species == "rettgeri") |
|
||||||
(x$genus == "Providencia" & x$species == "stuartii")), ab_NA(TGC)] <- NA
|
(x$genus == "Providencia" & x$species == "stuartii")), ab_NA(TGC)] <- NA
|
||||||
x[which((x$genus == "Citrobacter" & x$species == "koseri") |
|
x[which((x$genus == "Citrobacter" & x$species == "koseri") |
|
||||||
(x$genus == "Citrobacter" & x$species == "freundii") |
|
(x$genus == "Citrobacter" & x$species == "freundii") |
|
||||||
(x$genus == "Enterobacter" & x$species == "aerogenes") |
|
(x$genus == "Enterobacter" & x$species == "aerogenes") |
|
||||||
(x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
|
(x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
|
||||||
| (x$genus == "Enterobacter" & x$species == "cloacae") |
|
| (x$genus == "Enterobacter" & x$species == "cloacae") |
|
||||||
(x$genus == "Escherichia" & x$species == "hermannii") |
|
(x$genus == "Escherichia" & x$species == "hermannii") |
|
||||||
(x$genus == "Hafnia" & x$species == "alvei") |
|
(x$genus == "Hafnia" & x$species == "alvei") |
|
||||||
(x$genus == "Klebsiella") |
|
(x$genus == "Klebsiella") |
|
||||||
(x$genus == "Morganella" & x$species == "morganii") |
|
(x$genus == "Morganella" & x$species == "morganii") |
|
||||||
(x$genus == "Proteus" & x$species == "penneri") |
|
(x$genus == "Proteus" & x$species == "penneri") |
|
||||||
(x$genus == "Proteus" & x$species == "vulgaris") |
|
(x$genus == "Proteus" & x$species == "vulgaris") |
|
||||||
(x$genus == "Providencia" & x$species == "rettgeri") |
|
(x$genus == "Providencia" & x$species == "rettgeri") |
|
||||||
(x$genus == "Providencia" & x$species == "stuartii") |
|
(x$genus == "Providencia" & x$species == "stuartii") |
|
||||||
(x$genus == "Serratia" & x$species == "marcescens")), ab_NA(AMP)] <- NA
|
(x$genus == "Serratia" & x$species == "marcescens")), ab_NA(AMP)] <- NA
|
||||||
x[which((x$genus == "Citrobacter" & x$species == "freundii") |
|
x[which((x$genus == "Citrobacter" & x$species == "freundii") |
|
||||||
(x$genus == "Enterobacter" & x$species == "aerogenes") |
|
(x$genus == "Enterobacter" & x$species == "aerogenes") |
|
||||||
(x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
|
(x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
|
||||||
| (x$genus == "Enterobacter" & x$species == "cloacae") |
|
| (x$genus == "Enterobacter" & x$species == "cloacae") |
|
||||||
(x$genus == "Hafnia" & x$species == "alvei") |
|
(x$genus == "Hafnia" & x$species == "alvei") |
|
||||||
(x$genus == "Morganella" & x$species == "morganii") |
|
(x$genus == "Morganella" & x$species == "morganii") |
|
||||||
(x$genus == "Providencia" & x$species == "rettgeri") |
|
(x$genus == "Providencia" & x$species == "rettgeri") |
|
||||||
(x$genus == "Providencia" & x$species == "stuartii") |
|
(x$genus == "Providencia" & x$species == "stuartii") |
|
||||||
(x$genus == "Serratia" & x$species == "marcescens")), ab_NA(AMC)] <- NA
|
(x$genus == "Serratia" & x$species == "marcescens")), ab_NA(AMC)] <- NA
|
||||||
x[which((x$genus == "Citrobacter" & x$species == "freundii") |
|
x[which((x$genus == "Citrobacter" & x$species == "freundii") |
|
||||||
(x$genus == "Citrobacter" & x$species == "koseri") |
|
(x$genus == "Citrobacter" & x$species == "koseri") |
|
||||||
(x$genus == "Enterobacter" & x$species == "aerogenes") |
|
(x$genus == "Enterobacter" & x$species == "aerogenes") |
|
||||||
(x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
|
(x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
|
||||||
| (x$genus == "Enterobacter" & x$species == "cloacae") |
|
| (x$genus == "Enterobacter" & x$species == "cloacae") |
|
||||||
(x$genus == "Hafnia" & x$species == "alvei") |
|
(x$genus == "Hafnia" & x$species == "alvei") |
|
||||||
(x$genus == "Providencia" & x$species == "rettgeri") |
|
(x$genus == "Providencia" & x$species == "rettgeri") |
|
||||||
(x$genus == "Serratia" & x$species == "marcescens")), ab_NA(SAM)] <- NA
|
(x$genus == "Serratia" & x$species == "marcescens")), ab_NA(SAM)] <- NA
|
||||||
x[which((x$genus == "Morganella" & x$species == "morganii") |
|
x[which((x$genus == "Morganella" & x$species == "morganii") |
|
||||||
(x$genus == "Proteus" & x$species == "mirabilis") |
|
(x$genus == "Proteus" & x$species == "mirabilis") |
|
||||||
(x$genus == "Proteus" & x$species == "penneri") |
|
(x$genus == "Proteus" & x$species == "penneri") |
|
||||||
(x$genus == "Proteus" & x$species == "vulgaris") |
|
(x$genus == "Proteus" & x$species == "vulgaris") |
|
||||||
(x$genus == "Providencia" & x$species == "rettgeri") |
|
(x$genus == "Providencia" & x$species == "rettgeri") |
|
||||||
(x$genus == "Providencia" & x$species == "stuartii") |
|
(x$genus == "Providencia" & x$species == "stuartii") |
|
||||||
(x$genus == "Serratia" & x$species == "marcescens")), ab_NA(COL)] <- NA
|
(x$genus == "Serratia" & x$species == "marcescens")), ab_NA(COL)] <- NA
|
||||||
x[which((x$genus == "Morganella" & x$species == "morganii") |
|
x[which((x$genus == "Morganella" & x$species == "morganii") |
|
||||||
(x$genus == "Proteus" & x$species == "mirabilis") |
|
(x$genus == "Proteus" & x$species == "mirabilis") |
|
||||||
(x$genus == "Proteus" & x$species == "penneri") |
|
(x$genus == "Proteus" & x$species == "penneri") |
|
||||||
(x$genus == "Proteus" & x$species == "vulgaris") |
|
(x$genus == "Proteus" & x$species == "vulgaris") |
|
||||||
(x$genus == "Providencia" & x$species == "rettgeri") |
|
(x$genus == "Providencia" & x$species == "rettgeri") |
|
||||||
(x$genus == "Providencia" & x$species == "stuartii")), ab_NA(TCY)] <- NA
|
(x$genus == "Providencia" & x$species == "stuartii")), ab_NA(TCY)] <- NA
|
||||||
x[which((x$genus == "Morganella" & x$species == "morganii") |
|
x[which((x$genus == "Morganella" & x$species == "morganii") |
|
||||||
(x$genus == "Proteus" & x$species == "penneri") |
|
(x$genus == "Proteus" & x$species == "penneri") |
|
||||||
(x$genus == "Proteus" & x$species == "vulgaris") |
|
(x$genus == "Proteus" & x$species == "vulgaris") |
|
||||||
(x$genus == "Providencia" & x$species == "rettgeri") |
|
(x$genus == "Providencia" & x$species == "rettgeri") |
|
||||||
(x$genus == "Providencia" & x$species == "stuartii")), ab_NA(c(DOX, MNO))] <- NA
|
(x$genus == "Providencia" & x$species == "stuartii")), ab_NA(c(DOX, MNO))] <- NA
|
||||||
|
|
||||||
x$classes_in_guideline <- NA_integer_
|
x$classes_in_guideline <- NA_integer_
|
||||||
x$classes_available <- NA_integer_
|
x$classes_available <- NA_integer_
|
||||||
x$classes_affected <- NA_integer_
|
x$classes_affected <- NA_integer_
|
||||||
|
|
||||||
# now add the MDR levels to the data
|
# now add the MDR levels to the data
|
||||||
trans_tbl(
|
trans_tbl(
|
||||||
2,
|
2,
|
||||||
|
|
@ -990,7 +994,7 @@ mdro <- function(x = NULL,
|
||||||
c(TCY, DOX, MNO)
|
c(TCY, DOX, MNO)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
# now set MDROs:
|
# now set MDROs:
|
||||||
# MDR (=2): >=3 classes affected
|
# MDR (=2): >=3 classes affected
|
||||||
x[which(x$classes_affected >= 3), "MDRO"] <- 2
|
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"
|
" out of ", x$classes_available[which(x$classes_affected >= 3)], " available classes"
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
# XDR (=3): all but <=2 classes affected
|
# XDR (=3): all but <=2 classes affected
|
||||||
x[which((x$classes_in_guideline - x$classes_affected) <= 2), "MDRO"] <- 3
|
x[which((x$classes_in_guideline - x$classes_affected) <= 2), "MDRO"] <- 3
|
||||||
if (isTRUE(verbose)) {
|
if (isTRUE(verbose)) {
|
||||||
|
|
@ -1011,7 +1015,7 @@ mdro <- function(x = NULL,
|
||||||
" out of ", x$classes_in_guideline[which(x$MDRO == 3)], " classes)"
|
" out of ", x$classes_in_guideline[which(x$MDRO == 3)], " classes)"
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
# PDR (=4): all drugs are R
|
# PDR (=4): all drugs are R
|
||||||
x[which(x$classes_affected == 999 & x$classes_in_guideline == x$classes_available), "MDRO"] <- 4
|
x[which(x$classes_affected == 999 & x$classes_in_guideline == x$classes_available), "MDRO"] <- 4
|
||||||
if (isTRUE(verbose)) {
|
if (isTRUE(verbose)) {
|
||||||
|
|
@ -1022,7 +1026,7 @@ mdro <- function(x = NULL,
|
||||||
ifelse(!isTRUE(combine_SI), " or I", "")
|
ifelse(!isTRUE(combine_SI), " or I", "")
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
# not enough classes available
|
# 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
|
x[which(x$MDRO %in% c(1, 3) & x$classes_available < floor(x$classes_in_guideline * pct_required_classes)), "MDRO"] <- -1
|
||||||
if (isTRUE(verbose)) {
|
if (isTRUE(verbose)) {
|
||||||
|
|
@ -1032,18 +1036,18 @@ mdro <- function(x = NULL,
|
||||||
" (~", percentage(pct_required_classes), " of ", x$classes_in_guideline[which(x$MDRO == -1)], ")"
|
" (~", percentage(pct_required_classes), " of ", x$classes_in_guideline[which(x$MDRO == -1)], ")"
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
# add antibiotic names of resistant ones to verbose output
|
# add antibiotic names of resistant ones to verbose output
|
||||||
}
|
}
|
||||||
|
|
||||||
if (guideline$code == "eucast3.1") {
|
if (guideline$code == "eucast3.1") {
|
||||||
# EUCAST 3.1 --------------------------------------------------------------
|
# EUCAST 3.1 --------------------------------------------------------------
|
||||||
# Table 5
|
# Table 5
|
||||||
trans_tbl(
|
trans_tbl(
|
||||||
3,
|
3,
|
||||||
which(x$order == "Enterobacterales" |
|
which(x$order == "Enterobacterales" |
|
||||||
(x$genus == "Pseudomonas" & x$species == "aeruginosa") |
|
(x$genus == "Pseudomonas" & x$species == "aeruginosa") |
|
||||||
x$genus == "Acinetobacter"),
|
x$genus == "Acinetobacter"),
|
||||||
COL,
|
COL,
|
||||||
"all"
|
"all"
|
||||||
)
|
)
|
||||||
|
|
@ -1128,17 +1132,17 @@ mdro <- function(x = NULL,
|
||||||
"any"
|
"any"
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
if (guideline$code == "eucast3.2") {
|
if (guideline$code == "eucast3.2") {
|
||||||
# EUCAST 3.2 --------------------------------------------------------------
|
# EUCAST 3.2 --------------------------------------------------------------
|
||||||
# Table 6
|
# Table 6
|
||||||
trans_tbl(
|
trans_tbl(
|
||||||
3,
|
3,
|
||||||
which((x$order == "Enterobacterales" &
|
which((x$order == "Enterobacterales" &
|
||||||
!x$family == "Morganellaceae" &
|
!x$family == "Morganellaceae" &
|
||||||
!(x$genus == "Serratia" & x$species == "marcescens")) |
|
!(x$genus == "Serratia" & x$species == "marcescens")) |
|
||||||
(x$genus == "Pseudomonas" & x$species == "aeruginosa") |
|
(x$genus == "Pseudomonas" & x$species == "aeruginosa") |
|
||||||
x$genus == "Acinetobacter"),
|
x$genus == "Acinetobacter"),
|
||||||
COL,
|
COL,
|
||||||
"all"
|
"all"
|
||||||
)
|
)
|
||||||
|
|
@ -1229,7 +1233,7 @@ mdro <- function(x = NULL,
|
||||||
"any"
|
"any"
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
if (guideline$code == "eucast3.3") {
|
if (guideline$code == "eucast3.3") {
|
||||||
# EUCAST 3.3 --------------------------------------------------------------
|
# EUCAST 3.3 --------------------------------------------------------------
|
||||||
# note: this guideline is equal to EUCAST 3.2 - no MDRO insights changed
|
# note: this guideline is equal to EUCAST 3.2 - no MDRO insights changed
|
||||||
|
|
@ -1237,10 +1241,10 @@ mdro <- function(x = NULL,
|
||||||
trans_tbl(
|
trans_tbl(
|
||||||
3,
|
3,
|
||||||
which((x$order == "Enterobacterales" &
|
which((x$order == "Enterobacterales" &
|
||||||
!x$family == "Morganellaceae" &
|
!x$family == "Morganellaceae" &
|
||||||
!(x$genus == "Serratia" & x$species == "marcescens")) |
|
!(x$genus == "Serratia" & x$species == "marcescens")) |
|
||||||
(x$genus == "Pseudomonas" & x$species == "aeruginosa") |
|
(x$genus == "Pseudomonas" & x$species == "aeruginosa") |
|
||||||
x$genus == "Acinetobacter"),
|
x$genus == "Acinetobacter"),
|
||||||
COL,
|
COL,
|
||||||
"all"
|
"all"
|
||||||
)
|
)
|
||||||
|
|
@ -1331,72 +1335,72 @@ mdro <- function(x = NULL,
|
||||||
"any"
|
"any"
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
if (guideline$code == "mrgn") {
|
if (guideline$code == "mrgn") {
|
||||||
# Germany -----------------------------------------------------------------
|
# Germany -----------------------------------------------------------------
|
||||||
|
|
||||||
# Table 1
|
# Table 1
|
||||||
trans_tbl(
|
trans_tbl(
|
||||||
2, # 3MRGN
|
2, # 3MRGN
|
||||||
which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
|
which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
|
||||||
(x$genus == "Acinetobacter" & x$species == "baumannii")) &
|
(x$genus == "Acinetobacter" & x$species == "baumannii")) &
|
||||||
try_ab(x[, PIP, 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[, 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[, IPM, drop = TRUE] != "R") | try_ab(x[, MEM, drop = TRUE] != "R")) &
|
||||||
try_ab(x[, CIP, drop = TRUE] == "R")),
|
try_ab(x[, CIP, drop = TRUE] == "R")),
|
||||||
c(PIP, CTX, CAZ, IPM, MEM, CIP),
|
c(PIP, CTX, CAZ, IPM, MEM, CIP),
|
||||||
"any"
|
"any"
|
||||||
)
|
)
|
||||||
|
|
||||||
trans_tbl(
|
trans_tbl(
|
||||||
3, # 4MRGN, overwrites 3MRGN if applicable
|
3, # 4MRGN, overwrites 3MRGN if applicable
|
||||||
which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
|
which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
|
||||||
(x$genus == "Acinetobacter" & x$species == "baumannii")) &
|
(x$genus == "Acinetobacter" & x$species == "baumannii")) &
|
||||||
try_ab(x[, PIP, 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[, 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[, IPM, drop = TRUE] == "R") | try_ab(x[, MEM, drop = TRUE] == "R")) &
|
||||||
try_ab(x[, CIP, drop = TRUE] == "R")),
|
try_ab(x[, CIP, drop = TRUE] == "R")),
|
||||||
c(PIP, CTX, CAZ, IPM, MEM, CIP),
|
c(PIP, CTX, CAZ, IPM, MEM, CIP),
|
||||||
"any"
|
"any"
|
||||||
)
|
)
|
||||||
|
|
||||||
trans_tbl(
|
trans_tbl(
|
||||||
3, # 4MRGN, overwrites 3MRGN if applicable
|
3, # 4MRGN, overwrites 3MRGN if applicable
|
||||||
which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
|
which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
|
||||||
(x$genus == "Acinetobacter" & x$species == "baumannii")) &
|
(x$genus == "Acinetobacter" & x$species == "baumannii")) &
|
||||||
(try_ab(x[, IPM, drop = TRUE] == "R") | try_ab(x[, MEM, drop = TRUE] == "R"))),
|
(try_ab(x[, IPM, drop = TRUE] == "R") | try_ab(x[, MEM, drop = TRUE] == "R"))),
|
||||||
c(IPM, MEM),
|
c(IPM, MEM),
|
||||||
"any"
|
"any"
|
||||||
)
|
)
|
||||||
|
|
||||||
trans_tbl(
|
trans_tbl(
|
||||||
2, # 3MRGN, if only 1 group is S
|
2, # 3MRGN, if only 1 group is S
|
||||||
which(x$genus == "Pseudomonas" & x$species == "aeruginosa" &
|
which(x$genus == "Pseudomonas" & x$species == "aeruginosa" &
|
||||||
try_ab(x[, PIP, drop = TRUE] == "S") +
|
try_ab(x[, PIP, drop = TRUE] == "S") +
|
||||||
try_ab(x[, CTX, drop = TRUE] == "S") +
|
try_ab(x[, CTX, drop = TRUE] == "S") +
|
||||||
try_ab(x[, CAZ, drop = TRUE] == "S") +
|
try_ab(x[, CAZ, drop = TRUE] == "S") +
|
||||||
try_ab(x[, IPM, drop = TRUE] == "S") +
|
try_ab(x[, IPM, drop = TRUE] == "S") +
|
||||||
try_ab(x[, MEM, drop = TRUE] == "S") +
|
try_ab(x[, MEM, drop = TRUE] == "S") +
|
||||||
try_ab(x[, CIP, drop = TRUE] == "S") == 1),
|
try_ab(x[, CIP, drop = TRUE] == "S") == 1),
|
||||||
c(PIP, CTX, CAZ, IPM, MEM, CIP),
|
c(PIP, CTX, CAZ, IPM, MEM, CIP),
|
||||||
"any"
|
"any"
|
||||||
)
|
)
|
||||||
|
|
||||||
trans_tbl(
|
trans_tbl(
|
||||||
3, # 4MRGN otherwise
|
3, # 4MRGN otherwise
|
||||||
which((x$genus == "Pseudomonas" & x$species == "aeruginosa") &
|
which((x$genus == "Pseudomonas" & x$species == "aeruginosa") &
|
||||||
try_ab(x[, PIP, 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[, 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[, IPM, drop = TRUE] == "R") | try_ab(x[, MEM, drop = TRUE] == "R")) &
|
||||||
try_ab(x[, CIP, drop = TRUE] == "R")),
|
try_ab(x[, CIP, drop = TRUE] == "R")),
|
||||||
c(PIP, CTX, CAZ, IPM, MEM, CIP),
|
c(PIP, CTX, CAZ, IPM, MEM, CIP),
|
||||||
"any"
|
"any"
|
||||||
)
|
)
|
||||||
|
|
||||||
x[which(x$MDRO == 2), "reason"] <- "3MRGN"
|
x[which(x$MDRO == 2), "reason"] <- "3MRGN"
|
||||||
x[which(x$MDRO == 3), "reason"] <- "4MRGN"
|
x[which(x$MDRO == 3), "reason"] <- "4MRGN"
|
||||||
}
|
}
|
||||||
|
|
||||||
if (guideline$code == "brmo") {
|
if (guideline$code == "brmo") {
|
||||||
# Netherlands -------------------------------------------------------------
|
# Netherlands -------------------------------------------------------------
|
||||||
aminoglycosides <- aminoglycosides[!is.na(aminoglycosides)]
|
aminoglycosides <- aminoglycosides[!is.na(aminoglycosides)]
|
||||||
|
|
@ -1409,7 +1413,7 @@ mdro <- function(x = NULL,
|
||||||
if (length(ESBLs) != 2) {
|
if (length(ESBLs) != 2) {
|
||||||
ESBLs <- character(0)
|
ESBLs <- character(0)
|
||||||
}
|
}
|
||||||
|
|
||||||
# Table 1
|
# Table 1
|
||||||
trans_tbl(
|
trans_tbl(
|
||||||
3,
|
3,
|
||||||
|
|
@ -1417,21 +1421,21 @@ mdro <- function(x = NULL,
|
||||||
c(aminoglycosides, fluoroquinolones),
|
c(aminoglycosides, fluoroquinolones),
|
||||||
"all"
|
"all"
|
||||||
)
|
)
|
||||||
|
|
||||||
trans_tbl(
|
trans_tbl(
|
||||||
2,
|
2,
|
||||||
which(x$order == "Enterobacterales"), # following in fact the old Enterobacteriaceae classification
|
which(x$order == "Enterobacterales"), # following in fact the old Enterobacteriaceae classification
|
||||||
carbapenems,
|
carbapenems,
|
||||||
"any"
|
"any"
|
||||||
)
|
)
|
||||||
|
|
||||||
trans_tbl(
|
trans_tbl(
|
||||||
2,
|
2,
|
||||||
which(x$order == "Enterobacterales"), # following in fact the old Enterobacteriaceae classification
|
which(x$order == "Enterobacterales"), # following in fact the old Enterobacteriaceae classification
|
||||||
ESBLs,
|
ESBLs,
|
||||||
"all"
|
"all"
|
||||||
)
|
)
|
||||||
|
|
||||||
# Table 2
|
# Table 2
|
||||||
trans_tbl(
|
trans_tbl(
|
||||||
2,
|
2,
|
||||||
|
|
@ -1445,19 +1449,19 @@ mdro <- function(x = NULL,
|
||||||
c(aminoglycosides, fluoroquinolones),
|
c(aminoglycosides, fluoroquinolones),
|
||||||
"all"
|
"all"
|
||||||
)
|
)
|
||||||
|
|
||||||
trans_tbl(
|
trans_tbl(
|
||||||
3,
|
3,
|
||||||
which(x$genus == "Stenotrophomonas" & x$species == "maltophilia"),
|
which(x$genus == "Stenotrophomonas" & x$species == "maltophilia"),
|
||||||
SXT,
|
SXT,
|
||||||
"all"
|
"all"
|
||||||
)
|
)
|
||||||
|
|
||||||
if (!ab_missing(MEM) && !ab_missing(IPM) &&
|
if (!ab_missing(MEM) && !ab_missing(IPM) &&
|
||||||
!ab_missing(GEN) && !ab_missing(TOB) &&
|
!ab_missing(GEN) && !ab_missing(TOB) &&
|
||||||
!ab_missing(CIP) &&
|
!ab_missing(CIP) &&
|
||||||
!ab_missing(CAZ) &&
|
!ab_missing(CAZ) &&
|
||||||
!ab_missing(TZP)) {
|
!ab_missing(TZP)) {
|
||||||
x$psae <- 0
|
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[, 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"]
|
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$genus == "Pseudomonas" & x$species == "aeruginosa" &
|
||||||
x$psae >= 3
|
x$psae >= 3
|
||||||
), "reason"] <- paste0("at least 3 classes contain R", ifelse(!isTRUE(combine_SI), " or I", ""))
|
), "reason"] <- paste0("at least 3 classes contain R", ifelse(!isTRUE(combine_SI), " or I", ""))
|
||||||
|
|
||||||
# Table 3
|
# Table 3
|
||||||
trans_tbl(
|
trans_tbl(
|
||||||
3,
|
3,
|
||||||
|
|
@ -1498,7 +1502,7 @@ mdro <- function(x = NULL,
|
||||||
"all"
|
"all"
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
if (guideline$code == "tb") {
|
if (guideline$code == "tb") {
|
||||||
# Tuberculosis ------------------------------------------------------------
|
# Tuberculosis ------------------------------------------------------------
|
||||||
prepare_drug <- function(ab) {
|
prepare_drug <- function(ab) {
|
||||||
|
|
@ -1535,7 +1539,7 @@ mdro <- function(x = NULL,
|
||||||
ab != "R"
|
ab != "R"
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
x$mono_count <- 0
|
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(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
|
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(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(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[drug_is_R(RFP), "mono_count"] <- x[drug_is_R(RFP), "mono_count", drop = TRUE] + 1
|
||||||
|
|
||||||
x$mono <- x$mono_count > 0
|
x$mono <- x$mono_count > 0
|
||||||
x$poly <- x$mono_count > 1 & drug_is_not_R(RIF) & drug_is_not_R(INH)
|
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)
|
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$second <- drug_is_R(CAP) | drug_is_R(KAN) | drug_is_R(AMK)
|
||||||
x$xdr <- x$mdr & x$xdr & x$second
|
x$xdr <- x$mdr & x$xdr & x$second
|
||||||
x$MDRO <- ifelse(x$xdr, 5,
|
x$MDRO <- ifelse(x$xdr, 5,
|
||||||
ifelse(x$mdr, 4,
|
ifelse(x$mdr, 4,
|
||||||
ifelse(x$poly, 3,
|
ifelse(x$poly, 3,
|
||||||
ifelse(x$mono, 2,
|
ifelse(x$mono, 2,
|
||||||
1
|
1
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
# keep all real TB, make other species NA
|
# keep all real TB, make other species NA
|
||||||
x$MDRO <- ifelse(x$fullname == "Mycobacterium tuberculosis", x$MDRO, NA_real_)
|
x$MDRO <- ifelse(x$fullname == "Mycobacterium tuberculosis", x$MDRO, NA_real_)
|
||||||
x$reason <- "PDR/MDR/XDR criteria were met"
|
x$reason <- "PDR/MDR/XDR criteria were met"
|
||||||
}
|
}
|
||||||
|
|
||||||
# some more info on negative results
|
# some more info on negative results
|
||||||
if (isTRUE(verbose)) {
|
if (isTRUE(verbose)) {
|
||||||
if (guideline$code == "cmi2012") {
|
if (guideline$code == "cmi2012") {
|
||||||
|
|
@ -1579,7 +1583,7 @@ mdro <- function(x = NULL,
|
||||||
x[which(x$MDRO == 1), "reason"] <- "too few antibiotics are R"
|
x[which(x$MDRO == 1), "reason"] <- "too few antibiotics are R"
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
if (isTRUE(info.bak)) {
|
if (isTRUE(info.bak)) {
|
||||||
cat(group_msg)
|
cat(group_msg)
|
||||||
if (sum(!is.na(x$MDRO)) == 0) {
|
if (sum(!is.na(x$MDRO)) == 0) {
|
||||||
|
|
@ -1591,11 +1595,11 @@ mdro <- function(x = NULL,
|
||||||
)))
|
)))
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Fill in blanks ----
|
# Fill in blanks ----
|
||||||
# for rows that have no results
|
# for rows that have no results
|
||||||
x_transposed <- as.list(as.data.frame(t(x[, cols_ab, drop = FALSE]),
|
x_transposed <- as.list(as.data.frame(t(x[, cols_ab, drop = FALSE]),
|
||||||
stringsAsFactors = FALSE
|
stringsAsFactors = FALSE
|
||||||
))
|
))
|
||||||
rows_empty <- which(vapply(
|
rows_empty <- which(vapply(
|
||||||
FUN.VALUE = logical(1),
|
FUN.VALUE = logical(1),
|
||||||
|
|
@ -1609,7 +1613,7 @@ mdro <- function(x = NULL,
|
||||||
} else {
|
} else {
|
||||||
cat("\n")
|
cat("\n")
|
||||||
}
|
}
|
||||||
|
|
||||||
# Results ----
|
# Results ----
|
||||||
if (guideline$code == "cmi2012") {
|
if (guideline$code == "cmi2012") {
|
||||||
if (any(x$MDRO == -1, na.rm = TRUE)) {
|
if (any(x$MDRO == -1, na.rm = TRUE)) {
|
||||||
|
|
@ -1656,7 +1660,7 @@ mdro <- function(x = NULL,
|
||||||
ordered = TRUE
|
ordered = TRUE
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
if (isTRUE(verbose)) {
|
if (isTRUE(verbose)) {
|
||||||
colnames(x)[colnames(x) == col_mo] <- "microorganism"
|
colnames(x)[colnames(x) == col_mo] <- "microorganism"
|
||||||
x$microorganism <- mo_name(x$microorganism, language = NULL)
|
x$microorganism <- mo_name(x$microorganism, language = NULL)
|
||||||
|
|
@ -1678,9 +1682,9 @@ mdro <- function(x = NULL,
|
||||||
#' @export
|
#' @export
|
||||||
custom_mdro_guideline <- function(..., as_factor = TRUE) {
|
custom_mdro_guideline <- function(..., as_factor = TRUE) {
|
||||||
meet_criteria(as_factor, allow_class = "logical", has_length = 1)
|
meet_criteria(as_factor, allow_class = "logical", has_length = 1)
|
||||||
|
|
||||||
dots <- tryCatch(list(...),
|
dots <- tryCatch(list(...),
|
||||||
error = function(e) "error"
|
error = function(e) "error"
|
||||||
)
|
)
|
||||||
stop_if(
|
stop_if(
|
||||||
identical(dots, "error"),
|
identical(dots, "error"),
|
||||||
|
|
@ -1694,7 +1698,7 @@ custom_mdro_guideline <- function(..., as_factor = TRUE) {
|
||||||
inherits(dots[[i]], "formula"),
|
inherits(dots[[i]], "formula"),
|
||||||
"rule ", i, " must be a valid formula input (e.g., using '~'), see `?mdro`"
|
"rule ", i, " must be a valid formula input (e.g., using '~'), see `?mdro`"
|
||||||
)
|
)
|
||||||
|
|
||||||
# Query
|
# Query
|
||||||
qry <- dots[[i]][[2]]
|
qry <- dots[[i]][[2]]
|
||||||
if (inherits(qry, "call")) {
|
if (inherits(qry, "call")) {
|
||||||
|
|
@ -1710,14 +1714,14 @@ custom_mdro_guideline <- function(..., as_factor = TRUE) {
|
||||||
qry <- gsub(" *([&|+-/*^><==]+) *", " \\1 ", qry)
|
qry <- gsub(" *([&|+-/*^><==]+) *", " \\1 ", qry)
|
||||||
qry <- gsub("'", "\"", qry, fixed = TRUE)
|
qry <- gsub("'", "\"", qry, fixed = TRUE)
|
||||||
out[[i]]$query <- as.expression(qry)
|
out[[i]]$query <- as.expression(qry)
|
||||||
|
|
||||||
# Value
|
# Value
|
||||||
val <- tryCatch(eval(dots[[i]][[3]]), error = function(e) NULL)
|
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(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))
|
stop_if(length(val) > 1, "rule ", i, " must return a value of length 1, not ", length(val))
|
||||||
out[[i]]$value <- as.character(val)
|
out[[i]]$value <- as.character(val)
|
||||||
}
|
}
|
||||||
|
|
||||||
names(out) <- paste0("rule", seq_len(n_dots))
|
names(out) <- paste0("rule", seq_len(n_dots))
|
||||||
out <- set_clean_class(out, new_class = c("custom_mdro_guideline", "list"))
|
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)))
|
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(...)) {
|
for (g in list(...)) {
|
||||||
stop_ifnot(inherits(g, "custom_mdro_guideline"),
|
stop_ifnot(inherits(g, "custom_mdro_guideline"),
|
||||||
"for combining custom MDRO guidelines, all rules must be created with `custom_mdro_guideline()`",
|
"for combining custom MDRO guidelines, all rules must be created with `custom_mdro_guideline()`",
|
||||||
call = FALSE
|
call = FALSE
|
||||||
)
|
)
|
||||||
vals <- attributes(x)$values
|
vals <- attributes(x)$values
|
||||||
if (!all(attributes(g)$values %in% vals)) {
|
if (!all(attributes(g)$values %in% vals)) {
|
||||||
|
|
@ -1790,28 +1794,28 @@ run_custom_mdro_guideline <- function(df, guideline, info) {
|
||||||
reasons <- character(length = NROW(df))
|
reasons <- character(length = NROW(df))
|
||||||
for (i in seq_len(n_dots)) {
|
for (i in seq_len(n_dots)) {
|
||||||
qry <- tryCatch(eval(parse(text = guideline[[i]]$query), envir = df, enclos = parent.frame()),
|
qry <- tryCatch(eval(parse(text = guideline[[i]]$query), envir = df, enclos = parent.frame()),
|
||||||
error = function(e) {
|
error = function(e) {
|
||||||
AMR_env$err_msg <- e$message
|
AMR_env$err_msg <- e$message
|
||||||
return("error")
|
return("error")
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
if (identical(qry, "error")) {
|
if (identical(qry, "error")) {
|
||||||
warning_("in `custom_mdro_guideline()`: rule ", i,
|
warning_("in `custom_mdro_guideline()`: rule ", i,
|
||||||
" (`", as.character(guideline[[i]]$query), "`) was ignored because of this error message: ",
|
" (`", as.character(guideline[[i]]$query), "`) was ignored because of this error message: ",
|
||||||
AMR_env$err_msg,
|
AMR_env$err_msg,
|
||||||
call = FALSE,
|
call = FALSE,
|
||||||
add_fn = font_red
|
add_fn = font_red
|
||||||
)
|
)
|
||||||
next
|
next
|
||||||
}
|
}
|
||||||
stop_ifnot(is.logical(qry), "in custom_mdro_guideline(): rule ", i, " (`", guideline[[i]]$query,
|
stop_ifnot(is.logical(qry), "in custom_mdro_guideline(): rule ", i, " (`", guideline[[i]]$query,
|
||||||
"`) must return `TRUE` or `FALSE`, not ",
|
"`) must return `TRUE` or `FALSE`, not ",
|
||||||
format_class(class(qry), plural = FALSE),
|
format_class(class(qry), plural = FALSE),
|
||||||
call = FALSE
|
call = FALSE
|
||||||
)
|
)
|
||||||
|
|
||||||
new_mdros <- which(qry == TRUE & out == "")
|
new_mdros <- which(qry == TRUE & out == "")
|
||||||
|
|
||||||
if (isTRUE(info)) {
|
if (isTRUE(info)) {
|
||||||
cat(word_wrap(
|
cat(word_wrap(
|
||||||
"- Custom MDRO rule ", i, ": `", as.character(guideline[[i]]$query),
|
"- Custom MDRO rule ", i, ": `", as.character(guideline[[i]]$query),
|
||||||
|
|
@ -1827,11 +1831,11 @@ run_custom_mdro_guideline <- function(df, guideline, info) {
|
||||||
}
|
}
|
||||||
out[out == ""] <- "Negative"
|
out[out == ""] <- "Negative"
|
||||||
reasons[out == "Negative"] <- "no rules matched"
|
reasons[out == "Negative"] <- "no rules matched"
|
||||||
|
|
||||||
if (isTRUE(attributes(guideline)$as_factor)) {
|
if (isTRUE(attributes(guideline)$as_factor)) {
|
||||||
out <- factor(out, levels = attributes(guideline)$values, ordered = TRUE)
|
out <- factor(out, levels = attributes(guideline)$values, ordered = TRUE)
|
||||||
}
|
}
|
||||||
|
|
||||||
columns_nonsusceptible <- as.data.frame(t(df[, is.sir(df), drop = FALSE] == "R"))
|
columns_nonsusceptible <- as.data.frame(t(df[, is.sir(df), drop = FALSE] == "R"))
|
||||||
columns_nonsusceptible <- vapply(
|
columns_nonsusceptible <- vapply(
|
||||||
FUN.VALUE = character(1),
|
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 = " ")
|
function(x) paste0(rownames(columns_nonsusceptible)[which(x)], collapse = " ")
|
||||||
)
|
)
|
||||||
columns_nonsusceptible[is.na(out)] <- NA_character_
|
columns_nonsusceptible[is.na(out)] <- NA_character_
|
||||||
|
|
||||||
data.frame(
|
data.frame(
|
||||||
row_number = seq_len(NROW(df)),
|
row_number = seq_len(NROW(df)),
|
||||||
MDRO = out,
|
MDRO = out,
|
||||||
|
|
|
||||||
|
|
@ -49,13 +49,13 @@
|
||||||
#' sir <- random_sir(10)
|
#' sir <- random_sir(10)
|
||||||
#' sir
|
#' sir
|
||||||
#' mean_amr_distance(sir)
|
#' mean_amr_distance(sir)
|
||||||
#'
|
#'
|
||||||
#' mic <- random_mic(10)
|
#' mic <- random_mic(10)
|
||||||
#' mic
|
#' mic
|
||||||
#' mean_amr_distance(mic)
|
#' mean_amr_distance(mic)
|
||||||
#' # equal to the Z-score of their log2:
|
#' # equal to the Z-score of their log2:
|
||||||
#' (log2(mic) - mean(log2(mic))) / sd(log2(mic))
|
#' (log2(mic) - mean(log2(mic))) / sd(log2(mic))
|
||||||
#'
|
#'
|
||||||
#' disk <- random_disk(10)
|
#' disk <- random_disk(10)
|
||||||
#' disk
|
#' disk
|
||||||
#' mean_amr_distance(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_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_antibiotics <- unname(get_column_abx(df, info = FALSE))
|
||||||
df <- df[, colnames(df)[colnames(df) %in% union(df_classes, df_antibiotics)], drop = FALSE]
|
df <- df[, colnames(df)[colnames(df) %in% union(df_classes, df_antibiotics)], drop = FALSE]
|
||||||
|
|
||||||
stop_if(ncol(df) < 2,
|
stop_if(ncol(df) < 2,
|
||||||
"data set must contain at least two variables",
|
"data set must contain at least two variables",
|
||||||
call = -2
|
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")) {
|
if (message_not_thrown_before("mean_amr_distance", "groups")) {
|
||||||
message_("Calculating mean AMR distance based on columns ", vector_and(colnames(df), sort = FALSE))
|
message_("Calculating mean AMR distance based on columns ", vector_and(colnames(df), sort = FALSE))
|
||||||
}
|
}
|
||||||
|
|
||||||
res <- vapply(
|
res <- vapply(
|
||||||
FUN.VALUE = double(nrow(df)),
|
FUN.VALUE = double(nrow(df)),
|
||||||
df,
|
df,
|
||||||
|
|
|
||||||
14
R/mic.R
14
R/mic.R
|
|
@ -230,13 +230,13 @@ as.mic <- function(x, na.rm = FALSE) {
|
||||||
vector_and(quotes = TRUE)
|
vector_and(quotes = TRUE)
|
||||||
cur_col <- get_current_column()
|
cur_col <- get_current_column()
|
||||||
warning_("in `as.mic()`: ", na_after - na_before, " result",
|
warning_("in `as.mic()`: ", na_after - na_before, " result",
|
||||||
ifelse(na_after - na_before > 1, "s", ""),
|
ifelse(na_after - na_before > 1, "s", ""),
|
||||||
ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")),
|
ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")),
|
||||||
" truncated (",
|
" truncated (",
|
||||||
round(((na_after - na_before) / length(x)) * 100),
|
round(((na_after - na_before) / length(x)) * 100),
|
||||||
"%) that were invalid MICs: ",
|
"%) that were invalid MICs: ",
|
||||||
list_missing,
|
list_missing,
|
||||||
call = FALSE
|
call = FALSE
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
||||||
98
R/mo.R
98
R/mo.R
|
|
@ -183,12 +183,12 @@ as.mo <- function(x,
|
||||||
x <- replace_ignore_pattern(x, ignore_pattern)
|
x <- replace_ignore_pattern(x, ignore_pattern)
|
||||||
|
|
||||||
x_lower <- tolower(x)
|
x_lower <- tolower(x)
|
||||||
|
|
||||||
complexes <- x[trimws2(x_lower) %like_case% " (complex|group)$"]
|
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)) {
|
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)
|
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
|
# WHONET: xxx = no growth
|
||||||
x[x_lower %in% c("", "xxx", "na", "nan")] <- NA_character_
|
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
|
# take out the parts, split by space
|
||||||
x_parts <- strsplit(gsub("-", " ", x_out, fixed = TRUE), " ", fixed = TRUE)[[1]]
|
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)
|
# 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)) {
|
if (length(x_parts) %in% c(2, 3)) {
|
||||||
# for genus + species + subspecies
|
# for genus + species + subspecies
|
||||||
|
|
@ -313,13 +313,13 @@ as.mo <- function(x,
|
||||||
} else {
|
} else {
|
||||||
minimum_matching_score_current <- minimum_matching_score
|
minimum_matching_score_current <- minimum_matching_score
|
||||||
}
|
}
|
||||||
|
|
||||||
if (sum(m >= minimum_matching_score_current) > 10) {
|
if (sum(m >= minimum_matching_score_current) > 10) {
|
||||||
# at least 10 are left over, make the ones under `m` NA
|
# 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) {
|
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)
|
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_
|
result_mo <- NA_character_
|
||||||
|
|
@ -365,18 +365,19 @@ as.mo <- function(x,
|
||||||
plural <- c("s", "these uncertainties")
|
plural <- c("s", "these uncertainties")
|
||||||
}
|
}
|
||||||
if (length(AMR_env$mo_uncertainties$original_input) <= 3) {
|
if (length(AMR_env$mo_uncertainties$original_input) <= 3) {
|
||||||
examples <- vector_and(paste0(
|
examples <- vector_and(
|
||||||
'"', AMR_env$mo_uncertainties$original_input,
|
paste0(
|
||||||
'" (assumed ', italicise(AMR_env$mo_uncertainties$fullname), ")"
|
'"', AMR_env$mo_uncertainties$original_input,
|
||||||
),
|
'" (assumed ', italicise(AMR_env$mo_uncertainties$fullname), ")"
|
||||||
quotes = FALSE
|
),
|
||||||
|
quotes = FALSE
|
||||||
)
|
)
|
||||||
} else {
|
} else {
|
||||||
examples <- paste0(nr2char(length(AMR_env$mo_uncertainties$original_input)), " microorganism", plural[1])
|
examples <- paste0(nr2char(length(AMR_env$mo_uncertainties$original_input)), " microorganism", plural[1])
|
||||||
}
|
}
|
||||||
msg <- c(msg, paste0(
|
msg <- c(msg, paste0(
|
||||||
"Microorganism translation was uncertain for ", examples,
|
"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) {
|
for (m in msg) {
|
||||||
|
|
@ -442,7 +443,7 @@ as.mo <- function(x,
|
||||||
# Apply Lancefield ----
|
# Apply Lancefield ----
|
||||||
if (isTRUE(Lancefield) || Lancefield == "all") {
|
if (isTRUE(Lancefield) || Lancefield == "all") {
|
||||||
# (using `%like_case%` to also match subspecies)
|
# (using `%like_case%` to also match subspecies)
|
||||||
|
|
||||||
# group A - S. pyogenes
|
# group A - S. pyogenes
|
||||||
out[out %like_case% "^B_STRPT_PYGN(_|$)"] <- "B_STRPT_GRPA"
|
out[out %like_case% "^B_STRPT_PYGN(_|$)"] <- "B_STRPT_GRPA"
|
||||||
# group B - S. agalactiae
|
# group B - S. agalactiae
|
||||||
|
|
@ -560,7 +561,7 @@ pillar_shaft.mo <- function(x, ...) {
|
||||||
# markup NA and UNKNOWN
|
# markup NA and UNKNOWN
|
||||||
out[is.na(x)] <- font_na(" NA")
|
out[is.na(x)] <- font_na(" NA")
|
||||||
out[x == "UNKNOWN"] <- font_na(" UNKNOWN")
|
out[x == "UNKNOWN"] <- font_na(" UNKNOWN")
|
||||||
|
|
||||||
# markup manual codes
|
# 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)
|
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) ||
|
if (!all(x %in% all_mos) ||
|
||||||
(!is.null(df) && !all(unlist(df[, which(mo_cols), drop = FALSE]) %in% all_mos))) {
|
(!is.null(df) && !all(unlist(df[, which(mo_cols), drop = FALSE]) %in% all_mos))) {
|
||||||
# markup old mo codes
|
# 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
|
||||||
),
|
|
||||||
collapse = NULL
|
|
||||||
)
|
)
|
||||||
# throw a warning with the affected column name(s)
|
# throw a warning with the affected column name(s)
|
||||||
if (!is.null(mo_cols)) {
|
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))
|
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))
|
return(invisible(NULL))
|
||||||
}
|
}
|
||||||
|
|
||||||
add_MO_lookup_to_AMR_env()
|
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))
|
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[scores < 0.5] <- font_red_bg(text[scores < 0.5], collapse = NULL)
|
||||||
text
|
text
|
||||||
}
|
}
|
||||||
|
|
||||||
txt <- ""
|
txt <- ""
|
||||||
for (i in seq_len(nrow(x))) {
|
for (i in seq_len(nrow(x))) {
|
||||||
if (x[i, ]$candidates != "") {
|
if (x[i, ]$candidates != "") {
|
||||||
|
|
@ -835,21 +837,23 @@ print.mo_uncertainties <- function(x, ...) {
|
||||||
candidates_formatted <- candidates_formatted[order(1 - scores)]
|
candidates_formatted <- candidates_formatted[order(1 - scores)]
|
||||||
scores_formatted <- scores_formatted[order(1 - scores)]
|
scores_formatted <- scores_formatted[order(1 - scores)]
|
||||||
|
|
||||||
candidates <- word_wrap(paste0(
|
candidates <- word_wrap(
|
||||||
"Also matched: ",
|
paste0(
|
||||||
vector_and(paste0(
|
"Also matched: ",
|
||||||
candidates_formatted,
|
vector_and(
|
||||||
font_blue(paste0(" (", scores_formatted, ")"), collapse = NULL)
|
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
|
extra_indent = nchar("Also matched: "),
|
||||||
),
|
width = 0.9 * getOption("width", 100)
|
||||||
ifelse(n_candidates == 25,
|
|
||||||
font_grey(" [showing first 25]"),
|
|
||||||
""
|
|
||||||
)
|
|
||||||
),
|
|
||||||
extra_indent = nchar("Also matched: "),
|
|
||||||
width = 0.9 * getOption("width", 100)
|
|
||||||
)
|
)
|
||||||
} else {
|
} else {
|
||||||
candidates <- ""
|
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% "mil+er+i gr"] <- "B_STRPT_MILL"
|
||||||
out[x %like_case% "((strepto|^s).* viridans|^vgs[^a-z]*$)"] <- "B_STRPT_VIRI"
|
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"
|
out[x %like_case% "(viridans.* (strepto|^s).*|^vgs[^a-z]*$)"] <- "B_STRPT_VIRI"
|
||||||
|
|
||||||
# Salmonella in different languages, like "Salmonella grupo B"
|
# Salmonella in different languages, like "Salmonella grupo B"
|
||||||
out[x %like_case% "salmonella.* [bcd]$"] <- gsub(".*salmonella.* ([bcd])$",
|
out[x %like_case% "salmonella.* [bcd]$"] <- gsub(".*salmonella.* ([bcd])$",
|
||||||
"B_SLMNL_GRP\\U\\1",
|
"B_SLMNL_GRP\\U\\1",
|
||||||
x[x %like_case% "salmonella.* [bcd]$"],
|
x[x %like_case% "salmonella.* [bcd]$"],
|
||||||
perl = TRUE
|
perl = TRUE
|
||||||
)
|
)
|
||||||
out[x %like_case% "group [bcd] salmonella"] <- gsub(".*group ([bcd]) salmonella*",
|
out[x %like_case% "group [bcd] salmonella"] <- gsub(".*group ([bcd]) salmonella*",
|
||||||
"B_SLMNL_GRP\\U\\1",
|
"B_SLMNL_GRP\\U\\1",
|
||||||
x[x %like_case% "group [bcd] salmonella"],
|
x[x %like_case% "group [bcd] salmonella"],
|
||||||
perl = TRUE
|
perl = TRUE
|
||||||
)
|
)
|
||||||
|
|
||||||
# CoNS/CoPS in different languages (support for German, Dutch, Spanish, Portuguese)
|
# CoNS/CoPS in different languages (support for German, Dutch, Spanish, Portuguese)
|
||||||
|
|
@ -999,10 +1003,14 @@ convert_colloquial_input <- function(x) {
|
||||||
|
|
||||||
italicise <- function(x) {
|
italicise <- function(x) {
|
||||||
out <- font_italic(x, collapse = NULL)
|
out <- font_italic(x, collapse = NULL)
|
||||||
out[x %like_case% "Salmonella [A-Z]"] <- paste(font_italic("Salmonella"),
|
out[x %like_case% "Salmonella [A-Z]"] <- paste(
|
||||||
gsub("Salmonella ", "", x[x %like_case% "Salmonella [A-Z]"]))
|
font_italic("Salmonella"),
|
||||||
out[x %like_case% "Streptococcus [A-Z]"] <- paste(font_italic("Streptococcus"),
|
gsub("Salmonella ", "", x[x %like_case% "Salmonella [A-Z]"])
|
||||||
gsub("Streptococcus ", "", x[x %like_case% "Streptococcus [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()) {
|
if (has_colour()) {
|
||||||
out <- gsub("(Group|group|Complex|complex)(\033\\[23m)?", "\033[23m\\1", out, perl = TRUE)
|
out <- gsub("(Group|group|Complex|complex)(\033\\[23m)?", "\033[23m\\1", out, perl = TRUE)
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -34,13 +34,13 @@
|
||||||
#' @param x Any user input value(s)
|
#' @param x Any user input value(s)
|
||||||
#' @param n A full taxonomic name, that exists in [`microorganisms$fullname`][microorganisms]
|
#' @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}.
|
#' @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.
|
#' 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:
|
#' @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:
|
#' 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{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 )}}
|
#' \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:
|
#' 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.
|
#' * \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:
|
#' 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;
|
#' - **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.
|
#' - **Putative**, if a taxonomic species has fewer than three known cases. These records have `prevalence = 1.25` in the [microorganisms] data set.
|
||||||
#'
|
#'
|
||||||
#' Furthermore,
|
#' Furthermore,
|
||||||
#'
|
#'
|
||||||
#' - Any genus present in the **established** list also has `prevalence = 1.0` in the [microorganisms] data set;
|
#' - 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 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;
|
#' - 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
|
#' @inheritSection AMR Reference Data Publicly Available
|
||||||
#' @examples
|
#' @examples
|
||||||
#' mo_reset_session()
|
#' mo_reset_session()
|
||||||
#'
|
#'
|
||||||
#' as.mo("E. coli")
|
#' as.mo("E. coli")
|
||||||
#' mo_uncertainties()
|
#' 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
|
# force a capital letter, so this conversion will not count as a substitution
|
||||||
substr(x, 1, 1) <- toupper(substr(x, 1, 1))
|
substr(x, 1, 1) <- toupper(substr(x, 1, 1))
|
||||||
|
|
||||||
# n is always a taxonomically valid full name
|
# n is always a taxonomically valid full name
|
||||||
if (length(n) == 1) {
|
if (length(n) == 1) {
|
||||||
n <- rep(n, length(x))
|
n <- rep(n, length(x))
|
||||||
|
|
@ -103,7 +103,7 @@ mo_matching_score <- function(x, n) {
|
||||||
if (length(x) == 1) {
|
if (length(x) == 1) {
|
||||||
x <- rep(x, length(n))
|
x <- rep(x, length(n))
|
||||||
}
|
}
|
||||||
|
|
||||||
# length of fullname
|
# length of fullname
|
||||||
l_n <- nchar(n)
|
l_n <- nchar(n)
|
||||||
lev <- double(length = length(x))
|
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]
|
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)
|
# 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]
|
k_n <- AMR_env$MO_lookup[match(n, AMR_env$MO_lookup$fullname), "kingdom_index", drop = TRUE]
|
||||||
|
|
||||||
# matching score:
|
# matching score:
|
||||||
(l_n - 0.5 * l_n.lev) / (l_n * p_n * k_n)
|
(l_n - 0.5 * l_n.lev) / (l_n * p_n * k_n)
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -133,7 +133,6 @@
|
||||||
#' mo_fullname("K. pneu rh")
|
#' mo_fullname("K. pneu rh")
|
||||||
#' mo_shortname("K. pneu rh")
|
#' mo_shortname("K. pneu rh")
|
||||||
#'
|
#'
|
||||||
#'
|
|
||||||
#' \donttest{
|
#' \donttest{
|
||||||
#' # Becker classification, see ?as.mo ----------------------------------------
|
#' # Becker classification, see ?as.mo ----------------------------------------
|
||||||
#'
|
#'
|
||||||
|
|
@ -158,7 +157,7 @@
|
||||||
#' mo_gramstain("Klebsiella pneumoniae", language = "es") # Spanish
|
#' mo_gramstain("Klebsiella pneumoniae", language = "es") # Spanish
|
||||||
#' mo_gramstain("Klebsiella pneumoniae", language = "el") # Greek
|
#' mo_gramstain("Klebsiella pneumoniae", language = "el") # Greek
|
||||||
#' mo_gramstain("Klebsiella pneumoniae", language = "uk") # Ukrainian
|
#' mo_gramstain("Klebsiella pneumoniae", language = "uk") # Ukrainian
|
||||||
#'
|
#'
|
||||||
#' # mo_type is equal to mo_kingdom, but mo_kingdom will remain untranslated
|
#' # mo_type is equal to mo_kingdom, but mo_kingdom will remain untranslated
|
||||||
#' mo_kingdom("Klebsiella pneumoniae")
|
#' mo_kingdom("Klebsiella pneumoniae")
|
||||||
#' mo_type("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)]
|
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)]
|
rank <- AMR_env$MO_lookup$rank[match(x.mo, AMR_env$MO_lookup$mo)]
|
||||||
|
|
||||||
out <- factor(ifelse(prev == 1 & kngd == "Bacteria" & rank != "genus",
|
out <- factor(
|
||||||
"Pathogenic",
|
ifelse(prev == 1 & kngd == "Bacteria" & rank != "genus",
|
||||||
ifelse(prev < 2 & kngd == "Fungi",
|
"Pathogenic",
|
||||||
"Potentially pathogenic",
|
ifelse(prev < 2 & kngd == "Fungi",
|
||||||
ifelse(prev == 2 & kngd == "Bacteria",
|
"Potentially pathogenic",
|
||||||
"Non-pathogenic",
|
ifelse(prev == 2 & kngd == "Bacteria",
|
||||||
ifelse(kngd == "Bacteria",
|
"Non-pathogenic",
|
||||||
"Potentially pathogenic",
|
ifelse(kngd == "Bacteria",
|
||||||
"Unknown")))),
|
"Potentially pathogenic",
|
||||||
levels = c("Pathogenic", "Potentially pathogenic", "Non-pathogenic", "Unknown"),
|
"Unknown"
|
||||||
ordered = TRUE)
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
),
|
||||||
|
levels = c("Pathogenic", "Potentially pathogenic", "Non-pathogenic", "Unknown"),
|
||||||
|
ordered = TRUE
|
||||||
|
)
|
||||||
|
|
||||||
load_mo_uncertainties(metadata)
|
load_mo_uncertainties(metadata)
|
||||||
out
|
out
|
||||||
|
|
@ -727,7 +732,7 @@ mo_synonyms <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio
|
||||||
meet_criteria(x, allow_NA = TRUE)
|
meet_criteria(x, allow_NA = TRUE)
|
||||||
language <- validate_language(language)
|
language <- validate_language(language)
|
||||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||||
|
|
||||||
add_MO_lookup_to_AMR_env()
|
add_MO_lookup_to_AMR_env()
|
||||||
|
|
||||||
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
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)
|
meet_criteria(open, allow_class = "logical", has_length = 1)
|
||||||
language <- validate_language(language)
|
language <- validate_language(language)
|
||||||
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
|
||||||
|
|
||||||
add_MO_lookup_to_AMR_env()
|
add_MO_lookup_to_AMR_env()
|
||||||
|
|
||||||
x.mo <- as.mo(x = x, language = language, keep_synonyms = keep_synonyms, ... = ...)
|
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, ...) {
|
mo_validate <- function(x, property, language, keep_synonyms = keep_synonyms, ...) {
|
||||||
add_MO_lookup_to_AMR_env()
|
add_MO_lookup_to_AMR_env()
|
||||||
|
|
||||||
# try to catch an error when inputting an invalid argument
|
# try to catch an error when inputting an invalid argument
|
||||||
# so the 'call.' can be set to FALSE
|
# so the 'call.' can be set to FALSE
|
||||||
tryCatch(x[1L] %in% unlist(AMR_env$MO_lookup[1, property, drop = TRUE]),
|
tryCatch(x[1L] %in% unlist(AMR_env$MO_lookup[1, property, drop = TRUE]),
|
||||||
|
|
|
||||||
|
|
@ -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) {
|
check_validity_mo_source <- function(x, refer_to_name = "`reference_df`", stop_on_error = TRUE) {
|
||||||
add_MO_lookup_to_AMR_env()
|
add_MO_lookup_to_AMR_env()
|
||||||
|
|
||||||
if (paste(deparse(substitute(x)), collapse = "") == "get_mo_source()") {
|
if (paste(deparse(substitute(x)), collapse = "") == "get_mo_source()") {
|
||||||
return(TRUE)
|
return(TRUE)
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -140,7 +140,6 @@
|
||||||
#' )
|
#' )
|
||||||
#' }
|
#' }
|
||||||
#' if (require("dplyr")) {
|
#' if (require("dplyr")) {
|
||||||
#'
|
|
||||||
#' # scoped dplyr verbs with antibiotic selectors
|
#' # scoped dplyr verbs with antibiotic selectors
|
||||||
#' # (you could also use across() of course)
|
#' # (you could also use across() of course)
|
||||||
#' example_isolates %>%
|
#' example_isolates %>%
|
||||||
|
|
|
||||||
|
|
@ -274,7 +274,7 @@ resistance_predict <- function(x,
|
||||||
df_prediction$value <- ifelse(df_prediction$value > 1, 1, pmax(df_prediction$value, 0))
|
df_prediction$value <- ifelse(df_prediction$value > 1, 1, pmax(df_prediction$value, 0))
|
||||||
df_prediction <- df_prediction[order(df_prediction$year), , drop = FALSE]
|
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,
|
structure(out,
|
||||||
class = c("resistance_predict", class(out)),
|
class = c("resistance_predict", class(out)),
|
||||||
I_as_S = I_as_S,
|
I_as_S = I_as_S,
|
||||||
|
|
|
||||||
98
R/sir.R
98
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)`.
|
#' 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
|
#' ### 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)))`).
|
#' 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.
|
#' 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:
|
#' 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")
|
||||||
#' options(AMR_guideline = "CLSI 2018")
|
#' 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.
|
#' 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
|
#' - **R = Resistant**\cr
|
||||||
#' A microorganism is categorised as "Resistant" when there is a high likelihood of therapeutic failure even when there is increased exposure.
|
#' 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.
|
#' * *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.
|
#' 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.bak <- x
|
||||||
x <- as.character(x) # this is needed to prevent the vctrs pkg from throwing an error
|
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))) {
|
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
|
# support haven package for importing e.g., from SPSS - it adds the 'labels' attribute
|
||||||
lbls <- attributes(x.bak)$labels
|
lbls <- attributes(x.bak)$labels
|
||||||
|
|
@ -328,7 +328,7 @@ as.sir.default <- function(x, ...) {
|
||||||
x <- trimws2(as.character(unlist(x)))
|
x <- trimws2(as.character(unlist(x)))
|
||||||
x[x %in% c(NA, "", "-", "NULL")] <- NA_character_
|
x[x %in% c(NA, "", "-", "NULL")] <- NA_character_
|
||||||
x.bak <- x
|
x.bak <- x
|
||||||
|
|
||||||
na_before <- length(x[is.na(x)])
|
na_before <- length(x[is.na(x)])
|
||||||
|
|
||||||
# correct for translations
|
# correct for translations
|
||||||
|
|
@ -768,13 +768,13 @@ as_sir_method <- function(method_short,
|
||||||
if (length(uti) == 1) {
|
if (length(uti) == 1) {
|
||||||
uti <- rep(uti, length(x))
|
uti <- rep(uti, length(x))
|
||||||
}
|
}
|
||||||
|
|
||||||
if (isTRUE(add_intrinsic_resistance) && guideline_coerced %unlike% "EUCAST") {
|
if (isTRUE(add_intrinsic_resistance) && guideline_coerced %unlike% "EUCAST") {
|
||||||
if (message_not_thrown_before("as.sir", "intrinsic")) {
|
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.")
|
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_formatted <- paste0("'", font_bold(ab.bak), "'")
|
||||||
agent_name <- ab_name(ab, tolower = TRUE, language = NULL)
|
agent_name <- ab_name(ab, tolower = TRUE, language = NULL)
|
||||||
if (generalise_antibiotic_name(ab.bak) == generalise_antibiotic_name(agent_name)) {
|
if (generalise_antibiotic_name(ab.bak) == generalise_antibiotic_name(agent_name)) {
|
||||||
|
|
@ -801,27 +801,31 @@ as_sir_method <- function(method_short,
|
||||||
appendLF = FALSE,
|
appendLF = FALSE,
|
||||||
as_note = FALSE
|
as_note = FALSE
|
||||||
)
|
)
|
||||||
|
|
||||||
msg_note <- function(messages) {
|
msg_note <- function(messages) {
|
||||||
for (i in seq_len(length(messages))) {
|
for (i in seq_len(length(messages))) {
|
||||||
messages[i] <- word_wrap(extra_indent = 5, messages[i])
|
messages[i] <- word_wrap(extra_indent = 5, messages[i])
|
||||||
}
|
}
|
||||||
message(font_green(font_bold(" Note:\n")),
|
message(
|
||||||
paste0(" ", font_black(AMR_env$bullet_icon)," ", font_black(messages, collapse = NULL) , collapse = "\n"))
|
font_green(font_bold(" Note:\n")),
|
||||||
|
paste0(" ", font_black(AMR_env$bullet_icon), " ", font_black(messages, collapse = NULL), collapse = "\n")
|
||||||
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
method <- method_short
|
method <- method_short
|
||||||
|
|
||||||
metadata_mo <- get_mo_uncertainties()
|
metadata_mo <- get_mo_uncertainties()
|
||||||
|
|
||||||
df <- data.frame(values = x,
|
df <- data.frame(
|
||||||
mo = mo,
|
values = x,
|
||||||
result = NA_sir_,
|
mo = mo,
|
||||||
uti = uti,
|
result = NA_sir_,
|
||||||
stringsAsFactors = FALSE)
|
uti = uti,
|
||||||
|
stringsAsFactors = FALSE
|
||||||
|
)
|
||||||
if (method == "mic") {
|
if (method == "mic") {
|
||||||
# when as.sir.mic is called directly
|
# when as.sir.mic is called directly
|
||||||
df$values <- as.mic(df$values)
|
df$values <- as.mic(df$values)
|
||||||
} else if (method == "disk") {
|
} else if (method == "disk") {
|
||||||
# when as.sir.disk is called directly
|
# when as.sir.disk is called directly
|
||||||
df$values <- as.disk(df$values)
|
df$values <- as.disk(df$values)
|
||||||
|
|
@ -832,7 +836,7 @@ as_sir_method <- function(method_short,
|
||||||
method_coerced <- toupper(method)
|
method_coerced <- toupper(method)
|
||||||
ab_coerced <- ab
|
ab_coerced <- ab
|
||||||
mo_coerced <- mo
|
mo_coerced <- mo
|
||||||
|
|
||||||
if (identical(reference_data, AMR::clinical_breakpoints)) {
|
if (identical(reference_data, AMR::clinical_breakpoints)) {
|
||||||
breakpoints <- reference_data %pm>%
|
breakpoints <- reference_data %pm>%
|
||||||
subset(guideline == guideline_coerced & method == method_coerced & ab == ab_coerced)
|
subset(guideline == guideline_coerced & method == method_coerced & ab == ab_coerced)
|
||||||
|
|
@ -845,30 +849,31 @@ as_sir_method <- function(method_short,
|
||||||
breakpoints <- reference_data %pm>%
|
breakpoints <- reference_data %pm>%
|
||||||
subset(method == method_coerced & ab == ab_coerced)
|
subset(method == method_coerced & ab == ab_coerced)
|
||||||
}
|
}
|
||||||
|
|
||||||
msgs <- character(0)
|
msgs <- character(0)
|
||||||
if (nrow(breakpoints) == 0) {
|
if (nrow(breakpoints) == 0) {
|
||||||
# apparently no breakpoints found
|
# apparently no breakpoints found
|
||||||
msg_note(paste0("No ", method_coerced, " breakpoints available for ",
|
msg_note(paste0(
|
||||||
suppressMessages(suppressWarnings(ab_name(ab_coerced, language = NULL, tolower = TRUE))),
|
"No ", method_coerced, " breakpoints available for ",
|
||||||
" (", ab_coerced, ")"))
|
suppressMessages(suppressWarnings(ab_name(ab_coerced, language = NULL, tolower = TRUE))),
|
||||||
|
" (", ab_coerced, ")"
|
||||||
|
))
|
||||||
load_mo_uncertainties(metadata_mo)
|
load_mo_uncertainties(metadata_mo)
|
||||||
return(rep(NA_sir_, nrow(df)))
|
return(rep(NA_sir_, nrow(df)))
|
||||||
}
|
}
|
||||||
|
|
||||||
if (guideline_coerced %like% "EUCAST") {
|
if (guideline_coerced %like% "EUCAST") {
|
||||||
any_is_intrinsic_resistant <- FALSE
|
any_is_intrinsic_resistant <- FALSE
|
||||||
add_intrinsic_resistance_to_AMR_env()
|
add_intrinsic_resistance_to_AMR_env()
|
||||||
}
|
}
|
||||||
|
|
||||||
# run the rules
|
# run the rules
|
||||||
for (mo_unique in unique(df$mo)) {
|
for (mo_unique in unique(df$mo)) {
|
||||||
|
|
||||||
rows <- which(df$mo == mo_unique)
|
rows <- which(df$mo == mo_unique)
|
||||||
values <- df[rows, "values", drop = TRUE]
|
values <- df[rows, "values", drop = TRUE]
|
||||||
uti <- df[rows, "uti", drop = TRUE]
|
uti <- df[rows, "uti", drop = TRUE]
|
||||||
new_sir <- rep(NA_sir_, length(rows))
|
new_sir <- rep(NA_sir_, length(rows))
|
||||||
|
|
||||||
# find different mo properties
|
# find different mo properties
|
||||||
mo_current_genus <- as.mo(mo_genus(mo_unique, language = NULL))
|
mo_current_genus <- as.mo(mo_genus(mo_unique, language = NULL))
|
||||||
mo_current_family <- as.mo(mo_family(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")) {
|
if (!mo_rank(mo_unique) %in% c("kingdom", "phylum", "class", "order")) {
|
||||||
mo_formatted <- font_italic(mo_formatted)
|
mo_formatted <- font_italic(mo_formatted)
|
||||||
}
|
}
|
||||||
ab_formatted <- paste0(suppressMessages(suppressWarnings(ab_name(ab_coerced, language = NULL, tolower = TRUE))),
|
ab_formatted <- paste0(
|
||||||
" (", ab_coerced, ")")
|
suppressMessages(suppressWarnings(ab_name(ab_coerced, language = NULL, tolower = TRUE))),
|
||||||
|
" (", ab_coerced, ")"
|
||||||
# gather all available breakpoints for current MO and sort on taxonomic rank
|
)
|
||||||
|
|
||||||
|
# gather all available breakpoints for current MO and sort on taxonomic rank
|
||||||
# (this will prefer species breakpoints over order breakpoints)
|
# (this will prefer species breakpoints over order breakpoints)
|
||||||
breakpoints_current <- breakpoints %pm>%
|
breakpoints_current <- breakpoints %pm>%
|
||||||
subset(mo %in% c(mo_current_genus, mo_current_family,
|
subset(mo %in% c(
|
||||||
mo_current_order, mo_current_class,
|
mo_current_genus, mo_current_family,
|
||||||
mo_current_becker, mo_current_lancefield,
|
mo_current_order, mo_current_class,
|
||||||
mo_current_other))
|
mo_current_becker, mo_current_lancefield,
|
||||||
|
mo_current_other
|
||||||
|
))
|
||||||
|
|
||||||
if (any(df[rows, "uti", drop = TRUE], na.rm = TRUE)) {
|
if (any(df[rows, "uti", drop = TRUE], na.rm = TRUE)) {
|
||||||
breakpoints_current <- breakpoints_current %pm>%
|
breakpoints_current <- breakpoints_current %pm>%
|
||||||
# be as specific as possible (i.e. prefer species over genus):
|
# 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
|
# sort UTI = FALSE first, then UTI = TRUE
|
||||||
pm_arrange(rank_index, uti)
|
pm_arrange(rank_index, uti)
|
||||||
}
|
}
|
||||||
|
|
||||||
# throw notes for different body sites
|
# 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)) {
|
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
|
# 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, "."))
|
msgs <- c(msgs, paste0("Multiple breakpoints available for ", ab_formatted, " in ", mo_formatted, " - assuming ", site, "."))
|
||||||
}
|
}
|
||||||
|
|
||||||
# first check if mo is intrinsic resistant
|
# 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) {
|
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, ""))
|
msgs <- c(msgs, paste0("Intrinsic resistance applied for ", ab_formatted, " in ", mo_formatted, ""))
|
||||||
new_sir <- rep(as.sir("R"), length(rows))
|
new_sir <- rep(as.sir("R"), length(rows))
|
||||||
|
|
||||||
} else {
|
} else {
|
||||||
# then run the rules
|
# then run the rules
|
||||||
breakpoints_current <- breakpoints_current[1L, , drop = FALSE]
|
breakpoints_current <- breakpoints_current[1L, , drop = FALSE]
|
||||||
|
|
||||||
if (method == "mic") {
|
if (method == "mic") {
|
||||||
new_sir <- quick_case_when(
|
new_sir <- quick_case_when(
|
||||||
is.na(values) ~ NA_sir_,
|
is.na(values) ~ NA_sir_,
|
||||||
|
|
@ -953,7 +961,6 @@ as_sir_method <- function(method_short,
|
||||||
# and NA otherwise
|
# and NA otherwise
|
||||||
TRUE ~ NA_sir_
|
TRUE ~ NA_sir_
|
||||||
)
|
)
|
||||||
|
|
||||||
} else if (method == "disk") {
|
} else if (method == "disk") {
|
||||||
new_sir <- quick_case_when(
|
new_sir <- quick_case_when(
|
||||||
is.na(values) ~ NA_sir_,
|
is.na(values) ~ NA_sir_,
|
||||||
|
|
@ -988,10 +995,10 @@ as_sir_method <- function(method_short,
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
df[rows, "result"] <- new_sir
|
df[rows, "result"] <- new_sir
|
||||||
}
|
}
|
||||||
|
|
||||||
if (isTRUE(rise_warning)) {
|
if (isTRUE(rise_warning)) {
|
||||||
message(font_yellow(font_bold(" * WARNING *")))
|
message(font_yellow(font_bold(" * WARNING *")))
|
||||||
} else if (length(msgs) == 0) {
|
} else if (length(msgs) == 0) {
|
||||||
|
|
@ -999,9 +1006,9 @@ as_sir_method <- function(method_short,
|
||||||
} else {
|
} else {
|
||||||
msg_note(sort(msgs))
|
msg_note(sort(msgs))
|
||||||
}
|
}
|
||||||
|
|
||||||
load_mo_uncertainties(metadata_mo)
|
load_mo_uncertainties(metadata_mo)
|
||||||
|
|
||||||
df$result
|
df$result
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -1027,6 +1034,9 @@ sir_interpretation_history <- function(clean = FALSE) {
|
||||||
AMR_env$sir_interpretation_history <- out.bak
|
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)) {
|
if (pkg_is_available("tibble", also_load = FALSE)) {
|
||||||
import_fn("as_tibble", "tibble")(out)
|
import_fn("as_tibble", "tibble")(out)
|
||||||
} else {
|
} else {
|
||||||
|
|
|
||||||
BIN
R/sysdata.rda
BIN
R/sysdata.rda
Binary file not shown.
|
|
@ -141,10 +141,11 @@ reset_AMR_locale <- function() {
|
||||||
#' @export
|
#' @export
|
||||||
translate_AMR <- function(x, language = get_AMR_locale()) {
|
translate_AMR <- function(x, language = get_AMR_locale()) {
|
||||||
translate_into_language(x,
|
translate_into_language(x,
|
||||||
language = language,
|
language = language,
|
||||||
only_unknown = FALSE,
|
only_unknown = FALSE,
|
||||||
only_affect_ab_names = FALSE,
|
only_affect_ab_names = FALSE,
|
||||||
only_affect_mo_names = FALSE)
|
only_affect_mo_names = FALSE
|
||||||
|
)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -170,14 +171,15 @@ find_language <- function(language, fallback = TRUE) {
|
||||||
language <- Map(LANGUAGES_SUPPORTED_NAMES,
|
language <- Map(LANGUAGES_SUPPORTED_NAMES,
|
||||||
LANGUAGES_SUPPORTED,
|
LANGUAGES_SUPPORTED,
|
||||||
f = function(l, n, check = language) {
|
f = function(l, n, check = language) {
|
||||||
grepl(paste0(
|
grepl(
|
||||||
"^(", l[1], "|", l[2], "|",
|
paste0(
|
||||||
n, "(_|$)|", toupper(n), "(_|$))"
|
"^(", l[1], "|", l[2], "|",
|
||||||
),
|
n, "(_|$)|", toupper(n), "(_|$))"
|
||||||
check,
|
),
|
||||||
ignore.case = TRUE,
|
check,
|
||||||
perl = TRUE,
|
ignore.case = TRUE,
|
||||||
useBytes = FALSE
|
perl = TRUE,
|
||||||
|
useBytes = FALSE
|
||||||
)
|
)
|
||||||
},
|
},
|
||||||
USE.NAMES = TRUE
|
USE.NAMES = TRUE
|
||||||
|
|
@ -196,7 +198,6 @@ translate_into_language <- function(from,
|
||||||
only_unknown = FALSE,
|
only_unknown = FALSE,
|
||||||
only_affect_ab_names = FALSE,
|
only_affect_ab_names = FALSE,
|
||||||
only_affect_mo_names = FALSE) {
|
only_affect_mo_names = FALSE) {
|
||||||
|
|
||||||
# get ISO-639-1 of language
|
# get ISO-639-1 of language
|
||||||
lang <- validate_language(language)
|
lang <- validate_language(language)
|
||||||
if (lang == "en") {
|
if (lang == "en") {
|
||||||
|
|
@ -260,10 +261,10 @@ translate_into_language <- function(from,
|
||||||
|
|
||||||
# force UTF-8 for diacritics
|
# force UTF-8 for diacritics
|
||||||
from_unique_translated <- enc2utf8(from_unique_translated)
|
from_unique_translated <- enc2utf8(from_unique_translated)
|
||||||
|
|
||||||
# a kind of left join to get all results back
|
# a kind of left join to get all results back
|
||||||
out <- from_unique_translated[match(from.bak, from_unique)]
|
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()) {
|
if (!identical(from.bak, out) && get_AMR_locale() == lang && message_not_thrown_before("translation", entire_session = TRUE) && interactive()) {
|
||||||
message(word_wrap(
|
message(word_wrap(
|
||||||
"Assuming the ", LANGUAGES_SUPPORTED_NAMES[[lang]]$exonym, " language (",
|
"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
|
add_fn = list(font_blue), as_note = TRUE
|
||||||
))
|
))
|
||||||
}
|
}
|
||||||
|
|
||||||
out
|
out
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -35,7 +35,8 @@
|
||||||
#' @rdname AMR-deprecated
|
#' @rdname AMR-deprecated
|
||||||
#' @export
|
#' @export
|
||||||
NA_rsi_ <- set_clean_class(factor(NA_character_, levels = c("S", "I", "R"), ordered = TRUE),
|
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
|
#' @rdname AMR-deprecated
|
||||||
#' @export
|
#' @export
|
||||||
as.rsi <- function(x, ...) {
|
as.rsi <- function(x, ...) {
|
||||||
|
|
@ -197,14 +198,18 @@ deprecation_warning <- function(old = NULL, new = NULL, extra_msg = NULL) {
|
||||||
env <- paste0("deprecated_", old)
|
env <- paste0("deprecated_", old)
|
||||||
if (!env %in% names(AMR_env)) {
|
if (!env %in% names(AMR_env)) {
|
||||||
AMR_env[[paste0("deprecated_", old)]] <- 1
|
AMR_env[[paste0("deprecated_", old)]] <- 1
|
||||||
warning_(ifelse(is.null(new),
|
warning_(
|
||||||
paste0("The `", old, "()` function is no longer in use"),
|
ifelse(is.null(new),
|
||||||
paste0("The `", old, "()` function has been replaced with `", new, "()`")),
|
paste0("The `", old, "()` function is no longer in use"),
|
||||||
", see `?AMR-deprecated`.",
|
paste0("The `", old, "()` function has been replaced with `", new, "()`")
|
||||||
ifelse(!is.null(extra_msg),
|
),
|
||||||
paste0(" ", extra_msg),
|
", see `?AMR-deprecated`.",
|
||||||
""),
|
ifelse(!is.null(extra_msg),
|
||||||
"\nThis warning will be shown once per session.")
|
paste0(" ", extra_msg),
|
||||||
|
""
|
||||||
|
),
|
||||||
|
"\nThis warning will be shown once per session."
|
||||||
|
)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
||||||
22
R/zzz.R
22
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 = ""))) {
|
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)
|
packageStartupMessage("Adding custom antimicrobials from '", getOption("AMR_custom_ab"), "'...", appendLF = FALSE)
|
||||||
x <- readRDS2(getOption("AMR_custom_ab"))
|
x <- readRDS2(getOption("AMR_custom_ab"))
|
||||||
tryCatch({
|
tryCatch(
|
||||||
suppressWarnings(suppressMessages(add_custom_antimicrobials(x)))
|
{
|
||||||
packageStartupMessage("OK.")
|
suppressWarnings(suppressMessages(add_custom_antimicrobials(x)))
|
||||||
}, error = function(e) packageStartupMessage("Failed: ", e$message))
|
packageStartupMessage("OK.")
|
||||||
|
},
|
||||||
|
error = function(e) packageStartupMessage("Failed: ", e$message)
|
||||||
|
)
|
||||||
}
|
}
|
||||||
# if custom mo option is available, load it
|
# if custom mo option is available, load it
|
||||||
if (!is.null(getOption("AMR_custom_mo")) && file.exists(getOption("AMR_custom_mo", default = ""))) {
|
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)
|
packageStartupMessage("Adding custom microorganisms from '", getOption("AMR_custom_mo"), "'...", appendLF = FALSE)
|
||||||
x <- readRDS2(getOption("AMR_custom_mo"))
|
x <- readRDS2(getOption("AMR_custom_mo"))
|
||||||
tryCatch({
|
tryCatch(
|
||||||
suppressWarnings(suppressMessages(add_custom_microorganisms(x)))
|
{
|
||||||
packageStartupMessage("OK.")
|
suppressWarnings(suppressMessages(add_custom_microorganisms(x)))
|
||||||
}, error = function(e) packageStartupMessage("Failed: ", e$message))
|
packageStartupMessage("OK.")
|
||||||
|
},
|
||||||
|
error = function(e) packageStartupMessage("Failed: ", e$message)
|
||||||
|
)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -101,46 +101,48 @@ create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
|
||||||
MO_staph <- AMR::microorganisms
|
MO_staph <- AMR::microorganisms
|
||||||
MO_staph <- MO_staph[which(MO_staph$genus == "Staphylococcus"), , drop = FALSE]
|
MO_staph <- MO_staph[which(MO_staph$genus == "Staphylococcus"), , drop = FALSE]
|
||||||
if (type == "CoNS") {
|
if (type == "CoNS") {
|
||||||
MO_staph[which(MO_staph$species %in% c(
|
MO_staph[
|
||||||
"coagulase-negative", "argensis", "arlettae",
|
which(MO_staph$species %in% c(
|
||||||
"auricularis", "borealis", "caeli", "capitis", "caprae",
|
"coagulase-negative", "argensis", "arlettae",
|
||||||
"carnosus", "casei", "caseolyticus", "chromogenes", "cohnii", "condimenti",
|
"auricularis", "borealis", "caeli", "capitis", "caprae",
|
||||||
"croceilyticus",
|
"carnosus", "casei", "caseolyticus", "chromogenes", "cohnii", "condimenti",
|
||||||
"debuckii", "devriesei", "edaphicus", "epidermidis",
|
"croceilyticus",
|
||||||
"equorum", "felis", "fleurettii", "gallinarum",
|
"debuckii", "devriesei", "edaphicus", "epidermidis",
|
||||||
"haemolyticus", "hominis", "jettensis", "kloosii",
|
"equorum", "felis", "fleurettii", "gallinarum",
|
||||||
"lentus", "lugdunensis", "massiliensis", "microti",
|
"haemolyticus", "hominis", "jettensis", "kloosii",
|
||||||
"muscae", "nepalensis", "pasteuri", "petrasii",
|
"lentus", "lugdunensis", "massiliensis", "microti",
|
||||||
"pettenkoferi", "piscifermentans", "pragensis", "pseudoxylosus",
|
"muscae", "nepalensis", "pasteuri", "petrasii",
|
||||||
"pulvereri", "rostri", "saccharolyticus", "saprophyticus",
|
"pettenkoferi", "piscifermentans", "pragensis", "pseudoxylosus",
|
||||||
"sciuri", "simulans", "stepanovicii", "succinus",
|
"pulvereri", "rostri", "saccharolyticus", "saprophyticus",
|
||||||
"ureilyticus",
|
"sciuri", "simulans", "stepanovicii", "succinus",
|
||||||
"vitulinus", "vitulus", "warneri", "xylosus",
|
"ureilyticus",
|
||||||
"caledonicus", "canis",
|
"vitulinus", "vitulus", "warneri", "xylosus",
|
||||||
"durrellii", "lloydii",
|
"caledonicus", "canis",
|
||||||
"ratti", "taiwanensis", "veratri", "urealyticus"
|
"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", ""))),
|
# old, now renamed to S. schleiferi (but still as synonym in our data of course):
|
||||||
"mo",
|
(MO_staph$species == "schleiferi" & MO_staph$subspecies %in% c("schleiferi", ""))),
|
||||||
drop = TRUE
|
"mo",
|
||||||
|
drop = TRUE
|
||||||
]
|
]
|
||||||
} else if (type == "CoPS") {
|
} else if (type == "CoPS") {
|
||||||
MO_staph[which(MO_staph$species %in% c(
|
MO_staph[
|
||||||
"coagulase-positive", "coagulans",
|
which(MO_staph$species %in% c(
|
||||||
"agnetis", "argenteus",
|
"coagulase-positive", "coagulans",
|
||||||
"cornubiensis",
|
"agnetis", "argenteus",
|
||||||
"delphini", "lutrae",
|
"cornubiensis",
|
||||||
"hyicus", "intermedius",
|
"delphini", "lutrae",
|
||||||
"pseudintermedius", "pseudointermedius",
|
"hyicus", "intermedius",
|
||||||
"schweitzeri", "simiae",
|
"pseudintermedius", "pseudointermedius",
|
||||||
"roterodami",
|
"schweitzeri", "simiae",
|
||||||
"singaporensis"
|
"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")),
|
# old, now renamed to S. coagulans (but still as synonym in our data of course):
|
||||||
"mo",
|
(MO_staph$species == "schleiferi" & MO_staph$subspecies == "coagulans")),
|
||||||
drop = TRUE
|
"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_loinc <- lapply(new_df$loinc, generalise_antibiotic_name)
|
||||||
new_df$generalised_all <- unname(lapply(
|
new_df$generalised_all <- unname(lapply(
|
||||||
as.list(as.data.frame(t(new_df[,
|
as.list(as.data.frame(
|
||||||
c(
|
t(new_df[,
|
||||||
colnames(new_df)[colnames(new_df) %in% c("ab", "av", "atc", "cid", "name")],
|
c(
|
||||||
colnames(new_df)[colnames(new_df) %like% "generalised"]
|
colnames(new_df)[colnames(new_df) %in% c("ab", "av", "atc", "cid", "name")],
|
||||||
),
|
colnames(new_df)[colnames(new_df) %like% "generalised"]
|
||||||
drop = FALSE
|
),
|
||||||
]),
|
drop = FALSE
|
||||||
stringsAsFactors = FALSE
|
]),
|
||||||
|
stringsAsFactors = FALSE
|
||||||
)),
|
)),
|
||||||
function(x) {
|
function(x) {
|
||||||
x <- generalise_antibiotic_name(unname(unlist(x)))
|
x <- generalise_antibiotic_name(unname(unlist(x)))
|
||||||
|
|
@ -472,7 +475,7 @@ suppressMessages(devtools::document(quiet = TRUE))
|
||||||
if (!"styler" %in% rownames(utils::installed.packages())) {
|
if (!"styler" %in% rownames(utils::installed.packages())) {
|
||||||
message("Package 'styler' not installed!")
|
message("Package 'styler' not installed!")
|
||||||
} else if (interactive()) {
|
} else if (interactive()) {
|
||||||
# # only when sourcing this file ourselves
|
# only when sourcing this file ourselves
|
||||||
# usethis::ui_info("Styling package")
|
# usethis::ui_info("Styling package")
|
||||||
# styler::style_pkg(
|
# styler::style_pkg(
|
||||||
# style = styler::tidyverse_style,
|
# style = styler::tidyverse_style,
|
||||||
|
|
|
||||||
|
|
@ -1,4 +1,3 @@
|
||||||
|
|
||||||
license_text <- readLines("docs/LICENSE-text.html")
|
license_text <- readLines("docs/LICENSE-text.html")
|
||||||
license_text <- paste(license_text, collapse = "|||")
|
license_text <- paste(license_text, collapse = "|||")
|
||||||
license_text <- gsub("licen(s|c)e", "Survey", license_text, ignore.case = TRUE)
|
license_text <- gsub("licen(s|c)e", "Survey", license_text, ignore.case = TRUE)
|
||||||
|
|
|
||||||
|
|
@ -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
|
# in the info header in the Excel file, EUCAST mentions which genera are targeted
|
||||||
if (sheet %like% "anaerob.*Gram.*posi") {
|
if (sheet %like% "anaerob.*Gram.*posi") {
|
||||||
sheet <- paste0(c(
|
sheet <- paste0(
|
||||||
"Actinomyces", "Bifidobacterium", "Clostridioides",
|
c(
|
||||||
"Clostridium", "Cutibacterium", "Eggerthella",
|
"Actinomyces", "Bifidobacterium", "Clostridioides",
|
||||||
"Eubacterium", "Lactobacillus", "Propionibacterium",
|
"Clostridium", "Cutibacterium", "Eggerthella",
|
||||||
"Staphylococcus saccharolyticus"
|
"Eubacterium", "Lactobacillus", "Propionibacterium",
|
||||||
),
|
"Staphylococcus saccharolyticus"
|
||||||
collapse = "_"
|
),
|
||||||
|
collapse = "_"
|
||||||
)
|
)
|
||||||
} else if (sheet %like% "anaerob.*Gram.*nega") {
|
} else if (sheet %like% "anaerob.*Gram.*nega") {
|
||||||
sheet <- paste0(c(
|
sheet <- paste0(
|
||||||
"Bacteroides",
|
c(
|
||||||
"Bilophila",
|
"Bacteroides",
|
||||||
"Fusobacterium",
|
"Bilophila",
|
||||||
"Mobiluncus",
|
"Fusobacterium",
|
||||||
"Parabacteroides",
|
"Mobiluncus",
|
||||||
"Porphyromonas",
|
"Parabacteroides",
|
||||||
"Prevotella"
|
"Porphyromonas",
|
||||||
),
|
"Prevotella"
|
||||||
collapse = "_"
|
),
|
||||||
|
collapse = "_"
|
||||||
)
|
)
|
||||||
} else if (sheet == "Streptococcus A,B,C,G") {
|
} else if (sheet == "Streptococcus A,B,C,G") {
|
||||||
sheet <- paste0(microorganisms %>%
|
sheet <- paste0(
|
||||||
filter(genus == "Streptococcus") %>%
|
microorganisms %>%
|
||||||
mutate(lancefield = mo_name(mo, Lancefield = TRUE)) %>%
|
filter(genus == "Streptococcus") %>%
|
||||||
filter(lancefield %like% "^Streptococcus group") %>%
|
mutate(lancefield = mo_name(mo, Lancefield = TRUE)) %>%
|
||||||
pull(fullname),
|
filter(lancefield %like% "^Streptococcus group") %>%
|
||||||
collapse = "_"
|
pull(fullname),
|
||||||
|
collapse = "_"
|
||||||
)
|
)
|
||||||
} else if (sheet %like% "PK.*PD") {
|
} else if (sheet %like% "PK.*PD") {
|
||||||
sheet <- "UNKNOWN"
|
sheet <- "UNKNOWN"
|
||||||
|
|
|
||||||
|
|
@ -142,14 +142,15 @@ abx2 <- bind_rows(abx_atc1, abx_atc2)
|
||||||
rm(abx_atc1)
|
rm(abx_atc1)
|
||||||
rm(abx_atc2)
|
rm(abx_atc2)
|
||||||
|
|
||||||
abx2$ab[is.na(abx2$ab)] <- toupper(abbreviate(gsub(
|
abx2$ab[is.na(abx2$ab)] <- toupper(abbreviate(
|
||||||
"[/0-9-]",
|
gsub(
|
||||||
" ",
|
"[/0-9-]",
|
||||||
abx2$name[is.na(abx2$ab)]
|
" ",
|
||||||
),
|
abx2$name[is.na(abx2$ab)]
|
||||||
minlength = 3,
|
),
|
||||||
method = "left.kept",
|
minlength = 3,
|
||||||
strict = TRUE
|
method = "left.kept",
|
||||||
|
strict = TRUE
|
||||||
))
|
))
|
||||||
|
|
||||||
n_distinct(abx2$ab)
|
n_distinct(abx2$ab)
|
||||||
|
|
@ -197,24 +198,26 @@ get_CID <- function(ab) {
|
||||||
p$tick()
|
p$tick()
|
||||||
|
|
||||||
CID[i] <- tryCatch(
|
CID[i] <- tryCatch(
|
||||||
data.table::fread(paste0(
|
data.table::fread(
|
||||||
"https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/",
|
paste0(
|
||||||
URLencode(ab[i], reserved = TRUE),
|
"https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/",
|
||||||
"/cids/TXT?name_type=complete"
|
URLencode(ab[i], reserved = TRUE),
|
||||||
),
|
"/cids/TXT?name_type=complete"
|
||||||
showProgress = FALSE
|
),
|
||||||
|
showProgress = FALSE
|
||||||
)[[1]][1],
|
)[[1]][1],
|
||||||
error = function(e) NA_integer_
|
error = function(e) NA_integer_
|
||||||
)
|
)
|
||||||
if (is.na(CID[i])) {
|
if (is.na(CID[i])) {
|
||||||
# try with removing the text in brackets
|
# try with removing the text in brackets
|
||||||
CID[i] <- tryCatch(
|
CID[i] <- tryCatch(
|
||||||
data.table::fread(paste0(
|
data.table::fread(
|
||||||
"https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/",
|
paste0(
|
||||||
URLencode(trimws(gsub("[(].*[)]", "", ab[i])), reserved = TRUE),
|
"https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/",
|
||||||
"/cids/TXT?name_type=complete"
|
URLencode(trimws(gsub("[(].*[)]", "", ab[i])), reserved = TRUE),
|
||||||
),
|
"/cids/TXT?name_type=complete"
|
||||||
showProgress = FALSE
|
),
|
||||||
|
showProgress = FALSE
|
||||||
)[[1]][1],
|
)[[1]][1],
|
||||||
error = function(e) NA_integer_
|
error = function(e) NA_integer_
|
||||||
)
|
)
|
||||||
|
|
@ -223,12 +226,13 @@ get_CID <- function(ab) {
|
||||||
# try match on word and take the lowest CID value (sorted)
|
# try match on word and take the lowest CID value (sorted)
|
||||||
ab[i] <- gsub("[^a-z0-9]+", " ", ab[i], ignore.case = TRUE)
|
ab[i] <- gsub("[^a-z0-9]+", " ", ab[i], ignore.case = TRUE)
|
||||||
CID[i] <- tryCatch(
|
CID[i] <- tryCatch(
|
||||||
data.table::fread(paste0(
|
data.table::fread(
|
||||||
"https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/",
|
paste0(
|
||||||
URLencode(ab[i], reserved = TRUE),
|
"https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/",
|
||||||
"/cids/TXT?name_type=word"
|
URLencode(ab[i], reserved = TRUE),
|
||||||
),
|
"/cids/TXT?name_type=word"
|
||||||
showProgress = FALSE
|
),
|
||||||
|
showProgress = FALSE
|
||||||
)[[1]][1],
|
)[[1]][1],
|
||||||
error = function(e) NA_integer_
|
error = function(e) NA_integer_
|
||||||
)
|
)
|
||||||
|
|
@ -260,13 +264,14 @@ get_synonyms <- function(CID, clean = TRUE) {
|
||||||
}
|
}
|
||||||
|
|
||||||
synonyms_txt <- tryCatch(
|
synonyms_txt <- tryCatch(
|
||||||
data.table::fread(paste0(
|
data.table::fread(
|
||||||
"https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/fastidentity/cid/",
|
paste0(
|
||||||
CID[i],
|
"https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/fastidentity/cid/",
|
||||||
"/synonyms/TXT"
|
CID[i],
|
||||||
),
|
"/synonyms/TXT"
|
||||||
sep = "\n",
|
),
|
||||||
showProgress = FALSE
|
sep = "\n",
|
||||||
|
showProgress = FALSE
|
||||||
)[[1]],
|
)[[1]],
|
||||||
error = function(e) NA_character_
|
error = function(e) NA_character_
|
||||||
)
|
)
|
||||||
|
|
|
||||||
|
|
@ -106,31 +106,32 @@ antivirals <- antivirals %>%
|
||||||
oral_units,
|
oral_units,
|
||||||
iv_ddd,
|
iv_ddd,
|
||||||
iv_units
|
iv_units
|
||||||
) %>%
|
) %>%
|
||||||
AMR:::dataset_UTF8_to_ASCII()
|
AMR:::dataset_UTF8_to_ASCII()
|
||||||
|
|
||||||
av_codes <- tibble(name = antivirals$name %>%
|
av_codes <- tibble(name = antivirals$name %>%
|
||||||
strsplit("(, | and )") %>%
|
strsplit("(, | and )") %>%
|
||||||
unlist() %>%
|
unlist() %>%
|
||||||
unique() %>%
|
unique() %>%
|
||||||
sort()) %>%
|
sort()) %>%
|
||||||
mutate(av_1st = toupper(abbreviate(name, minlength = 3, use.classes = FALSE))) %>%
|
mutate(av_1st = toupper(abbreviate(name, minlength = 3, use.classes = FALSE))) %>%
|
||||||
filter(!name %in% c("acid", "dipivoxil", "disoproxil", "marboxil", "alafenamide"))
|
filter(!name %in% c("acid", "dipivoxil", "disoproxil", "marboxil", "alafenamide"))
|
||||||
|
|
||||||
replace_with_av_code <- function(name) {
|
replace_with_av_code <- function(name) {
|
||||||
unname(av_codes$av_1st[match(name, av_codes$name)])
|
unname(av_codes$av_1st[match(name, av_codes$name)])
|
||||||
}
|
}
|
||||||
|
|
||||||
names_codes <- antivirals %>%
|
names_codes <- antivirals %>%
|
||||||
separate(name,
|
separate(name,
|
||||||
into = paste0("name", c(1:7)),
|
into = paste0("name", c(1:7)),
|
||||||
sep = "(, | and )",
|
sep = "(, | and )",
|
||||||
remove = FALSE,
|
remove = FALSE,
|
||||||
fill = "right") %>%
|
fill = "right"
|
||||||
|
) %>%
|
||||||
# remove empty columns
|
# remove empty columns
|
||||||
select(!where(function(x) all(is.na(x)))) %>%
|
select(!where(function(x) all(is.na(x)))) %>%
|
||||||
mutate_at(vars(matches("name[1-9]")), replace_with_av_code) %>%
|
mutate_at(vars(matches("name[1-9]")), replace_with_av_code) %>%
|
||||||
unite(av, matches("name[1-9]"), sep = "+", na.rm = TRUE) %>%
|
unite(av, matches("name[1-9]"), sep = "+", na.rm = TRUE) %>%
|
||||||
mutate(name = gsub("(, | and )", "/", name))
|
mutate(name = gsub("(, | and )", "/", name))
|
||||||
substr(names_codes$name, 1, 1) <- toupper(substr(names_codes$name, 1, 1))
|
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'
|
# add loinc, see 'data-raw/loinc.R'
|
||||||
loinc_df <- read.csv("data-raw/Loinc.csv",
|
loinc_df <- read.csv("data-raw/Loinc.csv",
|
||||||
row.names = NULL,
|
row.names = NULL,
|
||||||
stringsAsFactors = FALSE)
|
stringsAsFactors = FALSE
|
||||||
|
)
|
||||||
|
|
||||||
loinc_df <- loinc_df %>% filter(CLASS == "DRUG/TOX")
|
loinc_df <- loinc_df %>% filter(CLASS == "DRUG/TOX")
|
||||||
av_names <- antivirals %>%
|
av_names <- antivirals %>%
|
||||||
|
|
|
||||||
|
|
@ -173,7 +173,7 @@ dosage_new <- bind_rows(
|
||||||
as.data.frame(stringsAsFactors = FALSE)
|
as.data.frame(stringsAsFactors = FALSE)
|
||||||
rownames(dosage_new) <- NULL
|
rownames(dosage_new) <- NULL
|
||||||
|
|
||||||
dosage <- bind_rows(dosage_new, AMR::dosage) %>%
|
dosage <- bind_rows(dosage_new, AMR::dosage) %>%
|
||||||
dataset_UTF8_to_ASCII()
|
dataset_UTF8_to_ASCII()
|
||||||
|
|
||||||
usethis::use_data(dosage, internal = FALSE, overwrite = TRUE, version = 2)
|
usethis::use_data(dosage, internal = FALSE, overwrite = TRUE, version = 2)
|
||||||
|
|
|
||||||
|
|
@ -37,10 +37,10 @@
|
||||||
# CSV file (~12,5 MB) as "taxonomy.csv". Their API unfortunately does
|
# CSV file (~12,5 MB) as "taxonomy.csv". Their API unfortunately does
|
||||||
# not include the full taxonomy and is currently (2022) pretty worthless.
|
# not include the full taxonomy and is currently (2022) pretty worthless.
|
||||||
# 3. For data about human pathogens, we use Bartlett et al. (2022),
|
# 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.
|
# 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
|
# . Download their latest xlsx file in the `data` folder and save it to our
|
||||||
#. `data-raw` folder.
|
# . `data-raw` folder.
|
||||||
# 4. Set this folder_location to the path where these two files are:
|
# 4. Set this folder_location to the path where these two files are:
|
||||||
folder_location <- "~/Downloads/backbone/"
|
folder_location <- "~/Downloads/backbone/"
|
||||||
file_gbif <- paste0(folder_location, "Taxon.tsv")
|
file_gbif <- paste0(folder_location, "Taxon.tsv")
|
||||||
|
|
@ -65,7 +65,7 @@ devtools::load_all(".") # load AMR package
|
||||||
|
|
||||||
get_author_year <- function(ref) {
|
get_author_year <- function(ref) {
|
||||||
# Only keep first author, e.g. transform 'Smith, Jones, 2011' to 'Smith et al., 2011'
|
# 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 <- iconv(ref, from = "UTF-8", to = "ASCII//TRANSLIT")
|
||||||
authors2 <- gsub(" ?\\(Approved Lists [0-9]+\\) ?", " () ", authors2)
|
authors2 <- gsub(" ?\\(Approved Lists [0-9]+\\) ?", " () ", authors2)
|
||||||
authors2 <- gsub(" [)(]+ $", "", authors2)
|
authors2 <- gsub(" [)(]+ $", "", authors2)
|
||||||
|
|
@ -73,21 +73,21 @@ get_author_year <- function(ref) {
|
||||||
authors2 <- trimws(gsub("^[(](.*)[)]$", "\\1", authors2))
|
authors2 <- trimws(gsub("^[(](.*)[)]$", "\\1", authors2))
|
||||||
# only take part after brackets if there's a name
|
# only take part after brackets if there's a name
|
||||||
authors2 <- ifelse(grepl(".*[)] [a-zA-Z]+.*", authors2),
|
authors2 <- ifelse(grepl(".*[)] [a-zA-Z]+.*", authors2),
|
||||||
gsub(".*[)] (.*)", "\\1", authors2),
|
gsub(".*[)] (.*)", "\\1", authors2),
|
||||||
authors2
|
authors2
|
||||||
)
|
)
|
||||||
# replace parentheses with emend. to get the latest authors
|
# replace parentheses with emend. to get the latest authors
|
||||||
authors2 <- gsub("(", " emend. ", authors2, fixed = TRUE)
|
authors2 <- gsub("(", " emend. ", authors2, fixed = TRUE)
|
||||||
authors2 <- gsub(")", "", authors2, fixed = TRUE)
|
authors2 <- gsub(")", "", authors2, fixed = TRUE)
|
||||||
authors2 <- gsub(" +", " ", authors2)
|
authors2 <- gsub(" +", " ", authors2)
|
||||||
authors2 <- trimws(authors2)
|
authors2 <- trimws(authors2)
|
||||||
|
|
||||||
# get year from last 4 digits
|
# get year from last 4 digits
|
||||||
lastyear <- as.integer(gsub(".*([0-9]{4})$", "\\1", authors2))
|
lastyear <- as.integer(gsub(".*([0-9]{4})$", "\\1", authors2))
|
||||||
# can never be later than now
|
# can never be later than now
|
||||||
lastyear <- ifelse(lastyear > as.integer(format(Sys.Date(), "%Y")),
|
lastyear <- ifelse(lastyear > as.integer(format(Sys.Date(), "%Y")),
|
||||||
NA,
|
NA,
|
||||||
lastyear
|
lastyear
|
||||||
)
|
)
|
||||||
# get authors without last year
|
# get authors without last year
|
||||||
authors <- gsub("(.*)[0-9]{4}$", "\\1", authors2)
|
authors <- gsub("(.*)[0-9]{4}$", "\\1", authors2)
|
||||||
|
|
@ -119,8 +119,8 @@ get_author_year <- function(ref) {
|
||||||
authors[nchar(authors) <= 3] <- ""
|
authors[nchar(authors) <= 3] <- ""
|
||||||
# combine author and year if year is available
|
# combine author and year if year is available
|
||||||
ref <- ifelse(!is.na(lastyear),
|
ref <- ifelse(!is.na(lastyear),
|
||||||
paste0(authors, ", ", lastyear),
|
paste0(authors, ", ", lastyear),
|
||||||
authors
|
authors
|
||||||
)
|
)
|
||||||
# fix beginning and ending
|
# fix beginning and ending
|
||||||
ref <- gsub(", $", "", ref)
|
ref <- gsub(", $", "", ref)
|
||||||
|
|
@ -128,7 +128,7 @@ get_author_year <- function(ref) {
|
||||||
ref <- gsub("^(emend|et al.,?)", "", ref)
|
ref <- gsub("^(emend|et al.,?)", "", ref)
|
||||||
ref <- trimws(ref)
|
ref <- trimws(ref)
|
||||||
ref <- gsub("'", "", ref)
|
ref <- gsub("'", "", ref)
|
||||||
|
|
||||||
# a lot start with a lowercase character - fix that
|
# 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)
|
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
|
# 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
|
# get latest taxonomic names of these fungal orders
|
||||||
include_fungal_orders_ids <- taxonomy_gbif.bak %>%
|
include_fungal_orders_ids <- taxonomy_gbif.bak %>%
|
||||||
filter(order %in% include_fungal_orders)
|
filter(order %in% include_fungal_orders)
|
||||||
include_fungal_orders <- taxonomy_gbif.bak %>%
|
include_fungal_orders <- taxonomy_gbif.bak %>%
|
||||||
filter(taxonID %in% c(include_fungal_orders_ids$taxonID, include_fungal_orders_ids$acceptedNameUsageID)) %>%
|
filter(taxonID %in% c(include_fungal_orders_ids$taxonID, include_fungal_orders_ids$acceptedNameUsageID)) %>%
|
||||||
distinct(order) %>%
|
distinct(order) %>%
|
||||||
pull(order)
|
pull(order)
|
||||||
|
|
||||||
# check some columns to validate below filters
|
# check some columns to validate below filters
|
||||||
|
|
@ -361,7 +361,7 @@ for (page in LETTERS) {
|
||||||
names <- names[ranks != "species"]
|
names <- names[ranks != "species"]
|
||||||
ranks <- ranks[ranks != "species"]
|
ranks <- ranks[ranks != "species"]
|
||||||
ranks[ranks == "domain"] <- "kingdom"
|
ranks[ranks == "domain"] <- "kingdom"
|
||||||
|
|
||||||
df <- names %>%
|
df <- names %>%
|
||||||
tibble() %>%
|
tibble() %>%
|
||||||
t() %>%
|
t() %>%
|
||||||
|
|
@ -369,7 +369,7 @@ for (page in LETTERS) {
|
||||||
setNames(ranks) %>%
|
setNames(ranks) %>%
|
||||||
# no candidates please
|
# no candidates please
|
||||||
filter(genus %unlike% "^(Candidatus|\\[)")
|
filter(genus %unlike% "^(Candidatus|\\[)")
|
||||||
|
|
||||||
taxonomy_lpsn_missing <- taxonomy_lpsn_missing %>%
|
taxonomy_lpsn_missing <- taxonomy_lpsn_missing %>%
|
||||||
bind_rows(df)
|
bind_rows(df)
|
||||||
}
|
}
|
||||||
|
|
@ -491,14 +491,14 @@ saveRDS(taxonomy_lpsn, "data-raw/taxonomy_lpsn.rds", version = 2)
|
||||||
taxonomy_gbif <- taxonomy_gbif %>%
|
taxonomy_gbif <- taxonomy_gbif %>%
|
||||||
# clean NAs and add fullname
|
# clean NAs and add fullname
|
||||||
mutate(across(kingdom:subspecies, function(x) ifelse(is.na(x), "", x)),
|
mutate(across(kingdom:subspecies, function(x) ifelse(is.na(x), "", x)),
|
||||||
fullname = trimws(case_when(
|
fullname = trimws(case_when(
|
||||||
rank == "family" ~ family,
|
rank == "family" ~ family,
|
||||||
rank == "order" ~ order,
|
rank == "order" ~ order,
|
||||||
rank == "class" ~ class,
|
rank == "class" ~ class,
|
||||||
rank == "phylum" ~ phylum,
|
rank == "phylum" ~ phylum,
|
||||||
rank == "kingdom" ~ kingdom,
|
rank == "kingdom" ~ kingdom,
|
||||||
TRUE ~ paste(genus, species, subspecies)
|
TRUE ~ paste(genus, species, subspecies)
|
||||||
)), .before = 1
|
)), .before = 1
|
||||||
) %>%
|
) %>%
|
||||||
# keep only one GBIF taxon ID per full name
|
# keep only one GBIF taxon ID per full name
|
||||||
arrange(fullname, gbif) %>%
|
arrange(fullname, gbif) %>%
|
||||||
|
|
@ -507,14 +507,14 @@ taxonomy_gbif <- taxonomy_gbif %>%
|
||||||
taxonomy_lpsn <- taxonomy_lpsn %>%
|
taxonomy_lpsn <- taxonomy_lpsn %>%
|
||||||
# clean NAs and add fullname
|
# clean NAs and add fullname
|
||||||
mutate(across(kingdom:subspecies, function(x) ifelse(is.na(x), "", x)),
|
mutate(across(kingdom:subspecies, function(x) ifelse(is.na(x), "", x)),
|
||||||
fullname = trimws(case_when(
|
fullname = trimws(case_when(
|
||||||
rank == "family" ~ family,
|
rank == "family" ~ family,
|
||||||
rank == "order" ~ order,
|
rank == "order" ~ order,
|
||||||
rank == "class" ~ class,
|
rank == "class" ~ class,
|
||||||
rank == "phylum" ~ phylum,
|
rank == "phylum" ~ phylum,
|
||||||
rank == "kingdom" ~ kingdom,
|
rank == "kingdom" ~ kingdom,
|
||||||
TRUE ~ paste(genus, species, subspecies)
|
TRUE ~ paste(genus, species, subspecies)
|
||||||
)), .before = 1
|
)), .before = 1
|
||||||
) %>%
|
) %>%
|
||||||
# keep only one LPSN record ID per full name
|
# keep only one LPSN record ID per full name
|
||||||
arrange(fullname, lpsn) %>%
|
arrange(fullname, lpsn) %>%
|
||||||
|
|
@ -536,23 +536,25 @@ taxonomy_lpsn$lpsn_parent[taxonomy_lpsn$rank == "subspecies"] <- taxonomy_lpsn$l
|
||||||
taxonomy <- taxonomy_lpsn %>%
|
taxonomy <- taxonomy_lpsn %>%
|
||||||
# join GBIF identifiers to them
|
# join GBIF identifiers to them
|
||||||
left_join(taxonomy_gbif %>% select(kingdom, fullname, starts_with("gbif")),
|
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
|
# for everything else, add the GBIF data
|
||||||
taxonomy <- taxonomy %>%
|
taxonomy <- taxonomy %>%
|
||||||
bind_rows(taxonomy_gbif %>%
|
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) %>%
|
arrange(fullname) %>%
|
||||||
filter(fullname != "")
|
filter(fullname != "")
|
||||||
|
|
||||||
# get missing entries from existing microorganisms data set
|
# get missing entries from existing microorganisms data set
|
||||||
taxonomy <- taxonomy %>%
|
taxonomy <- taxonomy %>%
|
||||||
bind_rows(AMR::microorganisms %>%
|
bind_rows(AMR::microorganisms %>%
|
||||||
select(all_of(colnames(taxonomy))) %>%
|
select(all_of(colnames(taxonomy))) %>%
|
||||||
filter(!paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname),
|
filter(
|
||||||
# these will be added later:
|
!paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname),
|
||||||
source != "manually added")) %>%
|
# these will be added later:
|
||||||
|
source != "manually added"
|
||||||
|
)) %>%
|
||||||
arrange(fullname) %>%
|
arrange(fullname) %>%
|
||||||
filter(fullname != "")
|
filter(fullname != "")
|
||||||
|
|
||||||
|
|
@ -602,9 +604,10 @@ taxonomy <- taxonomy %>%
|
||||||
source = "manually added"
|
source = "manually added"
|
||||||
) %>%
|
) %>%
|
||||||
filter(!paste(kingdom, rank) %in% paste(taxonomy$kingdom, taxonomy$rank)) %>%
|
filter(!paste(kingdom, rank) %in% paste(taxonomy$kingdom, taxonomy$rank)) %>%
|
||||||
left_join(current_gbif %>%
|
left_join(
|
||||||
select(kingdom, rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID),
|
current_gbif %>%
|
||||||
by = c("kingdom", "rank")
|
select(kingdom, rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID),
|
||||||
|
by = c("kingdom", "rank")
|
||||||
) %>%
|
) %>%
|
||||||
mutate(source = ifelse(!is.na(gbif), "GBIF", source))
|
mutate(source = ifelse(!is.na(gbif), "GBIF", source))
|
||||||
)
|
)
|
||||||
|
|
@ -625,17 +628,18 @@ for (i in 2:6) {
|
||||||
source = "manually added"
|
source = "manually added"
|
||||||
) %>%
|
) %>%
|
||||||
filter(!paste(kingdom, .[[ncol(.) - 4]], rank) %in% paste(taxonomy$kingdom, taxonomy[[i + 1]], taxonomy$rank)) %>%
|
filter(!paste(kingdom, .[[ncol(.) - 4]], rank) %in% paste(taxonomy$kingdom, taxonomy[[i + 1]], taxonomy$rank)) %>%
|
||||||
# get GBIF identifier where available
|
# get GBIF identifier where available
|
||||||
left_join(current_gbif %>%
|
left_join(
|
||||||
select(kingdom, all_of(i_name), rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID),
|
current_gbif %>%
|
||||||
by = c("kingdom", "rank", i_name)
|
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))
|
) %>%
|
||||||
|
mutate(source = ifelse(!is.na(gbif), "GBIF", source))
|
||||||
message("n = ", nrow(to_add))
|
message("n = ", nrow(to_add))
|
||||||
if (is.null(taxonomy_all_missing)) {
|
if (is.null(taxonomy_all_missing)) {
|
||||||
taxonomy_all_missing <- to_add
|
taxonomy_all_missing <- to_add
|
||||||
} else {
|
} else {
|
||||||
taxonomy_all_missing <- taxonomy_all_missing %>%
|
taxonomy_all_missing <- taxonomy_all_missing %>%
|
||||||
bind_rows(to_add)
|
bind_rows(to_add)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
@ -645,20 +649,24 @@ taxonomy <- taxonomy %>%
|
||||||
bind_rows(taxonomy_all_missing)
|
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)
|
# fix for duplicate fullnames within a kingdom (such as Nitrospira which is the name of the genus AND its class)
|
||||||
taxonomy <- taxonomy %>%
|
taxonomy <- taxonomy %>%
|
||||||
mutate(rank_index = case_when(rank == "subspecies" ~ 1,
|
mutate(
|
||||||
rank == "species" ~ 2,
|
rank_index = case_when(
|
||||||
rank == "genus" ~ 3,
|
rank == "subspecies" ~ 1,
|
||||||
rank == "family" ~ 4,
|
rank == "species" ~ 2,
|
||||||
rank == "order" ~ 5,
|
rank == "genus" ~ 3,
|
||||||
rank == "class" ~ 6,
|
rank == "family" ~ 4,
|
||||||
TRUE ~ 7),
|
rank == "order" ~ 5,
|
||||||
fullname_rank = paste0(fullname, " {", rank, "}")) %>%
|
rank == "class" ~ 6,
|
||||||
arrange(kingdom, fullname, rank_index) %>%
|
TRUE ~ 7
|
||||||
group_by(kingdom, fullname) %>%
|
),
|
||||||
mutate(fullname = if_else(row_number() > 1, fullname_rank, fullname)) %>%
|
fullname_rank = paste0(fullname, " {", rank, "}")
|
||||||
ungroup() %>%
|
) %>%
|
||||||
select(-fullname_rank, -rank_index) %>%
|
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)
|
arrange(fullname)
|
||||||
|
|
||||||
# now also add missing species (requires combination with genus)
|
# 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)) %>%
|
filter(!paste(kingdom, genus, species, rank) %in% paste(taxonomy$kingdom, taxonomy$genus, taxonomy$species, taxonomy$rank)) %>%
|
||||||
# get GBIF identifier where available
|
# get GBIF identifier where available
|
||||||
left_join(current_gbif %>%
|
left_join(
|
||||||
select(kingdom, genus, species = specificEpithet, rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID),
|
current_gbif %>%
|
||||||
by = c("kingdom", "rank", "genus", "species")
|
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))
|
mutate(source = ifelse(!is.na(gbif), "GBIF", source))
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
||||||
# remove NAs from taxonomy again, and keep unique full names
|
# 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)) %>%
|
filter(source == "manually added", !paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname)) %>%
|
||||||
select(fullname:subspecies, ref, source, rank)
|
select(fullname:subspecies, ref, source, rank)
|
||||||
|
|
||||||
manually_added <- manually_added %>%
|
manually_added <- manually_added %>%
|
||||||
bind_rows(salmonellae)
|
bind_rows(salmonellae)
|
||||||
|
|
||||||
# get latest taxonomy for those entries
|
# get latest taxonomy for those entries
|
||||||
|
|
@ -805,76 +814,83 @@ taxonomy <- taxonomy %>%
|
||||||
pathogens <- read_excel(file_bartlett, sheet = "Tab 6 Full List")
|
pathogens <- read_excel(file_bartlett, sheet = "Tab 6 Full List")
|
||||||
|
|
||||||
# get all established, both old and current taxonomic names
|
# get all established, both old and current taxonomic names
|
||||||
established <- pathogens %>%
|
established <- pathogens %>%
|
||||||
filter(status == "established") %>%
|
filter(status == "established") %>%
|
||||||
mutate(fullname = paste(genus, species)) %>%
|
mutate(fullname = paste(genus, species)) %>%
|
||||||
pull(fullname) %>%
|
pull(fullname) %>%
|
||||||
c(unlist(mo_current(.)),
|
c(
|
||||||
unlist(mo_synonyms(., keep_synonyms = FALSE))) %>%
|
unlist(mo_current(.)),
|
||||||
strsplit(" ", fixed = TRUE) %>%
|
unlist(mo_synonyms(., keep_synonyms = FALSE))
|
||||||
sapply(function(x) ifelse(length(x) == 1, x, paste(x[1], x[2]))) %>%
|
) %>%
|
||||||
sort() %>%
|
strsplit(" ", fixed = TRUE) %>%
|
||||||
|
sapply(function(x) ifelse(length(x) == 1, x, paste(x[1], x[2]))) %>%
|
||||||
|
sort() %>%
|
||||||
unique()
|
unique()
|
||||||
|
|
||||||
# get all putative, both old and current taxonomic names
|
# get all putative, both old and current taxonomic names
|
||||||
putative <- pathogens %>%
|
putative <- pathogens %>%
|
||||||
filter(status == "putative") %>%
|
filter(status == "putative") %>%
|
||||||
mutate(fullname = paste(genus, species)) %>%
|
mutate(fullname = paste(genus, species)) %>%
|
||||||
pull(fullname) %>%
|
pull(fullname) %>%
|
||||||
c(unlist(mo_current(.)),
|
c(
|
||||||
unlist(mo_synonyms(., keep_synonyms = FALSE))) %>%
|
unlist(mo_current(.)),
|
||||||
strsplit(" ", fixed = TRUE) %>%
|
unlist(mo_synonyms(., keep_synonyms = FALSE))
|
||||||
sapply(function(x) ifelse(length(x) == 1, x, paste(x[1], x[2]))) %>%
|
) %>%
|
||||||
sort() %>%
|
strsplit(" ", fixed = TRUE) %>%
|
||||||
|
sapply(function(x) ifelse(length(x) == 1, x, paste(x[1], x[2]))) %>%
|
||||||
|
sort() %>%
|
||||||
unique()
|
unique()
|
||||||
|
|
||||||
established <- established[established %unlike% "unknown"]
|
established <- established[established %unlike% "unknown"]
|
||||||
putative <- putative[putative %unlike% "unknown"]
|
putative <- putative[putative %unlike% "unknown"]
|
||||||
|
|
||||||
established_genera <- established %>%
|
established_genera <- established %>%
|
||||||
strsplit(" ", fixed = TRUE) %>%
|
strsplit(" ", fixed = TRUE) %>%
|
||||||
sapply(function(x) x[1]) %>%
|
sapply(function(x) x[1]) %>%
|
||||||
sort() %>%
|
sort() %>%
|
||||||
unique()
|
unique()
|
||||||
|
|
||||||
putative_genera <- putative %>%
|
putative_genera <- putative %>%
|
||||||
strsplit(" ", fixed = TRUE) %>%
|
strsplit(" ", fixed = TRUE) %>%
|
||||||
sapply(function(x) x[1]) %>%
|
sapply(function(x) x[1]) %>%
|
||||||
sort() %>%
|
sort() %>%
|
||||||
unique()
|
unique()
|
||||||
|
|
||||||
nonbacterial_genera <- AMR:::MO_PREVALENT_GENERA %>%
|
nonbacterial_genera <- AMR:::MO_PREVALENT_GENERA %>%
|
||||||
c(unlist(mo_current(.)),
|
c(
|
||||||
unlist(mo_synonyms(., keep_synonyms = FALSE))) %>%
|
unlist(mo_current(.)),
|
||||||
strsplit(" ", fixed = TRUE) %>%
|
unlist(mo_synonyms(., keep_synonyms = FALSE))
|
||||||
sapply(function(x) x[1]) %>%
|
) %>%
|
||||||
sort() %>%
|
strsplit(" ", fixed = TRUE) %>%
|
||||||
|
sapply(function(x) x[1]) %>%
|
||||||
|
sort() %>%
|
||||||
unique()
|
unique()
|
||||||
nonbacterial_genera <- nonbacterial_genera[nonbacterial_genera %unlike% "unknown"]
|
nonbacterial_genera <- nonbacterial_genera[nonbacterial_genera %unlike% "unknown"]
|
||||||
|
|
||||||
# update prevalence based on taxonomy (following the recent and thorough work of Bartlett et al., 2022)
|
# 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
|
# see https://doi.org/10.1099/mic.0.001269
|
||||||
taxonomy <- taxonomy %>%
|
taxonomy <- taxonomy %>%
|
||||||
mutate(prevalence = case_when(
|
mutate(prevalence = case_when(
|
||||||
# 'established' means 'have infected at least three persons in three or more references'
|
# '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,
|
paste(genus, species) %in% established & rank %in% c("species", "subspecies") ~ 1.0,
|
||||||
# other genera in the 'established' group
|
# other genera in the 'established' group
|
||||||
genus %in% established_genera & rank == "genus" ~ 1.0,
|
genus %in% established_genera & rank == "genus" ~ 1.0,
|
||||||
|
|
||||||
# 'putative' means 'fewer than three known cases'
|
# 'putative' means 'fewer than three known cases'
|
||||||
paste(genus, species) %in% putative & rank %in% c("species", "subspecies") ~ 1.25,
|
paste(genus, species) %in% putative & rank %in% c("species", "subspecies") ~ 1.25,
|
||||||
# other genera in the 'putative' group
|
# other genera in the 'putative' group
|
||||||
genus %in% putative_genera & rank == "genus" ~ 1.25,
|
genus %in% putative_genera & rank == "genus" ~ 1.25,
|
||||||
|
|
||||||
# species and subspecies in 'established' and 'putative' groups
|
# species and subspecies in 'established' and 'putative' groups
|
||||||
genus %in% c(established_genera, putative_genera) & rank %in% c("species", "subspecies") ~ 1.5,
|
genus %in% c(established_genera, putative_genera) & rank %in% c("species", "subspecies") ~ 1.5,
|
||||||
# other species from a genus in either group
|
# other species from a genus in either group
|
||||||
genus %in% nonbacterial_genera & rank %in% c("genus", "species", "subspecies") ~ 1.5,
|
genus %in% nonbacterial_genera & rank %in% c("genus", "species", "subspecies") ~ 1.5,
|
||||||
# we keep track of prevalent genera too of non-bacterial species
|
# 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,
|
genus %in% AMR:::MO_PREVALENT_GENERA & kingdom != "Bacteria" & rank %in% c("genus", "species", "subspecies") ~ 1.5,
|
||||||
|
|
||||||
# all others
|
# all others
|
||||||
TRUE ~ 2.0))
|
TRUE ~ 2.0
|
||||||
|
))
|
||||||
|
|
||||||
table(taxonomy$prevalence, useNA = "always")
|
table(taxonomy$prevalence, useNA = "always")
|
||||||
# (a lot will be removed further below)
|
# (a lot will be removed further below)
|
||||||
|
|
@ -909,13 +925,14 @@ mo_kingdom <- taxonomy %>%
|
||||||
mo_phylum <- taxonomy %>%
|
mo_phylum <- taxonomy %>%
|
||||||
filter(rank == "phylum") %>%
|
filter(rank == "phylum") %>%
|
||||||
distinct(kingdom, phylum) %>%
|
distinct(kingdom, phylum) %>%
|
||||||
left_join(AMR::microorganisms %>%
|
left_join(
|
||||||
filter(rank == "phylum") %>%
|
AMR::microorganisms %>%
|
||||||
transmute(kingdom,
|
filter(rank == "phylum") %>%
|
||||||
phylum = fullname,
|
transmute(kingdom,
|
||||||
mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo))
|
phylum = fullname,
|
||||||
),
|
mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo))
|
||||||
by = c("kingdom", "phylum")
|
),
|
||||||
|
by = c("kingdom", "phylum")
|
||||||
) %>%
|
) %>%
|
||||||
group_by(kingdom) %>%
|
group_by(kingdom) %>%
|
||||||
mutate(
|
mutate(
|
||||||
|
|
@ -935,13 +952,14 @@ mo_phylum <- mo_phylum %>%
|
||||||
mo_class <- taxonomy %>%
|
mo_class <- taxonomy %>%
|
||||||
filter(rank == "class") %>%
|
filter(rank == "class") %>%
|
||||||
distinct(kingdom, class) %>%
|
distinct(kingdom, class) %>%
|
||||||
left_join(AMR::microorganisms %>%
|
left_join(
|
||||||
filter(rank == "class") %>%
|
AMR::microorganisms %>%
|
||||||
transmute(kingdom,
|
filter(rank == "class") %>%
|
||||||
class = fullname,
|
transmute(kingdom,
|
||||||
mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo))
|
class = fullname,
|
||||||
),
|
mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo))
|
||||||
by = c("kingdom", "class")
|
),
|
||||||
|
by = c("kingdom", "class")
|
||||||
) %>%
|
) %>%
|
||||||
group_by(kingdom) %>%
|
group_by(kingdom) %>%
|
||||||
mutate(
|
mutate(
|
||||||
|
|
@ -961,13 +979,14 @@ mo_class <- mo_class %>%
|
||||||
mo_order <- taxonomy %>%
|
mo_order <- taxonomy %>%
|
||||||
filter(rank == "order") %>%
|
filter(rank == "order") %>%
|
||||||
distinct(kingdom, order) %>%
|
distinct(kingdom, order) %>%
|
||||||
left_join(AMR::microorganisms %>%
|
left_join(
|
||||||
filter(rank == "order") %>%
|
AMR::microorganisms %>%
|
||||||
transmute(kingdom,
|
filter(rank == "order") %>%
|
||||||
order = fullname,
|
transmute(kingdom,
|
||||||
mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo))
|
order = fullname,
|
||||||
),
|
mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo))
|
||||||
by = c("kingdom", "order")
|
),
|
||||||
|
by = c("kingdom", "order")
|
||||||
) %>%
|
) %>%
|
||||||
group_by(kingdom) %>%
|
group_by(kingdom) %>%
|
||||||
mutate(
|
mutate(
|
||||||
|
|
@ -987,13 +1006,14 @@ mo_order <- mo_order %>%
|
||||||
mo_family <- taxonomy %>%
|
mo_family <- taxonomy %>%
|
||||||
filter(rank == "family") %>%
|
filter(rank == "family") %>%
|
||||||
distinct(kingdom, family) %>%
|
distinct(kingdom, family) %>%
|
||||||
left_join(AMR::microorganisms %>%
|
left_join(
|
||||||
filter(rank == "family") %>%
|
AMR::microorganisms %>%
|
||||||
transmute(kingdom,
|
filter(rank == "family") %>%
|
||||||
family = fullname,
|
transmute(kingdom,
|
||||||
mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo))
|
family = fullname,
|
||||||
),
|
mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo))
|
||||||
by = c("kingdom", "family")
|
),
|
||||||
|
by = c("kingdom", "family")
|
||||||
) %>%
|
) %>%
|
||||||
group_by(kingdom) %>%
|
group_by(kingdom) %>%
|
||||||
mutate(
|
mutate(
|
||||||
|
|
@ -1014,11 +1034,12 @@ mo_genus <- taxonomy %>%
|
||||||
filter(rank == "genus") %>%
|
filter(rank == "genus") %>%
|
||||||
distinct(kingdom, genus) %>%
|
distinct(kingdom, genus) %>%
|
||||||
# get available old MO codes
|
# get available old MO codes
|
||||||
left_join(AMR::microorganisms %>%
|
left_join(
|
||||||
filter(rank == "genus") %>%
|
AMR::microorganisms %>%
|
||||||
transmute(mo_genus_old = gsub("^[A-Z]+_", "", as.character(mo)), kingdom, genus) %>%
|
filter(rank == "genus") %>%
|
||||||
distinct(kingdom, genus, .keep_all = TRUE),
|
transmute(mo_genus_old = gsub("^[A-Z]+_", "", as.character(mo)), kingdom, genus) %>%
|
||||||
by = c("kingdom", "genus")
|
distinct(kingdom, genus, .keep_all = TRUE),
|
||||||
|
by = c("kingdom", "genus")
|
||||||
) %>%
|
) %>%
|
||||||
distinct(kingdom, genus, .keep_all = TRUE) %>%
|
distinct(kingdom, genus, .keep_all = TRUE) %>%
|
||||||
# since kingdom is part of the code, genus abbreviations may be duplicated between kingdoms
|
# 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 %>%
|
mo_species <- taxonomy %>%
|
||||||
filter(rank == "species") %>%
|
filter(rank == "species") %>%
|
||||||
distinct(kingdom, genus, species) %>%
|
distinct(kingdom, genus, species) %>%
|
||||||
left_join(AMR::microorganisms %>%
|
left_join(
|
||||||
filter(rank == "species") %>%
|
AMR::microorganisms %>%
|
||||||
transmute(mo_species_old = gsub("^[A-Z]+_[A-Z]+_", "", as.character(mo)), kingdom, genus, species) %>%
|
filter(rank == "species") %>%
|
||||||
filter(mo_species_old %unlike% "-") %>%
|
transmute(mo_species_old = gsub("^[A-Z]+_[A-Z]+_", "", as.character(mo)), kingdom, genus, species) %>%
|
||||||
distinct(kingdom, genus, species, .keep_all = TRUE),
|
filter(mo_species_old %unlike% "-") %>%
|
||||||
by = c("kingdom", "genus", "species")
|
distinct(kingdom, genus, species, .keep_all = TRUE),
|
||||||
|
by = c("kingdom", "genus", "species")
|
||||||
) %>%
|
) %>%
|
||||||
distinct(kingdom, genus, species, .keep_all = TRUE) %>%
|
distinct(kingdom, genus, species, .keep_all = TRUE) %>%
|
||||||
group_by(kingdom, genus) %>%
|
group_by(kingdom, genus) %>%
|
||||||
|
|
@ -1108,12 +1130,13 @@ mo_species <- mo_species %>%
|
||||||
mo_subspecies <- taxonomy %>%
|
mo_subspecies <- taxonomy %>%
|
||||||
filter(rank == "subspecies") %>%
|
filter(rank == "subspecies") %>%
|
||||||
distinct(kingdom, genus, species, subspecies) %>%
|
distinct(kingdom, genus, species, subspecies) %>%
|
||||||
left_join(AMR::microorganisms %>%
|
left_join(
|
||||||
filter(rank %in% c("subspecies", "subsp.", "infraspecies")) %>%
|
AMR::microorganisms %>%
|
||||||
transmute(mo_subspecies_old = gsub("^[A-Z]+_[A-Z]+_[A-Z]+_", "", as.character(mo)), kingdom, genus, species, subspecies) %>%
|
filter(rank %in% c("subspecies", "subsp.", "infraspecies")) %>%
|
||||||
filter(mo_subspecies_old %unlike% "-") %>%
|
transmute(mo_subspecies_old = gsub("^[A-Z]+_[A-Z]+_[A-Z]+_", "", as.character(mo)), kingdom, genus, species, subspecies) %>%
|
||||||
distinct(kingdom, genus, species, subspecies, .keep_all = TRUE),
|
filter(mo_subspecies_old %unlike% "-") %>%
|
||||||
by = c("kingdom", "genus", "species", "subspecies")
|
distinct(kingdom, genus, species, subspecies, .keep_all = TRUE),
|
||||||
|
by = c("kingdom", "genus", "species", "subspecies")
|
||||||
) %>%
|
) %>%
|
||||||
distinct(kingdom, genus, species, subspecies, .keep_all = TRUE) %>%
|
distinct(kingdom, genus, species, subspecies, .keep_all = TRUE) %>%
|
||||||
group_by(kingdom, genus, species) %>%
|
group_by(kingdom, genus, species) %>%
|
||||||
|
|
@ -1187,20 +1210,26 @@ taxonomy <- taxonomy %>%
|
||||||
arrange(fullname)
|
arrange(fullname)
|
||||||
|
|
||||||
# now check these - e.g. Nitrospira is the name of a genus AND its class
|
# 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 %>%
|
taxonomy <- taxonomy %>%
|
||||||
mutate(rank_index = case_when(kingdom == "Bacteria" ~ 1,
|
mutate(rank_index = case_when(
|
||||||
kingdom == "Fungi" ~ 2,
|
kingdom == "Bacteria" ~ 1,
|
||||||
kingdom == "Protozoa" ~ 3,
|
kingdom == "Fungi" ~ 2,
|
||||||
kingdom == "Archaea" ~ 4,
|
kingdom == "Protozoa" ~ 3,
|
||||||
TRUE ~ 5)) %>%
|
kingdom == "Archaea" ~ 4,
|
||||||
arrange(fullname, rank_index) %>%
|
TRUE ~ 5
|
||||||
distinct(fullname, .keep_all = TRUE) %>%
|
)) %>%
|
||||||
select(-rank_index) %>%
|
arrange(fullname, rank_index) %>%
|
||||||
|
distinct(fullname, .keep_all = TRUE) %>%
|
||||||
|
select(-rank_index) %>%
|
||||||
filter(mo != "")
|
filter(mo != "")
|
||||||
|
|
||||||
# this must not exist:
|
# this must not exist:
|
||||||
taxonomy %>% filter(mo %like% "__") %>% View()
|
taxonomy %>%
|
||||||
|
filter(mo %like% "__") %>%
|
||||||
|
View()
|
||||||
taxonomy <- taxonomy %>% filter(mo %unlike% "__")
|
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])
|
taxonomy %>% filter(fullname %in% .[duplicated(fullname), "fullname", drop = TRUE])
|
||||||
|
|
||||||
# are all GBIFs available?
|
# 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
|
# 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 == "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$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?
|
# 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
|
# 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)]
|
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
|
# no ghost families, orders classes, phyla
|
||||||
taxonomy <- taxonomy %>%
|
taxonomy <- taxonomy %>%
|
||||||
group_by(kingdom, family) %>% filter(n() > 1 | fullname %like% "unknown" | rank == "kingdom") %>%
|
group_by(kingdom, family) %>%
|
||||||
group_by(kingdom, order) %>% filter(n() > 1 | fullname %like% "unknown" | rank == "kingdom") %>%
|
filter(n() > 1 | fullname %like% "unknown" | rank == "kingdom") %>%
|
||||||
group_by(kingdom, class) %>% filter(n() > 1 | fullname %like% "unknown" | rank == "kingdom") %>%
|
group_by(kingdom, order) %>%
|
||||||
group_by(kingdom, phylum) %>% filter(n() > 1 | fullname %like% "unknown" | rank == "kingdom") %>%
|
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()
|
ungroup()
|
||||||
|
|
||||||
|
|
||||||
message("\nCongratulations! The new taxonomic table will contain ", format(nrow(taxonomy), big.mark = ","), " rows.\n",
|
message(
|
||||||
"This was ", format(nrow(AMR::microorganisms), big.mark = ","), " rows.\n")
|
"\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:
|
# 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:
|
# these were removed:
|
||||||
AMR::microorganisms %>% filter(!paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname)) %>% View()
|
AMR::microorganisms %>%
|
||||||
AMR::microorganisms %>% filter(!fullname %in% taxonomy$fullname) %>% View()
|
filter(!paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname)) %>%
|
||||||
|
View()
|
||||||
|
AMR::microorganisms %>%
|
||||||
|
filter(!fullname %in% taxonomy$fullname) %>%
|
||||||
|
View()
|
||||||
|
|
||||||
|
|
||||||
# Add SNOMED CT -----------------------------------------------------------
|
# Add SNOMED CT -----------------------------------------------------------
|
||||||
|
|
|
||||||
File diff suppressed because it is too large
Load Diff
|
|
@ -58,8 +58,9 @@ mo_name("Enterobacter asburiae/cloacae")
|
||||||
# now add a custom entry - it will be considered by as.mo() and
|
# now add a custom entry - it will be considered by as.mo() and
|
||||||
# all mo_*() functions
|
# all mo_*() functions
|
||||||
add_custom_microorganisms(
|
add_custom_microorganisms(
|
||||||
data.frame(genus = "Enterobacter",
|
data.frame(
|
||||||
species = "asburiae/cloacae"
|
genus = "Enterobacter",
|
||||||
|
species = "asburiae/cloacae"
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
@ -81,8 +82,10 @@ mo_info("Enterobacter asburiae/cloacae")
|
||||||
|
|
||||||
# the function tries to be forgiving:
|
# the function tries to be forgiving:
|
||||||
add_custom_microorganisms(
|
add_custom_microorganisms(
|
||||||
data.frame(GENUS = "BACTEROIDES / PARABACTEROIDES SLASHLINE",
|
data.frame(
|
||||||
SPECIES = "SPECIES")
|
GENUS = "BACTEROIDES / PARABACTEROIDES SLASHLINE",
|
||||||
|
SPECIES = "SPECIES"
|
||||||
|
)
|
||||||
)
|
)
|
||||||
mo_name("BACTEROIDES / PARABACTEROIDES")
|
mo_name("BACTEROIDES / PARABACTEROIDES")
|
||||||
mo_rank("BACTEROIDES / PARABACTEROIDES")
|
mo_rank("BACTEROIDES / PARABACTEROIDES")
|
||||||
|
|
@ -93,9 +96,11 @@ mo_family("Bacteroides/Parabacteroides")
|
||||||
|
|
||||||
# for groups and complexes, set them as species or subspecies:
|
# for groups and complexes, set them as species or subspecies:
|
||||||
add_custom_microorganisms(
|
add_custom_microorganisms(
|
||||||
data.frame(genus = "Citrobacter",
|
data.frame(
|
||||||
species = c("freundii", "braakii complex"),
|
genus = "Citrobacter",
|
||||||
subspecies = c("complex", ""))
|
species = c("freundii", "braakii complex"),
|
||||||
|
subspecies = c("complex", "")
|
||||||
|
)
|
||||||
)
|
)
|
||||||
mo_name(c("C. freundii complex", "C. braakii complex"))
|
mo_name(c("C. freundii complex", "C. braakii complex"))
|
||||||
mo_species(c("C. freundii complex", "C. braakii complex"))
|
mo_species(c("C. freundii complex", "C. braakii complex"))
|
||||||
|
|
|
||||||
|
|
@ -214,20 +214,17 @@ example_isolates[, ab_selector(oral_ddd > 1 & oral_units == "g")]
|
||||||
# dplyr -------------------------------------------------------------------
|
# dplyr -------------------------------------------------------------------
|
||||||
\donttest{
|
\donttest{
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
|
|
||||||
# get AMR for all aminoglycosides e.g., per ward:
|
# get AMR for all aminoglycosides e.g., per ward:
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
group_by(ward) \%>\%
|
group_by(ward) \%>\%
|
||||||
summarise(across(aminoglycosides(), resistance))
|
summarise(across(aminoglycosides(), resistance))
|
||||||
}
|
}
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
|
|
||||||
# You can combine selectors with '&' to be more specific:
|
# You can combine selectors with '&' to be more specific:
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
select(penicillins() & administrable_per_os())
|
select(penicillins() & administrable_per_os())
|
||||||
}
|
}
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
|
|
||||||
# get AMR for only drugs that matter - no intrinsic resistance:
|
# get AMR for only drugs that matter - no intrinsic resistance:
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
filter(mo_genus() \%in\% c("Escherichia", "Klebsiella")) \%>\%
|
filter(mo_genus() \%in\% c("Escherichia", "Klebsiella")) \%>\%
|
||||||
|
|
@ -235,7 +232,6 @@ if (require("dplyr")) {
|
||||||
summarise(across(not_intrinsic_resistant(), resistance))
|
summarise(across(not_intrinsic_resistant(), resistance))
|
||||||
}
|
}
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
|
|
||||||
# get susceptibility for antibiotics whose name contains "trim":
|
# get susceptibility for antibiotics whose name contains "trim":
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
filter(first_isolate()) \%>\%
|
filter(first_isolate()) \%>\%
|
||||||
|
|
@ -243,19 +239,16 @@ if (require("dplyr")) {
|
||||||
summarise(across(ab_selector(name \%like\% "trim"), susceptibility))
|
summarise(across(ab_selector(name \%like\% "trim"), susceptibility))
|
||||||
}
|
}
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
|
|
||||||
# this will select columns 'IPM' (imipenem) and 'MEM' (meropenem):
|
# this will select columns 'IPM' (imipenem) and 'MEM' (meropenem):
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
select(carbapenems())
|
select(carbapenems())
|
||||||
}
|
}
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
|
|
||||||
# this will select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB':
|
# this will select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB':
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
select(mo, aminoglycosides())
|
select(mo, aminoglycosides())
|
||||||
}
|
}
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
|
|
||||||
# any() and all() work in dplyr's filter() too:
|
# any() and all() work in dplyr's filter() too:
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
filter(
|
filter(
|
||||||
|
|
@ -264,25 +257,21 @@ if (require("dplyr")) {
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
|
|
||||||
# also works with c():
|
# also works with c():
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
filter(any(c(carbapenems(), aminoglycosides()) == "R"))
|
filter(any(c(carbapenems(), aminoglycosides()) == "R"))
|
||||||
}
|
}
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
|
|
||||||
# not setting any/all will automatically apply all():
|
# not setting any/all will automatically apply all():
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
filter(aminoglycosides() == "R")
|
filter(aminoglycosides() == "R")
|
||||||
}
|
}
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
|
|
||||||
# this will select columns 'mo' and all antimycobacterial drugs ('RIF'):
|
# this will select columns 'mo' and all antimycobacterial drugs ('RIF'):
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
select(mo, ab_class("mycobact"))
|
select(mo, ab_class("mycobact"))
|
||||||
}
|
}
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
|
|
||||||
# get bug/drug combinations for only glycopeptides in Gram-positives:
|
# get bug/drug combinations for only glycopeptides in Gram-positives:
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
filter(mo_is_gram_positive()) \%>\%
|
filter(mo_is_gram_positive()) \%>\%
|
||||||
|
|
@ -298,7 +287,6 @@ if (require("dplyr")) {
|
||||||
select(penicillins()) # only the 'J01CA01' column will be selected
|
select(penicillins()) # only the 'J01CA01' column will be selected
|
||||||
}
|
}
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
|
|
||||||
# with recent versions of dplyr this is all equal:
|
# with recent versions of dplyr this is all equal:
|
||||||
x <- example_isolates[carbapenems() == "R", ]
|
x <- example_isolates[carbapenems() == "R", ]
|
||||||
y <- example_isolates \%>\% filter(carbapenems() == "R")
|
y <- example_isolates \%>\% filter(carbapenems() == "R")
|
||||||
|
|
|
||||||
|
|
@ -91,7 +91,6 @@ ab_name("eryt")
|
||||||
|
|
||||||
\donttest{
|
\donttest{
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
|
|
||||||
# you can quickly rename 'sir' columns using set_ab_names() with dplyr:
|
# you can quickly rename 'sir' columns using set_ab_names() with dplyr:
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
set_ab_names(where(is.sir), property = "atc")
|
set_ab_names(where(is.sir), property = "atc")
|
||||||
|
|
|
||||||
|
|
@ -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)}.
|
\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}{
|
\subsection{Supported Guidelines}{
|
||||||
|
|
|
||||||
|
|
@ -179,13 +179,11 @@ if (require("dplyr")) {
|
||||||
filter(first_isolate())
|
filter(first_isolate())
|
||||||
}
|
}
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
|
|
||||||
# short-hand version:
|
# short-hand version:
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
filter_first_isolate(info = FALSE)
|
filter_first_isolate(info = FALSE)
|
||||||
}
|
}
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
|
|
||||||
# flag the first isolates per group:
|
# flag the first isolates per group:
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
group_by(ward) \%>\%
|
group_by(ward) \%>\%
|
||||||
|
|
|
||||||
|
|
@ -44,11 +44,12 @@ is_new_episode(df$date, episode_days = 60) # TRUE/FALSE
|
||||||
df[which(get_episode(df$date, 60) == 3), ]
|
df[which(get_episode(df$date, 60) == 3), ]
|
||||||
|
|
||||||
# the functions also work for less than a day, e.g. to include one per hour:
|
# the functions also work for less than a day, e.g. to include one per hour:
|
||||||
get_episode(c(
|
get_episode(
|
||||||
Sys.time(),
|
c(
|
||||||
Sys.time() + 60 * 60
|
Sys.time(),
|
||||||
),
|
Sys.time() + 60 * 60
|
||||||
episode_days = 1 / 24
|
),
|
||||||
|
episode_days = 1 / 24
|
||||||
)
|
)
|
||||||
|
|
||||||
\donttest{
|
\donttest{
|
||||||
|
|
@ -85,7 +86,6 @@ if (require("dplyr")) {
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
|
|
||||||
# grouping on patients and microorganisms leads to the same
|
# grouping on patients and microorganisms leads to the same
|
||||||
# results as first_isolate() when using 'episode-based':
|
# results as first_isolate() when using 'episode-based':
|
||||||
x <- df \%>\%
|
x <- df \%>\%
|
||||||
|
|
@ -102,7 +102,6 @@ if (require("dplyr")) {
|
||||||
identical(x, y)
|
identical(x, y)
|
||||||
}
|
}
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
|
|
||||||
# but is_new_episode() has a lot more flexibility than first_isolate(),
|
# but is_new_episode() has a lot more flexibility than first_isolate(),
|
||||||
# since you can now group on anything that seems relevant:
|
# since you can now group on anything that seems relevant:
|
||||||
df \%>\%
|
df \%>\%
|
||||||
|
|
|
||||||
|
|
@ -138,13 +138,11 @@ At default, the names of antibiotics will be shown on the plots using \code{\lin
|
||||||
\examples{
|
\examples{
|
||||||
\donttest{
|
\donttest{
|
||||||
if (require("ggplot2") && require("dplyr")) {
|
if (require("ggplot2") && require("dplyr")) {
|
||||||
|
|
||||||
# get antimicrobial results for drugs against a UTI:
|
# get antimicrobial results for drugs against a UTI:
|
||||||
ggplot(example_isolates \%>\% select(AMX, NIT, FOS, TMP, CIP)) +
|
ggplot(example_isolates \%>\% select(AMX, NIT, FOS, TMP, CIP)) +
|
||||||
geom_sir()
|
geom_sir()
|
||||||
}
|
}
|
||||||
if (require("ggplot2") && require("dplyr")) {
|
if (require("ggplot2") && require("dplyr")) {
|
||||||
|
|
||||||
# prettify the plot using some additional functions:
|
# prettify the plot using some additional functions:
|
||||||
df <- example_isolates \%>\% select(AMX, NIT, FOS, TMP, CIP)
|
df <- example_isolates \%>\% select(AMX, NIT, FOS, TMP, CIP)
|
||||||
ggplot(df) +
|
ggplot(df) +
|
||||||
|
|
@ -155,21 +153,18 @@ if (require("ggplot2") && require("dplyr")) {
|
||||||
theme_sir()
|
theme_sir()
|
||||||
}
|
}
|
||||||
if (require("ggplot2") && require("dplyr")) {
|
if (require("ggplot2") && require("dplyr")) {
|
||||||
|
|
||||||
# or better yet, simplify this using the wrapper function - a single command:
|
# or better yet, simplify this using the wrapper function - a single command:
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
select(AMX, NIT, FOS, TMP, CIP) \%>\%
|
select(AMX, NIT, FOS, TMP, CIP) \%>\%
|
||||||
ggplot_sir()
|
ggplot_sir()
|
||||||
}
|
}
|
||||||
if (require("ggplot2") && require("dplyr")) {
|
if (require("ggplot2") && require("dplyr")) {
|
||||||
|
|
||||||
# get only proportions and no counts:
|
# get only proportions and no counts:
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
select(AMX, NIT, FOS, TMP, CIP) \%>\%
|
select(AMX, NIT, FOS, TMP, CIP) \%>\%
|
||||||
ggplot_sir(datalabels = FALSE)
|
ggplot_sir(datalabels = FALSE)
|
||||||
}
|
}
|
||||||
if (require("ggplot2") && require("dplyr")) {
|
if (require("ggplot2") && require("dplyr")) {
|
||||||
|
|
||||||
# add other ggplot2 arguments as you like:
|
# add other ggplot2 arguments as you like:
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
select(AMX, NIT, FOS, TMP, CIP) \%>\%
|
select(AMX, NIT, FOS, TMP, CIP) \%>\%
|
||||||
|
|
@ -182,14 +177,12 @@ if (require("ggplot2") && require("dplyr")) {
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
if (require("ggplot2") && require("dplyr")) {
|
if (require("ggplot2") && require("dplyr")) {
|
||||||
|
|
||||||
# you can alter the colours with colour names:
|
# you can alter the colours with colour names:
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
select(AMX) \%>\%
|
select(AMX) \%>\%
|
||||||
ggplot_sir(colours = c(SI = "yellow"))
|
ggplot_sir(colours = c(SI = "yellow"))
|
||||||
}
|
}
|
||||||
if (require("ggplot2") && require("dplyr")) {
|
if (require("ggplot2") && require("dplyr")) {
|
||||||
|
|
||||||
# but you can also use the built-in colour-blind friendly colours for
|
# 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:
|
# your plots, where "S" is green, "I" is yellow and "R" is red:
|
||||||
data.frame(
|
data.frame(
|
||||||
|
|
@ -202,7 +195,6 @@ if (require("ggplot2") && require("dplyr")) {
|
||||||
scale_sir_colours(Value4 = "S", Value5 = "I", Value6 = "R")
|
scale_sir_colours(Value4 = "S", Value5 = "I", Value6 = "R")
|
||||||
}
|
}
|
||||||
if (require("ggplot2") && require("dplyr")) {
|
if (require("ggplot2") && require("dplyr")) {
|
||||||
|
|
||||||
# resistance of ciprofloxacine per age group
|
# resistance of ciprofloxacine per age group
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
mutate(first_isolate = first_isolate()) \%>\%
|
mutate(first_isolate = first_isolate()) \%>\%
|
||||||
|
|
@ -216,14 +208,12 @@ if (require("ggplot2") && require("dplyr")) {
|
||||||
ggplot_sir(x = "age_group")
|
ggplot_sir(x = "age_group")
|
||||||
}
|
}
|
||||||
if (require("ggplot2") && require("dplyr")) {
|
if (require("ggplot2") && require("dplyr")) {
|
||||||
|
|
||||||
# a shorter version which also adjusts data label colours:
|
# a shorter version which also adjusts data label colours:
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
select(AMX, NIT, FOS, TMP, CIP) \%>\%
|
select(AMX, NIT, FOS, TMP, CIP) \%>\%
|
||||||
ggplot_sir(colours = FALSE)
|
ggplot_sir(colours = FALSE)
|
||||||
}
|
}
|
||||||
if (require("ggplot2") && require("dplyr")) {
|
if (require("ggplot2") && require("dplyr")) {
|
||||||
|
|
||||||
# it also supports groups (don't forget to use the group var on `x` or `facet`):
|
# it also supports groups (don't forget to use the group var on `x` or `facet`):
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
filter(mo_is_gram_negative(), ward != "Outpatient") \%>\%
|
filter(mo_is_gram_negative(), ward != "Outpatient") \%>\%
|
||||||
|
|
|
||||||
|
|
@ -405,7 +405,6 @@ mo_species("EHEC")
|
||||||
mo_fullname("K. pneu rh")
|
mo_fullname("K. pneu rh")
|
||||||
mo_shortname("K. pneu rh")
|
mo_shortname("K. pneu rh")
|
||||||
|
|
||||||
|
|
||||||
\donttest{
|
\donttest{
|
||||||
# Becker classification, see ?as.mo ----------------------------------------
|
# Becker classification, see ?as.mo ----------------------------------------
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -204,7 +204,6 @@ if (require("dplyr")) {
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
if (require("dplyr")) {
|
if (require("dplyr")) {
|
||||||
|
|
||||||
# scoped dplyr verbs with antibiotic selectors
|
# scoped dplyr verbs with antibiotic selectors
|
||||||
# (you could also use across() of course)
|
# (you could also use across() of course)
|
||||||
example_isolates \%>\%
|
example_isolates \%>\%
|
||||||
|
|
|
||||||
|
|
@ -34,7 +34,7 @@
|
||||||
|
|
||||||
# test only on GitHub Actions and at using RStudio jobs - not on CRAN as tests are lengthy
|
# 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) ||
|
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:
|
# 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()))
|
.libPaths(c(Sys.getenv("R_LIBS_USER_GH_ACTIONS"), .libPaths()))
|
||||||
if (AMR:::pkg_is_available("tinytest", also_load = TRUE)) {
|
if (AMR:::pkg_is_available("tinytest", also_load = TRUE)) {
|
||||||
|
|
|
||||||
|
|
@ -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:
|
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'}
|
```{r example table, echo = FALSE, results = 'asis'}
|
||||||
knitr::kable(data.frame(
|
knitr::kable(
|
||||||
date = Sys.Date(),
|
data.frame(
|
||||||
patient_id = c("abcd", "abcd", "efgh"),
|
date = Sys.Date(),
|
||||||
mo = "Escherichia coli",
|
patient_id = c("abcd", "abcd", "efgh"),
|
||||||
AMX = c("S", "S", "R"),
|
mo = "Escherichia coli",
|
||||||
CIP = c("S", "R", "S"),
|
AMX = c("S", "S", "R"),
|
||||||
stringsAsFactors = FALSE
|
CIP = c("S", "R", "S"),
|
||||||
),
|
stringsAsFactors = FALSE
|
||||||
align = "c"
|
),
|
||||||
|
align = "c"
|
||||||
)
|
)
|
||||||
```
|
```
|
||||||
|
|
||||||
|
|
@ -129,14 +130,15 @@ sample_size <- 20000
|
||||||
data <- data.frame(
|
data <- data.frame(
|
||||||
date = sample(dates, size = sample_size, replace = TRUE),
|
date = sample(dates, size = sample_size, replace = TRUE),
|
||||||
patient_id = sample(patients, size = sample_size, replace = TRUE),
|
patient_id = sample(patients, size = sample_size, replace = TRUE),
|
||||||
hospital = sample(c(
|
hospital = sample(
|
||||||
"Hospital A",
|
c(
|
||||||
"Hospital B",
|
"Hospital A",
|
||||||
"Hospital C",
|
"Hospital B",
|
||||||
"Hospital D"
|
"Hospital C",
|
||||||
),
|
"Hospital D"
|
||||||
size = sample_size, replace = TRUE,
|
),
|
||||||
prob = c(0.30, 0.35, 0.15, 0.20)
|
size = sample_size, replace = TRUE,
|
||||||
|
prob = c(0.30, 0.35, 0.15, 0.20)
|
||||||
),
|
),
|
||||||
bacteria = sample(bacteria,
|
bacteria = sample(bacteria,
|
||||||
size = sample_size, replace = TRUE,
|
size = sample_size, replace = TRUE,
|
||||||
|
|
@ -293,10 +295,11 @@ data_1st %>%
|
||||||
```
|
```
|
||||||
|
|
||||||
```{r bug_drg 2b, echo = FALSE, results = 'asis'}
|
```{r bug_drg 2b, echo = FALSE, results = 'asis'}
|
||||||
knitr::kable(data_1st %>%
|
knitr::kable(
|
||||||
filter(any(aminoglycosides() == "R")) %>%
|
data_1st %>%
|
||||||
head(),
|
filter(any(aminoglycosides() == "R")) %>%
|
||||||
align = "c"
|
head(),
|
||||||
|
align = "c"
|
||||||
)
|
)
|
||||||
```
|
```
|
||||||
|
|
||||||
|
|
@ -309,10 +312,11 @@ data_1st %>%
|
||||||
```
|
```
|
||||||
|
|
||||||
```{r bug_drg 1b, echo = FALSE, results = 'asis'}
|
```{r bug_drg 1b, echo = FALSE, results = 'asis'}
|
||||||
knitr::kable(data_1st %>%
|
knitr::kable(
|
||||||
bug_drug_combinations() %>%
|
data_1st %>%
|
||||||
head(),
|
bug_drug_combinations() %>%
|
||||||
align = "c"
|
head(),
|
||||||
|
align = "c"
|
||||||
)
|
)
|
||||||
```
|
```
|
||||||
|
|
||||||
|
|
@ -325,10 +329,11 @@ data_1st %>%
|
||||||
|
|
||||||
|
|
||||||
```{r bug_drg 3b, echo = FALSE, results = 'asis'}
|
```{r bug_drg 3b, echo = FALSE, results = 'asis'}
|
||||||
knitr::kable(data_1st %>%
|
knitr::kable(
|
||||||
select(bacteria, aminoglycosides()) %>%
|
data_1st %>%
|
||||||
bug_drug_combinations(),
|
select(bacteria, aminoglycosides()) %>%
|
||||||
align = "c"
|
bug_drug_combinations(),
|
||||||
|
align = "c"
|
||||||
)
|
)
|
||||||
```
|
```
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -88,11 +88,12 @@ data %>%
|
||||||
|
|
||||||
```{r, echo = FALSE}
|
```{r, echo = FALSE}
|
||||||
# on very old and some new releases of R, this may lead to an error
|
# on very old and some new releases of R, this may lead to an error
|
||||||
tryCatch(data %>%
|
tryCatch(
|
||||||
group_by(Country) %>%
|
data %>%
|
||||||
select(Country, AMP_ND2, AMC_ED20, CAZ_ED10, CIP_ED5) %>%
|
group_by(Country) %>%
|
||||||
ggplot_sir(translate_ab = "ab", facet = "Country", datalabels = FALSE) %>%
|
select(Country, AMP_ND2, AMC_ED20, CAZ_ED10, CIP_ED5) %>%
|
||||||
print(),
|
ggplot_sir(translate_ab = "ab", facet = "Country", datalabels = FALSE) %>%
|
||||||
error = function(e) base::invisible()
|
print(),
|
||||||
|
error = function(e) base::invisible()
|
||||||
)
|
)
|
||||||
```
|
```
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue