mirror of
https://github.com/msberends/AMR.git
synced 2024-12-25 06:46:11 +01:00
cleanup
This commit is contained in:
parent
796b972f8a
commit
d20caae54b
@ -1,5 +1,5 @@
|
||||
Package: AMR
|
||||
Version: 1.8.2.9040
|
||||
Version: 1.8.2.9041
|
||||
Date: 2022-10-31
|
||||
Title: Antimicrobial Resistance Data Analysis
|
||||
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
|
||||
|
2
NEWS.md
2
NEWS.md
@ -1,4 +1,4 @@
|
||||
# AMR 1.8.2.9040
|
||||
# AMR 1.8.2.9041
|
||||
|
||||
This version will eventually become v2.0! We're happy to reach a new major milestone soon!
|
||||
|
||||
|
@ -1130,7 +1130,7 @@ font_grey <- function(..., collapse = " ") {
|
||||
try_colour(..., before = "\033[38;5;249m", after = "\033[39m", collapse = collapse)
|
||||
}
|
||||
font_grey_bg <- function(..., collapse = " ") {
|
||||
if (tryCatch(import_fn("getThemeInfo", "rstudioapi", error_on_fail = FALSE)()$dark, error = function(e) FALSE)) {
|
||||
if (is_dark()) {
|
||||
# similar to HTML #444444
|
||||
try_colour(..., before = "\033[48;5;238m", after = "\033[49m", collapse = collapse)
|
||||
} else {
|
||||
@ -1360,20 +1360,11 @@ percentage <- function(x, digits = NULL, ...) {
|
||||
)
|
||||
}
|
||||
|
||||
time_start_tracking <- function() {
|
||||
AMR_env$time_start <- round(as.double(Sys.time()) * 1000)
|
||||
}
|
||||
|
||||
time_track <- function(name = NULL) {
|
||||
paste("(until now:", trimws(round(as.double(Sys.time()) * 1000) - AMR_env$time_start), "ms)")
|
||||
}
|
||||
|
||||
trimws2 <- function(..., whitespace = "[\u0009\u000A\u000B\u000C\u000D\u0020\u0085\u00A0\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u200C\u200D\u2028\u2029\u202F\u205F\u2060\u3000\uFEFF]") {
|
||||
# this is even faster than trimws() itself which sets " \t\n\r".
|
||||
trimws(..., whitespace = whitespace)
|
||||
}
|
||||
|
||||
|
||||
# Faster data.table implementations ----
|
||||
|
||||
match <- function(x, table, ...) {
|
||||
|
3
R/ab.R
3
R/ab.R
@ -498,6 +498,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
data.frame(
|
||||
x = x,
|
||||
ab = x_new,
|
||||
x_bak = x_bak[match(x, x_bak_clean)],
|
||||
stringsAsFactors = FALSE
|
||||
),
|
||||
stringsAsFactors = FALSE
|
||||
@ -513,7 +514,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
}
|
||||
x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs]
|
||||
x_unknown <- c(x_unknown,
|
||||
AMR_env$ab_previously_coerced$x[which(AMR_env$ab_previously_coerced$x %in% x & is.na(AMR_env$ab_previously_coerced$ab))])
|
||||
AMR_env$ab_previously_coerced$x_bak[which(AMR_env$ab_previously_coerced$x %in% x & is.na(AMR_env$ab_previously_coerced$ab))])
|
||||
if (length(x_unknown) > 0 && fast_mode == FALSE) {
|
||||
warning_(
|
||||
"in `as.ab()`: these values could not be coerced to a valid antimicrobial ID: ",
|
||||
|
67
R/rsi.R
67
R/rsi.R
@ -629,7 +629,7 @@ as.rsi.data.frame <- function(x,
|
||||
}
|
||||
x[, ab_cols[i]] <- as.rsi.default(x = as.character(x[, ab_cols[i], drop = TRUE]))
|
||||
if (show_message == TRUE) {
|
||||
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
|
||||
message_(" OK.", add_fn = list(font_green), as_note = FALSE)
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -790,6 +790,7 @@ as_rsi_method <- function(method_short,
|
||||
}
|
||||
|
||||
rise_warning <- FALSE
|
||||
rise_note <- FALSE
|
||||
method_param <- toupper(method)
|
||||
|
||||
genera <- mo_genus(mo, language = NULL)
|
||||
@ -828,7 +829,7 @@ as_rsi_method <- function(method_short,
|
||||
}
|
||||
|
||||
if (nrow(trans) == 0) {
|
||||
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
|
||||
message_(" OK.", add_fn = list(font_green), as_note = FALSE)
|
||||
load_mo_uncertainties(metadata_mo)
|
||||
return(set_clean_class(factor(new_rsi, levels = c("S", "I", "R"), ordered = TRUE),
|
||||
new_class = c("rsi", "ordered", "factor")
|
||||
@ -875,14 +876,18 @@ as_rsi_method <- function(method_short,
|
||||
))
|
||||
|
||||
if (NROW(get_record) == 0) {
|
||||
warning_(
|
||||
"No ", method_param, " breakpoints available for ",
|
||||
font_italic(suppressMessages(suppressWarnings(mo_shortname(mo[i], language = NULL, keep_synonyms = FALSE)))),
|
||||
paste0(" / "),
|
||||
if (mo_rank(mo[i]) %in% c("kingdom", "phylum", "class", "order")) {
|
||||
mo_formatted <- suppressMessages(suppressWarnings(mo_shortname(mo[i], language = NULL, keep_synonyms = FALSE)))
|
||||
} else {
|
||||
mo_formatted <- font_italic(suppressMessages(suppressWarnings(mo_shortname(mo[i], language = NULL, keep_synonyms = FALSE))))
|
||||
}
|
||||
message_(font_green(font_bold(" NOTE.\n")),
|
||||
font_black("No ", method_param, " breakpoints available for ", mo_formatted,
|
||||
" / ",
|
||||
suppressMessages(suppressWarnings(ab_name(ab_param, language = NULL, tolower = TRUE))),
|
||||
" (", ab_param, ")"
|
||||
" (", ab_param, ")", collapse = NULL)
|
||||
)
|
||||
rise_warning <- TRUE
|
||||
rise_note <- TRUE
|
||||
next
|
||||
}
|
||||
|
||||
@ -905,13 +910,19 @@ as_rsi_method <- function(method_short,
|
||||
rise_warning <- TRUE
|
||||
} else if (nrow(records_same_mo) > 1 && length(unique(records_same_mo$site)) > 1 && is.na(uti[i]) && all(c(TRUE, FALSE) %in% records_same_mo$uti, na.rm = TRUE) && message_not_thrown_before("as.rsi", "siteUTI", records_same_mo$mo[1], ab_param)) {
|
||||
# uti not set and both UTI and non-UTI breakpoints available, so throw warning
|
||||
warning_("in `as.rsi()`: breakpoints for UTI ", font_underline("and"), " non-UTI available for ",
|
||||
font_italic(suppressMessages(suppressWarnings(mo_shortname(records_same_mo$mo[1], language = NULL, keep_synonyms = FALSE)))),
|
||||
if (mo_rank(mo[i]) %in% c("kingdom", "phylum", "class", "order")) {
|
||||
mo_formatted <- suppressMessages(suppressWarnings(mo_shortname(mo[i], language = NULL, keep_synonyms = FALSE)))
|
||||
} else {
|
||||
mo_formatted <- font_italic(suppressMessages(suppressWarnings(mo_shortname(mo[i], language = NULL, keep_synonyms = FALSE))))
|
||||
}
|
||||
message_(font_green(font_bold(" NOTE.\n")),
|
||||
font_black("Breakpoints for UTI ", font_underline("and"), " non-UTI available for ", mo_formatted,
|
||||
" / ",
|
||||
suppressMessages(suppressWarnings(ab_name(ab_param, language = NULL, tolower = TRUE))),
|
||||
" (", ab_param, ") - assuming non-UTI. Use argument `uti` to set which isolates are from urine. See ?as.rsi.",
|
||||
call = FALSE
|
||||
" (", ab_param, ") - assuming non-UTI. Use argument `uti` to set which isolates are from urine. See ?as.rsi.", collapse = NULL),
|
||||
as_note = FALSE
|
||||
)
|
||||
rise_note <- TRUE
|
||||
get_record <- get_record %pm>%
|
||||
pm_filter(uti == FALSE)
|
||||
rise_warning <- TRUE
|
||||
@ -923,14 +934,19 @@ as_rsi_method <- function(method_short,
|
||||
} else {
|
||||
site <- paste0("body site '", get_record[1L, "site", drop = FALSE], "'")
|
||||
}
|
||||
warning_("in `as.rsi()`: breakpoints available for ",
|
||||
font_italic(suppressMessages(suppressWarnings(mo_shortname(records_same_mo$mo[1], language = NULL, keep_synonyms = FALSE)))),
|
||||
paste0(" / "),
|
||||
if (mo_rank(mo[i]) %in% c("kingdom", "phylum", "class", "order")) {
|
||||
mo_formatted <- suppressMessages(suppressWarnings(mo_shortname(mo[i], language = NULL, keep_synonyms = FALSE)))
|
||||
} else {
|
||||
mo_formatted <- font_italic(suppressMessages(suppressWarnings(mo_shortname(mo[i], language = NULL, keep_synonyms = FALSE))))
|
||||
}
|
||||
message_(font_green(font_bold(" NOTE.\n")),
|
||||
font_black("Breakpoints available for ", mo_formatted,
|
||||
" / ",
|
||||
suppressMessages(suppressWarnings(ab_name(records_same_mo$ab[1], language = NULL, tolower = TRUE))),
|
||||
paste0(" - assuming ", site),
|
||||
call = FALSE
|
||||
paste0(" - assuming ", site), collapse = NULL),
|
||||
as_note = FALSE
|
||||
)
|
||||
rise_warning <- TRUE
|
||||
rise_note <- TRUE
|
||||
}
|
||||
|
||||
if (NROW(get_record) > 0) {
|
||||
@ -1002,13 +1018,16 @@ as_rsi_method <- function(method_short,
|
||||
by = "x_mo"
|
||||
) %pm>%
|
||||
pm_pull(new_rsi)
|
||||
|
||||
if (isTRUE(rise_warning)) {
|
||||
message_("WARNING.", add_fn = list(font_yellow, font_bold), as_note = FALSE)
|
||||
} else {
|
||||
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
|
||||
|
||||
if (!isTRUE(rise_note)) {
|
||||
# notes already a have green "NOTE" text by this point
|
||||
if (isTRUE(rise_warning)) {
|
||||
message_(" WARNING.", add_fn = list(font_yellow, font_bold), as_note = FALSE)
|
||||
} else {
|
||||
message_(" OK.", add_fn = list(font_green), as_note = FALSE)
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
load_mo_uncertainties(metadata_mo)
|
||||
|
||||
set_clean_class(factor(new_rsi, levels = c("S", "I", "R"), ordered = TRUE),
|
||||
|
@ -28,7 +28,7 @@
|
||||
# ==================================================================== #
|
||||
|
||||
# extra tests for {vctrs} pkg support
|
||||
if (pkg_is_available("dplyr", also_load = FALSE)) {
|
||||
if (AMR:::pkg_is_available("dplyr", also_load = FALSE)) {
|
||||
test <- dplyr::tibble(ab = as.ab("CIP"),
|
||||
mo = as.mo("Escherichia coli"),
|
||||
mic = as.mic(2),
|
||||
|
@ -30,10 +30,11 @@
|
||||
# we use {tinytest} instead of {testthat} because it does not rely on recent R versions - we want to test on R >= 3.0.
|
||||
|
||||
# Run them in RStudio using:
|
||||
# rstudioapi::jobRunScript("tests/tinytest.R", name = "Tinytest Unit Tests", workingDir = getwd(), exportEnv = "tinytest_results")
|
||||
# rstudioapi::jobRunScript("tests/tinytest.R", name = "AMR Unit Tests", workingDir = getwd(), exportEnv = "tinytest_results")
|
||||
|
||||
# test only on GitHub Actions and at home - not on CRAN as tests are lengthy
|
||||
if (identical(Sys.getenv("R_RUN_TINYTEST"), "true")) {
|
||||
# test only on GitHub Actions and at using RStudio jobs - not on CRAN as tests are lengthy
|
||||
if (tryCatch(isTRUE(AMR:::import_fn("isJob", "rstudioapi")()), error = function(e) FALSE) ||
|
||||
identical(Sys.getenv("R_RUN_TINYTEST"), "true")) {
|
||||
# env var 'R_LIBS_USER' got overwritten during 'R CMD check' in GitHub Actions, so:
|
||||
.libPaths(c(Sys.getenv("R_LIBS_USER_GH_ACTIONS"), .libPaths()))
|
||||
if (AMR:::pkg_is_available("tinytest", also_load = TRUE)) {
|
||||
|
Loading…
Reference in New Issue
Block a user