1
0
mirror of https://github.com/msberends/AMR.git synced 2024-12-25 18:06:12 +01:00

first isolate missing dates fix

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

View File

@ -25,10 +25,11 @@
* This package now honours the new EUCAST insight (2019) that S and I are but classified as susceptible, where I is defined as 'increased exposure' and not 'intermediate' anymore. For functions like `portion_df()` and `count_df()` this means that their new parameter `combine_SI` is TRUE at default.
* Removed deprecated functions `guess_mo()`, `guess_atc()`, `EUCAST_rules()`, `interpretive_reading()`, `rsi()`
* Frequency tables of microbial IDs speed improvement
* Removed all hardcoded EUCAST rules and replaced them with a new reference file: `./inst/eucast/eucast.tsv`.
* Removed all hardcoded EUCAST rules and replaced them with a new reference file: `./inst/eucast/eucast.tsv`
* Added ceftazidim intrinsic resistance to *Streptococci*
* Changed default settings for `age_groups()`, to let groups of fives and tens end with 100+ instead of 120+.
* Fix for `freq()` for when all values are `NA`.
* Changed default settings for `age_groups()`, to let groups of fives and tens end with 100+ instead of 120+
* Fix for `freq()` for when all values are `NA`
* Fix for `first_isolate()` for when dates are missing
#### Other
* Support for R 3.6.0

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}

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),]
}

View File

@ -7,7 +7,7 @@ codecov:
comment: no
coverage:
precision: 5
precision: 1
round: up
range: "0...100"
status:

View File

@ -276,11 +276,14 @@ Please create an issue in one of our repositories if you want additions in this
<li>Removed deprecated functions <code>guess_mo()</code>, <code>guess_atc()</code>, <code>EUCAST_rules()</code>, <code>interpretive_reading()</code>, <code>rsi()</code>
</li>
<li>Frequency tables of microbial IDs speed improvement</li>
<li>Removed all hardcoded EUCAST rules and replaced them with a new reference file: <code>./inst/eucast/eucast.tsv</code>.</li>
<li>Removed all hardcoded EUCAST rules and replaced them with a new reference file: <code>./inst/eucast/eucast.tsv</code>
</li>
<li>Added ceftazidim intrinsic resistance to <em>Streptococci</em>
</li>
<li>Changed default settings for <code><a href="../reference/age_groups.html">age_groups()</a></code>, to let groups of fives and tens end with 100+ instead of 120+.</li>
<li>Fix for <code><a href="../reference/freq.html">freq()</a></code> for when all values are <code>NA</code>.</li>
<li>Changed default settings for <code><a href="../reference/age_groups.html">age_groups()</a></code>, to let groups of fives and tens end with 100+ instead of 120+</li>
<li>Fix for <code><a href="../reference/freq.html">freq()</a></code> for when all values are <code>NA</code>
</li>
<li>Fix for <code><a href="../reference/first_isolate.html">first_isolate()</a></code> for when dates are missing</li>
</ul>
</div>
<div id="other" class="section level4">

View File

