P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 07:51:57 +02:00
Code Releases Activity

new antibiotics

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2019-05-10 16:44:59 +02:00
parent 73f1ee1159
commit 68cc7ef0d0
147 changed files with 6228 additions and 4187 deletions
Download Patch File Download Diff File Expand all files Collapse all files

96
R/guess_ab_col.R
View File

@ -35,7 +35,7 @@
#'
#' guess_ab_col(df, "amoxicillin")
#' # [1] "amox"
#' guess_ab_col(df, "J01AA07") # ATC code of Tetracycline
#' guess_ab_col(df, "J01AA07") # ATC code of tetracycline
#' # [1] "tetr"
#'
#' guess_ab_col(df, "J01AA07", verbose = TRUE)
@ -49,7 +49,7 @@
#' # [1] "AMP_ND10"
#' guess_ab_col(df, "J01CR02")
#' # [1] "AMC_ED20"
#' guess_ab_col(df, as.atc("augmentin"))
#' guess_ab_col(df, as.ab("augmentin"))
#' # [1] "AMC_ED20"
guess_ab_col <- function(tbl = NULL, col = NULL, verbose = FALSE) {
if (is.null(tbl) & is.null(col)) {
@ -60,77 +60,21 @@ guess_ab_col <- function(tbl = NULL, col = NULL, verbose = FALSE) {
warning("argument 'col' has length > 1 and only the first element will be used")
col <- col[1]
}
col <- as.character(col)
if (!is.data.frame(tbl)) {
stop("`tbl` must be a data.frame")
}
tbl_names <- colnames(tbl)
tbl_names_stripped <- colnames(tbl) %>%
strsplit("_") %>%
lapply(function(x) {x[1]}) %>%
unlist()
if (col %in% tbl_names) {
if (verbose == TRUE) {
message(blue(paste0("NOTE: Using column `", bold(col), "` as input for `", col, "`.")))
}
return(col)
}
ab_result <- antibiotics %>%
select(atc:trade_name) %>%
filter_all(any_vars(tolower(.) == tolower(col))) %>%
filter_all(any_vars(. %in% tbl_names))
if (nrow(ab_result) == 0 & nchar(col) >= 5) {
# use like when col >= 5 characters
ab_result <- antibiotics %>%
select(atc:trade_name) %>%
filter_all(any_vars(tolower(.) %like% tolower(col))) %>%
filter_all(any_vars(. %in% tbl_names))
}
# WHONET
if (nrow(ab_result) == 0) {
# use like for any case
ab_result <- antibiotics %>%
select(atc:trade_name) %>%
filter_all(any_vars(tolower(.) == tolower(col))) %>%
filter_all(any_vars(. %in% tbl_names_stripped))
}
found_based_on_official_name <- FALSE
if (nrow(ab_result) == 0) {
# check if first part of official name resembles the columns that's been looking for
name <- suppressWarnings(atc_name(col))
if (!is.null(name)) {
ab_result <-
antibiotics %>%
filter(official == name) %>%
pull(official)
ab_result <- tbl_names[tbl_names %like% paste0("^", substr(ab_result, 1, 5))]
found_based_on_official_name <- TRUE
}
}
if (NROW(ab_result) > 1 & found_based_on_official_name == FALSE) {
# looking more and more for reliable hit
ab_result_1 <- ab_result %>% filter(tolower(atc) == tolower(col))
if (nrow(ab_result_1) == 0) {
ab_result_1 <- ab_result %>% filter(tolower(certe) == tolower(col))
}
if (nrow(ab_result_1) == 0) {
ab_result_1 <- ab_result %>% filter(tolower(umcg) == tolower(col))
}
if (nrow(ab_result_1) == 0) {
ab_result_1 <- ab_result %>% filter(tolower(official) == tolower(col))
}
if (nrow(ab_result_1) == 0) {
ab_result_1 <- ab_result %>% filter(tolower(official) == tolower(col))
}
if (nrow(ab_result_1) == 0) {
ab_result_1 <- ab_result[1, ]
}
ab_result <- ab_result_1
if (col %in% colnames(tbl)) {
ab_result <- col
} else {
# sort colnames on length - longest first
cols <- colnames(tbl[, tbl %>% colnames() %>% nchar() %>% order() %>% rev()])
df_trans <- data.frame(cols = cols,
abs = suppressWarnings(as.ab(cols)),
stringsAsFactors = FALSE)
ab_result <- df_trans[which(df_trans$abs == as.ab(col)), "cols"]
ab_result <- ab_result[!is.na(ab_result)][1L]
}
if (length(ab_result) == 0) {
@ -139,19 +83,9 @@ guess_ab_col <- function(tbl = NULL, col = NULL, verbose = FALSE) {
}
return(NULL)
} else {
result <- tbl_names[tbl_names %in% ab_result]
if (length(result) == 0) {
result <- tbl_names[tbl_names_stripped %in% ab_result]
}
if (length(result) == 0 | length(result) > 1) {
if (verbose == TRUE) {
message('No column found as input for `', col, '`.')
}
return(NULL)
}
if (verbose == TRUE) {
message(blue(paste0("NOTE: Using column `", bold(result), "` as input for `", col, "`.")))
message(blue(paste0("NOTE: Using column `", bold(ab_result), "` as input for `", col, "`.")))
}
return(result)
return(ab_result)
}
}