mirror of
https://github.com/msberends/AMR.git
synced 2026-11-16 00:10:57 +01:00
dr. M.S. (Matthijs) BerendsandClaude Opus 5.5
d683b9e7c6
- data-raw/microorganisms_files/: registry of all MO codes of every release since v2.0.0 (78,992 codes, built from the git tags), approved renames, and README with the rules; decision by Matthijs S. Berends: MO codes from before v2.0.0 are not supported - as.mo(): codes of earlier releases are translated deterministically via the internal MO_RETIRED_CODES (generated from the registry); unknown codes are no longer guessed (previously F_TRCHP, Trichophyton in v3.0.1, became Talaromyces chlamydosporus) - synonym_mo_to_accepted_mo(): a missing target of one source no longer overwrites a valid target of another source (e.g. Chaetomium abuense), and no 'renamed to itself' - taxonomy build: codes are reused and reserved from the registry instead of the development data (fixes 40 codes reused in the 2026 development data), also for phylum to family; synonym cycles are broken; dangling 'renamed to' identifiers are removed; the build stops on any broken integrity rule before saving - run_microorganisms_build.R: runs the build in chunks at its checkpoints in one R process, with progress logging and resuming from any checkpoint; prompt updated accordingly - tests: shared integrity rules (helper-microorganisms.R) used by build and testthat, registry tests over all codes, sentinel organisms, regression tests; current defects of the data on main are listed in microorganisms_known_defects.csv until the next rebuild Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
198 lines
11 KiB
R
198 lines
11 KiB
R
# ==================================================================== #
|
|
# TITLE: #
|
|
# AMR: An R Package for Working with Antimicrobial Resistance Data #
|
|
# #
|
|
# SOURCE CODE: #
|
|
# https://github.com/msberends/AMR #
|
|
# #
|
|
# PLEASE CITE THIS SOFTWARE AS: #
|
|
# Berends MS, Luz CF, Friedrich AW, et al. (2022). #
|
|
# AMR: An R Package for Working with Antimicrobial Resistance Data. #
|
|
# Journal of Statistical Software, 104(3), 1-31. #
|
|
# https://doi.org/10.18637/jss.v104.i03 #
|
|
# #
|
|
# Developed at the University of Groningen and the University Medical #
|
|
# Center Groningen in the Netherlands, in collaboration with many #
|
|
# colleagues from around the world, see our website. #
|
|
# #
|
|
# This R package is free software; you can freely use and distribute #
|
|
# it for both personal and commercial purposes under the terms of the #
|
|
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
|
# the Free Software Foundation. #
|
|
# We created this package for both routine data analysis and academic #
|
|
# research and it was publicly released in the hope that it will be #
|
|
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
|
# #
|
|
# Visit our website for the full manual and a complete tutorial about #
|
|
# how to conduct AMR data analysis: https://amr-for-r.org #
|
|
# ==================================================================== #
|
|
|
|
# Tests of the `microorganisms` data set and the stability of MO codes.
|
|
# The rules themselves are in helper-microorganisms.R, which is also used by the taxonomy build.
|
|
#
|
|
# KNOWN DEFECTS: the data set on the main branch of October 2026 contains defects that will be solved by the
|
|
# next taxonomy rebuild (e.g. Trichophyton as a bacterium, issue #309). These are listed in
|
|
# microorganisms_known_defects.csv, so that these tests fail on every NEW defect, while the current ones are
|
|
# visible. This list may only become shorter, and must be empty after the rebuild (then delete the file).
|
|
|
|
known_defects <- function() {
|
|
file <- test_path("microorganisms_known_defects.csv")
|
|
if (!file.exists(file)) {
|
|
return(data.frame(rule = character(0), record = character(0)))
|
|
}
|
|
utils::read.csv(file, colClasses = "character", na.strings = character(0))
|
|
}
|
|
new_defects <- function(rule, records) {
|
|
setdiff(records, known_defects()$record[known_defects()$rule == rule])
|
|
}
|
|
|
|
# Sentinel organisms: clinically important taxa with properties that must not change unnoticed.
|
|
# NA means: not checked.
|
|
sentinels <- data.frame(
|
|
fullname = c(
|
|
"Escherichia coli", "Klebsiella pneumoniae", "Pseudomonas aeruginosa", "Acinetobacter baumannii",
|
|
"Haemophilus influenzae", "Neisseria gonorrhoeae", "Staphylococcus aureus", "Streptococcus pneumoniae",
|
|
"Enterococcus faecium", "Clostridioides difficile", "Mycobacterium tuberculosis", "Listeria monocytogenes",
|
|
"Tropheryma whipplei", "Candida albicans", "Candidozyma auris", "Nakaseomyces glabratus",
|
|
"Aspergillus fumigatus", "Cryptococcus neoformans", "Pneumocystis jirovecii", "Trichophyton rubrum",
|
|
"Mucor", "Necator americanus", "Ascaris lumbricoides", "Echinococcus granulosus",
|
|
"Capillaria", "Plasmodium falciparum", "Leishmania donovani", "Trypanosoma cruzi",
|
|
"Giardia", "Toxoplasma gondii"
|
|
),
|
|
domain = c(
|
|
rep("Bacteria", 13), rep("Fungi", 8), rep("Animalia", 4),
|
|
"Protozoa", "Protozoa", "Protozoa", "Protozoa", NA
|
|
),
|
|
gramstain = c(
|
|
rep("Gram-negative", 6), rep("Gram-positive", 7), rep(NA, 17)
|
|
),
|
|
family = c(
|
|
"Enterobacteriaceae", "Enterobacteriaceae", "Pseudomonadaceae", "Moraxellaceae", "Pasteurellaceae",
|
|
"Neisseriaceae", "Staphylococcaceae", "Streptococcaceae", "Enterococcaceae", "Peptostreptococcaceae",
|
|
"Mycobacteriaceae", "Listeriaceae", NA, NA, NA, NA,
|
|
"Aspergillaceae", NA, NA, "Arthrodermataceae", "Mucoraceae", NA, NA, NA,
|
|
NA, NA, NA, NA, NA, NA
|
|
),
|
|
stringsAsFactors = FALSE
|
|
)
|
|
sentinel_defects <- function() {
|
|
i <- match(sentinels$fullname, microorganisms$fullname)
|
|
ok <- !is.na(i)
|
|
# (paste() of an empty vector would return one element, hence the use of sprintf())
|
|
out <- sprintf("%s is missing", sentinels$fullname[!ok])
|
|
check <- function(property, actual) {
|
|
expected <- sentinels[[property]]
|
|
wrong <- which(ok & !is.na(expected) & actual != expected)
|
|
sprintf("%s %s is %s instead of %s", sentinels$fullname[wrong], rep(property, length(wrong)), actual[wrong], expected[wrong])
|
|
}
|
|
out <- c(out, check("domain", microorganisms$domain[i]))
|
|
out <- c(out, check("family", microorganisms$family[i]))
|
|
gramstain <- rep(NA_character_, length(i))
|
|
gramstain[ok] <- suppressWarnings(mo_gramstain(microorganisms$mo[i[ok]], language = NULL))
|
|
out <- c(out, check("gramstain", gramstain))
|
|
# the code prefix must always match the domain
|
|
prefix_ok <- startsWith(as.character(microorganisms$mo[i]), paste0(MO_DOMAIN_PREFIX[sentinels$domain], "_"))
|
|
c(out, sprintf("%s has a code with the wrong prefix", sentinels$fullname[which(ok & !is.na(sentinels$domain) & !prefix_ok)]))
|
|
}
|
|
|
|
test_that("microorganisms: integrity rules", {
|
|
skip_on_cran()
|
|
issues <- mo_integrity_issues(microorganisms, registry = read_mo_registry(), renames = read_mo_renames())
|
|
for (rule in names(issues)) {
|
|
defects <- new_defects(rule, issues[[rule]])
|
|
expect_true(length(defects) == 0,
|
|
info = paste0("Rule '", rule, "' is broken by: ", paste(utils::head(defects, 25), collapse = ", "))
|
|
)
|
|
}
|
|
})
|
|
|
|
test_that("microorganisms: known defects are no longer than needed", {
|
|
skip_on_cran()
|
|
# a known defect that is solved must be removed from the list, so that it cannot come back unnoticed
|
|
kd <- known_defects()
|
|
skip_if(nrow(kd) == 0)
|
|
issues <- mo_integrity_issues(microorganisms, registry = read_mo_registry(), renames = read_mo_renames())
|
|
current <- c(
|
|
unlist(lapply(names(issues), function(rule) paste(rule, issues[[rule]], sep = "|"))),
|
|
paste("sentinel", sentinel_defects(), sep = "|")
|
|
)
|
|
solved <- setdiff(paste(kd$rule, kd$record, sep = "|"), current)
|
|
expect_true(length(solved) == 0,
|
|
info = paste0("Solved, remove from microorganisms_known_defects.csv: ", paste(utils::head(solved, 25), collapse = ", "))
|
|
)
|
|
})
|
|
|
|
test_that("microorganisms: sentinel organisms", {
|
|
skip_on_cran()
|
|
defects <- new_defects("sentinel", sentinel_defects())
|
|
expect_true(length(defects) == 0, info = paste(defects, collapse = "; "))
|
|
})
|
|
|
|
test_that("MO codes: every code of every release since v2.0.0 still means the same taxon", {
|
|
skip_on_cran()
|
|
registry <- read_mo_registry()
|
|
skip_if(is.null(registry), "MO code registry not available (only in the source repository)")
|
|
renames <- read_mo_renames()
|
|
|
|
# the registry itself
|
|
expect_false(anyDuplicated(registry$mo) > 0)
|
|
expect_true(all(numeric_version(sub("^v", "", registry$first_release)) >= "2.0.0"))
|
|
expect_true(all(numeric_version(sub("^v", "", registry$first_release)) <= numeric_version(sub("^v", "", registry$last_release))))
|
|
|
|
# every registered code must lead to its own taxon (or to NA if the taxon is not in the data anymore)
|
|
expected_name <- registry$fullname
|
|
renamed <- match(registry$mo, renames$mo)
|
|
expected_name[!is.na(renamed)] <- renames$new_name[renamed[!is.na(renamed)]]
|
|
# deliberate in as.mo() since v2.0.0: the kingdom/domain Fungi returns the code for an unknown fungus
|
|
expected_name[registry$mo == "F_[KNG]_FUNGI"] <- "(unknown fungus)"
|
|
result <- suppressWarnings(as.mo(registry$mo, keep_synonyms = TRUE, info = FALSE))
|
|
result_name <- microorganisms$fullname[match(result, microorganisms$mo)]
|
|
wrong <- !is.na(result) & mo_name_without_suffix(result_name) != mo_name_without_suffix(expected_name)
|
|
defects <- new_defects("registered_code_with_other_taxon", paste0(registry$mo[wrong], " (", result_name[wrong], ")"))
|
|
expect_true(length(defects) == 0,
|
|
info = paste0("Registered codes leading to another taxon: ", paste(utils::head(defects, 25), collapse = ", "))
|
|
)
|
|
|
|
# the internal lookup table must be up to date with the registry
|
|
retired <- registry$mo[!registry$mo %in% microorganisms$mo]
|
|
expect_setequal(AMR:::MO_RETIRED_CODES$old_mo, retired)
|
|
})
|
|
|
|
test_that("MO codes: codes of earlier releases are translated, never guessed", {
|
|
skip_on_cran()
|
|
retired <- AMR:::MO_RETIRED_CODES
|
|
expect_false(any(retired$old_mo %in% microorganisms$mo))
|
|
expect_true(all(retired$mo[!is.na(retired$mo)] %in% microorganisms$mo))
|
|
# every translated code leads to a record with the registered name
|
|
translated <- retired[!is.na(retired$mo), , drop = FALSE]
|
|
expect_identical(
|
|
as.character(suppressWarnings(as.mo(translated$old_mo, keep_synonyms = TRUE, info = FALSE))),
|
|
translated$mo
|
|
)
|
|
expect_identical(
|
|
mo_name_without_suffix(microorganisms$fullname[match(translated$mo, microorganisms$mo)]),
|
|
mo_name_without_suffix(translated$fullname)
|
|
)
|
|
|
|
# regression: in October 2026, the code of Trichophyton (F_TRCHP, v3.0.1) was guessed as Talaromyces
|
|
expect_warning(x <- as.mo("F_TRCHP_RBRM", info = FALSE), "earlier AMR package version")
|
|
expect_identical(mo_name(x, language = NULL), "Trichophyton rubrum")
|
|
expect_identical(suppressWarnings(mo_genus("F_TRCHP", language = NULL)), "Trichophyton")
|
|
|
|
# codes from before v2.0.0 and unknown codes are never guessed (decision by Matthijs S. Berends, 3 October 2026)
|
|
expect_warning(x <- as.mo("B_ESCH_COL", info = FALSE), "not supported")
|
|
expect_true(is.na(x))
|
|
expect_warning(x <- as.mo(c("B_ESCHR_COL", "B_ESCHR_COLI"), info = FALSE), "unknown MO code")
|
|
expect_identical(as.character(x), c(NA, "B_ESCHR_COLI"))
|
|
|
|
# regression: until October 2026, a MycoBank target that was not in the data set replaced a valid GBIF target by NA
|
|
expect_identical(mo_current("Chaetomium abuense"), "Amesia nigricolor")
|
|
# and a synonym without any known current name is not 'renamed' to itself
|
|
no_target <- mo_synonyms_without_current_name(microorganisms)
|
|
expect_true(all(is.na(AMR:::synonym_mo_to_accepted_mo(no_target$mo[is.na(no_target$chain_ends_at)], fill_in_accepted = FALSE))))
|
|
|
|
# current codes are returned as they are, without warnings
|
|
expect_silent(x <- as.mo(c("B_ESCHR_COLI", "B_STPHY_AURS", NA), info = FALSE))
|
|
expect_identical(as.character(x), c("B_ESCHR_COLI", "B_STPHY_AURS", NA))
|
|
})
|