P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-01-13 20:11:37 +01:00
Code Releases Activity

fix for mo codes

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2023-06-22 15:24:18 +02:00
parent f065945d7b
commit 1d9ee39cc7
4 changed files with 11 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
DESCRIPTION
View File

@ -1,5 +1,5 @@
Package: AMR Package: AMR
Version: 2.0.0.9024 Version: 2.0.0.9025
Date: 2023-06-22 Date: 2023-06-22
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)

2
NEWS.md
View File

@ -1,4 +1,4 @@
# AMR 2.0.0.9024 # AMR 2.0.0.9025
## New ## New
* Clinical breakpoints and intrinsic resistance of EUCAST 2023 and CLSI 2023 have been added for `as.sir()`. EUCAST 2023 (v13.0) is now the new default guideline for all MIC and disks diffusion interpretations, and for `eucast_rules()` to apply EUCAST Expert Rules. * Clinical breakpoints and intrinsic resistance of EUCAST 2023 and CLSI 2023 have been added for `as.sir()`. EUCAST 2023 (v13.0) is now the new default guideline for all MIC and disks diffusion interpretations, and for `eucast_rules()` to apply EUCAST Expert Rules.

4
R/aa_helper_functions.R
View File

@ -1517,6 +1517,10 @@ trimws2 <- function(..., whitespace = "[\u0009\u000A\u000B\u000C\u000D\u0020\u00
trimws(..., whitespace = whitespace) trimws(..., whitespace = whitespace)
} }
totitle <- function(x) {
gsub("^(.)", "\\U\\1", x, perl = TRUE)
}
readRDS_AMR <- function(file, refhook = NULL) { readRDS_AMR <- function(file, refhook = NULL) {
# this is readRDS with remote file support # this is readRDS with remote file support
con <- file(file) con <- file(file)

9
R/mo.R
View File

@ -302,17 +302,17 @@ as.mo <- function(x,
filtr <- which(AMR_env$MO_lookup$full_first %like_case% first_chars) filtr <- which(AMR_env$MO_lookup$full_first %like_case% first_chars)
} else if (nchar(x_out) == 3) { } else if (nchar(x_out) == 3) {
# no space and 3 characters - probably a code such as SAU or ECO # no space and 3 characters - probably a code such as SAU or ECO
msg <<- c(msg, paste0("Input \"", x_search, "\" was assumed to be a microorganism code - tried to match on \"", substr(x_out, 1, 1), AMR_env$dots, " ", substr(x_out, 2, 3), AMR_env$dots, "\"")) msg <<- c(msg, paste0("Input \"", x_search, "\" was assumed to be a microorganism code - tried to match on \"", totitle(substr(x_out, 1, 1)), AMR_env$dots, " ", substr(x_out, 2, 3), AMR_env$dots, "\""))
filtr <- which(AMR_env$MO_lookup$fullname_lower %like_case% paste0("(^| )", substr(x_out, 1, 1), ".* ", substr(x_out, 2, 3))) filtr <- which(AMR_env$MO_lookup$fullname_lower %like_case% paste0("(^| )", substr(x_out, 1, 1), ".* ", substr(x_out, 2, 3)))
} else if (nchar(x_out) == 4) { } else if (nchar(x_out) == 4) {
# no space and 4 characters - probably a code such as STAU or ESCO # no space and 4 characters - probably a code such as STAU or ESCO
msg <<- c(msg, paste0("Input \"", x_search, "\" was assumed to be a microorganism code - tried to match on \"", substr(x_out, 1, 2), AMR_env$dots, " ", substr(x_out, 3, 4), AMR_env$dots, "\"")) msg <<- c(msg, paste0("Input \"", x_search, "\" was assumed to be a microorganism code - tried to match on \"", totitle(substr(x_out, 1, 2)), AMR_env$dots, " ", substr(x_out, 3, 4), AMR_env$dots, "\""))
filtr <- which(AMR_env$MO_lookup$fullname_lower %like_case% paste0("(^| )", substr(x_out, 1, 2), ".* ", substr(x_out, 3, 4))) filtr <- which(AMR_env$MO_lookup$fullname_lower %like_case% paste0("(^| )", substr(x_out, 1, 2), ".* ", substr(x_out, 3, 4)))
} else if (nchar(x_out) <= 6) { } else if (nchar(x_out) <= 6) {
# no space and 5-6 characters - probably a code such as STAAUR or ESCCOL # no space and 5-6 characters - probably a code such as STAAUR or ESCCOL
first_part <- paste0(substr(x_out, 1, 2), "[a-z]*", substr(x_out, 3, 3)) first_part <- paste0(substr(x_out, 1, 2), "[a-z]*", substr(x_out, 3, 3))
second_part <- substr(x_out, 4, nchar(x_out)) second_part <- substr(x_out, 4, nchar(x_out))
msg <<- c(msg, paste0("Input \"", x_search, "\" was assumed to be a microorganism code - tried to match on \"", gsub("[a-z]*", AMR_env$dots, first_part, fixed = TRUE), " ", second_part, AMR_env$dots, "\"")) msg <<- c(msg, paste0("Input \"", x_search, "\" was assumed to be a microorganism code - tried to match on \"", gsub("[a-z]*", AMR_env$dots, totitle(first_part), fixed = TRUE), " ", second_part, AMR_env$dots, "\""))
filtr <- which(AMR_env$MO_lookup$fullname_lower %like_case% paste0("(^| )", first_part, ".* ", second_part)) filtr <- which(AMR_env$MO_lookup$fullname_lower %like_case% paste0("(^| )", first_part, ".* ", second_part))
} else { } else {
# for genus or species or subspecies # for genus or species or subspecies
@ -336,9 +336,10 @@ as.mo <- function(x,
# correct back for kingdom # correct back for kingdom
minimum_matching_score_current <- minimum_matching_score_current / AMR_env$MO_lookup$kingdom_index[match(mo_to_search, AMR_env$MO_lookup$fullname)] minimum_matching_score_current <- minimum_matching_score_current / AMR_env$MO_lookup$kingdom_index[match(mo_to_search, AMR_env$MO_lookup$fullname)]
minimum_matching_score_current <- pmax(minimum_matching_score_current, m) minimum_matching_score_current <- pmax(minimum_matching_score_current, m)
if (length(m) > 1 && all(m <= 0.55, na.rm = TRUE)) { if (length(x_parts) > 1 && all(m <= 0.55, na.rm = TRUE)) {
# if the highest score is 0.5, we have nothing serious - 0.5 is the lowest for pathogenic group 1 # if the highest score is 0.5, we have nothing serious - 0.5 is the lowest for pathogenic group 1
# make everything NA so the results will get removed below # make everything NA so the results will get removed below
# (we added length(x_parts) > 1 to exclude microbial codes from this rule, such as "STAU")
m[seq_len(length(m))] <- NA_real_ m[seq_len(length(m))] <- NA_real_
} }
} else { } else {