<p><div><div><div><div data-width="100" data-show-faces="false" data-send="true" data-layout="button_count" data-height="21" data-href="https://www.r-bloggers.com/conditional-formatting-of-a-table-in-r/"></div></div><div><a data-url="https://www.r-bloggers.com/conditional-formatting-of-a-table-in-r/" data-counturl="https://www.r-bloggers.com/conditional-formatting-of-a-table-in-r/" data-count="horizontal" data-text="Conditional Formatting of a Table in R" class="twitter-share-button" data-via="rbloggers" href="https://twitter.com/share"></a></div><div></div></div><div></div></div>
<div>
(This article was first published on <strong><a href="http://labrtorian.com/2016/11/07/conditional-formatting-of-a-table-in-r/"> The Lab-R-torian</a></strong>, and kindly contributed to <a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers)</a> </div>
<h2>Background</h2>
<p>There are a few ways to approach the problem of a conditionally formatted table in R. You can use the <a target="_blank" rel="nofollow" href="http://davidgohel.github.io/ReporteRs/"> ReporteRs</a> package's <code>FlexTable()</code> function, the <a target="_blank" rel="nofollow" href="https://renkun.me/formattable/"> formattable </a> package, or the <a target="_blank" rel="nofollow" href="https://cran.r-project.org/web/packages/condformat/index.html"> condformat </a> package. These allow you to produce a conditionally formatted tables in HTML. You can also use <a target="_blank" rel="nofollow" href="https://cran.r-project.org/web/packages/xtable/index.html"> xtable </a> package and essentially program what you want in LaTeX via the <code>xtable()</code> function. </p>
<p>In my desire for something simple-ish, I am going do this graphically using the <code>image()</code> function as suggested <a target="_blank" rel="nofollow" href="http://stackoverflow.com/questions/7828256/conditional-formatting-making-cells-colorful"> here</a>. The benefit is that I can then push the table into an RMarkdown generated PDF document easily.</p>
<h2>The Problem</h2>
<p>Suppose that you want to prepare a summary of how resident and medical student orders are placed on various wards. You obtain data that is formatted in the following manner. </p>

<pre>head(orders,10)</pre>

<pre>##    ward order.type cosigned
## 1   Med       CPOE     TRUE
## 2   Med    Written    FALSE
## 3   Med       CPOE     TRUE
## 4   Med    Written     TRUE
## 5   Med    Written     TRUE
## 6   Med    Written     TRUE
## 7   Med       CPOE     TRUE
## 8   Med       CPOE    FALSE
## 9   Med       CPOE     TRUE
## 10  Med       CPOE     TRUE</pre>

<p>There are 4 wards: medicine, surgery, ER and orthopedics. Orders can come in as computerized physician order entry (CPOE), verbal or written. The orders have to be cosigned by staff and this is recorded as TRUE/FALSE because staff are not always compliant in logging on to the EMR to cosign the trainee orders.</p>

<pre>str(orders)</pre>

<pre>## 'data.frame':    550 obs. of  3 variables:
##  $ ward      : Factor w/ 4 levels &quot;Med&quot;,&quot;Surg&quot;,&quot;ER&quot;,..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ order.type: Factor w/ 3 levels &quot;CPOE&quot;,&quot;Verbal&quot;,..: 1 3 1 3 3 3 1 1 1 1 ...
##  $ cosigned  : logi  TRUE FALSE TRUE TRUE TRUE TRUE ...</pre>

<pre>summary(orders)</pre>

<pre>##    ward       order.type   cosigned      
##  Med :150   CPOE   :291   Mode :logical  
##  Surg:100   Verbal : 54   FALSE:195      
##  ER  :200   Written:205   TRUE :355      
##  Orth:100                 NA's :0</pre>

<h2>Preparing Proportions Table</h2>
<p>Let's start with the assumption that we want to apply the <em>same</em> conditional formatting to all data in the table. That is, we want to color code all results with the same algorithm. We can used the <code>image()</code> function to get this done. Let's display the rates at which different order types (CPOE, verbal,or written) from the four wards. We can generate the proportions table in percent very easily with the <code>prop.table()</code> and <code>table()</code> functions operating on the first two columns of our <code>orders</code> data:</p>

<pre>my.data &lt;- round(prop.table(table(orders[,1:2]),1)*100,1)
my.data</pre>

