[英]formattable package in Shiny R
我最近發現了R的formattable程序包,我試圖在閃亮的環境下使用它,但沒有成功。 這是我在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)
當我運行該應用程序時,我得到了表格,但沒有閃亮的模板。 你能幫忙嗎?
謝謝
我將嘗試將其分解為幾個要點。
閃亮使用的功能已經在formattable
。 看線 。 我們可以從您的代碼中刪除這些行,因為它們不是必需的。
在您的示例中, box
什么? 通常用於在靜態圖周圍繪制框,並且不適用於htmlwidgets
。
fluidRow(
box(
formattableOutput("formattableexample")
),
)
此外,還有一個流浪,
從你的例子上面的紋路。
顯式轉換formattable
與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)
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.