R/recolor_rank.R

In greatgray/scorecard: GGCM Model Performance Scorecard

#' Recolors a scorecard table grid by setting every cell
#' containing the value of \code{1} to the given color.
#' This is useful for highlighting the \code{rank} columns.
#' @param table the table grid to modify
#' @param sdf scorecard data frame
#' @param cell_fill the cell fill color to apply to matches
#' @param cell_fg the cell foreground color
#' @param cell_alpha the cell alpha color adjustment
#' @return the modified table grid
#' @note Does not color the first match, which presumably
#' is the model row index counter.
#' @seealso grid::gpar, tableGrid
recolor_rank <- function(table,
                         sdf,
                         cell_fill,
                         cell_fg = "black",
                         cell_alpha = 1) {
  if (nrow(sdf) > 0) {
    indices <- which(sdf == 1, arr.ind = TRUE)
    if ( nrow(indices) < 2 ) {
      return(table)
    }
    for (i in 2:nrow(indices)) {
      row <- as.numeric(indices[i, 1]) + 2
      col <- as.numeric(indices[i, 2])
      fc <- find_cell(table, row, col, "core-bg")
      if ( ! is.null(fc) ) {
        table$grobs[fc][[1]][["gp"]] <- grid::gpar(fill = cell_fill,
                                                   alpha = cell_alpha)
      }
      fc <- find_cell(table, row, col, "core-fg")
      if ( ! is.null(fc) ) {
        table$grobs[fc][[1]]$gp$col <- cell_fg
      }
    }
  }
  return(table)
}