Shiny - 使用基于输入

时间:2017-04-19 18:24:52

标签: r shiny

我目前正在开发一个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包更容易。

1 个答案:

答案 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)
}