R/make_flextable_grouped.R

In cadenceinc/FlextableExtended: Flextable Wrapper

#' Make Grouped 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_grouped_flextable <- function(df,
                                   flex_group,
                                   col_names   = names(df),
                                   font_size   = 12,
                                   width       = 12,
                                   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 <- as_flextable(as_grouped_data(df, flex_group))
  
  ## flextable data
  df     <- rslt$body$dataset
  nc     <- numeric_cols(df)[!numeric_cols(df) %in% flex_group]
  non_nc <- non_numeric_cols(df)[!non_numeric_cols(df) %in% flex_group]
  n_rows <- nrow(df)
  n_keys <- length(rslt$col_keys)
  gr     <- which(!is.na(rslt$body$dataset[[flex_group]]))
  
  ## column names
  col_names <- col_names[!col_names %in% flex_group]
  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")
  }
  rslt <- align(rslt, i = gr, align = "center")
  
  ## bold
  if (!is.null(bold_rows)) rslt <- bold(rslt, i = bold_rows)
  rslt <- bold(rslt, i = gr)
  
  ## adjust grouped text
  grp_c <- rslt$body$dataset[gr, flex_group]
  rslt  <- compose(rslt, i = gr, value = as_paragraph(as_chunk(grp_c)))
  
  ## 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, width)
  rslt <- width(rslt, width = width / n_keys)
  
  ## height
  rslt <- height(rslt, height = (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
}