在 Shiny App 中有条件地显示单个或多个表

Question

我正在构建一个闪亮的应用程序，用户从单选按钮菜单中选择一个报告，然后表格显示在页面上。我想为用户添加一个选项以同时查看所有报告。我从这个线程 https://gist.github.com/wch/5436415/ 中找到了一些接近我想要的东西，但我似乎无法正确实现它。基本上，我认为我要做的是：

1. 在 UI 中，调用 uiOutput() 以响应式更新用户界面。如果用户选择“全部”按钮，我将需要多次调用htmlOutput()，但如果用户只选择一份报告，则只需调用一次htmlOutput()。作为记录，我正在使用kable() 函数创建我的表，这就是为什么我调用htmlOutput() 而不是tableOutput()。

2. 在服务器函数中，我需要调用 renderUI()，它提供了有关将有多少 htmlOutput() 调用以及每个调用中将包含哪些报告的说明。

3. 创建一个循环，然后调用 renderText，然后发送 html 代码以供 htmlOutput 函数解释。

我可以到达那里的大部分路。我可以让 Shiny 拥有反应式表格，并输出单独的报告，但我正在努力让循环范围反应性更新，以便在我的测试应用程序中看到所有三个表格。这是我所拥有的：

library(shiny)
library(shinydashboard)
library(knitr)
library(kableExtra)

data("cars")
data("iris")
data("airquality")

UI<-dashboardPage(
  dashboardHeader(),
  dashboardSidebar(sidebarMenu(
    menuItem("Options", radioButtons(inputId = "Tables", label="test", choices= c("cars", "iris", "airquality", "all"))
  ) )),
  dashboardBody(
    uiOutput(outputId = "TABLE"),
    textOutput("N")
  )  
  )

server<-function(input, output){
 
  TBL<-list("cars", "iris", "airquality")
  T1<-knitr::kable(head(cars))
  T2<-knitr::kable(head(iris))
  T3<-knitr::kable(head(airquality))
  tmp<-list(cars=T1, iris=T2, airquality=T3)
  TABLES<-reactive({
   ifelse(input$Tables=="all", tmp, tmp[input$Tables])
    })
  val<-reactive({
    tmp<-TABLES()
    length(tmp)})
  n<-isolate(val())
   output$TABLE<-renderUI({
    req(input$Tables)
      TAB<-TABLES()
      TBL<-names(TAB)
        tbls<-lapply(1:length(TBL), function(i){
          tblnm<-paste("tbl", i, sep="_")
          htmlOutput(tblnm)})
        do.call(tagList, tbls)
      })#Close Render UI
  for(i in 1:n){
  local({
    j<-i
    tblnm<-paste("tbl", j, sep="_")
   output[[tblnm]]<-renderText(kables(TABLES()))
    })
  }
  output$N<-renderText(n)
}#Close Server

shinyApp(ui = UI, server = server)

这是我认为我出错的地方：

我为 n 的值添加了一个 textOutput()，尽管调用了 reactive() 来获取 TABLES 的长度，但当我 isolate() 时，即使我选择“全部”报告按钮，它应该给我 3。我是否误解了 isolate() 的工作原理？是否有另一种方法可以从 reactive() 函数中获取值，该函数可以在 *Output() 或 reactive() 函数之外使用？任何指导将不胜感激。非常感谢。

Answer 1

我认为您的server 函数过于复杂。

render 函数本身就是一个响应式上下文，因此无需将仅存在于这些上下文中的变量定义为特定的响应式。

server<-function(input, output){
  TBL<-list("cars", "iris", "airquality")
  T1<-knitr::kable(head(cars))
  T2<-knitr::kable(head(iris))
  T3<-knitr::kable(head(airquality))
  tmp<-list(cars=T1, iris=T2, airquality=T3)
  output$TABLE<-renderUI({
    if(input$Tables=="all"){ind <- names(tmp)}else{ind <- input$Tables}
    lapply(tmp, HTML)[ind]
    })
  output$N <- renderText({
    if(input$Tables=="all"){ind <- names(tmp)}else{ind <- input$Tables}
    length(ind)
  })
}