mirror of
https://github.com/msberends/AMR.git
synced 2025-07-10 03:42:03 +02:00
(v2.1.1.9152) MIC plot fix
This commit is contained in:
28
R/mic.R
28
R/mic.R
@ -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
25
R/plotting.R
@ -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))
|
||||
|
Reference in New Issue
Block a user