P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2024-12-25 19:26:13 +01:00
Code Releases Activity

(v1.4.0.9011) message formatting

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2020-10-27 15:56:51 +01:00
parent 98773aa859
commit 5a607abb36
27 changed files with 187 additions and 157 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
.github/workflows/check.yaml vendored
View File

@ -50,18 +50,20 @@ jobs:
fail-fast: false
matrix:
config:
- {os: macOS-latest, r: 'devel', allowfail = false}
- {os: macOS-latest, r: 'release', allowfail = false}
- {os: macOS-latest, r: 'oldrel', allowfail = false}
- {os: windows-latest, r: 'devel', allowfail = false}
- {os: windows-latest, r: 'release', allowfail = false}
- {os: windows-latest, r: 'oldrel', allowfail = false}
- {os: ubuntu-16.04, r: 'release', allowfail = false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
- {os: ubuntu-16.04, r: '4.0', allowfail = false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
- {os: ubuntu-16.04, r: '3.6', allowfail = false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
- {os: ubuntu-16.04, r: '3.5', allowfail = false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
- {os: ubuntu-16.04, r: '3.4', allowfail = true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
- {os: ubuntu-16.04, r: '3.3', allowfail = true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
- {os: macOS-latest, r: 'devel', allowfail: false}
- {os: macOS-latest, r: 'release', allowfail: false}
- {os: macOS-latest, r: 'oldrel', allowfail: false}
- {os: windows-latest, r: 'devel', allowfail: false}
- {os: windows-latest, r: 'release', allowfail: false}
- {os: windows-latest, r: 'oldrel', allowfail: false}
- {os: ubuntu-16.04, r: 'devel', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
- {os: ubuntu-16.04, r: 'release', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
- {os: ubuntu-16.04, r: 'oldrel', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
- {os: ubuntu-16.04, r: '4.0', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
- {os: ubuntu-16.04, r: '3.6', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
- {os: ubuntu-16.04, r: '3.5', allowfail: false, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
- {os: ubuntu-16.04, r: '3.4', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
- {os: ubuntu-16.04, r: '3.3', allowfail: true, rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
env:
R_REMOTES_NO_ERRORS_FROM_WARNINGS: true

4
DESCRIPTION
View File

@ -1,6 +1,6 @@
Package: AMR
Version: 1.4.0.9009
Date: 2020-10-26
Version: 1.4.0.9011
Date: 2020-10-27
Title: Antimicrobial Resistance Analysis
Authors@R: c(
person(role = c("aut", "cre"),

4
NEWS.md
View File

@ -1,5 +1,5 @@
# AMR 1.4.0.9009
## <small>Last updated: 26 October 2020</small>
# AMR 1.4.0.9011
## <small>Last updated: 27 October 2020</small>
### New
* Functions `is_gram_negative()` and `is_gram_positive()` as wrappers around `mo_gramstain()`. They always return `TRUE` or `FALSE`, thus always return `FALSE` for species outside the taxonomic kingdom of Bacteria.

11
R/aa_helper_functions.R
View File

@ -209,19 +209,20 @@ search_type_in_df <- function(x, type, info = TRUE) {
if (!is.null(found)) {
# this column should contain logicals
if (!is.logical(x[, found, drop = TRUE])) {
message(font_red(paste0("NOTE: Column `", font_bold(found), "` found as input for `col_", type,
"`, but this column does not contain 'logical' values (TRUE/FALSE) and was ignored.")))
message_("Column `", font_bold(found), "` found as input for `col_", type,
"`, but this column does not contain 'logical' values (TRUE/FALSE) and was ignored.",
add_fn = font_red)
found <- NULL
}
}
}
if (!is.null(found) & info == TRUE) {
msg <- paste0("NOTE: Using column `", font_bold(found), "` as input for `col_", type, "`.")
msg <- paste0("Using column `", font_bold(found), "` as input for `col_", type, "`.")
if (type %in% c("keyantibiotics", "specimen")) {
msg <- paste(msg, "Use", font_bold(paste0("col_", type), "= FALSE"), "to prevent this.")
}
message(font_blue(msg))
message_(msg)
}
found
}
@ -297,6 +298,8 @@ message_ <- function(..., appendLF = TRUE, add_fn = list(font_blue), as_note = T
if (msg_stripped %like% "^NOTE: ") {
indentation <- 6
} else if (msg_stripped %like% "^=> ") {
indentation <- 3
} else {
indentation <- 0
}

4
R/ab.R
View File

@ -123,8 +123,8 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = TRUE, ...) {
abnames <- abnames[!abnames == "clavulanic acid"]
}
if (length(abnames) > 1) {
message(font_blue(paste0("NOTE: more than one result was found for item ", index, ": ",
paste0(abnames, collapse = ", "))))
message_("More than one result was found for item ", index, ": ",
paste0(abnames, collapse = ", "))
}
}
found[1L]

10
R/ab_class_selectors.R
View File

@ -158,7 +158,7 @@ ab_selector <- function(ab_class, function_name) {
ab_in_data <- get_column_abx(vars_df, info = FALSE)
if (length(ab_in_data) == 0) {
message(font_blue("NOTE: no antimicrobial agents found."))
message_("No antimicrobial agents found.")
return(NULL)
}
@ -176,13 +176,13 @@ ab_selector <- function(ab_class, function_name) {
# get the columns with a group names in the chosen ab class
agents <- ab_in_data[names(ab_in_data) %in% ab_reference$ab]
if (length(agents) == 0) {
message(font_blue(paste0("NOTE: No antimicrobial agents of class ", ab_group,
" found", examples, ".")))
message_("No antimicrobial agents of class ", ab_group, " found", examples, ".")
} else {
message(font_blue(paste0("Selecting ", ab_group, ": ",
message_("Selecting ", ab_group, ": ",
paste(paste0("`", font_bold(agents, collapse = NULL),
"` (", ab_name(names(agents), tolower = TRUE, language = NULL), ")"),
collapse = ", "))))
collapse = ", "),
as_note = FALSE)
}
unname(agents)
}

4
R/atc_online.R
View File

@ -100,7 +100,9 @@ atc_online_property <- function(atc_code,
}
if (!has_internet()) {
message("There appears to be no internet connection, returning NA.")
message_("There appears to be no internet connection, returning NA.",
add_fn = font_red,
as_note = FALSE)
return(rep(NA, length(atc_code)))
}

2
R/bug_drug_combinations.R
View File

@ -245,5 +245,5 @@ print.bug_drug_combinations <- function(x, ...) {
x_class <- class(x)
print(structure(x, class = x_class[x_class != "bug_drug_combinations"]),
...)
message(font_blue("NOTE: Use 'format()' on this result to get a publishable/printable format."))
message_("Use 'format()' on this result to get a publishable/printable format.", as_note = FALSE)
}

8
R/eucast_rules.R
View File

@ -174,7 +174,7 @@ eucast_rules <- function(x,
q_continue <- utils::menu(choices = c("OK", "Cancel"), graphics = FALSE, title = txt)
}
if (q_continue %in% c(FALSE, 2)) {
message("Cancelled, returning original data")
message_("Cancelled, returning original data", add_fn = font_red, as_note = FALSE)
return(x)
}
}
@ -443,14 +443,14 @@ eucast_rules <- function(x,
if (ab_missing(AMP) & !ab_missing(AMX)) {
# ampicillin column is missing, but amoxicillin is available
if (info == TRUE) {
message(font_blue(paste0("NOTE: Using column `", font_bold(AMX), "` as input for ampicillin since many EUCAST rules depend on it.")))
message_("Using column `", font_bold(AMX), "` as input for ampicillin since many EUCAST rules depend on it.")
}
AMP <- AMX
}
# data preparation ----
if (info == TRUE & NROW(x) > 10000) {
message(font_blue("NOTE: Preparing data..."), appendLF = FALSE)
message_("Preparing data...", appendLF = FALSE, as_note = FALSE)
}
# nolint start
@ -583,7 +583,7 @@ eucast_rules <- function(x,
x$gramstain <- mo_gramstain(x[, col_mo, drop = TRUE], language = NULL)
x$genus_species <- paste(x$genus, x$species)
if (info == TRUE & NROW(x) > 10000) {
message(font_blue("OK."))
message_("OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
}
if (any(x$genus == "Staphylococcus", na.rm = TRUE)) {

12
R/filter_ab_class.R
View File

@ -108,7 +108,7 @@ filter_ab_class <- function(x,
# get all columns in data with names that resemble antibiotics
ab_in_data <- get_column_abx(x, info = FALSE)
if (length(ab_in_data) == 0) {
message(font_blue("NOTE: no columns with class <rsi> found (see ?as.rsi), data left unchanged."))
message_("No columns with class <rsi> found (see ?as.rsi), data left unchanged.")
return(x.bak)
}
# get reference data
@ -122,15 +122,15 @@ filter_ab_class <- function(x,
atc_group2 %like% ab_class)
ab_group <- find_ab_group(ab_class)
if (ab_group == "") {
message(font_blue(paste0("NOTE: unknown antimicrobial class '", ab_class.bak, "', data left unchanged.")))
message_("Unknown antimicrobial class '", ab_class.bak, "', data left unchanged.")
return(x.bak)
}
# get the columns with a group names in the chosen ab class
agents <- ab_in_data[names(ab_in_data) %in% ab_reference$ab]
if (length(agents) == 0) {
message(font_blue(paste0("NOTE: no antimicrobial agents of class ", ab_group,
message_("NOTE: no antimicrobial agents of class ", ab_group,
" found (such as ", find_ab_names(ab_class, 2),
"), data left unchanged.")))
"), data left unchanged.")
return(x.bak)
}
@ -158,11 +158,11 @@ filter_ab_class <- function(x,
# sort columns on official name
agents <- agents[order(ab_name(names(agents), language = NULL))]
message(font_blue(paste0("Filtering on ", ab_group, ": ", scope,
message_("Filtering on ", ab_group, ": ", scope,
paste(paste0("`", font_bold(agents, collapse = NULL),
"` (", ab_name(names(agents), tolower = TRUE, language = NULL), ")"),
collapse = scope_txt),
operator, toString(result))))
operator, toString(result), as_note = FALSE)
x_transposed <- as.list(as.data.frame(t(x[, agents, drop = FALSE])))
filtered <- sapply(x_transposed, function(y) scope_fn(y %in% result, na.rm = TRUE))
x <- x[which(filtered), , drop = FALSE]

42
R/first_isolate.R
View File

@ -201,7 +201,7 @@ first_isolate <- function(x,
# WHONET support
x$patient_id <- paste(x$`First name`, x$`Last name`, x$Sex)
col_patient_id <- "patient_id"
message(font_blue(paste0("NOTE: Using combined columns `", font_bold("First name"), "`, `", font_bold("Last name"), "` and `", font_bold("Sex"), "` as input for `col_patient_id`")))
message_("Using combined columns `", font_bold("First name"), "`, `", font_bold("Last name"), "` and `", font_bold("Sex"), "` as input for `col_patient_id`")
} else {
col_patient_id <- search_type_in_df(x = x, type = "patient_id")
}
@ -250,7 +250,9 @@ first_isolate <- function(x,
}
# remove testcodes
if (!is.null(testcodes_exclude) & info == TRUE) {
message(font_black(paste0("[Criterion] Exclude test codes: ", toString(paste0("'", testcodes_exclude, "'")))))
message_("[Criterion] Exclude test codes: ", toString(paste0("'", testcodes_exclude, "'")),
add_fn = font_black,
as_note = FALSE)
}
if (is.null(col_specimen)) {
@ -261,7 +263,9 @@ first_isolate <- function(x,
if (!is.null(specimen_group)) {
check_columns_existance(col_specimen, x)
if (info == TRUE) {
message(font_black(paste0("[Criterion] Exclude other than specimen group '", specimen_group, "'")))
message_("[Criterion] Exclude other than specimen group '", specimen_group, "'",
add_fn = font_black,
as_note = FALSE)
}
}
if (!is.null(col_keyantibiotics)) {
@ -298,7 +302,7 @@ first_isolate <- function(x,
# no isolates found
if (abs(row.start) == Inf | abs(row.end) == Inf) {
if (info == TRUE) {
message(paste("=> Found", font_bold("no isolates")))
message_("=> Found ", font_bold("no isolates"), as_note = FALSE)
}
return(rep(FALSE, nrow(x)))
}
@ -350,13 +354,17 @@ first_isolate <- function(x,
weighted.notice <- "weighted "
if (info == TRUE) {
if (type == "keyantibiotics") {
message(font_black(paste0("[Criterion] Base inclusion on key antibiotics, ",
message_("[Criterion] Base inclusion on key antibiotics, ",
ifelse(ignore_I == FALSE, "not ", ""),
"ignoring I")))
"ignoring I",
add_fn = font_black,
as_note = FALSE)
}
if (type == "points") {
message(font_black(paste0("[Criterion] Base inclusion on key antibiotics, using points threshold of "
, points_threshold)))
message_("[Criterion] Base inclusion on key antibiotics, using points threshold of "
, points_threshold,
add_fn = font_black,
as_note = FALSE)
}
}
type_param <- type
@ -393,10 +401,14 @@ first_isolate <- function(x,
}
if (!is.null(col_icu)) {
if (icu_exclude == TRUE) {
message(font_black("[Criterion] Exclude isolates from ICU.\n"))
message_("[Criterion] Exclude isolates from ICU.",
add_fn = font_black,
as_note = FALSE)
x[which(as.logical(x[, col_icu, drop = TRUE])), "newvar_first_isolate"] <- FALSE
} else {
message(font_black("[Criterion] Include isolates from ICU.\n"))
message_("[Criterion] Include isolates from ICU.",
add_fn = font_black,
as_note = FALSE)
}
}
@ -405,18 +417,18 @@ first_isolate <- function(x,
# handle empty microorganisms
if (any(x$newvar_mo == "UNKNOWN", na.rm = TRUE) & info == TRUE) {
message(font_blue(paste0("NOTE: ", ifelse(include_unknown == TRUE, "Included ", "Excluded "),
message_(ifelse(include_unknown == TRUE, "Included ", "Excluded "),
format(sum(x$newvar_mo == "UNKNOWN", na.rm = TRUE),
decimal.mark = decimal.mark, big.mark = big.mark),
" isolates with a microbial ID 'UNKNOWN' (column `", font_bold(col_mo), "`)")))
" isolates with a microbial ID 'UNKNOWN' (column `", font_bold(col_mo), "`)")
}
x[which(x$newvar_mo == "UNKNOWN"), "newvar_first_isolate"] <- include_unknown
# exclude all NAs
if (any(is.na(x$newvar_mo)) & info == TRUE) {
message(font_blue(paste0("NOTE: Excluded ", format(sum(is.na(x$newvar_mo), na.rm = TRUE),
message_("Excluded ", format(sum(is.na(x$newvar_mo), na.rm = TRUE),
decimal.mark = decimal.mark, big.mark = big.mark),
" isolates with a microbial ID 'NA' (column `", font_bold(col_mo), "`)")))
" isolates with a microbial ID 'NA' (column `", font_bold(col_mo), "`)")
}
x[which(is.na(x$newvar_mo)), "newvar_first_isolate"] <- FALSE
@ -445,7 +457,7 @@ first_isolate <- function(x,
font_bold(paste0(n_found, " first ", weighted.notice, "isolates")),
" (", p_found_total, " of total where a microbial ID was available)")
}
message(font_black(msg_txt))
message_(msg_txt, add_fn = font_black, as_note = FALSE)
}
x$newvar_first_isolate

35
R/guess_ab_col.R
View File

@ -94,14 +94,16 @@ guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE) {
if (length(ab_result) == 0) {
if (verbose == TRUE) {
message(paste0("No column found as input for `", search_string,
"` (", ab_name(search_string, language = NULL, tolower = TRUE), ")."))
message_("No column found as input for `", search_string,
"` (", ab_name(search_string, language = NULL, tolower = TRUE), ").",
add_fn = font_black,
as_note = FALSE)
}
return(NULL)
} else {
if (verbose == TRUE) {
message(font_blue(paste0("NOTE: Using column `", font_bold(ab_result), "` as input for `", search_string,
"` (", ab_name(search_string, language = NULL, tolower = TRUE), ").")))
message_("Using column `", font_bold(ab_result), "` as input for `", search_string,
"` (", ab_name(search_string, language = NULL, tolower = TRUE), ").")
}
return(ab_result)
}
@ -120,18 +122,20 @@ get_column_abx <- function(x,
meet_criteria(info, allow_class = "logical", has_length = 1)
if (info == TRUE) {
message(font_blue("NOTE: Auto-guessing columns suitable for analysis"), appendLF = FALSE)
message_("Auto-guessing columns suitable for analysis", appendLF = FALSE)
}
x <- as.data.frame(x, stringsAsFactors = FALSE)
if (NROW(x) > 10000) {
# only test maximum of 10,000 values per column
if (info == TRUE) {
message(font_blue(paste0(" (using only ", font_bold("the first 10,000 rows"), ")...")), appendLF = FALSE)
message_(" (using only ", font_bold("the first 10,000 rows"), ")...",
appendLF = FALSE,
as_note = FALSE)
}
x <- x[1:10000, , drop = FALSE]
} else if (info == TRUE) {
message(font_blue("..."), appendLF = FALSE)
message_("...", appendLF = FALSE, as_note = FALSE)
}
x_bak <- x
# only check columns that are a valid AB code, ATC code, name, abbreviation or synonym,
@ -178,7 +182,7 @@ get_column_abx <- function(x,
if (length(x) == 0) {
if (info == TRUE) {
message(font_blue("No columns found."))
message_("No columns found.")
}
return(x)
}
@ -192,13 +196,13 @@ get_column_abx <- function(x,
# succeeded with auto-guessing
if (info == TRUE) {
message(font_blue("OK."))
message_("OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
}
for (i in seq_len(length(x))) {
if (info == TRUE & verbose == TRUE & !names(x[i]) %in% names(duplicates)) {
message(font_blue(paste0("NOTE: Using column `", font_bold(x[i]), "` as input for `", names(x)[i],
"` (", ab_name(names(x)[i], tolower = TRUE, language = NULL), ").")))
message_("Using column `", font_bold(x[i]), "` as input for `", names(x)[i],
"` (", ab_name(names(x)[i], tolower = TRUE, language = NULL), ").")
}
if (info == TRUE & names(x[i]) %in% names(duplicates)) {
warning(font_red(paste0("Using column `", font_bold(x[i]), "` as input for `", names(x)[i],
@ -225,15 +229,10 @@ get_column_abx <- function(x,
# missing a soft dependency may lower the reliability
missing <- soft_dependencies[!soft_dependencies %in% names(x)]
missing_msg <- paste(paste0(ab_name(missing, tolower = TRUE, language = NULL),
" (", missing, ")"),
" (", font_bold(missing, collapse = NULL), ")"),
collapse = ", ")
missing_msg <- paste("NOTE: Reliability would be improved if these antimicrobial results would be available too:",
message_("Reliability would be improved if these antimicrobial results would be available too: ",
missing_msg)
wrapped <- strwrap(missing_msg,
width = 0.95 * getOption("width"),
exdent = 6)
wrapped <- gsub("\\((.*?)\\)", paste0("(", font_bold("\\1"), ")"), wrapped) # add bold abbreviations
message(font_blue(wrapped, collapse = "\n"))
}
}
x

2
R/join_microorganisms.R
View File

@ -255,7 +255,7 @@ joins_check_df <- function(x, by) {
stop("Cannot join - no column found with name 'mo' or with class <mo>.", call. = FALSE)
}
}
message('Joining, by = "', by, '"') # message same as dplyr::join functions
message_('Joining, by = "', by, '"', add_fn = font_black, as_note = FALSE) # message same as dplyr::join functions
}
if (is.null(names(by))) {
joinby <- colnames(microorganisms)[1]

16
R/mdro.R
View File

@ -114,7 +114,7 @@ mdro <- function(x,
q_continue <- utils::menu(choices = c("OK", "Cancel"), graphics = FALSE, title = txt)
}
if (q_continue %in% c(FALSE, 2)) {
message("Cancelled, returning original data")
message_("Cancelled, returning original data", add_fn = font_red, as_note = FALSE)
return(x)
}
}
@ -162,8 +162,8 @@ mdro <- function(x,
col_mo <- search_type_in_df(x = x, type = "mo", info = info)
}
if (is.null(col_mo) & guideline$code == "tb") {
message(font_blue("NOTE: No column found as input for `col_mo`,",
font_bold("assuming all records contain", font_italic("Mycobacterium tuberculosis."))))
message_("No column found as input for `col_mo`, ",
font_bold("assuming all records contain", font_italic("Mycobacterium tuberculosis.")))
x$mo <- as.mo("Mycobacterium tuberculosis")
col_mo <- "mo"
}
@ -599,7 +599,7 @@ mdro <- function(x,
}
trans_tbl2 <- function(txt, rows, lst) {
if (info == TRUE) {
message(font_blue(txt, "..."), appendLF = FALSE)
message_(txt, "...", appendLF = FALSE, as_note = FALSE)
}
if (length(rows) > 0) {
# function specific for the CMI paper of 2012 (Magiorakos et al.)
@ -633,7 +633,7 @@ mdro <- function(x,
}
if (info == TRUE) {
message(font_blue(" OK"))
message_(" OK", as_note = FALSE)
}
}
@ -653,20 +653,20 @@ mdro <- function(x,
# take amoxicillin if ampicillin is unavailable
if (is.na(AMP) & !is.na(AMX)) {
if (verbose == TRUE) {
message(font_blue("NOTE: Filling ampicillin (AMP) results with amoxicillin (AMX) results"))
message_("Filling ampicillin (AMP) results with amoxicillin (AMX) results")
}
AMP <- AMX
}
# take ceftriaxone if cefotaxime is unavailable and vice versa
if (is.na(CRO) & !is.na(CTX)) {
if (verbose == TRUE) {
message(font_blue("NOTE: Filling ceftriaxone (CRO) results with cefotaxime (CTX) results"))
message_("Filling ceftriaxone (CRO) results with cefotaxime (CTX) results")
}
CRO <- CTX
}
if (is.na(CTX) & !is.na(CRO)) {
if (verbose == TRUE) {
message(font_blue("NOTE: Filling cefotaxime (CTX) results with ceftriaxone (CRO) results"))
message_("Filling cefotaxime (CTX) results with ceftriaxone (CRO) results")
}
CTX <- CRO
}

19
R/mo.R
View File

@ -1761,9 +1761,7 @@ print.mo_uncertainties <- function(x, ...) {
if (NROW(x) == 0) {
return(NULL)
}
cat(font_blue(strwrap("Matching scores are based on human pathogenic prevalence and the resemblance between the input and the full taxonomic name. Please see ?mo_matching_score.",
width = 0.98 * getOption("width")),
collapse = "\n"))
message_("Matching scores are based on human pathogenic prevalence and the resemblance between the input and the full taxonomic name. Please see ?mo_matching_score.", as_note = FALSE)
cat("\n")
msg <- ""
@ -1838,16 +1836,19 @@ print.mo_renamed <- function(x, ...) {
return(invisible())
}
for (i in seq_len(nrow(x))) {
message(font_blue(paste0("NOTE: ",
font_italic(x$old_name[i]), ifelse(x$old_ref[i] %in% c("", NA), "",
message_(font_italic(x$old_name[i]),
ifelse(x$old_ref[i] %in% c("", NA),
"",
paste0(" (", gsub("et al.", font_italic("et al."), x$old_ref[i]), ")")),
" was renamed ",
ifelse(as.integer(gsub("[^0-9]", "", x$new_ref[i])) < as.integer(gsub("[^0-9]", "", x$old_ref[i])),
font_bold("back to "),
""),
font_italic(x$new_name[i]), ifelse(x$new_ref[i] %in% c("", NA), "",
font_italic(x$new_name[i]),
ifelse(x$new_ref[i] %in% c("", NA),
"",
paste0(" (", gsub("et al.", font_italic("et al."), x$new_ref[i]), ")")),
" [", x$mo[i], "]")))
" [", x$mo[i], "]")
}
}
@ -1945,9 +1946,9 @@ replace_ignore_pattern <- function(x, ignore_pattern) {
if (!is.null(ignore_pattern) && !identical(trimws2(ignore_pattern), "")) {
ignore_cases <- x %like% ignore_pattern
if (sum(ignore_cases) > 0) {
message(font_blue(paste0("NOTE: the following input was ignored by `ignore_pattern = \"", ignore_pattern, "\"`: ",
message_("The following input was ignored by `ignore_pattern = \"", ignore_pattern, "\"`: ",
paste0("'", sort(unique(x[x %like% ignore_pattern])), "'", collapse = ", "),
collapse = ", ")))
collapse = ", ")
x[x %like% ignore_pattern] <- NA_character_
}
}

11
R/mo_source.R
View File

@ -126,7 +126,9 @@ set_mo_source <- function(path) {
options(mo_source_timestamp = NULL)
if (file.exists(file_location)) {
unlink(file_location)
message(font_red(paste0("Removed mo_source file '", font_bold(file_location), "'")))
message_("Removed mo_source file '", font_bold(file_location), "'",
add_fn = font_red,
as_note = FALSE)
}
return(invisible())
}
@ -199,10 +201,9 @@ set_mo_source <- function(path) {
saveRDS(df, file_location)
options(mo_source = path)
options(mo_source_timestamp = as.character(file.info(path)$mtime))
message(font_blue(paste0("NOTE: ",
action, " mo_source file '", font_bold(file_location), "'",
message_(action, " mo_source file '", font_bold(file_location), "'",
" from '", font_bold(path), "'",
'\n (columns "', colnames(df)[1], '" and "', colnames(df)[2], '")')))
'(columns "', colnames(df)[1], '" and "', colnames(df)[2], '")')
}
#' @rdname mo_source
@ -215,7 +216,7 @@ get_mo_source <- function() {
if (!file.exists(path.expand("~/mo_source.rds"))) {
options(mo_source = NULL)
options(mo_source_timestamp = NULL)
message(font_blue("NOTE: Removed references to deleted mo_source file (see ?mo_source)"))
message_("Removed references to deleted mo_source file (see ?mo_source)")
return(NULL)
}

4
R/pca.R
View File

@ -116,8 +116,8 @@ pca <- function(x,
pca_data <- x[, which(sapply(x, function(x) is.numeric(x)))]
message(font_blue(paste0("NOTE: Columns selected for PCA: ", paste0(font_bold(colnames(pca_data)), collapse = "/"),
".\n Total observations available: ", nrow(pca_data), ".")))
message_("Columns selected for PCA: ", paste0(font_bold(colnames(pca_data)), collapse = "/"),
". Total observations available: ", nrow(pca_data), ".")
pca_model <- prcomp(pca_data, retx = retx, center = center, scale. = scale., tol = tol, rank. = rank.)
attr(pca_model, "non_numeric_cols") <- x[, sapply(x, function(y) !is.numeric(y) & !all(is.na(y))), drop = FALSE]

48
R/rsi.R
View File

@ -340,7 +340,10 @@ as.rsi.mic <- function(x,
mo_coerced <- suppressWarnings(as.mo(mo))
guideline_coerced <- get_guideline(guideline)
if (is.na(ab_coerced)) {
message(font_red(paste0("Returning NAs for unknown drug: `", font_bold(ab), "`. Rename this column to a drug name or code, and check the output with as.ab().")))
message_("Returning NAs for unknown drug: `", font_bold(ab),
"`. Rename this column to a drug name or code, and check the output with as.ab().",
add_fn = font_red,
as_note = FALSE)
return(as.rsi(rep(NA, length(x))))
}
if (length(mo_coerced) == 1) {
@ -350,11 +353,12 @@ as.rsi.mic <- function(x,
uti <- rep(uti, length(x))
}
message(font_blue(paste0("=> Interpreting MIC values of `", font_bold(ab), "` (",
message_("=> Interpreting MIC values of `", font_bold(ab), "` (",
ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
ab_name(ab_coerced, tolower = TRUE), ")", mo_var_found,
" according to ", font_bold(guideline_coerced), " ... ")),
appendLF = FALSE)
" according to ", font_bold(guideline_coerced), " ... ",
appendLF = FALSE,
as_note = FALSE)
result <- exec_as.rsi(method = "mic",
x = x,
@ -363,7 +367,7 @@ as.rsi.mic <- function(x,
guideline = guideline_coerced,
uti = uti,
conserve_capped_values = conserve_capped_values,
add_intrinsic_resistance = add_intrinsic_resistance) # exec_as.rsi will return message(font_blue(" OK."))
add_intrinsic_resistance = add_intrinsic_resistance) # exec_as.rsi will return message_(" OK.")
result
}
@ -420,7 +424,10 @@ as.rsi.disk <- function(x,
mo_coerced <- suppressWarnings(as.mo(mo))
guideline_coerced <- get_guideline(guideline)
if (is.na(ab_coerced)) {
message(font_red(paste0("Returning NAs for unknown drug: `", font_bold(ab), "`. Rename this column to a drug name or code, and check the output with as.ab().")))
message_("Returning NAs for unknown drug: `", font_bold(ab),
"`. Rename this column to a drug name or code, and check the output with as.ab().",
add_fn = font_red,
as_note = FALSE)
return(as.rsi(rep(NA, length(x))))
}
if (length(mo_coerced) == 1) {
@ -430,10 +437,11 @@ as.rsi.disk <- function(x,
uti <- rep(uti, length(x))
}
message(font_blue(paste0("=> Interpreting disk zones of `", font_bold(ab), "` (",
message_("=> Interpreting disk zones of `", font_bold(ab), "` (",
ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
ab_name(ab_coerced, tolower = TRUE), ") using guideline ", font_bold(guideline_coerced), " ... ")),
appendLF = FALSE)
ab_name(ab_coerced, tolower = TRUE), ") using guideline ", font_bold(guideline_coerced), " ... ",
appendLF = FALSE,
as_note = FALSE)
result <- exec_as.rsi(method = "disk",
x = x,
mo = mo_coerced,
@ -441,7 +449,7 @@ as.rsi.disk <- function(x,
guideline = guideline_coerced,
uti = uti,
conserve_capped_values = FALSE,
add_intrinsic_resistance = add_intrinsic_resistance) # exec_as.rsi will return message(font_blue(" OK."))
add_intrinsic_resistance = add_intrinsic_resistance) # exec_as.rsi will return message_(" OK.")
result
}
@ -497,10 +505,11 @@ as.rsi.data.frame <- function(x,
} else {
plural <- c("", "s", "a ")
}
message(font_blue(paste0("NOTE: Assuming value", plural[1], " ",
message_("Assuming value", plural[1], " ",
paste(paste0('"', values, '"'), collapse = ", "),
" in column `", font_bold(col_specimen),
"` reflect", plural[2], " ", plural[3], "urinary tract infection", plural[1], ".\n Use `as.rsi(uti = FALSE)` to prevent this.")))
"` reflect", plural[2], " ", plural[3], "urinary tract infection", plural[1],
".\n Use `as.rsi(uti = FALSE)` to prevent this.")
} else {
# no data about UTI's found
uti <- FALSE
@ -573,12 +582,13 @@ as.rsi.data.frame <- function(x,
} else if (types[i] == "rsi") {
ab <- ab_cols[i]
ab_coerced <- suppressWarnings(as.ab(ab))
message(font_blue(paste0("=> Cleaning values in column `", font_bold(ab), "` (",
message_("=> Cleaning values in column `", font_bold(ab), "` (",
ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
ab_name(ab_coerced, tolower = TRUE), ")... ")),
appendLF = FALSE)
ab_name(ab_coerced, tolower = TRUE), ")... ",
appendLF = FALSE,
as_note = FALSE)
x[, ab_cols[i]] <- as.rsi.default(x = x %pm>% pm_pull(ab_cols[i]))
message(font_green("OK."))
message_("OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
}
}
@ -646,7 +656,7 @@ exec_as.rsi <- function(method,
guideline_coerced <- get_guideline(guideline)
if (guideline_coerced != guideline) {
message(font_blue(paste0("Note: Using guideline ", font_bold(guideline_coerced), " as input for `guideline`.")))
message_("Using guideline ", font_bold(guideline_coerced), " as input for `guideline`.")
}
new_rsi <- rep(NA_character_, length(x))
@ -664,7 +674,7 @@ exec_as.rsi <- function(method,
lookup_other <- paste(mo_other, ab)
if (all(trans$uti == TRUE, na.rm = TRUE) & all(uti == FALSE)) {
message(font_red("WARNING."))
message_("WARNING.", add_fn = list(font_red, font_bold), as_note = FALSE)
warning("Interpretation of ", font_bold(ab_name(ab, tolower = TRUE)), " for some microorganisms is only available for (uncomplicated) urinary tract infections (UTI).\n Use parameter 'uti' to set which isolates are from urine. See ?as.rsi.", call. = FALSE)
warned <- TRUE
}
@ -744,7 +754,7 @@ exec_as.rsi <- function(method,
pm_pull(new_rsi)
if (warned == FALSE) {
message(font_green("OK."))
message_("OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
}
load_mo_failures_uncertainties_renamed(metadata_mo)

2
docs/404.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="https://msberends.github.io/AMR//index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9009</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9011</span>
</span>
</div>

2
docs/LICENSE-text.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9009</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9011</span>
</span>
</div>

2
docs/articles/index.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9009</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9011</span>
</span>
</div>

2
docs/authors.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9009</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9011</span>
</span>
</div>

2
docs/index.html
View File

@ -43,7 +43,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9009</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9011</span>
</span>
</div>

12
docs/news/index.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9009</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9011</span>
</span>
</div>
@ -236,13 +236,13 @@
<small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small>
</div>
<div id="amr-1409009" class="section level1">
<h1 class="page-header" data-toc-text="1.4.0.9009">
<a href="#amr-1409009" class="anchor"></a>AMR 1.4.0.9009<small> Unreleased </small>
<div id="amr-1409011" class="section level1">
<h1 class="page-header" data-toc-text="1.4.0.9011">
<a href="#amr-1409011" class="anchor"></a>AMR 1.4.0.9011<small> Unreleased </small>
</h1>
<div id="last-updated-26-october-2020" class="section level2">
<div id="last-updated-27-october-2020" class="section level2">
<h2 class="hasAnchor">
<a href="#last-updated-26-october-2020" class="anchor"></a><small>Last updated: 26 October 2020</small>
<a href="#last-updated-27-october-2020" class="anchor"></a><small>Last updated: 27 October 2020</small>
</h2>
<div id="new" class="section level3">
<h3 class="hasAnchor">

2
docs/pkgdown.yml
View File

@ -12,7 +12,7 @@ articles:
datasets: datasets.html
resistance_predict: resistance_predict.html
welcome_to_AMR: welcome_to_AMR.html
last_built: 2020-10-26T14:49Z
last_built: 2020-10-27T14:41Z
urls:
reference: https://msberends.github.io/AMR//reference
article: https://msberends.github.io/AMR//articles

2
docs/reference/index.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9009</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9011</span>
</span>
</div>

2
docs/survey.html
View File

@ -81,7 +81,7 @@
</button>
<span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9009</span>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9011</span>
</span>
</div>