<pre>##       order.type
## ward   CPOE Verbal Written
##   Med  49.3    8.7    42.0
##   Surg 30.0    4.0    66.0
##   ER   89.5    7.0     3.5
##   Orth  8.0   23.0    69.0</pre>

<h2>A DIY Approach with the Image Function</h2>
<p>The <code>image()</code> function produces a tile plot based on matrix of z values, where z = f(x,y) using colours we can define and thresholds for switching from one colour to the next based on a <code>breaks</code> parameter. In our case, we will say that if the result is less than equal to 25%, we will colour the tile blue, if it is greater than 25% but less than or equal to 50%, we will colour it red, and if it greater than 50%, it will be yellow.</p>
<p>You will note that we have to transpose the data with the <code>t()</code> function because the image function plots the rows on the x axis on the columns on the y axis. You will also notice that we need to plot y descending on the y-axis to account for the fact that our tabular data has increasing index going <em>down</em> but the tile plot will default to have increasing y going <em>up</em>. We can also need to suppress the axes and their labels. The reader can comment out the lines <code>xaxt = 'n'</code> and <code>yaxt = 'n'</code> to see what is going on in terms of x and y values.</p>

<pre>x = 1:ncol(my.data)
y = 1:nrow(my.data)
centers &lt;- expand.grid(y,x)

#make the plot margins a little bigger
par(mar = c(2,7,4,2))

image(x, y, t(my.data),
      col = c(rgb(0,0,1,0.3),rgb(1,0,0,0.3), rgb(1,1,0,0.3)),
      breaks = c(0, 25, 50, 100),
      xaxt = 'n', 
      yaxt = 'n', 
      xlab = '', 
      ylab = '',
      ylim = c(max(y) + 0.5, min(y) - 0.5)
      )</pre>

<p><img alt="plot of chunk unnamed-chunk-5" src="https://i1.wp.com/labrtorian.com/wp-content/uploads/2016/11/unnamed-chunk-5-1.png?w=604" data-recalc-dims="1"></p>
<p>Now we can write our values over top with the <code>text()</code> function.</p>

<pre>text(centers[,2], centers[,1], c(my.data), col= &quot;black&quot;)</pre>

<p><img alt="plot of chunk unnamed-chunk-7" src="https://i0.wp.com/labrtorian.com/wp-content/uploads/2016/11/unnamed-chunk-7-1.png?w=604" data-recalc-dims="1"></p>
<p>And then we can write the variable names (which we yank from the attributes of the table) into the figure margin and draw some lines to make it look pretty. It was necessary to use the <code>adj</code> and <code>padj</code> parameters to make it look a little cleaner.</p>

<pre>#add margin text
mtext(paste(attributes(my.data)$dimnames[[2]],&quot;(%)&quot;), at=1:ncol(my.data), padj = -1)
mtext(attributes(my.data)$dimnames[[1]], at=1:nrow(my.data), side = 2, las = 1, adj = 1.2)

#add black lines
abline(h=y + 0.5)
abline(v=x + 0.5)</pre>

<p><img alt="plot of chunk unnamed-chunk-9" src="https://i0.wp.com/labrtorian.com/wp-content/uploads/2016/11/unnamed-chunk-9-1.png?w=604" data-recalc-dims="1"></p>
<h2>Conditionally Coloured Text</h2>
<p>Now, if you want to make the text colour match the background colour, we will need a little function.</p>

<pre>color.picker &lt;- function(z){
  if(z &lt;= 25){return(&quot;blue&quot;)}
  else if( z > 25 &amp; z &lt;= 50){return(&quot;red&quot;)}
  else {return(&quot;darkorange4&quot;)}
}</pre>

<p>and then apply it over the values of the matrix:</p>

<pre>text.cols &lt;- sapply(c(my.data), color.picker)
text(centers[,2], centers[,1], c(my.data), col= text.cols)</pre>

<p><img alt="plot of chunk unnamed-chunk-12" src="https://i2.wp.com/labrtorian.com/wp-content/uploads/2016/11/unnamed-chunk-12-1.png?w=604" data-recalc-dims="1"></p>
<h2>Different Conditions for Different Columns</h2>
<p>Now suppose you wanted different conditional formatting for each column. This is kind of a pain because you will need to provide the <code>image()</code> function a matrix to generate an appropriate fill-colour and a different matrix for the data to be written in each cell. Let's imagine for example that we want to include the compliance rate for co-signing in a fourth column and this is the <em>only</em> column we want coloured. To this column we want a colour scheme applied wherein if compliance is less than or equal to 20%, the colour is red, between 20% and 80%, it is yellow, and above 80% it is green. </p>
<p>We can calculate a proportions table based on columns 1 and 3 of the <code>orders</code> dataframe and then we can define a matrix <code>fill.data</code> that has <code>NA</code> on all the rates we calculated above.</p>

