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

first isolate missing dates fix

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2019-05-13 14:56:23 +02:00
parent c4aa92b4a7
commit cc403169c6
15 changed files with 200 additions and 146 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
R/data.R
View File

@ -55,7 +55,7 @@
#'
#' A data set containing the microbial taxonomy of six kingdoms from the Catalogue of Life. MO codes can be looked up using \code{\link{as.mo}}.
#' @inheritSection catalogue_of_life Catalogue of Life
#' @format A \code{\link{data.frame}} with 65,629 observations and 16 variables:
#' @format A \code{\link{data.frame}} with 67,903 observations and 16 variables:
#' \describe{
#' \item{\code{mo}}{ID of microorganism as used by this package}
#' \item{\code{col_id}}{Catalogue of Life ID}

139
R/first_isolate.R
View File

@ -22,7 +22,7 @@
#' Determine first (weighted) isolates
#'
#' Determine first (weighted) isolates of all microorganisms of every patient per episode and (if needed) per specimen type.
#' @param tbl a \code{data.frame} containing isolates.
#' @param x a \code{data.frame} containing isolates.
#' @param col_date column name of the result date (or date that is was received on the lab), defaults to the first column of with a date class
#' @param col_patient_id column name of the unique IDs of the patients, defaults to the first column that starts with 'patient' or 'patid' (case insensitive)
#' @param col_mo column name of the unique IDs of the microorganisms (see \code{\link{mo}}), defaults to the first column of class \code{mo}. Values will be coerced using \code{\link{as.mo}}.
@ -44,16 +44,16 @@
#'
#' The functions \code{filter_first_isolate} and \code{filter_first_weighted_isolate} are helper functions to quickly filter on first isolates. The function \code{filter_first_isolate} is essentially equal to:
#' \preformatted{
#' tbl \%>\%
#' mutate(only_firsts = first_isolate(tbl, ...)) \%>\%
#' x \%>\%
#' mutate(only_firsts = first_isolate(x, ...)) \%>\%
#' filter(only_firsts == TRUE) \%>\%
#' select(-only_firsts)
#' }
#' The function \code{filter_first_weighted_isolate} is essentially equal to:
#' \preformatted{
#' tbl \%>\%
#' x \%>\%
#' mutate(keyab = key_antibiotics(.)) \%>\%
#' mutate(only_weighted_firsts = first_isolate(tbl,
#' mutate(only_weighted_firsts = first_isolate(x,
#' col_keyantibiotics = "keyab", ...)) \%>\%
#' filter(only_weighted_firsts == TRUE) \%>\%
#' select(-only_weighted_firsts)
@ -118,43 +118,43 @@
#' \dontrun{
#'
#' # set key antibiotics to a new variable
#' tbl$keyab <- key_antibiotics(tbl)
#' x$keyab <- key_antibiotics(x)
#'
#' tbl$first_isolate <-
#' first_isolate(tbl)
#' x$first_isolate <-
#' first_isolate(x)
#'
#' tbl$first_isolate_weighed <-
#' first_isolate(tbl,
#' x$first_isolate_weighed <-
#' first_isolate(x,
#' col_keyantibiotics = 'keyab')
#'
#' tbl$first_blood_isolate <-
#' first_isolate(tbl,
#' x$first_blood_isolate <-
#' first_isolate(x,
#' specimen_group = 'Blood')
#'
#' tbl$first_blood_isolate_weighed <-
#' first_isolate(tbl,
#' x$first_blood_isolate_weighed <-
#' first_isolate(x,
#' specimen_group = 'Blood',
#' col_keyantibiotics = 'keyab')
#'
#' tbl$first_urine_isolate <-
#' first_isolate(tbl,
#' x$first_urine_isolate <-
#' first_isolate(x,
#' specimen_group = 'Urine')
#'
#' tbl$first_urine_isolate_weighed <-
#' first_isolate(tbl,
#' x$first_urine_isolate_weighed <-
#' first_isolate(x,
#' specimen_group = 'Urine',
#' col_keyantibiotics = 'keyab')
#'
#' tbl$first_resp_isolate <-
#' first_isolate(tbl,
#' x$first_resp_isolate <-
#' first_isolate(x,
#' specimen_group = 'Respiratory')
#'
#' tbl$first_resp_isolate_weighed <-
#' first_isolate(tbl,
#' x$first_resp_isolate_weighed <-
#' first_isolate(x,
#' specimen_group = 'Respiratory',
#' col_keyantibiotics = 'keyab')
#' }
first_isolate <- function(tbl,
first_isolate <- function(x,
col_date = NULL,
col_patient_id = NULL,
col_mo = NULL,
@ -172,8 +172,8 @@ first_isolate <- function(tbl,
info = TRUE,
...) {
if (!is.data.frame(tbl)) {
stop("`tbl` must be a data.frame.", call. = FALSE)
if (!is.data.frame(x)) {
stop("`x` must be a data.frame.", call. = FALSE)
}
dots <- unlist(list(...))
@ -183,12 +183,15 @@ first_isolate <- function(tbl,
if ('filter_specimen' %in% dots.names) {
specimen_group <- dots[which(dots.names == 'filter_specimen')]
}
if ('tbl' %in% dots.names) {
x <- dots[which(dots.names == 'tbl')]
}
}
# try to find columns based on type
# -- mo
if (is.null(col_mo)) {
col_mo <- search_type_in_df(tbl = tbl, type = "mo")
col_mo <- search_type_in_df(tbl = x, type = "mo")
}
if (is.null(col_mo)) {
stop("`col_mo` must be set.", call. = FALSE)
@ -196,23 +199,25 @@ first_isolate <- function(tbl,
# -- date
if (is.null(col_date)) {
col_date <- search_type_in_df(tbl = tbl, type = "date")
col_date <- search_type_in_df(tbl = x, type = "date")
}
if (is.null(col_date)) {
stop("`col_date` must be set.", call. = FALSE)
}
# convert to Date (pipes/pull for supporting tibbles too)
tbl[, col_date] <- tbl %>% pull(col_date) %>% as.Date()
dates <- x %>% pull(col_date) %>% as.Date()
dates[is.na(dates)] <- as.Date("1970-01-01")
x[, col_date] <- dates
# -- patient id
if (is.null(col_patient_id)) {
if (all(c("First name", "Last name", "Sex", "Identification number") %in% colnames(tbl))) {
if (all(c("First name", "Last name", "Sex", "Identification number") %in% colnames(x))) {
# WHONET support
tbl <- tbl %>% mutate(patient_id = paste(`First name`, `Last name`, Sex))
x <- x %>% mutate(patient_id = paste(`First name`, `Last name`, Sex))
col_patient_id <- "patient_id"
message(blue(paste0("NOTE: Using combined columns ", bold("`First name`, `Last name` and `Sex`"), " as input for `col_patient_id`.")))
} else {
col_patient_id <- search_type_in_df(tbl = tbl, type = "patient_id")
col_patient_id <- search_type_in_df(tbl = x, type = "patient_id")
}
}
if (is.null(col_patient_id)) {
@ -221,7 +226,7 @@ first_isolate <- function(tbl,
# -- key antibiotics
if (is.null(col_keyantibiotics)) {
col_keyantibiotics <- search_type_in_df(tbl = tbl, type = "keyantibiotics")
col_keyantibiotics <- search_type_in_df(tbl = x, type = "keyantibiotics")
}
if (isFALSE(col_keyantibiotics)) {
col_keyantibiotics <- NULL
@ -229,14 +234,14 @@ first_isolate <- function(tbl,
# -- specimen
if (is.null(col_specimen)) {
col_specimen <- search_type_in_df(tbl = tbl, type = "specimen")
col_specimen <- search_type_in_df(tbl = x, type = "specimen")
}
if (isFALSE(col_specimen)) {
col_specimen <- NULL
}
# check if columns exist
check_columns_existance <- function(column, tblname = tbl) {
check_columns_existance <- function(column, tblname = x) {
if (NROW(tblname) <= 1 | NCOL(tblname) <= 1) {
stop('Please check tbl for existance.')
}
@ -256,7 +261,7 @@ first_isolate <- function(tbl,
check_columns_existance(col_keyantibiotics)
# join to microorganisms data set
tbl <- tbl %>%
x <- x %>%
mutate_at(vars(col_mo), as.mo) %>%
left_join_microorganisms(by = col_mo)
col_genus <- "genus"
@ -273,8 +278,8 @@ first_isolate <- function(tbl,
if (is.null(col_icu)) {
icu_exclude <- FALSE
} else {
tbl <- tbl %>%
mutate(col_icu = tbl %>% pull(col_icu) %>% as.logical())
x <- x %>%
mutate(col_icu = x %>% pull(col_icu) %>% as.logical())
}
if (is.null(col_specimen)) {
@ -283,13 +288,13 @@ first_isolate <- function(tbl,
# filter on specimen group and keyantibiotics when they are filled in
if (!is.null(specimen_group)) {
check_columns_existance(col_specimen, tbl)
check_columns_existance(col_specimen, x)
if (info == TRUE) {
cat('[Criterion] Excluded other than specimen group \'', specimen_group, '\'\n', sep = '')
}
}
if (!is.null(col_keyantibiotics)) {
tbl <- tbl %>% mutate(key_ab = tbl %>% pull(col_keyantibiotics))
x <- x %>% mutate(key_ab = x %>% pull(col_keyantibiotics))
}
if (is.null(testcodes_exclude)) {
@ -297,12 +302,12 @@ first_isolate <- function(tbl,
}
# create new dataframe with original row index and right sorting
tbl <- tbl %>%
mutate(first_isolate_row_index = 1:nrow(tbl),
date_lab = tbl %>% pull(col_date),
patient_id = tbl %>% pull(col_patient_id),
species = tbl %>% pull(col_species),
genus = tbl %>% pull(col_genus)) %>%
x <- x %>%
mutate(first_isolate_row_index = 1:nrow(x),
date_lab = x %>% pull(col_date),
patient_id = x %>% pull(col_patient_id),
species = x %>% pull(col_species),
genus = x %>% pull(col_genus)) %>%
mutate(species = if_else(is.na(species) | species == "(no MO)", "", species),
genus = if_else(is.na(genus) | genus == "(no MO)", "", genus))
@ -312,18 +317,18 @@ first_isolate <- function(tbl,
if (info == TRUE & !is.null(col_icu)) {
cat('[Criterion] Included isolates from ICU.\n')
}
tbl <- tbl %>%
x <- x %>%
arrange_at(c(col_patient_id,
col_genus,
col_species,
col_date))
row.start <- 1
row.end <- nrow(tbl)
row.end <- nrow(x)
} else {
if (info == TRUE) {
cat('[Criterion] Excluded isolates from ICU.\n')
}
tbl <- tbl %>%
x <- x %>%
arrange_at(c(col_icu,
col_patient_id,
col_genus,
@ -331,10 +336,10 @@ first_isolate <- function(tbl,
col_date))
suppressWarnings(
row.start <- which(tbl %>% pull(col_icu) == FALSE) %>% min(na.rm = TRUE)
row.start <- which(x %>% pull(col_icu) == FALSE) %>% min(na.rm = TRUE)
)
suppressWarnings(
row.end <- which(tbl %>% pull(col_icu) == FALSE) %>% max(na.rm = TRUE)
row.end <- which(x %>% pull(col_icu) == FALSE) %>% max(na.rm = TRUE)
)
}
@ -344,23 +349,23 @@ first_isolate <- function(tbl,
if (info == TRUE & !is.null(col_icu)) {
cat('[Criterion] Included isolates from ICU.\n')
}
tbl <- tbl %>%
x <- x %>%
arrange_at(c(col_specimen,
col_patient_id,
col_genus,
col_species,
col_date))
suppressWarnings(
row.start <- which(tbl %>% pull(col_specimen) == specimen_group) %>% min(na.rm = TRUE)
row.start <- which(x %>% pull(col_specimen) == specimen_group) %>% min(na.rm = TRUE)
)
suppressWarnings(
row.end <- which(tbl %>% pull(col_specimen) == specimen_group) %>% max(na.rm = TRUE)
row.end <- which(x %>% pull(col_specimen) == specimen_group) %>% max(na.rm = TRUE)
)
} else {
if (info == TRUE) {
cat('[Criterion] Excluded isolates from ICU.\n')
}
tbl <- tbl %>%
x <- x %>%
arrange_at(c(col_icu,
col_specimen,
col_patient_id,
@ -368,12 +373,12 @@ first_isolate <- function(tbl,
col_species,
col_date))
suppressWarnings(
row.start <- which(tbl %>% pull(col_specimen) == specimen_group
& tbl %>% pull(col_icu) == FALSE) %>% min(na.rm = TRUE)
row.start <- which(x %>% pull(col_specimen) == specimen_group
& x %>% pull(col_icu) == FALSE) %>% min(na.rm = TRUE)
)
suppressWarnings(
row.end <- which(tbl %>% pull(col_specimen) == specimen_group
& tbl %>% pull(col_icu) == FALSE) %>% max(na.rm = TRUE)
row.end <- which(x %>% pull(col_specimen) == specimen_group
& x %>% pull(col_icu) == FALSE) %>% max(na.rm = TRUE)
)
}
@ -384,7 +389,7 @@ first_isolate <- function(tbl,
message(paste("=> Found", bold("no isolates")))
}
# NAs where genus is unavailable
return(tbl %>%
return(x %>%
mutate(real_first_isolate = if_else(genus == '', NA, FALSE)) %>%
pull(real_first_isolate)
)
@ -392,7 +397,7 @@ first_isolate <- function(tbl,
# suppress warnings because dplyr wants us to use library(dplyr) when using filter(row_number())
suppressWarnings(
scope.size <- tbl %>%
scope.size <- x %>%
filter(
row_number() %>% between(row.start,
row.end),
@ -424,7 +429,7 @@ first_isolate <- function(tbl,
}
# Analysis of first isolate ----
all_first <- tbl %>%
all_first <- x %>%
mutate(other_pat_or_mo = if_else(patient_id == lag(patient_id)
& genus == lag(genus)
& species == lag(species),
@ -513,7 +518,7 @@ first_isolate <- function(tbl,
decimal.mark <- getOption("OutDec")
big.mark <- ifelse(decimal.mark != ",", ",", ".")
n_found <- base::sum(all_first, na.rm = TRUE)
p_found_total <- percent(n_found / nrow(tbl), force_zero = TRUE)
p_found_total <- percent(n_found / nrow(x), force_zero = TRUE)
p_found_scope <- percent(n_found / scope.size, force_zero = TRUE)
# mark up number of found
n_found <- base::format(n_found, big.mark = big.mark, decimal.mark = decimal.mark)
@ -536,12 +541,12 @@ first_isolate <- function(tbl,
#' @rdname first_isolate
#' @importFrom dplyr filter
#' @export
filter_first_isolate <- function(tbl,
filter_first_isolate <- function(x,
col_date = NULL,
col_patient_id = NULL,
col_mo = NULL,
...) {
filter(tbl, first_isolate(tbl = tbl,
filter(x, first_isolate(x = x,
col_date = col_date,
col_patient_id = col_patient_id,
col_mo = col_mo,
@ -551,13 +556,13 @@ filter_first_isolate <- function(tbl,
#' @rdname first_isolate
#' @importFrom dplyr %>% mutate filter
#' @export
filter_first_weighted_isolate <- function(tbl,
filter_first_weighted_isolate <- function(x,
col_date = NULL,
col_patient_id = NULL,
col_mo = NULL,
col_keyantibiotics = NULL,
...) {
tbl_keyab <- tbl %>%
tbl_keyab <- x %>%
mutate(keyab = suppressMessages(key_antibiotics(.,
col_mo = col_mo,
...))) %>%
@ -567,5 +572,5 @@ filter_first_weighted_isolate <- function(tbl,
col_mo = col_mo,
col_keyantibiotics = "keyab",
...))
tbl[which(tbl_keyab$firsts == TRUE),]
x[which(tbl_keyab$firsts == TRUE),]
}