R/utils.R

Defines functions validate_header non_numeric_cols numeric_cols

numeric_cols <- function(x) {
  names(x)[sapply(x, function(cols) is.numeric(cols))]
}

non_numeric_cols <- function(x) {
  names(x)[sapply(x, function(cols) !is.numeric(cols))]
}

validate_header <- function(header, flextable) {
  n_keys <- length(flextable$col_keys)
  
  if (!is.list(header)) stop("Header must be a list.")
  
  is_named <- lapply(header, function(x) !is.null(names(x)))
  is_named <- all(is_named == TRUE)
  if (!is_named) stop("Each item in the header list must be named.")
  
  nms_numeric <- lapply(header, function(x) all(grepl("[0-9]", names(x))))
  nms_numeric <- all(nms_numeric == TRUE)
  if (!nms_numeric) stop("Header names must be numeric values.")
  
  col_total <- lapply(header, function(x) sum(as.numeric(names(x))))
  col_total <- lapply(col_total, function(x) x == n_keys)
  col_total <- all(col_total == TRUE)
  if (!col_total) stop("Each header name must be one or more numeric values 
                     whose sum == ncol(flextable).")
}
cadenceinc/FlextableExtended documentation built on May 28, 2020, 12:49 a.m.