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.5.0.9033) as.rsi fix

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2021-03-07 16:15:43 +01:00
parent 850c123de7
commit 1bbf409fe5
15 changed files with 22 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
R/mic.R
View File

@ -341,7 +341,7 @@ get_skimmers.mic <- function(column) {
skim_type = "mic",
min = ~min(., na.rm = TRUE),
max = ~max(., na.rm = TRUE),
median = ~median(., na.rm = TRUE),
median = ~stats::median(., na.rm = TRUE),
n_unique = ~pm_n_distinct(., na.rm = TRUE),
hist_log2 = ~skimr::inline_hist(log2(stats::na.omit(.)))
)

1
R/plot.R
View File

@ -527,7 +527,6 @@ plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_RSI, f
list(cols = cols, count = as.double(x), sub = sub, guideline = guideline)
}
#' @method plot rsi
#' @export
#' @importFrom graphics plot text axis

13
R/rsi.R
View File

@ -814,17 +814,14 @@ exec_as.rsi <- function(method,
if (is.na(x[i])) {
new_rsi[i] <- NA_character_
} else if (method == "mic") {
mic_input <- x[i]
mic_S <- as.mic(get_record$breakpoint_S)
mic_R <- as.mic(get_record$breakpoint_R)
new_rsi[i] <- quick_case_when(isTRUE(conserve_capped_values) & mic_input %like% "^<[0-9]" ~ "S",
isTRUE(conserve_capped_values) & mic_input %like% "^>[0-9]" ~ "R",
new_rsi[i] <- quick_case_when(isTRUE(conserve_capped_values) & x[i] %like% "^<[0-9]" ~ "S",
isTRUE(conserve_capped_values) & x[i] %like% "^>[0-9]" ~ "R",
# start interpreting: EUCAST uses <= S and > R, CLSI uses <=S and >= R
isTRUE(which(levels(mic_input) == mic_input) <= which(levels(mic_S) == mic_S)) ~ "S",
isTRUE(x[i] <= get_record$breakpoint_S) ~ "S",
guideline_coerced %like% "EUCAST" &
isTRUE(which(levels(mic_input) == mic_input) > which(levels(mic_R) == mic_R)) ~ "R",
isTRUE(x[i] > get_record$breakpoint_R) ~ "R",
guideline_coerced %like% "CLSI" &
isTRUE(which(levels(mic_input) == mic_input) >= which(levels(mic_R) == mic_R)) ~ "R",
isTRUE(x[i] >= get_record$breakpoint_R) ~ "R",
# return "I" when not match the bottom or top
!is.na(get_record$breakpoint_S) & !is.na(get_record$breakpoint_R) ~ "I",
# and NA otherwise