mirror of
https://github.com/msberends/AMR.git
synced 2025-07-08 16:42:10 +02:00
(v1.6.0.9015) italicise_taxonomy
This commit is contained in:
1
R/ab.R
1
R/ab.R
@ -477,7 +477,6 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
|
||||
if (length(x_unknown) > 0 & fast_mode == FALSE) {
|
||||
warning_("These values could not be coerced to a valid antimicrobial ID: ",
|
||||
vector_and(x_unknown), ".",
|
||||
".",
|
||||
call = FALSE)
|
||||
}
|
||||
|
||||
|
||||
@ -93,6 +93,7 @@
|
||||
#'
|
||||
#' `r paste0(" * ", sapply(DEFINED_AB_GROUPS, function(x) paste0("``", tolower(x), "``\\cr(", paste0(sort(ab_name(eval(parse(text = x), envir = asNamespace("AMR")), language = NULL, tolower = TRUE)), collapse = ", "), ")"), USE.NAMES = FALSE), "\n", collapse = "")`
|
||||
#' @returns A [list] containing the custom rules
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @export
|
||||
#' @examples
|
||||
#' x <- custom_eucast_rules(AMC == "R" & genus == "Klebsiella" ~ aminopenicillins == "R",
|
||||
|
||||
@ -65,7 +65,6 @@ format_eucast_version_nr <- function(version, markdown = TRUE) {
|
||||
#' @details
|
||||
#' **Note:** This function does not translate MIC values to RSI values. Use [as.rsi()] for that. \cr
|
||||
#' **Note:** When ampicillin (AMP, J01CA01) is not available but amoxicillin (AMX, J01CA04) is, the latter will be used for all rules where there is a dependency on ampicillin. These drugs are interchangeable when it comes to expression of antimicrobial resistance. \cr
|
||||
|
||||
#'
|
||||
#' The file containing all EUCAST rules is located here: <https://github.com/msberends/AMR/blob/master/data-raw/eucast_rules.tsv>. **Note:** Old taxonomic names are replaced with the current taxonomy where applicable. For example, *Ochrobactrum anthropi* was renamed to *Brucella anthropi* in 2020; the original EUCAST rules v3.1 and v3.2 did not yet contain this new taxonomic name. The file used as input for this `AMR` package contains the taxonomy updated until [`r CATALOGUE_OF_LIFE$yearmonth_LPSN`][catalogue_of_life()].
|
||||
#'
|
||||
@ -322,17 +321,6 @@ eucast_rules <- function(x,
|
||||
}
|
||||
cols_ab[match(x_new, names(cols_ab))]
|
||||
}
|
||||
markup_italics_where_needed <- function(x) {
|
||||
# returns names found in family, genus or species as italics
|
||||
if (!has_colour()) {
|
||||
return(x)
|
||||
}
|
||||
x <- unlist(strsplit(x, " "))
|
||||
ind <- gsub("[)(:]", "", x) %in% c(MO_lookup[which(MO_lookup$rank %in% c("family", "genus")), ]$fullname,
|
||||
MO_lookup[which(MO_lookup$rank == "species"), ]$species)
|
||||
x[ind] <- font_italic(x[ind], collapse = NULL)
|
||||
paste(x, collapse = " ")
|
||||
}
|
||||
get_antibiotic_names <- function(x) {
|
||||
x <- x %pm>%
|
||||
strsplit(",") %pm>%
|
||||
@ -343,6 +331,7 @@ eucast_rules <- function(x,
|
||||
paste(collapse = ", ")
|
||||
x <- gsub("_", " ", x, fixed = TRUE)
|
||||
x <- gsub("except CAZ", paste("except", ab_name("CAZ", language = NULL, tolower = TRUE)), x, fixed = TRUE)
|
||||
x <- gsub("except TGC", paste("except", ab_name("TGC", language = NULL, tolower = TRUE)), x, fixed = TRUE)
|
||||
x <- gsub("cephalosporins (1st|2nd|3rd|4th|5th)", "cephalosporins (\\1 gen.)", x)
|
||||
x
|
||||
}
|
||||
@ -655,9 +644,10 @@ eucast_rules <- function(x,
|
||||
# Print rule -------------------------------------------------------------
|
||||
if (rule_current != rule_previous) {
|
||||
# is new rule within group, print its name
|
||||
cat(markup_italics_where_needed(word_wrap(rule_current,
|
||||
width = getOption("width") - 30,
|
||||
extra_indent = 6)))
|
||||
cat(italicise_taxonomy(word_wrap(rule_current,
|
||||
width = getOption("width") - 30,
|
||||
extra_indent = 6),
|
||||
type = "ansi"))
|
||||
warned <- FALSE
|
||||
}
|
||||
}
|
||||
@ -795,9 +785,10 @@ eucast_rules <- function(x,
|
||||
get_antibiotic_names(cols))
|
||||
if (info == TRUE) {
|
||||
# print rule
|
||||
cat(markup_italics_where_needed(word_wrap(format_custom_query_rule(rule$query, colours = FALSE),
|
||||
width = getOption("width") - 30,
|
||||
extra_indent = 6)))
|
||||
cat(italicise_taxonomy(word_wrap(format_custom_query_rule(rule$query, colours = FALSE),
|
||||
width = getOption("width") - 30,
|
||||
extra_indent = 6),
|
||||
type = "ansi"))
|
||||
warned <- FALSE
|
||||
}
|
||||
run_changes <- edit_rsi(x = x,
|
||||
|
||||
119
R/italicise_taxonomy.R
Normal file
119
R/italicise_taxonomy.R
Normal file
@ -0,0 +1,119 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Data Analysis for R #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://github.com/msberends/AMR #
|
||||
# #
|
||||
# LICENCE #
|
||||
# (c) 2018-2021 Berends MS, Luz CF et al. #
|
||||
# Developed at the University of Groningen, the Netherlands, in #
|
||||
# collaboration with non-profit organisations Certe Medical #
|
||||
# Diagnostics & Advice, and University Medical Center Groningen. #
|
||||
# #
|
||||
# This R package is free software; you can freely use and distribute #
|
||||
# it for both personal and commercial purposes under the terms of the #
|
||||
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
|
||||
# the Free Software Foundation. #
|
||||
# We created this package for both routine data analysis and academic #
|
||||
# research and it was publicly released in the hope that it will be #
|
||||
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
|
||||
# #
|
||||
# Visit our website for the full manual and a complete tutorial about #
|
||||
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
|
||||
# ==================================================================== #
|
||||
|
||||
#' Italicise Taxonomic Families, Genera, Species, Subspecies
|
||||
#'
|
||||
#' According to the binomial nomenclature, the lowest four taxonomic levels (family, genus, species, subspecies) should be printed in italic. This function finds taxonomic names within strings and makes them italic.
|
||||
#' @inheritSection lifecycle Maturing Lifecycle
|
||||
#' @param string a character (vector)
|
||||
#' @param type type of conversion of the taxonomic names, either "markdown" or "ansi", see *Details*
|
||||
#' @details
|
||||
#' This function finds the taxonomic names and makes them italic based on the [microorganisms] data set.
|
||||
#'
|
||||
#' The taxonomic names can be italicised using markdown (the default) by adding `*` before and after the taxonomic names, or using ANSI colours by adding `\033[3m` before and `\033[23m` after the taxonomic names. If multiple ANSI colours are not available, no conversion will occur.
|
||||
#'
|
||||
#' This function also supports abbreviation of the genus if it is followed by a species, such as "E. coli" and "K. pneumoniae ozaenae".
|
||||
#' @inheritSection AMR Read more on Our Website!
|
||||
#' @export
|
||||
#' @examples
|
||||
#' italicise_taxonomy("An overview of Staphylococcus aureus isolates")
|
||||
#' italicise_taxonomy("An overview of S. aureus isolates")
|
||||
#'
|
||||
#' cat(italicise_taxonomy("An overview of S. aureus isolates", type = "ansi"))
|
||||
italicise_taxonomy <- function(string, type = c("markdown", "ansi")) {
|
||||
if (missing(type)) {
|
||||
type <- "markdown"
|
||||
}
|
||||
meet_criteria(string, allow_class = "character")
|
||||
meet_criteria(type, allow_class = "character", has_length = 1, is_in = c("markdown", "ansi"))
|
||||
|
||||
if (type == "markdown") {
|
||||
before <- "*"
|
||||
after <- "*"
|
||||
} else if (type == "ansi") {
|
||||
if (!has_colour()) {
|
||||
return(string)
|
||||
}
|
||||
before <- "\033[3m"
|
||||
after <- "\033[23m"
|
||||
}
|
||||
|
||||
vapply(FUN.VALUE = character(1),
|
||||
string,
|
||||
function(s) {
|
||||
s_split <- unlist(strsplit(s, " "))
|
||||
|
||||
search_strings <- gsub("[^a-zA-Z-]", "", s_split)
|
||||
|
||||
ind_species <- search_strings != "" &
|
||||
search_strings %in% MO_lookup[which(MO_lookup$rank %in% c("family",
|
||||
"genus",
|
||||
"species",
|
||||
"subspecies",
|
||||
"infraspecies",
|
||||
"subsp.")),
|
||||
"species",
|
||||
drop = TRUE]
|
||||
|
||||
ind_fullname <- search_strings != "" &
|
||||
search_strings %in% c(MO_lookup[which(MO_lookup$rank %in% c("family",
|
||||
"genus",
|
||||
"species",
|
||||
"subspecies",
|
||||
"infraspecies",
|
||||
"subsp.")),
|
||||
"fullname",
|
||||
drop = TRUE],
|
||||
MO_lookup[which(MO_lookup$rank %in% c("family",
|
||||
"genus",
|
||||
"species",
|
||||
"subspecies",
|
||||
"infraspecies",
|
||||
"subsp.")),
|
||||
"subspecies",
|
||||
drop = TRUE])
|
||||
|
||||
# also support E. coli, add "E." to indices
|
||||
has_previous_genera_abbr <- s_split[which(ind_species) - 1] %like_case% "^[A-Z][.]?$"
|
||||
ind_species <- c(which(ind_species), which(ind_species)[has_previous_genera_abbr] - 1)
|
||||
|
||||
ind <- c(ind_species, which(ind_fullname))
|
||||
|
||||
s_split[ind] <- paste0(before, s_split[ind], after)
|
||||
s_paste <- paste(s_split, collapse = " ")
|
||||
|
||||
# clean up a bit
|
||||
s_paste <- gsub(paste0(after, " ", before), " ", s_paste, fixed = TRUE)
|
||||
|
||||
s_paste
|
||||
},
|
||||
USE.NAMES = FALSE)
|
||||
}
|
||||
|
||||
#' @rdname italicise_taxonomy
|
||||
#' @export
|
||||
italicize_taxonomy <- function(string, type = c("markdown", "ansi")) {
|
||||
italicise(string = string, type = type)
|
||||
}
|
||||
Reference in New Issue
Block a user