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

(v1.4.0.9036) more unit tests

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2020-12-11 12:17:23 +01:00
parent 23ddc6004b
commit 2edd3339db
17 changed files with 72 additions and 51 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: 1.4.0.9035 Version: 1.4.0.9036
Date: 2020-12-11 Date: 2020-12-11
Title: Antimicrobial Resistance Analysis Title: Antimicrobial Resistance Analysis
Authors@R: c( Authors@R: c(

2
NEWS.md
View File

@ -1,4 +1,4 @@
# AMR 1.4.0.9035 # AMR 1.4.0.9036
## <small>Last updated: 11 December 2020</small> ## <small>Last updated: 11 December 2020</small>
### New ### New

31
R/eucast_rules.R
View File

@ -619,9 +619,11 @@ eucast_rules <- function(x,
# Other rules: enzyme inhibitors ------------------------------------------ # Other rules: enzyme inhibitors ------------------------------------------
if (any(c("all", "other") %in% rules)) { if (any(c("all", "other") %in% rules)) {
if (info == TRUE) { if (info == TRUE) {
cat(font_bold(paste0("\nRules by this AMR package (", cat("\n")
font_red(paste0("v", utils::packageDescription("AMR")$Version, ", ", cat(word_wrap(
format(as.Date(utils::packageDescription("AMR")$Date), format = "%Y"))), "), see ?eucast_rules\n"))) font_bold(paste0("Rules by this AMR package (",
font_red(paste0("v", utils::packageDescription("AMR")$Version, ", ",
format(as.Date(utils::packageDescription("AMR")$Date), format = "%Y"))), "), see ?eucast_rules\n"))))
} }
ab_enzyme <- subset(antibiotics, name %like% "/")[, c("ab", "name")] ab_enzyme <- subset(antibiotics, name %like% "/")[, c("ab", "name")]
@ -635,7 +637,7 @@ eucast_rules <- function(x,
# Set base to R where base + enzyme inhibitor is R # Set base to R where base + enzyme inhibitor is R
rule_current <- paste0("Set ", ab_name_base, " (", cols_ab[ab_enzyme[i, ]$base_ab], ") = R where ", rule_current <- paste0("Set ", ab_name_base, " (", cols_ab[ab_enzyme[i, ]$base_ab], ") = R where ",
ab_name_enzyme, " (", cols_ab[ab_enzyme[i, ]$ab], ") = R") ab_name_enzyme, " (", cols_ab[ab_enzyme[i, ]$ab], ") = R")
cat(rule_current) cat(word_wrap(rule_current))
run_changes <- edit_rsi(x = x, run_changes <- edit_rsi(x = x,
col_mo = col_mo, col_mo = col_mo,
to = "R", to = "R",
@ -664,7 +666,7 @@ eucast_rules <- function(x,
rule_current <- paste0("Set ", ab_name_enzyme, " (", cols_ab[ab_enzyme[i, ]$ab], ") = S where ", rule_current <- paste0("Set ", ab_name_enzyme, " (", cols_ab[ab_enzyme[i, ]$ab], ") = S where ",
ab_name_base, " (", cols_ab[ab_enzyme[i, ]$base_ab], ") = S") ab_name_base, " (", cols_ab[ab_enzyme[i, ]$base_ab], ") = S")
if (info == TRUE) { if (info == TRUE) {
cat(rule_current) cat(word_wrap(rule_current))
} }
run_changes <- edit_rsi(x = x, run_changes <- edit_rsi(x = x,
col_mo = col_mo, col_mo = col_mo,
@ -763,9 +765,10 @@ eucast_rules <- function(x,
if (info == TRUE) { if (info == TRUE) {
# Print EUCAST intro ------------------------------------------------------ # Print EUCAST intro ------------------------------------------------------
if (!rule_group_current %like% "other" & eucast_notification_shown == FALSE) { if (!rule_group_current %like% "other" & eucast_notification_shown == FALSE) {
cat(paste0("\n", font_grey(strrep("-", 0.95 * options()$width)), cat(
"\nRules by the ", font_bold("European Committee on Antimicrobial Susceptibility Testing (EUCAST)"), paste0("\n", font_grey(strrep("-", 0.95 * options()$width)), "\n",
"\n", font_blue("https://eucast.org/"), "\n")) word_wrap("Rules by the ", font_bold("European Committee on Antimicrobial Susceptibility Testing (EUCAST)")), "\n",
font_blue("https://eucast.org/"), "\n"))
eucast_notification_shown <- TRUE eucast_notification_shown <- TRUE
} }
@ -775,12 +778,16 @@ eucast_rules <- function(x,
cat(font_bold( cat(font_bold(
ifelse( ifelse(
rule_group_current %like% "breakpoint", rule_group_current %like% "breakpoint",
paste0("\n", breakpoints_info$title, " (", paste0("\n",
font_red(paste0(breakpoints_info$version_txt, ", ", breakpoints_info$year)), ")\n"), word_wrap(
breakpoints_info$title, " (",
font_red(paste0(breakpoints_info$version_txt, ", ", breakpoints_info$year)), ")\n")),
ifelse( ifelse(
rule_group_current %like% "expert", rule_group_current %like% "expert",
paste0("\n", expertrules_info$title, " (", paste0("\n",
font_red(paste0(expertrules_info$version_txt, ", ", expertrules_info$year)), ")\n"), word_wrap(
expertrules_info$title, " (",
font_red(paste0(expertrules_info$version_txt, ", ", expertrules_info$year)), ")\n")),
"")))) ""))))
} }
# Print rule ------------------------------------------------------------- # Print rule -------------------------------------------------------------

35
R/mo.R
View File

@ -748,7 +748,7 @@ exec_as.mo <- function(x,
x_backup_without_spp[i])), uncertainty = -1) x_backup_without_spp[i])), uncertainty = -1)
next next
} }
if (x_backup_without_spp[i] %like_case% "haemoly.*strept") { if (x_backup_without_spp[i] %like_case% "haemoly.*strep") {
# Haemolytic streptococci in different languages # Haemolytic streptococci in different languages
x[i] <- lookup(mo == "B_STRPT_HAEM", uncertainty = -1) x[i] <- lookup(mo == "B_STRPT_HAEM", uncertainty = -1)
next next
@ -1011,8 +1011,8 @@ exec_as.mo <- function(x,
if (!all(is.na(found)) & nchar(g.x_backup_without_spp) >= 6) { if (!all(is.na(found)) & nchar(g.x_backup_without_spp) >= 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 <- found["ref"] x <- found["ref"]
} else { } else {
x <- lookup(fullname == found["fullname_new"], haystack = MO_lookup) x <- lookup(fullname == found["fullname_new"], haystack = MO_lookup)
@ -1437,17 +1437,19 @@ exec_as.mo <- function(x,
# - Becker et al. 2014, PMID 25278577 # - Becker et al. 2014, PMID 25278577
# - Becker et al. 2019, PMID 30872103 # - Becker et al. 2019, PMID 30872103
# - Becker et al. 2020, PMID 32056452 # - Becker et al. 2020, PMID 32056452
post_Becker <- character(0) # 2020-10-20 currently all are mentioned in above papers post_Becker <- character(0) # 2020-10-20 currently all are mentioned in above papers (otherwise uncomment below)
if (any(x %in% MO_lookup[which(MO_lookup$species %in% post_Becker), property])) {
warning_("Becker ", font_italic("et al."), " (2014, 2019) does not contain these species named after their publication: ", # nolint start
font_italic(paste("S.", # if (any(x %in% MO_lookup[which(MO_lookup$species %in% post_Becker), property])) {
sort(mo_species(unique(x[x %in% MO_lookup[which(MO_lookup$species %in% post_Becker), property]]))), # warning_("Becker ", font_italic("et al."), " (2014, 2019) does not contain these species named after their publication: ",
collapse = ", ")), # font_italic(paste("S.",
".", # sort(mo_species(unique(x[x %in% MO_lookup[which(MO_lookup$species %in% post_Becker), property]]))),
call = FALSE, # collapse = ", ")),
immediate = TRUE) # ".",
} # call = FALSE,
# immediate = TRUE)
# }
# nolint end
# 'MO_CONS' and 'MO_COPS' are <mo> vectors created in R/zzz.R # 'MO_CONS' and 'MO_COPS' are <mo> vectors created in R/zzz.R
CoNS <- MO_lookup[which(MO_lookup$mo %in% MO_CONS), property, drop = TRUE] CoNS <- MO_lookup[which(MO_lookup$mo %in% MO_CONS), property, drop = TRUE]
@ -1976,10 +1978,3 @@ repair_reference_df <- function(reference_df) {
reference_df[, "mo"] <- as.mo(reference_df[, "mo", drop = TRUE]) reference_df[, "mo"] <- as.mo(reference_df[, "mo", drop = TRUE])
reference_df reference_df
} }
left_join_MO_lookup <- function(x, ...) {
pm_left_join(x = x, y = MO_lookup, ...)
}
left_join_MO.old_lookup <- function(x, ...) {
pm_left_join(x = x, y = MO.old_lookup, ...)
}

1
README.md
View File

@ -4,6 +4,7 @@
<img src="https://www.r-pkg.org/badges/version-ago/AMR" /> <img src="https://www.r-pkg.org/badges/version-ago/AMR" />
<img src="https://cranlogs.r-pkg.org/badges/grand-total/AMR" /> <img src="https://cranlogs.r-pkg.org/badges/grand-total/AMR" />
<img src="https://codecov.io/gh/msberends/AMR/branch/master/graph/badge.svg" />
<img src="https://msberends.github.io/AMR/works_great_on.png" align="center" height="150px" /> <img src="https://msberends.github.io/AMR/works_great_on.png" align="center" height="150px" />

2
docs/404.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="https://msberends.github.io/AMR//index.html">AMR (for R)</a> <a class="navbar-link" href="https://msberends.github.io/AMR//index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9035</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9036</span>
</span> </span>
</div> </div>

2
docs/LICENSE-text.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a> <a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9035</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9036</span>
</span> </span>
</div> </div>

2
docs/articles/index.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a> <a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9035</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9036</span>
</span> </span>
</div> </div>

2
docs/authors.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a> <a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9035</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9036</span>
</span> </span>
</div> </div>

2
docs/index.html
View File

@ -43,7 +43,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a> <a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9035</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9036</span>
</span> </span>
</div> </div>

8
docs/news/index.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a> <a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9035</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9036</span>
</span> </span>
</div> </div>
@ -236,9 +236,9 @@
<small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small> <small>Source: <a href='https://github.com/msberends/AMR/blob/master/NEWS.md'><code>NEWS.md</code></a></small>
</div> </div>
<div id="amr-1409035" class="section level1"> <div id="amr-1409036" class="section level1">
<h1 class="page-header" data-toc-text="1.4.0.9035"> <h1 class="page-header" data-toc-text="1.4.0.9036">
<a href="#amr-1409035" class="anchor"></a>AMR 1.4.0.9035<small> Unreleased </small> <a href="#amr-1409036" class="anchor"></a>AMR 1.4.0.9036<small> Unreleased </small>
</h1> </h1>
<div id="last-updated-11-december-2020" class="section level2"> <div id="last-updated-11-december-2020" class="section level2">
<h2 class="hasAnchor"> <h2 class="hasAnchor">

2
docs/pkgdown.yml
View File

@ -12,7 +12,7 @@ articles:
datasets: datasets.html datasets: datasets.html
resistance_predict: resistance_predict.html resistance_predict: resistance_predict.html
welcome_to_AMR: welcome_to_AMR.html welcome_to_AMR: welcome_to_AMR.html
last_built: 2020-12-11T08:04Z last_built: 2020-12-11T11:03Z
urls: urls:
reference: https://msberends.github.io/AMR//reference reference: https://msberends.github.io/AMR//reference
article: https://msberends.github.io/AMR//articles article: https://msberends.github.io/AMR//articles

2
docs/reference/index.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="../index.html">AMR (for R)</a> <a class="navbar-link" href="../index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9035</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9036</span>
</span> </span>
</div> </div>

2
docs/survey.html
View File

@ -81,7 +81,7 @@
</button> </button>
<span class="navbar-brand"> <span class="navbar-brand">
<a class="navbar-link" href="index.html">AMR (for R)</a> <a class="navbar-link" href="index.html">AMR (for R)</a>
<span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9035</span> <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Latest development version">1.4.0.9036</span>
</span> </span>
</div> </div>

2
tests/testthat/test-eucast_rules.R
View File

@ -116,6 +116,6 @@ test_that("EUCAST rules work", {
expect_output(suppressWarnings(eucast_rules(example_isolates %>% mutate(NOR = "S", NAL = "S"), info = TRUE))) expect_output(suppressWarnings(eucast_rules(example_isolates %>% mutate(NOR = "S", NAL = "S"), info = TRUE)))
# check verbose output # check verbose output
expect_output(suppressWarnings(eucast_rules(example_isolates, verbose = TRUE, info = TRUE))) expect_output(suppressWarnings(eucast_rules(example_isolates, verbose = TRUE, rules = "all", info = TRUE)))
}) })

20
tests/testthat/test-mo.R
View File

@ -57,8 +57,10 @@ test_that("as.mo works", {
expect_equal(as.character(as.mo("Estreptococos grupo B")), "B_STRPT_GRPB") expect_equal(as.character(as.mo("Estreptococos grupo B")), "B_STRPT_GRPB")
expect_equal(as.character(as.mo("Group B Streptococci")), "B_STRPT_GRPB") expect_equal(as.character(as.mo("Group B Streptococci")), "B_STRPT_GRPB")
expect_equal(as.character(suppressWarnings(as.mo("B_STRPT_PNE"))), "B_STRPT_PNMN") # old MO code (<=v0.8.0) expect_equal(as.character(suppressWarnings(as.mo("B_STRPT_PNE"))), "B_STRPT_PNMN") # old MO code (<=v0.8.0)
expect_equal(as.character(as.mo(c("mycobacterie", "mycobakterium"))), c("B_MYCBC", "B_MYCBC"))
expect_equal(as.character(as.mo(c("GAS", "GBS", "a MGS", "haemoly strep"))), c("B_STRPT_GRPA", "B_STRPT_GRPB", "B_STRPT_MILL", "B_STRPT_HAEM"))
expect_equal(as.character(as.mo(c("GAS", "GBS"))), c("B_STRPT_GRPA", "B_STRPT_GRPB"))
expect_equal(as.character(as.mo("S. pyo")), "B_STRPT_PYGN") # not Actinomyces pyogenes expect_equal(as.character(as.mo("S. pyo")), "B_STRPT_PYGN") # not Actinomyces pyogenes
@ -110,7 +112,8 @@ test_that("as.mo works", {
rep("B_PRBRK_NODS", 4)) rep("B_PRBRK_NODS", 4))
# empty values # empty values
expect_identical(as.character(as.mo(c("", NA, NaN))), rep(NA_character_, 3)) expect_identical(as.character(as.mo(c("", " ", NA, NaN))), rep(NA_character_, 4))
expect_identical(as.character(as.mo(" ")), NA_character_)
# too few characters # too few characters
expect_warning(as.mo("ab")) expect_warning(as.mo("ab"))
@ -203,6 +206,7 @@ test_that("as.mo works", {
# check old names # check old names
expect_equal(suppressMessages(as.character(as.mo("Escherichia blattae"))), "B_SHMWL_BLTT") expect_equal(suppressMessages(as.character(as.mo("Escherichia blattae"))), "B_SHMWL_BLTT")
print(mo_renamed()) print(mo_renamed())
expect_equal(suppressMessages(as.character(as.mo(c("E. coli", "Chlamydo psittaci")))), c("B_ESCHR_COLI", "B_CHLMY_PSTT"))
# check uncertain names # check uncertain names
expect_equal(suppressMessages(as.character(as.mo("staaur extratest", allow_uncertain = TRUE))), "B_STPHY_AURS") expect_equal(suppressMessages(as.character(as.mo("staaur extratest", allow_uncertain = TRUE))), "B_STPHY_AURS")
@ -210,7 +214,7 @@ test_that("as.mo works", {
expect_message(as.mo("e coli extra_text", allow_uncertain = TRUE)) expect_message(as.mo("e coli extra_text", allow_uncertain = TRUE))
expect_equal(suppressMessages(as.character(as.mo("unexisting aureus", allow_uncertain = 3))), "B_STPHY_AURS") expect_equal(suppressMessages(as.character(as.mo("unexisting aureus", allow_uncertain = 3))), "B_STPHY_AURS")
expect_equal(suppressMessages(as.character(as.mo("unexisting staphy", allow_uncertain = 3))), "B_STPHY_COPS") expect_equal(suppressMessages(as.character(as.mo("unexisting staphy", allow_uncertain = 3))), "B_STPHY_COPS")
expect_equal(suppressMessages(as.character(as.mo("Staphylococcus aureus unexisting", allow_uncertain = 3))), "B_STPHY_AURS_ANRB") expect_equal(suppressMessages(as.character(as.mo(c("s aur THISISATEST", "Staphylococcus aureus unexisting"), allow_uncertain = 3))), c("B_STPHY_AURS_ANRB", "B_STPHY_AURS_ANRB"))
# predefined reference_df # predefined reference_df
expect_equal(as.character(as.mo("TestingOwnID", expect_equal(as.character(as.mo("TestingOwnID",
@ -238,6 +242,9 @@ test_that("as.mo works", {
"Raoultella (here some text) terrigena")))), "Raoultella (here some text) terrigena")))),
c("B_MCRBC_PRXY", "B_STRPT_SUIS", "B_RLTLL_TRRG")) c("B_MCRBC_PRXY", "B_STRPT_SUIS", "B_RLTLL_TRRG"))
expect_output(print(mo_uncertainties())) expect_output(print(mo_uncertainties()))
x <- as.mo("S. aur")
# many hits
expect_output(print(mo_uncertainties()))
# Salmonella (City) are all actually Salmonella enterica spp (City) # Salmonella (City) are all actually Salmonella enterica spp (City)
expect_equal(suppressMessages(mo_name(c("Salmonella Goettingen", "Salmonella Typhimurium", "Salmonella Group A"))), expect_equal(suppressMessages(mo_name(c("Salmonella Goettingen", "Salmonella Typhimurium", "Salmonella Group A"))),
@ -285,4 +292,11 @@ test_that("as.mo works", {
expect_warning(x[[1]] <- "invalid code") expect_warning(x[[1]] <- "invalid code")
expect_warning(c(x[1], "test")) expect_warning(c(x[1], "test"))
# ignoring patterns
# frequency tables
if (require("cleaner")) {
expect_s3_class(cleaner::freq(example_isolates$mo), "freq")
}
}) })

4
tests/testthat/test-mo_property.R
View File

@ -122,6 +122,10 @@ test_that("mo_property works", {
"vanco"), "vanco"),
c(TRUE, FALSE, FALSE)) c(TRUE, FALSE, FALSE))
# with reference data
expect_equal(mo_name("test", reference_df = data.frame(col1 = "test", mo = "B_ESCHR_COLI")),
"Escherichia coli")
library(dplyr) library(dplyr)
expect_equal(example_isolates %>% filter(mo_is_gram_negative()) %>% nrow(), expect_equal(example_isolates %>% filter(mo_is_gram_negative()) %>% nrow(),
730) 730)