Introduction
This article describes how to go from a summary table...
...to a customized table with conditional formatting:
Requirements
A SUMMARY table with a single column and statistic.
Method
1. Select your table.
2. Copy the table name from Properties > GENERAL > Name.
3. Select Calculation > Custom Code.
4. Go to Properties > R CODE in the object inspector.
5. Paste the below CustomTable function into your output to adjust fonts, font colors, lines, shading, and the border:
library(RColorBrewer)
CustomTable <- function(x,
year,
as.percent = TRUE,
hide.values = FALSE,
values.width = 90,
scale.min = NULL,
scale.max = NULL,
heatmap = FALSE,
cell.colors = colorRampPalette(brewer.pal(9,"Blues"))(101),
font.colors = c(rep("blue", 76), rep("white", 25)))
{
categories <- rownames(x)
values = unname(x)
# Scaling the input values to be in [1, 2, 3, ..., n.color]
n.colors = length(cell.colors)
if (is.null(scale.min))
scale.min = min(values)
if (is.null(scale.max))
scale.max = max(values)
scaled.values = round((values - scale.min) / (scale.max - scale.min) * (n.colors - 1), 0) + 1
if (as.percent)
values <- flipFormat::FormatAsPercent(values / 100, decimals = 0)
if (hide.values)
values <- rep("", length(values))
# Heatmap formatting of cells
n = length(values)
# Creating the CSS
cell.shading = paste0('td.cell', 1:n, ' {}')
print(scaled.values)
print(cell.colors[scaled.values])
if (heatmap)
cell.shading = paste0('td.cell', 1:n, ' {background-color: ', cell.colors[scaled.values], '; color: ', font.colors[scaled.values], ';}')
cell.shading = paste0(cell.shading, collapse = '')
print(cell.shading)
.cell <- function(category, year, value, i)
{
paste0('<tr>
<td>', category, '</td>
<td class = "center">', year, '</td>
<td class = "right cell', i, '";>', value, '</td>
</tr>')
}
cells = paste0(.cell(categories, year, values, 1:n), collapse = "")
html = paste0('<!DOCTYPE html>
<html>
<head>
<style>
h1 {
font-size: 20;
font-family: verdana;
font-weight: 100;
line-height: 70%;
color: #444444;
margin-top: 20px;
text-indent: 5px;
align: left;
}
h2 {
font-size: 14px;
font-family: verdana;
font-weight: 200;
line-height: 60%;
color: #444444;
margin-top: 10px;
text-indent: 5px
}}
p {}
.table-caption-div {
display: inline-block;
}
table {
border-color: #3E7DCC;
border-style: solid;
background-color: #efefef;
margin-left: 0px;
width: auto;
padding: 6px;
display: inline-block;
border-collapse: collapse;
table-layout: fixed
}
caption { display: inline-block;
text-align:left}
td {
width: 80px;
height: 45px;
font-family: verdana;
color: grey;
font-size: 12px;
font-weight: 100;
border-top: 2px solid #dddddd;
border-bottom: 2px solid #dddddd;
text-indent: 5px;
}
td.center {
width: 90px;
text-align: center;
}
td.right {
width: ', values.width, 'px;
border-left: 1px solid #dddddd;
border-right: 1px solid #dddddd;
text-align: right;
padding-right: 50px;
}
', cell.shading, '
td.no-left {
border-top: none
}
</style>
</head>
<body>
<table >
<caption class="table-caption-div">
<h1>Age</h1>
<h2>How old are you?</h2>
</caption>',
cells,
'</table>
</body>
</html>')
rhtmlMetro::Box(text = html, text.as.html = TRUE)}
6. Add a line that uses this function and references the name of the table (from step 2), the year, whether you want it to display as a percentage and whether you want it to display as a heatmap:
CustomTable(table.Age, year = 2020, as.percent = TRUE, heatmap = TRUE)
See Also
How to Create a Heatmap using R and HTML