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

reorganised notes and warnings

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2018-12-14 10:52:20 +01:00
parent dec4947103
commit 857f565db0
2 changed files with 75 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
NEWS.md
View File

@ -12,6 +12,7 @@
* There will be looked for uncertain results at default - these results will be returned with an informative warning * There will be looked for uncertain results at default - these results will be returned with an informative warning
* Manual now contains more info about the algorithms * Manual now contains more info about the algorithms
* Progress bar will be shown when it takes more than 3 seconds to get results * Progress bar will be shown when it takes more than 3 seconds to get results
* Support for formatted console text
* Function `first_isolate`: * Function `first_isolate`:
* Will now use a column named like "patid" for the patient ID (parameter `col_patientid`), when this parameter was left blank * Will now use a column named like "patid" for the patient ID (parameter `col_patientid`), when this parameter was left blank
* Will now use a column named like "key(...)ab" or "key(...)antibiotics" for the key antibiotics (parameter `col_keyantibiotics`), when this parameter was left blank * Will now use a column named like "key(...)ab" or "key(...)antibiotics" for the key antibiotics (parameter `col_keyantibiotics`), when this parameter was left blank

69
R/mo.R
View File

@ -204,6 +204,7 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE,
} }
} }
notes <- character(0)
failures <- character(0) failures <- character(0)
x_input <- x x_input <- x
# only check the uniques, which is way faster # only check the uniques, which is way faster
@ -393,7 +394,11 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE,
if (grepl("[sS]almonella [A-Z][a-z]+ ?.*", x_trimmed[i])) { if (grepl("[sS]almonella [A-Z][a-z]+ ?.*", x_trimmed[i])) {
# Salmonella with capital letter species like "Salmonella Goettingen" - they're all S. enterica # Salmonella with capital letter species like "Salmonella Goettingen" - they're all S. enterica
x[i] <- microorganismsDT[mo == 'B_SLMNL_ENT', ..property][[1]][1L] x[i] <- microorganismsDT[mo == 'B_SLMNL_ENT', ..property][[1]][1L]
base::message(magenta(paste0("Note: ", italic(x_trimmed[i]), " will be considered a subspecies of ", italic("Salmonella enterica"), " (B_SLMNL_ENT)"))) notes <- c(notes,
magenta(paste0("Note: ", italic(x_trimmed[i]),
" was considered (a subspecies of) ",
italic("Salmonella enterica"),
" (B_SLMNL_ENT)")))
next next
} }
} }
@ -605,60 +610,60 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE,
} else { } else {
x[i] <- microorganismsDT[tsn == found[1, tsn_new], ..property][[1]] x[i] <- microorganismsDT[tsn == found[1, tsn_new], ..property][[1]]
} }
notes <- c(notes,
renamed_note(name_old = found[1, name], renamed_note(name_old = found[1, name],
name_new = microorganismsDT[tsn == found[1, tsn_new], fullname], name_new = microorganismsDT[tsn == found[1, tsn_new], fullname],
ref_old = found[1, ref], ref_old = found[1, ref],
ref_new = microorganismsDT[tsn == found[1, tsn_new], ref], ref_new = microorganismsDT[tsn == found[1, tsn_new], ref],
mo = microorganismsDT[tsn == found[1, tsn_new], mo]) mo = microorganismsDT[tsn == found[1, tsn_new], mo]))
next next
} }
# check for uncertain results ---- # check for uncertain results ----
if (allow_uncertain == TRUE) { if (allow_uncertain == TRUE) {
uncertain_fn <- function(x_backup, x_trimmed, x_withspaces, x_withspaces_start) {
# (1) look again for old taxonomic names, now for G. species ---- # (1) look again for old taxonomic names, now for G. species ----
found <- microorganisms.oldDT[name %like% x_withspaces[i] found <- microorganisms.oldDT[name %like% x_withspaces
| name %like% x_withspaces_start[i] | name %like% x_withspaces_start
| name %like% x[i],] | name %like% x,]
if (NROW(found) > 0 & nchar(x_trimmed[i]) >= 6) { if (NROW(found) > 0 & nchar(x_trimmed) >= 6) {
if (property == "ref") { if (property == "ref") {
# when property is "ref" (which is the case in mo_ref, mo_authors and mo_year), return the old value, so: # when property is "ref" (which is the case in mo_ref, mo_authors and mo_year), return the old value, so:
# mo_ref("Chlamydia psittaci) = "Page, 1968" (with warning) # mo_ref("Chlamydia psittaci) = "Page, 1968" (with warning)
# mo_ref("Chlamydophila psittaci) = "Everett et al., 1999" # mo_ref("Chlamydophila psittaci) = "Everett et al., 1999"
x[i] <- found[1, ref] x <- found[1, ref]
} else { } else {
x[i] <- microorganismsDT[tsn == found[1, tsn_new], ..property][[1]] x <- microorganismsDT[tsn == found[1, tsn_new], ..property][[1]]
} }
warning(red(paste0('UNCERTAIN - "', warning(red(paste0('UNCERTAIN - "',
x_backup[i], '" -> ', italic(found[1, name]))), x_backup, '" -> ', italic(found[1, name]))),
call. = FALSE, immediate. = TRUE) call. = FALSE, immediate. = FALSE)
notes <<- c(notes,
renamed_note(name_old = found[1, name], renamed_note(name_old = found[1, name],
name_new = microorganismsDT[tsn == found[1, tsn_new], fullname], name_new = microorganismsDT[tsn == found[1, tsn_new], fullname],
ref_old = found[1, ref], ref_old = found[1, ref],
ref_new = microorganismsDT[tsn == found[1, tsn_new], ref], ref_new = microorganismsDT[tsn == found[1, tsn_new], ref],
mo = microorganismsDT[tsn == found[1, tsn_new], mo]) mo = microorganismsDT[tsn == found[1, tsn_new], mo]))
next return(x)
} }
# (2) strip values between brackets ---- # (2) strip values between brackets ----
x_backup_stripped <- gsub("( [(].*[)])", "", x_backup[i]) x_backup_stripped <- gsub("( [(].*[)])", "", x_backup)
x_backup_stripped <- trimws(gsub(" ", " ", x_backup_stripped, fixed = TRUE)) x_backup_stripped <- trimws(gsub(" ", " ", x_backup_stripped, fixed = TRUE))
x_species_stripped <- gsub("( [(].*[)])", "", x_species[i]) found <- suppressMessages(suppressWarnings(exec_as.mo(x_backup_stripped, clear_options = FALSE)))
x_species_stripped <- trimws(gsub(" ", " ", x_species_stripped, fixed = TRUE)) if (!is.na(found) & nchar(x_trimmed) >= 6) {
found <- microorganismsDT[mo == found, ..property][[1]]
found <- microorganismsDT[fullname %like% x_backup_stripped
| fullname %like% x_species_stripped,]
if (NROW(found) > 0 & nchar(x_trimmed[i]) >= 6) {
x[i] <- found[1, ..property][[1]]
warning(red(paste0('UNCERTAIN - "', warning(red(paste0('UNCERTAIN - "',
x_backup[i], '" -> ', italic(found[1, fullname][[1]]), " (", found[1, mo][[1]], ")")), x_backup, '" -> ', italic(microorganismsDT[mo == found[1L], fullname][[1]]), " (", found[1L], ")")),
call. = FALSE, immediate. = TRUE) call. = FALSE, immediate. = FALSE)
next return(found[1L])
} }
# (3) try to strip off one element and check the remains ---- # (3) try to strip off one element and check the remains ----
look_for_part <- function(z) { look_for_part <- function(z) {
x_strip <- z %>% strsplit(" ") %>% unlist() x_strip <- z %>% strsplit(" ") %>% unlist()
if (length(x_strip) > 1 & nchar(x_trimmed[i]) >= 6) { if (length(x_strip) > 1 & nchar(x_trimmed) >= 6) {
for (i in 1:(length(x_strip) - 1)) { for (i in 1:(length(x_strip) - 1)) {
x_strip_collapsed <- paste(x_strip[1:(length(x_strip) - i)], collapse = " ") x_strip_collapsed <- paste(x_strip[1:(length(x_strip) - i)], collapse = " ")
found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, clear_options = FALSE))) found <- suppressMessages(suppressWarnings(exec_as.mo(x_strip_collapsed, clear_options = FALSE)))
@ -666,14 +671,17 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE,
found <- microorganismsDT[mo == found, ..property][[1]] found <- microorganismsDT[mo == found, ..property][[1]]
warning(red(paste0('UNCERTAIN - "', warning(red(paste0('UNCERTAIN - "',
z, '" -> ', italic(microorganismsDT[mo == found[1L], fullname][[1]]), " (", found[1L], ")")), z, '" -> ', italic(microorganismsDT[mo == found[1L], fullname][[1]]), " (", found[1L], ")")),
call. = FALSE, immediate. = TRUE) call. = FALSE, immediate. = FALSE)
return(found[1L]) return(found[1L])
} }
} }
} }
return(NA_character_) return(NA_character_)
} }
x[i] <- look_for_part(x_backup[i]) return(look_for_part(x_backup))
}
x[i] <- uncertain_fn(x_backup[i], x_trimmed[i], x_withspaces[i], x_withspaces_start[i])
if (!is.na(x[i])) { if (!is.na(x[i])) {
next next
} }
@ -773,6 +781,13 @@ exec_as.mo <- function(x, Becker = FALSE, Lancefield = FALSE,
x <- as.integer(x) x <- as.integer(x)
} }
if (length(notes > 0)) {
notes <- sort(notes)
for (i in 1:length(notes)) {
base::message(notes[i])
}
}
x x
} }
@ -798,7 +813,7 @@ renamed_note <- function(name_old, name_new, ref_old = "", ref_new = "", mo = ""
msg_plain <- paste0(name_old, ref_old, " -> ", name_new, ref_new) msg_plain <- paste0(name_old, ref_old, " -> ", name_new, ref_new)
msg_plain <- c(getOption("mo_renamed", character(0)), msg_plain) msg_plain <- c(getOption("mo_renamed", character(0)), msg_plain)
options(mo_renamed = sort(msg_plain)) options(mo_renamed = sort(msg_plain))
base::message(blue(paste("Note:", msg))) return(blue(paste("Note:", msg)))
} }
#' @exportMethod print.mo #' @exportMethod print.mo