1
0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 07:51:57 +02:00

(v1.3.0.9026) eucast expert rules 3.2

This commit is contained in:
2020-09-24 00:30:11 +02:00
parent a1411ddafc
commit c19095a3d5
107 changed files with 48638 additions and 3953 deletions

View File

@ -87,6 +87,8 @@ check_dataset_integrity <- function() {
data_in_pkg <- data(package = "AMR", envir = asNamespace("AMR"))$results[, "Item", drop = TRUE]
data_in_globalenv <- ls(envir = globalenv())
overwritten <- data_in_pkg[data_in_pkg %in% data_in_globalenv]
# exception for example_isolates
overwritten <- overwritten[overwritten != "example_isolates"]
stop_if(length(overwritten) > 0,
"the following data set is overwritten by your global environment and prevents the AMR package from working correctly:\n",
paste0("'", overwritten, "'", collapse = ", "),
@ -110,7 +112,7 @@ check_dataset_integrity <- function() {
invisible(TRUE)
}
search_type_in_df <- function(x, type) {
search_type_in_df <- function(x, type, info = TRUE) {
# try to find columns based on type
found <- NULL
@ -187,7 +189,7 @@ search_type_in_df <- function(x, type) {
}
}
if (!is.null(found)) {
if (!is.null(found) & info == TRUE) {
msg <- paste0("NOTE: Using column `", font_bold(found), "` as input for `col_", type, "`.")
if (type %in% c("keyantibiotics", "specimen")) {
msg <- paste(msg, "Use", font_bold(paste0("col_", type), "= FALSE"), "to prevent this.")
@ -197,6 +199,11 @@ search_type_in_df <- function(x, type) {
found
}
is_possibly_regex <- function(x) {
sapply(strsplit(x, ""),
function(y) any(y %in% c("$", "(", ")", "*", "+", "-", ".", "?", "[", "]", "^", "{", "|", "}", "\\"), na.rm = TRUE))
}
stop_ifnot_installed <- function(package) {
# no "utils::installed.packages()" since it requires non-staged install since R 3.6.0
# https://developer.r-project.org/Blog/public/2019/02/14/staged-install/index.html
@ -259,7 +266,7 @@ stop_if <- function(expr, ..., call = TRUE) {
}
stop_ifnot <- function(expr, ..., call = TRUE) {
if (!isTRUE(expr)) {
if (isFALSE(expr)) {
if (isTRUE(call)) {
call <- -1
}
@ -317,6 +324,18 @@ dataset_UTF8_to_ASCII <- function(df) {
df
}
create_ab_documentation <- function(ab) {
ab_names <- ab_name(ab, language = NULL, tolower = TRUE)
ab <- ab[order(ab_names)]
ab_names <- ab_names[order(ab_names)]
atcs <- ab_atc(ab)
atcs[!is.na(atcs)] <- paste0("[", atcs[!is.na(atcs)], "](", ab_url(ab[!is.na(atcs)]), ")")
atcs[is.na(atcs)] <- "no ATC code"
out <- paste0(ab_names, " (`", ab, "`, ", atcs, ")", collapse = ", ")
substr(out, 1, 1) <- toupper(substr(out, 1, 1))
out
}
has_colour <- function() {
# this is a base R version of crayon::has_color
enabled <- getOption("crayon.enabled")