P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 10:31:53 +02:00
Code Releases Activity

(v0.7.1.9062) mo/ab assignment improvements

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2019-08-26 16:02:03 +02:00
parent 13d4fef801
commit 7a6fce4eb8
19 changed files with 383 additions and 378 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
R/ab.R
View File

@ -287,14 +287,6 @@ as.data.frame.ab <- function (x, ...) {
attributes(y) <- attributes(x)
y
}
#' @exportMethod [<-.ab
#' @export
#' @noRd
"[<-.ab" <- function(value) {
y <- NextMethod()
attributes(y) <- attributes(value)
y
}
#' @exportMethod [[.ab
#' @export
#' @noRd
@ -303,13 +295,21 @@ as.data.frame.ab <- function (x, ...) {
attributes(y) <- attributes(x)
y
}
#' @exportMethod [<-.ab
#' @export
#' @noRd
"[<-.ab" <- function(i, j, ..., value) {
y <- NextMethod()
attributes(y) <- attributes(i)
class_integrity_check(y, "antimicrobial code", AMR::antibiotics$ab)
}
#' @exportMethod [[<-.ab
#' @export
#' @noRd
"[[<-.ab" <- function(i, j, ..., value) {
y <- NextMethod()
attributes(y) <- attributes(value)
y
attributes(y) <- attributes(i)
class_integrity_check(y, "antimicrobial code", AMR::antibiotics$ab)
}
#' @exportMethod c.ab
#' @export
@ -317,7 +317,7 @@ as.data.frame.ab <- function (x, ...) {
c.ab <- function(x, ...) {
y <- NextMethod()
attributes(y) <- attributes(x)
y
class_integrity_check(y, "antimicrobial code", AMR::antibiotics$ab)
}
#' @importFrom pillar type_sum

8
R/misc.R
View File

@ -190,3 +190,11 @@ translate_AMR <- function(from, language = get_locale(), only_unknown = FALSE) {
x,
ifelse(!is.na(y), y, NA))
}
class_integrity_check <- function(value, type, check_vector) {
if (!all(value[!is.na(value)] %in% check_vector)) {
warning(paste0("invalid ", type, ", NA generated"), call. = FALSE)
value[!value %in% check_vector] <- NA
}
value
}

36
R/mo.R
View File

@ -1693,17 +1693,15 @@ type_sum.mo <- function(x) {
#' @export
pillar_shaft.mo <- function(x, ...) {
out <- format(x)
# grey out the kingdom (part before first "_")
first_parts <- unlist(lapply(gregexpr(pattern = '_', x[!is.na(x)], fixed = TRUE), min))
first_parts[first_parts < 0] <- 0
out[!is.na(x)] <- paste0(pillar::style_subtle(substr(x[!is.na(x)], 0, first_parts)),
substr(x[!is.na(x)], first_parts + 1, nchar(x)))
# grey out the kingdom (part until first "_")
out[!is.na(x)] <- gsub("^([A-Z]+_)(.*)", paste0(pillar::style_subtle("\\1"), "\\2"), out[!is.na(x)])
# and grey out every _
out[!is.na(x)] <- gsub("_", pillar::style_subtle("_"), out[!is.na(x)])
# markup NA and UNKNOWN
out[is.na(x)] <- pillar::style_na(" NA")
out[x == "UNKNOWN"] <- pillar::style_na(" UNKNOWN")
out <- gsub("_", pillar::style_subtle("_"), out)
pillar::new_pillar_shaft_simple(out, align = "left", min_width = 12)
}
@ -1746,14 +1744,6 @@ as.data.frame.mo <- function(x, ...) {
attributes(y) <- attributes(x)
y
}
#' @exportMethod [<-.mo
#' @export
#' @noRd
"[<-.mo" <- function(i, j, ..., value) {
y <- NextMethod()
attributes(y) <- attributes(value)
y
}
#' @exportMethod [[.mo
#' @export
#' @noRd
@ -1762,13 +1752,21 @@ as.data.frame.mo <- function(x, ...) {
attributes(y) <- attributes(x)
y
}
#' @exportMethod [<-.mo
#' @export
#' @noRd
"[<-.mo" <- function(i, j, ..., value) {
y <- NextMethod()
attributes(y) <- attributes(i)
class_integrity_check(y, "microbial code", AMR::microorganisms$mo)
}
#' @exportMethod [[<-.mo
#' @export
#' @noRd
"[[<-.mo" <- function(value) {
"[[<-.mo" <- function(i, j, ..., value) {
y <- NextMethod()
attributes(y) <- attributes(value)
y
attributes(y) <- attributes(i)
class_integrity_check(y, "microbial code", AMR::microorganisms$mo)
}
#' @exportMethod c.mo
#' @export
@ -1776,7 +1774,7 @@ as.data.frame.mo <- function(x, ...) {
c.mo <- function(x, ...) {
y <- NextMethod()
attributes(y) <- attributes(x)
y
class_integrity_check(y, "microbial code", AMR::microorganisms$mo)
}
#' @rdname as.mo

39
R/portion.R
View File

@ -45,29 +45,22 @@
#' When using more than one variable for \code{...} (= combination therapy)), use \code{only_all_tested} to only count isolates that are tested for all antibiotics/variables that you test them for. See this example for two antibiotics, Antibiotic A and Antibiotic B, about how \code{portion_SI} works to calculate the \%SI:
#'
#' \preformatted{
#' -------------------------------------------------------------------------
#' only_all_tested = FALSE only_all_tested = TRUE
#' Antibiotic Antibiotic ----------------------- -----------------------
#' A B include as include as include as include as
#' numerator denominator numerator denominator
#' ---------- ---------- ---------- ----------- ---------- -----------
#' S S X X X X
#' I S X X X X
#' R S X X X X
#' not tested S X X - -
#' S I X X X X
#' I I X X X X
#' R I X X X X
#' not tested I X X - -
#' S R X X X X
#' I R X X X X
#' R R - X - X
#' not tested R - - - -
#' S not tested X X - -
#' I not tested X X - -
#' R not tested - - - -
#' not tested not tested - - - -
#' -------------------------------------------------------------------------
#' --------------------------------------------------------------------
#' only_all_tested = FALSE only_all_tested = TRUE
#' ----------------------- -----------------------
#' Drug A Drug B include as include as include as include as
#' numerator denominator numerator denominator
#' -------- -------- ---------- ----------- ---------- -----------
#' S or I S or I X X X X
#' R S or I X X X X
#' <NA> S or I X X - -
#' S or I R X X X X
#' R R - X - X
#' <NA> R - - - -
#' S or I <NA> X X - -
#' R <NA> - - - -
#' <NA> <NA> - - - -
#' --------------------------------------------------------------------
#' }
#'
#' Please note that, in combination therapies, for \code{only_all_tested = TRUE} applies that: