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

(v1.4.0.9030) as.mo() fix for known lab codes

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2020-12-03 16:59:04 +01:00
parent 4c114ff4b4
commit e03b3c96d3
40 changed files with 136 additions and 124 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
R/aa_helper_functions.R
View File

@ -146,7 +146,7 @@ search_type_in_df <- function(x, type, info = TRUE) {
# WHONET support
found <- sort(colnames(x)[colnames(x) %like% "^(specimen date|specimen_date|spec_date)"])[1]
if (!any(class(pm_pull(x, found)) %in% c("Date", "POSIXct"))) {
stop(font_red(paste0("ERROR: Found column `", font_bold(found), "` to be used as input for `col_", type,
stop(font_red(paste0("Found column '", font_bold(found), "' to be used as input for `col_", type,
"`, but this column contains no valid dates. Transform its values to valid dates first.")),
call. = FALSE)
}
@ -178,7 +178,7 @@ 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_("Column `", font_bold(found), "` found as input for `col_", type,
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
@ -187,7 +187,7 @@ search_type_in_df <- function(x, type, info = TRUE) {
}
if (!is.null(found) & info == TRUE) {
msg <- paste0("Using column `", font_bold(found), "` as input for `col_", type, "`.")
msg <- paste0("Using column '", 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.")
}

2
R/eucast_rules.R
View File

@ -454,7 +454,7 @@ eucast_rules <- function(x,
if (ab_missing(AMP) & !ab_missing(AMX)) {
# ampicillin column is missing, but amoxicillin is available
if (info == TRUE) {
message_("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
}

2
R/first_isolate.R
View File

@ -209,7 +209,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_("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")
}

18
R/guess_ab_col.R
View File

@ -44,7 +44,7 @@
#' # [1] "tetr"
#'
#' guess_ab_col(df, "J01AA07", verbose = TRUE)
#' # NOTE: Using column `tetr` as input for `J01AA07` (tetracycline).
#' # NOTE: Using column 'tetr' as input for J01AA07 (tetracycline).
#' # [1] "tetr"
#'
#' # WHONET codes
@ -94,16 +94,16 @@ guess_ab_col <- function(x = NULL, search_string = NULL, verbose = FALSE) {
if (length(ab_result) == 0) {
if (verbose == TRUE) {
message_("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_("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)
}
@ -204,12 +204,12 @@ get_column_abx <- function(x,
for (i in seq_len(length(x))) {
if (info == TRUE & verbose == TRUE & !names(x[i]) %in% names(duplicates)) {
message_("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_(paste0("Using column `", font_bold(x[i]), "` as input for `", names(x)[i],
"` (", ab_name(names(x)[i], tolower = TRUE, language = NULL),
warning_(paste0("Using column '", font_bold(x[i]), "' as input for ", names(x)[i],
" (", ab_name(names(x)[i], tolower = TRUE, language = NULL),
"), although it was matched for multiple antibiotics or columns."),
add_fn = font_red,
call = FALSE,

58
R/mo.R
View File

@ -636,9 +636,7 @@ exec_as.mo <- function(x,
}
# WHONET and other common LIS codes ----
found <- lookup(code %in% toupper(c(x_backup_untouched[i], x_backup[i], x_backup_without_spp[i])),
column = "mo",
haystack = microorganisms.codes)
found <- microorganisms.codes[which(microorganisms.codes$code %in% toupper(c(x_backup_untouched[i], x_backup[i], x_backup_without_spp[i]))), "mo", drop = TRUE][1L]
if (!is.na(found)) {
x[i] <- lookup(mo == found)
next
@ -893,10 +891,12 @@ exec_as.mo <- function(x,
}
# try any match keeping spaces ----
found <- lookup(fullname_lower %like_case% d.x_withspaces_start_end,
haystack = data_to_check)
if (!is.na(found) & nchar(g.x_backup_without_spp) >= 6) {
return(found[1L])
if (nchar(g.x_backup_without_spp) >= 6) {
found <- lookup(fullname_lower %like_case% d.x_withspaces_start_end,
haystack = data_to_check)
if (!is.na(found)) {
return(found[1L])
}
}
# try any match keeping spaces, not ending with $ ----
@ -905,10 +905,12 @@ exec_as.mo <- function(x,
if (!is.na(found)) {
return(found[1L])
}
found <- lookup(fullname_lower %like_case% e.x_withspaces_start_only,
haystack = data_to_check)
if (!is.na(found) & nchar(g.x_backup_without_spp) >= 6) {
return(found[1L])
if (nchar(g.x_backup_without_spp) >= 6) {
found <- lookup(fullname_lower %like_case% e.x_withspaces_start_only,
haystack = data_to_check)
if (!is.na(found)) {
return(found[1L])
}
}
# try any match keeping spaces, not start with ^ ----
@ -919,14 +921,16 @@ exec_as.mo <- function(x,
}
# try a trimmed version
found <- lookup(fullname_lower %like_case% b.x_trimmed |
fullname_lower %like_case% c.x_trimmed_without_group,
haystack = data_to_check)
if (!is.na(found) & nchar(g.x_backup_without_spp) >= 6) {
return(found[1L])
if (nchar(g.x_backup_without_spp) >= 6) {
found <- lookup(fullname_lower %like_case% b.x_trimmed |
fullname_lower %like_case% c.x_trimmed_without_group,
haystack = data_to_check)
if (!is.na(found)) {
return(found[1L])
}
}
# try splitting of characters in the middle and then find ID ----
# only when text length is 6 or lower
# like esco = E. coli, klpn = K. pneumoniae, stau = S. aureus, staaur = S. aureus
@ -1313,14 +1317,16 @@ exec_as.mo <- function(x,
if (isTRUE(debug)) {
message("Running '", f.x_withspaces_end_only, "'")
}
found <- lookup(fullname_lower %like_case% f.x_withspaces_end_only, column = "mo")
if (!is.na(found) & nchar(g.x_backup_without_spp) >= 6) {
found_result <- lookup(mo == found)
uncertainties <<- rbind(uncertainties,
attr(found, which = "uncertainties", exact = TRUE),
stringsAsFactors = FALSE)
found <- lookup(mo == found)
return(found)
if (nchar(g.x_backup_without_spp) >= 6) {
found <- lookup(fullname_lower %like_case% f.x_withspaces_end_only, column = "mo")
if (!is.na(found)) {
found_result <- lookup(mo == found)
uncertainties <<- rbind(uncertainties,
attr(found, which = "uncertainties", exact = TRUE),
stringsAsFactors = FALSE)
found <- lookup(mo == found)
return(found)
}
}
}

9
R/mo_property.R
View File

@ -383,9 +383,10 @@ mo_is_intrinsic_resistant <- function(x, ab, language = get_locale(), ...) {
ab <- rep(ab, length(x))
}
if (length(x) != length(ab)) {
stop_("length of 'x' and 'ab' must be equal, or one of them must be of length 1.")
stop_("length of `x` and `ab` must be equal, or one of them must be of length 1.")
}
# this saves about 50% in calculation time
intrinsic_to_check <- intrinsic_resistant[which(intrinsic_resistant$microorganism %in% x |
intrinsic_resistant$antibiotic %in% ab), , drop = FALSE]
paste(x, ab) %in% paste(intrinsic_to_check$microorganism, intrinsic_to_check$antibiotic)
@ -618,12 +619,12 @@ find_mo_col <- function(fn) {
mo <- suppressMessages(search_type_in_df(df, "mo"))
}, silent = TRUE)
if (!is.null(df) && !is.null(mo) && is.data.frame(df)) {
message_("Using column `", font_bold(mo), "` as input for ", fn, "()")
message_("Using column '", font_bold(mo), "' as input for ", fn, "()")
return(df[, mo, drop = TRUE])
} else {
stop_("Argument 'x' is missing and no column with info about microorganisms could be found.", call = -2)
stop_("Argument `x` is missing and no column with info about microorganisms could be found.", call = -2)
}
} else {
stop_("Argument 'x' is missing.", call = -2)
stop_("Argument `x` is missing.", call = -2)
}
}

4
R/rsi.R
View File

@ -1087,11 +1087,11 @@ check_reference_data <- function(reference_data) {
class_rsi <- sapply(rsi_translation, function(x) paste0("<", class(x), ">", collapse = " and "))
class_ref <- sapply(reference_data, function(x) paste0("<", class(x), ">", collapse = " and "))
if (!all(names(class_rsi) == names(class_ref))) {
stop_("'reference_data' must have the same column names as the 'rsi_translation' data set.", call = -2)
stop_("`reference_data` must have the same column names as the 'rsi_translation' data set.", call = -2)
}
if (!all(class_rsi == class_ref)) {
class_rsi[class_rsi != class_ref][1]
stop_("'reference_data' must be the same structure as the 'rsi_translation' data set. Column '", names(class_ref[class_rsi != class_ref][1]), "' is of class ", class_ref[class_rsi != class_ref][1], ", but should be of class ", class_rsi[class_rsi != class_ref][1], ".", call = -2)
stop_("`reference_data` must be the same structure as the 'rsi_translation' data set. Column '", names(class_ref[class_rsi != class_ref][1]), "' is of class ", class_ref[class_rsi != class_ref][1], ", but should be of class ", class_rsi[class_rsi != class_ref][1], ".", call = -2)
}
}
}