ci fixes

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
+  }
 }

docs/reference/availability.html

@@ -80,7 +80,7 @@
       </button>
       <span class="navbar-brand">
         <a class="navbar-link" href="../index.html">AMR (for R)</a>
-        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Released version">0.5.0.9023</span>
+        <span class="version label label-default" data-toggle="tooltip" data-placement="bottom" title="Released version">0.5.0.9025</span>
       </span>
     </div>
 
@@ -241,7 +241,7 @@
     
     </div>
 
-    <pre class="usage"><span class='fu'>availability</span>(<span class='no'>tbl</span>)</pre>
+    <pre class="usage"><span class='fu'>availability</span>(<span class='no'>tbl</span>, <span class='kw'>width</span> <span class='kw'>=</span> <span class='kw'>NULL</span>)</pre>
     
     <h2 class="hasAnchor" id="arguments"><a class="anchor" href="#arguments"></a>Arguments</h2>
     <table class="ref-arguments">
@@ -250,11 +250,15 @@
       <th>tbl</th>
       <td><p>a <code>data.frame</code> or <code>list</code></p></td>
     </tr>
+    <tr>
+      <th>width</th>
+      <td><p>number of characters to present the visual availability, defaults to filling the width of the console</p></td>
+    </tr>
     </table>
     
     <h2 class="hasAnchor" id="value"><a class="anchor" href="#value"></a>Value</h2>
 
-    <p><code>data.frame</code> with column names of <code>tbl</code> as row names and columns: <code>percent_IR</code>, <code>count</code>, <code>percent</code>, <code>visual_availability</code>.</p>
+    <p><code>data.frame</code> with column names of <code>tbl</code> as row names</p>
     
     <h2 class="hasAnchor" id="read-more-on-our-website-"><a class="anchor" href="#read-more-on-our-website-"></a>Read more on our website!</h2>
 

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}}.

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"))