From 8a1d384d9c2d579b5cd20685c9b9640be414ed11 Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Tue, 26 Mar 2019 15:34:04 +0100 Subject: [PATCH] ci fixes --- R/availability.R | 62 ++++++++++++++++++++++---------- docs/reference/availability.html | 10 ++++-- man/availability.Rd | 6 ++-- tests/testthat/test-mo_history.R | 2 +- 4 files changed, 56 insertions(+), 24 deletions(-) diff --git a/R/availability.R b/R/availability.R index d3fc71b1..17b620a7 100644 --- a/R/availability.R +++ b/R/availability.R @@ -23,7 +23,8 @@ #' #' Easy check for availability of columns in a data set. This makes it easy to get an idea of which antibiotic combination can be used for calculation with e.g. \code{\link{portion_IR}}. #' @param tbl a \code{data.frame} or \code{list} -#' @return \code{data.frame} with column names of \code{tbl} as row names and columns: \code{percent_IR}, \code{count}, \code{percent}, \code{visual_availability}. +#' @param width number of characters to present the visual availability, defaults to filling the width of the console +#' @return \code{data.frame} with column names of \code{tbl} as row names #' @inheritSection AMR Read more on our website! #' @export #' @examples @@ -40,23 +41,48 @@ #' filter(mo == as.mo("E. coli")) %>% #' select_if(is.rsi) %>% #' availability() -availability <- function(tbl) { +availability <- function(tbl, width = NULL) { x <- base::sapply(tbl, function(x) { 1 - base::sum(base::is.na(x)) / base::length(x) }) n <- base::sapply(tbl, function(x) base::length(x[!base::is.na(x)])) - IR <- base::sapply(tbl, function(x) base::ifelse(is.rsi(x), base::round(portion_IR(x, minimum = 0) * 100, 1), "NaN")) - IR <- paste0(IR, "%") - IR <- gsub("NaN%", "", IR) - max_chars <- 50 - x_chars <- strrep("#", round(x, digits = 2) / (1 / max_chars)) - x_chars_empty <- strrep("-", max_chars - nchar(x_chars)) - # x_abnames <- character(length(x)) - # for (i in 1:length(x)) { - # if (tbl %>% pull(i) %>% is.rsi()) { - # x_abnames[i] <- atc_name(colnames(tbl)[i]) - # } - # } - data.frame(percent_IR = IR, - count = n, - percent = paste0(round(x * 100, 1), "%"), - visual_availabilty = paste0("|", x_chars, x_chars_empty, "|")) + IR <- base::sapply(tbl, function(x) base::ifelse(is.rsi(x), portion_IR(x, minimum = 0), NA)) + IR_print <- character(length(IR)) + IR_print[!is.na(IR)] <- percent(IR[!is.na(IR)], round = 1, force_zero = TRUE) + IR_print[is.na(IR)] <- "" + + if (is.null(width)) { + width <- options()$width - + (max(nchar(colnames(tbl))) + + # count col + 8 + + # available % column + 10 + + # resistant % column + 10 + + # extra margin + 5) + width <- width / 2 + } + + if (length(IR[is.na(IR)]) == ncol(tbl)) { + width <- width * 2 + 10 + } + + x_chars_IR <- strrep("#", round(width * IR, digits = 2)) + x_chars_S <- strrep("-", width - nchar(x_chars_IR)) + vis_resistance <- paste0("|", x_chars_IR, x_chars_S, "|") + vis_resistance[is.na(IR)] <- "" + + x_chars <- strrep("#", round(x, digits = 2) / (1 / width)) + x_chars_empty <- strrep("-", width - nchar(x_chars)) + + df <- data.frame(count = n, + available = percent(x, round = 1, force_zero = TRUE), + visual_availabilty = paste0("|", x_chars, x_chars_empty, "|"), + resistant = IR_print, + visual_resistance = vis_resistance) + if (length(IR[is.na(IR)]) == ncol(tbl)) { + df[,1:3] + } else { + df + } } diff --git a/docs/reference/availability.html b/docs/reference/availability.html index a3bf3b4c..08bb4863 100644 --- a/docs/reference/availability.html +++ b/docs/reference/availability.html @@ -80,7 +80,7 @@ AMR (for R) - 0.5.0.9023 + 0.5.0.9025 @@ -241,7 +241,7 @@ - 
availability(tbl)
+ 
availability(tbl, width = NULL)

Arguments

@@ -250,11 +250,15 @@ + + + +
tbl

a data.frame or list
width

number of characters to present the visual availability, defaults to filling the width of the console

Value

-

data.frame with column names of tbl as row names and columns: percent_IR, count, percent, visual_availability.

+

data.frame with column names of tbl as row names

Read more on our website!

diff --git a/man/availability.Rd b/man/availability.Rd index e6258aae..e50b02bb 100644 --- a/man/availability.Rd +++ b/man/availability.Rd @@ -4,13 +4,15 @@ \alias{availability} \title{Check availability of columns} \usage{ -availability(tbl) +availability(tbl, width = NULL) } \arguments{ \item{tbl}{a \code{data.frame} or \code{list}} + +\item{width}{number of characters to present the visual availability, defaults to filling the width of the console} } \value{ -\code{data.frame} with column names of \code{tbl} as row names and columns: \code{percent_IR}, \code{count}, \code{percent}, \code{visual_availability}. +\code{data.frame} with column names of \code{tbl} as row names } \description{ Easy check for availability of columns in a data set. This makes it easy to get an idea of which antibiotic combination can be used for calculation with e.g. \code{\link{portion_IR}}. diff --git a/tests/testthat/test-mo_history.R b/tests/testthat/test-mo_history.R index 1cf799e1..bf93955f 100644 --- a/tests/testthat/test-mo_history.R +++ b/tests/testthat/test-mo_history.R @@ -37,7 +37,7 @@ test_that("mo_history works", { force = TRUE), "B_ESCHR_COL") - expect_equal(as.character(as.mo("testsubject", allow_uncertain = TRUE)), "B_ESCHR_COL") + expect_equal(as.character(as.mo("testsubject", force_mo_history = TRUE)), "B_ESCHR_COL") expect_equal(colnames(read_mo_history(force = TRUE)), c("x", "mo", "uncertainty_level", "package_version"))