1
0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 16:42:10 +02:00

clipboard update

This commit is contained in:
2018-07-23 15:09:19 +02:00
parent 8421638b60
commit 03a3cb397b
3 changed files with 24 additions and 7 deletions

View File

@ -14,6 +14,7 @@
#' @param startrow \emph{n}th row to start importing from. When \code{header = TRUE}, the import will start on row \code{startrow} \emph{below} the header.
#' @param as_vector a logical value indicating whether data consisting of only one column should be imported as vector using \code{\link[dplyr]{pull}}. This will strip off the header.
#' @param guess_col_types a logical value indicating whether column types should be guessed and transformed automatically with \code{\link[readr]{parse_guess}} from the \code{readr} package. Besides, the antimicrobial classes in this AMR package (\code{\link{as.rsi}} and \code{\link{as.mic}}) are also supported.
#' @param remove_ASCII_escape_char remove ASCII escape character
#' @param info print info to console
#' @keywords clipboard clipboard_import clipboard_export import export
#' @importFrom dplyr %>% pull as_tibble
@ -58,6 +59,7 @@
#' clipboard_export()
#' }
clipboard_import <- function(sep = '\t',
quote = "",
header = TRUE,
dec = ".",
na = c("", "NA", "NULL"),
@ -68,6 +70,7 @@ clipboard_import <- function(sep = '\t',
date_names = 'en',
date_format = '%Y-%m-%d',
time_format = '%H:%M',
remove_ASCII_escape_char = FALSE,
tz = Sys.timezone(),
encoding = "UTF-8",
info = TRUE) {
@ -80,6 +83,7 @@ clipboard_import <- function(sep = '\t',
# this will fail when clipr is (still) not available
import_tbl <- clipr::read_clip_tbl(file = file,
sep = sep,
quote = quote,
header = header,
strip.white = TRUE,
dec = dec,
@ -108,6 +112,7 @@ clipboard_import <- function(sep = '\t',
decimal_mark = dec,
tz = tz,
encoding = encoding,
remove_ASCII_escape_char = remove_ASCII_escape_char,
na = na)
if (info == TRUE) {
cat('OK\n')

View File

@ -119,6 +119,7 @@ tbl_parse_guess <- function(tbl,
decimal_mark = '.',
tz = Sys.timezone(),
encoding = "UTF-8",
remove_ASCII_escape_char = FALSE,
na = c("", "NA", "NULL")) {
date_format <- date_generic(date_format)
@ -139,8 +140,10 @@ tbl_parse_guess <- function(tbl,
if (any(tbl %>% pull(i) %>% class() %in% c('factor', 'character'))) {
# get values
distinct_val <- tbl %>% pull(i) %>% unique() %>% sort()
# remove ASCII escape character: https://en.wikipedia.org/wiki/Escape_character#ASCII_escape_character
tbl[, i] <- tbl %>% pull(i) %>% gsub('\033', ' ', ., fixed = TRUE)
if (remove_ASCII_escape_char == TRUE) {
# remove ASCII escape character: https://en.wikipedia.org/wiki/Escape_character#ASCII_escape_character
tbl[, i] <- tbl %>% pull(i) %>% gsub('\033', ' ', ., fixed = TRUE)
}
# look for RSI, shouldn't all be "" and must be valid antibiotic interpretations
if (!all(distinct_val[!is.na(distinct_val)] == '')
& all(distinct_val[!is.na(distinct_val)] %in% c('', 'I', 'I;I', 'R', 'R;R', 'S', 'S;S'))) {