0

I have R code for a shiny dashboard with several tabs. I want to be able to customise what function is run depending on the current tab. To do this I need to be able to know "What is the currently selected tabPanel?".

With the code below, there is the currently commented line #(textOutput("text")) , the idea being when uncommented, it would tell me what current tab is selected (just for testing purposes). However, when uncommented, the dataTable below it does not render.

Any assistance appreciated to get the application to know (and provide feedback to the user) what tabPanel is currently selected.

library(shiny)
library(shinydashboard)
#> 
#> Attaching package: 'shinydashboard'
#> The following object is masked from 'package:graphics':
#> 
#>     box

############################################

table_UI <- function(id) {
  ns <- NS(id)
  tagList(
    sidebarLayout(
      sidebarPanel(width = 2),
      mainPanel(
        p("see what I mean?"),
        #(textOutput("text")),
        DT::dataTableOutput(ns('table'))
      )
    )
    
  )
}

table_Server <- function(id,dataset) {

  moduleServer(
    id,
    function(input, output, session) {
      output$table = DT::renderDataTable({
        mtcars
      }) 
      
      output$text = renderText({
        paste0("You are viewing tab \"", input$region_indicators, "\"")
      })
      
    }
  )
}


ui = fluidPage(
  tabsetPanel(id = 'cqi_indicators',
              tabPanel('Region',
                       tabsetPanel(
                         id='region_indicators',
                         tabPanel("Data Entry",table_UI("DE")),
                         tabPanel("Adherence",table_UI("AA")),
                         tabPanel("Early Retention",table_UI("ER")),
                         tabPanel("Recent Retention",table_UI("RR")),
                         tabPanel("12Mo Retention",table_UI("12MR")),
                         tabPanel("3MMD",table_UI("3MMD")),
                         tabPanel("6MMD",table_UI("6MMD")),
                         tabPanel("EID 2Mo",table_UI("EID2Mo")),
                         tabPanel("EID 12Mo",table_UI("EID12Mo")),
                         tabPanel("TPT",table_UI("TPT")),
                         tabPanel("HVL",table_UI("HVL"))
                         
                       )
              ),
              tabPanel('District',
                       tabsetPanel(
                         id='district_indicators',
                         
                         tabPanel("3MMD",table_UI("3MMD2"))
                       )
              )
  )
)

server = function(input,output,session){
  
  table_Server("3MMD")
  table_Server("3MMD2")
  table_Server("AA")
  table_Server("ER")
  table_Server("RR")
  table_Server("12MR")
  table_Server("6MMD")
  table_Server("DE")
  table_Server("EID2Mo")
  table_Server("EID12Mo")
  table_Server("TPT")
  table_Server("HVL")
}

shinyApp(ui,server)
#> PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.
Shiny applications not supported in static R Markdown documents

Created on 2023-06-07 by the reprex package (v2.0.1)

Tumaini Kilimba
  • 329
  • 2
  • 12
  • From the online help for `tagsetPanel`: "id If provided, you can use ⁠input$⁠id in your server logic to determine which of the current tabs is active. The value will correspond to the value argument that is passed to tabPanel()". Also, you may want your module server functions to return a `reactive` and assign that return value to an object in your main server function. – Limey Jun 07 '23 at 12:10
  • @Limey Yes, as can be seen my tabsetPanel has the id region_indicators. Additionally, the module server function is set to access the value within the reactive ```renderText()``` function. Yet the issue persists – Tumaini Kilimba Jun 07 '23 at 12:17
  • Ah! You want the module server to know which tab is selected? – Limey Jun 07 '23 at 12:29
  • @Limey Yes... Yes, that is my goal – Tumaini Kilimba Jun 07 '23 at 12:32
  • Got it. Apologies for the misunderstanding. I've updated my answer. – Limey Jun 07 '23 at 12:36
  • @Limey thank you the below works great. Can you edit it leaving just the solution that you propose in your final EDIT is left so I can accept the answer? I think it may save somebody else some cognitive overload? Now that I can tell which tab is selected thanks to your answer, I move onto my actual objective of running a different function returning different tables based on what the current selected tab is. I will amend this post if I run into difficulties? Thanks again! – Tumaini Kilimba Jun 07 '23 at 13:19
  • Edited as requested. "I will amend this post if I run into difficulties". No. That would be a separate problem and a new question would be appropriate. – Limey Jun 07 '23 at 14:37

1 Answers1

0

Edited at OP's request.

EDIT

If you want your module server to know which tab is selected, you need to be a little more sophisticated. The tabsetPanel is defined in the main server function, so the module server doesn't know about it directly. Here's one way of doing it.

[Note, I modified your server function slightly so that it uses the dataset parameter you've already defined rather than hardcoding mtcars...]

library(shiny)
library(shinydashboard)

table_UI <- function(id) {
  ns <- NS(id)
  tagList(
    sidebarLayout(
      sidebarPanel(width = 2),
      mainPanel(
        textOutput(ns("text")),
        DT::dataTableOutput(ns('table'))
      )
    )
    
  )
}

table_Server <- function(id, dataset, selection) {
  moduleServer(
    id,
    function(input, output, session) {
      output$table = DT::renderDataTable({
        dataset
      }) 
      
      output$text = renderText({
        paste0("You are viewing tab \"", selection(), "\"")
      })
      
    }
  )
}

ui = fluidPage(
  tabsetPanel(id = 'cqi_indicators',
              tabPanel('Region',
                       tabsetPanel(
                         id='region_indicators',
                         tabPanel("Data Entry",table_UI("DE")),
                         tabPanel("Adherence",table_UI("AA")),
                         tabPanel("Early Retention",table_UI("ER")),
                         tabPanel("Recent Retention",table_UI("RR")),
                         tabPanel("12Mo Retention",table_UI("12MR")),
                         tabPanel("3MMD",table_UI("3MMD")),
                         tabPanel("6MMD",table_UI("6MMD")),
                         tabPanel("EID 2Mo",table_UI("EID2Mo")),
                         tabPanel("EID 12Mo",table_UI("EID12Mo")),
                         tabPanel("TPT",table_UI("TPT")),
                         tabPanel("HVL",table_UI("HVL"))
                         
                       )
              ),
              tabPanel('District',
                       tabsetPanel(
                         id='district_indicators',
                         
                         tabPanel("3MMD",table_UI("3MMD2"))
                       )
              )
  )
)

server = function(input,output,session){
  table_Server("3MMD", mtcars, selectedTab)
  table_Server("3MMD2", mtcars, selectedTab)
  table_Server("AA", mtcars, selectedTab)
  table_Server("ER", mtcars, selectedTab)
  table_Server("RR", mtcars, selectedTab)
  table_Server("12MR", mtcars, selectedTab)
  table_Server("6MMD", mtcars, selectedTab)
  table_Server("DE", mtcars, selectedTab)
  table_Server("EID2Mo", mtcars, selectedTab)
  table_Server("EID12Mo", mtcars, selectedTab)
  table_Server("TPT", mtcars, selectedTab)
  table_Server("HVL", mtcars, selectedTab)
  
  selectedTab <- reactive({
    input$region_indicators
  })
}

shinyApp(ui,server)

enter image description here

and

enter image description here

Limey
  • 10,234
  • 2
  • 12
  • 32