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

(v1.8.0.9005) as.rsi() fix

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2022-03-10 19:33:25 +01:00
parent ad82bb4ce0
commit 08d387b5ce
102 changed files with 1564 additions and 877 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
R/lifecycle.R
View File

@ -44,7 +44,7 @@
#' \if{html}{\figure{lifecycle_stable.svg}{options: style=margin-bottom:"5"} \cr}
#' The [lifecycle][AMR::lifecycle] of this function is **stable**. In a stable function, major changes are unlikely. This means that the unlying code will generally evolve by adding new arguments; removing arguments or changing the meaning of existing arguments will be avoided.
#'
#' If the unlying code needs breaking changes, they will occur gradually. For example, an argument will be deprecated and first continue to work, but will emit an message informing you of the change. Next, typically after at least one newly released version on CRAN, the message will be transformed to an error.
#' If the unlying code needs breaking changes, they will occur gradually. For example, an argument will be deprecated and first continue to work, but will emit a message informing you of the change. Next, typically after at least one newly released version on CRAN, the message will be transformed to an error.
#' @section Retired Lifecycle:
#' \if{html}{\figure{lifecycle_retired.svg}{options: style=margin-bottom:"5"} \cr}
#' The [lifecycle][AMR::lifecycle] of this function is **retired**. A retired function is no longer under active development, and (if appropiate) a better alternative is available. No new arguments will be added, and only the most critical bugs will be fixed. In a future version, this function will be removed.

12
R/mic.R
View File

@ -243,14 +243,12 @@ droplevels.mic <- function(x, exclude = if (any(is.na(levels(x)))) NULL else NA,
pillar_shaft.mic <- function(x, ...) {
crude_numbers <- as.double(x)
operators <- gsub("[^<=>]+", "", as.character(x))
pasted <- trimws(paste0(operators, trimws(format(crude_numbers))))
out <- pasted
operators[operators != ""] <- font_silver(operators[operators != ""], collapse = NULL)
out <- trimws(paste0(operators, trimws(format(crude_numbers))))
out[is.na(x)] <- font_na(NA)
out <- gsub("(<|=|>)", font_silver("\\1"), out)
if (any(out %like% "[.]", na.rm = TRUE)) {
out <- gsub("([.]?0+)$", font_white("\\1"), out)
}
create_pillar_column(out, align = "right", width = max(nchar(pasted)))
# maketrailing zeroes almost invisible
out[out %like% "[.]"] <- gsub("([.]?0+)$", font_white("\\1"), out[out %like% "[.]"], perl = TRUE)
create_pillar_column(out, align = "right", width = max(nchar(font_stripstyle(out))))
}
# will be exported using s3_register() in R/zzz.R

13
R/rsi.R
View File

@ -690,7 +690,6 @@ as_rsi_method <- function(method_short = "mic",
"... ",
appendLF = FALSE,
as_note = FALSE)
result <- exec_as.rsi(method = method_short,
x = x,
mo = mo_coerced,
@ -715,7 +714,7 @@ exec_as.rsi <- function(method,
metadata_mo <- get_mo_failures_uncertainties_renamed()
x_bak <- data.frame(x_mo = paste0(x, mo), stringsAsFactors = FALSE)
df <- unique(data.frame(x, mo), stringsAsFactors = FALSE)
df <- unique(data.frame(x, mo, x_mo = paste0(x, mo), stringsAsFactors = FALSE))
x <- df$x
mo <- df$mo
@ -848,7 +847,7 @@ exec_as.rsi <- function(method,
}
new_rsi <- x_bak %pm>%
pm_left_join(data.frame(x_mo = paste0(df$x, df$mo), new_rsi,
pm_left_join(data.frame(x_mo = paste0(x, mo), new_rsi,
stringsAsFactors = FALSE),
by = "x_mo") %pm>%
pm_pull(new_rsi)
@ -907,13 +906,13 @@ freq.rsi <- function(x, ...) {
.add_header = list(
Drug = paste0(ab_name(ab, language = NULL), " (", ab, ", ", paste(ab_atc(ab), collapse = "/"), ")"),
`Drug group` = ab_group(ab, language = NULL),
`%SI` = percentage(susceptibility(x, minimum = 0, as_percent = FALSE),
digits = digits)))
`%SI` = trimws(percentage(susceptibility(x, minimum = 0, as_percent = FALSE),
digits = digits))))
} else {
cleaner::freq.default(x = x, ...,
.add_header = list(
`%SI` = percentage(susceptibility(x, minimum = 0, as_percent = FALSE),
digits = digits)))
`%SI` = trimws(percentage(susceptibility(x, minimum = 0, as_percent = FALSE),
digits = digits))))
}
}