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

(v0.7.1.9074) CI updates

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2019-09-16 12:00:56 +02:00
parent 398c5bdc4f
commit f553a08a7b
19 changed files with 322 additions and 173 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
R/globals.R
View File

@ -68,6 +68,7 @@ globalVariables(c(".",
"observed",
"old",
"other_pat_or_mo",
"package_version",
"patient_id",
"pattern",
"plural",
@ -88,7 +89,9 @@ globalVariables(c(".",
"synonyms",
"total",
"txt",
"uncertainty_level",
"value",
"x",
"xdr",
"y",
"year"))

15
R/mo.R
View File

@ -258,7 +258,7 @@ as.mo <- function(x, Becker = FALSE, Lancefield = FALSE, allow_uncertain = TRUE,
y <- mo_validate(x = x, property = "mo",
Becker = Becker, Lancefield = Lancefield,
allow_uncertain = uncertainty_level, reference_df = reference_df,
force_mo_history = isTRUE(list(...)$force_mo_history),
#force_mo_history = isTRUE(list(...)$force_mo_history),
...)
}
@ -675,14 +675,16 @@ exec_as.mo <- function(x,
# translate known trivial abbreviations to genus + species ----
if (!is.na(x_trimmed[i])) {
if (toupper(x_backup_without_spp[i]) %in% c('MRSA', 'MSSA', 'VISA', 'VRSA')) {
if (toupper(x_backup_without_spp[i]) %in% c('MRSA', 'MSSA', 'VISA', 'VRSA')
| x_backup_without_spp[i] %like_case% " (mrsa|mssa|visa|vrsa) ") {
x[i] <- microorganismsDT[mo == 'B_STPHY_AUR', ..property][[1]][1L]
if (initial_search == TRUE) {
set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
}
next
}
if (toupper(x_backup_without_spp[i]) %in% c('MRSE', 'MSSE')) {
if (toupper(x_backup_without_spp[i]) %in% c('MRSE', 'MSSE')
| x_backup_without_spp[i] %like_case% " (mrse|msse) ") {
x[i] <- microorganismsDT[mo == 'B_STPHY_EPI', ..property][[1]][1L]
if (initial_search == TRUE) {
set_mo_history(x_backup[i], get_mo_code(x[i], property), 0, force = force_mo_history, disable = disable_mo_history)
@ -690,6 +692,7 @@ exec_as.mo <- function(x,
next
}
if (toupper(x_backup_without_spp[i]) == "VRE"
| x_backup_without_spp[i] %like_case% " vre "
| x_backup_without_spp[i] %like_case% '(enterococci|enterokok|enterococo)[a-z]*?$') {
x[i] <- microorganismsDT[mo == 'B_ENTRC', ..property][[1]][1L]
if (initial_search == TRUE) {
@ -718,7 +721,8 @@ exec_as.mo <- function(x,
}
next
}
if (toupper(x_backup_without_spp[i]) == 'MRPA') {
if (toupper(x_backup_without_spp[i]) == 'MRPA'
| x_backup_without_spp[i] %like_case% " mrpa ") {
# multi resistant P. aeruginosa
x[i] <- microorganismsDT[mo == 'B_PSDMN_AER', ..property][[1]][1L]
if (initial_search == TRUE) {
@ -735,7 +739,8 @@ exec_as.mo <- function(x,
}
next
}
if (toupper(x_backup_without_spp[i]) %in% c('PISP', 'PRSP', 'VISP', 'VRSP')) {
if (toupper(x_backup_without_spp[i]) %in% c('PISP', 'PRSP', 'VISP', 'VRSP')
| x_backup_without_spp[i] %like_case% " (pisp|prsp|visp|vrsp) ") {
# peni I, peni R, vanco I, vanco R: S. pneumoniae
x[i] <- microorganismsDT[mo == 'B_STRPT_PNE', ..property][[1]][1L]
if (initial_search == TRUE) {

60
R/mo_history.R
View File

@ -19,10 +19,9 @@
# Visit our website for more info: https://msberends.gitlab.io/AMR. #
# ==================================================================== #
mo_history_file <- file.path(file.path(system.file(package = "AMR"), "mo_history"), "mo_history.csv")
# print successful as.mo coercions to a options entry
#' @importFrom dplyr %>% distinct filter
#' @importFrom utils write.csv
set_mo_history <- function(x, mo, uncertainty_level, force = FALSE, disable = FALSE) {
if (isTRUE(disable)) {
return(base::invisible())
@ -42,14 +41,14 @@ set_mo_history <- function(x, mo, uncertainty_level, force = FALSE, disable = FA
# save package version too, as both the as.mo() algorithm and the reference data set may change
if (NROW(mo_hist[base::which(mo_hist$x == x[i] &
mo_hist$uncertainty_level >= uncertainty_level &
mo_hist$package_v == utils::packageVersion("AMR")),]) == 0) {
mo_hist$package_version == utils::packageVersion("AMR")),]) == 0) {
# # Not using the file system:
# tryCatch(options(mo_remembered_results = rbind(mo_hist,
# data.frame(
# x = x[i],
# mo = mo[i],
# uncertainty_level = uncertainty_level,
# package_v = base::as.character(utils::packageVersion("AMR")),
# package_version = base::as.character(utils::packageVersion("AMR")),
# stringsAsFactors = FALSE))),
# error = function(e) base::invisible())
# # don't remember more than 1,000 different input values
@ -57,16 +56,17 @@ set_mo_history <- function(x, mo, uncertainty_level, force = FALSE, disable = FA
# return(base::invisible())
# }
if (is.null(mo_hist)) {
message(blue(paste0("NOTE: results are saved to ", mo_history_file, ".")))
message(blue(paste0("NOTE: results are saved to ", mo_history_file(), ".")))
}
tryCatch(write.csv(rbind(mo_hist,
data.frame(
x = x[i],
mo = mo[i],
uncertainty_level = uncertainty_level,
package_v = base::as.character(utils::packageVersion("AMR")),
package_version = base::as.character(utils::packageVersion("AMR")),
stringsAsFactors = FALSE)),
file = mo_history_file, row.names = FALSE),
row.names = FALSE,
file = mo_history_file()),
error = function(e) base::invisible())
}
}
@ -91,6 +91,7 @@ get_mo_history <- function(x, uncertainty_level, force = FALSE, disable = FALSE)
}
#' @importFrom dplyr %>% filter distinct
#' @importFrom utils read.csv
read_mo_history <- function(uncertainty_level = 2, force = FALSE, unfiltered = FALSE, disable = FALSE) {
if (isTRUE(disable)) {
return(NULL)
@ -104,7 +105,7 @@ read_mo_history <- function(uncertainty_level = 2, force = FALSE, unfiltered = F
# # Not using the file system:
# history <- tryCatch(getOption("mo_remembered_results"),
# error = function(e) NULL)
history <- tryCatch(read.csv(mo_history_file, stringsAsFactors = FALSE),
history <- tryCatch(read.csv(mo_history_file(), stringsAsFactors = FALSE),
warning = function(w) invisible(),
error = function(e) NULL)
if (is.null(history)) {
@ -116,7 +117,7 @@ read_mo_history <- function(uncertainty_level = 2, force = FALSE, unfiltered = F
if (unfiltered == FALSE) {
history <- history %>%
filter(package_v == as.character(utils::packageVersion("AMR")),
filter(package_version == as.character(utils::packageVersion("AMR")),
# only take unknowns if uncertainty_level_param is higher
((mo == "UNKNOWN" & uncertainty_level_param == uncertainty_level) |
(mo != "UNKNOWN" & uncertainty_level_param >= uncertainty_level))) %>%
@ -152,19 +153,54 @@ clear_mo_history <- function(...) {
# error = function(e) FALSE)
success <- create_blank_mo_history()
if (!isFALSE(success)) {
cat(red(paste("File", mo_history_file, "cleared.")))
cat(red(paste("File", mo_history_file(), "cleared.")))
}
}
}
#' @importFrom utils write.csv
create_blank_mo_history <- function() {
tryCatch(
write.csv(x = data.frame(x = character(0),
mo = character(0),
uncertainty_level = integer(0),
package_v = character(0),
package_version = character(0),
stringsAsFactors = FALSE),
file = mo_history_file),
row.names = FALSE,
file = mo_history_file()),
warning = function(w) invisible(),
error = function(e) TRUE)
}
# Borrowed all below code from the extrafont package,
# https://github.com/wch/extrafont/blob/254c3f99b02f11adb59affbda699a92aec8624f5/R/utils.r
inst_path <- function() {
envname <- environmentName(parent.env(environment()))
# If installed in package, envname == "AMR"
# If loaded with load_all, envname == "package:AMR"
# (This is kind of strange)
if (envname == "AMR") {
system.file(package = "AMR")
} else {
srcfile <- attr(attr(inst_path, "srcref"), "srcfile")
file.path(dirname(dirname(srcfile$filename)), "inst")
}
}
# Get the path where extrafontdb is installed
db_path <- function() {
system.file(package = "AMR")
}
# fonttable file
mo_history_file <- function() {
file.path(mo_history_path(), "mo_history.csv")
}
# Path of fontmap directory
mo_history_path <- function() {
file.path(db_path(), "mo_history")
}