rfor-loopr-markdownhtmlwidgets

Generate formattable widgets in a loop in an R markdown document


I want to put HTML widgets like formattable (from formattable package) in an HTML page generated through RMarkdown. I need the widgets to be generated from within a for loop. How can i do that? With or without print(), both don't work.

This is an example code (partly taken from formattable homepage):

---
title: "formattable example loop"
output: html_document
---


```{r}
library(formattable)


df <- data.frame(
  id = 1:10,
  name = c("Bob", "Ashley", "James", "David", "Jenny", 
    "Hans", "Leo", "John", "Emily", "Lee"), 
  age = c(28, 27, 30, 28, 29, 29, 27, 27, 31, 30),
  grade = c("C", "A", "A", "C", "B", "B", "B", "A", "C", "C"),
  test1_score = c(8.9, 9.5, 9.6, 8.9, 9.1, 9.3, 9.3, 9.9, 8.5, 8.6),
  test2_score = c(9.1, 9.1, 9.2, 9.1, 8.9, 8.5, 9.2, 9.3, 9.1, 8.8),
  final_score = c(9, 9.3, 9.4, 9, 9, 8.9, 9.25, 9.6, 8.8, 8.7),
  registered = c(TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE),
  stringsAsFactors = FALSE)
for (i in 1: 10){
print(formattable(df, list(
  age = color_tile("white", "orange"),
  grade = formatter("span",
    style = x ~ ifelse(x == "A", style(color = "green", font.weight = "bold"), NA)),
  test1_score = color_bar("pink", 0.2),
  test2_score = color_bar("pink", 0.2),
  final_score = formatter("span",
    style = x ~ style(color = ifelse(rank(-x) <= 3, "green", "gray")),
    x ~ sprintf("%.2f (rank: %02d)", x, rank(-x))),
  registered = formatter("span", 
    style = x ~ style(color = ifelse(x, "green", "red")),
    x ~ icontext(ifelse(x, "ok", "remove"), ifelse(x, "Yes", "No")))
)))
}
```

The result should be ten times this formattable in an html_document.


Solution

  • Try this (there's a small wrapper for the table output and it's the code from the formattable site as it was easier to read :-)

    RPubs Preview

    ---
    title: "formattable example loop"
    output: html_document
    ---
    
    ```{r setup}
    library(formattable)
    library(htmltools)
    
    df <- data.frame(
      id = 1:10,
      name = c("Bob", "Ashley", "James", "David", "Jenny", 
        "Hans", "Leo", "John", "Emily", "Lee"), 
      age = c(28, 27, 30, 28, 29, 29, 27, 27, 31, 30),
      grade = c("C", "A", "A", "C", "B", "B", "B", "A", "C", "C"),
      test1_score = c(8.9, 9.5, 9.6, 8.9, 9.1, 9.3, 9.3, 9.9, 8.5, 8.6),
      test2_score = c(9.1, 9.1, 9.2, 9.1, 8.9, 8.5, 9.2, 9.3, 9.1, 8.8),
      final_score = c(9, 9.3, 9.4, 9, 9, 8.9, 9.25, 9.6, 8.8, 8.7),
      registered = c(TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE),
      stringsAsFactors = FALSE)
    
    show_plot <- function(plot_object) {
      div(style="margin:auto;text-align:center", plot_object)
    }
    ```
    
    ```{r}
    do.call(div, lapply(1:10, function(i) {
    
    show_plot(print(formattable(df, list(
      age = color_tile("white", "orange"),
      grade = formatter("span",
        style = x ~ ifelse(x == "A", style(color = "green", font.weight = "bold"), NA)),
      test1_score = color_bar("pink", 0.2),
      test2_score = color_bar("pink", 0.2),
      final_score = formatter("span",
        style = x ~ style(color = ifelse(rank(-x) <= 3, "green", "gray")),
        x ~ sprintf("%.2f (rank: %02d)", x, rank(-x))),
      registered = formatter("span", 
        style = x ~ style(color = ifelse(x, "green", "red")),
        x ~ icontext(ifelse(x, "ok", "remove"), ifelse(x, "Yes", "No")))
    ))))
    
    }))
    ```