fix clipboard on linux

This commit is contained in:
dr. M.S. (Matthijs) Berends 2018-04-02 11:11:21 +02:00
parent abcb4accbd
commit c182a9673d
12 changed files with 181 additions and 176 deletions

1
.gitignore vendored
View File

@ -3,3 +3,4 @@
.RData .RData
.Ruserdata .Ruserdata
AMR.Rproj AMR.Rproj
tests/testthat/Rplots.pdf

View File

@ -3,15 +3,9 @@
# Setting up R deps # Setting up R deps
language: r language: r
r: 3.2 r: 3.2
r_packages: r_packages: covr
- covr
- testthat
- dplyr
- rvest
- xml2
- reshape2
# system deps # system deps, install xclip for clipboard support
os: os:
- linux - linux
- osx - osx

View File

@ -1,6 +1,6 @@
Package: AMR Package: AMR
Version: 0.1.2 Version: 0.1.2
Date: 2018-03-27 Date: 2018-04-02
Title: Antimicrobial Resistance Analysis Title: Antimicrobial Resistance Analysis
Authors@R: c( Authors@R: c(
person( person(

View File

@ -30,15 +30,27 @@ clipboard_import <- function(sep = '\t',
on.exit(close(file)) on.exit(close(file))
} }
import_tbl <- read.delim(file = file, import_tbl <- tryCatch(read.delim(file = file,
sep = sep, sep = sep,
header = header, header = header,
strip.white = TRUE, strip.white = TRUE,
dec = dec, dec = dec,
na.strings = na, na.strings = na,
fileEncoding = 'UTF-8', fileEncoding = 'UTF-8',
encoding = 'UTF-8', encoding = 'UTF-8',
stringsAsFactors = FALSE) 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 # use tibble, so column types will be translated correctly
import_tbl <- as_tibble(import_tbl) import_tbl <- as_tibble(import_tbl)
@ -86,18 +98,22 @@ clipboard_export <- function(x,
on.exit(close(file)) on.exit(close(file))
} }
write.table(x = x, tryCatch(write.table(x = x,
file = file, file = file,
sep = sep, sep = sep,
na = na, na = na,
row.names = FALSE, row.names = FALSE,
col.names = header, col.names = header,
dec = dec, dec = dec,
quote = FALSE) quote = FALSE),
error = function(e) {
FALSE
})
if (info == TRUE) { if (info == TRUE) {
cat("Successfully exported to clipboard:", NROW(x), "obs. of", NCOL(x), "variables.\n") cat("Successfully exported to clipboard:", NROW(x), "obs. of", NCOL(x), "variables.\n")
} }
} }
is_Windows <- function() { is_Windows <- function() {
@ -105,6 +121,10 @@ is_Windows <- function() {
} }
check_xclip <- function() { check_xclip <- function() {
if (!isTRUE(file.exists(Sys.which("xclip")[1L]))) { if (!isTRUE(file.exists(Sys.which("xclip")[1L]))) {
if (Sys.info()['sysname'] %like% "Linux") {
stop("Please install Linux package xclip first.") stop("Please install Linux package xclip first.")
} else {
stop("Please install package xclip first (use `brew install xclip on macOS`).")
}
} }
} }

View File

@ -125,7 +125,7 @@
#' #'
#' # Add first isolates to our dataset: #' # Add first isolates to our dataset:
#' my_data <- my_data %>% #' my_data <- my_data %>%
#' mutate(first_isolates = first_isolate(my_data, date, patient_id, bactid)) #' mutate(first_isolates = first_isolate(my_data, "date", "patient_id", "bactid"))
#' #'
#' # -------- # #' # -------- #
#' # ANALYSIS # #' # ANALYSIS #

View File

@ -20,12 +20,12 @@
#' #'
#' 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 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_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, supports tidyverse-like quotation #' @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), supports tidyverse-like quotation #' @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_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_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), 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)
#' @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 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 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) #' @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 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 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 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_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, supports tidyverse-like quotation #' @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 #' @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}. #' 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}.
#' #'
@ -57,11 +57,9 @@
#' #'
#' library(dplyr) #' library(dplyr)
#' my_patients$first_isolate <- my_patients %>% #' my_patients$first_isolate <- my_patients %>%
#' left_join_microorganisms() %>% #' first_isolate(col_date = "date",
#' first_isolate(col_date = date, #' col_patient_id = "patient_id",
#' col_patient_id = patient_id, #' col_bactid = "bactid")
#' col_genus = genus,
#' col_species = species)
#' #'
#' \dontrun{ #' \dontrun{
#' #'
@ -122,16 +120,10 @@ first_isolate <- function(tbl,
col_genus = NA, col_genus = NA,
col_species = NA) { col_species = NA) {
# support tidyverse-like quotation # bactid OR genus+species must be available
# col_date <- quasiquotate(deparse(substitute(col_date)), col_date) if (is.na(col_bactid) & (is.na(col_genus) | is.na(col_species))) {
# col_patient_id <- quasiquotate(deparse(substitute(col_patient_id)), col_patient_id) stop('`col_bactid or both `col_genus` and `col_species` must be available.')
# 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)
# check if columns exist # check if columns exist
check_columns_existance <- function(column, tblname = tbl) { check_columns_existance <- function(column, tblname = tbl) {
@ -141,7 +133,7 @@ first_isolate <- function(tbl,
if (!is.na(column)) { if (!is.na(column)) {
if (!(column %in% colnames(tblname))) { if (!(column %in% colnames(tblname))) {
stop('Column ', column, ' not found.') stop('Column `', column, '` not found.')
} }
} }
} }
@ -156,7 +148,7 @@ first_isolate <- function(tbl,
check_columns_existance(col_keyantibiotics) check_columns_existance(col_keyantibiotics)
if (!is.na(col_bactid)) { if (!is.na(col_bactid)) {
tbl <- tbl %>% left_join_microorganisms() tbl <- tbl %>% left_join_microorganisms(by = col_bactid)
col_genus <- "genus" col_genus <- "genus"
col_species <- "species" col_species <- "species"
} }

View File

@ -41,7 +41,7 @@ clipboard_export(x, sep = "\\t", dec = ".", na = "", header = TRUE,
data.frame data.frame
} }
\description{ \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{ \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. 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.

View File

@ -14,17 +14,17 @@ first_isolate(tbl, col_date, col_patient_id, col_bactid = NA,
\arguments{ \arguments{
\item{tbl}{a \code{data.frame} containing isolates.} \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_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.} \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{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{ \value{
A vector to add to table, see Examples. A vector to add to table, see Examples.
@ -73,11 +73,9 @@ my_patients <- septic_patients
library(dplyr) library(dplyr)
my_patients$first_isolate <- my_patients \%>\% my_patients$first_isolate <- my_patients \%>\%
left_join_microorganisms() \%>\% first_isolate(col_date = "date",
first_isolate(col_date = date, col_patient_id = "patient_id",
col_patient_id = patient_id, col_bactid = "bactid")
col_genus = genus,
col_species = species)
\dontrun{ \dontrun{

View File

@ -39,7 +39,7 @@ library(dplyr)
# Add first isolates to our dataset: # Add first isolates to our dataset:
my_data <- my_data \%>\% my_data <- my_data \%>\%
mutate(first_isolates = first_isolate(my_data, date, patient_id, bactid)) mutate(first_isolates = first_isolate(my_data, "date", "patient_id", "bactid"))
# -------- # # -------- #
# ANALYSIS # # ANALYSIS #

Binary file not shown.

View File

@ -1,9 +1,9 @@
context("clipboard.R") context("clipboard.R")
test_that("clipboard works", { test_that("clipboard works", {
skip_on_os(c("linux", "solaris"))
t1 <<- AMR::antibiotics # why is the <<- needed? Won't work without it... t1 <<- AMR::antibiotics # why is the <<- needed? Won't work without it...
clipboard_export(t1, info = FALSE) clipboard_export(t1, info = FALSE)
t2 <- clipboard_import() t2 <- clipboard_import()
skip_if(is.null(t1) | is.null(t2), message = "No clipboard content found: skipping.")
expect_equal(t1, t2) expect_equal(t1, t2)
}) })