1
0
mirror of https://github.com/msberends/AMR.git synced 2024-12-25 18:06:12 +01:00

Try to support older R versions

This commit is contained in:
dr. M.S. (Matthijs) Berends 2018-04-19 12:50:23 +02:00
parent d79132b29f
commit e7396b8f39
7 changed files with 23 additions and 23 deletions

View File

@ -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 -qq update; fi
- if [ $TRAVIS_OS_NAME = linux ]; then sudo apt-get install -y xclip; 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 xclip; fi
- if [ $TRAVIS_OS_NAME = osx ]; then brew install r@3.1.3; fi
# postrun # postrun
after_success: after_success:

View File

@ -1,6 +1,6 @@
Package: AMR Package: AMR
Version: 0.2.0 Version: 0.2.0
Date: 2018-04-18 Date: 2018-04-19
Title: Antimicrobial Resistance Analysis Title: Antimicrobial Resistance Analysis
Authors@R: c( Authors@R: c(
person( person(
@ -25,7 +25,7 @@ Description: Functions to simplify the analysis of Antimicrobial Resistance (AMR
on antibiograms according to Leclercq (2013) on antibiograms according to Leclercq (2013)
<doi:10.1111/j.1469-0691.2011.03703.x>. <doi:10.1111/j.1469-0691.2011.03703.x>.
Depends: Depends:
R (>= 3.1.0) R (>= 3.1.3)
Imports: Imports:
dplyr (>= 0.7.0), dplyr (>= 0.7.0),
data.table (>= 1.10.0), data.table (>= 1.10.0),

View File

@ -9,7 +9,7 @@
* New print format for tibbles and data.tables * New print format for tibbles and data.tables
#### Changed #### 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 `ablist` to `antibiotics`
* Renamed dataset `bactlist` to `microorganisms` * Renamed dataset `bactlist` to `microorganisms`
* Added more microorganisms to `bactlist` * Added more microorganisms to `bactlist`

View File

@ -161,7 +161,7 @@ freq <- function(x,
} }
if (mult.columns > 1) { 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 { } else {
NAs <- x[is.na(x)] NAs <- x[is.na(x)]
} }

View File

@ -49,7 +49,7 @@
percent <- function(x, round = 1, force_zero = FALSE, ...) { percent <- function(x, round = 1, force_zero = FALSE, ...) {
val <- base::round(x * 100, digits = round) val <- base::round(x * 100, digits = round)
if (force_zero & any(val == as.integer(val))) { 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, "%") base::paste0(val, "%")
} }
@ -116,12 +116,13 @@ size_humanreadable <- function(bytes, decimals = 1) {
# Support for older R versions -------------------------------------------- # Support for older R versions --------------------------------------------
# strrep is only available in R 3.3 and later # strrep is only available in R 3.3 and later
strrep <- function(x, times) { strrep2 <- function(x, times) {
for (i in 1:length(x)) { for (i in 1:length(x)) {
x[i] <- paste(rep(x[i], times[i]), collapse = "") x[i] <- paste(rep(x[i], times[i]), collapse = "")
} }
x x
} }
# trimws is only available in R 3.2 and later # trimws is only available in R 3.2 and later
trimws <- function(x, which = "both") { trimws <- function(x, which = "both") {
if (which %in% c("left", "both", "l", "b")) { if (which %in% c("left", "both", "l", "b")) {

View File

@ -190,7 +190,7 @@ prettyprint_df <- function(x,
# extra space of 3 chars, right to row name or number # extra space of 3 chars, right to row name or number
if (NROW(x) > 0) { if (NROW(x) > 0) {
maxrowchars <- rownames(x) %>% nchar() %>% max() + 3 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 { } else {
maxrowchars <- 0 maxrowchars <- 0
} }
@ -203,7 +203,7 @@ prettyprint_df <- function(x,
x <- x %>% filter(row_number() %in% rows_list) x <- x %>% filter(row_number() %in% rows_list)
rownames(x) <- rownames(x.bak)[rows_list] rownames(x) <- rownames(x.bak)[rows_list]
# set inbetweener between parts # set inbetweener between parts
rownames(x)[n / 2 + 1] <- strrep("~", maxrowchars) rownames(x)[n / 2 + 1] <- strrep2("~", maxrowchars)
} }
if (header == TRUE) { if (header == TRUE) {
@ -259,7 +259,7 @@ prettyprint_df <- function(x,
# replace NAs # replace NAs
if (nchar(na) < 2) { if (nchar(na) < 2) {
# make as long as the text "NA" # 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) try(x[, i] <- gsub("^NA$", na, trimws(x[, i], 'both')), silent = TRUE)
# place class into 1st row # place class into 1st row
@ -269,7 +269,7 @@ prettyprint_df <- function(x,
# dashes between two parts when exceeding nmax # dashes between two parts when exceeding nmax
maxvalchars <- max(colnames(x)[i] %>% nchar(), x[, i] %>% nchar() %>% max()) maxvalchars <- max(colnames(x)[i] %>% nchar(), x[, i] %>% nchar() %>% max())
if (n + 1 < nrow(x.bak)) { 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 # 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') vals <- x %>% pull(i) %>% trimws('both')
colname <- colnames(x)[i] %>% trimws('both') colname <- colnames(x)[i] %>% trimws('both')
if (right == FALSE) { if (right == FALSE) {
vals <- paste0(vals, strrep(" ", maxvalchars - nchar(vals))) vals <- paste0(vals, strrep2(" ", maxvalchars - nchar(vals)))
colname <- paste0(colname, strrep(" ", maxvalchars - nchar(colname))) colname <- paste0(colname, strrep2(" ", maxvalchars - nchar(colname)))
} else { } else {
vals <- paste0(strrep(" ", maxvalchars - nchar(vals)), vals) vals <- paste0(strrep2(" ", maxvalchars - nchar(vals)), vals)
colname <- paste0(strrep(" ", maxvalchars - nchar(colname)), colname) colname <- paste0(strrep2(" ", maxvalchars - nchar(colname)), colname)
} }
x[, i] <- vals x[, i] <- vals
colnames(x)[i] <- colname colnames(x)[i] <- colname
@ -291,25 +291,25 @@ prettyprint_df <- function(x,
# add left padding according to `width` parameter # add left padding according to `width` parameter
# but not in 1st col when row names are off # but not in 1st col when row names are off
if (row.names == TRUE | i > 1) { if (row.names == TRUE | i > 1) {
x[, i] <- paste0(strrep(" ", width), x[, i]) x[, i] <- paste0(strrep2(" ", width), x[, i])
colnames(x)[i] <- paste0(strrep(" ", width), colnames(x)[i]) colnames(x)[i] <- paste0(strrep2(" ", width), colnames(x)[i])
} }
# strip columns that do not fit (3 chars as margin) # strip columns that do not fit (3 chars as margin)
width_console <- options()$width width_console <- options()$width
width_until_col <- x %>% width_until_col <- x %>%
select(1:i) %>% select(1:i) %>%
apply(1, paste, collapse = strrep(" ", width + 1)) %>% apply(1, paste, collapse = strrep2(" ", width + 1)) %>%
nchar() %>% nchar() %>%
max() max()
width_until_col_before <- x %>% width_until_col_before <- x %>%
select(1:(max(i, 2) - 1)) %>% select(1:(max(i, 2) - 1)) %>%
apply(1, paste, collapse = strrep(" ", width + 1)) %>% apply(1, paste, collapse = strrep2(" ", width + 1)) %>%
nchar() %>% nchar() %>%
max() max()
extraspace <- maxrowchars + nchar(rownames(x)[length(rownames(x))]) 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 <- colnames(x)[1:i] %>% paste0(collapse = strrep2(" ", 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_before <- colnames(x)[1:(max(i, 2) - 1)] %>% paste0(collapse = strrep2(" ", width + 1)) %>% nchar() + extraspace
if (i > 1 & if (i > 1 &
(width_until_col > width_console (width_until_col > width_console

View File

@ -19,8 +19,8 @@ test_that("size format works", {
}) })
test_that("functions missing in older R versions work", { test_that("functions missing in older R versions work", {
expect_equal(strrep("A", 5), "AAAAA") expect_equal(strrep2("A", 5), "AAAAA")
expect_equal(strrep(c("A", "B"), c(5, 2)), c("AAAAA", "BB")) expect_equal(strrep2(c("A", "B"), c(5, 2)), c("AAAAA", "BB"))
expect_equal(trimws(" test "), "test") expect_equal(trimws(" test "), "test")
expect_equal(trimws(" test ", "l"), "test ") expect_equal(trimws(" test ", "l"), "test ")
expect_equal(trimws(" test ", "r"), " test") expect_equal(trimws(" test ", "r"), " test")