1
0
mirror of https://github.com/msberends/AMR.git synced 2025-01-30 23:44:39 +01:00

Compare commits

..

No commits in common. "4b133d4c96990fa214d7b37ecd505b9e607e1b24" and "126afb01a46ee6fedc2fd74636b90814cfbcdd53" have entirely different histories.

8 changed files with 19 additions and 65 deletions

View File

@ -1,6 +1,6 @@
Package: AMR Package: AMR
Version: 1.8.2.9105 Version: 1.8.2.9103
Date: 2023-01-30 Date: 2023-01-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)
data analysis and to work with microbial and antimicrobial properties by data analysis and to work with microbial and antimicrobial properties by

View File

@ -1,4 +1,4 @@
# AMR 1.8.2.9105 # AMR 1.8.2.9103
*(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)* *(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)*

View File

@ -722,9 +722,9 @@ format_class <- function(class, plural = FALSE) {
class <- "input created with `custom_eucast_rules()`" class <- "input created with `custom_eucast_rules()`"
} }
if (any(c("mo", "ab", "sir") %in% class)) { if (any(c("mo", "ab", "sir") %in% class)) {
class <- paste0("of class '", class[1L], "'") class <- paste0("of class <", class[1L], ">")
} }
class[class == class.bak] <- paste0("of class '", class[class == class.bak], "'") class[class == class.bak] <- paste0("of class <", class[class == class.bak], ">")
# output # output
vector_or(class, quotes = FALSE, sort = FALSE) vector_or(class, quotes = FALSE, sort = FALSE)
} }
@ -854,7 +854,7 @@ meet_criteria <- function(object,
} }
), na.rm = TRUE), ), na.rm = TRUE),
"the data provided in argument `", obj_name, "the data provided in argument `", obj_name,
"` must contain at least one column of class '", contains_column_class, "'. ", "` must contain at least one column of class <", contains_column_class, ">. ",
"See ?as.", contains_column_class, ".", "See ?as.", contains_column_class, ".",
call = call_depth call = call_depth
) )

View File

