#' 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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.