This commit is contained in:
dr. M.S. (Matthijs) Berends 2022-09-23 14:56:00 +02:00
parent 94e3ea5333
commit 729eff0a9d
8 changed files with 54 additions and 44 deletions

View File

@ -37,7 +37,7 @@ name: R-code-check
jobs:
R-code-check:
runs-on: ${{ matrix.config.os }}
continue-on-error: ${{ matrix.config.allowfail }}
name: ${{ matrix.config.os }} (R-${{ matrix.config.r }})
@ -72,14 +72,14 @@ jobs:
R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
RSPM: ${{ matrix.config.rspm }}
R_REPOSITORIES: "https://cran.rstudio.com"
steps:
- uses: actions/checkout@v3
- uses: r-lib/actions/setup-r@v2
with:
r-version: ${{ matrix.config.r }}
- uses: r-lib/actions/setup-pandoc@v2
- name: Install Linux dependencies
@ -89,7 +89,7 @@ jobs:
# as of May 2021: https://sysreqs.r-hub.io/pkg/AMR,R,cleaner,curl,dplyr,ggplot2,knitr,microbenchmark,pillar,readxl,rmarkdown,rstudioapi,rvest,skimr,tidyr,tinytest,xml2,backports,crayon,rlang,vctrs,evaluate,highr,markdown,stringr,yaml,xfun,cli,ellipsis,fansi,lifecycle,utf8,glue,mime,magrittr,stringi,generics,R6,tibble,tidyselect,pkgconfig,purrr,digest,gtable,isoband,MASS,mgcv,scales,withr,nlme,Matrix,farver,labeling,munsell,RColorBrewer,viridisLite,lattice,colorspace,gridtext,Rcpp,RCurl,png,jpeg,bitops,cellranger,progress,rematch,hms,prettyunits,htmltools,jsonlite,tinytex,base64enc,httr,selectr,openssl,askpass,sys,repr,cpp11
run: |
sudo apt install -y libssl-dev libxml2-dev libcurl4-openssl-dev
- name: Restore cached R packages
# this step will add the step 'Post Restore cached R packages' on a succesful run
uses: actions/cache@v2
@ -102,7 +102,7 @@ jobs:
run: |
Rscript -e "source('data-raw/_install_deps.R')"
shell: bash
- name: Show session info
if: always()
run: |
@ -110,7 +110,7 @@ jobs:
utils::sessionInfo()
as.data.frame(utils::installed.packages())[, "Version", drop = FALSE]
shell: Rscript {0}
- name: Remove vignettes on R without knitr support
if: matrix.config.r == '3.0' || matrix.config.r == '3.1' || matrix.config.r == '3.2' || matrix.config.r == '3.3'
# writing to DESCRIPTION2 and then moving to DESCRIPTION is required for R <= 3.3 as writeLines() cannot overwrite
@ -151,6 +151,24 @@ jobs:
find . -name 'tinytest.Rout*' -exec cat '{}' \; || true
shell: bash
- name: Show dir
continue-on-error: true
if: always()
run: |
echo ${GITHUB_WORKSPACE}
echo "---"
ls ${GITHUB_WORKSPACE}
echo "---"
ls ../${GITHUB_WORKSPACE}
echo "---"
ls ../${GITHUB_WORKSPACE}/AMR
echo "---"
ls ../${GITHUB_WORKSPACE}/AMR.Rcheck
echo "---"
ls ${GITHUB_WORKSPACE}/AMR
echo "---"
ls ${GITHUB_WORKSPACE}/AMR.Rcheck
- name: Upload artifacts
if: always()
uses: actions/upload-artifact@v2

View File

@ -1,5 +1,5 @@
Package: AMR
Version: 1.8.1.9062
Version: 1.8.1.9063
Date: 2022-09-23
Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR)

View File

@ -1,4 +1,4 @@
# AMR 1.8.1.9062
# AMR 1.8.1.9063
This version will eventually become v2.0! We're happy to reach a new major milestone soon!

View File

