How to update the captions for different reports/tables in drop down

shiny
1

Hi All,
I am creating Dash board with several reports . I am using dropdown in individual Tabpanels. When i click on Table 1 the caption above the report should be displayed Table 1.If I am clicking on Table 2 the caption above should be Table 2. As of now in the below code in the output settings I am able to set the buttons . Caption is displaying only what I mentioned there. So for both reports it is displaying "Table 1Report".
Please help me on fixing this issue. Thank You.

library(shinydashboard)
library(shiny) #  Shiny web app
library(DT)    #  for data tables
library(shinyWidgets)
library(leaflet)
library(DBI)
library(dplyr)
library(readxl)
ui <- dashboardPage(
  dashboardHeader(disable = TRUE),
  dashboardSidebar(disable = TRUE),
  dashboardBody(
    fluidPage(
      tags$div(align = "center",style = "color:#3090C7;font-size: 50px;","MY TEST DASHBOARD"),
      tags$style(HTML("
   .tabbable > .nav > li > a {background-color:#728FCE;  color:black; width: 200PX;} ")),
      
      tabsetPanel(tabPanel("About",
                           
                           fluidRow(h3("About data",style = "color:#3090C7")),
                              ),
      
      navbarMenu("Data tab ",
                 
                 tabPanel("SUB FOLDER",
                          br(),
                          tabsetPanel(
                            tabPanel("TAB 1",
                                     br(),
                                     
                                     tags$div(style = "color:#728FCE;font-size: 17px;",selectInput("Test", "Select  Report",choices = c("Table 1","Table 2"))),
                                        sidebarLayout(
                                       sidebarPanel(width=3,
                                                    checkboxGroupInput("col_TT","Columns to display:",choices = c())
                                       ),
                                       mainPanel(
                                         DT::dataTableOutput("Test_data"))  
                                       )
                                     
                            )# outside tabpanel
                            )# TABSET pANEL ENDS HERE
                 )# TABPANEL BIRTHS ENDS
      )#NAVBAR DROP DOWN ENDS HERE
      )
    )
  )
  
)
server <- function(input, output,session) {
 
  TT <-  reactive ({
    
    switch(input$Test,
           
           "Table 1" = data.frame(read_excel('Table1.xlsx')),
           "Table 2" = data.frame(read_excel('Table2.xlsx'))
           
    )
  })
  
  observeEvent(input$Test,{
    req(TT()) # we need df()
    
    #update input$col_n with colnames of selected dataset
    updateCheckboxGroupInput(
      session,
      "col_TT",
      choices = colnames(TT()),
      selected = colnames(TT())
    )
  })
  
  output$Test_data <-   DT::renderDataTable({
    req(all(input$col_TT %in% names(TT())))
    DT::datatable(
      TT()  %>% select_at(input$col_TT),
      rownames = FALSE,
      caption = "Tabel 1 Report  ",
      editable = TRUE,
      extensions = 'Buttons',
      filter = list(position = "top",clear = FALSE, plain = FALSE),
      options = list(
        lengthMenu = c(30, 50),
        pageLength = nrow(TT()),
        scrollY =1600, scroller = TRUE, scrollX = T,
        paging = TRUE,
        searching = TRUE,
        fixedColumns = TRUE,
        autoWidth = TRUE,
        ordering = TRUE,
        dom = 'Bfrtip',#IF tB displays only few values
        buttons = c('copy', 'csv', 'excel','print'),
        modifier = list(page = "current")),
      class = "display nowrap compact" # style
    )
  })
  
}
# # run the app
shinyApp(ui, server)
2

You can just use the selected input value from "Test". Replace your caption arg in datatable with:

caption = paste(input$Test, "Report"),
3

Thank you. This give me the same caption as dropdown name. So I tried to update the caption like this .
proxy = dataTableProxy('Test_data')
observe({
if (input$Test = "Table 1") proxy %>%
updateCaption(proxy,"this is table 1 report")
})
It threw an error. Please correct me where i am missing. I am new to R.

This is my final code.

######---------------------testing the caption --------------------------

library(shinydashboard)
library(shiny) # Shiny web app
library(DT) # for data tables
library(shinyWidgets)
library(leaflet)
library(DBI)
library(dplyr)
library(readxl)
ui <- dashboardPage(
dashboardHeader(disable = TRUE),
dashboardSidebar(disable = TRUE),
dashboardBody(
fluidPage(
tags$div(align = "center",style = "color:#3090C7;font-size: 50px;","MY TEST DASHBOARD"),
tags$style(HTML("
.tabbable > .nav > li > a {background-color:#728FCE; color:black; width: 200PX;} ")),

  tabsetPanel(tabPanel("About",

                       fluidRow(h3("About data",style = "color:#3090C7")),
                          ),

  navbarMenu("Data tab ",

             tabPanel("SUB FOLDER",
                      br(),
                      tabsetPanel(
                        tabPanel("TAB 1",
                                 br(),

                                 tags$div(style = "color:#728FCE;font-size: 17px;",selectInput("Test", "Select  Report",choices = c("Table 1","Table 2"))),
                                    sidebarLayout(
                                   sidebarPanel(width=3,
                                                checkboxGroupInput("col_TT","Columns to display:",choices = c())
                                   ),
                                   mainPanel(
                                     DT::dataTableOutput("Test_data"))
                                   )

                        )# outside tabpanel
                        )# TABSET pANEL ENDS HERE
             )# TABPANEL BIRTHS ENDS
  )#NAVBAR DROP DOWN ENDS HERE
  )
)

)

)
server <- function(input, output,session) {

TT <- reactive ({

switch(input$Test,

       "Table 1" = data.frame(read_excel('Table1.xlsx')),
       "Table 2" = data.frame(read_excel('Table2.xlsx'))

)

})

observeEvent(input$Test,{
req(TT()) # we need df()

#update input$col_n with colnames of selected dataset
updateCheckboxGroupInput(
  session,
  "col_TT",
  choices = colnames(TT()),
  selected = colnames(TT())
)

})

output$Test_data <- DT::renderDataTable({
req(all(input$col_TT %in% names(TT())))
DT::datatable(
TT() %>% select_at(input$col_TT),
rownames = FALSE,
caption = paste(input$Test),
editable = TRUE,
extensions = 'Buttons',
filter = list(position = "top",clear = FALSE, plain = FALSE),
options = list(
lengthMenu = c(30, 50),
pageLength = nrow(TT()),
scrollY =1600, scroller = TRUE, scrollX = T,
paging = TRUE,
searching = TRUE,
fixedColumns = TRUE,
autoWidth = TRUE,
ordering = TRUE,
dom = 'Bfrtip',#IF tB displays only few values
buttons = c('copy', 'csv', 'excel','print'),
modifier = list(page = "current")),
class = "display nowrap compact" # style
)
})

proxy = dataTableProxy('Test_data')
observe({
if (input$Test = "Table 1") proxy %>%
updateCaption(proxy,"this is table 1 report")
})

}

# run the app

shinyApp(ui, server)

4

Apologies if I don't fully understand your expected result, but sounds like you want to display the caption "This is {input$Test} Report" instead of just "{input$Test}", and you want that to change based on your dropdown selection from input$Test. Is that right? If so, you can just follow my first reply and add some more text to the paste command. I see that you omitted the text "Report" from the paste command in your subsequent post, so hence the confusion on my part. You also introduced a DT proxy, but assuming you did only for caption purposes. Here is the full code I have - does this solve your problem? Note, I removed some unnecessary packages just for this code, and because I don't have access to your data files, I am using mtcars dataset as a placeholder. I also commented out that proxy code you added:

library(shinydashboard)
library(shiny) # Shiny web app
library(DT) # for data tables
library(shinyWidgets)
library(leaflet)
library(dplyr)
ui <- dashboardPage(
  dashboardHeader(disable = TRUE),
  dashboardSidebar(disable = TRUE),
  dashboardBody(
    fluidPage(
      tags$div(align = "center",style = "color:#3090C7;font-size: 50px;","MY TEST DASHBOARD"),
      tags$style(HTML("
.tabbable > .nav > li > a {background-color:#728FCE; color:black; width: 200PX;} ")),
      
      tabsetPanel(tabPanel("About",
                           
                           fluidRow(h3("About data",style = "color:#3090C7")),
      ),
      
      navbarMenu("Data tab ",
                 
                 tabPanel("SUB FOLDER",
                          br(),
                          tabsetPanel(
                            tabPanel("TAB 1",
                                     br(),
                                     
                                     tags$div(style = "color:#728FCE;font-size: 17px;",selectInput("Test", "Select  Report",choices = c("Table 1","Table 2"))),
                                     sidebarLayout(
                                       sidebarPanel(width=3,
                                                    checkboxGroupInput("col_TT","Columns to display:",choices = c())
                                       ),
                                       mainPanel(
                                         DT::dataTableOutput("Test_data"))
                                     )
                                     
                            )# outside tabpanel
                          )# TABSET pANEL ENDS HERE
                 )# TABPANEL BIRTHS ENDS
      )#NAVBAR DROP DOWN ENDS HERE
      )
    )
  )
  
)
server <- function(input, output,session) {
  
  TT <- reactive ({
    
    switch(input$Test,
           
           "Table 1" = mtcars,
           "Table 2" = mtcars
           
    )
  })
  
  observeEvent(input$Test,{
    req(TT()) # we need df()
    
    #update input$col_n with colnames of selected dataset
    updateCheckboxGroupInput(
      session,
      "col_TT",
      choices = colnames(TT()),
      selected = colnames(TT())
    )
  })
  
  output$Test_data <- DT::renderDataTable({
    req(all(input$col_TT %in% names(TT())))
    DT::datatable(
      TT() %>% select_at(input$col_TT),
      rownames = FALSE,
      caption = paste("This is", input$Test, "Report"),
      editable = TRUE,
      extensions = 'Buttons',
      filter = list(position = "top",clear = FALSE, plain = FALSE),
      options = list(
        lengthMenu = c(30, 50),
        pageLength = nrow(TT()),
        scrollY =1600, scroller = TRUE, scrollX = T,
        paging = TRUE,
        searching = TRUE,
        fixedColumns = TRUE,
        autoWidth = TRUE,
        ordering = TRUE,
        dom = 'Bfrtip',#IF tB displays only few values
        buttons = c('copy', 'csv', 'excel','print'),
        modifier = list(page = "current")),
      class = "display nowrap compact" # style
    )
  })
  
  # proxy = dataTableProxy('Test_data')
  # 
  # observe({
  #   if (input$Test == "Table 1") {
  #     proxy %>%
  #       updateCaption(proxy,"this is table 1 report")
  #   }
  #     
  # })
  
}

# run the app
shinyApp(ui, server)
5

Sorry for the confusion and Thanks for the quick reply..
I wanted to have my own caption not just " This is table 1 Report" or "This is Table 2 Report".
For say when i select Table 1 from drop down my caption can be " Total Toyota cars sold in 2021.."
Depending on the report data i need to add the caption not on the drop down name/table name.
So I thought updateCaption is the option.
For each report it has to be different captions.
Thank you so much for your help.

6

This topic was automatically closed 21 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.