formattable as an htmlwidget-蒲公英云

Kent Russell

2015-06-12

formattable was originally designed to offer additional formatting to the markdowngenerated by the deliberately sparse knitr::kable. This design limited formattable to only the context of an Rmarkdown document. Other contexts, such as the R console or RStudio IDE, would only see the much less attractive character markdown output.

library(formattable)
as.character(formattable(head(mtcars,3)))
## [1] "|              |  mpg| cyl| disp|  hp| drat|    wt|  qsec| vs| am| gear| carb|"
## [2] "|:-------------|----:|---:|----:|---:|----:|-----:|-----:|--:|--:|----:|----:|"
## [3] "|Mazda RX4     | 21.0|   6|  160| 110| 3.90| 2.620| 16.46|  0|  1|    4|    4|"
## [4] "|Mazda RX4 Wag | 21.0|   6|  160| 110| 3.90| 2.875| 17.02|  0|  1|    4|    4|"
## [5] "|Datsun 710    | 22.8|   4|  108|  93| 3.85| 2.320| 18.61|  1|  1|    4|    1|"

Fortunately, a new function as.htmlwidget uses markdown to easily convert aformattable object to an htmlwidget. Once converted to an htmlwidget, a user in these other contexts can leverage the infrastructure of htmlwidgets to benefit from the finalHTML output of formattable.

Demonstration of conversion

note, please run these in an ?interactive environment such as the console or RStudio IDE to see the difference

Let’s explicitly convert a formattable to an htmlwidget to help us understand what is happening.

as.htmlwidget( formattable( head(mtcars,3) ) )

	mpg	cyl	disp	hp	drat	wt	qsec	vs	am	gear	carb
Mazda RX4	21.0	6	160	110	3.90	2.620	16.46	0	1	4	4
Mazda RX4 Wag	21.0	6	160	110	3.90	2.875	17.02	0	1	4	4
Datsun 710	22.8	4	108	93	3.85	2.320	18.61	1	1	4	1

Although our htmlwidget version looks virtually the same when generated from a Rmddocument such as this vignette, a user in the console will have a noticeably different experience than before. The function interactive() can help formattable to guess when it should automatically convert to a htmlwidget. formattable will not auto-convert in the special situation where format = "pandoc" as shown below.

formattable( head(mtcars,3), format = "pandoc" )
## 
## 
##                   mpg   cyl   disp    hp   drat      wt    qsec   vs   am   gear   carb
## --------------  -----  ----  -----  ----  -----  ------  ------  ---  ---  -----  -----
## Mazda RX4        21.0     6    160   110   3.90   2.620   16.46    0    1      4      4
## Mazda RX4 Wag    21.0     6    160   110   3.90   2.875   17.02    0    1      4      4
## Datsun 710       22.8     4    108    93   3.85   2.320   18.61    1    1      4      1

If you prefer to avoid the automatic conversion to an htmlwidget, useas.character(formattable(...)).

As an additional example, we can recreate the example from Tristan Mahr(@tjmahr)with formattable.

## use formattable to recreate the example in
## https://rpubs.com/tjmahr/prettytables_2015
library("magrittr")
library("dplyr")
## Warning: package 'dplyr' was built under R version 3.1.3
library("broom")
library("stringr")
library("knitr")
fix_names <- . %>%
 str_replace(".Intercept.", "Intercept") %>%
 str_replace("Species", "") %>%
 # Capitalize species names
 str_replace("setosa", "Setosa") %>%
 str_replace("versicolor", "Versicolor") %>%
 str_replace("virginica", "Virginica") %>%
 # Clean up special characters
 str_replace_all(".Width", " Width") %>%
 str_replace_all(".Length", " Length") %>%
 str_replace_all(":", " x ")
# Print with n digits of precision
fixed_digits <- function(xs, n = 2) {
  formatC(xs, digits = n, format = "f")
}
# Don't print leading zero on bounded numbers.
remove_leading_zero <- function(xs) {
  # Problem if any value is greater than 1.0
  digit_matters <- xs %>% as.numeric %>%
 abs %>% is_greater_than(1)
  if (any(digit_matters)) {
    warning("Non-zero leading digit")
  }
  str_replace(xs, "^(-?)0", "\\1")
}
lm(Sepal.Length ~ Species * Sepal.Width, iris) %>%
 tidy %>%
 set_colnames( c("Param", "Estimate", "SE", "_t_", "_p_") ) %>%
 mutate( Param = fix_names( Param ) ) %>%
 formattable(
    list(
      "_p_" = formatter(
        "span"
        ,style = x ~ ifelse( x < 0.05, style( color = "red", font.weight = "bold" ), NA )
        ,ps ~ {
          tiny <- "< .001"
          ps_chr <- ps %>% fixed_digits(3) %>%
 remove_leading_zero
          ps_chr[ps < 0.001] <- tiny
          ps_chr
        }
      )
    )
    ,digits=2
  )

Param	Estimate	SE	t	p
Intercept	2.64	0.57	4.62	< .001
Versicolor	0.90	0.80	1.13	.261
Virginica	1.27	0.82	1.55	.123
Sepal Width	0.69	0.17	4.17	< .001
Versicolor x Sepal Width	0.17	0.26	0.67	.503
Virginica x Sepal Width	0.21	0.26	0.83	.411

htmlwidgets inside a formattable

Courtesy of this issue we have an interesting example of interactive sparklinehtmlwidgets inside a formattable. ** note: only works in Rmd currently **

# use builtin chickwts ?chickwts
library(dplyr)
library(formattable)
# devtools::install_github( "htmlwidgets/sparkline" )
library(sparkline)
chickwts %>%
 group_by( feed ) %>%
 summarise(
    weight = sprintf("`r sparkline(c(%s), type = 'box')`", paste0(weight, collapse=","))
  ) %>%
 ungroup %>%
 as.data.frame %>%
 formattable(
    list(
      weight = function(spkline){
        sapply(spkline, function(md) knitr::knit(text=md, quiet=T) )
      }
    )
  )