mirror of
https://github.com/msberends/AMR.git
synced 2024-12-25 19:26:13 +01:00
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!)*
|
||||||
|
|
||||||
|
@ -49,7 +49,8 @@ pm_left_join <- function(x, y, by = NULL, suffix = c(".x", ".y")) {
|
|||||||
|
|
||||||
merged <- cbind(
|
merged <- cbind(
|
||||||
x,
|
x,
|
||||||
y[match(
|
y[
|
||||||
|
match(
|
||||||
x[, by[1], drop = TRUE],
|
x[, by[1], drop = TRUE],
|
||||||
y[, by[2], drop = TRUE]
|
y[, by[2], drop = TRUE]
|
||||||
),
|
),
|
||||||
@ -190,7 +191,8 @@ addin_insert_like <- function() {
|
|||||||
)
|
)
|
||||||
}
|
}
|
||||||
replace_pos <- function(old, with) {
|
replace_pos <- function(old, with) {
|
||||||
modifyRange(document_range(
|
modifyRange(
|
||||||
|
document_range(
|
||||||
document_position(current_row, current_col - nchar(old)),
|
document_position(current_row, current_col - nchar(old)),
|
||||||
document_position(current_row, current_col)
|
document_position(current_row, current_col)
|
||||||
),
|
),
|
||||||
@ -253,7 +255,8 @@ 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(
|
||||||
|
font_red(paste0(
|
||||||
"Found column '", font_bold(found), "' to be used as input for `col_", type,
|
"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."
|
"`, but this column contains no valid dates. Transform its values to valid dates first."
|
||||||
)),
|
)),
|
||||||
@ -319,11 +322,13 @@ 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(
|
||||||
|
vapply(
|
||||||
FUN.VALUE = logical(1),
|
FUN.VALUE = logical(1),
|
||||||
X = strsplit(x, "", fixed = TRUE),
|
X = strsplit(x, "", fixed = TRUE),
|
||||||
FUN = function(y) {
|
FUN = function(y) {
|
||||||
any(y %in% c(
|
any(
|
||||||
|
y %in% c(
|
||||||
"$", "(", ")", "*", "+", "-",
|
"$", "(", ")", "*", "+", "-",
|
||||||
".", "?", "[", "]", "^", "{",
|
".", "?", "[", "]", "^", "{",
|
||||||
"|", "}", "\\"
|
"|", "}", "\\"
|
||||||
@ -410,7 +415,8 @@ 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(
|
||||||
|
vapply(
|
||||||
FUN.VALUE = character(1),
|
FUN.VALUE = character(1),
|
||||||
trimws(unlist(strsplit(msg, "\n", fixed = TRUE)), which = "right"),
|
trimws(unlist(strsplit(msg, "\n", fixed = TRUE)), which = "right"),
|
||||||
word_wrap,
|
word_wrap,
|
||||||
@ -429,7 +435,8 @@ 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(
|
||||||
|
strwrap(msg_stripped,
|
||||||
simplify = TRUE,
|
simplify = TRUE,
|
||||||
width = width
|
width = width
|
||||||
),
|
),
|
||||||
@ -487,7 +494,8 @@ 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(
|
||||||
|
word_wrap(...,
|
||||||
add_fn = add_fn,
|
add_fn = add_fn,
|
||||||
as_note = as_note
|
as_note = as_note
|
||||||
),
|
),
|
||||||
@ -499,7 +507,8 @@ warning_ <- function(...,
|
|||||||
add_fn = list(),
|
add_fn = list(),
|
||||||
immediate = FALSE,
|
immediate = FALSE,
|
||||||
call = FALSE) {
|
call = FALSE) {
|
||||||
warning(word_wrap(...,
|
warning(
|
||||||
|
word_wrap(...,
|
||||||
add_fn = add_fn,
|
add_fn = add_fn,
|
||||||
as_note = FALSE
|
as_note = FALSE
|
||||||
),
|
),
|
||||||
@ -836,7 +845,8 @@ meet_criteria <- function(object,
|
|||||||
)
|
)
|
||||||
}
|
}
|
||||||
if (!is.null(contains_column_class)) {
|
if (!is.null(contains_column_class)) {
|
||||||
stop_ifnot(any(vapply(
|
stop_ifnot(
|
||||||
|
any(vapply(
|
||||||
FUN.VALUE = logical(1),
|
FUN.VALUE = logical(1),
|
||||||
object,
|
object,
|
||||||
function(col, columns_class = contains_column_class) {
|
function(col, columns_class = contains_column_class) {
|
||||||
@ -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,7 +1339,8 @@ 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(
|
||||||
|
min(max_places,
|
||||||
maximum,
|
maximum,
|
||||||
na.rm = TRUE
|
na.rm = TRUE
|
||||||
),
|
),
|
||||||
@ -1366,7 +1376,8 @@ 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(
|
||||||
|
structure(
|
||||||
.Data = as.double(x),
|
.Data = as.double(x),
|
||||||
class = c("percentage", "numeric")
|
class = c("percentage", "numeric")
|
||||||
),
|
),
|
||||||
|
13
R/ab.R
13
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,7 +337,8 @@ 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(
|
||||||
|
lapply(
|
||||||
strsplit(x[i], "[^A-Z0-9]"),
|
strsplit(x[i], "[^A-Z0-9]"),
|
||||||
function(y) {
|
function(y) {
|
||||||
for (i in seq_len(length(y))) {
|
for (i in seq_len(length(y))) {
|
||||||
@ -362,7 +362,8 @@ 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(
|
||||||
|
lapply(
|
||||||
strsplit(x_translated, "[^A-Z0-9 ]"),
|
strsplit(x_translated, "[^A-Z0-9 ]"),
|
||||||
function(y) {
|
function(y) {
|
||||||
for (i in seq_len(length(y))) {
|
for (i in seq_len(length(y))) {
|
||||||
@ -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: ",
|
||||||
|
@ -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,7 +421,9 @@ 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(
|
||||||
|
ab_name(
|
||||||
|
sample(agents_all,
|
||||||
size = min(5, length(agents_all)),
|
size = min(5, length(agents_all)),
|
||||||
replace = FALSE
|
replace = FALSE
|
||||||
),
|
),
|
||||||
@ -491,7 +481,8 @@ 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(
|
||||||
|
sapply(
|
||||||
eucast_rules(vars_df,
|
eucast_rules(vars_df,
|
||||||
col_mo = col_mo,
|
col_mo = col_mo,
|
||||||
version_expertrules = version_expertrules,
|
version_expertrules = version_expertrules,
|
||||||
@ -549,7 +540,8 @@ 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(
|
||||||
|
ab_name(names(ab_in_data)[names(ab_in_data) %in% untreatable],
|
||||||
language = NULL,
|
language = NULL,
|
||||||
tolower = TRUE
|
tolower = TRUE
|
||||||
),
|
),
|
||||||
@ -593,7 +585,8 @@ 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(
|
||||||
|
ab_name(sample(abx, size = min(2, length(abx)), replace = FALSE),
|
||||||
tolower = TRUE,
|
tolower = TRUE,
|
||||||
language = NULL
|
language = NULL
|
||||||
),
|
),
|
||||||
@ -821,7 +814,8 @@ 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(
|
||||||
|
ab_name(sample(drugs, size = min(n, length(drugs)), replace = FALSE),
|
||||||
tolower = TRUE,
|
tolower = TRUE,
|
||||||
language = NULL
|
language = NULL
|
||||||
),
|
),
|
||||||
|
3
R/age.R
3
R/age.R
@ -83,7 +83,8 @@ 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(
|
||||||
|
paste0(
|
||||||
format(as.Date(reference), "%Y"),
|
format(as.Date(reference), "%Y"),
|
||||||
format(as.Date(x), "-%m-%d")
|
format(as.Date(x), "-%m-%d")
|
||||||
),
|
),
|
||||||
|
12
R/av.R
12
R/av.R
@ -308,7 +308,8 @@ 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(
|
||||||
|
lapply(
|
||||||
strsplit(x[i], "[^A-Z0-9]"),
|
strsplit(x[i], "[^A-Z0-9]"),
|
||||||
function(y) {
|
function(y) {
|
||||||
for (i in seq_len(length(y))) {
|
for (i in seq_len(length(y))) {
|
||||||
@ -332,7 +333,8 @@ 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(
|
||||||
|
lapply(
|
||||||
strsplit(x_translated, "[^A-Z0-9 ]"),
|
strsplit(x_translated, "[^A-Z0-9 ]"),
|
||||||
function(y) {
|
function(y) {
|
||||||
for (i in seq_len(length(y))) {
|
for (i in seq_len(length(y))) {
|
||||||
@ -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: ",
|
||||||
|
@ -240,7 +240,8 @@ 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(
|
||||||
|
paste0(
|
||||||
i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then "),
|
i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then "),
|
||||||
"set to {result}:"
|
"set to {result}:"
|
||||||
),
|
),
|
||||||
|
@ -77,7 +77,8 @@
|
|||||||
#' # 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(
|
||||||
|
#' genus = "Enterobacter",
|
||||||
#' species = "asburiae/cloacae"
|
#' species = "asburiae/cloacae"
|
||||||
#' )
|
#' )
|
||||||
#' )
|
#' )
|
||||||
@ -100,8 +101,10 @@
|
|||||||
#'
|
#'
|
||||||
#' # 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")
|
||||||
@ -112,9 +115,11 @@
|
|||||||
#'
|
#'
|
||||||
#' # 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(
|
||||||
|
#' genus = "Citrobacter",
|
||||||
#' species = c("freundii", "braakii complex"),
|
#' species = c("freundii", "braakii complex"),
|
||||||
#' subspecies = c("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"))
|
||||||
@ -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)) {
|
||||||
@ -230,13 +243,21 @@ 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(
|
||||||
|
"CUSTOM",
|
||||||
seq.int(from = current + 1, to = current + nrow(x), by = 1),
|
seq.int(from = current + 1, to = current + nrow(x), by = 1),
|
||||||
"_",
|
"_",
|
||||||
toupper(unname(abbreviate(gsub(" +", " _ ",
|
toupper(unname(abbreviate(
|
||||||
gsub("[^A-Za-z0-9-]", " ",
|
gsub(
|
||||||
trimws2(paste(x$genus, x$species, x$subspecies)))),
|
" +", " _ ",
|
||||||
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 ----
|
||||||
|
@ -57,7 +57,8 @@
|
|||||||
#' 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(
|
||||||
|
#' c(
|
||||||
#' Sys.time(),
|
#' Sys.time(),
|
||||||
#' Sys.time() + 60 * 60
|
#' Sys.time() + 60 * 60
|
||||||
#' ),
|
#' ),
|
||||||
@ -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,7 +702,8 @@ 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(
|
||||||
|
word_wrap(rule_current,
|
||||||
width = getOption("width") - 30,
|
width = getOption("width") - 30,
|
||||||
extra_indent = 6
|
extra_indent = 6
|
||||||
),
|
),
|
||||||
@ -721,7 +722,8 @@ 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(
|
||||||
|
all_staph[which(all_staph$CNS_CPS %like% "negative"),
|
||||||
"fullname",
|
"fullname",
|
||||||
drop = TRUE
|
drop = TRUE
|
||||||
],
|
],
|
||||||
@ -731,7 +733,8 @@ eucast_rules <- function(x,
|
|||||||
)
|
)
|
||||||
} 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(
|
||||||
|
all_staph[which(all_staph$CNS_CPS %like% "positive"),
|
||||||
"fullname",
|
"fullname",
|
||||||
drop = TRUE
|
drop = TRUE
|
||||||
],
|
],
|
||||||
@ -745,7 +748,8 @@ 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(
|
||||||
|
all_strep[which(all_strep$Lancefield %like% "group [ABCG]"),
|
||||||
"fullname",
|
"fullname",
|
||||||
drop = TRUE
|
drop = TRUE
|
||||||
],
|
],
|
||||||
@ -789,12 +793,14 @@ 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(
|
||||||
|
which(x[, if_mo_property, drop = TRUE] %like% mo_value &
|
||||||
as.sir_no_warning(x[, source_antibiotics[1L]]) == source_value[1L]),
|
as.sir_no_warning(x[, source_antibiotics[1L]]) == source_value[1L]),
|
||||||
error = function(e) integer(0)
|
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(
|
||||||
|
which(x[, if_mo_property, drop = TRUE] %like% mo_value &
|
||||||
as.sir_no_warning(x[, source_antibiotics[1L]]) == source_value[1L] &
|
as.sir_no_warning(x[, source_antibiotics[1L]]) == source_value[1L] &
|
||||||
as.sir_no_warning(x[, source_antibiotics[2L]]) == source_value[2L]),
|
as.sir_no_warning(x[, source_antibiotics[2L]]) == source_value[2L]),
|
||||||
error = function(e) integer(0)
|
error = function(e) integer(0)
|
||||||
@ -872,7 +878,8 @@ 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(
|
||||||
|
word_wrap(format_custom_query_rule(rule$query, colours = FALSE),
|
||||||
width = getOption("width") - 30,
|
width = getOption("width") - 30,
|
||||||
extra_indent = 6
|
extra_indent = 6
|
||||||
),
|
),
|
||||||
@ -1117,7 +1124,8 @@ edit_sir <- function(x,
|
|||||||
},
|
},
|
||||||
error = function(e) {
|
error = function(e) {
|
||||||
txt_error()
|
txt_error()
|
||||||
stop(paste0(
|
stop(
|
||||||
|
paste0(
|
||||||
"In row(s) ", paste(rows[seq_len(min(length(rows), 10))], collapse = ","),
|
"In row(s) ", paste(rows[seq_len(min(length(rows), 10))], collapse = ","),
|
||||||
ifelse(length(rows) > 10, "...", ""),
|
ifelse(length(rows) > 10, "...", ""),
|
||||||
" while writing value '", to,
|
" while writing value '", to,
|
||||||
|
@ -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,7 +242,8 @@ 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_(
|
||||||
|
paste0(
|
||||||
"Determining first isolates ",
|
"Determining first isolates ",
|
||||||
ifelse(method %in% c("episode-based", "phenotype-based"),
|
ifelse(method %in% c("episode-based", "phenotype-based"),
|
||||||
ifelse(is.infinite(episode_days),
|
ifelse(is.infinite(episode_days),
|
||||||
@ -469,7 +468,9 @@ 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(
|
||||||
|
lapply(
|
||||||
|
split(
|
||||||
x$newvar_date,
|
x$newvar_date,
|
||||||
x$episode_group
|
x$episode_group
|
||||||
),
|
),
|
||||||
@ -606,7 +607,8 @@ 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_(
|
||||||
|
paste0(
|
||||||
"=> Found ",
|
"=> Found ",
|
||||||
font_bold(paste0(
|
font_bold(paste0(
|
||||||
n_found,
|
n_found,
|
||||||
|
@ -414,7 +414,8 @@ 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(
|
||||||
|
sweep(circle %*% chol(sigma) * ed,
|
||||||
MARGIN = 2,
|
MARGIN = 2,
|
||||||
STATS = mu,
|
STATS = mu,
|
||||||
FUN = "+"
|
FUN = "+"
|
||||||
|
@ -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,7 +274,8 @@ 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_(
|
||||||
|
paste0(
|
||||||
"Column '", font_bold(out[i]), "' will not be used for ",
|
"Column '", font_bold(out[i]), "' will not be used for ",
|
||||||
names(out)[i], " (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ")",
|
names(out)[i], " (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ")",
|
||||||
", as it is already set for ",
|
", as it is already set for ",
|
||||||
@ -307,7 +308,8 @@ 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(
|
||||||
|
paste0(
|
||||||
ab_name(missing, tolower = TRUE, language = NULL),
|
ab_name(missing, tolower = TRUE, language = NULL),
|
||||||
" (", font_bold(missing, collapse = NULL), ")"
|
" (", font_bold(missing, collapse = NULL), ")"
|
||||||
),
|
),
|
||||||
@ -355,7 +357,8 @@ generate_warning_abs_missing <- function(missing, any = FALSE) {
|
|||||||
} else {
|
} else {
|
||||||
any_txt <- c("", "are")
|
any_txt <- c("", "are")
|
||||||
}
|
}
|
||||||
warning_(paste0(
|
warning_(
|
||||||
|
paste0(
|
||||||
"Introducing NAs since", any_txt[1], " these antimicrobials ", any_txt[2], " required: ",
|
"Introducing NAs since", any_txt[1], " these antimicrobials ", any_txt[2], " required: ",
|
||||||
vector_and(missing, quotes = FALSE)
|
vector_and(missing, quotes = FALSE)
|
||||||
),
|
),
|
||||||
|
@ -73,7 +73,8 @@ 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[
|
||||||
|
which(AMR_env$MO_lookup$rank %in% c(
|
||||||
"family",
|
"family",
|
||||||
"genus",
|
"genus",
|
||||||
"species",
|
"species",
|
||||||
@ -87,7 +88,8 @@ italicise_taxonomy <- function(string, type = c("markdown", "ansi")) {
|
|||||||
|
|
||||||
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[
|
||||||
|
which(AMR_env$MO_lookup$rank %in% c(
|
||||||
"family",
|
"family",
|
||||||
"genus",
|
"genus",
|
||||||
"species",
|
"species",
|
||||||
@ -98,7 +100,8 @@ italicise_taxonomy <- function(string, type = c("markdown", "ansi")) {
|
|||||||
"fullname",
|
"fullname",
|
||||||
drop = TRUE
|
drop = TRUE
|
||||||
],
|
],
|
||||||
AMR_env$MO_lookup[which(AMR_env$MO_lookup$rank %in% c(
|
AMR_env$MO_lookup[
|
||||||
|
which(AMR_env$MO_lookup$rank %in% c(
|
||||||
"family",
|
"family",
|
||||||
"genus",
|
"genus",
|
||||||
"species",
|
"species",
|
||||||
|
12
R/mdro.R
12
R/mdro.R
@ -655,7 +655,8 @@ mdro <- function(x = NULL,
|
|||||||
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(
|
||||||
|
lapply(
|
||||||
x[, cols, drop = FALSE],
|
x[, cols, drop = FALSE],
|
||||||
function(col) as.sir(col)
|
function(col) as.sir(col)
|
||||||
),
|
),
|
||||||
@ -670,7 +671,8 @@ 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(
|
||||||
|
sort(c(
|
||||||
unlist(strsplit(x[row, "columns_nonsusceptible", drop = TRUE], ", ", fixed = TRUE)),
|
unlist(strsplit(x[row, "columns_nonsusceptible", drop = TRUE], ", ", fixed = TRUE)),
|
||||||
names(cols_nonsus)[cols_nonsus]
|
names(cols_nonsus)[cols_nonsus]
|
||||||
)),
|
)),
|
||||||
@ -715,7 +717,8 @@ mdro <- function(x = NULL,
|
|||||||
# 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(
|
||||||
|
lapply(
|
||||||
x[, lst_vector, drop = FALSE],
|
x[, lst_vector, drop = FALSE],
|
||||||
function(col) as.sir(col)
|
function(col) as.sir(col)
|
||||||
),
|
),
|
||||||
@ -748,7 +751,8 @@ 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(
|
||||||
|
vapply(
|
||||||
FUN.VALUE = logical(1),
|
FUN.VALUE = logical(1),
|
||||||
group_tbl,
|
group_tbl,
|
||||||
function(group) {
|
function(group) {
|
||||||
|
26
R/mo.R
26
R/mo.R
@ -365,7 +365,8 @@ 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(
|
||||||
|
paste0(
|
||||||
'"', AMR_env$mo_uncertainties$original_input,
|
'"', AMR_env$mo_uncertainties$original_input,
|
||||||
'" (assumed ', italicise(AMR_env$mo_uncertainties$fullname), ")"
|
'" (assumed ', italicise(AMR_env$mo_uncertainties$fullname), ")"
|
||||||
),
|
),
|
||||||
@ -376,7 +377,7 @@ as.mo <- function(x,
|
|||||||
}
|
}
|
||||||
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) {
|
||||||
@ -577,7 +578,8 @@ 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
|
||||||
@ -835,9 +837,11 @@ 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(
|
||||||
|
paste0(
|
||||||
"Also matched: ",
|
"Also matched: ",
|
||||||
vector_and(paste0(
|
vector_and(
|
||||||
|
paste0(
|
||||||
candidates_formatted,
|
candidates_formatted,
|
||||||
font_blue(paste0(" (", scores_formatted, ")"), collapse = NULL)
|
font_blue(paste0(" (", scores_formatted, ")"), collapse = NULL)
|
||||||
),
|
),
|
||||||
@ -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)
|
||||||
}
|
}
|
||||||
|
@ -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 ----------------------------------------
|
||||||
#'
|
#'
|
||||||
@ -426,7 +425,8 @@ 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(
|
||||||
|
ifelse(prev == 1 & kngd == "Bacteria" & rank != "genus",
|
||||||
"Pathogenic",
|
"Pathogenic",
|
||||||
ifelse(prev < 2 & kngd == "Fungi",
|
ifelse(prev < 2 & kngd == "Fungi",
|
||||||
"Potentially pathogenic",
|
"Potentially pathogenic",
|
||||||
@ -434,9 +434,14 @@ mo_pathogenicity <- function(x, language = get_AMR_locale(), keep_synonyms = get
|
|||||||
"Non-pathogenic",
|
"Non-pathogenic",
|
||||||
ifelse(kngd == "Bacteria",
|
ifelse(kngd == "Bacteria",
|
||||||
"Potentially pathogenic",
|
"Potentially pathogenic",
|
||||||
"Unknown")))),
|
"Unknown"
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
),
|
||||||
levels = c("Pathogenic", "Potentially pathogenic", "Non-pathogenic", "Unknown"),
|
levels = c("Pathogenic", "Potentially pathogenic", "Non-pathogenic", "Unknown"),
|
||||||
ordered = TRUE)
|
ordered = TRUE
|
||||||
|
)
|
||||||
|
|
||||||
load_mo_uncertainties(metadata)
|
load_mo_uncertainties(metadata)
|
||||||
out
|
out
|
||||||
|
@ -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 %>%
|
||||||
|
38
R/sir.R
38
R/sir.R
@ -64,7 +64,7 @@
|
|||||||
#' ```
|
#' ```
|
||||||
#' 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
|
||||||
#'
|
#'
|
||||||
@ -806,19 +806,23 @@ as_sir_method <- function(method_short,
|
|||||||
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(
|
||||||
|
values = x,
|
||||||
mo = mo,
|
mo = mo,
|
||||||
result = NA_sir_,
|
result = NA_sir_,
|
||||||
uti = uti,
|
uti = uti,
|
||||||
stringsAsFactors = FALSE)
|
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)
|
||||||
@ -849,9 +853,11 @@ as_sir_method <- function(method_short,
|
|||||||
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(
|
||||||
|
"No ", method_coerced, " breakpoints available for ",
|
||||||
suppressMessages(suppressWarnings(ab_name(ab_coerced, language = NULL, tolower = TRUE))),
|
suppressMessages(suppressWarnings(ab_name(ab_coerced, language = NULL, tolower = TRUE))),
|
||||||
" (", ab_coerced, ")"))
|
" (", ab_coerced, ")"
|
||||||
|
))
|
||||||
load_mo_uncertainties(metadata_mo)
|
load_mo_uncertainties(metadata_mo)
|
||||||
return(rep(NA_sir_, nrow(df)))
|
return(rep(NA_sir_, nrow(df)))
|
||||||
}
|
}
|
||||||
@ -863,7 +869,6 @@ as_sir_method <- function(method_short,
|
|||||||
|
|
||||||
# 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]
|
||||||
@ -890,16 +895,20 @@ 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_genus, mo_current_family,
|
||||||
mo_current_order, mo_current_class,
|
mo_current_order, mo_current_class,
|
||||||
mo_current_becker, mo_current_lancefield,
|
mo_current_becker, mo_current_lancefield,
|
||||||
mo_current_other))
|
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>%
|
||||||
@ -937,7 +946,6 @@ as_sir_method <- function(method_short,
|
|||||||
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]
|
||||||
@ -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_,
|
||||||
@ -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.
@ -144,7 +144,8 @@ translate_AMR <- function(x, language = get_AMR_locale()) {
|
|||||||
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,7 +171,8 @@ 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(
|
||||||
|
paste0(
|
||||||
"^(", l[1], "|", l[2], "|",
|
"^(", l[1], "|", l[2], "|",
|
||||||
n, "(_|$)|", toupper(n), "(_|$))"
|
n, "(_|$)|", toupper(n), "(_|$))"
|
||||||
),
|
),
|
||||||
@ -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") {
|
||||||
|
@ -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_(
|
||||||
|
ifelse(is.null(new),
|
||||||
paste0("The `", old, "()` function is no longer in use"),
|
paste0("The `", old, "()` function is no longer in use"),
|
||||||
paste0("The `", old, "()` function has been replaced with `", new, "()`")),
|
paste0("The `", old, "()` function has been replaced with `", new, "()`")
|
||||||
|
),
|
||||||
", see `?AMR-deprecated`.",
|
", see `?AMR-deprecated`.",
|
||||||
ifelse(!is.null(extra_msg),
|
ifelse(!is.null(extra_msg),
|
||||||
paste0(" ", extra_msg),
|
paste0(" ", extra_msg),
|
||||||
""),
|
""
|
||||||
"\nThis warning will be shown once per session.")
|
),
|
||||||
|
"\nThis warning will be shown once per session."
|
||||||
|
)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
14
R/zzz.R
14
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)))
|
suppressWarnings(suppressMessages(add_custom_antimicrobials(x)))
|
||||||
packageStartupMessage("OK.")
|
packageStartupMessage("OK.")
|
||||||
}, error = function(e) packageStartupMessage("Failed: ", e$message))
|
},
|
||||||
|
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)))
|
suppressWarnings(suppressMessages(add_custom_microorganisms(x)))
|
||||||
packageStartupMessage("OK.")
|
packageStartupMessage("OK.")
|
||||||
}, error = function(e) packageStartupMessage("Failed: ", e$message))
|
},
|
||||||
|
error = function(e) packageStartupMessage("Failed: ", e$message)
|
||||||
|
)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -101,7 +101,8 @@ 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[
|
||||||
|
which(MO_staph$species %in% c(
|
||||||
"coagulase-negative", "argensis", "arlettae",
|
"coagulase-negative", "argensis", "arlettae",
|
||||||
"auricularis", "borealis", "caeli", "capitis", "caprae",
|
"auricularis", "borealis", "caeli", "capitis", "caprae",
|
||||||
"carnosus", "casei", "caseolyticus", "chromogenes", "cohnii", "condimenti",
|
"carnosus", "casei", "caseolyticus", "chromogenes", "cohnii", "condimenti",
|
||||||
@ -126,7 +127,8 @@ create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
|
|||||||
drop = TRUE
|
drop = TRUE
|
||||||
]
|
]
|
||||||
} else if (type == "CoPS") {
|
} else if (type == "CoPS") {
|
||||||
MO_staph[which(MO_staph$species %in% c(
|
MO_staph[
|
||||||
|
which(MO_staph$species %in% c(
|
||||||
"coagulase-positive", "coagulans",
|
"coagulase-positive", "coagulans",
|
||||||
"agnetis", "argenteus",
|
"agnetis", "argenteus",
|
||||||
"cornubiensis",
|
"cornubiensis",
|
||||||
@ -254,7 +256,8 @@ 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(
|
||||||
|
t(new_df[,
|
||||||
c(
|
c(
|
||||||
colnames(new_df)[colnames(new_df) %in% c("ab", "av", "atc", "cid", "name")],
|
colnames(new_df)[colnames(new_df) %in% c("ab", "av", "atc", "cid", "name")],
|
||||||
colnames(new_df)[colnames(new_df) %like% "generalised"]
|
colnames(new_df)[colnames(new_df) %like% "generalised"]
|
||||||
@ -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,7 +66,8 @@ 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(
|
||||||
|
c(
|
||||||
"Actinomyces", "Bifidobacterium", "Clostridioides",
|
"Actinomyces", "Bifidobacterium", "Clostridioides",
|
||||||
"Clostridium", "Cutibacterium", "Eggerthella",
|
"Clostridium", "Cutibacterium", "Eggerthella",
|
||||||
"Eubacterium", "Lactobacillus", "Propionibacterium",
|
"Eubacterium", "Lactobacillus", "Propionibacterium",
|
||||||
@ -75,7 +76,8 @@ read_EUCAST <- function(sheet, file, guideline_name) {
|
|||||||
collapse = "_"
|
collapse = "_"
|
||||||
)
|
)
|
||||||
} else if (sheet %like% "anaerob.*Gram.*nega") {
|
} else if (sheet %like% "anaerob.*Gram.*nega") {
|
||||||
sheet <- paste0(c(
|
sheet <- paste0(
|
||||||
|
c(
|
||||||
"Bacteroides",
|
"Bacteroides",
|
||||||
"Bilophila",
|
"Bilophila",
|
||||||
"Fusobacterium",
|
"Fusobacterium",
|
||||||
@ -87,7 +89,8 @@ read_EUCAST <- function(sheet, file, guideline_name) {
|
|||||||
collapse = "_"
|
collapse = "_"
|
||||||
)
|
)
|
||||||
} else if (sheet == "Streptococcus A,B,C,G") {
|
} else if (sheet == "Streptococcus A,B,C,G") {
|
||||||
sheet <- paste0(microorganisms %>%
|
sheet <- paste0(
|
||||||
|
microorganisms %>%
|
||||||
filter(genus == "Streptococcus") %>%
|
filter(genus == "Streptococcus") %>%
|
||||||
mutate(lancefield = mo_name(mo, Lancefield = TRUE)) %>%
|
mutate(lancefield = mo_name(mo, Lancefield = TRUE)) %>%
|
||||||
filter(lancefield %like% "^Streptococcus group") %>%
|
filter(lancefield %like% "^Streptococcus group") %>%
|
||||||
|
@ -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(
|
||||||
|
gsub(
|
||||||
"[/0-9-]",
|
"[/0-9-]",
|
||||||
" ",
|
" ",
|
||||||
abx2$name[is.na(abx2$ab)]
|
abx2$name[is.na(abx2$ab)]
|
||||||
),
|
),
|
||||||
minlength = 3,
|
minlength = 3,
|
||||||
method = "left.kept",
|
method = "left.kept",
|
||||||
strict = TRUE
|
strict = TRUE
|
||||||
))
|
))
|
||||||
|
|
||||||
n_distinct(abx2$ab)
|
n_distinct(abx2$ab)
|
||||||
@ -197,7 +198,8 @@ get_CID <- function(ab) {
|
|||||||
p$tick()
|
p$tick()
|
||||||
|
|
||||||
CID[i] <- tryCatch(
|
CID[i] <- tryCatch(
|
||||||
data.table::fread(paste0(
|
data.table::fread(
|
||||||
|
paste0(
|
||||||
"https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/",
|
"https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/",
|
||||||
URLencode(ab[i], reserved = TRUE),
|
URLencode(ab[i], reserved = TRUE),
|
||||||
"/cids/TXT?name_type=complete"
|
"/cids/TXT?name_type=complete"
|
||||||
@ -209,7 +211,8 @@ get_CID <- function(ab) {
|
|||||||
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(
|
||||||
|
paste0(
|
||||||
"https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/",
|
"https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/",
|
||||||
URLencode(trimws(gsub("[(].*[)]", "", ab[i])), reserved = TRUE),
|
URLencode(trimws(gsub("[(].*[)]", "", ab[i])), reserved = TRUE),
|
||||||
"/cids/TXT?name_type=complete"
|
"/cids/TXT?name_type=complete"
|
||||||
@ -223,7 +226,8 @@ 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(
|
||||||
|
paste0(
|
||||||
"https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/",
|
"https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/",
|
||||||
URLencode(ab[i], reserved = TRUE),
|
URLencode(ab[i], reserved = TRUE),
|
||||||
"/cids/TXT?name_type=word"
|
"/cids/TXT?name_type=word"
|
||||||
@ -260,7 +264,8 @@ get_synonyms <- function(CID, clean = TRUE) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
synonyms_txt <- tryCatch(
|
synonyms_txt <- tryCatch(
|
||||||
data.table::fread(paste0(
|
data.table::fread(
|
||||||
|
paste0(
|
||||||
"https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/fastidentity/cid/",
|
"https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/fastidentity/cid/",
|
||||||
CID[i],
|
CID[i],
|
||||||
"/synonyms/TXT"
|
"/synonyms/TXT"
|
||||||
|
@ -126,7 +126,8 @@ names_codes <- antivirals %>%
|
|||||||
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) %>%
|
||||||
@ -144,7 +145,8 @@ 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 %>%
|
||||||
|
@ -39,8 +39,8 @@
|
|||||||
# 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")
|
||||||
@ -550,9 +550,11 @@ taxonomy <- taxonomy %>%
|
|||||||
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(
|
||||||
|
!paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname),
|
||||||
# these will be added later:
|
# these will be added later:
|
||||||
source != "manually added")) %>%
|
source != "manually added"
|
||||||
|
)) %>%
|
||||||
arrange(fullname) %>%
|
arrange(fullname) %>%
|
||||||
filter(fullname != "")
|
filter(fullname != "")
|
||||||
|
|
||||||
@ -602,7 +604,8 @@ 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(
|
||||||
|
current_gbif %>%
|
||||||
select(kingdom, rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID),
|
select(kingdom, rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID),
|
||||||
by = c("kingdom", "rank")
|
by = c("kingdom", "rank")
|
||||||
) %>%
|
) %>%
|
||||||
@ -626,7 +629,8 @@ for (i in 2:6) {
|
|||||||
) %>%
|
) %>%
|
||||||
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(
|
||||||
|
current_gbif %>%
|
||||||
select(kingdom, all_of(i_name), rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID),
|
select(kingdom, all_of(i_name), rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID),
|
||||||
by = c("kingdom", "rank", i_name)
|
by = c("kingdom", "rank", i_name)
|
||||||
) %>%
|
) %>%
|
||||||
@ -646,14 +650,18 @@ taxonomy <- taxonomy %>%
|
|||||||
|
|
||||||
# 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_index = case_when(
|
||||||
|
rank == "subspecies" ~ 1,
|
||||||
rank == "species" ~ 2,
|
rank == "species" ~ 2,
|
||||||
rank == "genus" ~ 3,
|
rank == "genus" ~ 3,
|
||||||
rank == "family" ~ 4,
|
rank == "family" ~ 4,
|
||||||
rank == "order" ~ 5,
|
rank == "order" ~ 5,
|
||||||
rank == "class" ~ 6,
|
rank == "class" ~ 6,
|
||||||
TRUE ~ 7),
|
TRUE ~ 7
|
||||||
fullname_rank = paste0(fullname, " {", rank, "}")) %>%
|
),
|
||||||
|
fullname_rank = paste0(fullname, " {", rank, "}")
|
||||||
|
) %>%
|
||||||
arrange(kingdom, fullname, rank_index) %>%
|
arrange(kingdom, fullname, rank_index) %>%
|
||||||
group_by(kingdom, fullname) %>%
|
group_by(kingdom, fullname) %>%
|
||||||
mutate(fullname = if_else(row_number() > 1, fullname_rank, fullname)) %>%
|
mutate(fullname = if_else(row_number() > 1, fullname_rank, fullname)) %>%
|
||||||
@ -676,7 +684,8 @@ 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(
|
||||||
|
current_gbif %>%
|
||||||
select(kingdom, genus, species = specificEpithet, rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID),
|
select(kingdom, genus, species = specificEpithet, rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID),
|
||||||
by = c("kingdom", "rank", "genus", "species")
|
by = c("kingdom", "rank", "genus", "species")
|
||||||
) %>%
|
) %>%
|
||||||
@ -809,8 +818,10 @@ 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(.)),
|
||||||
|
unlist(mo_synonyms(., keep_synonyms = FALSE))
|
||||||
|
) %>%
|
||||||
strsplit(" ", fixed = TRUE) %>%
|
strsplit(" ", fixed = TRUE) %>%
|
||||||
sapply(function(x) ifelse(length(x) == 1, x, paste(x[1], x[2]))) %>%
|
sapply(function(x) ifelse(length(x) == 1, x, paste(x[1], x[2]))) %>%
|
||||||
sort() %>%
|
sort() %>%
|
||||||
@ -821,8 +832,10 @@ 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(.)),
|
||||||
|
unlist(mo_synonyms(., keep_synonyms = FALSE))
|
||||||
|
) %>%
|
||||||
strsplit(" ", fixed = TRUE) %>%
|
strsplit(" ", fixed = TRUE) %>%
|
||||||
sapply(function(x) ifelse(length(x) == 1, x, paste(x[1], x[2]))) %>%
|
sapply(function(x) ifelse(length(x) == 1, x, paste(x[1], x[2]))) %>%
|
||||||
sort() %>%
|
sort() %>%
|
||||||
@ -844,8 +857,10 @@ putative_genera <- putative %>%
|
|||||||
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(.)),
|
||||||
|
unlist(mo_synonyms(., keep_synonyms = FALSE))
|
||||||
|
) %>%
|
||||||
strsplit(" ", fixed = TRUE) %>%
|
strsplit(" ", fixed = TRUE) %>%
|
||||||
sapply(function(x) x[1]) %>%
|
sapply(function(x) x[1]) %>%
|
||||||
sort() %>%
|
sort() %>%
|
||||||
@ -874,7 +889,8 @@ taxonomy <- taxonomy %>%
|
|||||||
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,7 +925,8 @@ 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(
|
||||||
|
AMR::microorganisms %>%
|
||||||
filter(rank == "phylum") %>%
|
filter(rank == "phylum") %>%
|
||||||
transmute(kingdom,
|
transmute(kingdom,
|
||||||
phylum = fullname,
|
phylum = fullname,
|
||||||
@ -935,7 +952,8 @@ 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(
|
||||||
|
AMR::microorganisms %>%
|
||||||
filter(rank == "class") %>%
|
filter(rank == "class") %>%
|
||||||
transmute(kingdom,
|
transmute(kingdom,
|
||||||
class = fullname,
|
class = fullname,
|
||||||
@ -961,7 +979,8 @@ 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(
|
||||||
|
AMR::microorganisms %>%
|
||||||
filter(rank == "order") %>%
|
filter(rank == "order") %>%
|
||||||
transmute(kingdom,
|
transmute(kingdom,
|
||||||
order = fullname,
|
order = fullname,
|
||||||
@ -987,7 +1006,8 @@ 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(
|
||||||
|
AMR::microorganisms %>%
|
||||||
filter(rank == "family") %>%
|
filter(rank == "family") %>%
|
||||||
transmute(kingdom,
|
transmute(kingdom,
|
||||||
family = fullname,
|
family = fullname,
|
||||||
@ -1014,7 +1034,8 @@ 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(
|
||||||
|
AMR::microorganisms %>%
|
||||||
filter(rank == "genus") %>%
|
filter(rank == "genus") %>%
|
||||||
transmute(mo_genus_old = gsub("^[A-Z]+_", "", as.character(mo)), kingdom, genus) %>%
|
transmute(mo_genus_old = gsub("^[A-Z]+_", "", as.character(mo)), kingdom, genus) %>%
|
||||||
distinct(kingdom, genus, .keep_all = TRUE),
|
distinct(kingdom, genus, .keep_all = TRUE),
|
||||||
@ -1060,7 +1081,8 @@ 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(
|
||||||
|
AMR::microorganisms %>%
|
||||||
filter(rank == "species") %>%
|
filter(rank == "species") %>%
|
||||||
transmute(mo_species_old = gsub("^[A-Z]+_[A-Z]+_", "", as.character(mo)), kingdom, genus, species) %>%
|
transmute(mo_species_old = gsub("^[A-Z]+_[A-Z]+_", "", as.character(mo)), kingdom, genus, species) %>%
|
||||||
filter(mo_species_old %unlike% "-") %>%
|
filter(mo_species_old %unlike% "-") %>%
|
||||||
@ -1108,7 +1130,8 @@ 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(
|
||||||
|
AMR::microorganisms %>%
|
||||||
filter(rank %in% c("subspecies", "subsp.", "infraspecies")) %>%
|
filter(rank %in% c("subspecies", "subsp.", "infraspecies")) %>%
|
||||||
transmute(mo_subspecies_old = gsub("^[A-Z]+_[A-Z]+_[A-Z]+_", "", as.character(mo)), kingdom, genus, species, subspecies) %>%
|
transmute(mo_subspecies_old = gsub("^[A-Z]+_[A-Z]+_[A-Z]+_", "", as.character(mo)), kingdom, genus, species, subspecies) %>%
|
||||||
filter(mo_subspecies_old %unlike% "-") %>%
|
filter(mo_subspecies_old %unlike% "-") %>%
|
||||||
@ -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 == "Bacteria" ~ 1,
|
||||||
kingdom == "Fungi" ~ 2,
|
kingdom == "Fungi" ~ 2,
|
||||||
kingdom == "Protozoa" ~ 3,
|
kingdom == "Protozoa" ~ 3,
|
||||||
kingdom == "Archaea" ~ 4,
|
kingdom == "Archaea" ~ 4,
|
||||||
TRUE ~ 5)) %>%
|
TRUE ~ 5
|
||||||
|
)) %>%
|
||||||
arrange(fullname, rank_index) %>%
|
arrange(fullname, rank_index) %>%
|
||||||
distinct(fullname, .keep_all = TRUE) %>%
|
distinct(fullname, .keep_all = TRUE) %>%
|
||||||
select(-rank_index) %>%
|
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 -----------------------------------------------------------
|
||||||
|
@ -35,7 +35,8 @@
|
|||||||
# WHO Collaborating Centre for Reference and Research on Salmonella
|
# WHO Collaborating Centre for Reference and Research on Salmonella
|
||||||
# https://www.researchgate.net/publication/283428414
|
# https://www.researchgate.net/publication/283428414
|
||||||
|
|
||||||
serovars <- c("Aachen",
|
serovars <- c(
|
||||||
|
"Aachen",
|
||||||
"Aarhus",
|
"Aarhus",
|
||||||
"Aba",
|
"Aba",
|
||||||
"Abadina",
|
"Abadina",
|
||||||
@ -1550,7 +1551,8 @@ serovars <- c("Aachen",
|
|||||||
"Zinder",
|
"Zinder",
|
||||||
"Zongo",
|
"Zongo",
|
||||||
"Zuilen",
|
"Zuilen",
|
||||||
"Zwickau")
|
"Zwickau"
|
||||||
|
)
|
||||||
|
|
||||||
library(dplyr)
|
library(dplyr)
|
||||||
salmonellae <- tibble(
|
salmonellae <- tibble(
|
||||||
@ -1569,12 +1571,14 @@ salmonellae <- salmonellae %>%
|
|||||||
# remove e.g. Salmonella Enteritidis if Salmonella enteritidis already existed
|
# remove e.g. Salmonella Enteritidis if Salmonella enteritidis already existed
|
||||||
filter(!tolower(fullname) %in% tolower(AMR::microorganisms$fullname))
|
filter(!tolower(fullname) %in% tolower(AMR::microorganisms$fullname))
|
||||||
|
|
||||||
groups <- c("Paratyphi A",
|
groups <- c(
|
||||||
|
"Paratyphi A",
|
||||||
"Paratyphi B",
|
"Paratyphi B",
|
||||||
"Paratyphi C",
|
"Paratyphi C",
|
||||||
"Group B",
|
"Group B",
|
||||||
"Group C",
|
"Group C",
|
||||||
"Group D")
|
"Group D"
|
||||||
|
)
|
||||||
salmonellae <- salmonellae %>%
|
salmonellae <- salmonellae %>%
|
||||||
bind_rows(tibble(
|
bind_rows(tibble(
|
||||||
genus = "Salmonella",
|
genus = "Salmonella",
|
||||||
|
@ -58,7 +58,8 @@ 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(
|
||||||
|
genus = "Enterobacter",
|
||||||
species = "asburiae/cloacae"
|
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(
|
||||||
|
genus = "Citrobacter",
|
||||||
species = c("freundii", "braakii complex"),
|
species = c("freundii", "braakii complex"),
|
||||||
subspecies = c("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(
|
||||||
|
c(
|
||||||
Sys.time(),
|
Sys.time(),
|
||||||
Sys.time() + 60 * 60
|
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 \%>\%
|
||||||
|
@ -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(
|
||||||
|
data.frame(
|
||||||
date = Sys.Date(),
|
date = Sys.Date(),
|
||||||
patient_id = c("abcd", "abcd", "efgh"),
|
patient_id = c("abcd", "abcd", "efgh"),
|
||||||
mo = "Escherichia coli",
|
mo = "Escherichia coli",
|
||||||
AMX = c("S", "S", "R"),
|
AMX = c("S", "S", "R"),
|
||||||
CIP = c("S", "R", "S"),
|
CIP = c("S", "R", "S"),
|
||||||
stringsAsFactors = FALSE
|
stringsAsFactors = FALSE
|
||||||
),
|
),
|
||||||
align = "c"
|
align = "c"
|
||||||
)
|
)
|
||||||
```
|
```
|
||||||
|
|
||||||
@ -129,7 +130,8 @@ 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(
|
||||||
|
c(
|
||||||
"Hospital A",
|
"Hospital A",
|
||||||
"Hospital B",
|
"Hospital B",
|
||||||
"Hospital C",
|
"Hospital C",
|
||||||
@ -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(
|
||||||
|
data_1st %>%
|
||||||
filter(any(aminoglycosides() == "R")) %>%
|
filter(any(aminoglycosides() == "R")) %>%
|
||||||
head(),
|
head(),
|
||||||
align = "c"
|
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(
|
||||||
|
data_1st %>%
|
||||||
bug_drug_combinations() %>%
|
bug_drug_combinations() %>%
|
||||||
head(),
|
head(),
|
||||||
align = "c"
|
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(
|
||||||
|
data_1st %>%
|
||||||
select(bacteria, aminoglycosides()) %>%
|
select(bacteria, aminoglycosides()) %>%
|
||||||
bug_drug_combinations(),
|
bug_drug_combinations(),
|
||||||
align = "c"
|
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(
|
||||||
|
data %>%
|
||||||
group_by(Country) %>%
|
group_by(Country) %>%
|
||||||
select(Country, AMP_ND2, AMC_ED20, CAZ_ED10, CIP_ED5) %>%
|
select(Country, AMP_ND2, AMC_ED20, CAZ_ED10, CIP_ED5) %>%
|
||||||
ggplot_sir(translate_ab = "ab", facet = "Country", datalabels = FALSE) %>%
|
ggplot_sir(translate_ab = "ab", facet = "Country", datalabels = FALSE) %>%
|
||||||
print(),
|
print(),
|
||||||
error = function(e) base::invisible()
|
error = function(e) base::invisible()
|
||||||
)
|
)
|
||||||
```
|
```
|
||||||
|
Loading…
Reference in New Issue
Block a user