1
0
mirror of https://github.com/msberends/AMR.git synced 2024-12-27 10:06:12 +01:00

fix veterinary for R<4

This commit is contained in:
dr. M.S. (Matthijs) Berends 2024-02-24 19:26:35 +01:00
parent 35963ca3dc
commit b303662ec6
4 changed files with 12 additions and 10 deletions

View File

@ -1,5 +1,5 @@
Package: AMR Package: AMR
Version: 2.1.1.9008 Version: 2.1.1.9009
Date: 2024-02-24 Date: 2024-02-24
Title: Antimicrobial Resistance Data Analysis Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR) Description: Functions to simplify and standardise antimicrobial resistance (AMR)

View File

@ -1,4 +1,4 @@
# AMR 2.1.1.9008 # AMR 2.1.1.9009
*(this beta version will eventually become v3.0. We're happy to reach a new major milestone soon, which will be all about the new One Health support!)* *(this beta version will eventually become v3.0. We're happy to reach a new major milestone soon, which will be all about the new One Health support!)*

View File

@ -86,8 +86,8 @@ EUCAST_VERSION_EXPERT_RULES <- list(
TAXONOMY_VERSION <- list( TAXONOMY_VERSION <- list(
GBIF = list( GBIF = list(
accessed_date = as.Date("2022-12-11"), accessed_date = as.Date("2024-01-08"),
citation = "GBIF Secretariat (2022). GBIF Backbone Taxonomy. Checklist dataset \\doi{10.15468/39omei}.", citation = "GBIF Secretariat (2023). GBIF Backbone Taxonomy. Checklist dataset \\doi{10.15468/39omei}.",
url = "https://www.gbif.org" url = "https://www.gbif.org"
), ),
LPSN = list( LPSN = list(
@ -146,6 +146,8 @@ globalVariables(c(
"group", "group",
"guideline", "guideline",
"hjust", "hjust",
"host_index",
"host_match",
"input", "input",
"intrinsic_resistant", "intrinsic_resistant",
"isolates", "isolates",

12
R/sir.R
View File

@ -526,7 +526,7 @@ as.sir.data.frame <- function(x,
meet_criteria(include_screening, allow_class = "logical", has_length = 1) meet_criteria(include_screening, allow_class = "logical", has_length = 1)
meet_criteria(include_PKPD, allow_class = "logical", has_length = 1) meet_criteria(include_PKPD, allow_class = "logical", has_length = 1)
meet_criteria(breakpoint_type, allow_class = "character", is_in = reference_data$type, has_length = 1) meet_criteria(breakpoint_type, allow_class = "character", is_in = reference_data$type, has_length = 1)
meet_criteria(host, allow_class = "character", allow_NULL = TRUE, allow_NA = TRUE) meet_criteria(host, allow_class = c("character", "factor"), allow_NULL = TRUE, allow_NA = TRUE)
x.bak <- x x.bak <- x
for (i in seq_len(ncol(x))) { for (i in seq_len(ncol(x))) {
# don't keep factors, overwriting them is hard # don't keep factors, overwriting them is hard
@ -545,8 +545,8 @@ as.sir.data.frame <- function(x,
if (breakpoint_type == "animal") { if (breakpoint_type == "animal") {
if (is.null(host)) { if (is.null(host)) {
host <- search_type_in_df(x = x, type = "host", add_col_prefix = FALSE) host <- search_type_in_df(x = x, type = "host", add_col_prefix = FALSE)
} else if (length(host) == 1 && host %in% colnames(x)) { } else if (length(host) == 1 && as.character(host) %in% colnames(x)) {
host <- x[[host]] host <- x[[as.character(host)]]
} }
} }
@ -745,7 +745,7 @@ get_guideline <- function(guideline, reference_data) {
} }
convert_host <- function(x, lang = get_AMR_locale()) { convert_host <- function(x, lang = get_AMR_locale()) {
x <- trimws2(tolower(x)) x <- trimws2(tolower(as.character(x)))
x_out <- rep(NA_character_, length(x)) x_out <- rep(NA_character_, length(x))
# this order is based on: clinical_breakpoints |> filter(type == "animal") |> count(host, sort = TRUE) # this order is based on: clinical_breakpoints |> filter(type == "animal") |> count(host, sort = TRUE)
x_out[is.na(x_out) & (x %like% "dog|canine" | x %like% translate_AMR("dog|dogs|canine", lang))] <- "dogs" x_out[is.na(x_out) & (x %like% "dog|canine" | x %like% translate_AMR("dog|dogs|canine", lang))] <- "dogs"
@ -785,7 +785,7 @@ as_sir_method <- function(method_short,
meet_criteria(include_PKPD, allow_class = "logical", has_length = 1, .call_depth = -2) meet_criteria(include_PKPD, allow_class = "logical", has_length = 1, .call_depth = -2)
check_reference_data(reference_data, .call_depth = -2) check_reference_data(reference_data, .call_depth = -2)
meet_criteria(breakpoint_type, allow_class = "character", is_in = reference_data$type, has_length = 1, .call_depth = -2) meet_criteria(breakpoint_type, allow_class = "character", is_in = reference_data$type, has_length = 1, .call_depth = -2)
meet_criteria(host, allow_class = "character", allow_NULL = TRUE, allow_NA = TRUE, .call_depth = -2) meet_criteria(host, allow_class = c("character", "factor"), allow_NULL = TRUE, allow_NA = TRUE, .call_depth = -2)
# backward compatibilty # backward compatibilty
dots <- list(...) dots <- list(...)
@ -804,7 +804,7 @@ as_sir_method <- function(method_short,
} }
} }
} else { } else {
if (!is.null(host) && !all(toupper(host) %in% c("HUMAN", "ECOFF"))) { if (!is.null(host) && !all(toupper(as.character(host)) %in% c("HUMAN", "ECOFF"))) {
if (message_not_thrown_before("as.sir", "assumed_breakpoint_animal")) { if (message_not_thrown_before("as.sir", "assumed_breakpoint_animal")) {
message_("Assuming `breakpoint_type = \"animal\"`, since `host` is set.", ifelse(guideline_coerced %like% "EUCAST", " Do you also need to set `guideline = \"CLSI\"`?", ""), "\n\n") message_("Assuming `breakpoint_type = \"animal\"`, since `host` is set.", ifelse(guideline_coerced %like% "EUCAST", " Do you also need to set `guideline = \"CLSI\"`?", ""), "\n\n")
} }