mirror of
https://github.com/msberends/AMR.git
synced 2025-07-08 08:32:04 +02:00
(v1.1.0.9013) lose dependencies
This commit is contained in:
@ -429,8 +429,8 @@ percentage <- function(x, digits = NULL, ...) {
|
||||
# prevent dependency on package 'backports'
|
||||
# these functions were not available in previous versions of R (last checked: R 4.0.0)
|
||||
# see here for the full list: https://github.com/r-lib/backports
|
||||
strrep = function(x, times) {
|
||||
x = as.character(x)
|
||||
strrep <- function(x, times) {
|
||||
x <- as.character(x)
|
||||
if (length(x) == 0L)
|
||||
return(x)
|
||||
unlist(.mapply(function(x, times) {
|
||||
@ -441,18 +441,18 @@ strrep = function(x, times) {
|
||||
paste0(replicate(times, x), collapse = "")
|
||||
}, list(x = x, times = times), MoreArgs = list()), use.names = FALSE)
|
||||
}
|
||||
trimws <- function (x, which = c("both", "left", "right")) {
|
||||
which = match.arg(which)
|
||||
mysub = function(re, x) sub(re, "", x, perl = TRUE)
|
||||
trimws <- function(x, which = c("both", "left", "right")) {
|
||||
which <- match.arg(which)
|
||||
mysub <- function(re, x) sub(re, "", x, perl = TRUE)
|
||||
if (which == "left")
|
||||
return(mysub("^[ \t\r\n]+", x))
|
||||
if (which == "right")
|
||||
return(mysub("[ \t\r\n]+$", x))
|
||||
mysub("[ \t\r\n]+$", mysub("^[ \t\r\n]+", x))
|
||||
}
|
||||
isFALSE <- function (x) {
|
||||
isFALSE <- function(x) {
|
||||
is.logical(x) && length(x) == 1L && !is.na(x) && !x
|
||||
}
|
||||
deparse1 = function (expr, collapse = " ", width.cutoff = 500L, ...) {
|
||||
deparse1 <- function(expr, collapse = " ", width.cutoff = 500L, ...) {
|
||||
paste(deparse(expr, width.cutoff, ...), collapse = collapse)
|
||||
}
|
||||
|
2
R/ab.R
2
R/ab.R
@ -352,7 +352,7 @@ print.ab <- function(x, ...) {
|
||||
#' @exportMethod as.data.frame.ab
|
||||
#' @export
|
||||
#' @noRd
|
||||
as.data.frame.ab <- function (x, ...) {
|
||||
as.data.frame.ab <- function(x, ...) {
|
||||
nm <- deparse1(substitute(x))
|
||||
if (!"nm" %in% names(list(...))) {
|
||||
as.data.frame.vector(as.ab(x), ..., nm = nm)
|
||||
|
72
R/freq.R
72
R/freq.R
@ -1,72 +0,0 @@
|
||||
# ==================================================================== #
|
||||
# TITLE #
|
||||
# Antimicrobial Resistance (AMR) Analysis #
|
||||
# #
|
||||
# SOURCE #
|
||||
# https://gitlab.com/msberends/AMR #
|
||||
# #
|
||||
# LICENCE #
|
||||
# (c) 2018-2020 Berends MS, Luz CF et al. #
|
||||
# #
|
||||
# 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 more info: https://msberends.gitlab.io/AMR. #
|
||||
# ==================================================================== #
|
||||
|
||||
if ("cleaner" %in% rownames(utils::installed.packages())) {
|
||||
freq <- get("freq", envir = asNamespace("cleaner"))
|
||||
freq.default <- get("freq.default", envir = asNamespace("cleaner"))
|
||||
} else {
|
||||
freq <- ""
|
||||
freq.default <- ""
|
||||
}
|
||||
|
||||
#' @method freq mo
|
||||
#' @export
|
||||
#' @noRd
|
||||
freq.mo <- function(x, ...) {
|
||||
x_noNA <- as.mo(x[!is.na(x)]) # as.mo() to get the newest mo codes
|
||||
grams <- mo_gramstain(x_noNA, language = NULL)
|
||||
digits <- list(...)$digits
|
||||
if (is.null(digits)) {
|
||||
digits <- 2
|
||||
}
|
||||
freq.default(x = x, ...,
|
||||
.add_header = list(`Gram-negative` = paste0(format(sum(grams == "Gram-negative", na.rm = TRUE),
|
||||
big.mark = ",",
|
||||
decimal.mark = "."),
|
||||
" (", percentage(sum(grams == "Gram-negative", na.rm = TRUE) / length(grams), digits = digits),
|
||||
")"),
|
||||
`Gram-positive` = paste0(format(sum(grams == "Gram-positive", na.rm = TRUE),
|
||||
big.mark = ",",
|
||||
decimal.mark = "."),
|
||||
" (", percentage(sum(grams == "Gram-positive", na.rm = TRUE) / length(grams), digits = digits),
|
||||
")"),
|
||||
`No of genera` = n_distinct(mo_genus(x_noNA, language = NULL)),
|
||||
`No of species` = n_distinct(paste(mo_genus(x_noNA, language = NULL),
|
||||
mo_species(x_noNA, language = NULL)))))
|
||||
}
|
||||
|
||||
#' @method freq rsi
|
||||
#' @export
|
||||
#' @noRd
|
||||
freq.rsi <- function(x, ...) {
|
||||
x_name <- deparse(substitute(x))
|
||||
x_name <- gsub(".*[$]", "", x_name)
|
||||
ab <- suppressMessages(suppressWarnings(as.ab(x_name)))
|
||||
if (!is.na(ab)) {
|
||||
freq.default(x = x, ...,
|
||||
.add_header = list(Drug = paste0(ab_name(ab), " (", ab, ", ", ab_atc(ab), ")"),
|
||||
group = ab_group(ab),
|
||||
`%SI` = susceptibility(x, minimum = 0, as_percent = TRUE)))
|
||||
} else {
|
||||
freq.default(x = x, ...,
|
||||
.add_header = list(`%SI` = susceptibility(x, minimum = 0, as_percent = TRUE)))
|
||||
}
|
||||
}
|
2
R/mo.R
2
R/mo.R
@ -1578,7 +1578,7 @@ summary.mo <- function(object, ...) {
|
||||
#' @exportMethod as.data.frame.mo
|
||||
#' @export
|
||||
#' @noRd
|
||||
as.data.frame.mo <- function (x, ...) {
|
||||
as.data.frame.mo <- function(x, ...) {
|
||||
nm <- deparse1(substitute(x))
|
||||
if (!"nm" %in% names(list(...))) {
|
||||
as.data.frame.vector(as.mo(x), ..., nm = nm)
|
||||
|
Reference in New Issue
Block a user