P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2024-12-26 16:46:13 +01:00
Code Releases Activity

Update guess_ab_col.R

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2019-10-08 08:02:19 +00:00
parent 5dbff3e170
commit 683d226fd3
1 changed files with 23 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
R/guess_ab_col.R
View File

@ -121,28 +121,33 @@ get_column_abx <- function(x,
verbose = FALSE, verbose = FALSE,
...) { ...) {
# determine from given data set message(blue("NOTE: Auto-guessing columns suitable for analysis..."))
x <- as.data.frame(x, stringsAsFactors = FALSE)
x_bak <- x x_bak <- x
# only check columns that are a valid AB code, ATC code, name, abbreviation or synonym,
# or already have the rsi class (as.rsi)
# and that have no more than 50% invalid values
vectr_antibiotics <- unique(toupper(unlist(AMR::antibiotics[,c("ab", "atc", "name", "abbreviations", "synonyms")])))
vectr_antibiotics <- vectr_antibiotics[!is.na(vectr_antibiotics) & nchar(vectr_antibiotics) >= 3]
x_columns <- sapply(colnames(x), function(col = x, df = x_bak) {
if (toupper(col) %in% vectr_antibiotics |
is.rsi(as.data.frame(df)[, col]) |
is.rsi.eligible(as.data.frame(df)[, col], threshold = 0.5)) {
return(col)
} else {
return(NA_character_)
}
})
x_coluxmns <- x_columns[!is.na(x_columns)]
x <- x[,x_columns[!is.na(x_columns)]]
df_trans <- data.frame(colnames = colnames(x), df_trans <- data.frame(colnames = colnames(x),
abcode = suppressWarnings(as.ab(colnames(x)))) abcode = suppressWarnings(as.ab(colnames(x))))
df_trans <- df_trans[!is.na(df_trans$abcode),] df_trans <- df_trans[!is.na(df_trans$abcode),]
x <- as.character(df_trans$colnames) x <- as.character(df_trans$colnames)
names(x) <- df_trans$abcode names(x) <- df_trans$abcode
# remove the ones that are not a valid AB code, ATC code, name, abbreviation or synonym,
# and do not already have the rsi class (as.rsi)
# and that have >50% invalid values
vectr_antibiotics <- unique(toupper(unlist(AMR::antibiotics[,c("ab", "atc", "name", "abbreviations", "synonyms")])))
vectr_antibiotics <- vectr_antibiotics[!is.na(vectr_antibiotics) & nchar(vectr_antibiotics) >= 3]
x <- sapply(x, function(col = x, df = x_bak) {
ifelse(toupper(col) %in% vectr_antibiotics |
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 (...): # add from self-defined dots (...):
# get_column_abx(example_isolates %>% rename(thisone = AMX), amox = "thisone") # get_column_abx(example_isolates %>% rename(thisone = AMX), amox = "thisone")
dots <- list(...) dots <- list(...)