R/make_flextable.R

In cadenceinc/FlextableExtended: Flextable Wrapper

#' Make Flextable
#'
#' @param df data.frame to convert to flextable
#' @param col_names
#' @param font_size 
#' @param max_width 
#' @param max_height 
#' @param header 
#' @param center_cols 
#' @param br 
#' @param ir 
#' @param indent_cols 
#' @param v_line_cols 
#' @param merge_hor 
#' @param merge_ver 
#'
#' @return flextable object
#' @export
#'
make_flextable <- function(df,
                           col_names   = names(df),
                           font_size   = 12,
                           max_width   = 12,
                           max_height  = 6,
                           header      = NULL,
                           center_cols = NULL,
                           bold_rows   = NULL,
                           v_line_cols = NULL,
                           indent_rows = NULL,
                           indent_cols = 1,
                           merge_hor   = FALSE,
                           merge_ver   = FALSE) {
  rslt <- flextable(df)
  
  ## flextable data
  nc     <- numeric_cols(df)
  non_nc <- non_numeric_cols(df)
  n_rows <- nrow(df)
  n_keys <- length(rslt$col_keys)
  
  ## column names
  rslt <- set_header_labels(rslt, values = setNames(col_names, rslt$col_keys))
  
  ## header
  if (!is.null(header)) {
    validate_header(header, rslt)
    for (i in header) {
      w <- as.numeric(names(i))
      rslt <- add_header_row(rslt, values = i, colwidths = w)
    }
  }
  rslt <- align(rslt, align = "center", part = "header")
  rslt <- bold(rslt, part = "header")
  rslt <- merge_h(rslt, part = "header")
  rslt <- height(rslt, height = .1, part = "header")
  
  ## font size
  rslt <- fontsize(rslt, size = font_size, part = "all")
  
  ## align
  rslt <- align(rslt, j = nc, align = "right")
  rslt <- align(rslt, j = non_nc, align = "left")
  if (!is.null(center_cols)) {
    rslt <- align(rslt, j = center_cols, align = "center")
  }
  
  ## bold
  if (!is.null(bold_rows)) rslt <- flextable::bold(rslt, i = bold_rows)
  
  ## indent
  if (!is.null(indent_rows)) 
    rslt <- padding(rslt, indent_rows, indent_cols, padding.left = 20)
  
  ## merge
  if (merge_ver) rslt <- merge_v(rslt)
  if (merge_hor) rslt <- merge_h(rslt)
  
  ## width
  rslt <- fit_to_width(rslt, max_width)
  rslt <- width(rslt, width = max_width / n_keys)
  
  ## height
  rslt <- height(rslt, height = (max_height - 1) / n_rows)
  
  ## vline
  if (!is.null(v_line_cols)) {
    rslt <- vline(rslt, j = v_line_cols, border = fp_border(width = 3))
  }
  
  ## border
  rslt <- border_remove(rslt)
  rslt <- border(rslt, border = fp_border(), part = "all")
  rslt <- border(rslt, border = fp_border(width = 3), part = "header")
  rslt <- border_outer(rslt, border = fp_border(width = 3))
  rslt <- fix_border_issues(rslt)
  rslt
}