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