mirror of
https://github.com/msberends/AMR.git
synced 2026-11-15 22:20:47 +01:00
(v3.0.1.9121) styler
This commit is contained in:
dr. M.S. (Matthijs) Berends committed
1 parent
c8cb36ddcf
commit
0293d296aa
14 files changed
+1191
-993
No files matched your search
+1
-1
@@ -1,5 +1,5 @@
|
||||
Package: AMR
|
||||
Version: 3.0.1.9120
|
||||
Version: 3.0.1.9121
|
||||
Date: 2026-10-12
|
||||
Title: Antimicrobial Resistance Data Analysis
|
||||
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# AMR 3.0.1.9120
|
||||
# AMR 3.0.1.9121
|
||||
|
||||
Planned as v3.1.0, mid October 2026.
|
||||
|
||||
|
||||
+10
-6
@@ -73,7 +73,6 @@
|
||||
#' # Though they are primarily intended to use for selections and filters.
|
||||
#' # Examples sections below are split into 'dplyr', 'base R', and 'data.table':
|
||||
#'
|
||||
#' \donttest{
|
||||
#' \dontrun{
|
||||
#' # dplyr -------------------------------------------------------------------
|
||||
#'
|
||||
@@ -94,8 +93,10 @@
|
||||
#' # get AMR for all aminoglycosides e.g., per ward:
|
||||
#' example_isolates %>%
|
||||
#' group_by(ward) %>%
|
||||
#' summarise(across(aminoglycosides(),
|
||||
#' resistance))
|
||||
#' summarise(across(
|
||||
#' aminoglycosides(),
|
||||
#' resistance
|
||||
#' ))
|
||||
#'
|
||||
#' # You can combine selectors with '&' to be more specific:
|
||||
#' example_isolates %>%
|
||||
@@ -105,8 +106,10 @@
|
||||
#' example_isolates %>%
|
||||
#' filter(mo_genus() %in% c("Escherichia", "Klebsiella")) %>%
|
||||
#' group_by(ward) %>%
|
||||
#' summarise_at(not_intrinsic_resistant(),
|
||||
#' resistance)
|
||||
#' summarise_at(
|
||||
#' not_intrinsic_resistant(),
|
||||
#' resistance
|
||||
#' )
|
||||
#'
|
||||
#' # get susceptibility for antimicrobials whose name contains "trim":
|
||||
#' example_isolates %>%
|
||||
@@ -159,8 +162,9 @@
|
||||
#' y <- example_isolates %>% filter(carbapenems() == "R")
|
||||
#' z <- example_isolates %>% filter(if_all(carbapenems(), ~ .x == "R"))
|
||||
#' identical(x, y) && identical(y, z)
|
||||
#'
|
||||
#' }
|
||||
#'
|
||||
#' \donttest{
|
||||
#' # base R ------------------------------------------------------------------
|
||||
#'
|
||||
#' # select columns 'IPM' (imipenem) and 'MEM' (meropenem)
|
||||
|
||||
+2
-1
@@ -207,7 +207,8 @@
|
||||
#' top_n_microorganisms(n = 10) %>%
|
||||
#' group_by(
|
||||
#' age_group = age_groups(age, c(25, 50, 75)),
|
||||
#' gender) %>%
|
||||
#' gender
|
||||
#' ) %>%
|
||||
#' wisca(antimicrobials = c("TZP", "TZP+TOB", "TZP+GEN"))
|
||||
#' }
|
||||
#'
|
||||
|
||||
Binary file not shown.
File diff suppressed because it is too large.
Load diff
@@ -38,12 +38,12 @@ for (i in seq_len(nrow(antimicrobials))) {
|
||||
}
|
||||
|
||||
int_resis <- interpretive_rules(int_resis,
|
||||
interpretive_rules_df = subset(
|
||||
AMR:::INTERPRETIVE_RULES_DF,
|
||||
reference.rule_group %like% "Expected.* Phenotypes"
|
||||
),
|
||||
overwrite = TRUE,
|
||||
info = FALSE
|
||||
interpretive_rules_df = subset(
|
||||
AMR:::INTERPRETIVE_RULES_DF,
|
||||
reference.rule_group %like% "Expected.* Phenotypes"
|
||||
),
|
||||
overwrite = TRUE,
|
||||
info = FALSE
|
||||
)
|
||||
|
||||
int_resis2 <- int_resis[, sapply(int_resis, function(x) any(!is.sir(x) | x == "R")), drop = FALSE] %>%
|
||||
@@ -63,8 +63,10 @@ all(int_resis3$ab %in% antimicrobials$ab)
|
||||
|
||||
intrinsic_resistant <- int_resis3
|
||||
|
||||
intrinsic_resistant$version <- paste(EUCAST_VERSION_EXPECTED_PHENOTYPES$`1.2`$title,
|
||||
EUCAST_VERSION_EXPECTED_PHENOTYPES$`1.2`$version_txt)
|
||||
intrinsic_resistant$version <- paste(
|
||||
EUCAST_VERSION_EXPECTED_PHENOTYPES$`1.2`$title,
|
||||
EUCAST_VERSION_EXPECTED_PHENOTYPES$`1.2`$version_txt
|
||||
)
|
||||
|
||||
usethis::use_data(intrinsic_resistant, internal = FALSE, overwrite = TRUE, version = 2, compress = "xz")
|
||||
rm(intrinsic_resistant)
|
||||
|
||||
@@ -53,7 +53,7 @@
|
||||
# 5. Go to BacDive data base for the oxygen tolerance and cell shape.
|
||||
# Go to https://bacdive.dsmz.de/advsearch, filter 'Oxygen tolerance' or
|
||||
# 'Cell shape' on "*" and click Submit and click on the 'Download tabel as CSV' button.
|
||||
# Last time these worked:
|
||||
# Last time these worked:
|
||||
# - wget -O bacdive_oxygen_tolerance.csv 'https://bacdive.dsmz.de/advsearch/csv?fg%5B1%5D%5Bgc%5D=OR&fg%5B1%5D%5Bfl%5D%5B1%5D%5Bfd%5D=Oxygen+tolerance&fg%5B1%5D%5Bfl%5D%5B1%5D%5Bfv%5D=%2A&fg%5B1%5D%5Bfl%5D%5B1%5D%5Bfvd%5D=oxygen_tolerance-oxygen_tol-4'
|
||||
# - wget -O bacdive_cell_shape.csv 'https://bacdive.dsmz.de/advsearch/csv?fg%5B1%5D%5Bgc%5D=OR&fg%5B1%5D%5Bfl%5D%5B1%5D%5Bfd%5D=Cell+shape&fg%5B1%5D%5Bfl%5D%5B1%5D%5Bfv%5D=%2A&fg%5B1%5D%5Bfl%5D%5B1%5D%5Bfvd%5D=cell_morphology-cell_shape-2'
|
||||
# 6. Set these locations to the paths where the files are (or set the environment variable
|
||||
@@ -231,12 +231,12 @@ get_author_year <- function(ref) {
|
||||
# normalise Unicode to NFC (precomposed) so iconv can transliterate
|
||||
authors2 <- stringi::stri_trans_nfc(ref)
|
||||
# fix known encoding errors in source data
|
||||
authors2 <- gsub("\u0092", "'", authors2) # Windows-1252 right quote
|
||||
authors2 <- gsub("\u0091", "'", authors2) # Windows-1252 left quote
|
||||
authors2 <- gsub("\u04AB", "\u00E7", authors2) # Cyrillic cedilla to Latin cedilla
|
||||
authors2 <- gsub("[\u0400-\u04FF]", "", authors2) # remove remaining Cyrillic characters
|
||||
authors2 <- gsub("\u0092", "'", authors2) # Windows-1252 right quote
|
||||
authors2 <- gsub("\u0091", "'", authors2) # Windows-1252 left quote
|
||||
authors2 <- gsub("\u04AB", "\u00E7", authors2) # Cyrillic cedilla to Latin cedilla
|
||||
authors2 <- gsub("[\u0400-\u04FF]", "", authors2) # remove remaining Cyrillic characters
|
||||
authors2 <- iconv(authors2, from = "UTF-8", to = "ASCII//TRANSLIT")
|
||||
|
||||
|
||||
authors2 <- gsub(" ?\\(Approved Lists [0-9]+\\) ?", " ", authors2)
|
||||
authors2 <- gsub(" +", " ", authors2)
|
||||
authors2 <- trimws(authors2)
|
||||
@@ -251,15 +251,15 @@ get_author_year <- function(ref) {
|
||||
# replace parentheses with emend. to get the latest authors
|
||||
# authors2 <- gsub("(", " emend. ", authors2, fixed = TRUE)
|
||||
# authors2 <- gsub(")", "", authors2, fixed = TRUE)
|
||||
|
||||
|
||||
# remove any remaining parentheses
|
||||
authors2 <- gsub("[()]", "", authors2)
|
||||
authors2 <- gsub(" +", " ", authors2)
|
||||
authors2 <- trimws(authors2)
|
||||
|
||||
|
||||
# strip emend. and everything after it to retain the combination authority
|
||||
authors2 <- gsub(" ?emend[.]?.*", "", authors2)
|
||||
|
||||
|
||||
# get year from last 4 digits
|
||||
lastyear <- as.integer(gsub(".*([0-9]{4})$", "\\1", authors2))
|
||||
# can never be later than now
|
||||
@@ -359,16 +359,19 @@ get_lpsn_and_author <- function(rank, name, tries = 3) {
|
||||
for (try in seq_len(tries)) {
|
||||
# be polite to the LPSN server
|
||||
Sys.sleep(0.1)
|
||||
page_txt <- tryCatch({
|
||||
resp <- curl::curl_fetch_memory(url)
|
||||
if (resp$status_code == 200) {
|
||||
read_html(rawToChar(resp$content))
|
||||
} else {
|
||||
# 404 is a valid answer, other codes (e.g. 429, 503) are worth a retry
|
||||
not_found <- resp$status_code == 404
|
||||
NULL
|
||||
}
|
||||
}, error = function(e) NULL)
|
||||
page_txt <- tryCatch(
|
||||
{
|
||||
resp <- curl::curl_fetch_memory(url)
|
||||
if (resp$status_code == 200) {
|
||||
read_html(rawToChar(resp$content))
|
||||
} else {
|
||||
# 404 is a valid answer, other codes (e.g. 429, 503) are worth a retry
|
||||
not_found <- resp$status_code == 404
|
||||
NULL
|
||||
}
|
||||
},
|
||||
error = function(e) NULL
|
||||
)
|
||||
if (!is.null(page_txt) || not_found) {
|
||||
break
|
||||
}
|
||||
@@ -1431,35 +1434,43 @@ taxonomy_gbif <- taxonomy_gbif %>%
|
||||
mutate(
|
||||
name_parts = strsplit(fullname, " "),
|
||||
rank_num = match(rank, rank_levels, nomatch = NA_integer_),
|
||||
|
||||
|
||||
# Step 1: parse the synonym's own name components from fullname
|
||||
kingdom = if_else(is.na(kingdom) & rank == "kingdom",
|
||||
sapply(name_parts, `[`, 1L), kingdom),
|
||||
sapply(name_parts, `[`, 1L), kingdom
|
||||
),
|
||||
phylum = if_else(is.na(phylum) & rank == "phylum",
|
||||
sapply(name_parts, `[`, 1L), phylum),
|
||||
sapply(name_parts, `[`, 1L), phylum
|
||||
),
|
||||
class = if_else(is.na(class) & rank == "class",
|
||||
sapply(name_parts, `[`, 1L), class),
|
||||
sapply(name_parts, `[`, 1L), class
|
||||
),
|
||||
order = if_else(is.na(order) & rank == "order",
|
||||
sapply(name_parts, `[`, 1L), order),
|
||||
sapply(name_parts, `[`, 1L), order
|
||||
),
|
||||
family = if_else(is.na(family) & rank == "family",
|
||||
sapply(name_parts, `[`, 1L), family),
|
||||
sapply(name_parts, `[`, 1L), family
|
||||
),
|
||||
genus = if_else(is.na(genus) & rank %in% c("genus", "species", "subspecies"),
|
||||
sapply(name_parts, `[`, 1L), genus),
|
||||
sapply(name_parts, `[`, 1L), genus
|
||||
),
|
||||
species = if_else(is.na(species) & rank %in% c("species", "subspecies"),
|
||||
sapply(name_parts, `[`, 2L), species),
|
||||
sapply(name_parts, `[`, 2L), species
|
||||
),
|
||||
subspecies = if_else(is.na(subspecies) & rank == "subspecies",
|
||||
sapply(name_parts, `[`, 3L), subspecies),
|
||||
|
||||
sapply(name_parts, `[`, 3L), subspecies
|
||||
),
|
||||
|
||||
# Step 2: fill domain and kingdom from the accepted name, only for ranks ABOVE the synonym's rank
|
||||
domain = if_else(is.na(domain) & !is.na(acc_domain), acc_domain, domain),
|
||||
domain = if_else(is.na(domain) & !is.na(acc_domain), acc_domain, domain),
|
||||
kingdom = if_else(is.na(kingdom) & !is.na(acc_kingdom) & rank_num > 1L, acc_kingdom, kingdom),
|
||||
# Step 3: phylum to family may only come from the accepted name if that is in the same genus
|
||||
# (or if the synonym is a genus or higher), otherwise from the synonym's own genus (see Step 4)
|
||||
same_lineage = rank_num <= 6L | (!is.na(acc_genus) & genus == acc_genus),
|
||||
phylum = if_else(is.na(phylum) & !is.na(acc_phylum) & rank_num > 2L & same_lineage, acc_phylum, phylum),
|
||||
class = if_else(is.na(class) & !is.na(acc_class) & rank_num > 3L & same_lineage, acc_class, class),
|
||||
order = if_else(is.na(order) & !is.na(acc_order) & rank_num > 4L & same_lineage, acc_order, order),
|
||||
family = if_else(is.na(family) & !is.na(acc_family) & rank_num > 5L & same_lineage, acc_family, family)
|
||||
phylum = if_else(is.na(phylum) & !is.na(acc_phylum) & rank_num > 2L & same_lineage, acc_phylum, phylum),
|
||||
class = if_else(is.na(class) & !is.na(acc_class) & rank_num > 3L & same_lineage, acc_class, class),
|
||||
order = if_else(is.na(order) & !is.na(acc_order) & rank_num > 4L & same_lineage, acc_order, order),
|
||||
family = if_else(is.na(family) & !is.na(acc_family) & rank_num > 5L & same_lineage, acc_family, family)
|
||||
) %>%
|
||||
# Step 4: species in another genus than their accepted name get the taxonomy of their own genus
|
||||
left_join(accepted_genera, by = c("domain", "genus")) %>%
|
||||
@@ -1603,7 +1614,7 @@ taxonomy <- taxonomy_lpsn %>%
|
||||
ungroup() %>%
|
||||
# only keep unique species per domain
|
||||
distinct(domain, fullname, .keep_all = TRUE) %>%
|
||||
arrange(fullname) %>%
|
||||
arrange(fullname) %>%
|
||||
select(fullname, everything())
|
||||
|
||||
# get missing entries from existing microorganisms data set
|
||||
@@ -1845,12 +1856,12 @@ taxonomy <- taxonomy %>%
|
||||
filter(.resolve != "remove") %>%
|
||||
mutate(
|
||||
is_genus_rank = genus != "" & !is.na(best_domain) & rank %in% c("genus", "species", "subspecies"),
|
||||
domain = if_else(genus != "" & !is.na(best_domain), best_domain, domain),
|
||||
domain = if_else(genus != "" & !is.na(best_domain), best_domain, domain),
|
||||
kingdom = if_else(genus != "" & !is.na(best_kingdom) & best_kingdom != "", best_kingdom, kingdom),
|
||||
phylum = if_else(is_genus_rank & best_phylum != "", best_phylum, phylum),
|
||||
class = if_else(is_genus_rank & best_class != "", best_class, class),
|
||||
order = if_else(is_genus_rank & best_order != "", best_order, order),
|
||||
family = if_else(is_genus_rank & best_family != "", best_family, family)
|
||||
phylum = if_else(is_genus_rank & best_phylum != "", best_phylum, phylum),
|
||||
class = if_else(is_genus_rank & best_class != "", best_class, class),
|
||||
order = if_else(is_genus_rank & best_order != "", best_order, order),
|
||||
family = if_else(is_genus_rank & best_family != "", best_family, family)
|
||||
) %>%
|
||||
select(-starts_with("best_"), -is_genus_rank, -.resolve)
|
||||
rm(genus_candidates, best_domain)
|
||||
@@ -1932,7 +1943,8 @@ taxonomy <- taxonomy %>%
|
||||
rank == "kingdom" ~ kingdom,
|
||||
rank == "domain" ~ domain,
|
||||
TRUE ~ paste(genus, species, subspecies) # already trimmed 7 lines up
|
||||
))) %>%
|
||||
))
|
||||
) %>%
|
||||
# keep the record of the most authoritative source: LPSN > MycoBank > GBIF > other
|
||||
mutate(sprio = source_prio(source)) %>%
|
||||
arrange(fullname, sprio) %>%
|
||||
@@ -2049,7 +2061,7 @@ fill_from_parent <- function(data, taxonomy, child_rank, parent_rank) {
|
||||
arrange(.data[[child_rank]], sprio) %>%
|
||||
distinct(.data[[child_rank]], .keep_all = TRUE) %>%
|
||||
select(all_of(c(child_rank, parent_rank)))
|
||||
|
||||
|
||||
data %>%
|
||||
rows_update(lookup, by = child_rank, unmatched = "ignore")
|
||||
}
|
||||
@@ -2091,7 +2103,7 @@ for (rank_name in c("family", "order", "class", "phylum", "kingdom")) {
|
||||
filter(rank != rank_name, .data[[rank_name]] != "") %>%
|
||||
distinct(.data[[rank_name]]) %>%
|
||||
pull()
|
||||
|
||||
|
||||
n_before <- nrow(taxonomy)
|
||||
taxonomy <- taxonomy %>%
|
||||
filter(!(rank == rank_name & !fullname %in% has_children))
|
||||
@@ -2112,7 +2124,7 @@ gbif_bacteria <- which(
|
||||
taxonomy$domain == "Bacteria" &
|
||||
taxonomy$source %in% c("GBIF", "manually added", "inferred") &
|
||||
(taxonomy$rank %in% c("phylum", "class", "order", "family", "genus") |
|
||||
(taxonomy$rank == "species" & taxonomy$genus %in% lpsn_genera))
|
||||
(taxonomy$rank == "species" & taxonomy$genus %in% lpsn_genera))
|
||||
)
|
||||
message(length(gbif_bacteria))
|
||||
added <- 0
|
||||
@@ -2175,18 +2187,19 @@ taxonomy$domain[taxonomy$domain == "(unknown kingdom)"] <- "(unknown domain)"
|
||||
# e.g., phylum above class "Bacilli" was still "Firmicutes" in 2023, should be "Bacillota" per LPSN
|
||||
rank_pairs <- tibble(
|
||||
child = c("genus", "family", "order", "class", "phylum"),
|
||||
parent = c("family", "order", "class", "phylum", "kingdom")
|
||||
parent = c("family", "order", "class", "phylum", "kingdom")
|
||||
)
|
||||
|
||||
for (d in unique(taxonomy$domain[taxonomy$domain != "(unknown domain)"])) {
|
||||
src <- if (d == "Fungi") "MycoBank" else "LPSN"
|
||||
message("Fixing GBIF taxonomy for domain ", d, " based on ", src, "...",
|
||||
appendLF = FALSE)
|
||||
|
||||
appendLF = FALSE
|
||||
)
|
||||
|
||||
for (i in seq_len(nrow(rank_pairs))) {
|
||||
child_col <- rank_pairs$child[i]
|
||||
child_col <- rank_pairs$child[i]
|
||||
parent_col <- rank_pairs$parent[i]
|
||||
|
||||
|
||||
# build lookup: for each child value in this domain, get the parent from the authoritative source
|
||||
lookup <- taxonomy %>%
|
||||
filter(
|
||||
@@ -2194,13 +2207,13 @@ for (d in unique(taxonomy$domain[taxonomy$domain != "(unknown domain)"])) {
|
||||
source == src,
|
||||
.data[[child_col]] != ""
|
||||
)
|
||||
|
||||
|
||||
# special case: kingdom lookup excludes "Bacteria"/"Archaea" as kingdom values
|
||||
if (parent_col == "kingdom") {
|
||||
lookup <- lookup %>%
|
||||
filter(!kingdom %in% c("Bacteria", "Archaea"))
|
||||
}
|
||||
|
||||
|
||||
lookup <- lookup %>%
|
||||
# an empty parent in the authoritative source must never erase a known parent from GBIF
|
||||
# (e.g. MycoBank has no family for Mucor, GBIF has Mucoraceae)
|
||||
@@ -2209,7 +2222,7 @@ for (d in unique(taxonomy$domain[taxonomy$domain != "(unknown domain)"])) {
|
||||
arrange(rank != child_col) %>%
|
||||
distinct(.data[[child_col]], .keep_all = TRUE) %>%
|
||||
select(all_of(c(child_col, parent_col)))
|
||||
|
||||
|
||||
# join and overwrite
|
||||
taxonomy <- taxonomy %>%
|
||||
rows_update(
|
||||
@@ -2236,13 +2249,13 @@ taxonomy <- taxonomy %>%
|
||||
rank = case_when(
|
||||
rank %in% c("(unknown rank)", "species group") ~ rank,
|
||||
subspecies != "" ~ "subspecies",
|
||||
species != "" ~ "species",
|
||||
genus != "" ~ "genus",
|
||||
family != "" ~ "family",
|
||||
order != "" ~ "order",
|
||||
class != "" ~ "class",
|
||||
phylum != "" ~ "phylum",
|
||||
kingdom != "" ~ "kingdom",
|
||||
species != "" ~ "species",
|
||||
genus != "" ~ "genus",
|
||||
family != "" ~ "family",
|
||||
order != "" ~ "order",
|
||||
class != "" ~ "class",
|
||||
phylum != "" ~ "phylum",
|
||||
kingdom != "" ~ "kingdom",
|
||||
.default = NA_character_
|
||||
)
|
||||
)
|
||||
@@ -2292,10 +2305,10 @@ taxonomy <- taxonomy %>%
|
||||
)
|
||||
)
|
||||
taxonomy$rank[taxonomy$kingdom == taxonomy$domain &
|
||||
taxonomy$rank == "kingdom" &
|
||||
taxonomy$domain %in% c("Bacteria", "Archaea")] <- "domain"
|
||||
taxonomy$rank == "kingdom" &
|
||||
taxonomy$domain %in% c("Bacteria", "Archaea")] <- "domain"
|
||||
taxonomy$kingdom[taxonomy$kingdom == taxonomy$domain &
|
||||
taxonomy$rank == "domain"] <- ""
|
||||
taxonomy$rank == "domain"] <- ""
|
||||
|
||||
taxonomy <- taxonomy %>%
|
||||
arrange(fullname, source_prio(source), lpsn, mycobank, desc(gbif)) %>%
|
||||
@@ -2306,33 +2319,33 @@ taxonomy <- taxonomy %>%
|
||||
taxonomy <- taxonomy %>%
|
||||
mutate(
|
||||
.parent_fullname = case_when(
|
||||
rank == "subspecies" ~ paste(genus, species),
|
||||
rank == "species" ~ genus,
|
||||
rank == "genus" & family != "" ~ family,
|
||||
rank == "genus" & order != "" ~ order,
|
||||
rank == "genus" & class != "" ~ class,
|
||||
rank == "genus" & phylum != "" ~ phylum,
|
||||
rank == "genus" ~ domain,
|
||||
rank == "family" & order != "" ~ order,
|
||||
rank == "family" & class != "" ~ class,
|
||||
rank == "family" & phylum != "" ~ phylum,
|
||||
rank == "family" ~ domain,
|
||||
rank == "order" & class != "" ~ class,
|
||||
rank == "order" & phylum != "" ~ phylum,
|
||||
rank == "order" ~ domain,
|
||||
rank == "class" & phylum != "" ~ phylum,
|
||||
rank == "class" ~ domain,
|
||||
rank == "phylum" & kingdom != "" ~ kingdom,
|
||||
rank == "phylum" ~ domain,
|
||||
rank == "kingdom" ~ domain,
|
||||
rank == "subspecies" ~ paste(genus, species),
|
||||
rank == "species" ~ genus,
|
||||
rank == "genus" & family != "" ~ family,
|
||||
rank == "genus" & order != "" ~ order,
|
||||
rank == "genus" & class != "" ~ class,
|
||||
rank == "genus" & phylum != "" ~ phylum,
|
||||
rank == "genus" ~ domain,
|
||||
rank == "family" & order != "" ~ order,
|
||||
rank == "family" & class != "" ~ class,
|
||||
rank == "family" & phylum != "" ~ phylum,
|
||||
rank == "family" ~ domain,
|
||||
rank == "order" & class != "" ~ class,
|
||||
rank == "order" & phylum != "" ~ phylum,
|
||||
rank == "order" ~ domain,
|
||||
rank == "class" & phylum != "" ~ phylum,
|
||||
rank == "class" ~ domain,
|
||||
rank == "phylum" & kingdom != "" ~ kingdom,
|
||||
rank == "phylum" ~ domain,
|
||||
rank == "kingdom" ~ domain,
|
||||
.default = NA_character_
|
||||
)
|
||||
)
|
||||
|
||||
# Build lookup vectors: fullname -> id
|
||||
lpsn_lookup <- setNames(taxonomy$lpsn, taxonomy$fullname)
|
||||
lpsn_lookup <- setNames(taxonomy$lpsn, taxonomy$fullname)
|
||||
mycobank_lookup <- setNames(taxonomy$mycobank, taxonomy$fullname)
|
||||
gbif_lookup <- setNames(taxonomy$gbif, taxonomy$fullname)
|
||||
gbif_lookup <- setNames(taxonomy$gbif, taxonomy$fullname)
|
||||
|
||||
taxonomy <- taxonomy %>%
|
||||
mutate(
|
||||
@@ -2676,12 +2689,12 @@ genus_ref <- taxonomy %>%
|
||||
filter(genus != "") %>%
|
||||
group_by(genus) %>%
|
||||
summarise(
|
||||
.ref_domain = coalesce(first(domain[rank == "genus"]), first(domain)),
|
||||
.ref_kingdom = coalesce(first(kingdom[rank == "genus"]), first(kingdom)),
|
||||
.ref_phylum = consensus_value(phylum, rank, source, "genus"),
|
||||
.ref_class = consensus_value(class, rank, source, "genus"),
|
||||
.ref_order = consensus_value(order, rank, source, "genus"),
|
||||
.ref_family = consensus_value(family, rank, source, "genus"),
|
||||
.ref_domain = coalesce(first(domain[rank == "genus"]), first(domain)),
|
||||
.ref_kingdom = coalesce(first(kingdom[rank == "genus"]), first(kingdom)),
|
||||
.ref_phylum = consensus_value(phylum, rank, source, "genus"),
|
||||
.ref_class = consensus_value(class, rank, source, "genus"),
|
||||
.ref_order = consensus_value(order, rank, source, "genus"),
|
||||
.ref_family = consensus_value(family, rank, source, "genus"),
|
||||
.groups = "drop"
|
||||
)
|
||||
|
||||
@@ -2689,13 +2702,13 @@ taxonomy <- taxonomy %>%
|
||||
left_join(genus_ref, by = "genus") %>%
|
||||
mutate(
|
||||
across_flag = rank != "genus" & genus != "" & fullname %unlike% "unknown",
|
||||
domain = if_else(across_flag, .ref_domain, domain),
|
||||
kingdom = if_else(across_flag, .ref_kingdom, kingdom),
|
||||
domain = if_else(across_flag, .ref_domain, domain),
|
||||
kingdom = if_else(across_flag, .ref_kingdom, kingdom),
|
||||
# also fill the genus record itself where it has no value
|
||||
phylum = if_else((across_flag | (rank == "genus" & phylum == "")) & .ref_phylum != "", .ref_phylum, phylum),
|
||||
class = if_else((across_flag | (rank == "genus" & class == "")) & .ref_class != "", .ref_class, class),
|
||||
order = if_else((across_flag | (rank == "genus" & order == "")) & .ref_order != "", .ref_order, order),
|
||||
family = if_else((across_flag | (rank == "genus" & family == "")) & .ref_family != "", .ref_family, family)
|
||||
phylum = if_else((across_flag | (rank == "genus" & phylum == "")) & .ref_phylum != "", .ref_phylum, phylum),
|
||||
class = if_else((across_flag | (rank == "genus" & class == "")) & .ref_class != "", .ref_class, class),
|
||||
order = if_else((across_flag | (rank == "genus" & order == "")) & .ref_order != "", .ref_order, order),
|
||||
family = if_else((across_flag | (rank == "genus" & family == "")) & .ref_family != "", .ref_family, family)
|
||||
) %>%
|
||||
select(-starts_with(".ref_"), -across_flag) %>%
|
||||
arrange(fullname)
|
||||
@@ -2809,10 +2822,14 @@ plasmodia <- data.frame(
|
||||
status = "accepted",
|
||||
prevalence = 1.25
|
||||
) %>%
|
||||
mutate(rank = ifelse(species == "", "genus",
|
||||
ifelse(subspecies != "", "subspecies",
|
||||
"species")),
|
||||
fullname = trimws(paste(genus, species, subspecies)))
|
||||
mutate(
|
||||
rank = ifelse(species == "", "genus",
|
||||
ifelse(subspecies != "", "subspecies",
|
||||
"species"
|
||||
)
|
||||
),
|
||||
fullname = trimws(paste(genus, species, subspecies))
|
||||
)
|
||||
|
||||
taxonomy <- taxonomy %>%
|
||||
filter(genus != "Plasmodium") %>%
|
||||
@@ -2898,8 +2915,10 @@ if (nrow(isospora_belli) == 1 && !"Cystoisospora belli" %in% taxonomy$fullname)
|
||||
status = "synonym",
|
||||
source = "manually added",
|
||||
ref = "",
|
||||
across(any_of(c("lpsn", "lpsn_parent", "lpsn_renamed_to", "mycobank", "mycobank_parent", "mycobank_renamed_to",
|
||||
"gbif", "gbif_parent")), ~NA_character_),
|
||||
across(any_of(c(
|
||||
"lpsn", "lpsn_parent", "lpsn_renamed_to", "mycobank", "mycobank_parent", "mycobank_renamed_to",
|
||||
"gbif", "gbif_parent"
|
||||
)), ~NA_character_),
|
||||
gbif_renamed_to = isospora_belli$gbif
|
||||
)
|
||||
) %>%
|
||||
@@ -3186,9 +3205,11 @@ taxonomy <- taxonomy %>%
|
||||
distinct(fullname, .keep_all = TRUE) %>%
|
||||
compute_prevalence()
|
||||
message("Restored ", nrow(restored), " released taxa (", nrow(taxonomy) - n_before, " records including their parents)")
|
||||
rm(restore_registry, restore_renames, renamed, missing_released, homonyms_removed, retirements, new_retirements, source_names, older_homonyms, older_homonym_retirements,
|
||||
released_records, genus_domains, conflicting, conflict_retirements, kingdom_of_phylum, lineage_of_genus, restored,
|
||||
rank_order)
|
||||
rm(
|
||||
restore_registry, restore_renames, renamed, missing_released, homonyms_removed, retirements, new_retirements, source_names, older_homonyms, older_homonym_retirements,
|
||||
released_records, genus_domains, conflicting, conflict_retirements, kingdom_of_phylum, lineage_of_genus, restored,
|
||||
rank_order
|
||||
)
|
||||
|
||||
|
||||
# Link orthographic variants without a current name ----------------------------------------------
|
||||
@@ -3495,8 +3516,10 @@ if (nrow(new_retirements) > 0) {
|
||||
na = ""
|
||||
)
|
||||
}
|
||||
rm(no_current_name, lpsn_outcome, prokaryotes, to_remove, has_kept_children, outcome, removed, registry_now,
|
||||
retirements_now, new_retirements)
|
||||
rm(
|
||||
no_current_name, lpsn_outcome, prokaryotes, to_remove, has_kept_children, outcome, removed, registry_now,
|
||||
retirements_now, new_retirements
|
||||
)
|
||||
|
||||
|
||||
# Fix genera that are synonyms while they contain accepted species --------------------------------
|
||||
@@ -3617,8 +3640,10 @@ for (r in c("family", "order", "class", "phylum")) {
|
||||
new_record$status <- "accepted"
|
||||
new_record$source <- "manually added"
|
||||
new_record$ref <- NA_character_
|
||||
for (col in intersect(c("lpsn", "lpsn_parent", "lpsn_renamed_to", "mycobank", "mycobank_parent",
|
||||
"mycobank_renamed_to", "gbif", "gbif_parent", "gbif_renamed_to"), colnames(new_record))) {
|
||||
for (col in intersect(c(
|
||||
"lpsn", "lpsn_parent", "lpsn_renamed_to", "mycobank", "mycobank_parent",
|
||||
"mycobank_renamed_to", "gbif", "gbif_parent", "gbif_renamed_to"
|
||||
), colnames(new_record))) {
|
||||
new_record[[col]] <- NA_character_
|
||||
}
|
||||
for (lf in c(r, lower)) new_record[[lf]] <- ""
|
||||
@@ -4022,7 +4047,7 @@ taxonomy <- taxonomy %>% filter(mo %unlike% "__")
|
||||
|
||||
# keep unique taxonomy
|
||||
taxonomy <- bind_rows(
|
||||
taxonomy %>%
|
||||
taxonomy %>%
|
||||
filter(fullname %like% "unknown"),
|
||||
taxonomy %>%
|
||||
distinct(across(domain:subspecies), .keep_all = TRUE) %>%
|
||||
@@ -4489,7 +4514,8 @@ bacdive_shape_other <- taxonomy %>%
|
||||
morphology = case_when(
|
||||
fullname %like% "coccus" ~ "cocci",
|
||||
fullname %in% taxonomy$fullname[taxonomy$order %in% c("Enterobacterales", "Caryophanales", "Lactobacillales")] ~ morphology,
|
||||
TRUE ~ paste("likely", morphology))
|
||||
TRUE ~ paste("likely", morphology)
|
||||
)
|
||||
) %>%
|
||||
select(fullname, morphology) %>%
|
||||
distinct(fullname, .keep_all = TRUE)
|
||||
@@ -4883,7 +4909,7 @@ if (!is.null(mo_integrity_report(integrity_issues))) {
|
||||
# sets refer only to current names, except intrinsic_resistant, which lists synonyms on purpose)
|
||||
fix_old_mos <- function(dataset, new_ref, drop = FALSE, col = "mo", current = TRUE) {
|
||||
before <- dataset
|
||||
|
||||
|
||||
# the data sets contain codes of the development version
|
||||
mo_names <- microorganisms_dev$fullname[match(before[[col]], microorganisms_dev$mo)]
|
||||
# names of the development version that do not exist anymore, with their name in the new data set
|
||||
@@ -4922,20 +4948,24 @@ save_df <- function(...) {
|
||||
)
|
||||
}
|
||||
microorganisms.codes <- fix_old_mos(AMR::microorganisms.codes, taxonomy, drop = TRUE)
|
||||
if (!identical(microorganisms.codes, AMR::microorganisms.codes)) save_df(microorganisms.codes); rm(microorganisms.codes)
|
||||
if (!identical(microorganisms.codes, AMR::microorganisms.codes)) save_df(microorganisms.codes)
|
||||
rm(microorganisms.codes)
|
||||
|
||||
clinical_breakpoints <- fix_old_mos(AMR::clinical_breakpoints, taxonomy)
|
||||
if (!identical(clinical_breakpoints, AMR::clinical_breakpoints)) save_df(clinical_breakpoints); rm(clinical_breakpoints)
|
||||
if (!identical(clinical_breakpoints, AMR::clinical_breakpoints)) save_df(clinical_breakpoints)
|
||||
rm(clinical_breakpoints)
|
||||
|
||||
example_isolates <- fix_old_mos(AMR::example_isolates, taxonomy)
|
||||
if (!identical(example_isolates, AMR::example_isolates)) save_df(example_isolates); rm(example_isolates)
|
||||
if (!identical(example_isolates, AMR::example_isolates)) save_df(example_isolates)
|
||||
rm(example_isolates)
|
||||
|
||||
# (intrinsic_resistant is not updated here: it is computed from the new data set afterwards, see
|
||||
# data-raw/_reproduction_scripts/reproduction_of_intrinsic_resistant.R)
|
||||
|
||||
microorganisms.groups <- fix_old_mos(AMR::microorganisms.groups, taxonomy, col = "mo")
|
||||
microorganisms.groups <- fix_old_mos(microorganisms.groups, taxonomy, col = "mo_group")
|
||||
if (!identical(microorganisms.groups, AMR::microorganisms.groups)) save_df(microorganisms.groups); rm(microorganisms.groups)
|
||||
if (!identical(microorganisms.groups, AMR::microorganisms.groups)) save_df(microorganisms.groups)
|
||||
rm(microorganisms.groups)
|
||||
|
||||
|
||||
# *** Save to package *** -------------------------------------------------------------------------
|
||||
|
||||
@@ -56,12 +56,12 @@ step("microorganisms.groups", "data-raw/_reproduction_scripts/reproduction_of_mi
|
||||
# 2. EUCAST breakpoints, merged into clinical_breakpoints (as at the end of reproduction_of_clinical_breakpoints.R)
|
||||
merge_script <- tempfile(fileext = ".R")
|
||||
writeLines(c(
|
||||
'devtools::load_all()',
|
||||
'library(dplyr, warn.conflicts = FALSE)',
|
||||
"devtools::load_all()",
|
||||
"library(dplyr, warn.conflicts = FALSE)",
|
||||
'source("data-raw/_reproduction_scripts/reproduction_of_clinical_breakpoints_eucast.R")',
|
||||
'# the rank of an organism can have changed with the new data set',
|
||||
'breakpoints_now <- clinical_breakpoints %>%',
|
||||
' mutate(rank_index = case_when(',
|
||||
"# the rank of an organism can have changed with the new data set",
|
||||
"breakpoints_now <- clinical_breakpoints %>%",
|
||||
" mutate(rank_index = case_when(",
|
||||
' mo_rank(mo, keep_synonyms = TRUE) %like% "(infra|sub)" ~ 1,',
|
||||
' mo_rank(mo, keep_synonyms = TRUE) == "species" ~ 2,',
|
||||
' mo_rank(mo, keep_synonyms = TRUE) == "species group" ~ 2.5,',
|
||||
@@ -69,9 +69,9 @@ writeLines(c(
|
||||
' mo_rank(mo, keep_synonyms = TRUE) == "family" ~ 4,',
|
||||
' mo_rank(mo, keep_synonyms = TRUE) == "order" ~ 5,',
|
||||
' mo != "UNKNOWN" ~ 6,',
|
||||
' TRUE ~ 7',
|
||||
" TRUE ~ 7",
|
||||
' ) + if_else(is.na(breakpoint_S) & is.na(breakpoint_R) & guideline %like% "EUCAST", 0.1, 0))',
|
||||
'clinical_breakpoints <- merge_eucast_breakpoints(breakpoints_now, breakpoints_eucast, eucast_coverage)',
|
||||
"clinical_breakpoints <- merge_eucast_breakpoints(breakpoints_now, breakpoints_eucast, eucast_coverage)",
|
||||
'usethis::use_data(clinical_breakpoints, overwrite = TRUE, compress = "xz", version = 2)'
|
||||
), merge_script)
|
||||
step("clinical_breakpoints (EUCAST)", merge_script)
|
||||
|
||||
@@ -1,622 +1,622 @@
|
||||
# Copyright (c) [2022] [Larisse Bolton]
|
||||
|
||||
wisca_params <- function(x, antibiotic_in, pathogen_in, analysis, exclude, isolate_first, susceptible_I, infection_in,infection_full){
|
||||
wisca_params <- function(x, antibiotic_in, pathogen_in, analysis, exclude, isolate_first, susceptible_I, infection_in, infection_full) {
|
||||
# Isolate the type of syndrome you would like to investigate
|
||||
if (infection_in != ""){
|
||||
x <- x %>%
|
||||
filter(infection_type == infection_in)
|
||||
if (infection_in != "") {
|
||||
x <- x %>%
|
||||
filter(infection_type == infection_in)
|
||||
} else {
|
||||
x <- x
|
||||
}
|
||||
|
||||
|
||||
# Define antibiotic regimens under investigation from "antimicrobials" dataset
|
||||
antibiotic_df <- function(abo_in){
|
||||
mono_ab <- str_to_title(abo_in[!str_detect(abo_in,fixed("+"))]) #identify single antimicrobials
|
||||
|
||||
antibiotic_df <- function(abo_in) {
|
||||
mono_ab <- str_to_title(abo_in[!str_detect(abo_in, fixed("+"))]) # identify single antimicrobials
|
||||
|
||||
mono_antibiotic_x_set <- data.frame()
|
||||
for (j in 1:length(mono_ab)){ #generate dataframe for single antimicrobials with abbreviations and fullnames
|
||||
for (j in 1:length(mono_ab)) { # generate dataframe for single antimicrobials with abbreviations and fullnames
|
||||
mono_x_name <- ab_name(mono_ab[j], only_first = TRUE)
|
||||
mono_x_ab <- as.ab(mono_x_name)
|
||||
mono_antibiotic <- subset(antimicrobials, antimicrobials$ab %in% mono_x_ab)[,c("ab","name")]
|
||||
mono_antibiotic_x_set <- rbind.data.frame(mono_antibiotic_x_set,mono_antibiotic, row.names = NULL)
|
||||
mono_antibiotic <- subset(antimicrobials, antimicrobials$ab %in% mono_x_ab)[, c("ab", "name")]
|
||||
mono_antibiotic_x_set <- rbind.data.frame(mono_antibiotic_x_set, mono_antibiotic, row.names = NULL)
|
||||
}
|
||||
names(mono_antibiotic_x_set) <- c("ab1","namerx")
|
||||
names(mono_antibiotic_x_set) <- c("ab1", "namerx")
|
||||
mono_antibiotic_x_set$ab1 <- as.character(mono_antibiotic_x_set$ab1)
|
||||
|
||||
|
||||
comb_ab <- str_to_title(abo_in[str_detect(abo_in,fixed("+"))]) #identify combination regimens
|
||||
if(length(comb_ab) > 0){
|
||||
|
||||
comb_antibiotic_x_total <- data.frame()
|
||||
for (jj in 1:length(comb_ab)){ #generate dataframe for combination antimicrobials with abbreviations and fullnames
|
||||
|
||||
|
||||
comb_ab <- str_to_title(abo_in[str_detect(abo_in, fixed("+"))]) # identify combination regimens
|
||||
if (length(comb_ab) > 0) {
|
||||
comb_antibiotic_x_total <- data.frame()
|
||||
for (jj in 1:length(comb_ab)) { # generate dataframe for combination antimicrobials with abbreviations and fullnames
|
||||
comb_ab_sep <- unlist(str_split(comb_ab[jj], fixed("+")))
|
||||
comb_antibiotic_x_pre <- data.frame(x = rep(0, times = 2), y = rep(0, times = 2))
|
||||
for (ii in 1:length(comb_ab_sep)){
|
||||
for (ii in 1:length(comb_ab_sep)) {
|
||||
comb_x_name <- ab_name(comb_ab_sep[ii], only_first = TRUE)
|
||||
comb_x_ab <- as.ab(comb_x_name)
|
||||
comb_antibiotic <- subset(antimicrobials, antimicrobials$ab %in% comb_x_ab)[,c("ab","name")]
|
||||
comb_antibiotic_x_pre[ii,] <- comb_antibiotic
|
||||
comb_antibiotic <- subset(antimicrobials, antimicrobials$ab %in% comb_x_ab)[, c("ab", "name")]
|
||||
comb_antibiotic_x_pre[ii, ] <- comb_antibiotic
|
||||
names(comb_antibiotic_x_pre) <- names(comb_antibiotic)
|
||||
}
|
||||
comb_antibiotic_x <- pivot_wider(comb_antibiotic_x_pre, names_from = name, values_from = ab)
|
||||
comb_antibiotic_x_set <- comb_antibiotic_x %>%
|
||||
mutate(namerx = str_flatten(str_c(names(comb_antibiotic_x), collapse = "+")))
|
||||
new_ab <- sapply(X = as.character(1:(ncol(comb_antibiotic_x_set)-1)), FUN = function(x){str_flatten(str_c("ab",x))})
|
||||
names(comb_antibiotic_x_set)[1:(ncol(comb_antibiotic_x_set)-1)] <- new_ab
|
||||
names(comb_antibiotic_x_set)[ncol(comb_antibiotic_x_set)]<- "namerx"
|
||||
comb_antibiotic_x_total <-rbind.data.frame(comb_antibiotic_x_total, comb_antibiotic_x_set, row.names = NULL)
|
||||
new_ab <- sapply(X = as.character(1:(ncol(comb_antibiotic_x_set) - 1)), FUN = function(x) {
|
||||
str_flatten(str_c("ab", x))
|
||||
})
|
||||
names(comb_antibiotic_x_set)[1:(ncol(comb_antibiotic_x_set) - 1)] <- new_ab
|
||||
names(comb_antibiotic_x_set)[ncol(comb_antibiotic_x_set)] <- "namerx"
|
||||
comb_antibiotic_x_total <- rbind.data.frame(comb_antibiotic_x_total, comb_antibiotic_x_set, row.names = NULL)
|
||||
}
|
||||
|
||||
|
||||
|
||||
antibiotic_x_set <- full_join(x= mono_antibiotic_x_set,y = comb_antibiotic_x_total) #generate full antibiotic dataset for analysis
|
||||
antibiotic_x_set <- select(antibiotic_x_set, starts_with("ab"),starts_with("namerx"))
|
||||
|
||||
|
||||
|
||||
antibiotic_x_set <- full_join(x = mono_antibiotic_x_set, y = comb_antibiotic_x_total) # generate full antibiotic dataset for analysis
|
||||
antibiotic_x_set <- select(antibiotic_x_set, starts_with("ab"), starts_with("namerx"))
|
||||
} else {
|
||||
antibiotic_x_set <- mono_antibiotic_x_set
|
||||
}
|
||||
return(antibiotic_x_set)
|
||||
}
|
||||
|
||||
antibiotic_rx <- antibiotic_df(abo_in = antibiotic_in) #full dataframe with antibiotic regimens
|
||||
|
||||
|
||||
#if the dataset names are in different format to built-in set
|
||||
if ((length(names(x)[sapply(names(x), function(x1){any(str_detect(x1,"[A-Z]$") & !(x1 %in% antimicrobials$ab) & !(x1 %in% antimicrobials$name))})])>0)){
|
||||
names(x)[which(str_detect(names(x),"[a-z]+") & !str_detect(names(x),"fullname") & !str_detect(names(x),"mo"))] <- str_to_upper(names(x)[which(str_detect(names(x),"[a-z]+") & !str_detect(names(x),"fullname") & !str_detect(names(x),"mo"))])
|
||||
names(x)[which(str_detect(names(x),"^ORG") & str_detect(names(x),"NAME$"))] <- "fullname"
|
||||
names(x)[which(str_detect(names(x),"^ORG") & str_detect(names(x),"CODE$"))] <- "organism"
|
||||
names(x)[which(str_detect(names(x),"^DATE") & str_detect(names(x),"CULTURE$") | str_detect(names(x),"^DATE") & str_detect(names(x),"SPECIMEN"))] <- "date"
|
||||
names(x)[which(str_detect(names(x),"^EPISODE") | str_detect(names(x),"^PAT"))] <- "patient"
|
||||
names(x)[which(str_detect(names(x),"^WARD"))] <- "ward"
|
||||
names(x)[which(str_detect(names(x),"^HOSP"))] <- "hospital"
|
||||
names(x)[which(str_detect(names(x),"DATE") & (str_detect(names(x),"REGISTRATION")))] <- "date"
|
||||
|
||||
antibiotic_rx <- antibiotic_df(abo_in = antibiotic_in) # full dataframe with antibiotic regimens
|
||||
|
||||
|
||||
# if the dataset names are in different format to built-in set
|
||||
if ((length(names(x)[sapply(names(x), function(x1) {
|
||||
any(str_detect(x1, "[A-Z]$") & !(x1 %in% antimicrobials$ab) & !(x1 %in% antimicrobials$name))
|
||||
})]) > 0)) {
|
||||
names(x)[which(str_detect(names(x), "[a-z]+") & !str_detect(names(x), "fullname") & !str_detect(names(x), "mo"))] <- str_to_upper(names(x)[which(str_detect(names(x), "[a-z]+") & !str_detect(names(x), "fullname") & !str_detect(names(x), "mo"))])
|
||||
names(x)[which(str_detect(names(x), "^ORG") & str_detect(names(x), "NAME$"))] <- "fullname"
|
||||
names(x)[which(str_detect(names(x), "^ORG") & str_detect(names(x), "CODE$"))] <- "organism"
|
||||
names(x)[which(str_detect(names(x), "^DATE") & str_detect(names(x), "CULTURE$") | str_detect(names(x), "^DATE") & str_detect(names(x), "SPECIMEN"))] <- "date"
|
||||
names(x)[which(str_detect(names(x), "^EPISODE") | str_detect(names(x), "^PAT"))] <- "patient"
|
||||
names(x)[which(str_detect(names(x), "^WARD"))] <- "ward"
|
||||
names(x)[which(str_detect(names(x), "^HOSP"))] <- "hospital"
|
||||
names(x)[which(str_detect(names(x), "DATE") & (str_detect(names(x), "REGISTRATION")))] <- "date"
|
||||
}
|
||||
|
||||
#remove any duplicated variables
|
||||
if (any(duplicated(names(x)))){
|
||||
x <- x[,-max(which(names(x) == names(x)[which(duplicated(names(x)))]))]
|
||||
|
||||
# remove any duplicated variables
|
||||
if (any(duplicated(names(x)))) {
|
||||
x <- x[, -max(which(names(x) == names(x)[which(duplicated(names(x)))]))]
|
||||
} else {
|
||||
x <- x
|
||||
}
|
||||
|
||||
x <- arrange(x,"date") #arrange in increasing date
|
||||
|
||||
#if your dataset does not have an episode identifier
|
||||
if (length(names(x)[sapply(names(x), function(x1){any(str_detect(x1,"patient"))})]) == 0){
|
||||
x$patient <- seq(1,nrow(x),1)
|
||||
|
||||
x <- arrange(x, "date") # arrange in increasing date
|
||||
|
||||
# if your dataset does not have an episode identifier
|
||||
if (length(names(x)[sapply(names(x), function(x1) {
|
||||
any(str_detect(x1, "patient"))
|
||||
})]) == 0) {
|
||||
x$patient <- seq(1, nrow(x), 1)
|
||||
}
|
||||
|
||||
|
||||
|
||||
#find demographic data within dataset
|
||||
micro_df_ind <- which(sapply(x,function(y) any(str_detect(y,"^S$"))|any(str_detect(y,"^R$"))|any(str_detect(y,"^SENSITIVE$"))| any(str_detect(y,"^RESISTANT$"))) == TRUE)
|
||||
micro_df <- names(x)[micro_df_ind]#column names for susceptibility data
|
||||
demograph_df <- names(x)[which(!names(x) %in% micro_df)] #column names for demographic or organism data
|
||||
|
||||
#Dataset required to contain both mo and fullname
|
||||
if ("mo" %in% names(x)){
|
||||
|
||||
|
||||
# find demographic data within dataset
|
||||
micro_df_ind <- which(sapply(x, function(y) any(str_detect(y, "^S$")) | any(str_detect(y, "^R$")) | any(str_detect(y, "^SENSITIVE$")) | any(str_detect(y, "^RESISTANT$"))) == TRUE)
|
||||
micro_df <- names(x)[micro_df_ind] # column names for susceptibility data
|
||||
demograph_df <- names(x)[which(!names(x) %in% micro_df)] # column names for demographic or organism data
|
||||
|
||||
# Dataset required to contain both mo and fullname
|
||||
if ("mo" %in% names(x)) {
|
||||
# If mo included but not fullname:
|
||||
x <- x %>%
|
||||
mutate(mo = as.mo(mo), keep_synonyms = TRUE)
|
||||
test_isolates_pre <- x %>%
|
||||
mutate(across(.cols = all_of(demograph_df),~ str_to_title(.x))) %>%
|
||||
mutate(mo = toupper(mo))
|
||||
if ("fullname" %in% names(x)){
|
||||
test_isolates <- test_isolates_pre[,c(demograph_df)]
|
||||
mutate(across(.cols = all_of(demograph_df), ~ str_to_title(.x))) %>%
|
||||
mutate(mo = toupper(mo))
|
||||
if ("fullname" %in% names(x)) {
|
||||
test_isolates <- test_isolates_pre[, c(demograph_df)]
|
||||
} else {
|
||||
test_isolates <- left_join_microorganisms(x = test_isolates_pre, by = "mo")[,c(demograph_df,"fullname")] #add in fullname
|
||||
test_isolates <- left_join_microorganisms(x = test_isolates_pre, by = "mo")[, c(demograph_df, "fullname")] # add in fullname
|
||||
}
|
||||
test_isolates <- test_isolates %>% #remove bugs to be excluded and final style conversions
|
||||
test_isolates <- test_isolates %>% # remove bugs to be excluded and final style conversions
|
||||
filter(!(fullname %in% exclude)) %>%
|
||||
mutate(fullname = str_to_title(fullname))
|
||||
|
||||
rx_abo <- x %>% #from orginal dataset
|
||||
filter(mo %in% test_isolates$mo) %>% #select only those bugs that should be included
|
||||
distinct(date, patient, mo, .keep_all = TRUE) #ensure that there are no duplications
|
||||
rx_regs <- names(rx_abo)[!(names(rx_abo) %in% demograph_df)] #extract susceptibility data
|
||||
|
||||
if (any(str_detect(rx_regs,fixed("+")))){#if combinations have already been accounted for in susceptibility profiling
|
||||
|
||||
rx_abo <- x %>% # from orginal dataset
|
||||
filter(mo %in% test_isolates$mo) %>% # select only those bugs that should be included
|
||||
distinct(date, patient, mo, .keep_all = TRUE) # ensure that there are no duplications
|
||||
rx_regs <- names(rx_abo)[!(names(rx_abo) %in% demograph_df)] # extract susceptibility data
|
||||
|
||||
if (any(str_detect(rx_regs, fixed("+")))) { # if combinations have already been accounted for in susceptibility profiling
|
||||
rx_regs_ind <- which(!(names(rx_abo) %in% demograph_df)) # extract susceptibility data
|
||||
rx_regs_comb <- rx_regs[str_detect(rx_regs,fixed("+"))]# find combination regimen variables
|
||||
rx_regs_comb <- rx_regs[str_detect(rx_regs, fixed("+"))] # find combination regimen variables
|
||||
rx_regs_comb_x_total <- data.frame()
|
||||
|
||||
for (jj in 1:length(rx_regs_comb)){ # for every combination regimen
|
||||
rx_regs_comb_sep <- str_remove_all(unlist(str_split(rx_regs_comb[jj], fixed("+"))),"[[:punct:]]") #extract separate antimicrobials included in regimen
|
||||
|
||||
for (jj in 1:length(rx_regs_comb)) { # for every combination regimen
|
||||
rx_regs_comb_sep <- str_remove_all(unlist(str_split(rx_regs_comb[jj], fixed("+"))), "[[:punct:]]") # extract separate antimicrobials included in regimen
|
||||
rx_regs_comb_pre <- data.frame(x = rep(0, times = 2), y = rep(0, times = 2))
|
||||
for (ii in 1:length(rx_regs_comb_sep)){ #for every antibiotic in the combination regimen
|
||||
rx_regs_comb_name <- ab_name(rx_regs_comb_sep[ii], only_first = TRUE) #extract their antibiotic name
|
||||
rx_regs_comb_ab <- as.ab(rx_regs_comb_name) #convert antibiotic name to abbreviation
|
||||
rx_regs_comb_antibiotic <- subset(antimicrobials, antimicrobials$ab %in% rx_regs_comb_ab)[,c("ab","name")]
|
||||
rx_regs_comb_pre[ii,] <- rx_regs_comb_antibiotic
|
||||
for (ii in 1:length(rx_regs_comb_sep)) { # for every antibiotic in the combination regimen
|
||||
rx_regs_comb_name <- ab_name(rx_regs_comb_sep[ii], only_first = TRUE) # extract their antibiotic name
|
||||
rx_regs_comb_ab <- as.ab(rx_regs_comb_name) # convert antibiotic name to abbreviation
|
||||
rx_regs_comb_antibiotic <- subset(antimicrobials, antimicrobials$ab %in% rx_regs_comb_ab)[, c("ab", "name")]
|
||||
rx_regs_comb_pre[ii, ] <- rx_regs_comb_antibiotic
|
||||
names(rx_regs_comb_pre) <- names(rx_regs_comb_antibiotic)
|
||||
}
|
||||
rx_regs_comb_x <- pivot_wider(rx_regs_comb_pre, names_from = name, values_from = ab)
|
||||
rx_regs_comb_x_set <- rx_regs_comb_x %>%
|
||||
mutate(namerx = str_flatten(str_c(names(rx_regs_comb_x), collapse = "+"))) #generate new antimicrobials table
|
||||
rx_regs_new_ab <- sapply(X = as.character(1:(ncol(rx_regs_comb_x_set)-1)), FUN = function(x){str_flatten(str_c("ab",x))})
|
||||
names(rx_regs_comb_x_set)[1:(ncol(rx_regs_comb_x_set)-1)] <- rx_regs_new_ab
|
||||
names(rx_regs_comb_x_set)[ncol(rx_regs_comb_x_set)]<- "namerx"
|
||||
rx_regs_comb_x_total <-rbind.data.frame(rx_regs_comb_x_total, rx_regs_comb_x_set, row.names = NULL)
|
||||
mutate(namerx = str_flatten(str_c(names(rx_regs_comb_x), collapse = "+"))) # generate new antimicrobials table
|
||||
rx_regs_new_ab <- sapply(X = as.character(1:(ncol(rx_regs_comb_x_set) - 1)), FUN = function(x) {
|
||||
str_flatten(str_c("ab", x))
|
||||
})
|
||||
names(rx_regs_comb_x_set)[1:(ncol(rx_regs_comb_x_set) - 1)] <- rx_regs_new_ab
|
||||
names(rx_regs_comb_x_set)[ncol(rx_regs_comb_x_set)] <- "namerx"
|
||||
rx_regs_comb_x_total <- rbind.data.frame(rx_regs_comb_x_total, rx_regs_comb_x_set, row.names = NULL)
|
||||
}
|
||||
|
||||
rx_regs_comb_rename <- select(rx_regs_comb_x_total,starts_with("ab")) #extract all antibiotic abbreviations
|
||||
#regenerate variable names for dataset
|
||||
|
||||
rx_regs_comb_rename <- select(rx_regs_comb_x_total, starts_with("ab")) # extract all antibiotic abbreviations
|
||||
# regenerate variable names for dataset
|
||||
suppressWarnings({
|
||||
for (k in 1:nrow(rx_regs_comb_x_total)){
|
||||
rx_regs_comb_rename_2 <- unlist(rx_regs_comb_rename[k,])
|
||||
for (k in 1:nrow(rx_regs_comb_x_total)) {
|
||||
rx_regs_comb_rename_2 <- unlist(rx_regs_comb_rename[k, ])
|
||||
rx_regs_comb_rename_vec <- str_flatten(str_c(rx_regs_comb_rename_2, collapse = "+"))
|
||||
names(rx_abo)[names(rx_abo) == rx_regs_comb[k]] <- rx_regs_comb_rename_vec
|
||||
|
||||
}
|
||||
})
|
||||
names(rx_abo)[!(str_detect(names(rx_abo),fixed("+"))) & !(names(rx_abo) %in% demograph_df)] <-
|
||||
as.ab(names(rx_abo)[!(str_detect(names(rx_abo),fixed("+"))) & !(names(rx_abo) %in% demograph_df)])
|
||||
names(rx_abo)[which(duplicated(names(rx_abo)))] <- str_c(names(rx_abo)[which(duplicated(names(rx_abo)))],".x")
|
||||
rx_abo_upd <- left_join_microorganisms(x = rx_abo, by = "mo")[,c(names(rx_abo),"fullname")]
|
||||
|
||||
names(rx_abo)[!(str_detect(names(rx_abo), fixed("+"))) & !(names(rx_abo) %in% demograph_df)] <-
|
||||
as.ab(names(rx_abo)[!(str_detect(names(rx_abo), fixed("+"))) & !(names(rx_abo) %in% demograph_df)])
|
||||
names(rx_abo)[which(duplicated(names(rx_abo)))] <- str_c(names(rx_abo)[which(duplicated(names(rx_abo)))], ".x")
|
||||
rx_abo_upd <- left_join_microorganisms(x = rx_abo, by = "mo")[, c(names(rx_abo), "fullname")]
|
||||
} else {
|
||||
names(rx_abo)[!(names(rx_abo) %in% demograph_df)] <- as.ab(names(rx_abo)[!(names(rx_abo) %in% demograph_df)])
|
||||
names(rx_abo)[which(duplicated(names(rx_abo)))] <- str_c(names(rx_abo)[which(duplicated(names(rx_abo)))],".x")
|
||||
rx_abo_upd <- left_join_microorganisms(x = rx_abo, by = "mo")[,c(names(rx_abo),"fullname")]
|
||||
|
||||
}
|
||||
names(rx_abo)[which(duplicated(names(rx_abo)))] <- str_c(names(rx_abo)[which(duplicated(names(rx_abo)))], ".x")
|
||||
rx_abo_upd <- left_join_microorganisms(x = rx_abo, by = "mo")[, c(names(rx_abo), "fullname")]
|
||||
}
|
||||
} else {
|
||||
#If fullname included in dataset:
|
||||
# If fullname included in dataset:
|
||||
test_isolates_pre <- x %>%
|
||||
mutate(across(.cols = all_of(demograph_df),~ str_to_title(.x))) %>%
|
||||
mutate(across(.cols = all_of(demograph_df), ~ str_to_title(.x))) %>%
|
||||
filter(!(fullname %in% unique(exclude)))
|
||||
print(nrow(test_isolates_pre))
|
||||
test_isolates <- left_join_microorganisms(x = test_isolates_pre, by = "fullname")[,c(demograph_df,"mo")]
|
||||
test_isolates$fullname <- str_to_title(test_isolates$fullname)
|
||||
test_isolates <- left_join_microorganisms(x = test_isolates_pre, by = "fullname")[, c(demograph_df, "mo")]
|
||||
test_isolates$fullname <- str_to_title(test_isolates$fullname)
|
||||
test_isolates$mo <- toupper(test_isolates$mo)
|
||||
|
||||
|
||||
rx_abo <- x %>%
|
||||
mutate(fullname = str_to_title(fullname)) %>%
|
||||
filter(!(fullname %in% unique(exclude))) %>%
|
||||
filter(!(fullname %in% unique(exclude))) %>%
|
||||
distinct(date, patient, fullname, .keep_all = TRUE)
|
||||
rx_regs <- names(rx_abo)[!(names(rx_abo) %in% demograph_df)] #susceptibility data
|
||||
|
||||
if (any(str_detect(rx_regs,fixed("+")))){#if combinations have already been accounted for
|
||||
rx_regs <- names(rx_abo)[!(names(rx_abo) %in% demograph_df)] # susceptibility data
|
||||
|
||||
if (any(str_detect(rx_regs, fixed("+")))) { # if combinations have already been accounted for
|
||||
rx_regs_ind <- which(!(names(rx_abo) %in% demograph_df))
|
||||
rx_regs_comb <- rx_regs[str_detect(rx_regs,fixed("+"))]
|
||||
rx_regs_comb <- rx_regs[str_detect(rx_regs, fixed("+"))]
|
||||
rx_regs_comb_x_total <- data.frame()
|
||||
|
||||
for (jj in 1:length(rx_regs_comb)){
|
||||
rx_regs_comb_sep <- str_remove_all(unlist(str_split(rx_regs_comb[jj], fixed("+"))),"[[:punct:]]")
|
||||
|
||||
for (jj in 1:length(rx_regs_comb)) {
|
||||
rx_regs_comb_sep <- str_remove_all(unlist(str_split(rx_regs_comb[jj], fixed("+"))), "[[:punct:]]")
|
||||
rx_regs_comb_pre <- data.frame(x = rep(0, times = 2), y = rep(0, times = 2))
|
||||
for (ii in 1:length(rx_regs_comb_sep)){
|
||||
for (ii in 1:length(rx_regs_comb_sep)) {
|
||||
rx_regs_comb_name <- ab_name(rx_regs_comb_sep[ii], only_first = TRUE)
|
||||
rx_regs_comb_ab <- as.ab(rx_regs_comb_name)
|
||||
rx_regs_comb_antibiotic <- subset(antimicrobials, antimicrobials$ab %in% rx_regs_comb_ab)[,c("ab","name")]
|
||||
rx_regs_comb_pre[ii,] <- rx_regs_comb_antibiotic
|
||||
rx_regs_comb_antibiotic <- subset(antimicrobials, antimicrobials$ab %in% rx_regs_comb_ab)[, c("ab", "name")]
|
||||
rx_regs_comb_pre[ii, ] <- rx_regs_comb_antibiotic
|
||||
names(rx_regs_comb_pre) <- names(rx_regs_comb_antibiotic)
|
||||
}
|
||||
rx_regs_comb_x <- pivot_wider(rx_regs_comb_pre, names_from = name, values_from = ab)
|
||||
rx_regs_comb_x_set <- rx_regs_comb_x %>%
|
||||
mutate(namerx = str_flatten(str_c(names(rx_regs_comb_x), collapse = "+")))
|
||||
rx_regs_new_ab <- sapply(X = as.character(1:(ncol(rx_regs_comb_x_set)-1)), FUN = function(x){str_flatten(str_c("ab",x))})
|
||||
names(rx_regs_comb_x_set)[1:(ncol(rx_regs_comb_x_set)-1)] <- rx_regs_new_ab
|
||||
names(rx_regs_comb_x_set)[ncol(rx_regs_comb_x_set)]<- "namerx"
|
||||
rx_regs_comb_x_total <-rbind.data.frame(rx_regs_comb_x_total, rx_regs_comb_x_set, row.names = NULL)
|
||||
rx_regs_new_ab <- sapply(X = as.character(1:(ncol(rx_regs_comb_x_set) - 1)), FUN = function(x) {
|
||||
str_flatten(str_c("ab", x))
|
||||
})
|
||||
names(rx_regs_comb_x_set)[1:(ncol(rx_regs_comb_x_set) - 1)] <- rx_regs_new_ab
|
||||
names(rx_regs_comb_x_set)[ncol(rx_regs_comb_x_set)] <- "namerx"
|
||||
rx_regs_comb_x_total <- rbind.data.frame(rx_regs_comb_x_total, rx_regs_comb_x_set, row.names = NULL)
|
||||
}
|
||||
|
||||
rx_regs_comb_rename <- select(rx_regs_comb_x_total,starts_with("ab"))
|
||||
|
||||
|
||||
rx_regs_comb_rename <- select(rx_regs_comb_x_total, starts_with("ab"))
|
||||
|
||||
suppressWarnings({
|
||||
for (k in 1:nrow(rx_regs_comb_x_total)){
|
||||
rx_regs_comb_rename_2 <- unlist(rx_regs_comb_rename[k,])
|
||||
for (k in 1:nrow(rx_regs_comb_x_total)) {
|
||||
rx_regs_comb_rename_2 <- unlist(rx_regs_comb_rename[k, ])
|
||||
rx_regs_comb_rename_vec <- str_flatten(str_c(rx_regs_comb_rename_2, collapse = "+"))
|
||||
names(rx_abo)[names(rx_abo) == rx_regs_comb[k]] <- rx_regs_comb_rename_vec
|
||||
}
|
||||
})
|
||||
names(rx_abo)[!(str_detect(names(rx_abo),fixed("+"))) & !(names(rx_abo) %in% demograph_df)] <-
|
||||
as.ab(names(rx_abo)[!(str_detect(names(rx_abo),fixed("+"))) & !(names(rx_abo) %in% demograph_df)])
|
||||
names(rx_abo)[which(duplicated(names(rx_abo)))] <- str_c(names(rx_abo)[which(duplicated(names(rx_abo)))],".x")
|
||||
rx_abo_upd <- left_join_microorganisms(x = rx_abo, by = "fullname")[,c(names(rx_abo),"mo")]
|
||||
|
||||
names(rx_abo)[!(str_detect(names(rx_abo), fixed("+"))) & !(names(rx_abo) %in% demograph_df)] <-
|
||||
as.ab(names(rx_abo)[!(str_detect(names(rx_abo), fixed("+"))) & !(names(rx_abo) %in% demograph_df)])
|
||||
names(rx_abo)[which(duplicated(names(rx_abo)))] <- str_c(names(rx_abo)[which(duplicated(names(rx_abo)))], ".x")
|
||||
rx_abo_upd <- left_join_microorganisms(x = rx_abo, by = "fullname")[, c(names(rx_abo), "mo")]
|
||||
} else {
|
||||
names(rx_abo)[!(names(rx_abo) %in% demograph_df)] <- as.ab(names(rx_abo)[!(names(rx_abo) %in% demograph_df)])
|
||||
names(rx_abo)[which(duplicated(names(rx_abo)))] <- str_c(names(rx_abo)[which(duplicated(names(rx_abo)))],".x")
|
||||
rx_abo_upd <- left_join_microorganisms(x = rx_abo, by = "fullname")[,c(names(rx_abo),"mo")]
|
||||
|
||||
}
|
||||
names(rx_abo)[which(duplicated(names(rx_abo)))] <- str_c(names(rx_abo)[which(duplicated(names(rx_abo)))], ".x")
|
||||
rx_abo_upd <- left_join_microorganisms(x = rx_abo, by = "fullname")[, c(names(rx_abo), "mo")]
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
rx_abo_upd$fullname <- str_to_title(rx_abo_upd$fullname)
|
||||
|
||||
|
||||
#generate new dataset with demographic information and only antimicrobials under investigation
|
||||
rx_1 <- select(antibiotic_rx,starts_with("ab")) #all antimicrobials
|
||||
|
||||
|
||||
# generate new dataset with demographic information and only antimicrobials under investigation
|
||||
rx_1 <- select(antibiotic_rx, starts_with("ab")) # all antimicrobials
|
||||
rx_df <- test_isolates
|
||||
var_date <- names(rx_df)[str_detect(names(rx_df),"date")]
|
||||
var_date <- names(rx_df)[str_detect(names(rx_df), "date")]
|
||||
rx_df[[var_date]] <- ymd(rx_df[[var_date]])
|
||||
var_patient <- names(rx_df)[str_detect(names(rx_df),"patient")]
|
||||
var_patient <- names(rx_df)[str_detect(names(rx_df), "patient")]
|
||||
rx_df[[var_patient]] <- toupper(rx_df[[var_patient]])
|
||||
|
||||
|
||||
names_vec <- vector()
|
||||
suppressWarnings({
|
||||
for (k in 1:nrow(rx_1)){
|
||||
rx_2 <- unlist(rx_1[k,][!is.na(str_extract(rx_1[k,],"[A-Z]+"))])
|
||||
if ((length(rx_2) > 1) & !(str_flatten(str_c(rx_2, collapse = "+")) %in% names(rx_abo_upd))){ # if more than one antibiotic in regimen and susceptibility of the combination not considered
|
||||
rx_df <- merge(x = rx_df, y = rx_abo_upd[,c("date","patient","mo",rx_2)], by = c("date","patient","mo")) #then bind separate antimicrobials in regimen
|
||||
#if prior individual antibiotic was added, suffix will be generated
|
||||
for (jj in 1:length(rx_2)){
|
||||
if (any(str_detect(names(rx_df),paste0(rx_2[jj],".y")))){
|
||||
rx_df[[paste0(rx_2[jj],".y")]] <- str_trim(rx_df[[paste0(rx_2[jj],".y")]])
|
||||
for (k in 1:nrow(rx_1)) {
|
||||
rx_2 <- unlist(rx_1[k, ][!is.na(str_extract(rx_1[k, ], "[A-Z]+"))])
|
||||
if ((length(rx_2) > 1) & !(str_flatten(str_c(rx_2, collapse = "+")) %in% names(rx_abo_upd))) { # if more than one antibiotic in regimen and susceptibility of the combination not considered
|
||||
rx_df <- merge(x = rx_df, y = rx_abo_upd[, c("date", "patient", "mo", rx_2)], by = c("date", "patient", "mo")) # then bind separate antimicrobials in regimen
|
||||
# if prior individual antibiotic was added, suffix will be generated
|
||||
for (jj in 1:length(rx_2)) {
|
||||
if (any(str_detect(names(rx_df), paste0(rx_2[jj], ".y")))) {
|
||||
rx_df[[paste0(rx_2[jj], ".y")]] <- str_trim(rx_df[[paste0(rx_2[jj], ".y")]])
|
||||
} else {
|
||||
rx_df[[rx_2[jj]]] <- str_trim(rx_df[[rx_2[jj]]])
|
||||
}
|
||||
}
|
||||
names(rx_df)[names(rx_df) %in% rx_2] <- str_flatten(str_c(rx_2, collapse = "+")) #rename both variables as the combination
|
||||
names(rx_df)[names(rx_df) %in% paste0(rx_2,".y")] <- str_flatten(str_c(rx_2, collapse = "+"))
|
||||
names(rx_df)[names(rx_df) %in% paste0(rx_2,".x")] <- rx_2
|
||||
names(rx_df)[names(rx_df) %in% rx_2] <- str_flatten(str_c(rx_2, collapse = "+")) # rename both variables as the combination
|
||||
names(rx_df)[names(rx_df) %in% paste0(rx_2, ".y")] <- str_flatten(str_c(rx_2, collapse = "+"))
|
||||
names(rx_df)[names(rx_df) %in% paste0(rx_2, ".x")] <- rx_2
|
||||
names_vec[k] <- str_flatten(str_c(rx_2, collapse = "+"))
|
||||
} else if ((length(rx_2) > 1) & (str_flatten(str_c(rx_2, collapse = "+")) %in% names(rx_abo_upd))){#if more than one antibiotic in regimen and susceptibility of the combination considered
|
||||
rx_df <- merge(x = rx_df, y = rx_abo_upd[,c("date","patient","mo",str_flatten(str_c(rx_2, collapse = "+")))], by = c("date","patient","mo"))
|
||||
} else if ((length(rx_2) > 1) & (str_flatten(str_c(rx_2, collapse = "+")) %in% names(rx_abo_upd))) { # if more than one antibiotic in regimen and susceptibility of the combination considered
|
||||
rx_df <- merge(x = rx_df, y = rx_abo_upd[, c("date", "patient", "mo", str_flatten(str_c(rx_2, collapse = "+")))], by = c("date", "patient", "mo"))
|
||||
rx_df[[str_flatten(str_c(rx_2, collapse = "+"))]] <- str_trim(rx_df[[str_flatten(str_c(rx_2, collapse = "+"))]])
|
||||
names_vec[k] <- str_flatten(str_c(rx_2, collapse = "+"))
|
||||
} else {
|
||||
rx_df <- merge(x = rx_df, y = rx_abo_upd[,c("date","patient","mo",rx_2)], by = c("date","patient","mo")) #then bind separate antimicrobials in regimen
|
||||
rx_df <- merge(x = rx_df, y = rx_abo_upd[, c("date", "patient", "mo", rx_2)], by = c("date", "patient", "mo")) # then bind separate antimicrobials in regimen
|
||||
rx_df[[rx_2]] <- str_trim(rx_df[[rx_2]])
|
||||
names(rx_df)[names(rx_df) %in% rx_2] <- str_flatten(str_c(rx_2, collapse = "+")) #rename both variables as the combination
|
||||
names(rx_df)[names(rx_df) %in% paste0(rx_2,".y")] <- str_flatten(str_c(rx_2, collapse = "+"))
|
||||
names(rx_df)[names(rx_df) %in% paste0(rx_2,".x")] <- rx_2
|
||||
names(rx_df)[names(rx_df) %in% rx_2] <- str_flatten(str_c(rx_2, collapse = "+")) # rename both variables as the combination
|
||||
names(rx_df)[names(rx_df) %in% paste0(rx_2, ".y")] <- str_flatten(str_c(rx_2, collapse = "+"))
|
||||
names(rx_df)[names(rx_df) %in% paste0(rx_2, ".x")] <- rx_2
|
||||
names_vec[k] <- rx_2
|
||||
}
|
||||
}
|
||||
})
|
||||
|
||||
if (any(is.na(rx_df$mo))){
|
||||
|
||||
if (any(is.na(rx_df$mo))) {
|
||||
missing1 <- which(is.na(rx_df$mo))
|
||||
if (rx_df[missing1,"fullname"] != "NA"){
|
||||
rx_df[missing1,"mo"] <- as.mo(rx_df[missing1,]$fullname, keep_synonyms = TRUE)
|
||||
if (rx_df[missing1, "fullname"] != "NA") {
|
||||
rx_df[missing1, "mo"] <- as.mo(rx_df[missing1, ]$fullname, keep_synonyms = TRUE)
|
||||
} else {
|
||||
rx_df <- rx_df[-missing1,]
|
||||
rx_df <- rx_df[-missing1, ]
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#Generate adapted first isolate dataset on antimicrobial level
|
||||
if (isolate_first == "yes"){ #if dataset has already been deduplicated for first isolates
|
||||
|
||||
|
||||
# Generate adapted first isolate dataset on antimicrobial level
|
||||
if (isolate_first == "yes") { # if dataset has already been deduplicated for first isolates
|
||||
test_isolates_first <- rx_df
|
||||
} else {
|
||||
test_isolates_first <- rx_df[first_isolate(x = rx_df,
|
||||
method = "e",
|
||||
episode_days = 14,
|
||||
col_date = var_date,
|
||||
col_mo = "mo") == TRUE,] #Only include isolates for microorganisms < 14 days apart
|
||||
test_isolates_first <- rx_df[first_isolate(
|
||||
x = rx_df,
|
||||
method = "e",
|
||||
episode_days = 14,
|
||||
col_date = var_date,
|
||||
col_mo = "mo"
|
||||
) == TRUE, ] # Only include isolates for microorganisms < 14 days apart
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
test_isolates_first_upd <<- test_isolates_first %>%
|
||||
pivot_longer(cols = names(test_isolates_first)[which(sapply(test_isolates_first,
|
||||
function(y) any(str_detect(y,"^S$"))|any(str_detect(y,"^R$"))|any(str_detect(y,"^SENSITIVE$"))| any(str_detect(y,"^RESISTANT$"))))],
|
||||
names_to = "keyantimicrobials", values_to = "antibiogram") %>% #combine all regimens and antibiograms into single variables
|
||||
mutate(antibiogram = ifelse(antibiogram == "I"|antibiogram == "INTERMEDIATE",susceptible_I,antibiogram)) %>% #simplify susceptibility outputs - 90-60 rule
|
||||
mutate(antibiogram = ifelse(antibiogram == "SENSITIVE","S", antibiogram)) %>%
|
||||
mutate(antibiogram = ifelse(antibiogram == "RESISTANT","R",antibiogram)) %>%
|
||||
mutate(antibiogram = factor(antibiogram),
|
||||
keyantimicrobials = as.factor(keyantimicrobials))
|
||||
|
||||
|
||||
#recode susceptibility of regimes if not already in the dataset: if any S, then all S; if any NA and not S, then combination NA; if all R, then combination R.
|
||||
pivot_longer(
|
||||
cols = names(test_isolates_first)[which(sapply(
|
||||
test_isolates_first,
|
||||
function(y) any(str_detect(y, "^S$")) | any(str_detect(y, "^R$")) | any(str_detect(y, "^SENSITIVE$")) | any(str_detect(y, "^RESISTANT$"))
|
||||
))],
|
||||
names_to = "keyantimicrobials", values_to = "antibiogram"
|
||||
) %>% # combine all regimens and antibiograms into single variables
|
||||
mutate(antibiogram = ifelse(antibiogram == "I" | antibiogram == "INTERMEDIATE", susceptible_I, antibiogram)) %>% # simplify susceptibility outputs - 90-60 rule
|
||||
mutate(antibiogram = ifelse(antibiogram == "SENSITIVE", "S", antibiogram)) %>%
|
||||
mutate(antibiogram = ifelse(antibiogram == "RESISTANT", "R", antibiogram)) %>%
|
||||
mutate(
|
||||
antibiogram = factor(antibiogram),
|
||||
keyantimicrobials = as.factor(keyantimicrobials)
|
||||
)
|
||||
|
||||
|
||||
# recode susceptibility of regimes if not already in the dataset: if any S, then all S; if any NA and not S, then combination NA; if all R, then combination R.
|
||||
print("-------------------")
|
||||
print(test_isolates_first_upd)
|
||||
print(names(test_isolates_first_upd))
|
||||
print(duplicated(names(test_isolates_first_upd)))
|
||||
print(any(duplicated(names(test_isolates_first_upd))))
|
||||
print("-------------------")
|
||||
|
||||
if (any(duplicated(names(test_isolates_first_upd)))){
|
||||
|
||||
if (any(duplicated(names(test_isolates_first_upd)))) {
|
||||
test_isolates_temp3 <- test_isolates_upd %>%
|
||||
mutate(antibiogram = as.character(antibiogram)) %>%
|
||||
mutate(antibiogram = replace_na(antibiogram,"U")) %>%
|
||||
mutate(antibiogram = replace_na(antibiogram, "U")) %>%
|
||||
mutate(combiantibiogram = "A")
|
||||
test_isolates_temp4 <- test_isolates_temp3 %>%
|
||||
group_by(date,patient,mo,keyantimicrobials) %>%
|
||||
mutate(combiantibiogram = ifelse(any(str_detect(antibiogram,"S")), "S",combiantibiogram)) %>%
|
||||
mutate(combiantibiogram = ifelse(any(str_detect(antibiogram,"U")) & !any(str_detect(antibiogram,"S")), "U",combiantibiogram)) %>%
|
||||
mutate(combiantibiogram = ifelse(!any(str_detect(antibiogram,"U")) & !any(str_detect(antibiogram,"S")), "R", combiantibiogram)) %>%
|
||||
distinct(date,patient,mo,.keep_all = TRUE) %>%
|
||||
group_by(date, patient, mo, keyantimicrobials) %>%
|
||||
mutate(combiantibiogram = ifelse(any(str_detect(antibiogram, "S")), "S", combiantibiogram)) %>%
|
||||
mutate(combiantibiogram = ifelse(any(str_detect(antibiogram, "U")) & !any(str_detect(antibiogram, "S")), "U", combiantibiogram)) %>%
|
||||
mutate(combiantibiogram = ifelse(!any(str_detect(antibiogram, "U")) & !any(str_detect(antibiogram, "S")), "R", combiantibiogram)) %>%
|
||||
distinct(date, patient, mo, .keep_all = TRUE) %>%
|
||||
ungroup() %>%
|
||||
select(-antibiogram) %>%
|
||||
rename("antibiogram" = "combiantibiogram") %>%
|
||||
mutate(antibiogram = ifelse(antibiogram == "U",NA_character_, antibiogram)) %>%
|
||||
mutate(antibiogram = ifelse(antibiogram == "U", NA_character_, antibiogram)) %>%
|
||||
mutate(antibiogram = as.factor(antibiogram))
|
||||
|
||||
test_isolates_temp5 <- test_isolates_upd %>% #isolate the single regimens
|
||||
group_by(date,patient,mo) %>%
|
||||
filter(!str_detect(keyantimicrobials,fixed("+"))) %>%
|
||||
|
||||
test_isolates_temp5 <- test_isolates_upd %>% # isolate the single regimens
|
||||
group_by(date, patient, mo) %>%
|
||||
filter(!str_detect(keyantimicrobials, fixed("+"))) %>%
|
||||
ungroup()
|
||||
|
||||
test_isolates_final <- bind_rows(test_isolates_temp4,test_isolates_temp5)
|
||||
|
||||
test_isolates_final <- bind_rows(test_isolates_temp4, test_isolates_temp5)
|
||||
test_isolates_final <- test_isolates_final %>%
|
||||
arrange(patient)
|
||||
|
||||
arrange(patient)
|
||||
} else {
|
||||
test_isolates_final <- test_isolates_first_upd
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
test_isolates_final <<- test_isolates_final
|
||||
|
||||
|
||||
test_isolates_final$fullname <- as.factor(test_isolates_final$fullname)
|
||||
test_isolates_final$date <- ymd(test_isolates_final$date)
|
||||
|
||||
|
||||
#Calculate pathogen incidence and susceptible by regimen
|
||||
mo_name_total <- test_isolates_final %>% #deduplicate pathogen list
|
||||
filter(!duplicated(mo)) %>%
|
||||
select(mo,fullname)
|
||||
|
||||
organism_count_total <- test_isolates_final %>% #count the number of occurrences of pathogens within first isolates set
|
||||
|
||||
|
||||
# Calculate pathogen incidence and susceptible by regimen
|
||||
mo_name_total <- test_isolates_final %>% # deduplicate pathogen list
|
||||
filter(!duplicated(mo)) %>%
|
||||
select(mo, fullname)
|
||||
|
||||
organism_count_total <- test_isolates_final %>% # count the number of occurrences of pathogens within first isolates set
|
||||
group_by(mo) %>%
|
||||
distinct(date,patient,.keep_all = TRUE) %>%
|
||||
distinct(date, patient, .keep_all = TRUE) %>%
|
||||
count(mo) %>%
|
||||
ungroup() %>%
|
||||
arrange(desc(n))
|
||||
|
||||
|
||||
organism_count_total_upd <- organism_count_total %>%
|
||||
mutate(mo = as.character(mo)) %>%
|
||||
mutate(mo = ifelse(str_detect(mo, "^B_KLBSL"),"B_KLBSL",mo)) %>%
|
||||
mutate(mo = as.factor(mo))
|
||||
mutate(mo = ifelse(str_detect(mo, "^B_KLBSL"), "B_KLBSL", mo)) %>%
|
||||
mutate(mo = as.factor(mo))
|
||||
klebsiella_combine <- organism_count_total_upd %>%
|
||||
filter(mo == "B_KLBSL") %>%
|
||||
summarise(n_kleb = sum(n))
|
||||
organism_count_total_upd <- organism_count_total_upd %>%
|
||||
mutate(n = ifelse(mo == "B_KLBSL", klebsiella_combine$n_kleb, n)) %>%
|
||||
distinct(mo,.keep_all = TRUE)
|
||||
distinct(mo, .keep_all = TRUE)
|
||||
organism_count_total_upd <- rename(organism_count_total_upd,
|
||||
"n_inc" = "n")
|
||||
|
||||
regimen_organism <- slice_max(organism_count_total_upd, order_by = n_inc, n = pathogen_in) #choose only the top n number of occurring pathogens to consider in WISCA
|
||||
total_pathogens <- sum(regimen_organism$n_inc) #total number of occurrences of pathogens
|
||||
print(paste0("Total pathogens = ",sum(organism_count_total_upd$n_inc)))
|
||||
"n_inc" = "n"
|
||||
)
|
||||
|
||||
regimen_organism <- slice_max(organism_count_total_upd, order_by = n_inc, n = pathogen_in) # choose only the top n number of occurring pathogens to consider in WISCA
|
||||
total_pathogens <- sum(regimen_organism$n_inc) # total number of occurrences of pathogens
|
||||
print(paste0("Total pathogens = ", sum(organism_count_total_upd$n_inc)))
|
||||
print(paste0("Number of pathogens contributing to WISCA = ", total_pathogens))
|
||||
print(paste0("Percentage of pathogens contributing to WISCA = ",round((total_pathogens/sum(organism_count_total_upd$n_inc))*100,0),"%"))
|
||||
|
||||
print(paste0("Percentage of pathogens contributing to WISCA = ", round((total_pathogens / sum(organism_count_total_upd$n_inc)) * 100, 0), "%"))
|
||||
|
||||
test_isolates_final <- test_isolates_final %>%
|
||||
mutate(mo = as.character(mo)) %>%
|
||||
mutate(mo = ifelse(str_detect(mo, "^B_KLBSL"), "B_KLBSL",mo)) %>% #combine all Klebsiella species together
|
||||
mutate(mo = ifelse(str_detect(mo, "^B_KLBSL"), "B_KLBSL", mo)) %>% # combine all Klebsiella species together
|
||||
mutate(mo = as.factor(mo)) %>%
|
||||
mutate(fullname = as.character(fullname)) %>%
|
||||
mutate(fullname = ifelse(str_detect(fullname, "Klebsiella"), "Klebsiella sp.", fullname)) %>% #rename all Klebsiella species
|
||||
mutate(fullname = ifelse(str_detect(fullname, "Klebsiella"), "Klebsiella sp.", fullname)) %>% # rename all Klebsiella species
|
||||
mutate(fullname = as.factor(fullname))
|
||||
|
||||
|
||||
#for each antimicrobial regimen calculate the pathogen incidence and sensitivity
|
||||
|
||||
|
||||
# for each antimicrobial regimen calculate the pathogen incidence and sensitivity
|
||||
params_set_out <- data.frame()
|
||||
|
||||
if (analysis %in% names(test_isolates_final)){
|
||||
|
||||
#if there is a facility/ward/category level analysis required
|
||||
for (j in 1:length(unique(test_isolates_final[[analysis]]))){#for every facility/ward/category
|
||||
infection_episodes <- length(unique(test_isolates_final[test_isolates_final[[analysis]] == unique(test_isolates_final[[analysis]])[j],]$patient))
|
||||
|
||||
if (infection_episodes < 100){#must have at least 100 infection episodes for WISCA
|
||||
warning(paste0("Number of infection episodes = ",infection_episodes,". Minimum sample size for WISCA is 100 infection episodes. Below minimum sample size will produce inaccurate coverage estimates."))
|
||||
|
||||
|
||||
if (analysis %in% names(test_isolates_final)) {
|
||||
# if there is a facility/ward/category level analysis required
|
||||
for (j in 1:length(unique(test_isolates_final[[analysis]]))) { # for every facility/ward/category
|
||||
infection_episodes <- length(unique(test_isolates_final[test_isolates_final[[analysis]] == unique(test_isolates_final[[analysis]])[j], ]$patient))
|
||||
|
||||
if (infection_episodes < 100) { # must have at least 100 infection episodes for WISCA
|
||||
warning(paste0("Number of infection episodes = ", infection_episodes, ". Minimum sample size for WISCA is 100 infection episodes. Below minimum sample size will produce inaccurate coverage estimates."))
|
||||
} else {
|
||||
print(paste0("Number of infection episodes = ",infection_episodes," > 100 minimum required. Sample size adequate for WISCA analysis."))
|
||||
print(paste0("Number of infection episodes = ", infection_episodes, " > 100 minimum required. Sample size adequate for WISCA analysis."))
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
y_site <- subset(test_isolates_final, test_isolates_final[[analysis]] == unique(test_isolates_final[[analysis]])[j])
|
||||
|
||||
mo_name_sites <- y_site %>% #deduplicate
|
||||
filter(!duplicated(mo)) %>%
|
||||
select(mo,fullname,all_of(analysis))
|
||||
|
||||
organism_count_regimen <- y_site %>% #count the number of organisms per regimen
|
||||
|
||||
mo_name_sites <- y_site %>% # deduplicate
|
||||
filter(!duplicated(mo)) %>%
|
||||
select(mo, fullname, all_of(analysis))
|
||||
|
||||
organism_count_regimen <- y_site %>% # count the number of organisms per regimen
|
||||
filter(mo %in% regimen_organism$mo) %>%
|
||||
group_by(mo) %>%
|
||||
distinct(date, patient, .keep_all = TRUE) %>%
|
||||
count(mo) %>%
|
||||
ungroup() %>%
|
||||
arrange(desc(n))
|
||||
|
||||
|
||||
organism_count_df <- left_join(x = organism_count_regimen, y = mo_name_sites, by = "mo")[,c("mo",analysis,"fullname","n")]
|
||||
|
||||
|
||||
|
||||
organism_count_df <- left_join(x = organism_count_regimen, y = mo_name_sites, by = "mo")[, c("mo", analysis, "fullname", "n")]
|
||||
|
||||
total_sites_pathogens <- sum(organism_count_df$n)
|
||||
print(paste0("Number of pathogens contributing to WISCA in ",unique(test_isolates_final[[analysis]])[j]," = ", total_sites_pathogens))
|
||||
|
||||
organism_count_df <- organism_count_df %>%
|
||||
mutate(prop.n = n/total_sites_pathogens) #pathogen incidence = number of pathogen occurring/total pathogen occurrences included in WISCA
|
||||
#
|
||||
|
||||
susceptible_regimen_tested <<- y_site %>% #determine sensitivity profile - assume those with NA not tested. Calculate susceptibility only on tested
|
||||
print(paste0("Number of pathogens contributing to WISCA in ", unique(test_isolates_final[[analysis]])[j], " = ", total_sites_pathogens))
|
||||
|
||||
organism_count_df <- organism_count_df %>%
|
||||
mutate(prop.n = n / total_sites_pathogens) # pathogen incidence = number of pathogen occurring/total pathogen occurrences included in WISCA
|
||||
#
|
||||
|
||||
susceptible_regimen_tested <<- y_site %>% # determine sensitivity profile - assume those with NA not tested. Calculate susceptibility only on tested
|
||||
filter(mo %in% regimen_organism$mo) %>%
|
||||
filter(!is.na(antibiogram)) %>%
|
||||
group_by(mo,keyantimicrobials) %>%
|
||||
group_by(mo, keyantimicrobials) %>%
|
||||
distinct(date, patient, .keep_all = TRUE) %>%
|
||||
count(antibiogram) %>%
|
||||
ungroup() %>%
|
||||
arrange(desc(n))
|
||||
susceptible_regimen_ntested <<- y_site %>% #determine sensitivity profile - assume those with NA not tested. Calculate susceptibility only on tested
|
||||
arrange(desc(n))
|
||||
susceptible_regimen_ntested <<- y_site %>% # determine sensitivity profile - assume those with NA not tested. Calculate susceptibility only on tested
|
||||
filter(mo %in% regimen_organism$mo) %>%
|
||||
filter(is.na(antibiogram)) %>% #Not tested
|
||||
group_by(mo,keyantimicrobials) %>%
|
||||
filter(is.na(antibiogram)) %>% # Not tested
|
||||
group_by(mo, keyantimicrobials) %>%
|
||||
distinct(date, patient, .keep_all = TRUE) %>%
|
||||
count(antibiogram) %>%
|
||||
ungroup() %>%
|
||||
arrange(desc(n))
|
||||
|
||||
organism_count_df_tested <<- susceptible_regimen_tested %>%
|
||||
group_by(mo,keyantimicrobials) %>%
|
||||
arrange(desc(n))
|
||||
|
||||
organism_count_df_tested <<- susceptible_regimen_tested %>%
|
||||
group_by(mo, keyantimicrobials) %>%
|
||||
summarise(tested_n = sum(n), .groups = "keep") %>%
|
||||
ungroup()
|
||||
organism_count_df_ntested <<- susceptible_regimen_ntested %>%
|
||||
group_by(mo,keyantimicrobials) %>%
|
||||
organism_count_df_ntested <<- susceptible_regimen_ntested %>%
|
||||
group_by(mo, keyantimicrobials) %>%
|
||||
summarise(ntested_n = sum(n), .groups = "keep") %>%
|
||||
ungroup()
|
||||
|
||||
organism_count_df_combine_tested <- full_join(x = organism_count_df_tested, y = organism_count_df_ntested, by = c("mo","keyantimicrobials")) #combine tested and nontested
|
||||
|
||||
organism_count_df_combine_tested <- full_join(x = organism_count_df_tested, y = organism_count_df_ntested, by = c("mo", "keyantimicrobials")) # combine tested and nontested
|
||||
organism_count_df_combine_tested <- organism_count_df_combine_tested %>%
|
||||
mutate(tested_n = ifelse(is.na(tested_n), 0 ,tested_n),
|
||||
ntested_n = ifelse(is.na(ntested_n), 0, ntested_n))
|
||||
|
||||
organism_count_df_regimen_tested <- left_join(x = organism_count_df, y = organism_count_df_combine_tested[,c("mo","keyantimicrobials","tested_n")], by = "mo")
|
||||
|
||||
#minimum number of tested isolates per ABO should be 30 for accurate coverage estimates
|
||||
mutate(
|
||||
tested_n = ifelse(is.na(tested_n), 0, tested_n),
|
||||
ntested_n = ifelse(is.na(ntested_n), 0, ntested_n)
|
||||
)
|
||||
|
||||
organism_count_df_regimen_tested <- left_join(x = organism_count_df, y = organism_count_df_combine_tested[, c("mo", "keyantimicrobials", "tested_n")], by = "mo")
|
||||
|
||||
# minimum number of tested isolates per ABO should be 30 for accurate coverage estimates
|
||||
condition_tested <- organism_count_df_regimen_tested %>%
|
||||
filter(tested_n <30)
|
||||
if (nrow(condition_tested) > 0){
|
||||
filter(tested_n < 30)
|
||||
if (nrow(condition_tested) > 0) {
|
||||
warning("Number of tested isolates per regimen should exceed 30. Coverage estimates will be inaccurate for following regimens")
|
||||
View(condition_tested[c("mo","n","keyantimicrobials","tested_n")])
|
||||
View(condition_tested[c("mo", "n", "keyantimicrobials", "tested_n")])
|
||||
} else {
|
||||
print("Number of tested isolates per regimen exceed minimum threshold of 30.")
|
||||
}
|
||||
|
||||
|
||||
organism_tested_sensitive <- susceptible_regimen_tested %>%
|
||||
filter(antibiogram == "S")
|
||||
|
||||
if (nrow(susceptible_regimen_tested)> 0){
|
||||
sensitivity <- left_join(x = organism_count_df_regimen_tested, y = organism_tested_sensitive, by = c("mo","keyantimicrobials"))
|
||||
|
||||
if (nrow(susceptible_regimen_tested) > 0) {
|
||||
sensitivity <- left_join(x = organism_count_df_regimen_tested, y = organism_tested_sensitive, by = c("mo", "keyantimicrobials"))
|
||||
sensitivity <- sensitivity %>%
|
||||
rename("S_n" = "n.y") %>%
|
||||
mutate(S_n = ifelse(is.na(S_n),0,S_n)) %>%
|
||||
mutate(S_n = ifelse(is.na(S_n), 0, S_n)) %>%
|
||||
select(-antibiogram)
|
||||
sensitivity <- sensitivity %>% #calculate proportion sensitive out of those tested and having results
|
||||
mutate(prop.S = ifelse(tested_n != 0, S_n/tested_n, 0))
|
||||
sensitivity <- sensitivity %>% # calculate proportion sensitive out of those tested and having results
|
||||
mutate(prop.S = ifelse(tested_n != 0, S_n / tested_n, 0))
|
||||
sensitivity$perc.S <- sensitivity$prop.S * 100
|
||||
|
||||
params_set_out <- rbind.data.frame(params_set_out, sensitivity, row.names = NULL)
|
||||
} else {
|
||||
|
||||
params_set_out <- rbind.data.frame(params_set_out, sensitivity, row.names = NULL)
|
||||
} else {
|
||||
next
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
params_set_out$fullname <- droplevels(params_set_out$fullname)
|
||||
params_set_out[[names(test_isolates_final)[names(test_isolates_final) == analysis]]] <- as.factor(params_set_out[[names(test_isolates_final)[names(test_isolates_final) == analysis]]])
|
||||
|
||||
} else{
|
||||
|
||||
} else {
|
||||
infection_episodes <- length(unique(test_isolates_final$patient))
|
||||
if (infection_episodes < 100){#must have at least 100 infection episodes for WISCA
|
||||
warning(paste0("Number of infection episodes = ",infection_episodes,". Minimum sample size for WISCA is 100 infection episodes. Below minimum sample size will produce inaccurate coverage estimates."))
|
||||
|
||||
if (infection_episodes < 100) { # must have at least 100 infection episodes for WISCA
|
||||
warning(paste0("Number of infection episodes = ", infection_episodes, ". Minimum sample size for WISCA is 100 infection episodes. Below minimum sample size will produce inaccurate coverage estimates."))
|
||||
} else {
|
||||
print(paste0("Number of infection episodes = ",infection_episodes," > 100 minimum required. Sample size adequate for WISCA analysis."))
|
||||
print(paste0("Number of infection episodes = ", infection_episodes, " > 100 minimum required. Sample size adequate for WISCA analysis."))
|
||||
}
|
||||
|
||||
mo_name_sites <- test_isolates_final %>% #deduplicate
|
||||
filter(!duplicated(mo)) %>%
|
||||
select(mo,fullname)
|
||||
|
||||
organism_count_path <- test_isolates_final %>% #count the number of organisms
|
||||
|
||||
mo_name_sites <- test_isolates_final %>% # deduplicate
|
||||
filter(!duplicated(mo)) %>%
|
||||
select(mo, fullname)
|
||||
|
||||
organism_count_path <- test_isolates_final %>% # count the number of organisms
|
||||
filter(mo %in% regimen_organism$mo) %>%
|
||||
group_by(mo) %>%
|
||||
distinct(date, patient, .keep_all = TRUE) %>%
|
||||
count(mo) %>%
|
||||
ungroup() %>%
|
||||
arrange(desc(n))
|
||||
|
||||
organism_count_df <- left_join(x = organism_count_path, y = mo_name_sites, by = "mo")[,c("mo","fullname","n")]
|
||||
|
||||
arrange(desc(n))
|
||||
|
||||
organism_count_df <- left_join(x = organism_count_path, y = mo_name_sites, by = "mo")[, c("mo", "fullname", "n")]
|
||||
|
||||
total_sites_pathogens <- sum(organism_count_df$n)
|
||||
|
||||
|
||||
|
||||
organism_count_df <- organism_count_df %>%
|
||||
mutate(prop.n = n/total_pathogens) #pathogen incidence = number of pathogen occurring/total pathogen occurrences included in WISCA
|
||||
|
||||
|
||||
susceptible_regimen_tested <<- test_isolates_final %>% #determine sensitivity profile - assume those with NA not tested. Calculate susceptibility only on tested
|
||||
|
||||
|
||||
organism_count_df <- organism_count_df %>%
|
||||
mutate(prop.n = n / total_pathogens) # pathogen incidence = number of pathogen occurring/total pathogen occurrences included in WISCA
|
||||
|
||||
|
||||
susceptible_regimen_tested <<- test_isolates_final %>% # determine sensitivity profile - assume those with NA not tested. Calculate susceptibility only on tested
|
||||
filter(mo %in% regimen_organism$mo) %>%
|
||||
filter(!is.na(antibiogram)) %>% #Tested
|
||||
group_by(mo,keyantimicrobials) %>%
|
||||
filter(!is.na(antibiogram)) %>% # Tested
|
||||
group_by(mo, keyantimicrobials) %>%
|
||||
distinct(date, patient, .keep_all = TRUE) %>%
|
||||
count(antibiogram) %>%
|
||||
ungroup() %>%
|
||||
arrange(desc(n))
|
||||
susceptible_regimen_ntested <<- test_isolates_final %>% #determine sensitivity profile - assume those with NA not tested. Calculate susceptibility only on tested
|
||||
arrange(desc(n))
|
||||
susceptible_regimen_ntested <<- test_isolates_final %>% # determine sensitivity profile - assume those with NA not tested. Calculate susceptibility only on tested
|
||||
filter(mo %in% regimen_organism$mo) %>%
|
||||
filter(is.na(antibiogram)) %>% #Not tested
|
||||
group_by(mo,keyantimicrobials) %>%
|
||||
filter(is.na(antibiogram)) %>% # Not tested
|
||||
group_by(mo, keyantimicrobials) %>%
|
||||
distinct(date, patient, .keep_all = TRUE) %>%
|
||||
count(antibiogram) %>%
|
||||
ungroup() %>%
|
||||
arrange(desc(n))
|
||||
|
||||
organism_count_df_tested <<- susceptible_regimen_tested %>%
|
||||
group_by(mo,keyantimicrobials) %>%
|
||||
arrange(desc(n))
|
||||
|
||||
organism_count_df_tested <<- susceptible_regimen_tested %>%
|
||||
group_by(mo, keyantimicrobials) %>%
|
||||
summarise(tested_n = sum(n), .groups = "keep") %>%
|
||||
ungroup()
|
||||
organism_count_df_ntested <<- susceptible_regimen_ntested %>%
|
||||
group_by(mo,keyantimicrobials) %>%
|
||||
organism_count_df_ntested <<- susceptible_regimen_ntested %>%
|
||||
group_by(mo, keyantimicrobials) %>%
|
||||
summarise(ntested_n = sum(n), .groups = "keep") %>%
|
||||
ungroup()
|
||||
|
||||
organism_count_df_combine_tested <- full_join(x = organism_count_df_tested, y = organism_count_df_ntested, by = c("mo","keyantimicrobials")) #combine tested and nontested
|
||||
|
||||
organism_count_df_combine_tested <- full_join(x = organism_count_df_tested, y = organism_count_df_ntested, by = c("mo", "keyantimicrobials")) # combine tested and nontested
|
||||
organism_count_df_combine_tested <- organism_count_df_combine_tested %>%
|
||||
mutate(tested_n = ifelse(is.na(tested_n), 0 ,tested_n),
|
||||
ntested_n = ifelse(is.na(ntested_n), 0, ntested_n))
|
||||
|
||||
organism_count_df_regimen_tested <- left_join(x = organism_count_df, y = organism_count_df_combine_tested[,c("mo","keyantimicrobials","tested_n")], by = "mo")
|
||||
|
||||
#minimum number of tested isolates per ABO should be 30 for accurate coverage estimates
|
||||
mutate(
|
||||
tested_n = ifelse(is.na(tested_n), 0, tested_n),
|
||||
ntested_n = ifelse(is.na(ntested_n), 0, ntested_n)
|
||||
)
|
||||
|
||||
organism_count_df_regimen_tested <- left_join(x = organism_count_df, y = organism_count_df_combine_tested[, c("mo", "keyantimicrobials", "tested_n")], by = "mo")
|
||||
|
||||
# minimum number of tested isolates per ABO should be 30 for accurate coverage estimates
|
||||
condition_tested <- organism_count_df_regimen_tested %>%
|
||||
filter(tested_n <30)
|
||||
if (nrow(condition_tested) > 0){
|
||||
filter(tested_n < 30)
|
||||
if (nrow(condition_tested) > 0) {
|
||||
warning("Number of tested isolates per regimen should exceed 30. Coverage estimates will be inaccurate for these regimens.")
|
||||
View(condition_tested[,c("mo","n","keyantimicrobials","tested_n")])
|
||||
View(condition_tested[, c("mo", "n", "keyantimicrobials", "tested_n")])
|
||||
} else {
|
||||
print("Number of tested isolates per regimen exceed minimum threshold of 30.")
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
organism_tested_sensitive <- susceptible_regimen_tested %>%
|
||||
filter(antibiogram == "S")
|
||||
|
||||
if (nrow(susceptible_regimen_tested)> 0){
|
||||
sensitivity <- left_join(x = organism_count_df_regimen_tested, y = organism_tested_sensitive, by = c("mo","keyantimicrobials"))
|
||||
|
||||
if (nrow(susceptible_regimen_tested) > 0) {
|
||||
sensitivity <- left_join(x = organism_count_df_regimen_tested, y = organism_tested_sensitive, by = c("mo", "keyantimicrobials"))
|
||||
sensitivity <- sensitivity %>%
|
||||
rename("S_n" = "n.y") %>%
|
||||
mutate(S_n = ifelse(is.na(S_n),0,S_n)) %>%
|
||||
mutate(S_n = ifelse(is.na(S_n), 0, S_n)) %>%
|
||||
select(-antibiogram)
|
||||
sensitivity <- sensitivity %>% #calculate proportion sensitive out of those tested and having results
|
||||
mutate(prop.S = ifelse(tested_n != 0, S_n/tested_n, 0))
|
||||
sensitivity <- sensitivity %>% # calculate proportion sensitive out of those tested and having results
|
||||
mutate(prop.S = ifelse(tested_n != 0, S_n / tested_n, 0))
|
||||
sensitivity$perc.S <- sensitivity$prop.S * 100
|
||||
|
||||
params_set_out <- rbind.data.frame(params_set_out, sensitivity, row.names = NULL)
|
||||
|
||||
|
||||
params_set_out <- rbind.data.frame(params_set_out, sensitivity, row.names = NULL)
|
||||
} else {
|
||||
next
|
||||
}
|
||||
params_set_out$fullname <- droplevels(params_set_out$fullname)
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
# if (infection_in != ""){
|
||||
# params_set_out <- params_set_out %>%
|
||||
# mutate(infection_type = infection_in) %>%
|
||||
# mutate(infection_type_full = infection_full) %>%
|
||||
# rowwise() %>%
|
||||
# mutate(regimens = ifelse(str_detect(keyantimicrobials, fixed("+")),
|
||||
# str_c(sapply(unlist(unique(str_split(keyantimicrobials, fixed("+")))),ab_name,USE.NAMES = FALSE), collapse = " + "),
|
||||
# str_c(sapply(unlist(unique(str_split(keyantimicrobials, fixed("+")))),ab_name,USE.NAMES = FALSE), collapse = " + "),
|
||||
# ab_name(keyantimicrobials))) %>%
|
||||
# select(mo:prop.n, regimens,keyantimicrobials,tested_n:infection_type, infection_type_full)
|
||||
#
|
||||
#
|
||||
#
|
||||
#
|
||||
# } else {
|
||||
# print("here??")
|
||||
# params_set_out <- params_set_out %>%
|
||||
# mutate(infection_type_full = infection_full) %>%
|
||||
# rowwise() %>%
|
||||
# mutate(regimens = ifelse(str_detect(keyantimicrobials, fixed("+")),
|
||||
# str_c(sapply(unlist(unique(str_split(keyantimicrobials, fixed("+")))),ab_name,USE.NAMES = FALSE), collapse = " + "),
|
||||
# str_c(sapply(unlist(unique(str_split(keyantimicrobials, fixed("+")))),ab_name,USE.NAMES = FALSE), collapse = " + "),
|
||||
# ab_name(keyantimicrobials))) %>%
|
||||
# select(mo:prop.n, regimens,keyantimicrobials,tested_n:infection_type, infection_type_full)
|
||||
# }
|
||||
|
||||
|
||||
|
||||
|
||||
return(params_set_out)
|
||||
|
||||
|
||||
}
|
||||
+128
-122
@@ -1,122 +1,128 @@
|
||||
|
||||
# Copyright (c) [2022] [Larisse Bolton (author), Aislinn Cook (contributor)]
|
||||
# Adapted from: Bielicki JA, Sharland M, Heath PT, et al. Evaluation of the coverage of 3 antibiotic regimens for
|
||||
# neonatal sepsis in the hospital setting across Asian countries. JAMA Netw Open.
|
||||
# 2020:3(2):e1921124. doi:10.1001.jamanetworkopen.2019.21124
|
||||
|
||||
|
||||
wisca_funct <- function(wisca_in,analysis){
|
||||
|
||||
#function used to gerenrate coverage estimate parameters from input data
|
||||
priors <- function(wisca_prior_in){
|
||||
#INCIDENCE
|
||||
#prior Dirichlet (Gamma) parameters
|
||||
A <- rep(1, times = length(unique(wisca_prior_in$mo)))
|
||||
Multiplier <- rep(1, times = length(unique(wisca_prior_in$mo)))
|
||||
multinomial_obs <- round((wisca_prior_in$n.x)*Multiplier,0)
|
||||
|
||||
#posterior Dirichlet (Gamma) parameters
|
||||
gamma_A <- A + multinomial_obs
|
||||
B <- rep(1, times = length(gamma_A))
|
||||
|
||||
##SUSCEPTIBILITY
|
||||
#prior Beta parameters
|
||||
beta_A <- rep(1, times = length(unique(wisca_prior_in$mo)))
|
||||
beta_B <- rep(1, times = length(unique(wisca_prior_in$mo)))
|
||||
|
||||
#Binomial distribution parameters
|
||||
r <- wisca_prior_in$S_n #number of pathogens that tested sensitive
|
||||
n_obs <- wisca_prior_in$tested_n #number of pathogens tested
|
||||
# n_tested <- round(n_obs*(wisca_calc_input$prop.sens))
|
||||
diff_nr <- n_obs - r #difference between number of pathogens that were tested and those that tested sensitive
|
||||
|
||||
#posterior beta parameters
|
||||
post_beta_1 <- beta_A + r
|
||||
post_beta_2 <- beta_B + diff_nr
|
||||
|
||||
priors_df <- bind_cols(gamma_A,B,post_beta_1,post_beta_2)
|
||||
names(priors_df) <- c("gamma_A","B","post_beta_1","post_beta_2")
|
||||
return(priors_df)
|
||||
}
|
||||
|
||||
#simulations per bug
|
||||
#function to generate simulations
|
||||
coverage <- function(wisca_sim_in){
|
||||
sim_coverage <- wisca_sim_in %>%
|
||||
mutate(random_incidence = runif(n = nrow(wisca_sim_in), min = 0, max = 1),
|
||||
random_susceptibility = runif(n = nrow(wisca_sim_in), min = 0, max = 1)) %>%
|
||||
mutate(simulation_bug = qgamma(random_incidence, shape = gamma_A, scale = B),
|
||||
simulation_suscep = qbeta(p = random_susceptibility,
|
||||
shape1 = post_beta_1, shape2 = post_beta_2)) %>%
|
||||
mutate(sim_inc_total = sum(simulation_bug),
|
||||
simulated_incidence = simulation_bug/sim_inc_total) %>%
|
||||
mutate(simulated_bugcover = simulated_incidence *simulation_suscep,
|
||||
coverage = sum(simulated_bugcover))
|
||||
sim_coverage_out <- slice_head(sim_coverage, n = 1)$coverage
|
||||
return(sim_coverage_out)
|
||||
}
|
||||
|
||||
##will run this for every regimen
|
||||
set.seed(1243)
|
||||
cover <- data.frame()
|
||||
|
||||
for (gg in 1:length(unique(wisca_in$keyantimicrobials))){
|
||||
simulation_nr <- 1000
|
||||
#generate 1000 coverage estimates and determine mean and CI
|
||||
wisca <- subset(wisca_in, keyantimicrobials == unique(wisca_in$keyantimicrobials)[gg])
|
||||
|
||||
if (analysis %in% names(wisca)){
|
||||
cover_level <- data.frame()
|
||||
for (ii in 1:length(levels(wisca[[analysis]]))){
|
||||
wisca_prep <- subset(wisca, wisca[[analysis]] == levels(wisca[[analysis]])[ii])
|
||||
params_priors <- priors(wisca_prior_in = wisca_prep)
|
||||
|
||||
coverage_simulation_total <- replicate(n = simulation_nr,coverage(wisca_sim_in = params_priors))
|
||||
|
||||
av_coverage <- mean(coverage_simulation_total)
|
||||
ci_coverage_lower <- quantile(coverage_simulation_total, probs = 0.025)
|
||||
ci_coverage_upper <- quantile(coverage_simulation_total, probs = 0.975)
|
||||
|
||||
combine_out <- cbind.data.frame(unique(wisca_in$keyantimicrobials)[gg],
|
||||
levels(wisca[[analysis]])[ii],
|
||||
av_coverage,
|
||||
ci_coverage_lower,
|
||||
ci_coverage_upper,
|
||||
row.names = NULL)
|
||||
names(combine_out) <- c("Regimen",str_to_sentence(analysis),"Coverage","Lower_CI","Upper_CI")
|
||||
cover_level <- rbind.data.frame(cover_level,combine_out, row.names = NULL)
|
||||
}
|
||||
cover <- rbind.data.frame(cover,cover_level, row.names = NULL)
|
||||
|
||||
|
||||
} else {
|
||||
params_priors <- priors(wisca_prior_in = wisca)
|
||||
|
||||
coverage_simulation_total <- replicate(n = simulation_nr,coverage(wisca_sim_in = params_priors))
|
||||
|
||||
av_coverage <- mean(coverage_simulation_total)
|
||||
ci_coverage_lower <- quantile(coverage_simulation_total, probs = 0.025)
|
||||
ci_coverage_upper <- quantile(coverage_simulation_total, probs = 0.975)
|
||||
|
||||
combine_out <- cbind.data.frame(unique(wisca_in$keyantimicrobials)[gg],
|
||||
av_coverage,
|
||||
ci_coverage_lower,
|
||||
ci_coverage_upper,
|
||||
row.names = NULL)
|
||||
names(combine_out) <- c("Regimen","Coverage","Lower_CI","Upper_CI")
|
||||
cover <- rbind.data.frame(cover,combine_out, row.names = NULL)
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
cover <- cover %>%
|
||||
mutate(across(.cols = Coverage:Upper_CI, ~ round(.x*100,1))) %>%
|
||||
rowwise() %>%
|
||||
mutate(Regimen_full = ifelse(str_detect(Regimen, fixed("+")),
|
||||
str_c(sapply(unlist(unique(str_split(Regimen, fixed("+")))),ab_name,USE.NAMES = FALSE), collapse = " + "),
|
||||
ab_name(Regimen))) %>%
|
||||
relocate(Regimen_full,.before = Regimen)
|
||||
|
||||
return(cover)
|
||||
|
||||
}
|
||||
# Copyright (c) [2022] [Larisse Bolton (author), Aislinn Cook (contributor)]
|
||||
# Adapted from: Bielicki JA, Sharland M, Heath PT, et al. Evaluation of the coverage of 3 antibiotic regimens for
|
||||
# neonatal sepsis in the hospital setting across Asian countries. JAMA Netw Open.
|
||||
# 2020:3(2):e1921124. doi:10.1001.jamanetworkopen.2019.21124
|
||||
|
||||
|
||||
wisca_funct <- function(wisca_in, analysis) {
|
||||
# function used to gerenrate coverage estimate parameters from input data
|
||||
priors <- function(wisca_prior_in) {
|
||||
# INCIDENCE
|
||||
# prior Dirichlet (Gamma) parameters
|
||||
A <- rep(1, times = length(unique(wisca_prior_in$mo)))
|
||||
Multiplier <- rep(1, times = length(unique(wisca_prior_in$mo)))
|
||||
multinomial_obs <- round((wisca_prior_in$n.x) * Multiplier, 0)
|
||||
|
||||
# posterior Dirichlet (Gamma) parameters
|
||||
gamma_A <- A + multinomial_obs
|
||||
B <- rep(1, times = length(gamma_A))
|
||||
|
||||
## SUSCEPTIBILITY
|
||||
# prior Beta parameters
|
||||
beta_A <- rep(1, times = length(unique(wisca_prior_in$mo)))
|
||||
beta_B <- rep(1, times = length(unique(wisca_prior_in$mo)))
|
||||
|
||||
# Binomial distribution parameters
|
||||
r <- wisca_prior_in$S_n # number of pathogens that tested sensitive
|
||||
n_obs <- wisca_prior_in$tested_n # number of pathogens tested
|
||||
# n_tested <- round(n_obs*(wisca_calc_input$prop.sens))
|
||||
diff_nr <- n_obs - r # difference between number of pathogens that were tested and those that tested sensitive
|
||||
|
||||
# posterior beta parameters
|
||||
post_beta_1 <- beta_A + r
|
||||
post_beta_2 <- beta_B + diff_nr
|
||||
|
||||
priors_df <- bind_cols(gamma_A, B, post_beta_1, post_beta_2)
|
||||
names(priors_df) <- c("gamma_A", "B", "post_beta_1", "post_beta_2")
|
||||
return(priors_df)
|
||||
}
|
||||
|
||||
# simulations per bug
|
||||
# function to generate simulations
|
||||
coverage <- function(wisca_sim_in) {
|
||||
sim_coverage <- wisca_sim_in %>%
|
||||
mutate(
|
||||
random_incidence = runif(n = nrow(wisca_sim_in), min = 0, max = 1),
|
||||
random_susceptibility = runif(n = nrow(wisca_sim_in), min = 0, max = 1)
|
||||
) %>%
|
||||
mutate(
|
||||
simulation_bug = qgamma(random_incidence, shape = gamma_A, scale = B),
|
||||
simulation_suscep = qbeta(
|
||||
p = random_susceptibility,
|
||||
shape1 = post_beta_1, shape2 = post_beta_2
|
||||
)
|
||||
) %>%
|
||||
mutate(
|
||||
sim_inc_total = sum(simulation_bug),
|
||||
simulated_incidence = simulation_bug / sim_inc_total
|
||||
) %>%
|
||||
mutate(
|
||||
simulated_bugcover = simulated_incidence * simulation_suscep,
|
||||
coverage = sum(simulated_bugcover)
|
||||
)
|
||||
sim_coverage_out <- slice_head(sim_coverage, n = 1)$coverage
|
||||
return(sim_coverage_out)
|
||||
}
|
||||
|
||||
## will run this for every regimen
|
||||
set.seed(1243)
|
||||
cover <- data.frame()
|
||||
|
||||
for (gg in 1:length(unique(wisca_in$keyantimicrobials))) {
|
||||
simulation_nr <- 1000
|
||||
# generate 1000 coverage estimates and determine mean and CI
|
||||
wisca <- subset(wisca_in, keyantimicrobials == unique(wisca_in$keyantimicrobials)[gg])
|
||||
|
||||
if (analysis %in% names(wisca)) {
|
||||
cover_level <- data.frame()
|
||||
for (ii in 1:length(levels(wisca[[analysis]]))) {
|
||||
wisca_prep <- subset(wisca, wisca[[analysis]] == levels(wisca[[analysis]])[ii])
|
||||
params_priors <- priors(wisca_prior_in = wisca_prep)
|
||||
|
||||
coverage_simulation_total <- replicate(n = simulation_nr, coverage(wisca_sim_in = params_priors))
|
||||
|
||||
av_coverage <- mean(coverage_simulation_total)
|
||||
ci_coverage_lower <- quantile(coverage_simulation_total, probs = 0.025)
|
||||
ci_coverage_upper <- quantile(coverage_simulation_total, probs = 0.975)
|
||||
|
||||
combine_out <- cbind.data.frame(unique(wisca_in$keyantimicrobials)[gg],
|
||||
levels(wisca[[analysis]])[ii],
|
||||
av_coverage,
|
||||
ci_coverage_lower,
|
||||
ci_coverage_upper,
|
||||
row.names = NULL
|
||||
)
|
||||
names(combine_out) <- c("Regimen", str_to_sentence(analysis), "Coverage", "Lower_CI", "Upper_CI")
|
||||
cover_level <- rbind.data.frame(cover_level, combine_out, row.names = NULL)
|
||||
}
|
||||
cover <- rbind.data.frame(cover, cover_level, row.names = NULL)
|
||||
} else {
|
||||
params_priors <- priors(wisca_prior_in = wisca)
|
||||
|
||||
coverage_simulation_total <- replicate(n = simulation_nr, coverage(wisca_sim_in = params_priors))
|
||||
|
||||
av_coverage <- mean(coverage_simulation_total)
|
||||
ci_coverage_lower <- quantile(coverage_simulation_total, probs = 0.025)
|
||||
ci_coverage_upper <- quantile(coverage_simulation_total, probs = 0.975)
|
||||
|
||||
combine_out <- cbind.data.frame(unique(wisca_in$keyantimicrobials)[gg],
|
||||
av_coverage,
|
||||
ci_coverage_lower,
|
||||
ci_coverage_upper,
|
||||
row.names = NULL
|
||||
)
|
||||
names(combine_out) <- c("Regimen", "Coverage", "Lower_CI", "Upper_CI")
|
||||
cover <- rbind.data.frame(cover, combine_out, row.names = NULL)
|
||||
}
|
||||
}
|
||||
cover <- cover %>%
|
||||
mutate(across(.cols = Coverage:Upper_CI, ~ round(.x * 100, 1))) %>%
|
||||
rowwise() %>%
|
||||
mutate(Regimen_full = ifelse(str_detect(Regimen, fixed("+")),
|
||||
str_c(sapply(unlist(unique(str_split(Regimen, fixed("+")))), ab_name, USE.NAMES = FALSE), collapse = " + "),
|
||||
ab_name(Regimen)
|
||||
)) %>%
|
||||
relocate(Regimen_full, .before = Regimen)
|
||||
|
||||
return(cover)
|
||||
}
|
||||
@@ -170,13 +170,9 @@ example_isolates %>%
|
||||
#> ℹ Using column mo as input for `mo_fullname()`
|
||||
#> ℹ Using column mo as input for `mo_is_gram_negative()`
|
||||
#> ℹ Using column mo as input for `mo_is_intrinsic_resistant()`
|
||||
#> ℹ Determining intrinsic resistance based on 'EUCAST Expected
|
||||
#> Resistant Phenotypes' v1.2 (2023). This note will be shown
|
||||
#> once per session.
|
||||
#> ℹ For `aminoglycosides()` using columns GEN (gentamicin), TOB
|
||||
#> (tobramycin), AMK (amikacin), and KAN (kanamycin)
|
||||
#> ℹ For `carbapenems()` using columns IPM (imipenem) and MEM
|
||||
#> (meropenem)
|
||||
#> ℹ Determining intrinsic resistance based on 'EUCAST Expected Resistant Phenotypes' v1.2 (2023). This note will be shown once per session.
|
||||
#> ℹ For `aminoglycosides()` using columns GEN (gentamicin), TOB (tobramycin), AMK (amikacin), and KAN (kanamycin)
|
||||
#> ℹ For `carbapenems()` using columns IPM (imipenem) and MEM (meropenem)
|
||||
#> # A tibble: 35 × 7
|
||||
#> bacteria GEN TOB AMK KAN IPM MEM
|
||||
#> <chr> <sir> <sir> <sir> <sir> <sir> <sir>
|
||||
@@ -253,8 +249,7 @@ for tracking resistance per species over time:
|
||||
antibiogram(example_isolates,
|
||||
mo_transform = "gramstain",
|
||||
antimicrobials = c("AMC", carbapenems(), "TZP"))
|
||||
#> ℹ For `carbapenems()` using columns IPM (imipenem) and MEM
|
||||
#> (meropenem)
|
||||
#> ℹ For `carbapenems()` using columns IPM (imipenem) and MEM (meropenem)
|
||||
```
|
||||
|
||||
| Pathogen | Amoxicillin/clavulanic acid | Imipenem | Meropenem | Piperacillin/tazobactam |
|
||||
@@ -369,16 +364,13 @@ out <- example_isolates %>%
|
||||
# calculate AMR using resistance(), over all aminoglycosides and polymyxins:
|
||||
summarise(across(c(aminoglycosides(), polymyxins()),
|
||||
resistance))
|
||||
#> ℹ For `aminoglycosides()` using columns GEN (gentamicin), TOB
|
||||
#> (tobramycin), AMK (amikacin), and KAN (kanamycin)
|
||||
#> ℹ For `aminoglycosides()` using columns GEN (gentamicin), TOB (tobramycin), AMK (amikacin), and KAN (kanamycin)
|
||||
#> ℹ For `polymyxins()` using column COL (colistin)
|
||||
#> Warning: There was 1 warning in `summarise()`.
|
||||
#> ℹ In argument: `across(c(aminoglycosides(), polymyxins()),
|
||||
#> resistance)`.
|
||||
#> ℹ In argument: `across(c(aminoglycosides(), polymyxins()), resistance)`.
|
||||
#> ℹ In group 3: `ward = "Outpatient"`.
|
||||
#> Caused by warning:
|
||||
#> ! Introducing NA: only 23 results available for KAN in group:
|
||||
#> ward = "Outpatient" (whilst `minimum = 30`).
|
||||
#> ! Introducing NA: only 23 results available for KAN in group: ward = "Outpatient" (whilst `minimum = 30`).
|
||||
out
|
||||
#> # A tibble: 3 × 6
|
||||
#> ward GEN TOB AMK KAN COL
|
||||
|
||||
+2
-1
@@ -334,7 +334,8 @@ if (requireNamespace("dplyr")) {
|
||||
top_n_microorganisms(n = 10) \%>\%
|
||||
group_by(
|
||||
age_group = age_groups(age, c(25, 50, 75)),
|
||||
gender) \%>\%
|
||||
gender
|
||||
) \%>\%
|
||||
wisca(antimicrobials = c("TZP", "TZP+TOB", "TZP+GEN"))
|
||||
}
|
||||
|
||||
|
||||
@@ -308,7 +308,6 @@ carbapenems()
|
||||
# Though they are primarily intended to use for selections and filters.
|
||||
# Examples sections below are split into 'dplyr', 'base R', and 'data.table':
|
||||
|
||||
\donttest{
|
||||
\dontrun{
|
||||
# dplyr -------------------------------------------------------------------
|
||||
|
||||
@@ -329,8 +328,10 @@ example_isolates \%>\% select(administrable_per_os())
|
||||
# get AMR for all aminoglycosides e.g., per ward:
|
||||
example_isolates \%>\%
|
||||
group_by(ward) \%>\%
|
||||
summarise(across(aminoglycosides(),
|
||||
resistance))
|
||||
summarise(across(
|
||||
aminoglycosides(),
|
||||
resistance
|
||||
))
|
||||
|
||||
# You can combine selectors with '&' to be more specific:
|
||||
example_isolates \%>\%
|
||||
@@ -340,8 +341,10 @@ example_isolates \%>\%
|
||||
example_isolates \%>\%
|
||||
filter(mo_genus() \%in\% c("Escherichia", "Klebsiella")) \%>\%
|
||||
group_by(ward) \%>\%
|
||||
summarise_at(not_intrinsic_resistant(),
|
||||
resistance)
|
||||
summarise_at(
|
||||
not_intrinsic_resistant(),
|
||||
resistance
|
||||
)
|
||||
|
||||
# get susceptibility for antimicrobials whose name contains "trim":
|
||||
example_isolates \%>\%
|
||||
@@ -394,8 +397,9 @@ x <- example_isolates[carbapenems() == "R", ]
|
||||
y <- example_isolates \%>\% filter(carbapenems() == "R")
|
||||
z <- example_isolates \%>\% filter(if_all(carbapenems(), ~ .x == "R"))
|
||||
identical(x, y) && identical(y, z)
|
||||
|
||||
}
|
||||
|
||||
\donttest{
|
||||
# base R ------------------------------------------------------------------
|
||||
|
||||
# select columns 'IPM' (imipenem) and 'MEM' (meropenem)
|
||||
|
||||
Reference in new issue
Block a user