2018-02-21 11:52:31 +01:00
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Analysis #
# #
2019-01-02 23:24:07 +01:00
# SOURCE #
# https://gitlab.com/msberends/AMR #
2018-02-21 11:52:31 +01:00
# #
# LICENCE #
2019-01-02 23:24:07 +01:00
# (c) 2019 Berends MS (m.s.berends@umcg.nl), Luz CF (c.f.luz@umcg.nl) #
2018-02-21 11:52:31 +01:00
# #
2019-01-02 23:24:07 +01:00
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
# the Free Software Foundation. #
# #
# This R package was created for academic research and was publicly #
# released in the hope that it will be useful, but it comes WITHOUT #
# ANY WARRANTY OR LIABILITY. #
2019-04-05 18:47:39 +02:00
# Visit our website for more info: https://msberends.gitlab.io/AMR. #
2018-02-21 11:52:31 +01:00
# ==================================================================== #
#' Determine first (weighted) isolates
#'
2018-04-02 11:11:21 +02:00
#' Determine first (weighted) isolates of all microorganisms of every patient per episode and (if needed) per specimen type.
2019-05-13 14:56:23 +02:00
#' @param x a \code{data.frame} containing isolates.
2019-01-15 12:45:24 +01:00
#' @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
2018-12-10 15:14:29 +01:00
#' @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)
2019-08-27 22:41:09 +02:00
#' @param col_mo column name of the IDs of the microorganisms (see \code{\link{as.mo}}), defaults to the first column of class \code{mo}. Values will be coerced using \code{\link{as.mo}}.
2018-12-14 07:23:25 +01:00
#' @param col_testcode column name of the test codes. Use \code{col_testcode = NULL} to \strong{not} exclude certain test codes (like test codes for screening). In that case \code{testcodes_exclude} will be ignored.
2018-04-02 11:11:21 +02:00
#' @param col_specimen column name of the specimen type or group
#' @param col_icu column name of the logicals (\code{TRUE}/\code{FALSE}) whether a ward or department is an Intensive Care Unit (ICU)
2018-12-14 07:23:25 +01:00
#' @param col_keyantibiotics column name of the key antibiotics to determine first \emph{weighted} isolates, see \code{\link{key_antibiotics}}. Defaults to the first column that starts with 'key' followed by 'ab' or 'antibiotics' (case insensitive). Use \code{col_keyantibiotics = FALSE} to prevent this.
2019-08-08 22:39:42 +02:00
#' @param episode_days episode in days after which a genus/species combination will be determined as 'first isolate' again. The default of 365 days is based on the guideline by CLSI, see Source.
2018-03-19 20:39:23 +01:00
#' @param testcodes_exclude character vector with test codes that should be excluded (case-insensitive)
2018-12-22 22:39:34 +01:00
#' @param icu_exclude logical whether ICU isolates should be excluded (rows with value \code{TRUE} in column \code{col_icu})
#' @param specimen_group value in column \code{col_specimen} to filter on
2018-03-19 20:39:23 +01:00
#' @param type type to determine weighed isolates; can be \code{"keyantibiotics"} or \code{"points"}, see Details
#' @param ignore_I logical to determine whether antibiotic interpretations with \code{"I"} will be ignored when \code{type = "keyantibiotics"}, see Details
#' @param points_threshold points until the comparison of key antibiotics will lead to inclusion of an isolate when \code{type = "points"}, see Details
2018-02-21 11:52:31 +01:00
#' @param info print progress
2019-08-08 22:39:42 +02:00
#' @param include_unknown logical to determine whether 'unknown' microorganisms should be included too, i.e. microbial code \code{"UNKNOWN"}, which defaults to \code{FALSE}. For WHONET users, this means that all records with organism code \code{"con"} (\emph{contamination}) will be excluded at default. Isolates with a microbial ID of \code{NA} will always be excluded as first isolate.
2018-12-22 22:39:34 +01:00
#' @param ... parameters passed on to the \code{first_isolate} function
2018-03-19 20:39:23 +01:00
#' @details \strong{WHY THIS IS SO IMPORTANT} \cr
2018-12-22 22:39:34 +01:00
#' To conduct an analysis of antimicrobial resistance, you should only include the first isolate of every patient per episode \href{https://www.ncbi.nlm.nih.gov/pubmed/17304462}{[1]}. If you would not do this, you could easily get an overestimate or underestimate of the resistance of an antibiotic. Imagine that a patient was admitted with an MRSA and that it was found in 5 different blood cultures the following week. The resistance percentage of oxacillin of all \emph{S. aureus} isolates would be overestimated, because you included this MRSA more than once. It would be \href{https://en.wikipedia.org/wiki/Selection_bias}{selection bias}.
#'
2019-08-08 22:39:42 +02:00
#' All isolates with a microbial ID of \code{NA} will be excluded as first isolate.
#'
2019-04-09 14:59:17 +02:00
#' 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:
2018-12-22 22:39:34 +01:00
#' \preformatted{
2019-05-13 14:56:23 +02:00
#' x \%>\%
#' mutate(only_firsts = first_isolate(x, ...)) \%>\%
2018-12-22 22:39:34 +01:00
#' filter(only_firsts == TRUE) \%>\%
#' select(-only_firsts)
#' }
#' The function \code{filter_first_weighted_isolate} is essentially equal to:
#' \preformatted{
2019-05-13 14:56:23 +02:00
#' x \%>\%
2018-12-22 22:39:34 +01:00
#' mutate(keyab = key_antibiotics(.)) \%>\%
2019-05-13 14:56:23 +02:00
#' mutate(only_weighted_firsts = first_isolate(x,
2018-12-22 22:39:34 +01:00
#' col_keyantibiotics = "keyab", ...)) \%>\%
#' filter(only_weighted_firsts == TRUE) \%>\%
#' select(-only_weighted_firsts)
#' }
2018-07-17 13:02:05 +02:00
#' @section Key antibiotics:
2018-07-25 14:17:04 +02:00
#' There are two ways to determine whether isolates can be included as first \emph{weighted} isolates which will give generally the same results: \cr
2018-03-13 11:57:30 +01:00
#'
2018-03-19 21:23:21 +01:00
#' \strong{1. Using} \code{type = "keyantibiotics"} \strong{and parameter} \code{ignore_I} \cr
2019-04-09 14:59:17 +02:00
#' Any difference from S to R (or vice versa) will (re)select an isolate as a first weighted isolate. With \code{ignore_I = FALSE}, also differences from I to S|R (or vice versa) will lead to this. This is a reliable method and 30-35 times faster than method 2. Read more about this in the \code{\link{key_antibiotics}} function. \cr
2018-07-17 13:02:05 +02:00
#'
2018-03-19 21:23:21 +01:00
#' \strong{2. Using} \code{type = "points"} \strong{and parameter} \code{points_threshold} \cr
2019-04-09 14:59:17 +02:00
#' A difference from I to S|R (or vice versa) means 0.5 points, a difference from S to R (or vice versa) means 1 point. When the sum of points exceeds \code{points_threshold}, which default to \code{2}, an isolate will be (re)selected as a first weighted isolate.
2018-12-22 22:39:34 +01:00
#' @rdname first_isolate
2018-02-21 11:52:31 +01:00
#' @keywords isolate isolates first
2018-07-17 14:48:11 +02:00
#' @seealso \code{\link{key_antibiotics}}
2018-02-26 12:15:52 +01:00
#' @export
2019-07-29 17:34:57 +02:00
#' @importFrom dplyr arrange_at lag between row_number filter mutate arrange pull ungroup
2018-12-22 22:39:34 +01:00
#' @importFrom crayon blue bold silver
#' @return Logical vector
2018-07-29 22:14:51 +02:00
#' @source Methodology of this function is based on: \strong{M39 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 4th Edition}, 2014, \emph{Clinical and Laboratory Standards Institute (CLSI)}. \url{https://clsi.org/standards/products/microbiology/documents/m39/}.
2019-01-02 23:24:07 +01:00
#' @inheritSection AMR Read more on our website!
2018-02-21 11:52:31 +01:00
#' @examples
2019-08-27 16:45:42 +02:00
#' # `example_isolates` is a dataset available in the AMR package.
#' # See ?example_isolates.
2018-04-02 11:11:21 +02:00
#'
2018-03-19 20:39:23 +01:00
#' library(dplyr)
2018-12-22 22:39:34 +01:00
#' # Filter on first isolates:
2019-08-27 16:45:42 +02:00
#' example_isolates %>%
2018-08-10 15:01:05 +02:00
#' mutate(first_isolate = first_isolate(.,
#' col_date = "date",
#' col_patient_id = "patient_id",
2018-12-22 22:39:34 +01:00
#' col_mo = "mo")) %>%
#' filter(first_isolate == TRUE)
#'
#' # Which can be shortened to:
2019-08-27 16:45:42 +02:00
#' example_isolates %>%
2018-12-22 22:39:34 +01:00
#' filter_first_isolate()
#' # or for first weighted isolates:
2019-08-27 16:45:42 +02:00
#' example_isolates %>%
2018-12-22 22:39:34 +01:00
#' filter_first_weighted_isolate()
2019-08-14 14:57:06 +02:00
#'
2018-07-25 14:17:04 +02:00
#' # Now let's see if first isolates matter:
2019-08-27 16:45:42 +02:00
#' A <- example_isolates %>%
2018-07-25 14:17:04 +02:00
#' group_by(hospital_id) %>%
2019-05-10 16:44:59 +02:00
#' summarise(count = n_rsi(GEN), # gentamicin availability
#' resistance = portion_IR(GEN)) # gentamicin resistance
2018-07-25 14:17:04 +02:00
#'
2019-08-27 16:45:42 +02:00
#' B <- example_isolates %>%
2019-05-10 16:44:59 +02:00
#' filter_first_weighted_isolate() %>% # the 1st isolate filter
2018-07-25 14:17:04 +02:00
#' group_by(hospital_id) %>%
2019-05-10 16:44:59 +02:00
#' summarise(count = n_rsi(GEN), # gentamicin availability
#' resistance = portion_IR(GEN)) # gentamicin resistance
2018-07-25 14:17:04 +02:00
#'
2018-08-10 15:01:05 +02:00
#' # Have a look at A and B.
#' # B is more reliable because every isolate is only counted once.
2019-04-09 14:59:17 +02:00
#' # Gentamicin resitance in hospital D appears to be 3.1% higher than
#' # when you (erroneously) would have used all isolates for analysis.
2018-07-25 14:17:04 +02:00
#'
2018-12-22 22:39:34 +01:00
#'
2018-07-25 14:17:04 +02:00
#' ## OTHER EXAMPLES:
#'
2018-02-21 11:52:31 +01:00
#' \dontrun{
#'
2018-02-22 20:48:48 +01:00
#' # set key antibiotics to a new variable
2019-05-13 14:56:23 +02:00
#' x$keyab <- key_antibiotics(x)
2018-02-21 11:52:31 +01:00
#'
2019-05-13 14:56:23 +02:00
#' x$first_isolate <-
#' first_isolate(x)
2018-02-21 11:52:31 +01:00
#'
2019-05-13 14:56:23 +02:00
#' x$first_isolate_weighed <-
#' first_isolate(x,
2018-02-21 11:52:31 +01:00
#' col_keyantibiotics = 'keyab')
#'
2019-05-13 14:56:23 +02:00
#' x$first_blood_isolate <-
#' first_isolate(x,
2018-12-22 22:39:34 +01:00
#' specimen_group = 'Blood')
2018-02-21 11:52:31 +01:00
#'
2019-05-13 14:56:23 +02:00
#' x$first_blood_isolate_weighed <-
#' first_isolate(x,
2018-12-22 22:39:34 +01:00
#' specimen_group = 'Blood',
2018-02-21 11:52:31 +01:00
#' col_keyantibiotics = 'keyab')
#'
2019-05-13 14:56:23 +02:00
#' x$first_urine_isolate <-
#' first_isolate(x,
2018-12-22 22:39:34 +01:00
#' specimen_group = 'Urine')
2018-02-21 11:52:31 +01:00
#'
2019-05-13 14:56:23 +02:00
#' x$first_urine_isolate_weighed <-
#' first_isolate(x,
2018-12-22 22:39:34 +01:00
#' specimen_group = 'Urine',
2018-02-21 11:52:31 +01:00
#' col_keyantibiotics = 'keyab')
#'
2019-05-13 14:56:23 +02:00
#' x$first_resp_isolate <-
#' first_isolate(x,
2018-12-22 22:39:34 +01:00
#' specimen_group = 'Respiratory')
2018-02-21 11:52:31 +01:00
#'
2019-05-13 14:56:23 +02:00
#' x$first_resp_isolate_weighed <-
#' first_isolate(x,
2018-12-22 22:39:34 +01:00
#' specimen_group = 'Respiratory',
2018-02-21 11:52:31 +01:00
#' col_keyantibiotics = 'keyab')
#' }
2019-05-13 14:56:23 +02:00
first_isolate <- function ( x ,
2018-10-23 11:15:05 +02:00
col_date = NULL ,
col_patient_id = NULL ,
col_mo = NULL ,
col_testcode = NULL ,
col_specimen = NULL ,
col_icu = NULL ,
col_keyantibiotics = NULL ,
2018-02-21 11:52:31 +01:00
episode_days = 365 ,
2018-10-23 11:15:05 +02:00
testcodes_exclude = NULL ,
2018-02-21 11:52:31 +01:00
icu_exclude = FALSE ,
2018-12-22 22:39:34 +01:00
specimen_group = NULL ,
2018-03-19 20:39:23 +01:00
type = " keyantibiotics" ,
ignore_I = TRUE ,
2018-02-27 20:01:02 +01:00
points_threshold = 2 ,
2018-03-23 14:46:02 +01:00
info = TRUE ,
2019-08-08 22:39:42 +02:00
include_unknown = FALSE ,
2018-12-22 22:39:34 +01:00
... ) {
2018-04-02 11:11:21 +02:00
2019-05-13 14:56:23 +02:00
if ( ! is.data.frame ( x ) ) {
stop ( " `x` must be a data.frame." , call. = FALSE )
2018-12-22 22:39:34 +01:00
}
dots <- unlist ( list ( ... ) )
if ( length ( dots ) != 0 ) {
# backwards compatibility with old parameters
dots.names <- dots %>% names ( )
if ( ' filter_specimen' %in% dots.names ) {
specimen_group <- dots [which ( dots.names == ' filter_specimen' ) ]
}
2019-05-13 14:56:23 +02:00
if ( ' tbl' %in% dots.names ) {
x <- dots [which ( dots.names == ' tbl' ) ]
}
2018-10-23 11:15:05 +02:00
}
# try to find columns based on type
# -- mo
2019-01-15 12:45:24 +01:00
if ( is.null ( col_mo ) ) {
2019-05-23 16:58:59 +02:00
col_mo <- search_type_in_df ( x = x , type = " mo" )
2018-12-22 22:39:34 +01:00
}
if ( is.null ( col_mo ) ) {
stop ( " `col_mo` must be set." , call. = FALSE )
2018-10-23 11:15:05 +02:00
}
2018-12-10 15:14:29 +01:00
2018-10-23 11:15:05 +02:00
# -- date
2018-12-10 15:14:29 +01:00
if ( is.null ( col_date ) ) {
2019-05-23 16:58:59 +02:00
col_date <- search_type_in_df ( x = x , type = " date" )
2018-08-31 13:36:19 +02:00
}
2018-12-10 15:14:29 +01:00
if ( is.null ( col_date ) ) {
stop ( " `col_date` must be set." , call. = FALSE )
}
2019-01-15 12:45:24 +01:00
# convert to Date (pipes/pull for supporting tibbles too)
2019-05-13 14:56:23 +02:00
dates <- x %>% pull ( col_date ) %>% as.Date ( )
dates [is.na ( dates ) ] <- as.Date ( " 1970-01-01" )
x [ , col_date ] <- dates
2018-12-10 15:14:29 +01:00
2018-10-23 11:15:05 +02:00
# -- patient id
2019-01-15 12:45:24 +01:00
if ( is.null ( col_patient_id ) ) {
2019-05-13 14:56:23 +02:00
if ( all ( c ( " First name" , " Last name" , " Sex" , " Identification number" ) %in% colnames ( x ) ) ) {
2019-01-29 20:20:09 +01:00
# WHONET support
2019-05-13 14:56:23 +02:00
x <- x %>% mutate ( patient_id = paste ( `First name` , `Last name` , Sex ) )
2019-01-29 20:20:09 +01:00
col_patient_id <- " patient_id"
2019-08-08 22:39:42 +02:00
message ( blue ( paste0 ( " NOTE: Using combined columns `" , bold ( " First name" ) , " `, `" , bold ( " Last name" ) , " ` and `" , bold ( " Sex" ) , " ` as input for `col_patient_id`." ) ) )
2019-01-29 20:20:09 +01:00
} else {
2019-05-23 16:58:59 +02:00
col_patient_id <- search_type_in_df ( x = x , type = " patient_id" )
2019-01-29 20:20:09 +01:00
}
2018-10-23 11:15:05 +02:00
}
2018-12-10 15:14:29 +01:00
if ( is.null ( col_patient_id ) ) {
stop ( " `col_patient_id` must be set." , call. = FALSE )
}
# -- key antibiotics
2019-01-15 12:45:24 +01:00
if ( is.null ( col_keyantibiotics ) ) {
2019-05-23 16:58:59 +02:00
col_keyantibiotics <- search_type_in_df ( x = x , type = " keyantibiotics" )
2018-12-10 15:14:29 +01:00
}
if ( isFALSE ( col_keyantibiotics ) ) {
col_keyantibiotics <- NULL
}
2018-10-23 11:15:05 +02:00
2019-01-29 00:06:50 +01:00
# -- specimen
2019-05-31 14:25:11 +02:00
if ( is.null ( col_specimen ) & ! is.null ( specimen_group ) ) {
2019-05-23 16:58:59 +02:00
col_specimen <- search_type_in_df ( x = x , type = " specimen" )
2019-01-29 00:06:50 +01:00
}
if ( isFALSE ( col_specimen ) ) {
col_specimen <- NULL
}
2018-03-19 20:39:23 +01:00
# check if columns exist
2019-05-13 14:56:23 +02:00
check_columns_existance <- function ( column , tblname = x ) {
2018-02-21 11:52:31 +01:00
if ( NROW ( tblname ) <= 1 | NCOL ( tblname ) <= 1 ) {
stop ( ' Please check tbl for existance.' )
}
2018-04-02 11:11:21 +02:00
2018-10-23 11:15:05 +02:00
if ( ! is.null ( column ) ) {
2018-02-21 11:52:31 +01:00
if ( ! ( column %in% colnames ( tblname ) ) ) {
2018-04-02 11:11:21 +02:00
stop ( ' Column `' , column , ' ` not found.' )
2018-02-21 11:52:31 +01:00
}
}
}
2018-04-02 11:11:21 +02:00
2018-02-21 11:52:31 +01:00
check_columns_existance ( col_date )
2018-02-26 14:06:31 +01:00
check_columns_existance ( col_patient_id )
2018-08-31 13:36:19 +02:00
check_columns_existance ( col_mo )
2018-02-21 11:52:31 +01:00
check_columns_existance ( col_testcode )
check_columns_existance ( col_icu )
check_columns_existance ( col_keyantibiotics )
2018-04-02 11:11:21 +02:00
2019-08-08 22:39:42 +02:00
# create new dataframe with original row index
2019-05-13 14:56:23 +02:00
x <- x %>%
2019-08-08 22:39:42 +02:00
mutate ( newvar_row_index = 1 : nrow ( x ) ,
newvar_mo = x %>% pull ( col_mo ) %>% as.mo ( ) ,
newvar_genus_species = paste ( mo_genus ( newvar_mo ) , mo_species ( newvar_mo ) ) ,
newvar_date = x %>% pull ( col_date ) ,
newvar_patient_id = x %>% pull ( col_patient_id ) )
2018-10-23 11:15:05 +02:00
if ( is.null ( col_testcode ) ) {
testcodes_exclude <- NULL
2018-02-21 11:52:31 +01:00
}
2018-03-19 20:39:23 +01:00
# remove testcodes
2018-10-23 11:15:05 +02:00
if ( ! is.null ( testcodes_exclude ) & info == TRUE ) {
2018-12-22 22:39:34 +01:00
cat ( ' [Criterion] Excluded test codes:\n' , toString ( testcodes_exclude ) , ' \n' )
2018-02-21 11:52:31 +01:00
}
2018-04-02 11:11:21 +02:00
2018-10-23 11:15:05 +02:00
if ( is.null ( col_icu ) ) {
2018-02-21 11:52:31 +01:00
icu_exclude <- FALSE
} else {
2019-05-13 14:56:23 +02:00
x <- x %>%
mutate ( col_icu = x %>% pull ( col_icu ) %>% as.logical ( ) )
2018-02-21 11:52:31 +01:00
}
2018-04-02 11:11:21 +02:00
2018-10-23 11:15:05 +02:00
if ( is.null ( col_specimen ) ) {
2018-12-22 22:39:34 +01:00
specimen_group <- NULL
2018-03-19 20:39:23 +01:00
}
2018-04-02 11:11:21 +02:00
2018-03-19 20:39:23 +01:00
# filter on specimen group and keyantibiotics when they are filled in
2018-12-22 22:39:34 +01:00
if ( ! is.null ( specimen_group ) ) {
2019-05-13 14:56:23 +02:00
check_columns_existance ( col_specimen , x )
2018-02-21 11:52:31 +01:00
if ( info == TRUE ) {
2018-12-22 22:39:34 +01:00
cat ( ' [Criterion] Excluded other than specimen group \'' , specimen_group , ' \'\n' , sep = ' ' )
2018-02-21 11:52:31 +01:00
}
}
2018-10-23 11:15:05 +02:00
if ( ! is.null ( col_keyantibiotics ) ) {
2019-05-13 14:56:23 +02:00
x <- x %>% mutate ( key_ab = x %>% pull ( col_keyantibiotics ) )
2018-02-21 11:52:31 +01:00
}
2018-04-02 11:11:21 +02:00
2018-10-23 11:15:05 +02:00
if ( is.null ( testcodes_exclude ) ) {
2018-02-21 11:52:31 +01:00
testcodes_exclude <- ' '
}
2018-04-02 11:11:21 +02:00
2019-08-08 22:39:42 +02:00
# arrange data to the right sorting
2018-12-22 22:39:34 +01:00
if ( is.null ( specimen_group ) ) {
2018-10-23 11:15:05 +02:00
# not filtering on specimen
2018-02-21 11:52:31 +01:00
if ( icu_exclude == FALSE ) {
2018-10-23 11:15:05 +02:00
if ( info == TRUE & ! is.null ( col_icu ) ) {
2018-12-22 22:39:34 +01:00
cat ( ' [Criterion] Included isolates from ICU.\n' )
2018-02-21 11:52:31 +01:00
}
2019-05-13 14:56:23 +02:00
x <- x %>%
2019-08-08 22:39:42 +02:00
arrange ( newvar_patient_id ,
newvar_genus_species ,
newvar_date )
2018-02-21 11:52:31 +01:00
row.start <- 1
2019-05-13 14:56:23 +02:00
row.end <- nrow ( x )
2018-02-21 11:52:31 +01:00
} else {
if ( info == TRUE ) {
2018-12-22 22:39:34 +01:00
cat ( ' [Criterion] Excluded isolates from ICU.\n' )
2018-02-21 11:52:31 +01:00
}
2019-05-13 14:56:23 +02:00
x <- x %>%
2018-02-21 11:52:31 +01:00
arrange_at ( c ( col_icu ,
2019-08-08 22:39:42 +02:00
" newvar_patient_id" ,
" newvar_genus_species" ,
" newvar_date" ) )
2018-04-02 11:11:21 +02:00
2018-02-21 11:52:31 +01:00
suppressWarnings (
2019-05-13 14:56:23 +02:00
row.start <- which ( x %>% pull ( col_icu ) == FALSE ) %>% min ( na.rm = TRUE )
2018-02-21 11:52:31 +01:00
)
suppressWarnings (
2019-05-13 14:56:23 +02:00
row.end <- which ( x %>% pull ( col_icu ) == FALSE ) %>% max ( na.rm = TRUE )
2018-02-21 11:52:31 +01:00
)
}
2018-04-02 11:11:21 +02:00
2018-02-21 11:52:31 +01:00
} else {
2018-10-23 11:15:05 +02:00
# filtering on specimen and only analyse these row to save time
2018-02-21 11:52:31 +01:00
if ( icu_exclude == FALSE ) {
2018-10-23 11:15:05 +02:00
if ( info == TRUE & ! is.null ( col_icu ) ) {
2018-12-22 22:39:34 +01:00
cat ( ' [Criterion] Included isolates from ICU.\n' )
2018-02-21 11:52:31 +01:00
}
2019-05-13 14:56:23 +02:00
x <- x %>%
2018-02-21 11:52:31 +01:00
arrange_at ( c ( col_specimen ,
2019-08-08 22:39:42 +02:00
" newvar_patient_id" ,
" newvar_genus_species" ,
" newvar_date" ) )
2018-02-21 11:52:31 +01:00
suppressWarnings (
2019-05-13 14:56:23 +02:00
row.start <- which ( x %>% pull ( col_specimen ) == specimen_group ) %>% min ( na.rm = TRUE )
2018-02-21 11:52:31 +01:00
)
suppressWarnings (
2019-05-13 14:56:23 +02:00
row.end <- which ( x %>% pull ( col_specimen ) == specimen_group ) %>% max ( na.rm = TRUE )
2018-02-21 11:52:31 +01:00
)
} else {
if ( info == TRUE ) {
2018-12-22 22:39:34 +01:00
cat ( ' [Criterion] Excluded isolates from ICU.\n' )
2018-02-21 11:52:31 +01:00
}
2019-05-13 14:56:23 +02:00
x <- x %>%
2018-02-21 11:52:31 +01:00
arrange_at ( c ( col_icu ,
col_specimen ,
2019-08-08 22:39:42 +02:00
" newvar_patient_id" ,
" newvar_genus_species" ,
" newvar_date" ) )
2018-02-21 11:52:31 +01:00
suppressWarnings (
2019-05-13 14:56:23 +02:00
row.start <- which ( x %>% pull ( col_specimen ) == specimen_group
& x %>% pull ( col_icu ) == FALSE ) %>% min ( na.rm = TRUE )
2018-02-21 11:52:31 +01:00
)
suppressWarnings (
2019-05-13 14:56:23 +02:00
row.end <- which ( x %>% pull ( col_specimen ) == specimen_group
& x %>% pull ( col_icu ) == FALSE ) %>% max ( na.rm = TRUE )
2018-02-21 11:52:31 +01:00
)
}
2018-04-02 11:11:21 +02:00
2018-02-21 11:52:31 +01:00
}
2018-04-02 11:11:21 +02:00
2019-08-08 22:39:42 +02:00
# no isolates found
2018-02-21 11:52:31 +01:00
if ( abs ( row.start ) == Inf | abs ( row.end ) == Inf ) {
if ( info == TRUE ) {
2019-02-04 12:24:07 +01:00
message ( paste ( " => Found" , bold ( " no isolates" ) ) )
2018-02-21 11:52:31 +01:00
}
2019-08-08 22:39:42 +02:00
return ( rep ( FALSE , nrow ( x ) ) )
2018-02-21 11:52:31 +01:00
}
2019-08-08 22:39:42 +02:00
# did find some isolates - add new index numbers of rows
x <- x %>% mutate ( newvar_row_index_sorted = 1 : nrow ( .) )
2018-04-02 11:11:21 +02:00
2018-12-31 01:48:53 +01:00
# suppress warnings because dplyr wants us to use library(dplyr) when using filter(row_number())
2019-08-08 22:39:42 +02:00
#suppressWarnings(
scope.size <- row.end - row.start + 1
# x %>%
# filter(
# row_number() %>% between(row.start,
# row.end),
# newvar_genus != "",
# newvar_species != "") %>%
# nrow()
# )
2018-05-31 14:19:25 +02:00
2018-12-31 01:48:53 +01:00
identify_new_year = function ( x , episode_days ) {
# I asked on StackOverflow:
# https://stackoverflow.com/questions/42122245/filter-one-row-every-year
if ( length ( x ) == 1 ) {
return ( TRUE )
}
2019-06-07 22:47:37 +02:00
indices <- integer ( 0 )
start <- x [1 ]
ind <- 1
indices [ind ] <- ind
2018-12-31 01:48:53 +01:00
for ( i in 2 : length ( x ) ) {
2019-06-07 22:47:37 +02:00
if ( isTRUE ( as.numeric ( x [i ] - start ) >= episode_days ) ) {
ind <- ind + 1
indices [ind ] <- i
start <- x [i ]
2018-12-31 01:48:53 +01:00
}
}
result <- rep ( FALSE , length ( x ) )
result [indices ] <- TRUE
return ( result )
}
2018-03-19 20:39:23 +01:00
# Analysis of first isolate ----
2019-05-13 14:56:23 +02:00
all_first <- x %>%
2019-08-08 22:39:42 +02:00
mutate ( other_pat_or_mo = if_else ( newvar_patient_id == lag ( newvar_patient_id )
& newvar_genus_species == lag ( newvar_genus_species ) ,
2018-02-21 11:52:31 +01:00
FALSE ,
2019-01-02 23:24:07 +01:00
TRUE ) ) %>%
2019-08-08 22:39:42 +02:00
group_by ( newvar_patient_id ,
newvar_genus_species ) %>%
mutate ( more_than_episode_ago = identify_new_year ( x = newvar_date ,
2018-12-31 01:48:53 +01:00
episode_days = episode_days ) ) %>%
ungroup ( )
2018-04-02 11:11:21 +02:00
2018-07-25 14:17:04 +02:00
weighted.notice <- ' '
2018-10-23 11:15:05 +02:00
if ( ! is.null ( col_keyantibiotics ) ) {
2018-07-25 14:17:04 +02:00
weighted.notice <- ' weighted '
2018-02-21 11:52:31 +01:00
if ( info == TRUE ) {
2018-03-19 20:39:23 +01:00
if ( type == ' keyantibiotics' ) {
2018-12-22 22:39:34 +01:00
cat ( ' [Criterion] Inclusion based on key antibiotics, ' )
2018-03-19 20:39:23 +01:00
if ( ignore_I == FALSE ) {
2018-07-19 15:11:23 +02:00
cat ( ' not ' )
2018-03-19 20:39:23 +01:00
}
2018-07-19 15:11:23 +02:00
cat ( ' ignoring I.\n' )
2018-03-19 20:39:23 +01:00
}
if ( type == ' points' ) {
2018-12-22 22:39:34 +01:00
cat ( paste0 ( ' [Criterion] Inclusion based on key antibiotics, using points threshold of '
2018-07-19 15:11:23 +02:00
, points_threshold , ' .\n' ) )
2018-03-19 20:39:23 +01:00
}
2018-02-21 11:52:31 +01:00
}
2018-03-19 21:03:23 +01:00
type_param <- type
2019-08-08 22:39:42 +02:00
all_first <- all_first %>%
mutate ( key_ab_lag = lag ( key_ab ) ) %>%
mutate ( key_ab_other = ! key_antibiotics_equal ( y = key_ab ,
z = key_ab_lag ,
type = type_param ,
ignore_I = ignore_I ,
points_threshold = points_threshold ,
info = info ) ) %>%
mutate (
real_first_isolate =
if_else (
newvar_row_index_sorted %>% between ( row.start , row.end )
& newvar_genus_species != " "
& ( other_pat_or_mo | more_than_episode_ago | key_ab_other ) ,
TRUE ,
FALSE ) )
2018-02-21 11:52:31 +01:00
} else {
2018-12-31 01:48:53 +01:00
# no key antibiotics
2019-08-08 22:39:42 +02:00
all_first <- all_first %>%
mutate (
2018-06-08 12:06:54 +02:00
real_first_isolate =
if_else (
2019-08-08 22:39:42 +02:00
newvar_row_index_sorted %>% between ( row.start , row.end )
& newvar_genus_species != " "
2018-12-31 01:48:53 +01:00
& ( other_pat_or_mo | more_than_episode_ago ) ,
2018-06-08 12:06:54 +02:00
TRUE ,
FALSE ) )
2019-08-08 22:39:42 +02:00
2018-02-21 11:52:31 +01:00
}
2018-04-02 11:11:21 +02:00
2018-03-19 20:39:23 +01:00
# first one as TRUE
2018-02-21 11:52:31 +01:00
all_first [row.start , ' real_first_isolate' ] <- TRUE
2018-03-19 20:39:23 +01:00
# no tests that should be included, or ICU
2018-10-23 11:15:05 +02:00
if ( ! is.null ( col_testcode ) ) {
2018-02-21 11:52:31 +01:00
all_first [which ( all_first [ , col_testcode ] %in% tolower ( testcodes_exclude ) ) , ' real_first_isolate' ] <- FALSE
}
if ( icu_exclude == TRUE ) {
all_first [which ( all_first [ , col_icu ] == TRUE ) , ' real_first_isolate' ] <- FALSE
}
2019-08-08 22:39:42 +02:00
decimal.mark <- getOption ( " OutDec" )
big.mark <- ifelse ( decimal.mark != " ," , " ," , " ." )
# handle empty microorganisms
2019-08-28 17:12:48 +02:00
if ( any ( all_first $ newvar_mo == " UNKNOWN" , na.rm = TRUE ) & info == TRUE ) {
2019-08-08 22:39:42 +02:00
if ( include_unknown == TRUE ) {
message ( blue ( paste0 ( " NOTE: Included " , format ( sum ( all_first $ newvar_mo == " UNKNOWN" ) ,
decimal.mark = decimal.mark , big.mark = big.mark ) ,
' isolates with a microbial ID "UNKNOWN" (column `' , bold ( col_mo ) , ' `).' ) ) )
} else {
message ( blue ( paste0 ( " NOTE: Excluded " , format ( sum ( all_first $ newvar_mo == " UNKNOWN" ) ,
decimal.mark = decimal.mark , big.mark = big.mark ) ,
' isolates with a microbial ID "UNKNOWN" (column `' , bold ( col_mo ) , ' `).' ) ) )
}
}
all_first [which ( all_first $ newvar_mo == " UNKNOWN" ) , ' real_first_isolate' ] <- include_unknown
# exclude all NAs
2019-08-28 17:12:48 +02:00
if ( any ( is.na ( all_first $ newvar_mo ) ) & info == TRUE ) {
2019-08-08 22:39:42 +02:00
message ( blue ( paste0 ( " NOTE: Excluded " , format ( sum ( is.na ( all_first $ newvar_mo ) ) ,
decimal.mark = decimal.mark , big.mark = big.mark ) ,
' isolates with a microbial ID "NA" (column `' , bold ( col_mo ) , ' `).' ) ) )
}
all_first [which ( is.na ( all_first $ newvar_mo ) ) , ' real_first_isolate' ] <- FALSE
# arrange back according to original sorting again
2018-02-21 11:52:31 +01:00
all_first <- all_first %>%
2019-08-08 22:39:42 +02:00
arrange ( newvar_row_index ) %>%
2018-02-21 11:52:31 +01:00
pull ( real_first_isolate )
2019-08-08 22:39:42 +02:00
2018-02-21 11:52:31 +01:00
if ( info == TRUE ) {
2018-12-22 22:39:34 +01:00
n_found <- base :: sum ( all_first , na.rm = TRUE )
2019-05-13 14:56:23 +02:00
p_found_total <- percent ( n_found / nrow ( x ) , force_zero = TRUE )
2018-12-22 22:39:34 +01:00
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 )
if ( p_found_total != p_found_scope ) {
msg_txt <- paste0 ( " => Found " ,
bold ( paste0 ( n_found , " first " , weighted.notice , " isolates" ) ) ,
" (" , p_found_scope , " within scope and " , p_found_total , " of total)" )
} else {
msg_txt <- paste0 ( " => Found " ,
bold ( paste0 ( n_found , " first " , weighted.notice , " isolates" ) ) ,
" (" , p_found_total , " of total)" )
}
base :: message ( msg_txt )
2018-02-21 11:52:31 +01:00
}
2018-04-02 11:11:21 +02:00
2018-02-21 11:52:31 +01:00
all_first
2018-04-02 11:11:21 +02:00
2018-02-21 11:52:31 +01:00
}
2018-12-22 22:39:34 +01:00
#' @rdname first_isolate
#' @importFrom dplyr filter
#' @export
2019-05-13 14:56:23 +02:00
filter_first_isolate <- function ( x ,
2018-12-22 22:39:34 +01:00
col_date = NULL ,
col_patient_id = NULL ,
col_mo = NULL ,
... ) {
2019-05-13 14:56:23 +02:00
filter ( x , first_isolate ( x = x ,
2019-05-23 16:58:59 +02:00
col_date = col_date ,
col_patient_id = col_patient_id ,
col_mo = col_mo ,
... ) )
2018-12-22 22:39:34 +01:00
}
#' @rdname first_isolate
#' @importFrom dplyr %>% mutate filter
#' @export
2019-05-13 14:56:23 +02:00
filter_first_weighted_isolate <- function ( x ,
2018-12-22 22:39:34 +01:00
col_date = NULL ,
col_patient_id = NULL ,
col_mo = NULL ,
col_keyantibiotics = NULL ,
... ) {
2019-05-13 14:56:23 +02:00
tbl_keyab <- x %>%
2018-12-22 22:39:34 +01:00
mutate ( keyab = suppressMessages ( key_antibiotics ( .,
col_mo = col_mo ,
... ) ) ) %>%
mutate ( firsts = first_isolate ( .,
col_date = col_date ,
col_patient_id = col_patient_id ,
col_mo = col_mo ,
col_keyantibiotics = " keyab" ,
... ) )
2019-05-13 14:56:23 +02:00
x [which ( tbl_keyab $ firsts == TRUE ) , ]
2018-12-22 22:39:34 +01:00
}