@ -241,17 +241,17 @@
</div>
<pre class="usage"><span class='fu'>first_isolate</span>(<span class='no'>tbl</span>, <span class='kw'>col_date</span> <span class='kw'>=</span> <span class='kw'>NULL</span>, <span class='kw'>col_patient_id</span> <span class='kw'>=</span> <span class='kw'>NULL</span>,
<pre class="usage"><span class='fu'>first_isolate</span>(<span class='no'>x</span>, <span class='kw'>col_date</span> <span class='kw'>=</span> <span class='kw'>NULL</span>, <span class='kw'>col_patient_id</span> <span class='kw'>=</span> <span class='kw'>NULL</span>,
<span class='kw'>col_mo</span> <span class='kw'>=</span> <span class='kw'>NULL</span>, <span class='kw'>col_testcode</span> <span class='kw'>=</span> <span class='kw'>NULL</span>, <span class='kw'>col_specimen</span> <span class='kw'>=</span> <span class='kw'>NULL</span>,
<span class='kw'>col_icu</span> <span class='kw'>=</span> <span class='kw'>NULL</span>, <span class='kw'>col_keyantibiotics</span> <span class='kw'>=</span> <span class='kw'>NULL</span>, <span class='kw'>episode_days</span> <span class='kw'>=</span> <span class='fl'>365</span>,
<span class='kw'>testcodes_exclude</span> <span class='kw'>=</span> <span class='kw'>NULL</span>, <span class='kw'>icu_exclude</span> <span class='kw'>=</span> <span class='fl'>FALSE</span>,
<span class='kw'>specimen_group</span> <span class='kw'>=</span> <span class='kw'>NULL</span>, <span class='kw'>type</span> <span class='kw'>=</span> <span class='st'>"keyantibiotics"</span>, <span class='kw'>ignore_I</span> <span class='kw'>=</span> <span class='fl'>TRUE</span>,
<span class='kw'>points_threshold</span> <span class='kw'>=</span> <span class='fl'>2</span>, <span class='kw'>info</span> <span class='kw'>=</span> <span class='fl'>TRUE</span>, <span class='no'>...</span>)
<span class='fu'>filter_first_isolate</span>(<span class='no'>tbl</span>, <span class='kw'>col_date</span> <span class='kw'>=</span> <span class='kw'>NULL</span>, <span class='kw'>col_patient_id</span> <span class='kw'>=</span> <span class='kw'>NULL</span>,
<span class='fu'>filter_first_isolate</span>(<span class='no'>x</span>, <span class='kw'>col_date</span> <span class='kw'>=</span> <span class='kw'>NULL</span>, <span class='kw'>col_patient_id</span> <span class='kw'>=</span> <span class='kw'>NULL</span>,
<span class='kw'>col_mo</span> <span class='kw'>=</span> <span class='kw'>NULL</span>, <span class='no'>...</span>)
<span class='fu'>filter_first_weighted_isolate</span>(<span class='no'>tbl</span>, <span class='kw'>col_date</span> <span class='kw'>=</span> <span class='kw'>NULL</span>,
<span class='fu'>filter_first_weighted_isolate</span>(<span class='no'>x</span>, <span class='kw'>col_date</span> <span class='kw'>=</span> <span class='kw'>NULL</span>,
<span class='kw'>col_patient_id</span> <span class='kw'>=</span> <span class='kw'>NULL</span>, <span class='kw'>col_mo</span> <span class='kw'>=</span> <span class='kw'>NULL</span>, <span class='kw'>col_keyantibiotics</span> <span class='kw'>=</span> <span class='kw'>NULL</span>,
<span class='no'>...</span>)</pre>
@ -259,7 +259,7 @@
<table class="ref-arguments">
<colgroup><col class="name" /><col class="desc" /></colgroup>
<tr>
<th>tbl</th>
<th>x</th>
<td><p>a <code>data.frame</code> containing isolates.</p></td>
</tr>
<tr>
@ -341,14 +341,14 @@
<p><strong>WHY THIS IS SO IMPORTANT</strong> <br />
To conduct an analysis of antimicrobial resistance, you should only include the first isolate of every patient per episode <a href='https://www.ncbi.nlm.nih.gov/pubmed/17304462'>[1]</a>. 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 <em>S. aureus</em> isolates would be overestimated, because you included this MRSA more than once. It would be <a href='https://en.wikipedia.org/wiki/Selection_bias'>selection bias</a>.</p>
<p>The functions <code>filter_first_isolate</code> and <code>filter_first_weighted_isolate</code> are helper functions to quickly filter on first isolates. The function <code>filter_first_isolate</code> is essentially equal to:</p><pre>
tbl %&gt;%
mutate(only_firsts = first_isolate(tbl, ...)) %&gt;%
x %&gt;%
mutate(only_firsts = first_isolate(x, ...)) %&gt;%
filter(only_firsts == TRUE) %&gt;%
select(-only_firsts)
</pre><p>The function <code>filter_first_weighted_isolate</code> is essentially equal to:</p><pre>
tbl %&gt;%
x %&gt;%
mutate(keyab = key_antibiotics(.)) %&gt;%
mutate(only_weighted_firsts = first_isolate(tbl,
mutate(only_weighted_firsts = first_isolate(x,
col_keyantibiotics = "keyab", ...)) %&gt;%
filter(only_weighted_firsts == TRUE) %&gt;%
select(-only_weighted_firsts)
@ -416,39 +416,39 @@ To conduct an analysis of antimicrobial resistance, you should only include the
<span class='co'># }</span><span class='co'># NOT RUN {</span>
<span class='co'># set key antibiotics to a new variable</span>
<span class='no'>tbl</span>$<span class='no'>keyab</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='key_antibiotics.html'>key_antibiotics</a></span>(<span class='no'>tbl</span>)
<span class='no'>x</span>$<span class='no'>keyab</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='key_antibiotics.html'>key_antibiotics</a></span>(<span class='no'>x</span>)
<span class='no'>tbl</span>$<span class='no'>first_isolate</span> <span class='kw'>&lt;-</span>
<span class='fu'>first_isolate</span>(<span class='no'>tbl</span>)
<span class='no'>x</span>$<span class='no'>first_isolate</span> <span class='kw'>&lt;-</span>
<span class='fu'>first_isolate</span>(<span class='no'>x</span>)
<span class='no'>tbl</span>$<span class='no'>first_isolate_weighed</span> <span class='kw'>&lt;-</span>
<span class='fu'>first_isolate</span>(<span class='no'>tbl</span>,
<span class='no'>x</span>$<span class='no'>first_isolate_weighed</span> <span class='kw'>&lt;-</span>
<span class='fu'>first_isolate</span>(<span class='no'>x</span>,
<span class='kw'>col_keyantibiotics</span> <span class='kw'>=</span> <span class='st'>'keyab'</span>)
<span class='no'>tbl</span>$<span class='no'>first_blood_isolate</span> <span class='kw'>&lt;-</span>
<span class='fu'>first_isolate</span>(<span class='no'>tbl</span>,
<span class='no'>x</span>$<span class='no'>first_blood_isolate</span> <span class='kw'>&lt;-</span>
<span class='fu'>first_isolate</span>(<span class='no'>x</span>,
<span class='kw'>specimen_group</span> <span class='kw'>=</span> <span class='st'>'Blood'</span>)
<span class='no'>tbl</span>$<span class='no'>first_blood_isolate_weighed</span> <span class='kw'>&lt;-</span>
<span class='fu'>first_isolate</span>(<span class='no'>tbl</span>,
<span class='no'>x</span>$<span class='no'>first_blood_isolate_weighed</span> <span class='kw'>&lt;-</span>
<span class='fu'>first_isolate</span>(<span class='no'>x</span>,
<span class='kw'>specimen_group</span> <span class='kw'>=</span> <span class='st'>'Blood'</span>,
<span class='kw'>col_keyantibiotics</span> <span class='kw'>=</span> <span class='st'>'keyab'</span>)
<span class='no'>tbl</span>$<span class='no'>first_urine_isolate</span> <span class='kw'>&lt;-</span>
<span class='fu'>first_isolate</span>(<span class='no'>tbl</span>,
<span class='no'>x</span>$<span class='no'>first_urine_isolate</span> <span class='kw'>&lt;-</span>
<span class='fu'>first_isolate</span>(<span class='no'>x</span>,
<span class='kw'>specimen_group</span> <span class='kw'>=</span> <span class='st'>'Urine'</span>)
<span class='no'>tbl</span>$<span class='no'>first_urine_isolate_weighed</span> <span class='kw'>&lt;-</span>
<span class='fu'>first_isolate</span>(<span class='no'>tbl</span>,
<span class='no'>x</span>$<span class='no'>first_urine_isolate_weighed</span> <span class='kw'>&lt;-</span>
<span class='fu'>first_isolate</span>(<span class='no'>x</span>,
<span class='kw'>specimen_group</span> <span class='kw'>=</span> <span class='st'>'Urine'</span>,
<span class='kw'>col_keyantibiotics</span> <span class='kw'>=</span> <span class='st'>'keyab'</span>)
<span class='no'>tbl</span>$<span class='no'>first_resp_isolate</span> <span class='kw'>&lt;-</span>
<span class='fu'>first_isolate</span>(<span class='no'>tbl</span>,
<span class='no'>x</span>$<span class='no'>first_resp_isolate</span> <span class='kw'>&lt;-</span>
<span class='fu'>first_isolate</span>(<span class='no'>x</span>,
<span class='kw'>specimen_group</span> <span class='kw'>=</span> <span class='st'>'Respiratory'</span>)
<span class='no'>tbl</span>$<span class='no'>first_resp_isolate_weighed</span> <span class='kw'>&lt;-</span>
<span class='fu'>first_isolate</span>(<span class='no'>tbl</span>,
<span class='no'>x</span>$<span class='no'>first_resp_isolate_weighed</span> <span class='kw'>&lt;-</span>
<span class='fu'>first_isolate</span>(<span class='no'>x</span>,
<span class='kw'>specimen_group</span> <span class='kw'>=</span> <span class='st'>'Respiratory'</span>,
<span class='kw'>col_keyantibiotics</span> <span class='kw'>=</span> <span class='st'>'keyab'</span>)
<span class='co'># }</span></pre>

View File

@ -245,7 +245,7 @@
<h2 class="hasAnchor" id="format"><a class="anchor" href="#format"></a>Format</h2>
<p>A <code><a href='https://www.rdocumentation.org/packages/base/topics/data.frame'>data.frame</a></code> with 65,629 observations and 16 variables:</p><dl class='dl-horizontal'>
<p>A <code><a href='https://www.rdocumentation.org/packages/base/topics/data.frame'>data.frame</a></code> with 67,903 observations and 16 variables:</p><dl class='dl-horizontal'>
<dt><code>mo</code></dt><dd><p>ID of microorganism as used by this package</p></dd>
<dt><code>col_id</code></dt><dd><p>Catalogue of Life ID</p></dd>
<dt><code>fullname</code></dt><dd><p>Full name, like <code>"Echerichia coli"</code></p></dd>

View File

@ -261,10 +261,6 @@
<h2 class="hasAnchor" id="arguments"><a class="anchor" href="#arguments"></a>Arguments</h2>
<table class="ref-arguments">
<colgroup><col class="name" /><col class="desc" /></colgroup>
<tr>
<th>tbl</th>
<td><p>a <code>data.frame</code> containing isolates.</p></td>
</tr>
<tr>
<th>col_ab</th>
<td><p>column name of <code>tbl</code> with antimicrobial interpretations (<code>R</code>, <code>I</code> and <code>S</code>)</p></td>
@ -307,9 +303,7 @@
</tr>
<tr>
<th>x</th>
<td><p>the coordinates of points in the plot. Alternatively, a
single plotting structure, function or <em>any <span style="R">R</span> object with a
<code>plot</code> method</em> can be provided.</p></td>
<td><p>a <code>data.frame</code> containing isolates.</p></td>
</tr>
<tr>
<th>main</th>

View File

@ -9,22 +9,22 @@
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/}.
}
\usage{
first_isolate(tbl, col_date = NULL, col_patient_id = NULL,
first_isolate(x, col_date = NULL, col_patient_id = NULL,
col_mo = NULL, col_testcode = NULL, col_specimen = NULL,
col_icu = NULL, col_keyantibiotics = NULL, episode_days = 365,
testcodes_exclude = NULL, icu_exclude = FALSE,
specimen_group = NULL, type = "keyantibiotics", ignore_I = TRUE,
points_threshold = 2, info = TRUE, ...)
filter_first_isolate(tbl, col_date = NULL, col_patient_id = NULL,
filter_first_isolate(x, col_date = NULL, col_patient_id = NULL,
col_mo = NULL, ...)
filter_first_weighted_isolate(tbl, col_date = NULL,
filter_first_weighted_isolate(x, col_date = NULL,
col_patient_id = NULL, col_mo = NULL, col_keyantibiotics = NULL,
...)
}
\arguments{
\item{tbl}{a \code{data.frame} containing isolates.}
\item{x}{a \code{data.frame} containing isolates.}
\item{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}
@ -70,16 +70,16 @@ To conduct an analysis of antimicrobial resistance, you should only include the
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)
@ -144,39 +144,39 @@ B <- septic_patients \%>\%
\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')
}

View File

@ -4,7 +4,7 @@
\name{microorganisms}
\alias{microorganisms}
\title{Data set with ~65,000 microorganisms}
\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}

View File

@ -24,8 +24,6 @@ ggplot_rsi_predict(x, main = paste("Resistance prediction of",
attributes(x)$ab), ribbon = TRUE, ...)
}
\arguments{
\item{tbl}{a \code{data.frame} containing isolates.}
\item{col_ab}{column name of \code{tbl} with antimicrobial interpretations (\code{R}, \code{I} and \code{S})}
\item{col_date}{column name of the date, will be used to calculate years if this column doesn't consist of years already, defaults to the first column of with a date class}
@ -46,9 +44,7 @@ ggplot_rsi_predict(x, main = paste("Resistance prediction of",
\item{info}{a logical to indicate whether textual analysis should be printed with the name and \code{\link{summary}} of the statistical model.}
\item{x}{the coordinates of points in the plot. Alternatively, a
single plotting structure, function or \emph{any \R object with a
\code{plot} method} can be provided.}
\item{x}{a \code{data.frame} containing isolates.}
\item{main}{title of the plot}

View File

@ -42,9 +42,12 @@ test_that("as.ab works", {
expect_warning(as.ab("Z00ZZ00")) # not yet available in data set
expect_warning(as.ab("UNKNOWN"))
expect_warning(as.ab(""))
expect_output(print(as.ab("amox")))
expect_identical(class(pull(antibiotics, ab)), "ab")
# first 5 chars of official name
expect_equal(as.character(as.atc(c("nitro", "cipro"))),
c("J01XE01", "J01MA02"))
@ -53,4 +56,7 @@ test_that("as.ab works", {
expect_equal(as.character(as.atc("AMX")),
"J01CA04")
expect_equal(as.character(as.ab("Phloxapen")),
"FLC")
})

View File

@ -48,4 +48,6 @@ test_that("creation of data sets is valid", {
test_that("CoL version info works", {
expect_identical(class(catalogue_of_life_version()),
c("catalogue_of_life_version", "list"))
expect_output(print(catalogue_of_life_version()))
})

35
tests/testthat/test-disk.R Executable file
View File

@ -0,0 +1,35 @@
# ==================================================================== #
# TITLE #
# Antidiskrobial Resistance (AMR) Analysis #
# #
# SOURCE #
# https://gitlab.com/msberends/AMR #
# #
# LICENCE #
# (c) 2019 Berends MS (m.s.berends@umcg.nl), Luz CF (c.f.luz@umcg.nl) #
# #
# 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. #
# Visit our website for more info: https://msberends.gitlab.io/AMR. #
# ==================================================================== #
context("disk.R")
test_that("disk works", {
expect_true(as.disk(8) == as.disk("8"))
expect_true(is.disk(as.disk(8)))
expect_equal(suppressWarnings(as.logical(as.disk("INVALID VALUE"))), NA)
# all levels should be valid disks
expect_silent(as.disk(levels(as.disk(15))))
expect_warning(as.disk("INVALID VALUE"))
})

View File

@ -25,7 +25,7 @@ test_that("first isolates work", {
# first isolates
expect_equal(
sum(
first_isolate(tbl = septic_patients,
first_isolate(x = septic_patients,
col_date = "date",
col_patient_id = "patient_id",
col_mo = "mo",
@ -37,7 +37,7 @@ test_that("first isolates work", {
expect_equal(
suppressWarnings(
sum(
first_isolate(tbl = septic_patients %>% mutate(keyab = key_antibiotics(.)),
first_isolate(x = septic_patients %>% mutate(keyab = key_antibiotics(.)),
# let syntax determine these automatically:
# col_date = "date",
# col_patient_id = "patient_id",
@ -51,7 +51,7 @@ test_that("first isolates work", {
expect_equal(
suppressWarnings(
sum(
first_isolate(tbl = septic_patients %>% dplyr::as_tibble() %>% mutate(keyab = key_antibiotics(.)),
first_isolate(x = septic_patients %>% dplyr::as_tibble() %>% mutate(keyab = key_antibiotics(.)),
# let syntax determine these automatically:
# col_date = "date",
# col_patient_id = "patient_id",
@ -65,7 +65,7 @@ test_that("first isolates work", {
expect_equal(
suppressWarnings(
sum(
first_isolate(tbl = septic_patients %>% mutate(keyab = key_antibiotics(.)),
first_isolate(x = septic_patients %>% mutate(keyab = key_antibiotics(.)),
col_date = "date",
col_patient_id = "patient_id",
col_mo = "mo",
@ -79,7 +79,7 @@ test_that("first isolates work", {
expect_equal(
suppressWarnings(
sum(
first_isolate(tbl = septic_patients %>% mutate(keyab = key_antibiotics(.)),
first_isolate(x = septic_patients %>% mutate(keyab = key_antibiotics(.)),
col_date = "date",
col_patient_id = "patient_id",
col_mo = "mo",
@ -106,7 +106,7 @@ test_that("first isolates work", {
random_rows <- sample(x = 1:2000, size = 1500, replace = FALSE)
expect_lt(
sum(
first_isolate(tbl = mutate(septic_patients,
first_isolate(x = mutate(septic_patients,
specimen = if_else(row_number() %in% random_rows,
"Urine",
"Other")),
@ -121,7 +121,7 @@ test_that("first isolates work", {
# same, but now exclude ICU
expect_lt(
sum(
first_isolate(tbl = mutate(septic_patients,
first_isolate(x = mutate(septic_patients,
specimen = if_else(row_number() %in% random_rows,
"Urine",
"Other")),
@ -175,4 +175,16 @@ test_that("first isolates work", {
col_mo = "mo",
col_patient_id = "patient_id"))
df <- septic_patients
df[1:100, "date"] <- NA
expect_equal(
sum(
first_isolate(x = df,
col_date = "date",
col_patient_id = "patient_id",
col_mo = "mo",
info = TRUE),
na.rm = TRUE),
1279)
})