mirror of
https://github.com/msberends/AMR.git
synced 2025-07-08 20:02:04 +02:00
(v1.0.1.9005) as.mo() improvements
This commit is contained in:
39
R/data.R
39
R/data.R
@ -19,11 +19,11 @@
|
||||
# Visit our website for more info: https://msberends.gitlab.io/AMR. #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Data sets with ~550 antimicrobials
|
||||
#' Data sets with `r format(nrow(antibiotics) + nrow(antivirals), big.mark = ",")` antimicrobials
|
||||
#'
|
||||
#' Two data sets containing all antibiotics/antimycotics and antivirals. Use [as.ab()] or one of the [ab_property()] functions to retrieve values from the [antibiotics] data set. Three identifiers are included in this data set: an antibiotic ID (`ab`, primarily used in this package) as defined by WHONET/EARS-Net, an ATC code (`atc`) as defined by the WHO, and a Compound ID (`cid`) as found in PubChem. Other properties in this data set are derived from one or more of these codes.
|
||||
#' @format
|
||||
#' ### For the [antibiotics] data set: a [`data.frame`] with 452 observations and 14 variables:
|
||||
#' ### For the [antibiotics] data set: a [`data.frame`] with `r nrow(antibiotics)` observations and `r ncol(antibiotics)` variables:
|
||||
#' - `ab`\cr Antibiotic ID as used in this package (like `AMC`), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available
|
||||
#' - `atc`\cr ATC code (Anatomical Therapeutic Chemical) as defined by the WHOCC, like `J01CR02`
|
||||
#' - `cid`\cr Compound ID as found in PubChem
|
||||
@ -39,7 +39,7 @@
|
||||
#' - `iv_units`\cr Units of `iv_ddd`
|
||||
#' - `loinc`\cr All LOINC codes (Logical Observation Identifiers Names and Codes) associated with the name of the antimicrobial agent. Use [ab_loinc()] to retrieve them quickly, see [ab_property()].
|
||||
#'
|
||||
#' ### For the [antivirals] data set: a [`data.frame`] with 102 observations and 9 variables:
|
||||
#' ### For the [antivirals] data set: a [`data.frame`] with `r nrow(antivirals)` observations and `r ncol(antivirals)` variables:
|
||||
#' - `atc`\cr ATC code (Anatomical Therapeutic Chemical) as defined by the WHOCC
|
||||
#' - `cid`\cr Compound ID as found in PubChem
|
||||
#' - `name`\cr Official name as used by WHONET/EARS-Net or the WHO
|
||||
@ -71,11 +71,11 @@
|
||||
#' @rdname antibiotics
|
||||
"antivirals"
|
||||
|
||||
#' Data set with ~70,000 microorganisms
|
||||
#' Data set with `r format(nrow(microorganisms), big.mark = ",")` microorganisms
|
||||
#'
|
||||
#' A data set containing the microbial taxonomy of six kingdoms from the Catalogue of Life. MO codes can be looked up using [as.mo()].
|
||||
#' @inheritSection catalogue_of_life Catalogue of Life
|
||||
#' @format A [`data.frame`] with 69,447 observations and 17 variables:
|
||||
#' @format A [`data.frame`] with `r format(nrow(microorganisms), big.mark = ",")` observations and `r ncol(microorganisms)` variables:
|
||||
#' - `mo`\cr ID of microorganism as used by this package
|
||||
#' - `col_id`\cr Catalogue of Life ID
|
||||
#' - `fullname`\cr Full name, like `"Escherichia coli"`
|
||||
@ -92,8 +92,8 @@
|
||||
#' - 3 entries of *Trichomonas* (*Trichomonas vaginalis*, and its family and genus)
|
||||
#' - 1 entry of *Blastocystis* (*Blastocystis hominis*), although it officially does not exist (Noel *et al.* 2005, PMID 15634993)
|
||||
#' - 5 other 'undefined' entries (unknown, unknown Gram negatives, unknown Gram positives, unknown yeast and unknown fungus)
|
||||
#' - 6 families under the Enterobacterales order, according to Adeolu *et al.* (2016, PMID 27620848), that are not in the Catalogue of Life
|
||||
#' - 12,600 species from the DSMZ (Deutsche Sammlung von Mikroorganismen und Zellkulturen) since the DSMZ contain the latest taxonomic information based on recent publications
|
||||
#' - 6 families under the Enterobacterales order, according to Adeolu *et al.* (2016, PMID 27620848), that are not (yet) in the Catalogue of Life
|
||||
#' - `r format(nrow(filter(microorganisms, source == "DSMZ")), big.mark = ",")` species from the DSMZ (Deutsche Sammlung von Mikroorganismen und Zellkulturen) since the DSMZ contain the latest taxonomic information based on recent publications
|
||||
#'
|
||||
#' ### Direct download
|
||||
#' This data set is available as 'flat file' for use even without R - you can find the file here:
|
||||
@ -122,7 +122,7 @@ catalogue_of_life <- list(
|
||||
#'
|
||||
#' A data set containing old (previously valid or accepted) taxonomic names according to the Catalogue of Life. This data set is used internally by [as.mo()].
|
||||
#' @inheritSection catalogue_of_life Catalogue of Life
|
||||
#' @format A [`data.frame`] with 24,246 observations and 5 variables:
|
||||
#' @format A [`data.frame`] with `r format(nrow(microorganisms.old), big.mark = ",")` observations and `r ncol(microorganisms.old)` variables:
|
||||
#' - `col_id`\cr Catalogue of Life ID that was originally given
|
||||
#' - `col_id_new`\cr New Catalogue of Life ID that responds to an entry in the [microorganisms] data set
|
||||
#' - `fullname`\cr Old full taxonomic name of the microorganism
|
||||
@ -136,7 +136,7 @@ catalogue_of_life <- list(
|
||||
#' Translation table for common microorganism codes
|
||||
#'
|
||||
#' A data set containing commonly used codes for microorganisms, from laboratory systems and WHONET. Define your own with [set_mo_source()]. They will all be searched when using [as.mo()] and consequently all the [`mo_*`][mo_property()] functions.
|
||||
#' @format A [`data.frame`] with 5,450 observations and 2 variables:
|
||||
#' @format A [`data.frame`] with `r format(nrow(microorganisms.codes), big.mark = ",")` observations and `r ncol(microorganisms.codes)` variables:
|
||||
#' - `code`\cr Commonly used code of a microorganism
|
||||
#' - `mo`\cr ID of the microorganism in the [microorganisms] data set
|
||||
#' @inheritSection catalogue_of_life Catalogue of Life
|
||||
@ -144,10 +144,10 @@ catalogue_of_life <- list(
|
||||
#' @seealso [as.mo()] [microorganisms]
|
||||
"microorganisms.codes"
|
||||
|
||||
#' Data set with 2,000 example isolates
|
||||
#' Data set with `r format(nrow(example_isolates), big.mark = ",")` example isolates
|
||||
#'
|
||||
#' A data set containing 2,000 microbial isolates with their full antibiograms. The data set reflects reality and can be used to practice AMR analysis. For examples, please read [the tutorial on our website](https://msberends.gitlab.io/AMR/articles/AMR.html).
|
||||
#' @format A [`data.frame`] with 2,000 observations and 49 variables:
|
||||
#' A data set containing `r format(nrow(example_isolates), big.mark = ",")` microbial isolates with their full antibiograms. The data set reflects reality and can be used to practice AMR analysis. For examples, please read [the tutorial on our website](https://msberends.gitlab.io/AMR/articles/AMR.html).
|
||||
#' @format A [`data.frame`] with `r format(nrow(example_isolates), big.mark = ",")` observations and `r ncol(example_isolates)` variables:
|
||||
#' - `date`\cr date of receipt at the laboratory
|
||||
#' - `hospital_id`\cr ID of the hospital, from A to D
|
||||
#' - `ward_icu`\cr logical to determine if ward is an intensive care unit
|
||||
@ -157,14 +157,14 @@ catalogue_of_life <- list(
|
||||
#' - `gender`\cr gender of the patient
|
||||
#' - `patient_id`\cr ID of the patient
|
||||
#' - `mo`\cr ID of microorganism created with [as.mo()], see also [microorganisms]
|
||||
#' - `PEN:RIF`\cr 40 different antibiotics with class [`rsi`] (see [as.rsi()]); these column names occur in the [antibiotics] data set and can be translated with [ab_name()]
|
||||
#' - `PEN:RIF`\cr `r sum(sapply(example_isolates, is.rsi))` different antibiotics with class [`rsi`] (see [as.rsi()]); these column names occur in the [antibiotics] data set and can be translated with [ab_name()]
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
"example_isolates"
|
||||
|
||||
#' Data set with unclean data
|
||||
#'
|
||||
#' A data set containing 3,000 microbial isolates that are not cleaned up and consequently not ready for AMR analysis. This data set can be used for practice.
|
||||
#' @format A [`data.frame`] with 3,000 observations and 8 variables:
|
||||
#' A data set containing `r format(nrow(example_isolates_unclean), big.mark = ",")` microbial isolates that are not cleaned up and consequently not ready for AMR analysis. This data set can be used for practice.
|
||||
#' @format A [`data.frame`] with `r format(nrow(example_isolates_unclean), big.mark = ",")` observations and `r ncol(example_isolates_unclean)` variables:
|
||||
#' - `patient_id`\cr ID of the patient
|
||||
#' - `date`\cr date of receipt at the laboratory
|
||||
#' - `hospital`\cr ID of the hospital, from A to C
|
||||
@ -173,10 +173,10 @@ catalogue_of_life <- list(
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
"example_isolates_unclean"
|
||||
|
||||
#' Data set with 500 isolates - WHONET example
|
||||
#' Data set with `r format(nrow(WHONET), big.mark = ",")` isolates - WHONET example
|
||||
#'
|
||||
#' This example data set has the exact same structure as an export file from WHONET. Such files can be used with this package, as this example data set shows. The data itself was based on our [example_isolates] data set.
|
||||
#' @format A [`data.frame`] with 500 observations and 53 variables:
|
||||
#' @format A [`data.frame`] with `r format(nrow(WHONET), big.mark = ",")` observations and `r ncol(WHONET)` variables:
|
||||
#' - `Identification number`\cr ID of the sample
|
||||
#' - `Specimen number`\cr ID of the specimen
|
||||
#' - `Organism`\cr Name of the microorganism. Before analysis, you should transform this to a valid microbial class, using [as.mo()].
|
||||
@ -202,14 +202,14 @@ catalogue_of_life <- list(
|
||||
#' - `Inducible clindamycin resistance`\cr Clindamycin can be induced?
|
||||
#' - `Comment`\cr Other comments
|
||||
#' - `Date of data entry`\cr Date this data was entered in WHONET
|
||||
#' - `AMP_ND10:CIP_EE`\cr 27 different antibiotics. You can lookup the abbreviatons in the [antibiotics] data set, or use e.g. [`ab_name("AMP")`][ab_name()] to get the official name immediately. Before analysis, you should transform this to a valid antibiotic class, using [as.rsi()].
|
||||
#' - `AMP_ND10:CIP_EE`\cr `r sum(sapply(WHONET, is.rsi))` different antibiotics. You can lookup the abbreviations in the [antibiotics] data set, or use e.g. [`ab_name("AMP")`][ab_name()] to get the official name immediately. Before analysis, you should transform this to a valid antibiotic class, using [as.rsi()].
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
"WHONET"
|
||||
|
||||
#' Data set for R/SI interpretation
|
||||
#'
|
||||
#' Data set to interpret MIC and disk diffusion to R/SI values. Included guidelines are CLSI (2011-2019) and EUCAST (2011-2020). Use [as.rsi()] to transform MICs or disks measurements to R/SI values.
|
||||
#' @format A [`data.frame`] with 13,975 observations and 9 variables:
|
||||
#' @format A [`data.frame`] with `r format(nrow(rsi_translation), big.mark = ",")` observations and `r ncol(rsi_translation)` variables:
|
||||
#' - `guideline`\cr Name of the guideline
|
||||
#' - `method`\cr Either "MIC" or "DISK"
|
||||
#' - `site`\cr Body site, e.g. "Oral" or "Respiratory"
|
||||
@ -219,6 +219,7 @@ catalogue_of_life <- list(
|
||||
#' - `disk_dose`\cr Dose of the used disk diffusion method
|
||||
#' - `breakpoint_S`\cr Lowest MIC value or highest number of millimetres that leads to "S"
|
||||
#' - `breakpoint_R`\cr Highest MIC value or lowest number of millimetres that leads to "R"
|
||||
#' - `uti`\cr A logical value (`TRUE`/`FALSE`) to indicate whether the rule applies to a urinary tract infection (UTI)
|
||||
#' @details The repository of this `AMR` package contains a file comprising this exact data set: <https://gitlab.com/msberends/AMR/blob/master/data-raw/rsi_translation.txt>. This file **allows for machine reading EUCAST and CLSI guidelines**, which is almost impossible with the Excel and PDF files distributed by EUCAST and CLSI. This file is updated automatically.
|
||||
#' @inheritSection AMR Read more on our website!
|
||||
"rsi_translation"
|
||||
|
3
R/disk.R
3
R/disk.R
@ -159,6 +159,7 @@ vec_ptype_full.disk <- function(x, ...) {
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[<-.disk" <- function(i, j, ..., value) {
|
||||
value <- as.disk(value)
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
y
|
||||
@ -167,6 +168,7 @@ vec_ptype_full.disk <- function(x, ...) {
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[[<-.disk" <- function(i, j, ..., value) {
|
||||
value <- as.disk(value)
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
y
|
||||
@ -176,6 +178,7 @@ vec_ptype_full.disk <- function(x, ...) {
|
||||
#' @noRd
|
||||
c.disk <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
y <- as.disk(y)
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
}
|
||||
|
@ -21,7 +21,7 @@
|
||||
|
||||
#' PCA biplot with `ggplot2`
|
||||
#'
|
||||
#' This function is to produce a `ggplot2` variant of a so-called [biplot](https://en.wikipedia.org/wiki/Biplot) for PCA (principal component analysis), but is more flexible and more appealing than the base \R [biplot()] function.
|
||||
#' Produces a `ggplot2` variant of a so-called [biplot](https://en.wikipedia.org/wiki/Biplot) for PCA (principal component analysis), but is more flexible and more appealing than the base \R [biplot()] function.
|
||||
#' @inheritSection lifecycle Maturing lifecycle
|
||||
#' @param x an object returned by [pca()], [prcomp()] or [princomp()]
|
||||
#' @inheritParams stats::biplot.prcomp
|
||||
|
43
R/mic.R
43
R/mic.R
@ -254,3 +254,46 @@ pillar_shaft.mic <- function(x, ...) {
|
||||
out[is.na(x)] <- pillar::style_na(NA)
|
||||
pillar::new_pillar_shaft_simple(out, align = "right", min_width = 4)
|
||||
}
|
||||
|
||||
#' @exportMethod [.mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[.mic" <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
}
|
||||
#' @exportMethod [[.mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[[.mic" <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
y
|
||||
}
|
||||
#' @exportMethod [<-.mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[<-.mic" <- function(i, j, ..., value) {
|
||||
value <- as.mic(value)
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
y
|
||||
}
|
||||
#' @exportMethod [[<-.mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[[<-.mic" <- function(i, j, ..., value) {
|
||||
value <- as.mic(value)
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
y
|
||||
}
|
||||
#' @exportMethod c.mic
|
||||
#' @export
|
||||
#' @noRd
|
||||
c.mic <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
y
|
||||
}
|
||||
|
47
R/mo.R
47
R/mo.R
@ -177,8 +177,14 @@ as.mo <- function(x,
|
||||
|
||||
check_dataset_integrity()
|
||||
|
||||
# start off with replaced language-specific non-ASCII characters with ASCII characters
|
||||
x <- parse_encoding(x)
|
||||
|
||||
# WHONET: xxx = no growth
|
||||
x[tolower(as.character(paste0(x, ""))) %in% c("", "xxx", "na", "nan")] <- NA_character_
|
||||
# Laboratory systems: remove entries like "no growth" etc
|
||||
x[trimws2(x) %like% "(no .*growth|keine? .*wachtstum|geen .*groei|no .*crecimientonon|sem .*crescimento|pas .*croissance)"] <- NA_character_
|
||||
x[trimws2(x) %like% "^(no|not|kein|geen|niet|non|sem) [a-z]+"] <- "UNKNOWN"
|
||||
|
||||
uncertainty_level <- translate_allow_uncertain(allow_uncertain)
|
||||
|
||||
@ -256,9 +262,15 @@ exec_as.mo <- function(x,
|
||||
|
||||
check_dataset_integrity()
|
||||
|
||||
# start off with replaced language-specific non-ASCII characters with ASCII characters
|
||||
x <- parse_encoding(x)
|
||||
|
||||
# WHONET: xxx = no growth
|
||||
x[tolower(as.character(paste0(x, ""))) %in% c("", "xxx", "na", "nan")] <- NA_character_
|
||||
|
||||
# Laboratory systems: remove entries like "no growth" etc
|
||||
x[trimws2(x) %like% "(no .*growth|keine? .*wachtstum|geen .*groei|no .*crecimientonon|sem .*crescimento|pas .*croissance)"] <- NA_character_
|
||||
x[trimws2(x) %like% "^(no|not|kein|geen|niet|non|sem) [a-z]+"] <- "UNKNOWN"
|
||||
|
||||
if (initial_search == TRUE) {
|
||||
options(mo_failures = NULL)
|
||||
options(mo_uncertainties = NULL)
|
||||
@ -298,7 +310,7 @@ exec_as.mo <- function(x,
|
||||
|
||||
x_input <- x
|
||||
# already strip leading and trailing spaces
|
||||
x <- trimws(x, which = "both")
|
||||
x <- trimws(x)
|
||||
# only check the uniques, which is way faster
|
||||
x <- unique(x)
|
||||
# remove empty values (to later fill them in again with NAs)
|
||||
@ -417,7 +429,7 @@ exec_as.mo <- function(x,
|
||||
strip_whitespace <- function(x, dyslexia_mode) {
|
||||
# all whitespaces (tab, new lines, etc.) should be one space
|
||||
# and spaces before and after should be omitted
|
||||
trimmed <- trimws(gsub("[\\s]+", " ", x, perl = TRUE), which = "both")
|
||||
trimmed <- trimws2(x)
|
||||
# also, make sure the trailing and leading characters are a-z or 0-9
|
||||
# in case of non-regex
|
||||
if (dyslexia_mode == FALSE) {
|
||||
@ -439,8 +451,9 @@ exec_as.mo <- function(x,
|
||||
# remove spp and species
|
||||
x <- gsub(" +(spp.?|ssp.?|sp.? |ss ?.?|subsp.?|subspecies|biovar |serovar |species)", " ", x)
|
||||
x <- gsub("(spp.?|subsp.?|subspecies|biovar|serovar|species)", "", x)
|
||||
x <- gsub("^([a-z]{2,4})(spe.?)$", "\\1", x) # when ending in SPE instead of SPP and preceded by 2-4 characters
|
||||
x <- strip_whitespace(x, dyslexia_mode)
|
||||
|
||||
|
||||
x_backup_without_spp <- x
|
||||
x_species <- paste(x, "species")
|
||||
# translate to English for supported languages of mo_property
|
||||
@ -454,6 +467,8 @@ exec_as.mo <- function(x,
|
||||
x <- gsub("(hefe|gist|gisten|levadura|lievito|fermento|levure)[a-z]*", "yeast", x)
|
||||
x <- gsub("(schimmels?|mofo|molde|stampo|moisissure|fungi)[a-z]*", "fungus", x)
|
||||
x <- gsub("fungus[ph|f]rya", "fungiphrya", x)
|
||||
# no contamination
|
||||
x <- gsub("(contamination|kontamination|mengflora|contaminaci.n|contamina..o)", "", x)
|
||||
# remove non-text in case of "E. coli" except dots and spaces
|
||||
x <- trimws(gsub("[^.a-zA-Z0-9/ \\-]+", " ", x))
|
||||
# but make sure that dots are followed by a space
|
||||
@ -680,8 +695,8 @@ exec_as.mo <- function(x,
|
||||
next
|
||||
}
|
||||
|
||||
if (x_backup_without_spp[i] %like_case% "virus") {
|
||||
# there is no fullname like virus, so don't try to coerce it
|
||||
if (x_backup_without_spp[i] %like_case% "(virus|viridae)") {
|
||||
# there is no fullname like virus or viridae, so don't try to coerce it
|
||||
x[i] <- NA_character_
|
||||
next
|
||||
}
|
||||
@ -1467,7 +1482,8 @@ exec_as.mo <- function(x,
|
||||
if (n_distinct(failures) > 1) {
|
||||
plural <- c("values", "them", "were")
|
||||
}
|
||||
total_failures <- length(x_input[as.character(x_input) %in% as.character(failures) & !x_input %in% c(NA, NULL, NaN)])
|
||||
x_input_clean <- trimws2(x_input)
|
||||
total_failures <- length(x_input_clean[as.character(x_input_clean) %in% as.character(failures) & !x_input %in% c(NA, NULL, NaN)])
|
||||
total_n <- length(x_input[!x_input %in% c(NA, NULL, NaN)])
|
||||
msg <- paste0(nr2char(n_distinct(failures)), " unique ", plural[1],
|
||||
" (covering ", percentage(total_failures / total_n),
|
||||
@ -1475,7 +1491,7 @@ exec_as.mo <- function(x,
|
||||
if (n_distinct(failures) <= 10) {
|
||||
msg <- paste0(msg, ": ", paste('"', unique(failures), '"', sep = "", collapse = ", "))
|
||||
}
|
||||
msg <- paste0(msg, ". Use mo_failures() to review ", plural[2], ". Edit the `allow_uncertain` parameter if needed (see ?as.mo).")
|
||||
msg <- paste0(msg, ".\nUse mo_failures() to review ", plural[2], ". Edit the `allow_uncertain` parameter if needed (see ?as.mo).")
|
||||
warning(red(paste0("\n", msg)),
|
||||
call. = FALSE,
|
||||
immediate. = TRUE) # thus will always be shown, even if >= warnings
|
||||
@ -1787,6 +1803,7 @@ as.data.frame.mo <- function(x, ...) {
|
||||
"[<-.mo" <- function(i, j, ..., value) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
# must only contain valid MOs
|
||||
class_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo),
|
||||
as.character(microorganisms.translation$mo_old)))
|
||||
}
|
||||
@ -1796,6 +1813,7 @@ as.data.frame.mo <- function(x, ...) {
|
||||
"[[<-.mo" <- function(i, j, ..., value) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
# must only contain valid MOs
|
||||
class_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo),
|
||||
as.character(microorganisms.translation$mo_old)))
|
||||
}
|
||||
@ -1805,6 +1823,7 @@ as.data.frame.mo <- function(x, ...) {
|
||||
c.mo <- function(x, ...) {
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(x)
|
||||
# must only contain valid MOs
|
||||
class_integrity_check(y, "microorganism code", c(as.character(microorganisms$mo),
|
||||
as.character(microorganisms.translation$mo_old)))
|
||||
}
|
||||
@ -1949,3 +1968,15 @@ levenshtein_fraction <- function(input, output) {
|
||||
# self-made score between 0 and 1 (for % certainty, so 0 means huge distance, 1 means no distance)
|
||||
(base::nchar(output) - 0.5 * levenshtein) / nchar(output)
|
||||
}
|
||||
|
||||
trimws2 <- function(x) {
|
||||
trimws(gsub("[\\s]+", " ", x, perl = TRUE))
|
||||
}
|
||||
|
||||
parse_encoding <- function(x) {
|
||||
tryCatch({
|
||||
parsed <- iconv(x, to = "UTF-8")
|
||||
parsed[is.na(parsed) & !is.na(x)] <- iconv(x[is.na(parsed) & !is.na(x)], from = "Latin1", to = "ASCII//TRANSLIT")
|
||||
gsub('"', "", parsed, fixed = TRUE)
|
||||
}, error = function(e) stop(e$message, call. = FALSE))
|
||||
}
|
||||
|
31
R/rsi.R
31
R/rsi.R
@ -226,7 +226,7 @@ as.rsi.mic <- function(x, mo, ab = deparse(substitute(x)), guideline = "EUCAST",
|
||||
uti <- rep(uti, length(x))
|
||||
}
|
||||
|
||||
message(blue(paste0("=> Interpreting MIC values of column `", bold(ab), "` (",
|
||||
message(blue(paste0("=> Interpreting MIC values of `", bold(ab), "` (",
|
||||
ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
|
||||
ab_name(ab_coerced, tolower = TRUE), ") using guideline ", bold(guideline_coerced), " ... ")),
|
||||
appendLF = FALSE)
|
||||
@ -263,7 +263,7 @@ as.rsi.disk <- function(x, mo, ab = deparse(substitute(x)), guideline = "EUCAST"
|
||||
uti <- rep(uti, length(x))
|
||||
}
|
||||
|
||||
message(blue(paste0("=> Interpreting disk zones of column `", bold(ab), "` (",
|
||||
message(blue(paste0("=> Interpreting disk zones of `", bold(ab), "` (",
|
||||
ifelse(ab_coerced != ab, paste0(ab_coerced, ", "), ""),
|
||||
ab_name(ab_coerced, tolower = TRUE), ") using guideline ", bold(guideline_coerced), " ... ")),
|
||||
appendLF = FALSE)
|
||||
@ -682,3 +682,30 @@ pillar_shaft.rsi <- function(x, ...) {
|
||||
out[x == "R"] <- bgRed(white(" R "))
|
||||
pillar::new_pillar_shaft_simple(out, align = "left", width = 3)
|
||||
}
|
||||
|
||||
#' @exportMethod [<-.rsi
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[<-.rsi" <- function(i, j, ..., value) {
|
||||
value <- as.rsi(value)
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
y
|
||||
}
|
||||
#' @exportMethod [[<-.rsi
|
||||
#' @export
|
||||
#' @noRd
|
||||
"[[<-.rsi" <- function(i, j, ..., value) {
|
||||
value <- as.rsi(value)
|
||||
y <- NextMethod()
|
||||
attributes(y) <- attributes(i)
|
||||
y
|
||||
}
|
||||
#' @exportMethod c.rsi
|
||||
#' @export
|
||||
#' @noRd
|
||||
c.rsi <- function(x, ...) {
|
||||
y <- unlist(lapply(list(...), as.character))
|
||||
x <- as.character(x)
|
||||
as.rsi(c(x, y))
|
||||
}
|
||||
|
Reference in New Issue
Block a user