From e7396b8f392fb33498ee97cf4b850f73a7c2ae39 Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Thu, 19 Apr 2018 12:50:23 +0200 Subject: [PATCH] Try to support older R versions --- .travis.yml | 1 - DESCRIPTION | 4 ++-- NEWS.md | 2 +- R/freq.R | 2 +- R/misc.R | 5 +++-- R/print.R | 28 ++++++++++++++-------------- tests/testthat/test-misc.R | 4 ++-- 7 files changed, 23 insertions(+), 23 deletions(-) diff --git a/.travis.yml b/.travis.yml index 36321cc8..abee0789 100644 --- a/.travis.yml +++ b/.travis.yml @@ -16,7 +16,6 @@ before_install: - if [ $TRAVIS_OS_NAME = linux ]; then sudo apt-get -qq update; fi - if [ $TRAVIS_OS_NAME = linux ]; then sudo apt-get install -y xclip; fi - if [ $TRAVIS_OS_NAME = osx ]; then brew install xclip; fi - - if [ $TRAVIS_OS_NAME = osx ]; then brew install r@3.1.3; fi # postrun after_success: diff --git a/DESCRIPTION b/DESCRIPTION index 917405b5..9248ea7e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR Version: 0.2.0 -Date: 2018-04-18 +Date: 2018-04-19 Title: Antimicrobial Resistance Analysis Authors@R: c( person( @@ -25,7 +25,7 @@ Description: Functions to simplify the analysis of Antimicrobial Resistance (AMR on antibiograms according to Leclercq (2013) . Depends: - R (>= 3.1.0) + R (>= 3.1.3) Imports: dplyr (>= 0.7.0), data.table (>= 1.10.0), diff --git a/NEWS.md b/NEWS.md index 66ee0641..05bdb219 100644 --- a/NEWS.md +++ b/NEWS.md @@ -9,7 +9,7 @@ * New print format for tibbles and data.tables #### Changed -* Support for older R versions, only R 3.1.0 and later is needed +* Support for older R versions, only R 3.1.3 or later is needed * Renamed dataset `ablist` to `antibiotics` * Renamed dataset `bactlist` to `microorganisms` * Added more microorganisms to `bactlist` diff --git a/R/freq.R b/R/freq.R index 2a43de5d..c8578f6a 100644 --- a/R/freq.R +++ b/R/freq.R @@ -161,7 +161,7 @@ freq <- function(x, } if (mult.columns > 1) { - NAs <- x[is.na(x) | x == trimws(AMR:::strrep('NA ', mult.columns))] + NAs <- x[is.na(x) | x == trimws(strrep2('NA ', mult.columns))] } else { NAs <- x[is.na(x)] } diff --git a/R/misc.R b/R/misc.R index 75b5f19f..c8e133f1 100644 --- a/R/misc.R +++ b/R/misc.R @@ -49,7 +49,7 @@ percent <- function(x, round = 1, force_zero = FALSE, ...) { val <- base::round(x * 100, digits = round) if (force_zero & any(val == as.integer(val))) { - val[val == as.integer(val)] <- paste0(val[val == as.integer(val)], ".", base::strrep(0, round)) + val[val == as.integer(val)] <- paste0(val[val == as.integer(val)], ".", strrep2(0, round)) } base::paste0(val, "%") } @@ -116,12 +116,13 @@ size_humanreadable <- function(bytes, decimals = 1) { # Support for older R versions -------------------------------------------- # strrep is only available in R 3.3 and later -strrep <- function(x, times) { +strrep2 <- function(x, times) { for (i in 1:length(x)) { x[i] <- paste(rep(x[i], times[i]), collapse = "") } x } + # trimws is only available in R 3.2 and later trimws <- function(x, which = "both") { if (which %in% c("left", "both", "l", "b")) { diff --git a/R/print.R b/R/print.R index 6cdb68d9..2978c15e 100644 --- a/R/print.R +++ b/R/print.R @@ -190,7 +190,7 @@ prettyprint_df <- function(x, # extra space of 3 chars, right to row name or number if (NROW(x) > 0) { maxrowchars <- rownames(x) %>% nchar() %>% max() + 3 - rownames(x) <- paste0(rownames(x), strrep(" ", maxrowchars - nchar(rownames(x)))) + rownames(x) <- paste0(rownames(x), strrep2(" ", maxrowchars - nchar(rownames(x)))) } else { maxrowchars <- 0 } @@ -203,7 +203,7 @@ prettyprint_df <- function(x, x <- x %>% filter(row_number() %in% rows_list) rownames(x) <- rownames(x.bak)[rows_list] # set inbetweener between parts - rownames(x)[n / 2 + 1] <- strrep("~", maxrowchars) + rownames(x)[n / 2 + 1] <- strrep2("~", maxrowchars) } if (header == TRUE) { @@ -259,7 +259,7 @@ prettyprint_df <- function(x, # replace NAs if (nchar(na) < 2) { # make as long as the text "NA" - na <- paste0(na, strrep(" ", 2 - nchar(na))) + na <- paste0(na, strrep2(" ", 2 - nchar(na))) } try(x[, i] <- gsub("^NA$", na, trimws(x[, i], 'both')), silent = TRUE) # place class into 1st row @@ -269,7 +269,7 @@ prettyprint_df <- function(x, # dashes between two parts when exceeding nmax maxvalchars <- max(colnames(x)[i] %>% nchar(), x[, i] %>% nchar() %>% max()) if (n + 1 < nrow(x.bak)) { - x[n / 2 + if_else(header == TRUE, 2, 1), i] <- strrep("~", maxvalchars) + x[n / 2 + if_else(header == TRUE, 2, 1), i] <- strrep2("~", maxvalchars) } # align according to `right` parameter, but only factors and text, but not MICs @@ -278,11 +278,11 @@ prettyprint_df <- function(x, vals <- x %>% pull(i) %>% trimws('both') colname <- colnames(x)[i] %>% trimws('both') if (right == FALSE) { - vals <- paste0(vals, strrep(" ", maxvalchars - nchar(vals))) - colname <- paste0(colname, strrep(" ", maxvalchars - nchar(colname))) + vals <- paste0(vals, strrep2(" ", maxvalchars - nchar(vals))) + colname <- paste0(colname, strrep2(" ", maxvalchars - nchar(colname))) } else { - vals <- paste0(strrep(" ", maxvalchars - nchar(vals)), vals) - colname <- paste0(strrep(" ", maxvalchars - nchar(colname)), colname) + vals <- paste0(strrep2(" ", maxvalchars - nchar(vals)), vals) + colname <- paste0(strrep2(" ", maxvalchars - nchar(colname)), colname) } x[, i] <- vals colnames(x)[i] <- colname @@ -291,25 +291,25 @@ prettyprint_df <- function(x, # add left padding according to `width` parameter # but not in 1st col when row names are off if (row.names == TRUE | i > 1) { - x[, i] <- paste0(strrep(" ", width), x[, i]) - colnames(x)[i] <- paste0(strrep(" ", width), colnames(x)[i]) + x[, i] <- paste0(strrep2(" ", width), x[, i]) + colnames(x)[i] <- paste0(strrep2(" ", width), colnames(x)[i]) } # strip columns that do not fit (3 chars as margin) width_console <- options()$width width_until_col <- x %>% select(1:i) %>% - apply(1, paste, collapse = strrep(" ", width + 1)) %>% + apply(1, paste, collapse = strrep2(" ", width + 1)) %>% nchar() %>% max() width_until_col_before <- x %>% select(1:(max(i, 2) - 1)) %>% - apply(1, paste, collapse = strrep(" ", width + 1)) %>% + apply(1, paste, collapse = strrep2(" ", width + 1)) %>% nchar() %>% max() extraspace <- maxrowchars + nchar(rownames(x)[length(rownames(x))]) - width_until_colnames <- colnames(x)[1:i] %>% paste0(collapse = strrep(" ", width + 1)) %>% nchar() + extraspace - width_until_colnames_before <- colnames(x)[1:(max(i, 2) - 1)] %>% paste0(collapse = strrep(" ", width + 1)) %>% nchar() + extraspace + width_until_colnames <- colnames(x)[1:i] %>% paste0(collapse = strrep2(" ", width + 1)) %>% nchar() + extraspace + width_until_colnames_before <- colnames(x)[1:(max(i, 2) - 1)] %>% paste0(collapse = strrep2(" ", width + 1)) %>% nchar() + extraspace if (i > 1 & (width_until_col > width_console diff --git a/tests/testthat/test-misc.R b/tests/testthat/test-misc.R index 30792859..bce8a885 100644 --- a/tests/testthat/test-misc.R +++ b/tests/testthat/test-misc.R @@ -19,8 +19,8 @@ test_that("size format works", { }) test_that("functions missing in older R versions work", { - expect_equal(strrep("A", 5), "AAAAA") - expect_equal(strrep(c("A", "B"), c(5, 2)), c("AAAAA", "BB")) + expect_equal(strrep2("A", 5), "AAAAA") + expect_equal(strrep2(c("A", "B"), c(5, 2)), c("AAAAA", "BB")) expect_equal(trimws(" test "), "test") expect_equal(trimws(" test ", "l"), "test ") expect_equal(trimws(" test ", "r"), " test")