mirror of
https://github.com/msberends/AMR.git
synced 2025-07-08 23:21:56 +02:00
faster determination of abx
This commit is contained in:
@ -291,7 +291,8 @@ eucast_rules <- function(x,
|
||||
"SXT",
|
||||
"VAN"),
|
||||
hard_dependencies = NULL,
|
||||
verbose = verbose)
|
||||
verbose = verbose,
|
||||
...)
|
||||
|
||||
AMC <- cols_ab['AMC']
|
||||
AMK <- cols_ab['AMK']
|
||||
|
||||
314
R/mdro.R
314
R/mdro.R
@ -64,41 +64,41 @@ mdro <- function(x,
|
||||
}
|
||||
|
||||
if (length(country) > 1) {
|
||||
stop('`country` must be a length one character string.', call. = FALSE)
|
||||
stop("`country` must be a length one character string.", call. = FALSE)
|
||||
}
|
||||
|
||||
if (is.null(country)) {
|
||||
country <- 'EUCAST'
|
||||
country <- "EUCAST"
|
||||
}
|
||||
country <- trimws(country)
|
||||
if (tolower(country) != 'eucast' & !country %like% '^[a-z]{2}$') {
|
||||
stop('This is not a valid ISO 3166-1 alpha-2 country code: "', country, '". Please see ?mdro.', call. = FALSE)
|
||||
if (tolower(country) != "eucast" & !country %like% "^[a-z]{2}$") {
|
||||
stop("This is not a valid ISO 3166-1 alpha-2 country code: '", country, "'. Please see ?mdro.", call. = FALSE)
|
||||
}
|
||||
|
||||
# create list and make country code case-independent
|
||||
guideline <- list(country = list(code = tolower(country)))
|
||||
|
||||
if (guideline$country$code == 'eucast') {
|
||||
guideline$country$name <- '(European guidelines)'
|
||||
guideline$name <- 'EUCAST Expert Rules, "Intrinsic Resistance and Exceptional Phenotypes Tables"'
|
||||
guideline$version <- 'Version 3.1'
|
||||
guideline$source <- 'http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf'
|
||||
if (guideline$country$code == "eucast") {
|
||||
guideline$country$name <- "(European guidelines)"
|
||||
guideline$name <- "EUCAST Expert Rules, \"Intrinsic Resistance and Exceptional Phenotypes Tables\""
|
||||
guideline$version <- "Version 3.1"
|
||||
guideline$source <- "http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf"
|
||||
# support per country:
|
||||
} else if (guideline$country$code == 'de') {
|
||||
guideline$country$name <- 'Germany'
|
||||
guideline$name <- ''
|
||||
guideline$version <- ''
|
||||
guideline$source <- ''
|
||||
} else if (guideline$country$code == 'nl') {
|
||||
guideline$country$name <- 'The Netherlands'
|
||||
guideline$name <- 'WIP-Richtlijn BRMO'
|
||||
guideline$version <- 'Revision as of December 2017'
|
||||
guideline$source <- 'https://www.rivm.nl/Documenten_en_publicaties/Professioneel_Praktisch/Richtlijnen/Infectieziekten/WIP_Richtlijnen/WIP_Richtlijnen/Ziekenhuizen/WIP_richtlijn_BRMO_Bijzonder_Resistente_Micro_Organismen_ZKH'
|
||||
} else if (guideline$country$code == "de") {
|
||||
guideline$country$name <- "Germany"
|
||||
guideline$name <- ""
|
||||
guideline$version <- ""
|
||||
guideline$source <- ""
|
||||
} else if (guideline$country$code == "nl") {
|
||||
guideline$country$name <- "The Netherlands"
|
||||
guideline$name <- "WIP-Richtlijn BRMO"
|
||||
guideline$version <- "Revision as of December 2017"
|
||||
guideline$source <- "https://www.rivm.nl/Documenten_en_publicaties/Professioneel_Praktisch/Richtlijnen/Infectieziekten/WIP_Richtlijnen/WIP_Richtlijnen/Ziekenhuizen/WIP_richtlijn_BRMO_Bijzonder_Resistente_Micro_Organismen_ZKH"
|
||||
# add here more countries like this:
|
||||
# } else if (country$code == 'xx') {
|
||||
# country$name <- 'country name'
|
||||
# } else if (country$code == "xx") {
|
||||
# country$name <- "country name"
|
||||
} else {
|
||||
stop('This country code is currently unsupported: ', guideline$country$code, call. = FALSE)
|
||||
stop("This country code is currently unsupported: ", guideline$country$code, call. = FALSE)
|
||||
}
|
||||
|
||||
if (info == TRUE) {
|
||||
@ -110,71 +110,71 @@ mdro <- function(x,
|
||||
}
|
||||
|
||||
|
||||
cols_ab <- get_column_abx(x = x, verbose = verbose)
|
||||
cols_ab <- get_column_abx(x = x, verbose = verbose, ...)
|
||||
|
||||
AMC <- cols_ab['AMC']
|
||||
AMK <- cols_ab['AMK']
|
||||
AMP <- cols_ab['AMP']
|
||||
AMX <- cols_ab['AMX']
|
||||
ATM <- cols_ab['ATM']
|
||||
AZL <- cols_ab['AZL']
|
||||
AZM <- cols_ab['AZM']
|
||||
CAZ <- cols_ab['CAZ']
|
||||
CED <- cols_ab['CED']
|
||||
CHL <- cols_ab['CHL']
|
||||
CIP <- cols_ab['CIP']
|
||||
CLI <- cols_ab['CLI']
|
||||
CLR <- cols_ab['CLR']
|
||||
COL <- cols_ab['COL']
|
||||
CRO <- cols_ab['CRO']
|
||||
CTX <- cols_ab['CTX']
|
||||
CXM <- cols_ab['CXM']
|
||||
CZO <- cols_ab['CZO']
|
||||
DAP <- cols_ab['DAP']
|
||||
DOX <- cols_ab['DOX']
|
||||
ERY <- cols_ab['ERY']
|
||||
ETP <- cols_ab['ETP']
|
||||
FEP <- cols_ab['FEP']
|
||||
FLC <- cols_ab['FLC']
|
||||
FOS <- cols_ab['FOS']
|
||||
FOX <- cols_ab['FOX']
|
||||
FUS <- cols_ab['FUS']
|
||||
GEN <- cols_ab['GEN']
|
||||
IPM <- cols_ab['IPM']
|
||||
KAN <- cols_ab['KAN']
|
||||
LIN <- cols_ab['LIN']
|
||||
LNZ <- cols_ab['LNZ']
|
||||
LVX <- cols_ab['LVX']
|
||||
MEM <- cols_ab['MEM']
|
||||
MEZ <- cols_ab['MEZ']
|
||||
MTR <- cols_ab['MTR']
|
||||
MFX <- cols_ab['MFX']
|
||||
MNO <- cols_ab['MNO']
|
||||
NAL <- cols_ab['NAL']
|
||||
NEO <- cols_ab['NEO']
|
||||
NET <- cols_ab['NET']
|
||||
NIT <- cols_ab['NIT']
|
||||
NOR <- cols_ab['NOR']
|
||||
NOV <- cols_ab['NOV']
|
||||
OFX <- cols_ab['OFX']
|
||||
PEN <- cols_ab['PEN']
|
||||
PIP <- cols_ab['PIP']
|
||||
PLB <- cols_ab['PLB']
|
||||
PRI <- cols_ab['PRI']
|
||||
QDA <- cols_ab['QDA']
|
||||
RID <- cols_ab['RID']
|
||||
RIF <- cols_ab['RIF']
|
||||
RXT <- cols_ab['RXT']
|
||||
SIS <- cols_ab['SIS']
|
||||
SXT <- cols_ab['SXT']
|
||||
TCY <- cols_ab['TCY']
|
||||
TEC <- cols_ab['TEC']
|
||||
TGC <- cols_ab['TGC']
|
||||
TIC <- cols_ab['TIC']
|
||||
TMP <- cols_ab['TMP']
|
||||
TOB <- cols_ab['TOB']
|
||||
TZP <- cols_ab['TZP']
|
||||
VAN <- cols_ab['VAN']
|
||||
AMC <- cols_ab["AMC"]
|
||||
AMK <- cols_ab["AMK"]
|
||||
AMP <- cols_ab["AMP"]
|
||||
AMX <- cols_ab["AMX"]
|
||||
ATM <- cols_ab["ATM"]
|
||||
AZL <- cols_ab["AZL"]
|
||||
AZM <- cols_ab["AZM"]
|
||||
CAZ <- cols_ab["CAZ"]
|
||||
CED <- cols_ab["CED"]
|
||||
CHL <- cols_ab["CHL"]
|
||||
CIP <- cols_ab["CIP"]
|
||||
CLI <- cols_ab["CLI"]
|
||||
CLR <- cols_ab["CLR"]
|
||||
COL <- cols_ab["COL"]
|
||||
CRO <- cols_ab["CRO"]
|
||||
CTX <- cols_ab["CTX"]
|
||||
CXM <- cols_ab["CXM"]
|
||||
CZO <- cols_ab["CZO"]
|
||||
DAP <- cols_ab["DAP"]
|
||||
DOX <- cols_ab["DOX"]
|
||||
ERY <- cols_ab["ERY"]
|
||||
ETP <- cols_ab["ETP"]
|
||||
FEP <- cols_ab["FEP"]
|
||||
FLC <- cols_ab["FLC"]
|
||||
FOS <- cols_ab["FOS"]
|
||||
FOX <- cols_ab["FOX"]
|
||||
FUS <- cols_ab["FUS"]
|
||||
GEN <- cols_ab["GEN"]
|
||||
IPM <- cols_ab["IPM"]
|
||||
KAN <- cols_ab["KAN"]
|
||||
LIN <- cols_ab["LIN"]
|
||||
LNZ <- cols_ab["LNZ"]
|
||||
LVX <- cols_ab["LVX"]
|
||||
MEM <- cols_ab["MEM"]
|
||||
MEZ <- cols_ab["MEZ"]
|
||||
MTR <- cols_ab["MTR"]
|
||||
MFX <- cols_ab["MFX"]
|
||||
MNO <- cols_ab["MNO"]
|
||||
NAL <- cols_ab["NAL"]
|
||||
NEO <- cols_ab["NEO"]
|
||||
NET <- cols_ab["NET"]
|
||||
NIT <- cols_ab["NIT"]
|
||||
NOR <- cols_ab["NOR"]
|
||||
NOV <- cols_ab["NOV"]
|
||||
OFX <- cols_ab["OFX"]
|
||||
PEN <- cols_ab["PEN"]
|
||||
PIP <- cols_ab["PIP"]
|
||||
PLB <- cols_ab["PLB"]
|
||||
PRI <- cols_ab["PRI"]
|
||||
QDA <- cols_ab["QDA"]
|
||||
RID <- cols_ab["RID"]
|
||||
RIF <- cols_ab["RIF"]
|
||||
RXT <- cols_ab["RXT"]
|
||||
SIS <- cols_ab["SIS"]
|
||||
SXT <- cols_ab["SXT"]
|
||||
TCY <- cols_ab["TCY"]
|
||||
TEC <- cols_ab["TEC"]
|
||||
TGC <- cols_ab["TGC"]
|
||||
TIC <- cols_ab["TIC"]
|
||||
TMP <- cols_ab["TMP"]
|
||||
TOB <- cols_ab["TOB"]
|
||||
TZP <- cols_ab["TZP"]
|
||||
VAN <- cols_ab["VAN"]
|
||||
|
||||
|
||||
ab_missing <- function(ab) {
|
||||
@ -194,15 +194,15 @@ mdro <- function(x,
|
||||
cols <- cols[!is.na(cols)]
|
||||
if (length(rows) > 0 & length(cols) > 0) {
|
||||
if (any_all == "any") {
|
||||
col_filter <- which(tbl_[, cols] == 'R')
|
||||
row_filter <- which(tbl_[, cols] == "R")
|
||||
} else if (any_all == "all") {
|
||||
col_filter <- tbl_ %>%
|
||||
row_filter <- tbl_ %>%
|
||||
mutate(index = 1:nrow(.)) %>%
|
||||
filter_at(vars(cols), all_vars(. == "R")) %>%
|
||||
pull((index))
|
||||
}
|
||||
rows <- rows[rows %in% col_filter]
|
||||
tbl_[rows, 'MDRO'] <<- to
|
||||
rows <- rows[rows %in% row_filter]
|
||||
tbl_[rows, "MDRO"] <<- to
|
||||
}
|
||||
}
|
||||
|
||||
@ -213,105 +213,117 @@ mdro <- function(x,
|
||||
# add unconfirmed to where genus is available
|
||||
mutate(MDRO = ifelse(!is.na(genus), 1, NA_integer_))
|
||||
|
||||
if (guideline$country$code == 'eucast') {
|
||||
if (guideline$country$code == "eucast") {
|
||||
# EUCAST ------------------------------------------------------------------
|
||||
# Table 5
|
||||
trans_tbl(3,
|
||||
which(tbl_$family == 'Enterobacteriaceae'
|
||||
| tbl_$fullname %like% '^Pseudomonas aeruginosa'
|
||||
| tbl_$genus == 'Acinetobacter'),
|
||||
which(tbl_$family == "Enterobacteriaceae"
|
||||
| tbl_$fullname %like% "^Pseudomonas aeruginosa"
|
||||
| tbl_$genus == "Acinetobacter"),
|
||||
COL,
|
||||
"all")
|
||||
trans_tbl(3,
|
||||
which(tbl_$fullname %like% '^Salmonella Typhi'),
|
||||
which(tbl_$fullname %like% "^Salmonella Typhi"),
|
||||
c(carbapenems, fluoroquinolones),
|
||||
"any")
|
||||
trans_tbl(3,
|
||||
which(tbl_$fullname %like% '^Haemophilus influenzae'),
|
||||
which(tbl_$fullname %like% "^Haemophilus influenzae"),
|
||||
c(cephalosporins_3rd, carbapenems, fluoroquinolones),
|
||||
"any")
|
||||
trans_tbl(3,
|
||||
which(tbl_$fullname %like% '^Moraxella catarrhalis'),
|
||||
which(tbl_$fullname %like% "^Moraxella catarrhalis"),
|
||||
c(cephalosporins_3rd, fluoroquinolones),
|
||||
"any")
|
||||
trans_tbl(3,
|
||||
which(tbl_$fullname %like% '^Neisseria meningitidis'),
|
||||
which(tbl_$fullname %like% "^Neisseria meningitidis"),
|
||||
c(cephalosporins_3rd, fluoroquinolones),
|
||||
"any")
|
||||
trans_tbl(3,
|
||||
which(tbl_$fullname %like% '^Neisseria gonorrhoeae'),
|
||||
which(tbl_$fullname %like% "^Neisseria gonorrhoeae"),
|
||||
AZM,
|
||||
"any")
|
||||
# Table 6
|
||||
trans_tbl(3,
|
||||
which(tbl_$fullname %like% '^Staphylococcus (aureus|epidermidis|coagulase negatief|hominis|haemolyticus|intermedius|pseudointermedius)'),
|
||||
which(tbl_$fullname %like% "^Staphylococcus (aureus|epidermidis|coagulase negatief|hominis|haemolyticus|intermedius|pseudointermedius)"),
|
||||
c(VAN, TEC, DAP, LNZ, QDA, TGC),
|
||||
"any")
|
||||
trans_tbl(3,
|
||||
which(tbl_$genus == 'Corynebacterium'),
|
||||
which(tbl_$genus == "Corynebacterium"),
|
||||
c(VAN, TEC, DAP, LNZ, QDA, TGC),
|
||||
"any")
|
||||
trans_tbl(3,
|
||||
which(tbl_$fullname %like% '^Streptococcus pneumoniae'),
|
||||
which(tbl_$fullname %like% "^Streptococcus pneumoniae"),
|
||||
c(carbapenems, VAN, TEC, DAP, LNZ, QDA, TGC, RIF),
|
||||
"any")
|
||||
trans_tbl(3, # Sr. groups A/B/C/G
|
||||
which(tbl_$fullname %like% '^Streptococcus (pyogenes|agalactiae|equisimilis|equi|zooepidemicus|dysgalactiae|anginosus)'),
|
||||
which(tbl_$fullname %like% "^Streptococcus (pyogenes|agalactiae|equisimilis|equi|zooepidemicus|dysgalactiae|anginosus)"),
|
||||
c(PEN, cephalosporins, VAN, TEC, DAP, LNZ, QDA, TGC),
|
||||
"any")
|
||||
trans_tbl(3,
|
||||
which(tbl_$genus == 'Enterococcus'),
|
||||
which(tbl_$genus == "Enterococcus"),
|
||||
c(DAP, LNZ, TGC, TEC),
|
||||
"any")
|
||||
trans_tbl(3,
|
||||
which(tbl_$fullname %like% '^Enterococcus faecalis'),
|
||||
which(tbl_$fullname %like% "^Enterococcus faecalis"),
|
||||
c(AMP, AMX),
|
||||
"any")
|
||||
# Table 7
|
||||
trans_tbl(3,
|
||||
which(tbl_$genus == 'Bacteroides'),
|
||||
which(tbl_$genus == "Bacteroides"),
|
||||
MTR,
|
||||
"any")
|
||||
trans_tbl(3,
|
||||
which(tbl_$fullname %like% '^Clostridium difficile'),
|
||||
c( MTR, VAN),
|
||||
which(tbl_$fullname %like% "^Clostridium difficile"),
|
||||
c(MTR, VAN),
|
||||
"any")
|
||||
}
|
||||
|
||||
if (guideline$country$code == 'de') {
|
||||
if (guideline$country$code == "de") {
|
||||
# Germany -----------------------------------------------------------------
|
||||
stop("We are still working on German guidelines in this beta version.", call. = FALSE)
|
||||
}
|
||||
|
||||
if (guideline$country$code == 'nl') {
|
||||
if (guideline$country$code == "nl") {
|
||||
# Netherlands -------------------------------------------------------------
|
||||
aminoglycosides <- aminoglycosides[!ab_missing(aminoglycosides)]
|
||||
fluoroquinolones <- fluoroquinolones[!ab_missing(fluoroquinolones)]
|
||||
carbapenems <- carbapenems[!ab_missing(carbapenems)]
|
||||
aminoglycosides <- aminoglycosides[!is.na(aminoglycosides)]
|
||||
fluoroquinolones <- fluoroquinolones[!is.na(fluoroquinolones)]
|
||||
carbapenems <- carbapenems[!is.na(carbapenems)]
|
||||
amino <- AMX %or% AMP
|
||||
third <- CAZ %or% CTX
|
||||
ESBLs <- c(amino, third)
|
||||
ESBLs <- ESBLs[!is.na(ESBLs)]
|
||||
if (length(ESBLs) != 2) {
|
||||
ESBLs <- character(0)
|
||||
}
|
||||
|
||||
# Table 1
|
||||
trans_tbl(3,
|
||||
which(tbl_$family == 'Enterobacteriaceae'),
|
||||
which(tbl_$family == "Enterobacteriaceae"),
|
||||
c(aminoglycosides, fluoroquinolones),
|
||||
"all")
|
||||
|
||||
trans_tbl(2,
|
||||
which(tbl_$family == 'Enterobacteriaceae'),
|
||||
c(carbapenems),
|
||||
which(tbl_$family == "Enterobacteriaceae"),
|
||||
carbapenems,
|
||||
"any")
|
||||
|
||||
trans_tbl(2,
|
||||
which(tbl_$family == "Enterobacteriaceae"),
|
||||
ESBLs,
|
||||
"all")
|
||||
|
||||
# Table 2
|
||||
trans_tbl(2,
|
||||
which(tbl_$genus == 'Acinetobacter'),
|
||||
which(tbl_$genus == "Acinetobacter"),
|
||||
c(carbapenems),
|
||||
"any")
|
||||
trans_tbl(3,
|
||||
which(tbl_$genus == 'Acinetobacter'),
|
||||
which(tbl_$genus == "Acinetobacter"),
|
||||
c(aminoglycosides, fluoroquinolones),
|
||||
"all")
|
||||
|
||||
trans_tbl(3,
|
||||
which(tbl_$fullname %like% '^Stenotrophomonas maltophilia'),
|
||||
which(tbl_$fullname %like% "^Stenotrophomonas maltophilia"),
|
||||
SXT,
|
||||
"all")
|
||||
|
||||
@ -330,28 +342,28 @@ mdro <- function(x,
|
||||
tbl_$psae <- 0
|
||||
}
|
||||
tbl_[which(
|
||||
tbl_$fullname %like% 'Pseudomonas aeruginosa'
|
||||
tbl_$fullname %like% "Pseudomonas aeruginosa"
|
||||
& tbl_$psae >= 3
|
||||
), 'MDRO'] <- 3
|
||||
), "MDRO"] <- 3
|
||||
|
||||
# Table 3
|
||||
trans_tbl(3,
|
||||
which(tbl_$fullname %like% 'Streptococcus pneumoniae'),
|
||||
which(tbl_$fullname %like% "Streptococcus pneumoniae"),
|
||||
PEN,
|
||||
"all")
|
||||
trans_tbl(3,
|
||||
which(tbl_$fullname %like% 'Streptococcus pneumoniae'),
|
||||
which(tbl_$fullname %like% "Streptococcus pneumoniae"),
|
||||
VAN,
|
||||
"all")
|
||||
trans_tbl(3,
|
||||
which(tbl_$fullname %like% 'Enterococcus faecium'),
|
||||
which(tbl_$fullname %like% "Enterococcus faecium"),
|
||||
c(PEN, VAN),
|
||||
"all")
|
||||
}
|
||||
|
||||
factor(x = tbl_$MDRO,
|
||||
levels = 1:3,
|
||||
labels = c('Negative', 'Positive, unconfirmed', 'Positive'),
|
||||
labels = c("Negative", "Positive, unconfirmed", "Positive"),
|
||||
ordered = TRUE)
|
||||
}
|
||||
|
||||
@ -372,55 +384,3 @@ mrgn <- function(x, country = "de", ...) {
|
||||
eucast_exceptional_phenotypes <- function(x, country = "EUCAST", ...) {
|
||||
mdro(x = x, country = "EUCAST", ...)
|
||||
}
|
||||
|
||||
# is_ESBL <- function(x, col_mo = NULL, ...) {
|
||||
# get_ab_col <- function(columns, ab) {
|
||||
# columns[names(columns) == ab]
|
||||
# }
|
||||
# col_mo <- get_column_mo(tbl = x, col_mo = col_mo)
|
||||
# cols_ab <- get_column_abx(tbl = x,
|
||||
# soft_dependencies = c("AMX", "AMP"),
|
||||
# hard_dependencies = c("CAZ"),
|
||||
# ...)
|
||||
#
|
||||
# if (!any(c("AMX", "AMP") %in% names(cols_ab))) {
|
||||
# # both ampicillin and amoxicillin are missing
|
||||
# generate_warning_abs_missing(c("AMX", "AMP"), any = TRUE)
|
||||
# return(rep(NA, nrow(x)))
|
||||
# }
|
||||
#
|
||||
# ESBLs <- rep(NA, nrow(x))
|
||||
#
|
||||
# # first make all eligible cases FALSE
|
||||
# ESBLs[which(mo_family(x[, col_mo]) == "Enterobacteriaceae"
|
||||
# & x[, get_ab_col(cols_ab, "AMX")] %in% c("R", "I", "S")
|
||||
# & x[, get_ab_col(cols_ab, "AMX")] %in% c("R", "I", "S")
|
||||
# & x[, get_ab_col(cols_ab, "AMX")] %in% c("R", "I", "S")
|
||||
# )] <- FALSE
|
||||
# # now make the positives cases TRUE
|
||||
# ESBLs[which(!is.na(ESBLs)
|
||||
# & x[, get_ab_col(cols_ab, "AMX")] == "R"
|
||||
# & x[, get_ab_col(cols_ab, "CAZ")] == "R")] <- TRUE
|
||||
# ESBLs
|
||||
#
|
||||
# }
|
||||
#
|
||||
# is_3MRGN <- function(x, ...) {
|
||||
#
|
||||
# }
|
||||
#
|
||||
# is_4MRGN <- function(x, ...) {
|
||||
#
|
||||
# }
|
||||
|
||||
get_column_mo <- function(tbl, col_mo = NULL) {
|
||||
# throws a blue note about which column will be used if guessed
|
||||
if (is.null(col_mo)) {
|
||||
col_mo <- search_type_in_df(tbl = tbl, type = "mo")
|
||||
}
|
||||
if (is.null(col_mo)) {
|
||||
stop("`col_mo` must be set.", call. = FALSE)
|
||||
}
|
||||
col_mo
|
||||
}
|
||||
|
||||
|
||||
43
R/misc.R
43
R/misc.R
@ -157,23 +157,56 @@ search_type_in_df <- function(tbl, type) {
|
||||
get_column_abx <- function(x,
|
||||
soft_dependencies = NULL,
|
||||
hard_dependencies = NULL,
|
||||
verbose = FALSE) {
|
||||
verbose = FALSE,
|
||||
...) {
|
||||
|
||||
# determine from given data set
|
||||
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
|
||||
|
||||
# add from self-defined dots (...):
|
||||
# get_column_abx(septic_patients %>% rename(thisone = AMX), amox = "thisone")
|
||||
dots <- list(...)
|
||||
if (length(dots) > 0) {
|
||||
dots <- unlist(dots)
|
||||
newnames <- suppressWarnings(as.ab(names(dots)))
|
||||
if (any(is.na(newnames))) {
|
||||
warning("Invalid antibiotic reference(s): ", toString(names(dots)[is.na(newnames)]),
|
||||
call. = FALSE, immediate. = TRUE)
|
||||
}
|
||||
names(dots) <- newnames
|
||||
dots <- dots[!is.na(names(dots))]
|
||||
# merge, but overwrite automatically determined ones by 'dots'
|
||||
x <- c(x[!x %in% dots & !names(x) %in% names(dots)], dots)
|
||||
}
|
||||
|
||||
# sort on name
|
||||
x <- x[sort(names(x))]
|
||||
duplies <- x[base::duplicated(x)]
|
||||
|
||||
if (verbose == TRUE) {
|
||||
for (i in 1:length(x)) {
|
||||
message(blue(paste0("NOTE: Using column `", bold(x[i]), "` as input for ", names(x)[i],
|
||||
" (", ab_name(names(x)[i], language = "en", tolower = TRUE), ").")))
|
||||
if (x[i] %in% duplies) {
|
||||
message(red(paste0("NOTE: Using column `", bold(x[i]), "` as input for ", names(x)[i],
|
||||
" (", ab_name(names(x)[i], language = "en", tolower = TRUE), ") [DUPLICATED USE].")))
|
||||
} else {
|
||||
message(blue(paste0("NOTE: Using column `", bold(x[i]), "` as input for ", names(x)[i],
|
||||
" (", ab_name(names(x)[i], language = "en", tolower = TRUE), ").")))
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (n_distinct(x) != length(x)) {
|
||||
msg_txt <- paste("Column(s)", paste0("'", duplies, "'", collapse = "'"), "used for more than one antibiotic.")
|
||||
if (verbose == FALSE) {
|
||||
msg_txt <- paste(msg_txt, "Use verbose = TRUE to see which antibiotics are used by which columns.")
|
||||
}
|
||||
stop(msg_txt, call. = FALSE)
|
||||
}
|
||||
|
||||
if (!is.null(hard_dependencies)) {
|
||||
if (!all(hard_dependencies %in% names(x))) {
|
||||
# missing a hard dependency will return NA and consequently the data will not be analysed
|
||||
@ -275,3 +308,7 @@ t <- function(from, language = get_locale()) {
|
||||
base::enc2utf8(from)
|
||||
|
||||
}
|
||||
|
||||
"%or%" <- function(x, y) {
|
||||
ifelse(!is.na(x), x, ifelse(!is.na(y), y, NA))
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user