From c182a9673d16f2849fecfa901e5a7dfa4e45cf8f Mon Sep 17 00:00:00 2001 From: msberends Date: Mon, 2 Apr 2018 11:11:21 +0200 Subject: [PATCH] fix clipboard on linux --- .gitignore | 1 + .travis.yml | 10 +- DESCRIPTION | 2 +- R/clipboard.R | 70 ++++++++----- R/data.R | 38 +++---- R/first_isolates.R | 180 +++++++++++++++----------------- R/join.R | 6 +- man/clipboard.Rd | 2 +- man/first_isolate.Rd | 24 ++--- man/septic_patients.Rd | 22 ++-- tests/testthat/Rplots.pdf | Bin 4854 -> 0 bytes tests/testthat/test-clipboard.R | 2 +- 12 files changed, 181 insertions(+), 176 deletions(-) delete mode 100644 tests/testthat/Rplots.pdf diff --git a/.gitignore b/.gitignore index 5fac0fbc..e4a31cd9 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ .RData .Ruserdata AMR.Rproj +tests/testthat/Rplots.pdf diff --git a/.travis.yml b/.travis.yml index f360382c..fa96253a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -3,15 +3,9 @@ # Setting up R deps language: r r: 3.2 -r_packages: - - covr - - testthat - - dplyr - - rvest - - xml2 - - reshape2 +r_packages: covr -# system deps +# system deps, install xclip for clipboard support os: - linux - osx diff --git a/DESCRIPTION b/DESCRIPTION index e03a4340..90290f58 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR Version: 0.1.2 -Date: 2018-03-27 +Date: 2018-04-02 Title: Antimicrobial Resistance Analysis Authors@R: c( person( diff --git a/R/clipboard.R b/R/clipboard.R index 48f0f785..e41c2842 100644 --- a/R/clipboard.R +++ b/R/clipboard.R @@ -29,27 +29,39 @@ clipboard_import <- function(sep = '\t', file <- pipe("xclip -o", "r") on.exit(close(file)) } - - import_tbl <- read.delim(file = file, - sep = sep, - header = header, - strip.white = TRUE, - dec = dec, - na.strings = na, - fileEncoding = 'UTF-8', - encoding = 'UTF-8', - stringsAsFactors = FALSE) - + + import_tbl <- tryCatch(read.delim(file = file, + sep = sep, + header = header, + strip.white = TRUE, + dec = dec, + na.strings = na, + fileEncoding = 'UTF-8', + encoding = 'UTF-8', + stringsAsFactors = FALSE), + error = function(e) { + FALSE + }) + + if (import_tbl == FALSE) { + cat("No clipboard content found.") + if (Sys.info()['sysname'] %like% "Linux") { + cat(" These functions do not work without X11 installed.") + } + cat("\n") + return(invisible()) + } + # use tibble, so column types will be translated correctly import_tbl <- as_tibble(import_tbl) - + if (startrow > 1) { # would else lose column headers import_tbl <- import_tbl[startrow:nrow(import_tbl),] } - + colnames(import_tbl) <- gsub('[.]+', '_', colnames(import_tbl)) - + if (NCOL(import_tbl) == 1 & as_vector == TRUE) { import_tbl %>% pull(1) } else { @@ -66,14 +78,14 @@ clipboard_export <- function(x, na = "", header = TRUE, info = TRUE) { - + x <- deparse(substitute(x)) size <- x %>% - get() %>% + get() %>% object.size() %>% formatC(format = 'd') %>% as.integer() - + x <- get(x) if (is_Windows() == TRUE) { @@ -86,18 +98,22 @@ clipboard_export <- function(x, on.exit(close(file)) } - write.table(x = x, - file = file, - sep = sep, - na = na, - row.names = FALSE, - col.names = header, - dec = dec, - quote = FALSE) + tryCatch(write.table(x = x, + file = file, + sep = sep, + na = na, + row.names = FALSE, + col.names = header, + dec = dec, + quote = FALSE), + error = function(e) { + FALSE + }) if (info == TRUE) { cat("Successfully exported to clipboard:", NROW(x), "obs. of", NCOL(x), "variables.\n") } + } is_Windows <- function() { @@ -105,6 +121,10 @@ is_Windows <- function() { } check_xclip <- function() { if (!isTRUE(file.exists(Sys.which("xclip")[1L]))) { + if (Sys.info()['sysname'] %like% "Linux") { stop("Please install Linux package xclip first.") + } else { + stop("Please install package xclip first (use `brew install xclip on macOS`).") + } } } diff --git a/R/data.R b/R/data.R index a8494f3a..91c7a527 100644 --- a/R/data.R +++ b/R/data.R @@ -42,7 +42,7 @@ #' @seealso \code{\link{microorganisms}} # last two columns created with: # antibiotics %>% -# mutate(useful_gramnegative = +# mutate(useful_gramnegative = # if_else( # atc_group1 %like% '(fusidic|glycopeptide|macrolide|lincosamide|daptomycin|linezolid)' | # atc_group2 %like% '(fusidic|glycopeptide|macrolide|lincosamide|daptomycin|linezolid)' | @@ -116,39 +116,39 @@ #' # ----------- # #' # PREPARATION # #' # ----------- # -#' +#' #' # Save this example dataset to an object, so we can edit it: #' my_data <- septic_patients -#' +#' #' # load the dplyr package to make data science A LOT easier #' library(dplyr) -#' +#' #' # Add first isolates to our dataset: -#' my_data <- my_data %>% -#' mutate(first_isolates = first_isolate(my_data, date, patient_id, bactid)) -#' +#' my_data <- my_data %>% +#' mutate(first_isolates = first_isolate(my_data, "date", "patient_id", "bactid")) +#' #' # -------- # #' # ANALYSIS # #' # -------- # -#' -#' # 1. Get the amoxicillin resistance percentages +#' +#' # 1. Get the amoxicillin resistance percentages #' # of E. coli, divided by hospital: -#' +#' #' my_data %>% #' filter(bactid == "ESCCOL", -#' first_isolates == TRUE) %>% -#' group_by(hospital_id) %>% +#' first_isolates == TRUE) %>% +#' group_by(hospital_id) %>% #' summarise(n = n(), #' amoxicillin_resistance = rsi(amox)) -#' -#' -#' # 2. Get the amoxicillin/clavulanic acid resistance +#' +#' +#' # 2. Get the amoxicillin/clavulanic acid resistance #' # percentages of E. coli, trend over the years: -#' -#' my_data %>% +#' +#' my_data %>% #' filter(bactid == guess_bactid("E. coli"), -#' first_isolates == TRUE) %>% -#' group_by(year = format(date, "%Y")) %>% +#' first_isolates == TRUE) %>% +#' group_by(year = format(date, "%Y")) %>% #' summarise(n = n(), #' amoxclav_resistance = rsi(amcl, minimum = 20)) "septic_patients" diff --git a/R/first_isolates.R b/R/first_isolates.R index f5f04fba..54a2ca5e 100644 --- a/R/first_isolates.R +++ b/R/first_isolates.R @@ -18,14 +18,14 @@ #' Determine first (weighted) isolates #' -#' Determine first (weighted) isolates of all microorganisms of every patient per episode and (if needed) per specimen type. +#' 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 col_date column name of the result date (or date that is was received on the lab), supports tidyverse-like quotation -#' @param col_patient_id column name of the unique IDs of the patients, supports tidyverse-like quotation -#' @param col_bactid column name of the unique IDs of the microorganisms (should occur in the \code{\link{microorganisms}} dataset), supports tidyverse-like quotation +#' @param col_date column name of the result date (or date that is was received on the lab) +#' @param col_patient_id column name of the unique IDs of the patients +#' @param col_bactid column name of the unique IDs of the microorganisms (should occur in the \code{\link{microorganisms}} dataset) #' @param col_testcode column name of the test codes. Use \code{col_testcode = NA} to \strong{not} exclude certain test codes (like test codes for screening). In that case \code{testcodes_exclude} will be ignored. Supports tidyverse-like quotation. -#' @param col_specimen column name of the specimen type or group, supports tidyverse-like quotation -#' @param col_icu column name of the logicals (\code{TRUE}/\code{FALSE}) whether a ward or department is an Intensive Care Unit (ICU), supports tidyverse-like quotation +#' @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) #' @param col_keyantibiotics column name of the key antibiotics to determine first \emph{weighted} isolates, see \code{\link{key_antibiotics}}. Supports tidyverse-like quotation. #' @param episode_days episode in days after which a genus/species combination will be determined as 'first isolate' again #' @param testcodes_exclude character vector with test codes that should be excluded (case-insensitive) @@ -36,8 +36,8 @@ #' @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 #' @param info print progress -#' @param col_genus (deprecated, use \code{col_bactid} instead) column name of the genus of the microorganisms, supports tidyverse-like quotation -#' @param col_species (deprecated, use \code{col_bactid} instead) column name of the species of the microorganisms, supports tidyverse-like quotation +#' @param col_genus (deprecated, use \code{col_bactid} instead) column name of the genus of the microorganisms +#' @param col_species (deprecated, use \code{col_bactid} instead) column name of the species of the microorganisms #' @details \strong{WHY THIS IS SO IMPORTANT} \cr #' 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}. #' @@ -54,15 +54,13 @@ #' # septic_patients is a dataset available in the AMR package #' ?septic_patients #' my_patients <- septic_patients -#' +#' #' library(dplyr) #' my_patients$first_isolate <- my_patients %>% -#' left_join_microorganisms() %>% -#' first_isolate(col_date = date, -#' col_patient_id = patient_id, -#' col_genus = genus, -#' col_species = species) -#' +#' first_isolate(col_date = "date", +#' col_patient_id = "patient_id", +#' col_bactid = "bactid") +#' #' \dontrun{ #' #' # set key antibiotics to a new variable @@ -121,31 +119,25 @@ first_isolate <- function(tbl, info = TRUE, col_genus = NA, col_species = NA) { - - # support tidyverse-like quotation - # col_date <- quasiquotate(deparse(substitute(col_date)), col_date) - # col_patient_id <- quasiquotate(deparse(substitute(col_patient_id)), col_patient_id) - # col_bactid <- quasiquotate(deparse(substitute(col_bactid)), col_bactid) - # col_genus <- quasiquotate(deparse(substitute(col_genus)), col_genus) - # col_species <- quasiquotate(deparse(substitute(col_species)), col_species) - # col_testcode <- quasiquotate(deparse(substitute(col_testcode)), col_testcode) - # col_specimen <- quasiquotate(deparse(substitute(col_specimen)), col_specimen) - # col_icu <- quasiquotate(deparse(substitute(col_icu)), col_icu) - # col_keyantibiotics <- quasiquotate(deparse(substitute(col_keyantibiotics)), col_keyantibiotics) - + + # bactid OR genus+species must be available + if (is.na(col_bactid) & (is.na(col_genus) | is.na(col_species))) { + stop('`col_bactid or both `col_genus` and `col_species` must be available.') + } + # check if columns exist check_columns_existance <- function(column, tblname = tbl) { if (NROW(tblname) <= 1 | NCOL(tblname) <= 1) { stop('Please check tbl for existance.') } - + if (!is.na(column)) { if (!(column %in% colnames(tblname))) { - stop('Column ', column, ' not found.') + stop('Column `', column, '` not found.') } } } - + check_columns_existance(col_date) check_columns_existance(col_patient_id) check_columns_existance(col_bactid) @@ -154,13 +146,13 @@ first_isolate <- function(tbl, check_columns_existance(col_testcode) check_columns_existance(col_icu) check_columns_existance(col_keyantibiotics) - + if (!is.na(col_bactid)) { - tbl <- tbl %>% left_join_microorganisms() + tbl <- tbl %>% left_join_microorganisms(by = col_bactid) col_genus <- "genus" col_species <- "species" } - + if (is.na(col_testcode)) { testcodes_exclude <- NA } @@ -168,18 +160,18 @@ first_isolate <- function(tbl, if (!is.na(testcodes_exclude[1]) & testcodes_exclude[1] != '' & info == TRUE) { cat('Isolates from these test codes will be ignored:\n', toString(testcodes_exclude), '\n') } - + if (is.na(col_icu)) { icu_exclude <- FALSE } else { tbl <- tbl %>% mutate(col_icu = tbl %>% pull(col_icu) %>% as.logical()) } - + if (is.na(col_specimen)) { filter_specimen <- '' } - + specgroup.notice <- '' weighted.notice <- '' # filter on specimen group and keyantibiotics when they are filled in @@ -196,11 +188,11 @@ first_isolate <- function(tbl, } else { tbl <- tbl %>% mutate(key_ab = tbl %>% pull(col_keyantibiotics)) } - + if (is.na(testcodes_exclude[1])) { testcodes_exclude <- '' } - + # create new dataframe with original row index and right sorting tbl <- tbl %>% mutate(first_isolate_row_index = 1:nrow(tbl), @@ -211,9 +203,9 @@ first_isolate <- function(tbl, genus = tbl %>% pull(col_genus)) %>% mutate(species = if_else(is.na(species), '', species), genus = if_else(is.na(genus), '', genus)) - + if (filter_specimen == '') { - + if (icu_exclude == FALSE) { if (info == TRUE) { cat('Isolates from ICU will *NOT* be ignored.\n') @@ -235,7 +227,7 @@ first_isolate <- function(tbl, col_genus, col_species, col_date)) - + suppressWarnings( row.start <- which(tbl %>% pull(col_icu) == FALSE) %>% min(na.rm = TRUE) ) @@ -243,7 +235,7 @@ first_isolate <- function(tbl, row.end <- which(tbl %>% pull(col_icu) == FALSE) %>% max(na.rm = TRUE) ) } - + } else { # sort on specimen and only analyse these row to save time if (icu_exclude == FALSE) { @@ -282,9 +274,9 @@ first_isolate <- function(tbl, & tbl %>% pull(col_icu) == FALSE) %>% max(na.rm = TRUE) ) } - + } - + if (abs(row.start) == Inf | abs(row.end) == Inf) { if (info == TRUE) { cat('No isolates found.\n') @@ -297,14 +289,14 @@ first_isolate <- function(tbl, } return(tbl %>% pull(real_first_isolate)) } - + scope.size <- tbl %>% filter(row_number() %>% between(row.start, row.end), genus != '') %>% nrow() - + # Analysis of first isolate ---- all_first <- tbl %>% mutate(other_pat_or_mo = if_else(patient_id == lag(patient_id) @@ -316,7 +308,7 @@ first_isolate <- function(tbl, mutate(days_diff = if_else(other_pat_or_mo == FALSE, (date_lab - lag(date_lab)) + lag(days_diff), 0)) - + if (col_keyantibiotics != '') { if (info == TRUE) { if (type == 'keyantibiotics') { @@ -365,7 +357,7 @@ first_isolate <- function(tbl, TRUE, FALSE)) } - + # first one as TRUE all_first[row.start, 'real_first_isolate'] <- TRUE # no tests that should be included, or ICU @@ -375,15 +367,15 @@ first_isolate <- function(tbl, if (icu_exclude == TRUE) { all_first[which(all_first[, col_icu] == TRUE), 'real_first_isolate'] <- FALSE } - + # NA's where genus is unavailable all_first <- all_first %>% mutate(real_first_isolate = if_else(genus == '', NA, real_first_isolate)) - + all_first <- all_first %>% arrange(first_isolate_row_index) %>% pull(real_first_isolate) - + if (info == TRUE) { cat(paste0('\nFound ', all_first %>% sum(na.rm = TRUE), @@ -393,13 +385,13 @@ first_isolate <- function(tbl, (all_first %>% sum(na.rm = TRUE) / tbl %>% nrow()) %>% percent(), ' of total)\n')) } - + if (output_logical == FALSE) { all_first <- all_first %>% as.integer() } - + all_first - + } #' Key antibiotics based on bacteria ID @@ -409,10 +401,10 @@ first_isolate <- function(tbl, #' @param info print warnings #' @param amcl,amox,cfot,cfta,cftr,cfur,cipr,clar,clin,clox,doxy,gent,line,mero,peni,pita,rifa,teic,trsu,vanc column names of antibiotics, case-insensitive #' @export -#' @importFrom dplyr %>% mutate if_else +#' @importFrom dplyr %>% mutate if_else #' @return Character of length 1. #' @seealso \code{\link{mo_property}} \code{\link{antibiotics}} -#' @examples +#' @examples #' \donttest{ #' #' # set key antibiotics to a new variable #' tbl$keyab <- key_antibiotics(tbl) @@ -440,9 +432,9 @@ key_antibiotics <- function(tbl, teic = 'teic', trsu = 'trsu', vanc = 'vanc') { - + keylist <- character(length = nrow(tbl)) - + # check columns col.list <- c(amox, cfot, cfta, cftr, cfur, cipr, clar, clin, clox, doxy, gent, line, mero, peni, @@ -486,12 +478,12 @@ key_antibiotics <- function(tbl, teic <- col.list[17] trsu <- col.list[18] vanc <- col.list[19] - + # join microorganisms tbl <- tbl %>% left_join_microorganisms(col_bactid) - + tbl$key_ab <- NA_character_ - + # Staphylococcus list_ab <- c(clox, trsu, teic, vanc, doxy, line, clar, rifa) list_ab <- list_ab[list_ab %in% colnames(tbl)] @@ -501,7 +493,7 @@ key_antibiotics <- function(tbl, MARGIN = 1, FUN = function(x) paste(x, collapse = "")), key_ab)) - + # Rest of Gram + list_ab <- c(peni, amox, teic, vanc, clin, line, clar, trsu) list_ab <- list_ab[list_ab %in% colnames(tbl)] @@ -511,7 +503,7 @@ key_antibiotics <- function(tbl, MARGIN = 1, FUN = function(x) paste(x, collapse = "")), key_ab)) - + # Gram - list_ab <- c(amox, amcl, pita, cfur, cfot, cfta, cftr, mero, cipr, trsu, gent) list_ab <- list_ab[list_ab %in% colnames(tbl)] @@ -521,76 +513,76 @@ key_antibiotics <- function(tbl, MARGIN = 1, FUN = function(x) paste(x, collapse = "")), key_ab)) - + # format tbl <- tbl %>% mutate(key_ab = gsub('(NA|NULL)', '-', key_ab) %>% toupper()) - + tbl$key_ab - + } #' @importFrom dplyr progress_estimated %>% #' @noRd key_antibiotics_equal <- function(x, - y, - type = c("keyantibiotics", "points"), + y, + type = c("keyantibiotics", "points"), ignore_I = TRUE, - points_threshold = 2, + points_threshold = 2, info = FALSE) { # x is active row, y is lag type <- type[1] - + if (length(x) != length(y)) { stop('Length of `x` and `y` must be equal.') } - + result <- logical(length(x)) - + if (info == TRUE) { p <- dplyr::progress_estimated(length(x)) } - + for (i in 1:length(x)) { - + if (info == TRUE) { p$tick()$print() } - + if (is.na(x[i])) { x[i] <- '' } if (is.na(y[i])) { y[i] <- '' } - + if (nchar(x[i]) != nchar(y[i])) { - + result[i] <- FALSE - + } else if (x[i] == '' & y[i] == '') { - + result[i] <- TRUE - + } else { - + x2 <- strsplit(x[i], "")[[1]] y2 <- strsplit(y[i], "")[[1]] - + if (type == 'points') { # count points for every single character: # - no change is 0 points # - I <-> S|R is 0.5 point # - S|R <-> R|S is 1 point # use the levels of as.rsi (S = 1, I = 2, R = 3) - + suppressWarnings(x2 <- x2 %>% as.rsi() %>% as.double()) suppressWarnings(y2 <- y2 %>% as.rsi() %>% as.double()) - + points <- (x2 - y2) %>% abs() %>% sum(na.rm = TRUE) result[i] <- ((points / 2) >= points_threshold) - + } else if (type == 'keyantibiotics') { # check if key antibiotics are exactly the same # also possible to ignore I, so only S <-> R and S <-> R are counted @@ -599,15 +591,15 @@ key_antibiotics_equal <- function(x, } else { valid_chars <- c('S', 's', 'I', 'i', 'R', 'r') } - + # remove invalid values (like "-", NA) on both locations x2[which(!x2 %in% valid_chars)] <- '?' x2[which(!y2 %in% valid_chars)] <- '?' y2[which(!x2 %in% valid_chars)] <- '?' y2[which(!y2 %in% valid_chars)] <- '?' - + result[i] <- all(x2 == y2) - + } else { stop('`', type, '` is not a valid value for type, must be "points" or "keyantibiotics". See ?first_isolate.') } @@ -627,7 +619,7 @@ key_antibiotics_equal <- function(x, #' @importFrom dplyr %>% filter slice pull #' @return Character (vector). #' @seealso \code{\link{microorganisms}} for the dataframe that is being used to determine ID's. -#' @examples +#' @examples #' # These examples all return "STAAUR", the ID of S. aureus: #' guess_bactid("stau") #' guess_bactid("STAU") @@ -646,7 +638,7 @@ guess_bactid <- function(x) { # add start and stop x_species <- paste(x, 'species') x <- paste0('^', x, '$') - + for (i in 1:length(x)) { if (tolower(x[i]) == '^e.*coli$') { # avoid detection of Entamoeba coli in case of E. coli @@ -681,7 +673,7 @@ guess_bactid <- function(x) { # let's try the ID's first found <- AMR::microorganisms %>% filter(bactid == x.bak[i]) - + if (nrow(found) == 0) { # now try exact match found <- AMR::microorganisms %>% filter(fullname == x[i]) @@ -709,10 +701,10 @@ guess_bactid <- function(x) { x.bak[i] %>% substr((x_length / 2) + 1, x_length) %>% trimws()) found <- AMR::microorganisms %>% filter(fullname %like% paste0('^', x[i])) } - + if (nrow(found) != 0) { - x[i] <- found %>% - slice(1) %>% + x[i] <- found %>% + slice(1) %>% pull(bactid) } else { x[i] <- "" diff --git a/R/join.R b/R/join.R index 9dfc516b..c22a0953 100644 --- a/R/join.R +++ b/R/join.R @@ -10,12 +10,12 @@ #' @param ... other parameters to pass on to \code{dplyr::\link[dplyr]{join}}. #' @details As opposed to the \code{\link[dplyr]{join}} functions of \code{dplyr}, characters vectors are supported and at default existing columns will get a suffix \code{"2"} and the newly joined columns will not get a suffix. See \code{\link[dplyr]{join}} for more information. #' @export -#' @examples +#' @examples #' left_join_microorganisms("STAAUR") -#' +#' #' library(dplyr) #' septic_patients %>% left_join_microorganisms() -#' +#' #' df <- data.frame(date = seq(from = as.Date("2018-01-01"), #' to = as.Date("2018-01-07"), #' by = 1), diff --git a/man/clipboard.Rd b/man/clipboard.Rd index 15239f67..387a1a3e 100644 --- a/man/clipboard.Rd +++ b/man/clipboard.Rd @@ -41,7 +41,7 @@ clipboard_export(x, sep = "\\t", dec = ".", na = "", header = TRUE, data.frame } \description{ -These are helper functions around \code{\link{read.table}} and \code{\link{write.table}} to import from and export to clipboard. The data will be read and written as tab-separated by default, which makes it possible to copy and paste from other software like Excel and SPSS without further transformation. +These are helper functions around \code{\link{read.table}} and \code{\link{write.table}} to import from and export to clipboard, with support for Windows, Linux and macOS. The data will be read and written as tab-separated by default, which makes it possible to copy and paste from other software like Excel and SPSS without further transformation. } \details{ For \code{clipboard_export}, the reserved clipboard size for exporting will be set automatically to 125\% of the object size of \code{x}. This way, it is possible to export data with thousands of rows as the only limit will be your systems RAM. diff --git a/man/first_isolate.Rd b/man/first_isolate.Rd index 0b11f33c..9fe300a2 100644 --- a/man/first_isolate.Rd +++ b/man/first_isolate.Rd @@ -14,17 +14,17 @@ first_isolate(tbl, col_date, col_patient_id, col_bactid = NA, \arguments{ \item{tbl}{a \code{data.frame} containing isolates.} -\item{col_date}{column name of the result date (or date that is was received on the lab), supports tidyverse-like quotation} +\item{col_date}{column name of the result date (or date that is was received on the lab)} -\item{col_patient_id}{column name of the unique IDs of the patients, supports tidyverse-like quotation} +\item{col_patient_id}{column name of the unique IDs of the patients} -\item{col_bactid}{column name of the unique IDs of the microorganisms (should occur in the \code{\link{microorganisms}} dataset), supports tidyverse-like quotation} +\item{col_bactid}{column name of the unique IDs of the microorganisms (should occur in the \code{\link{microorganisms}} dataset)} \item{col_testcode}{column name of the test codes. Use \code{col_testcode = NA} to \strong{not} exclude certain test codes (like test codes for screening). In that case \code{testcodes_exclude} will be ignored. Supports tidyverse-like quotation.} -\item{col_specimen}{column name of the specimen type or group, supports tidyverse-like quotation} +\item{col_specimen}{column name of the specimen type or group} -\item{col_icu}{column name of the logicals (\code{TRUE}/\code{FALSE}) whether a ward or department is an Intensive Care Unit (ICU), supports tidyverse-like quotation} +\item{col_icu}{column name of the logicals (\code{TRUE}/\code{FALSE}) whether a ward or department is an Intensive Care Unit (ICU)} \item{col_keyantibiotics}{column name of the key antibiotics to determine first \emph{weighted} isolates, see \code{\link{key_antibiotics}}. Supports tidyverse-like quotation.} @@ -46,9 +46,9 @@ first_isolate(tbl, col_date, col_patient_id, col_bactid = NA, \item{info}{print progress} -\item{col_genus}{(deprecated, use \code{col_bactid} instead) column name of the genus of the microorganisms, supports tidyverse-like quotation} +\item{col_genus}{(deprecated, use \code{col_bactid} instead) column name of the genus of the microorganisms} -\item{col_species}{(deprecated, use \code{col_bactid} instead) column name of the species of the microorganisms, supports tidyverse-like quotation} +\item{col_species}{(deprecated, use \code{col_bactid} instead) column name of the species of the microorganisms} } \value{ A vector to add to table, see Examples. @@ -73,12 +73,10 @@ my_patients <- septic_patients library(dplyr) my_patients$first_isolate <- my_patients \%>\% - left_join_microorganisms() \%>\% - first_isolate(col_date = date, - col_patient_id = patient_id, - col_genus = genus, - col_species = species) - + first_isolate(col_date = "date", + col_patient_id = "patient_id", + col_bactid = "bactid") + \dontrun{ # set key antibiotics to a new variable diff --git a/man/septic_patients.Rd b/man/septic_patients.Rd index 8b5176d0..14956c3b 100644 --- a/man/septic_patients.Rd +++ b/man/septic_patients.Rd @@ -38,31 +38,31 @@ my_data <- septic_patients library(dplyr) # Add first isolates to our dataset: -my_data <- my_data \%>\% - mutate(first_isolates = first_isolate(my_data, date, patient_id, bactid)) +my_data <- my_data \%>\% + mutate(first_isolates = first_isolate(my_data, "date", "patient_id", "bactid")) # -------- # # ANALYSIS # # -------- # -# 1. Get the amoxicillin resistance percentages +# 1. Get the amoxicillin resistance percentages # of E. coli, divided by hospital: my_data \%>\% filter(bactid == "ESCCOL", - first_isolates == TRUE) \%>\% - group_by(hospital_id) \%>\% + first_isolates == TRUE) \%>\% + group_by(hospital_id) \%>\% summarise(n = n(), amoxicillin_resistance = rsi(amox)) - - -# 2. Get the amoxicillin/clavulanic acid resistance + + +# 2. Get the amoxicillin/clavulanic acid resistance # percentages of E. coli, trend over the years: -my_data \%>\% +my_data \%>\% filter(bactid == guess_bactid("E. coli"), - first_isolates == TRUE) \%>\% - group_by(year = format(date, "\%Y")) \%>\% + first_isolates == TRUE) \%>\% + group_by(year = format(date, "\%Y")) \%>\% summarise(n = n(), amoxclav_resistance = rsi(amcl, minimum = 20)) } diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf deleted file mode 100644 index 386c286569bd371760beb3e3834de545c8023fb1..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 4854 zcmb7I2{@E(+ZG|yB6}hpA{1sZ#u6nnmMoQhmobLsZOlw&rfg#m+1@N!vqhGAefDe- z2}PEWQnJ6uS_lp0pYgu+_SOG?|NlS7F~>2_`CRvX-S>5$$9Y`mEqwu{s{mDmgQNq; z11AEz1N-bfKu`bz5S@PmX=s4JNDnNUf+G@8XbKjPMXAFeP*sQ$Oa-c4hJKN z1PbGo45;o52b*HaM5+gdF(3S=`IrIU%3*{hxKSL-j9HZ7wmmkjcwTFR^plX`Jp&Ytm@db-s31V;GjrN~v%i7Gl-`Ybu;hocy_S@ik#rJfn^f-SPjyjD96&;viVvE=UrM9B+Nb;t} zv(gMqs+pz5vI|}pQ_cg==$T1EzdmG#=|}}cHIDth8K)sMbQEhf@fH{RN1Uu(ciem4 zFBRdRD)O8lDmL~;kuK?9+b>zIwH7V(V#0fRn&AI0B9Qu}_6--z@dc>#s| zZ^YP%_?a2XYX1jjm>C;3Gnlbd?AgXKTP%0ADX7J`s9|T7N7J~6|}w_4UY+{QhqjpG#1PH zSg=pmBeA_-h?K+1cR56>RZ@L?PZDQDR3|GNcK6yCfM*x{h%Di&F5w*Wt~ir&u4|UWa_~)0-H7rzEo#0V5q|6n^M&{-vt30qL2om46cz;cKvr_E7 z&W>9Y^tk@Od8&44Z);sip;cv(U(X_4<#x$-Ne8E>6H-Et#P5s=7_KtYtC5!*`OLG} zFLc;*vi+CyXX?aXr}g9clL4?H&V>xv0ZiR61(+-`1soVEL!>g)0tSGMu`W2YHqjHX zV=_V+0%!gleh?g{V0@ziL)S27SPEbVW+*Eo57v|700QeW#0JpN0PDg4C{xc&85~gp zpx>1Xtm8@1GovsyRzrh1Gb1~m=wU`eV|EZQ*;G#(P~I8I`1+65F(GDZJMdW~QX5Ui zx&R1fl*2dmWWIgd^ckjJ5tvE9DC|`n2Fsije2$@r;J-A$5k3+c*8Z_Qykwl=(Nhp)pyge}4(SRIeY^h|# z^<5^VbGwC6{Z~l*B8g{RiiAfVdM$OPjfk)NUCylUe&@DC8>nTuxfRU**vOhIU|+U1 z|JZa(cyy$j6X&jdA6VG%ETg3Ia&5s4UDgy<-`7$26uu3i`q~4)=gs4Nr=yx!wlfoI zY$Ty97m}lOZ^qp%-lZyqm9syQS;7ts<{fez@>4d$Z8!c)rN7?r!7h$d>1j11ix+ z$DyxNgl$B}JXl=2w`};m+=a^|Prg=FQ-!!IxHri5`#Wr<#jRgWbPVxd6h?_}G_P6t zrR--Z$-`C-(!<us&N!3(ou!r>Yayr^0aH5^m*S@X4r-}=U1wjAkUUm zLpV4=2i1{h1Q;b&+CAk9XHU@%)!N8R-QaHinmbsNc;n3mPfwyX>s^V%T7F_Ivd4J< zE+3Z@JxjE`t$J*qJ0oADB&Tn72YsbkRU3VMDk$Y2gV965s(DSi=2N$9S>XVSjuzXj zmdFenU*qlvjXc#X+@ox)XJo^7UvYwt2JzqAg#v{511hr)B?J{Y$rNxl9Ij>AkF3fvxx`Bs@a8-U;mT{WE#bklmph$T-4hcc z)b#8FOjTSlsH*W6iOu)mV#xXCq){Gg(CNT@o`8cq>USa`Jc5sPwPQV{xOgP)-{j3@ z#c92{DV8f<6QLiQ|J073Lq`XC!6;#GySTvh@jHpxmf47$dnTM0(hE-YTlCBR2KvNf ztb6%R=Zmfx7K*&OaC)Sou2oiA&ykt(8J<;Dx&TLTHYN%hbI9LF^q4?7Yq@Z_NMDTF zb>Y@1bY7|TAL;|5a}oPnJW8DL&<7x&gFd`I>?dPr!AHj_qz9@O?KRGYpLk+1YD&xx8=X6Y_ge+ea*S|vawU46}vg3MmRSl~RJ*Kp+Kk!?g=$EA&w>R<33%7!subSKckz8z@?TNag|FMwQ@tOXOq9-P{ zcg=Gs=I=v$D_|Cbx@zWXNUw5_$Yu6F_4wsm!pD(gCK0lmvTm{%^N@Szv1T>>)PCJr zn_1QUNTodX9#h=i3gV^U3ORv@h;)MrgA9Y{_A3H%N3um;u+6+*h0)P;D*dE|g2j1@ zhS_5;5id{ND}Fgu;8pPPr9uCjm%9DKg-ZRj{=WXI!fS;ieOkC=T*&3g-{xPa-v3BB z;2zTKCeX?Wfw{S|#sRZxiq9-V5IAt6X&XFH&EQ z(Cg`D9O@hr9PAuL998>2hRQedH#>xW2`!F}igu1d9HI(q!Yq{zK)O^2$_B;onZ<+g69OaBRL{PjClLvQ=0ME z7~5WjV1>O3b@G`u!qzQz?&Y&p^h@r)30ft z^inIjsy?+kFxX@>@B8|*kWijss$pbDj#ul-#>(O8=$hFY5BoWXyM%pJsH%E`={1LI zF+RbYY}_>N488cako-cod(&sS-5duTC5sOfzrwq%8LY_>pSgBce?qTBf5jp<~|C`&0ZINBJyM_X$0t&U-8gB*C&g5pXpLuzPJE${Ar%6+S zr0?`}?PlG|{^`Bb*RBWk1oSLquRo4zPP|SNkKy9pTg>Hu2+e15@WrEmTBm10iR{Ia z^^zTuOQ;mo**o4j0y%tl(sC}gdA23A>0^qVty&!;`oj61P}?vQITLB)`9gI0p&F7# z)2VFLF}mc0j#s3j{DAfChK&v07U|p4db}@gKyN7ASW?Tr&C#{m8*sPMFuxkVsJO_N z!AayK#x1pjr_W2(9J?i>X>iqeI71_4Ji|10*}PHEd~ZfRJ%8YC!@0f2Z!_2AG>_G5 zvL(ePUoqF`$>Z9DRVuB(!pfhQN0jGw+)i4sM@WNsm9fad$g;W?_+WQ`z!OxNBP?|y z(JX%Dn2P$keuhT|gy>W=xNO`ZvrJogi7BVa{JYg_GoFX)A-0HNtb&>Wat^!-~JR9F_`P_1BVD9Zu)e%`M#cr_p zTd}fwGABmwSxnN&r1^&z&{if@ktK#@hPJ}?gAUjWm6fwJs=+7yXe(o%BG-kyH?Qiv z>Wb$-zV5Tkx3IEZClos^b$UOdcX8x|M$nRJYMWvRU6nQePI_(4*_^_P_sxD|e(wXr z*=U_Hot+A)3fLmj{aos@)8nR&5l{cVcdhvQ#QdrxG1f4tFfsqMjfGFmXTp4bFNvw3 zxotSOb5`c$^3B>0tG&F{E4>giCwA(vXGK-p-TVokj-_?+K21xq{hywLT#s+u;mbTX zm3jNrE$Zz1_mh2?dPDD}+cz}HMc{|T5BQ$Jm1*DZ^!MxYr@e+hZI$lr5{hwjahR{2 zBo&ey{jw%FH^tRCj&Pg|6Ah~cpLAFh&QS3kkJ!A`XH{REQ71@R=zY2sJ2q$Xia4xa zEm8lh?(>W#y=c0MOz0l6Aq&x}CNp~LBQ{glMf~7jN*!ha%~P|Q>K~k%f=^14l|&xck& zF6Kv_&-7zk4_Vp#rT2#Zc&G4}i`OAA95ar{U%V@)QlKvH= zkHufbQg9eF2>dN6u(RGDFBNur_5Vi(Mo-P$)=wD}w263^|CGkl1M3Qc08lsx^8Eo2 z%F0U0fGhAFgE6Yfd;r3C42ocwiGRnSFa*P}{DdjN83yMk46efPBtK!w5Qeq*cMJk! zmicE)?N>|%&bTu9DNYskOI|pPv4fxD;4rmc^1_wWe%Kqu1C7IDJs6i$0N4!Yjb+pd p0G}ne5&7R22?aLx7~Eb