我目前正在开发一个Shiny应用程序,它显示一个静态HTML表格,源自另一个文件,因为HTML代码的大小。该表使用空数据表初始化,以呈现空表。 HTML表格上方是正常的 selectizeInput 字段,用于在后台过滤数据表(通过observe()函数)。然后应使用过滤后的数据表填充HTML表。
我坚持使用" new"更新HTML表格。数据表。我试着在观察()中再次采购表格 - 没有变化。我将数据表初始化为reactiveValue并使用reactive()函数包装HTML表 - 函数 - 再次没有变化。
这是一个玩具示例,它有点类似于我的Shiny应用程序:
app.R
library(shiny)
ui <- fluidPage(
fluidRow(
column(width = 6, uiOutput("cars"))
),
fluidRow(
column(width = 6, htmlOutput("html.table"))
)
)
server <- function(input, output) {
filtered_cars <- data.frame(matrix("NA", nrow = 1, ncol = 4, dimnames = list("NA", c("mpg","cyl","disp","hp"))))
source("server_html_table.R", local = TRUE)
output$cars <- renderUI({
selectizeInput(
inputId = "cars",
label = NULL,
choices = rownames(mtcars),
options = list(placeholder = 'Cars')
)
})
output$html.table <- renderUI({
html.table
})
observeEvent(input$cars, {
filtered_cars <- subset(mtcars, rownames(mtcars) %in% input$cars)
#some kind of update for the html table missing
})
}
# Run the application
shinyApp(ui = ui, server = server)
server_html_table.R
html.table <- tags$table(style = "border: 1px solid black; padding: 1%; width: 100%;",
tags$tr(
tags$th("Car Name"),
tags$th("MPG"),
tags$th("CYL"),
tags$th("DISP"),
tags$th("HP")
),
tags$tr(
tags$td(rownames(filtered_cars)),
tags$td(filtered_cars$mpg),
tags$td(filtered_cars$cyl),
tags$td(filtered_cars$disp),
tags$td(filtered_cars$hp)
)
)
如您所见,表格单元格不会更新。我知道observeEvent中缺少某种更新函数(比如updateSelectizeInput()),但我无法想出一种自己编码的方法。
我很感激任何形式的想法或提示!
编辑#1:也许更清楚地说明HTML表格 - 我在我的应用程序中显示一个Profit and Loss表,需要通过HTML手动构建。因此,我无法使用通常的dataTableOutput()和renderDataTable()函数。由于表格在很大程度上依赖于CSS,因此基本HTML的使用比htmlTable包更容易。
答案 0 :(得分:1)
我找到了解决问题的方法!
静态html表包含在一个函数中,该函数将在应用程序的服务器部分启动时获取一次,然后在renderUI()函数中调用。每次用户更改菜单时都会触发渲染功能。在这里,我过滤关于输入的数据帧并将其传递给“build_table”函数。然后,通过索引从数据框中填充表中的每个单元格。该函数将完整的html表返回给renderUI()。
这是上面的玩具示例,根据工作解决方案调整:
<强> app.R 强>
library(shiny)
ui <- fluidPage(
fluidRow(
column(width = 6, uiOutput("cars"))
),
fluidRow(
column(width = 6, htmlOutput("html.table"))
)
)
server <- function(input, output) {
source("server_html_table.R", local = TRUE)
output$cars <- renderUI({
selectizeInput(
inputId = "cars",
label = NULL,
choices = rownames(mtcars),
options = list(placeholder = 'Cars')
)
})
output$html.table <- renderUI({
input$cars
isolate({
filtered_cars <- subset(mtcars, rownames(mtcars) %in% input$cars)
build_table(filtered_cars)
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
<强> server_html_table.R 强>
build_table <- function(data){
html.table <- tags$table(style = "border: 1px solid black; padding: 1%; width: 100%;",
tags$tr(
tags$th("Car Name"),
tags$th("MPG"),
tags$th("CYL"),
tags$th("DISP"),
tags$th("HP")
),
tags$tr(
tags$td(rownames(data)),
tags$td(data$mpg),
tags$td(data$cyl),
tags$td(data$disp),
tags$td(data$hp)
)
)
return(html.table)
}