<pre>my.data &lt;- cbind(my.data,Cosigned = round(prop.table(table(orders[,c(1,3)]),1)*100,1)[,2])
fill.data &lt;- my.data
fill.data[,1:3] &lt;- matrix(NA, nrow = nrow(my.data), ncol = ncol(my.data) - 1)</pre>

<p>Now the proportions matrix is as follows:</p>

<pre>my.data</pre>

<pre>##      CPOE Verbal Written Cosigned
## Med  49.3    8.7    42.0     75.3
## Surg 30.0    4.0    66.0     52.0
## ER   89.5    7.0     3.5     88.5
## Orth  8.0   23.0    69.0     13.0</pre>

<p>and the fill data is:</p>

<pre>fill.data</pre>

<pre>##      CPOE Verbal Written Cosigned
## Med    NA     NA      NA     75.3
## Surg   NA     NA      NA     52.0
## ER     NA     NA      NA     88.5
## Orth   NA     NA      NA     13.0</pre>

<p>Now we can apply the <code>image()</code> function to the <code>fill.data</code> matrix. When it comes to writing the data in the cells, we will use the original <code>my.data</code> matrix and we will adjust out <code>color.picker()</code> function.</p>

<pre>color.picker &lt;- function(z){
  if(is.na(z)){return(&quot;black&quot;)}
  else if(z &lt;= 20){return(&quot;red&quot;)}
  else if( z > 20 &amp; z &lt;= 80){return(&quot;darkorange4&quot;)}
  else {return(&quot;darkgreen&quot;)}
}

x = 1:ncol(my.data)
y = 1:nrow(my.data)
centers &lt;- expand.grid(y,x)

par(mar = c(2,7,4,2))
image(x, y, t(fill.data),
      col = c(rgb(1,0,0,0.3),rgb(1,1,0,0.3), rgb(0,1,0,0.3)),
      breaks = c(0, 20, 80, 100),
      xaxt='n', 
      yaxt='n', 
      xlab='', 
      ylab='',
      ylim = c(max(y) + 0.5, min(y) - 0.5)
)

#write in values
text.cols &lt;- sapply(c(fill.data), color.picker)
text(centers[,2], centers[,1], format(c(my.data),nsmall = 1), col= text.cols)

#add margin text
mtext(paste(attributes(my.data)$dimnames[[2]],&quot;(%)&quot;), at=1:ncol(my.data), padj = -1)
mtext(attributes(my.data)$dimnames[[1]], at=1:nrow(my.data), side = 2, las = 1, adj = 1.2)

#add black lines
abline(h=y + 0.5)
abline(v=x + 0.5)</pre>

<p><img alt="plot of chunk unnamed-chunk-16" src="https://i1.wp.com/labrtorian.com/wp-content/uploads/2016/11/unnamed-chunk-16-1.png?w=604" data-recalc-dims="1"></p>
<p>So, it looks like this could become super–awkward if we had elaborate conditions to apply. This is where a packages like condformat and formattable come in handy. If you use the condformat package, you can include the table in an RMarkdown generated PDF or HTML document. However, the <code>formattable()</code> function, though capable of much prettier output, does not work with PDFs generated using RMarkdown. </p>
<p>First, here is a condformat example. Suppose we wanted to colourized CPOE in shades of green because CPOE is more operationally desirable and verbal/written orders in shades of red because they are less operationally desirable. We also want the red/yellow/green formatting in the Cosigned column. Using condformat we could do the following: </p>

<pre>library(condformat)

my.data &lt;- as.data.frame(my.data)

color.picker &lt;- function(z){
  if(is.na(z)){return(0)}
  else if(z &lt;= 20){return(1)}
  else if( z > 20 &amp; z &lt;= 80){return(2)}
  else {return(3)}
}

