AMR/data-raw/_internals.R

285 lines
16 KiB
R
Raw Normal View History

# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Data Analysis for R #
# #
# SOURCE #
# https://github.com/msberends/AMR #
# #
# LICENCE #
2020-12-27 00:30:28 +01:00
# (c) 2018-2021 Berends MS, Luz CF et al. #
2020-10-08 11:16:03 +02:00
# Developed at the University of Groningen, the Netherlands, in #
# collaboration with non-profit organisations Certe Medical #
# Diagnostics & Advice, and University Medical Center Groningen. #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
# the Free Software Foundation. #
# We created this package for both routine data analysis and academic #
# research and it was publicly released in the hope that it will be #
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
2020-10-08 11:16:03 +02:00
# #
# Visit our website for the full manual and a complete tutorial about #
# how to conduct AMR data analysis: https://msberends.github.io/AMR/ #
# ==================================================================== #
# Run this file to update the package using:
# source("data-raw/_internals.R")
2020-09-24 00:30:11 +02:00
library(dplyr, warn.conflicts = FALSE)
devtools::load_all(quiet = TRUE)
old_globalenv <- ls(envir = globalenv())
2021-04-07 08:37:42 +02:00
# Save internal data to R/sysdata.rda -------------------------------------
# See 'data-raw/eucast_rules.tsv' for the EUCAST reference file
EUCAST_RULES_DF <- utils::read.delim(file = "data-raw/eucast_rules.tsv",
2020-09-14 12:21:23 +02:00
skip = 10,
sep = "\t",
stringsAsFactors = FALSE,
header = TRUE,
strip.white = TRUE,
2020-09-24 00:30:11 +02:00
na = c(NA, "", NULL)) %>%
# take the order of the reference.rule_group column in the original data file
mutate(reference.rule_group = factor(reference.rule_group,
levels = unique(reference.rule_group),
ordered = TRUE),
sorting_rule = ifelse(grepl("^Table", reference.rule, ignore.case = TRUE), 1, 2)) %>%
arrange(reference.rule_group,
reference.version,
sorting_rule,
reference.rule) %>%
mutate(reference.rule_group = as.character(reference.rule_group)) %>%
select(-sorting_rule)
# Translations
TRANSLATIONS <- utils::read.delim(file = "data-raw/translations.tsv",
2019-06-01 20:40:49 +02:00
sep = "\t",
stringsAsFactors = FALSE,
header = TRUE,
blank.lines.skip = TRUE,
fill = TRUE,
strip.white = TRUE,
encoding = "UTF-8",
fileEncoding = "UTF-8",
na.strings = c(NA, "", NULL),
allowEscapes = TRUE, # else "\\1" will be imported as "\\\\1"
quote = "")
2019-06-01 20:40:49 +02:00
# for checking input in `language` argument in e.g. mo_*() and ab_*() functions
LANGUAGES_SUPPORTED <- sort(c("en", colnames(TRANSLATIONS)[nchar(colnames(TRANSLATIONS)) == 2]))
# vectors of CoNS and CoPS, improves speed in as.mo()
2021-05-30 22:14:38 +02:00
create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
# Determination of which staphylococcal species are CoNS/CoPS according to:
# - Becker et al. 2014, PMID 25278577
# - Becker et al. 2019, PMID 30872103
# - Becker et al. 2020, PMID 32056452
# this function returns class <mo>
MO_staph <- AMR::microorganisms
MO_staph <- MO_staph[which(MO_staph$genus == "Staphylococcus"), , drop = FALSE]
if (type == "CoNS") {
MO_staph[which(MO_staph$species %in% c("coagulase-negative", "argensis", "arlettae",
"auricularis", "borealis", "caeli", "capitis", "caprae",
"carnosus", "casei", "chromogenes", "cohnii", "condimenti",
"croceilyticus",
"debuckii", "devriesei", "edaphicus", "epidermidis",
"equorum", "felis", "fleurettii", "gallinarum",
"haemolyticus", "hominis", "jettensis", "kloosii",
"lentus", "lugdunensis", "massiliensis", "microti",
"muscae", "nepalensis", "pasteuri", "petrasii",
"pettenkoferi", "piscifermentans", "pragensis", "pseudoxylosus",
"pulvereri", "rostri", "saccharolyticus", "saprophyticus",
"sciuri", "simulans", "stepanovicii", "succinus",
"ureilyticus",
"vitulinus", "vitulus", "warneri", "xylosus")
| (MO_staph$species == "schleiferi" & MO_staph$subspecies %in% c("schleiferi", ""))),
"mo", drop = TRUE]
} else if (type == "CoPS") {
MO_staph[which(MO_staph$species %in% c("coagulase-positive", "coagulans",
"agnetis", "argenteus",
"cornubiensis",
"delphini", "lutrae",
"hyicus", "intermedius",
"pseudintermedius", "pseudointermedius",
"schweitzeri", "simiae")
| (MO_staph$species == "schleiferi" & MO_staph$subspecies == "coagulans")),
"mo", drop = TRUE]
}
}
MO_CONS <- create_species_cons_cops("CoNS")
MO_COPS <- create_species_cons_cops("CoPS")
2021-04-07 08:37:42 +02:00
# antibiotic groups
# (these will also be used for eucast_rules() and understanding data-raw/eucast_rules.tsv)
globalenv_before_ab <- c(ls(envir = globalenv()), "globalenv_before_ab")
AMINOGLYCOSIDES <- antibiotics %>% filter(group %like% "aminoglycoside") %>% pull(ab)
AMINOPENICILLINS <- as.ab(c("AMP", "AMX"))
CARBAPENEMS <- antibiotics %>% filter(group %like% "carbapenem") %>% pull(ab)
CEPHALOSPORINS <- antibiotics %>% filter(group %like% "cephalosporin") %>% pull(ab)
CEPHALOSPORINS_1ST <- antibiotics %>% filter(group %like% "cephalosporin.*1") %>% pull(ab)
CEPHALOSPORINS_2ND <- antibiotics %>% filter(group %like% "cephalosporin.*2") %>% pull(ab)
CEPHALOSPORINS_3RD <- antibiotics %>% filter(group %like% "cephalosporin.*3") %>% pull(ab)
CEPHALOSPORINS_4TH <- antibiotics %>% filter(group %like% "cephalosporin.*4") %>% pull(ab)
CEPHALOSPORINS_5TH <- antibiotics %>% filter(group %like% "cephalosporin.*5") %>% pull(ab)
2021-04-07 08:37:42 +02:00
CEPHALOSPORINS_EXCEPT_CAZ <- CEPHALOSPORINS[CEPHALOSPORINS != "CAZ"]
FLUOROQUINOLONES <- antibiotics %>% filter(atc_group2 %like% "fluoroquinolone" | (group %like% "quinolone" & is.na(atc_group2))) %>% pull(ab)
2021-04-07 08:37:42 +02:00
LIPOGLYCOPEPTIDES <- as.ab(c("DAL", "ORI", "TLV")) # dalba/orita/tela
GLYCOPEPTIDES <- antibiotics %>% filter(group %like% "glycopeptide") %>% pull(ab)
GLYCOPEPTIDES_EXCEPT_LIPO <- GLYCOPEPTIDES[!GLYCOPEPTIDES %in% LIPOGLYCOPEPTIDES]
LINCOSAMIDES <- antibiotics %>% filter(atc_group2 %like% "lincosamide" | (group %like% "lincosamide" & is.na(atc_group2))) %>% pull(ab)
MACROLIDES <- antibiotics %>% filter(atc_group2 %like% "macrolide" | (group %like% "macrolide" & is.na(atc_group2))) %>% pull(ab)
2021-04-07 08:37:42 +02:00
OXAZOLIDINONES <- antibiotics %>% filter(group %like% "oxazolidinone") %>% pull(ab)
PENICILLINS <- antibiotics %>% filter(group %like% "penicillin") %>% pull(ab)
POLYMYXINS <- antibiotics %>% filter(group %like% "polymyxin") %>% pull(ab)
QUINOLONES <- antibiotics %>% filter(group %like% "quinolone") %>% pull(ab)
2021-04-07 08:37:42 +02:00
STREPTOGRAMINS <- antibiotics %>% filter(atc_group2 %like% "streptogramin") %>% pull(ab)
TETRACYCLINES <- antibiotics %>% filter(group %like% "tetracycline") %>% pull(ab)
2021-04-07 08:37:42 +02:00
TETRACYCLINES_EXCEPT_TGC <- TETRACYCLINES[TETRACYCLINES != "TGC"]
UREIDOPENICILLINS <- as.ab(c("PIP", "TZP", "AZL", "MEZ"))
BETALACTAMS <- c(PENICILLINS, CEPHALOSPORINS, CARBAPENEMS)
DEFINED_AB_GROUPS <- ls(envir = globalenv())
DEFINED_AB_GROUPS <- DEFINED_AB_GROUPS[!DEFINED_AB_GROUPS %in% globalenv_before_ab]
2019-06-01 20:40:49 +02:00
# Export to package as internal data ----
usethis::use_data(EUCAST_RULES_DF,
TRANSLATIONS,
LANGUAGES_SUPPORTED,
MO_CONS,
MO_COPS,
2021-04-07 08:37:42 +02:00
AMINOGLYCOSIDES,
AMINOPENICILLINS,
CARBAPENEMS,
CEPHALOSPORINS,
CEPHALOSPORINS_1ST,
CEPHALOSPORINS_2ND,
CEPHALOSPORINS_3RD,
CEPHALOSPORINS_4TH,
CEPHALOSPORINS_5TH,
2021-04-07 08:37:42 +02:00
CEPHALOSPORINS_EXCEPT_CAZ,
FLUOROQUINOLONES,
LIPOGLYCOPEPTIDES,
GLYCOPEPTIDES,
GLYCOPEPTIDES_EXCEPT_LIPO,
LINCOSAMIDES,
MACROLIDES,
OXAZOLIDINONES,
PENICILLINS,
POLYMYXINS,
QUINOLONES,
2021-04-07 08:37:42 +02:00
STREPTOGRAMINS,
TETRACYCLINES,
TETRACYCLINES_EXCEPT_TGC,
UREIDOPENICILLINS,
BETALACTAMS,
DEFINED_AB_GROUPS,
2019-06-01 20:40:49 +02:00
internal = TRUE,
overwrite = TRUE,
2020-09-14 12:21:23 +02:00
version = 2,
compress = "xz")
2019-06-01 20:40:49 +02:00
# Export data sets to the repository in different formats -----------------
2020-09-14 12:21:23 +02:00
write_md5 <- function(object) {
2020-09-24 00:30:11 +02:00
conn <- file(paste0("data-raw/", deparse(substitute(object)), ".md5"))
writeLines(digest::digest(object, "md5"), conn)
close(conn)
2020-09-14 12:21:23 +02:00
}
changed_md5 <- function(object) {
tryCatch({
conn <- file(paste0("data-raw/", deparse(substitute(object)), ".md5"))
compared <- digest::digest(object, "md5") != readLines(con = conn)
close(conn)
compared
}, error = function(e) TRUE)
}
2020-02-14 19:54:13 +01:00
# give official names to ABs and MOs
rsi <- dplyr::mutate(rsi_translation, ab = ab_name(ab), mo = mo_name(mo))
2020-09-14 12:21:23 +02:00
if (changed_md5(rsi)) {
2021-03-11 21:42:30 +01:00
usethis::ui_info(paste0("Saving {usethis::ui_value('rsi_translation')} to {usethis::ui_value('/data-raw/')}"))
2020-09-14 12:21:23 +02:00
write_md5(rsi)
try(saveRDS(rsi, "data-raw/rsi_translation.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(rsi, "data-raw/rsi_translation.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(haven::write_sas(rsi, "data-raw/rsi_translation.sas"), silent = TRUE)
try(haven::write_sav(rsi, "data-raw/rsi_translation.sav"), silent = TRUE)
try(haven::write_dta(rsi, "data-raw/rsi_translation.dta"), silent = TRUE)
try(openxlsx::write.xlsx(rsi, "data-raw/rsi_translation.xlsx"), silent = TRUE)
}
mo <- dplyr::mutate_if(microorganisms, ~!is.numeric(.), as.character)
2020-09-14 12:21:23 +02:00
if (changed_md5(mo)) {
2021-03-11 21:42:30 +01:00
usethis::ui_info(paste0("Saving {usethis::ui_value('microorganisms')} to {usethis::ui_value('/data-raw/')}"))
2020-09-14 12:21:23 +02:00
write_md5(mo)
try(saveRDS(mo, "data-raw/microorganisms.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(mo, "data-raw/microorganisms.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
2021-03-11 21:42:30 +01:00
try(haven::write_sas(dplyr::select(mo, -snomed), "data-raw/microorganisms.sas"), silent = TRUE)
try(haven::write_sav(dplyr::select(mo, -snomed), "data-raw/microorganisms.sav"), silent = TRUE)
try(haven::write_dta(dplyr::select(mo, -snomed), "data-raw/microorganisms.dta"), silent = TRUE)
2020-09-14 12:21:23 +02:00
try(openxlsx::write.xlsx(mo, "data-raw/microorganisms.xlsx"), silent = TRUE)
}
2020-09-14 12:21:23 +02:00
if (changed_md5(microorganisms.old)) {
2021-03-11 21:42:30 +01:00
usethis::ui_info(paste0("Saving {usethis::ui_value('microorganisms.old')} to {usethis::ui_value('/data-raw/')}"))
2020-09-14 12:21:23 +02:00
write_md5(microorganisms.old)
try(saveRDS(microorganisms.old, "data-raw/microorganisms.old.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(microorganisms.old, "data-raw/microorganisms.old.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(haven::write_sas(microorganisms.old, "data-raw/microorganisms.old.sas"), silent = TRUE)
try(haven::write_sav(microorganisms.old, "data-raw/microorganisms.old.sav"), silent = TRUE)
try(haven::write_dta(microorganisms.old, "data-raw/microorganisms.old.dta"), silent = TRUE)
try(openxlsx::write.xlsx(microorganisms.old, "data-raw/microorganisms.old.xlsx"), silent = TRUE)
}
2020-08-17 21:49:58 +02:00
ab <- dplyr::mutate_if(antibiotics, ~!is.numeric(.), as.character)
2020-09-14 12:21:23 +02:00
if (changed_md5(ab)) {
2021-03-11 21:42:30 +01:00
usethis::ui_info(paste0("Saving {usethis::ui_value('antibiotics')} to {usethis::ui_value('/data-raw/')}"))
2020-09-14 12:21:23 +02:00
write_md5(ab)
try(saveRDS(ab, "data-raw/antibiotics.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(ab, "data-raw/antibiotics.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(haven::write_sas(ab, "data-raw/antibiotics.sas"), silent = TRUE)
try(haven::write_sav(ab, "data-raw/antibiotics.sav"), silent = TRUE)
try(haven::write_dta(ab, "data-raw/antibiotics.dta"), silent = TRUE)
try(openxlsx::write.xlsx(ab, "data-raw/antibiotics.xlsx"), silent = TRUE)
}
av <- dplyr::mutate_if(antivirals, ~!is.numeric(.), as.character)
2020-09-14 12:21:23 +02:00
if (changed_md5(av)) {
2021-03-11 21:42:30 +01:00
usethis::ui_info(paste0("Saving {usethis::ui_value('antivirals')} to {usethis::ui_value('/data-raw/')}"))
2020-09-14 12:21:23 +02:00
write_md5(av)
try(saveRDS(av, "data-raw/antivirals.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(av, "data-raw/antivirals.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(haven::write_sas(av, "data-raw/antivirals.sas"), silent = TRUE)
try(haven::write_sav(av, "data-raw/antivirals.sav"), silent = TRUE)
try(haven::write_dta(av, "data-raw/antivirals.dta"), silent = TRUE)
try(openxlsx::write.xlsx(av, "data-raw/antivirals.xlsx"), silent = TRUE)
}
if (changed_md5(intrinsic_resistant)) {
2021-03-11 21:42:30 +01:00
usethis::ui_info(paste0("Saving {usethis::ui_value('intrinsic_resistant')} to {usethis::ui_value('/data-raw/')}"))
2020-09-14 12:21:23 +02:00
write_md5(intrinsic_resistant)
try(saveRDS(intrinsic_resistant, "data-raw/intrinsic_resistant.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(intrinsic_resistant, "data-raw/intrinsic_resistant.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(haven::write_sas(intrinsic_resistant, "data-raw/intrinsic_resistant.sas"), silent = TRUE)
try(haven::write_sav(intrinsic_resistant, "data-raw/intrinsic_resistant.sav"), silent = TRUE)
try(haven::write_dta(intrinsic_resistant, "data-raw/intrinsic_resistant.dta"), silent = TRUE)
try(openxlsx::write.xlsx(intrinsic_resistant, "data-raw/intrinsic_resistant.xlsx"), silent = TRUE)
}
if (changed_md5(dosage)) {
2021-03-11 21:42:30 +01:00
usethis::ui_info(paste0("Saving {usethis::ui_value('dosage')} to {usethis::ui_value('/data-raw/')}"))
write_md5(dosage)
try(saveRDS(dosage, "data-raw/dosage.rds", version = 2, compress = "xz"), silent = TRUE)
try(write.table(dosage, "data-raw/dosage.txt", sep = "\t", na = "", row.names = FALSE), silent = TRUE)
try(haven::write_sas(dosage, "data-raw/dosage.sas"), silent = TRUE)
try(haven::write_sav(dosage, "data-raw/dosage.sav"), silent = TRUE)
try(haven::write_dta(dosage, "data-raw/dosage.dta"), silent = TRUE)
try(openxlsx::write.xlsx(dosage, "data-raw/dosage.xlsx"), silent = TRUE)
}
# remove leftovers from global env
current_globalenv <- ls(envir = globalenv())
rm(list = current_globalenv[!current_globalenv %in% old_globalenv])
rm(current_globalenv)