Shiny - 使用基于输入的过滤数据填充静态 HTML 表

Question

由于 HTML 代码的大小，我目前正在开发一个显示静态 HTML 表格的 Shiny 应用程序，该表格源自另一个文件。该表使用空数据表进行初始化，以呈现空表。 HTML 表上方是普通的 selectizeInput 字段，它们在后台过滤数据表（通过 observe() 函数）。然后应该用过滤后的数据表填充 HTML 表。

我被困在使用“新”数据表更新 HTML 表的过程中。我尝试在 observe() 中再次采购表格 - 没有变化。我将数据表初始化为 reactiveValue 并用 reactive()-Function 包装了 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 表的要点 - 我在我的应用程序中显示了一个损益表，它需要通过 HTML 手动构建。因此，我不能使用通常的 dataTableOutput() 和 renderDataTable() 函数。由于表格严重依赖 CSS，因此基本 HTML 的使用比 htmlTable 包要容易得多。

Answer 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)
}