condformat(my.data) +
rule_fill_gradient(CPOE, low = rgb(1,1,1), high = rgb(0,1,0)) +
rule_fill_gradient(Verbal, low = rgb(1,1,1), high = rgb(1,0,0)) +
rule_fill_gradient(Written, low = rgb(1,1,1), high = rgb(1,0,0)) +
rule_fill_discrete(Cosigned, expression = sapply(Cosigned,
       color.picker),colours=c(&quot;0&quot; = &quot;white&quot;, &quot;1&quot; = &quot;red&quot;, 
       &quot;2&quot; =  &quot;yellow&quot;, &quot;3&quot; = &quot;lightgreen&quot;))</pre>

<table>
<thead>
<tr>
<th> </th>
<th>CPOE</th>
<th>Verbal</th>
<th>Written</th>
<th>Cosigned</th>
</tr>
</thead>
<tbody>
<tr>
<td>1</td>
<td>49.3</td>
<td> 8.7</td>
<td>42.0</td>
<td>75.3</td>
</tr>
<tr>
<td>2</td>
<td>30.0</td>
<td> 4.0</td>
<td>66.0</td>
<td>52.0</td>
</tr>
<tr>
<td>3</td>
<td>89.5</td>
<td> 7.0</td>
<td> 3.5</td>
<td>88.5</td>
</tr>
<tr>
<td>4</td>
<td> 8.0</td>
<td>23.0</td>
<td>69.0</td>
<td>13.0</td>
</tr>
</tbody>
</table>
<p>You can see that the rownames are suppressed with <code>condformat()</code>. You could circumvent this by putting the rownames into their own column. This package is pretty easy to use and with PDF rendering (shown below) it produces something more LaTeX-ish than what is shown above which was generated straight to HTML.</p>
<p><img title="plot of chunk unnamed-chunk-18" alt="plot of chunk unnamed-chunk-18" src="https://i0.wp.com/labrtorian.com/wp-content/uploads/2016/11/condformat_latex.png?w=400" data-recalc-dims="1"></p>
<p>For something more attractive looking, here is an example of something similar using the formattable package (borrowing heavily from the code author's <a target="_blank" rel="nofollow" href="https://renkun.me/formattable/"> examples </a>):</p>

<pre>library(formattable)

color.picker &lt;- function(z){
  if(is.na(z)){return(&quot;black&quot;)}
  else if(z &lt;= 20){return(&quot;red&quot;)}
  else if( z > 20 &amp; z &lt;= 80){return(&quot;darkorange&quot;)}
  else {return(&quot;darkgreen&quot;)}
}

bg.picker &lt;- function(z){
  if(is.na(z)){return(&quot;black&quot;)}
  else if(z &lt;= 20){return(&quot;pink&quot;)}
  else if( z > 20 &amp; z &lt;= 80){return(&quot;yellow&quot;)}
  else {return(&quot;lightgreen&quot;)}
}

my.data &lt;- as.data.frame(my.data)

formattable(my.data, list(
  CPOE = color_tile(&quot;white&quot;, &quot;green&quot;),
  Verbal = color_tile(&quot;white&quot;, &quot;red&quot;),
  Written = color_tile(&quot;white&quot;, &quot;red&quot;),
  Cosigned = formatter(&quot;span&quot;,
       style = x ~ style(display = &quot;block&quot;,
       &quot;border-radius&quot; = &quot;4px&quot;,
       &quot;padding-right&quot; = &quot;4px&quot;,
       color = sapply(x,color.picker),
       &quot;background-color&quot; = sapply(x,bg.picker)),
       x ~ sprintf(&quot;%.2f (rank: %02d)&quot;, x, rank(-x)))
))</pre>

<table>
<thead>
<tr>
<th> </th>
<th> CPOE </th>
<th> Verbal </th>
<th> Written </th>
<th> Cosigned </th>
</tr>
</thead>
<tbody>
<tr>
<td> Med </td>
<td> <span>49.3</span> </td>
<td> <span>8.7</span> </td>
<td> <span>42.0</span> </td>
<td> <span>75.30 (rank: 02)</span> </td>
</tr>
<tr>
<td> Surg </td>
<td> <span>30.0</span> </td>
<td> <span>4.0</span> </td>
<td> <span>66.0</span> </td>
<td> <span>52.00 (rank: 03)</span> </td>
</tr>
<tr>
<td> ER </td>
<td> <span>89.5</span> </td>
<td> <span>7.0</span> </td>
<td> <span>3.5</span> </td>
<td> <span>88.50 (rank: 01)</span> </td>
</tr>
<tr>
<td> Orth </td>
<td> <span>8.0</span> </td>
<td> <span>23.0</span> </td>
<td> <span>69.0</span> </td>
<td> <span>13.00 (rank: 04)</span> </td>
</tr>
</tbody>
</table>
<p>I hope that this points you in the right direction.</p>
<p><br>
<br>
<strong>And as for conditions:</strong></p>
<p>“If you declare with your mouth, “Jesus is Lord,” and believe in your heart that God raised him from the dead, you will be saved.” </p>
<p>Romans 10:9</p>
<p><div><div><div><div data-width="55" data-show-faces="false" data-send="true" data-layout="box_count" data-height="62" data-href="https://www.r-bloggers.com/conditional-formatting-of-a-table-in-r/"></div></div><div><a data-url="https://www.r-bloggers.com/conditional-formatting-of-a-table-in-r/" data-counturl="https://www.r-bloggers.com/conditional-formatting-of-a-table-in-r/" data-count="vertical" data-text="Conditional Formatting of a Table in R" class="twitter-share-button" data-via="rbloggers" href="https://twitter.com/share"></a></div><div></div></div><div></div></div>
<div>
<div>To <strong>leave a comment</strong> for the author, please follow the link and comment on their blog: <strong><a href="http://labrtorian.com/2016/11/07/conditional-formatting-of-a-table-in-r/"> The Lab-R-torian</a></strong>.</div>
<hr>
<a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers.com</a> offers <strong><a rel="nofollow" href="https://feedburner.google.com/fb/a/mailverify?uri=RBloggers">daily e-mail updates</a></strong> about <a title="The R Project for Statistical Computing" rel="nofollow" href="https://www.r-project.org/">R</a> news and <a title="R tutorials" rel="nofollow" href="https://www.r-bloggers.com/?s=tutorial">tutorials</a> on topics such as: <a title="Data science" rel="nofollow" href="https://www.r-bloggers.com/?s=data%20science">Data science</a>, <a title="Big Data" rel="nofollow" href="https://www.r-bloggers.com/?s=Big%20Data">Big Data, <a title="R jobs" rel="nofollow" href="https://www.r-users.com/">R jobs</a>, visualization (<a title="ggplot and ggplot2 tutorials" rel="nofollow" href="https://www.r-bloggers.com/?s=ggplot2">ggplot2</a>, <a title="Boxplots using lattice and ggplot2 tutorials" rel="nofollow" href="https://www.r-bloggers.com/?s=boxplot">Boxplots</a>, <a title="Maps and gis" rel="nofollow" href="https://www.r-bloggers.com/?s=map">maps</a>, <a title="Animation in R" rel="nofollow" href="https://www.r-bloggers.com/?s=animation">animation</a>), programming (<a title="RStudio IDE for R" rel="nofollow" href="https://www.r-bloggers.com/?s=RStudio">RStudio</a>, <a title="Sweave and literate programming" rel="nofollow" href="https://www.r-bloggers.com/?s=sweave">Sweave</a>, <a title="LaTeX in R" rel="nofollow" href="https://www.r-bloggers.com/?s=LaTeX">LaTeX</a>, <a title="SQL and databases" rel="nofollow" href="https://www.r-bloggers.com/?s=SQL">SQL</a>, <a title="Eclipse IDE for R" rel="nofollow" href="https://www.r-bloggers.com/?s=eclipse">Eclipse</a>, <a title="git and github, Version Control System" rel="nofollow" href="https://www.r-bloggers.com/?s=git">git</a>, <a title="Large data in R using Hadoop" rel="nofollow" href="https://www.r-bloggers.com/?s=hadoop">hadoop</a>, <a title="Web Scraping of google, facebook, yahoo, twitter and more using R" rel="nofollow" href="https://www.r-bloggers.com/?s=Web+Scraping">Web Scraping</a>) statistics (<a title="Regressions and ANOVA analysis tutorials" rel="nofollow" href="https://www.r-bloggers.com/?s=regression">regression</a>, <a title="principal component analysis tutorial" rel="nofollow" href="https://www.r-bloggers.com/?s=PCA">PCA</a>, <a title="Time series" rel="nofollow" href="https://www.r-bloggers.com/?s=time+series">time series</a>, <a title="finance trading" rel="nofollow" href="https://www.r-bloggers.com/?s=trading">trading</a>) and more...
<img height="1" alt="" width="1" src="http://feeds.feedburner.com/~r/RBloggers/~4/bpVdvLsW4Go"></a></div>