@ -179,7 +179,7 @@ g.test <- function(x,
V <- outer(sr, sc, v, n) V <- outer(sr, sc, v, n)
dimnames(E) <- dimnames(x) dimnames(E) <- dimnames(x)
STATISTIC <- 2 * sum(x * log(x / E), na.rm = TRUE) # sum((abs(x - E) - YATES)^2/E) for chisq.test STATISTIC <- 2 * sum(x * log(x / E)) # sum((abs(x - E) - YATES)^2/E) for chisq.test
PARAMETER <- (nr - 1L) * (nc - 1L) PARAMETER <- (nr - 1L) * (nc - 1L)
PVAL <- pchisq(STATISTIC, PARAMETER, lower.tail = FALSE) PVAL <- pchisq(STATISTIC, PARAMETER, lower.tail = FALSE)
} else { } else {

30
R/mo.R
View File

@ -210,7 +210,7 @@ as.mo <- function(x,
# From known codes ---- # From known codes ----
out[is.na(out) & toupper(x) %in% AMR::microorganisms.codes$code] <- AMR::microorganisms.codes$mo[match(toupper(x)[is.na(out) & toupper(x) %in% AMR::microorganisms.codes$code], AMR::microorganisms.codes$code)] out[is.na(out) & toupper(x) %in% AMR::microorganisms.codes$code] <- AMR::microorganisms.codes$mo[match(toupper(x)[is.na(out) & toupper(x) %in% AMR::microorganisms.codes$code], AMR::microorganisms.codes$code)]
# From SNOMED ---- # From SNOMED ----
if (any(is.na(out) & !is.na(x)) && any(is.na(out) & x %in% unlist(AMR_env$MO_lookup$snomed), na.rm = TRUE)) { if (any(is.na(out) & !is.na(x)) && any(is.na(out) & x %in% unlist(microorganisms$snomed), na.rm = TRUE)) {
# found this extremely fast gem here: https://stackoverflow.com/a/11002456/4575331 # found this extremely fast gem here: https://stackoverflow.com/a/11002456/4575331
out[is.na(out) & x %in% unlist(AMR_env$MO_lookup$snomed)] <- AMR_env$MO_lookup$mo[rep(seq_along(AMR_env$MO_lookup$snomed), vapply(FUN.VALUE = double(1), AMR_env$MO_lookup$snomed, length))[match(x[is.na(out) & x %in% unlist(AMR_env$MO_lookup$snomed)], unlist(AMR_env$MO_lookup$snomed))]] out[is.na(out) & x %in% unlist(AMR_env$MO_lookup$snomed)] <- AMR_env$MO_lookup$mo[rep(seq_along(AMR_env$MO_lookup$snomed), vapply(FUN.VALUE = double(1), AMR_env$MO_lookup$snomed, length))[match(x[is.na(out) & x %in% unlist(AMR_env$MO_lookup$snomed)], unlist(AMR_env$MO_lookup$snomed))]]
} }
@ -800,31 +800,25 @@ print.mo_uncertainties <- function(x, ...) {
return(invisible(NULL)) return(invisible(NULL))
} }
cat(word_wrap("Matching scores are based on the resemblance between the input and the full taxonomic name, and the pathogenicity in humans. See `?mo_matching_score`.\n\n", add_fn = font_blue))
add_MO_lookup_to_AMR_env() add_MO_lookup_to_AMR_env()
col_red <- function(x) font_rose_bg(font_black(x, collapse = NULL), collapse = NULL) cat(word_wrap("Matching scores are based on the resemblance between the input and the full taxonomic name, and the pathogenicity in humans. See `?mo_matching_score`.\n\n", add_fn = font_blue))
col_orange <- function(x) font_orange_bg(font_black(x, collapse = NULL), collapse = NULL)
col_yellow <- function(x) font_yellow_bg(font_black(x, collapse = NULL), collapse = NULL)
col_green <- function(x) font_green_bg(font_black(x, collapse = NULL), collapse = NULL)
if (has_colour()) { if (has_colour()) {
cat(word_wrap("Colour keys: ", cat(word_wrap("Colour keys: ",
col_red(" 0.000-0.499 "), font_red_bg(" 0.000-0.499 "),
col_orange(" 0.500-0.599 "), font_orange_bg(" 0.500-0.599 "),
col_yellow(" 0.600-0.699 "), font_yellow_bg(" 0.600-0.699 "),
col_green(" 0.700-1.000"), font_green_bg(" 0.700-1.000"),
add_fn = font_blue add_fn = font_blue
), font_green_bg(" "), "\n", sep = "") ), font_green_bg(" "), "\n", sep = "")
} }
score_set_colour <- function(text, scores) { score_set_colour <- function(text, scores) {
# set colours to scores # set colours to scores
text[scores >= 0.7] <- col_green(text[scores >= 0.7]) text[scores >= 0.7] <- font_green_bg(text[scores >= 0.7], collapse = NULL)
text[scores >= 0.6 & scores < 0.7] <- col_yellow(text[scores >= 0.6 & scores < 0.7]) text[scores >= 0.6 & scores < 0.7] <- font_yellow_bg(text[scores >= 0.6 & scores < 0.7], collapse = NULL)
text[scores >= 0.5 & scores < 0.6] <- col_orange(text[scores >= 0.5 & scores < 0.6]) text[scores >= 0.5 & scores < 0.6] <- font_orange_bg(text[scores >= 0.5 & scores < 0.6], collapse = NULL)
text[scores < 0.5] <- col_red(text[scores < 0.5]) text[scores < 0.5] <- font_red_bg(text[scores < 0.5], collapse = NULL)
text text
} }

View File

@ -195,20 +195,6 @@ if (AMR:::pkg_is_available("dplyr", min_version = "1.0.0")) {
as.sir(guideline = "CLSI") %>% as.sir(guideline = "CLSI") %>%
pull(amox_disk) %>% pull(amox_disk) %>%
is.sir()) is.sir())
# used by group_by() on sir_calc_df(), check some internals to see if grouped calculation without tidyverse works
groups <- example_isolates %>%
group_by(mo) %>%
attributes() %>%
.$groups
expect_equal(nrow(groups),
90)
expect_equal(class(groups$.rows),
c("vctrs_list_of", "vctrs_vctr", "list"))
expect_equal(groups$.rows[[1]],
c(101, 524, 1368))
expect_equal(example_isolates[c(101, 524, 1368), "mo", drop = TRUE],
rep(groups$mo[1], 3))
} }
# frequency tables # frequency tables
if (AMR:::pkg_is_available("cleaner")) { if (AMR:::pkg_is_available("cleaner")) {

View File

@ -1,21 +0,0 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/antibiogram.R
\name{antibiogram_wisca}
\alias{antibiogram_wisca}
\title{Generate Antibiogram: Traditional, Combined, Syndromic, or Weighted (WISCA)}
\usage{
antibiogram_wisca(
x,
...,
antibiotics = where(is.sir),
type = c("traditional", "combined", "syndromic", "WISCA"),
col_mo = NULL,
minimum = 30
)
}
\arguments{
\item{x}{a \link{data.frame} containing at least a column with microorganisms and columns with antibiotic results (class 'sir', see \code{\link[=as.sir]{as.sir()}})}
}
\description{
Generate Antibiogram: Traditional, Combined, Syndromic, or Weighted (WISCA)
}

View File

@ -49,11 +49,6 @@
content: 'Maintainers'; content: 'Maintainers';
} }
/* marked words for after using the search box */
mark, .mark {
background: rgba(17, 143, 118, 0.25) !important;
}
/* SYNTAX */ /* SYNTAX */
/* These are simple changes for the syntax highlighting */ /* These are simple changes for the syntax highlighting */