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

(v2.1.1.9152) MIC plot fix

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2025-02-18 08:07:02 +01:00
parent ef02f4a7f2
commit 671d657fd8
11 changed files with 50 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
R/mic.R
View File

@ -43,9 +43,14 @@ VALID_MIC_LEVELS <- c(t(vapply(FUN.VALUE = character(length(VALID_MIC_LEVELS)),
c("<", "<=", "", ">=", ">"),
paste0,
VALID_MIC_LEVELS)))
COMMON_MIC_VALUES <- c(0.001, 0.002, 0.004, 0.008, 0.016, 0.032, 0.064,
0.125, 0.25, 0.5, 1, 2, 4, 8, 16, 32,
64, 128, 256, 512, 1024)
COMMON_MIC_VALUES <- c(0.0001, 0.0002, 0.0005,
0.001, 0.002, 0.004, 0.008,
0.016, 0.032, 0.064,
0.125, 0.25, 0.5,
1, 2, 4, 8,
16, 32, 64,
128, 256, 512,
1024, 2048, 4096)
#' Transform Input to Minimum Inhibitory Concentrations (MIC)
#'
@ -158,7 +163,7 @@ as.mic <- function(x, na.rm = FALSE, keep_operators = "all") {
if (is.mic(x) && (keep_operators == "all" || !any(x %like% "[>=<]", na.rm = TRUE))) {
if (!identical(levels(x), VALID_MIC_LEVELS)) {
# from an older AMR version - just update MIC factor levels
# might be from an older AMR version - just update MIC factor levels
x <- set_clean_class(factor(as.character(x), levels = VALID_MIC_LEVELS, ordered = TRUE),
new_class = c("mic", "ordered", "factor"))
}
@ -184,20 +189,19 @@ as.mic <- function(x, na.rm = FALSE, keep_operators = "all") {
# comma to period
x <- gsub(",", ".", x, fixed = TRUE)
# transform scientific notation
x[x %like% "[-]?[0-9]+([.][0-9]+)?e[-]?[0-9]+"] <- as.double(x[x %like% "[-]?[0-9]+([.][0-9]+)?e[-]?[0-9]+"])
# transform Unicode for >= and <=
x <- gsub("\u2264", "<=", x, fixed = TRUE)
x <- gsub("\u2265", ">=", x, fixed = TRUE)
# remove other invalid characters
x <- gsub("[^a-zA-Z0-9.><= ]+", "", x, perl = TRUE)
# remove space between operator and number ("<= 0.002" -> "<=0.002")
x <- gsub("(<|=|>) +", "\\1", x, perl = TRUE)
x <- gsub("[^a-zA-Z0-9.><= -]+", "", x, perl = TRUE)
# transform => to >= and =< to <=
x <- gsub("=<", "<=", x, fixed = TRUE)
x <- gsub("=>", ">=", x, fixed = TRUE)
# Remove leading == and =
x <- gsub("^=+", "", x)
# retrieve signs and remove them from input
x_signs <- trimws(gsub("[^>=<]", "", x))
x <- trimws(gsub("[>=<]", "", x))
# dots without a leading zero must start with 0
x <- gsub("([^0-9]|^)[.]", "\\10.", x, perl = TRUE)
# values like "<=0.2560.512" should be 0.512
@ -217,6 +221,12 @@ as.mic <- function(x, na.rm = FALSE, keep_operators = "all") {
x[x %like% "[.]"] <- gsub("0+$", "", x[x %like% "[.]"])
# never end with dot
x <- gsub("[.]$", "", x, perl = TRUE)
# remove scientific notation
x[x %like% "[0-9]e[-]?[0-9]"] <- trimws(format(suppressWarnings(as.double(x[x %like% "[0-9]e[-]?[0-9]"])), scientific = FALSE))
# add signs again
x <- paste0(x_signs, x)
# remove NAs introduced by format()
x <- gsub("(NA)+", "", x)
# trim it
x <- trimws2(x)

25
R/plotting.R
View File

@ -237,20 +237,33 @@ create_scale_mic <- function(aest, keep_operators, mic_range = NULL, ...) {
"In `scale_", aest, "_mic()`, `limits` cannot be combined with `mic_range`, as they working identically. Use `mic_range` OR `limits`.", call = FALSE)
mic_range <- args$limits
}
# do not take these arguments into account, as they will be overwritten and seem to allow weird behaviour
# do not take these arguments into account, as they will be overwritten and seem to allow weird behaviour if set anyway
args[c("aesthetics", "trans", "transform", "transform_df", "breaks", "labels", "limits")] <- NULL
scale <- do.call(ggplot_fn, args)
scale$transform <- function(x) {
as.double(rescale_mic(x = as.double(x), keep_operators = , "labels", mic_range = mic_range, as.mic = TRUE))
as.double(rescale_mic(x = as.double(x), keep_operators = keep_operators, mic_range = mic_range, as.mic = TRUE))
}
scale$transform_df <- function(self, df) {
self$`.values_rescaled` <- rescale_mic(x = as.double(df[[aest]]), keep_operators = keep_operators, mic_range = mic_range, as.mic = TRUE)
self$`.values_levels` <- levels(rescale_mic(x = as.double(df[[aest]]), keep_operators = keep_operators, mic_range = mic_range, as.mic = FALSE))
if (length(self$`.values_levels`) > 6 & "0.025" %in% self$`.values_levels`) {
# TODO weird levelling out leading to 0.025 being redundant
self$`.values_levels` <- self$`.values_levels`[self$`.values_levels` != "0.025"]
# create new breaks and labels here
lims <- range(self$`.values_rescaled`)
if (!is.na(mic_range[1]) && mic_range[1] < lims[1]) {
lims[1] <- mic_range[1]
}
if (!is.na(mic_range[2]) && mic_range[2] > lims[2]) {
lims[2] <- mic_range[2]
}
ind_min <- which(COMMON_MIC_VALUES <= lims[1])[which.min(abs(COMMON_MIC_VALUES[COMMON_MIC_VALUES <= lims[1]] - lims[1]))] # Closest index where COMMON_MIC_VALUES <= lims[1]
ind_max <- which(COMMON_MIC_VALUES >= lims[2])[which.min(abs(COMMON_MIC_VALUES[COMMON_MIC_VALUES >= lims[2]] - lims[2]))] # Closest index where COMMON_MIC_VALUES >= lims[2]
self$`.values_levels` <- as.mic(COMMON_MIC_VALUES[ind_min:ind_max])
if (keep_operators %in% c("edges", "all") && length(self$`.values_levels`) > 1) {
self$`.values_levels`[1] <- paste0("<=", self$`.values_levels`[1])
self$`.values_levels`[length(self$`.values_levels`)] <- paste0(">=", self$`.values_levels`[length(self$`.values_levels`)])
}
self$`.values_log` <- log2(as.double(self$`.values_rescaled`))
if (aest == "y" && "group" %in% colnames(df)) {
df$group <- as.integer(factor(df$x))