R/reports.R

In leonawicz/apputils: Supporting Functions For Shiny Apps Development

#' Convert stat box groups output to list of data frames
#'
#' Convert stat box groups output to list of data frames for reuse in other contexts,
#' typically in reports generated by \code{rmarkdown} and \code{knitr}.
#'
#' @param d data frame to use for generating stat box groups.
#' @param grp character or \code{NULL}, factor variable (column name) in \code{d}
#' used to determine the number of groups of stat box sets.
#' @param rnd numeric, number of decimal places to round values to.
#'
#' @return a list of data frames.
#' @export
#'
#' @examples
#' #not run
sbg_to_tables <- function (d, grp, rnd=0){
  id <- c("annual", "decadal")
  clr <- !is.null(grp)
  x <- purrr::map(id, ~stat_boxes_group(
    d, grp, rnd = rnd, type = .x, prevent = FALSE, output = "list")) %>%
    purrr::map(~dplyr::tbl_df(data.frame(do.call(rbind, .x), stringsAsFactors = FALSE)))
  if (clr){
    lev <- levels(d[[grp]]) # nolint
    nam <- purrr::map(x, ~c("ColorBy", names(.x)))
    x <- purrr::map2(x, nam, ~dplyr::mutate(.x, ColorBy = factor(lev, levels = lev)) %>%
                       dplyr::select_(.dots=.y))
    names(x[[1]])[1] <- names(x[[2]])[1] <- grp
    names(x[[1]])[6+1] <- "SD"
    names(x[[2]])[-1] <- gsub("\\.", " ", names(x[[2]]))[-1]
    names(x[[2]])[6+1] <- "Percent change"
  } else {
    names(x[[1]])[6] <- "SD"
    names(x[[2]]) <- gsub("\\.", " ", names(x[[2]]))
    names(x[[2]])[6] <- "Percent change"
  }
  names(x) <- id
  x
}

#' Create sensible readable string from a vector
#'
#' Create a string from a vector for printing where vector elements
#' are sensibly pasted together, collapsing using commas and \code{'and'} to conjoin vector elements.
#'
#' @param x character.
#'
#' @return character.
#' @export
#'
#' @examples
#' pasteByLength(c("a", "b", "c"))
pasteByLength <- function(x){
  if(length(x)==1) return(x)
  if(length(x)==2) return(paste(x, collapse=" and "))
  n <- length(x)
  paste(c(paste(x[1:(n-1)], collapse=", "), x[n]), collapse=" and ")
}