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