Sean McKenzie
Sean McKenzie

Reputation: 909

Conditionally display single or multiple tables in Shiny App

I have a shiny app that I am building where the user selects a report from a radio button menu, and then the table displays on the page. I would like to add an option for the user to simultaneously view all reports. I have found something close to what I want from this thread https://gist.github.com/wch/5436415/ , but I can't quite seem to implement it properly. Basically, I think what I have to do is:

  1. In the UI, make a call to uiOutput() to reactively update the User Interface. I will need multiple calls to htmlOutput() if the user selects the "all" button, but only one call to htmlOutput() if the use simply selects one report. For the record, I am creating my tables with the kable() function, which is why I call htmlOutput() instead of tableOutput().

  2. In the server function, I need to make a call to renderUI() that provides the instructions on how many htmlOutput() calls there will be and which reports will be in each call.

  3. Create a loop that then makes a call to renderText that then sends the html code for the htmlOutput function to interpret.

I can get most of the way there. I can get Shiny to have reactive tables, and output individual reports, but I am struggling to get the looping range to reactively update so that I see all three tables in my testing app. Here is what I have:

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)

Here is where I think I am going wrong:

I included a textOutput() for the value of n, and despite having the reactive() call to get the length of TABLES, when I isolate() I still get the value of 1 even when I select the "all" report button, which should give me 3. Am I misinterpreting how isolate() works? Is there another way to get a value out of a reactive() function that can be used outside of a *Output() or reactive() function? Any guidance would be much appreciated. Thanks so much.

Upvotes: 0

Views: 921

Answers (1)

Ian Campbell
Ian Campbell

Reputation: 24878

I think your server function is needlessly complex.

render functions are a reactive context themselves, so no need to define variables which only exist in those contexts as specifically reactive.

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

enter image description here

Upvotes: 3

Related Questions