1
0
mirror of https://github.com/msberends/AMR.git synced 2025-07-09 15:41:56 +02:00

(v0.7.1.9094) get_column_abx() improvement

This commit is contained in:
2019-10-06 21:44:08 +02:00
parent b6653a620a
commit 3d5692219e
11 changed files with 25 additions and 15 deletions

View File

@ -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)

View File

@ -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")