@ -563,11 +563,11 @@ ab_select_exec <- function(function_name,
return(NULL)
}
if (is.null(ab_class_args) || function_name %in% c("antifungals", "antimycobacterials")) {
if (is.null(ab_class_args) || isTRUE(function_name %in% c("antifungals", "antimycobacterials"))) {
ab_group <- NULL
if (function_name == "antifungals") {
if (isTRUE(function_name == "antifungals")) {
abx <- antibiotics$ab[which(antibiotics$group == "Antifungals")]
} else if (function_name == "antimycobacterials") {
} else if (isTRUE(function_name == "antimycobacterials")) {
abx <- antibiotics$ab[which(antibiotics$group == "Antimycobacterials")]
} else {
# their upper case equivalent are vectors with class <ab>, created in data-raw/_pre_commit_hook.R

9
R/mo.R
View File

@ -92,10 +92,7 @@
#' - `"S. aureus - please mind: MRSA"`. The last word will be stripped, after which the function will try to find a match. If it does not, the second last word will be stripped, etc. Again, a warning will be thrown that the result *Staphylococcus aureus* (`B_STPHY_AURS`) needs review.
#' - `"Fluoroquinolone-resistant Neisseria gonorrhoeae"`. The first word will be stripped, after which the function will try to find a match. A warning will be thrown that the result *Neisseria gonorrhoeae* (`B_NESSR_GNRR`) needs review.
#'
#' There are three helper functions that can be run after using the [as.mo()] function:
#' - Use [mo_uncertainties()] to get a [data.frame] that prints in a pretty format with all taxonomic names that were guessed. The output contains the matching score for all matches (see *Matching Score for Microorganisms* below).
#' - Use [mo_failures()] to get a [character] [vector] with all values that could not be coerced to a valid value.
#' - Use [mo_renamed()] to get a [data.frame] with all values that could be coerced based on old, previously accepted taxonomic names.
#' Use [mo_uncertainties()] to get a [data.frame] that prints in a pretty format with all taxonomic names that were guessed. The output contains the matching score for all matches (see *Matching Score for Microorganisms* below).
#'
#' ### Microbial Prevalence of Pathogens in Humans
#'
@ -839,14 +836,14 @@ translate_allow_uncertain <- function(allow_uncertain) {
allow_uncertain
}
get_mo_failures_uncertainties_renamed <- function() {
get_mo_uncertainties <- function() {
remember <- list(uncertainties = pkg_env$mo_uncertainties)
# empty them, otherwise e.g. mo_shortname("Chlamydophila psittaci") will give 3 notes
pkg_env$mo_uncertainties <- NULL
remember
}
load_mo_failures_uncertainties_renamed <- function(metadata) {
load_mo_uncertainties <- function(metadata) {
pkg_env$mo_uncertainties <- metadata$uncertainties
}

View File

@ -201,7 +201,7 @@ mo_shortname <- function(x, language = get_AMR_locale(), keep_synonyms = getOpti
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_failures_uncertainties_renamed()
metadata <- get_mo_uncertainties()
replace_empty <- function(x) {
x[x == ""] <- "spp."
@ -223,7 +223,7 @@ mo_shortname <- function(x, language = get_AMR_locale(), keep_synonyms = getOpti
shortnames[shortnames %like% "unknown"] <- paste0("(", trimws(gsub("[^a-zA-Z -]", "", shortnames[shortnames %like% "unknown"], perl = TRUE)), ")")
shortnames[is.na(x.mo)] <- NA_character_
load_mo_failures_uncertainties_renamed(metadata)
load_mo_uncertainties(metadata)
translate_into_language(shortnames, language = language, only_unknown = FALSE, only_affect_mo_names = TRUE)
}
@ -374,7 +374,7 @@ mo_gramstain <- function(x, language = get_AMR_locale(), keep_synonyms = getOpti
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_failures_uncertainties_renamed()
metadata <- get_mo_uncertainties()
x <- rep(NA_character_, length(x))
# make all bacteria Gram negative
@ -393,7 +393,7 @@ mo_gramstain <- function(x, language = get_AMR_locale(), keep_synonyms = getOpti
# and of course our own ID for Gram-positives
| x.mo == "B_GRAMP"] <- "Gram-positive"
load_mo_failures_uncertainties_renamed(metadata)
load_mo_uncertainties(metadata)
translate_into_language(x, language = language, only_unknown = FALSE)
}
@ -409,9 +409,9 @@ mo_is_gram_negative <- function(x, language = get_AMR_locale(), keep_synonyms =
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_failures_uncertainties_renamed()
metadata <- get_mo_uncertainties()
grams <- mo_gramstain(x.mo, language = NULL, keep_synonyms = keep_synonyms)
load_mo_failures_uncertainties_renamed(metadata)
load_mo_uncertainties(metadata)
out <- grams == "Gram-negative" & !is.na(grams)
out[x.mo %in% c(NA_character_, "UNKNOWN")] <- NA
out
@ -429,9 +429,9 @@ mo_is_gram_positive <- function(x, language = get_AMR_locale(), keep_synonyms =
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_failures_uncertainties_renamed()
metadata <- get_mo_uncertainties()
grams <- mo_gramstain(x.mo, language = NULL, keep_synonyms = keep_synonyms)
load_mo_failures_uncertainties_renamed(metadata)
load_mo_uncertainties(metadata)
out <- grams == "Gram-positive" & !is.na(grams)
out[x.mo %in% c(NA_character_, "UNKNOWN")] <- NA
out
@ -449,12 +449,12 @@ mo_is_yeast <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_failures_uncertainties_renamed()
metadata <- get_mo_uncertainties()
x.kingdom <- mo_kingdom(x.mo, language = NULL, keep_synonyms = keep_synonyms)
x.class <- mo_class(x.mo, language = NULL, keep_synonyms = keep_synonyms)
load_mo_failures_uncertainties_renamed(metadata)
load_mo_uncertainties(metadata)
out <- rep(FALSE, length(x))
out[x.kingdom == "Fungi" & x.class == "Saccharomycetes"] <- TRUE
@ -615,7 +615,7 @@ mo_taxonomy <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_failures_uncertainties_renamed()
metadata <- get_mo_uncertainties()
out <- list(
kingdom = mo_kingdom(x, language = language, keep_synonyms = keep_synonyms),
@ -628,7 +628,7 @@ mo_taxonomy <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio
subspecies = mo_subspecies(x, language = language, keep_synonyms = keep_synonyms)
)
load_mo_failures_uncertainties_renamed(metadata)
load_mo_uncertainties(metadata)
out
}
@ -644,7 +644,7 @@ mo_synonyms <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_failures_uncertainties_renamed()
metadata <- get_mo_uncertainties()
syns <- lapply(x.mo, function(y) {
gbif <- AMR::microorganisms$gbif[match(y, AMR::microorganisms$mo)]
@ -664,7 +664,7 @@ mo_synonyms <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio
result <- unlist(syns)
}
load_mo_failures_uncertainties_renamed(metadata)
load_mo_uncertainties(metadata)
result
}
@ -680,7 +680,7 @@ mo_info <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("A
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
metadata <- get_mo_failures_uncertainties_renamed()
metadata <- get_mo_uncertainties()
info <- lapply(x, function(y) {
c(
@ -701,7 +701,7 @@ mo_info <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("A
result <- info[[1L]]
}
load_mo_failures_uncertainties_renamed(metadata)
load_mo_uncertainties(metadata)
result
}
@ -718,7 +718,7 @@ mo_url <- function(x, open = FALSE, language = get_AMR_locale(), keep_synonyms =
meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
x.mo <- as.mo(x = x, language = language, keep_synonyms = keep_synonyms, ... = ...)
metadata <- get_mo_failures_uncertainties_renamed()
metadata <- get_mo_uncertainties()
x.rank <- AMR::microorganisms$rank[match(x.mo, AMR::microorganisms$mo)]
x.name <- AMR::microorganisms$fullname[match(x.mo, AMR::microorganisms$mo)]
@ -739,7 +739,7 @@ mo_url <- function(x, open = FALSE, language = get_AMR_locale(), keep_synonyms =
utils::browseURL(u[1L])
}
load_mo_failures_uncertainties_renamed(metadata)
load_mo_uncertainties(metadata)
u
}

View File

@ -757,7 +757,7 @@ as_rsi_method <- function(method_short,
method <- method_short
metadata_mo <- get_mo_failures_uncertainties_renamed()
metadata_mo <- get_mo_uncertainties()
x_bak <- data.frame(x_mo = paste0(x, mo), stringsAsFactors = FALSE)
df <- unique(data.frame(x, mo, x_mo = paste0(x, mo), stringsAsFactors = FALSE))
@ -810,7 +810,7 @@ as_rsi_method <- function(method_short,
if (nrow(trans) == 0) {
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
load_mo_failures_uncertainties_renamed(metadata_mo)
load_mo_uncertainties(metadata_mo)
return(set_clean_class(factor(new_rsi, levels = c("S", "I", "R"), ordered = TRUE),
new_class = c("rsi", "ordered", "factor")
))
@ -947,7 +947,7 @@ as_rsi_method <- function(method_short,
message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
}
load_mo_failures_uncertainties_renamed(metadata_mo)
load_mo_uncertainties(metadata_mo)
set_clean_class(factor(new_rsi, levels = c("S", "I", "R"), ordered = TRUE),
new_class = c("rsi", "ordered", "factor")

View File

@ -115,12 +115,7 @@ With the default setting (\code{allow_uncertain = TRUE}, level 2), below example
\item \code{"Fluoroquinolone-resistant Neisseria gonorrhoeae"}. The first word will be stripped, after which the function will try to find a match. A warning will be thrown that the result \emph{Neisseria gonorrhoeae} (\code{B_NESSR_GNRR}) needs review.
}
There are three helper functions that can be run after using the \code{\link[=as.mo]{as.mo()}} function:
\itemize{
\item Use \code{\link[=mo_uncertainties]{mo_uncertainties()}} to get a \link{data.frame} that prints in a pretty format with all taxonomic names that were guessed. The output contains the matching score for all matches (see \emph{Matching Score for Microorganisms} below).
\item Use \code{\link[=mo_failures]{mo_failures()}} to get a \link{character} \link{vector} with all values that could not be coerced to a valid value.
\item Use \code{\link[=mo_renamed]{mo_renamed()}} to get a \link{data.frame} with all values that could be coerced based on old, previously accepted taxonomic names.
}
Use \code{\link[=mo_uncertainties]{mo_uncertainties()}} to get a \link{data.frame} that prints in a pretty format with all taxonomic names that were guessed. The output contains the matching score for all matches (see \emph{Matching Score for Microorganisms} below).
}
\subsection{Microbial Prevalence of Pathogens in Humans}{