Shiny R中的formattable包

Question

I discovered recently the formattable package for R and I'm trying to use it on shiny but I didn't succeed. Here is the code I found on github:

library(shiny)
library(formattable)
library(htmlwidgets)


#This is the part that could be added to formattable to allow shiny integration. Not sure about height 100% but the function wont accept NULL
formattableOutput <- function(outputId, width = "100%", height = "100%") {
  shinyWidgetOutput(outputId, "formattable_widget", width, height, package = "formattable")
}

renderFormattable <- function(expr, env = parent.frame(), quoted = FALSE) {
  if (!quoted) { expr <- substitute(expr) } # force quoted
  shinyRenderWidget(expr, formattableOutput, env, quoted = TRUE)
}

#Define a dataframe (example stolen from formattable readme)
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)


##################################
# Shiny server
##################################

server <- function(input, output) {

  #use our new function to create an output called formattableexample. We require an explicit call to the as.htmlwidget function as this does not register as an interactive  environment

  output$formattableexample <- renderFormattable({
    as.htmlwidget(
      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"),
        test2_score = color_bar("pink"),
        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")))
      ))

    )
  })
}

##################################
# Shiny ui
##################################
ui <- fluidPage(
  #use our new function to show the output we just defined. 

  fluidRow(
     box(
      formattableOutput("formattableexample")
    ),
  )
)

shinyApp(ui = ui, server = server)

When I run the app I get the table but not the shiny template. Could you give any help?

Thanks

Answer 1

I will try to break this down into points.

Formattable Shiny Functions

The functions for shiny use are already in formattable . See lines . We can eliminate those lines from your code since they are not necessary.

Errors in Example

In your example, what is box ? Usually that is used to draw a box around a static plot and will not work with htmlwidgets .

fluidRow(
   box(
    formattableOutput("formattableexample")
  ),
)

Also, there is a stray , in the above lines from your example.

as.htmlwidget Not Necessary

Explicitly converting the formattable with as.htmlwidget is no longer necessary, so we can eliminate that.

Working Code

Correcting the errors and removing the lines as mentioned above gives us the following working code.

library(shiny)
library(formattable)
library(htmlwidgets)


#Define a dataframe (example stolen from formattable readme)
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)


##################################
# Shiny server
##################################

server <- function(input, output) {

  #use our new function to create an output called formattableexample. We require an explicit call to the as.htmlwidget function as this does not register as an interactive  environment

  output$formattableexample <- renderFormattable({
      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"),
        test2_score = color_bar("pink"),
        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")))
      ))
  })
}

##################################
# Shiny ui
##################################
ui <- fluidPage(
  #use our new function to show the output we just defined. 

  fluidRow(
    formattableOutput("formattableexample")
  )
)

shinyApp(ui = ui, server = server)