From cc403169c6b9c768d6558d6824b56b1031baf56b Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Mon, 13 May 2019 14:56:23 +0200 Subject: [PATCH] first isolate missing dates fix --- NEWS.md | 7 +- R/data.R | 2 +- R/first_isolate.R | 139 +++++++++++++------------ codecov.yml | 2 +- docs/news/index.html | 9 +- docs/reference/first_isolate.html | 50 ++++----- docs/reference/microorganisms.html | 2 +- docs/reference/resistance_predict.html | 8 +- man/first_isolate.Rd | 50 ++++----- man/microorganisms.Rd | 2 +- man/resistance_predict.Rd | 6 +- tests/testthat/test-ab.R | 6 ++ tests/testthat/test-data.R | 2 + tests/testthat/test-disk.R | 35 +++++++ tests/testthat/test-first_isolate.R | 26 +++-- 15 files changed, 200 insertions(+), 146 deletions(-) create mode 100755 tests/testthat/test-disk.R diff --git a/NEWS.md b/NEWS.md index 74907e41..f2a712ea 100755 --- a/NEWS.md +++ b/NEWS.md @@ -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 diff --git a/R/data.R b/R/data.R index f5f57566..0aec1b15 100755 --- a/R/data.R +++ b/R/data.R @@ -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} diff --git a/R/first_isolate.R b/R/first_isolate.R index 224b6a8d..c315b660 100755 --- a/R/first_isolate.R +++ b/R/first_isolate.R @@ -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),] } diff --git a/codecov.yml b/codecov.yml index f3502d9a..0a1028a0 100644 --- a/codecov.yml +++ b/codecov.yml @@ -7,7 +7,7 @@ codecov: comment: no coverage: - precision: 5 + precision: 1 round: up range: "0...100" status: diff --git a/docs/news/index.html b/docs/news/index.html index 96b552a4..17f27bc3 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -276,11 +276,14 @@ Please create an issue in one of our repositories if you want additions in this
  • 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
  • diff --git a/docs/reference/first_isolate.html b/docs/reference/first_isolate.html index 18cf2832..c2a4e9d6 100644 --- a/docs/reference/first_isolate.html +++ b/docs/reference/first_isolate.html @@ -241,17 +241,17 @@
    -
    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,
       ...)
    @@ -259,7 +259,7 @@ - + @@ -341,14 +341,14 @@

    WHY THIS IS SO IMPORTANT
    To conduct an analysis of antimicrobial resistance, you should only include the first isolate of every patient per episode [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 S. aureus isolates would be overestimated, because you included this MRSA more than once. It would be selection bias.

    The functions filter_first_isolate and filter_first_weighted_isolate are helper functions to quickly filter on first isolates. The function filter_first_isolate is essentially equal to:

    - tbl %>%
    -   mutate(only_firsts = first_isolate(tbl, ...)) %>%
    + x %>%
    +   mutate(only_firsts = first_isolate(x, ...)) %>%
        filter(only_firsts == TRUE) %>%
        select(-only_firsts)
     

    The function filter_first_weighted_isolate is essentially equal to:

    - 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)
    @@ -416,39 +416,39 @@ To conduct an analysis of antimicrobial resistance, you should only include the
     
     # }# NOT RUN {
     # 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')
     # }
    diff --git a/docs/reference/microorganisms.html b/docs/reference/microorganisms.html index 04cc088f..62f34126 100644 --- a/docs/reference/microorganisms.html +++ b/docs/reference/microorganisms.html @@ -245,7 +245,7 @@

    Format

    -

    A data.frame with 65,629 observations and 16 variables:

    +

    A data.frame with 67,903 observations and 16 variables:

    mo

    ID of microorganism as used by this package

    col_id

    Catalogue of Life ID

    fullname

    Full name, like "Echerichia coli"

    diff --git a/docs/reference/resistance_predict.html b/docs/reference/resistance_predict.html index 6972ee99..f4da5499 100644 --- a/docs/reference/resistance_predict.html +++ b/docs/reference/resistance_predict.html @@ -261,10 +261,6 @@

    Arguments

    tblx

    a data.frame containing isolates.

    - - - - @@ -307,9 +303,7 @@ - + diff --git a/man/first_isolate.Rd b/man/first_isolate.Rd index 4de198cf..2e6d62cc 100755 --- a/man/first_isolate.Rd +++ b/man/first_isolate.Rd @@ -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') } diff --git a/man/microorganisms.Rd b/man/microorganisms.Rd index e0d29d5a..4fb40bfd 100755 --- a/man/microorganisms.Rd +++ b/man/microorganisms.Rd @@ -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} diff --git a/man/resistance_predict.Rd b/man/resistance_predict.Rd index cc98afd7..4048bc05 100644 --- a/man/resistance_predict.Rd +++ b/man/resistance_predict.Rd @@ -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} diff --git a/tests/testthat/test-ab.R b/tests/testthat/test-ab.R index e44468bb..c81a0586 100755 --- a/tests/testthat/test-ab.R +++ b/tests/testthat/test-ab.R @@ -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") + }) diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R index c9bd5ee1..2d91810f 100644 --- a/tests/testthat/test-data.R +++ b/tests/testthat/test-data.R @@ -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())) }) diff --git a/tests/testthat/test-disk.R b/tests/testthat/test-disk.R new file mode 100755 index 00000000..486a69c6 --- /dev/null +++ b/tests/testthat/test-disk.R @@ -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")) + +}) diff --git a/tests/testthat/test-first_isolate.R b/tests/testthat/test-first_isolate.R index 868b252a..039a6cc1 100755 --- a/tests/testthat/test-first_isolate.R +++ b/tests/testthat/test-first_isolate.R @@ -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) + })
    tbl

    a data.frame containing isolates.

    col_ab

    column name of tbl with antimicrobial interpretations (R, I and S)

    x

    the coordinates of points in the plot. Alternatively, a - single plotting structure, function or any R object with a - plot method can be provided.

    a data.frame containing isolates.

    main