mirror of
https://github.com/msberends/AMR.git
synced 2025-07-09 11:41:58 +02:00
(v0.7.1.9094) get_column_abx() improvement
This commit is contained in:
@ -191,7 +191,7 @@ eucast_rules <- function(x,
|
||||
txt <- paste0("WARNING: In Verbose mode, the eucast_rules() function does not apply rules to the data, but instead returns a data set in logbook form with extensive info about which rows and columns would be effected and in which way.",
|
||||
"\n\nThis may overwrite your existing data if you use e.g.:",
|
||||
"\ndata <- eucast_rules(data, verbose = TRUE)\n\nDo you want to continue?")
|
||||
if ("rstudioapi" %in% rownames(installed.packages())) {
|
||||
if ("rstudioapi" %in% rownames(utils::installed.packages())) {
|
||||
q_continue <- rstudioapi::showQuestion("Using verbose = TRUE with eucast_rules()", txt)
|
||||
} else {
|
||||
q_continue <- menu(choices = c("OK", "Cancel"), graphics = TRUE, title = txt)
|
||||
|
@ -122,11 +122,21 @@ get_column_abx <- function(x,
|
||||
...) {
|
||||
|
||||
# determine from given data set
|
||||
x_bak <- x
|
||||
df_trans <- data.frame(colnames = colnames(x),
|
||||
abcode = suppressWarnings(as.ab(colnames(x))))
|
||||
df_trans <- df_trans[!is.na(df_trans$abcode),]
|
||||
x <- as.character(df_trans$colnames)
|
||||
names(x) <- df_trans$abcode
|
||||
|
||||
# remove the ones that do not already have the rsi class (as.rsi) and that have >50% invalid values
|
||||
x <- sapply(x, function(col = x, df = x_bak) {
|
||||
ifelse(is.rsi(as.data.frame(df)[, col]) |
|
||||
is.rsi.eligible(as.data.frame(df)[, col], threshold = 0.5),
|
||||
col,
|
||||
NA)
|
||||
})
|
||||
x <- x[!is.na(x)]
|
||||
|
||||
# add from self-defined dots (...):
|
||||
# get_column_abx(example_isolates %>% rename(thisone = AMX), amox = "thisone")
|
||||
|
Reference in New Issue
Block a user