0

我最近发现了 R 的可格式化包,我正在尝试在闪亮上使用它,但我没有成功。这是我在 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)

当我运行应用程序时,我得到了表格,但没有得到闪亮的模板。你能帮忙吗?

谢谢

4

1 回答 1

2

我将尝试将其分解为点。

可格式化的闪亮功能

闪亮使用的功能已经在formattable. 见。我们可以从您的代码中删除这些行,因为它们不是必需的。

示例中的错误

在你的例子中,什么是box?通常用于在静态图周围绘制一个框,不适用于htmlwidgets.

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

,此外,您的示例中的上述行中有一个杂散。

as.htmlwidget 不需要

不再需要显式转换formattablewith ,因此我们可以消除它。as.htmlwidget

工作代码

纠正错误并删除上面提到的行为我们提供了以下工作代码。

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)
于 2016-10-22T12:16:59.063 回答