Navlistpanel: Make Tabs Sequentially Active in Shiny App

navlistPanel: Make tabs sequentially active in shiny app

Here's an example. All but the first nav links are disabled when the page loads. I've added 'Done' buttons to each section. When you press a Done button, the next nav link becomes enabled.

 ui <- fluidPage(  
   tags$head(tags$script("
        window.onload = function() {
            $('#mynavlist a:contains(\"Data Check\")').parent().addClass('disabled');
            $('#mynavlist a:contains(\"Dry Run\")').parent().addClass('disabled');
            $('#mynavlist a:contains(\"Output\")').parent().addClass('disabled');
        };

        Shiny.addCustomMessageHandler('activeNavs', function(nav_label) {
            $('#mynavlist a:contains(\"' + nav_label + '\")').parent().removeClass('disabled');
        });
   ")),
   titlePanel("New Project"), 
   navlistPanel(selected="Data Upload", id='mynavlist',
   tabPanel("Data Upload",           
         textInput("aInSummary", label = h5("Please type a"), 
                   value = "Enter value..."),
         br(),
         actionButton('data_upload_done', 'Done')
         ),   
   tabPanel("Data Check",
         textInput("bInDataCheck", label = h5("Please type b"), 
                   value = "Enter value..."),
         br(),
         actionButton('data_check_done', 'Done')
         ),   
   tabPanel("Dry Run",
         textInput("cInDryRun", label = h5("Please type c"), 
                   value = "Enter value..."),
         br(),
         actionButton('dry_run_done', 'Done')
        ),                 
   tabPanel("Output"),
   "-----",
   tabPanel("Help-FAQ")
   )
)

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

    observe({
        if (input$data_upload_done > 0) {
            session$sendCustomMessage('activeNavs', 'Data Check')
        }
    })

    observe({
        if (input$data_check_done > 0) {
            session$sendCustomMessage('activeNavs', 'Dry Run')
        }
    })

    observe({
        if (input$dry_run_done > 0) {
            session$sendCustomMessage('activeNavs', 'Output')
        }
    })
}

runApp(list(ui=ui, server=server))

Shiny App displays output in multiple tabs

It is not possible with the pageWithSidebar function. This function is deprecated anyway. Try to wrap a fluidPage in a navbarPage:

# Define UI
ui <- navbarPage("App Title",
                 tabPanel("Plot",
                          fluidPage(
                            sidebarLayout(

                              # Sidebar with a slider input
                              sidebarPanel(
                                sliderInput("obs",
                                            "Number of observations:",
                                            min = 0,
                                            max = 1000,
                                            value = 500)
                              ),

                              # Show a plot of the generated distribution
                              mainPanel(
                                plotOutput("distPlot")
                              )
                            )
                          )

                 ),
                 tabPanel("Summary",
                          tags$br("Some text"))
)

# Server logic
server <- function(input, output) {
  output$distPlot <- renderPlot({
    hist(rnorm(input$obs))
  })
}

# Complete app with UI and server components
shinyApp(ui, server)

How to create a shiny App where tabs are only become visible if a condition is met

you can find a solution to conditional tabsets in the link below, this is done on the server side with renderUI() and shown achieved with conditional panels

Add dynamic tabs in shiny dashboard using conditional panel

A closer example of adding tabs to an existing tab set can be achieved with the code below (derived from examples in the original link):

library(shiny) 
library(shinydashboard)
ui <- dashboardPage(
    dashboardHeader(),
    dashboardSidebar(
        checkboxGroupInput("Tabs", label = h4("tabpanel"), choices = list("tabs" = "tabs"),selected = NULL),
        checkboxGroupInput("MoreTabs", label = h4("moretabpanel"), choices = list("moretabs" = "moretabs"),selected = NULL)
    ),
    dashboardBody(
       tabBox(id="x",tabPanel("panel","panel"))
    )
)
server <- function(input, output) { 

    observeEvent(input$Tabs,{
       
        check1 <- input$Tabs == "tabs"
        
        if(check1&!is.na(check1)){
           
        
            insertTab(inputId = "x",
                      tabPanel("Dynamic", "This a dynamically-added tab"),target="panel",position ="after")
        }
        
    })
    }
shinyApp(ui, server)

We use the function insertTab to append a tab to an existing tabset based on an event. (checking a box) if you want to subsequently remove this tab if the condition becomes unsatisfied again you can use removeTab more information on these functions can be found here:

Shiny Insert Tab

In Shiny, how to make tabs appear one at a time without javascript, etc

I found a solution to this problem. It involves a few components.

First, I had to create a new version of the tabsetPanel function (which I called tabsetPanel2. It is essentially the same as tabsetPanel except that it drops any tabPanel objects that are NULL. That way, any tabPanel objects that are not supposed to appear can be set to NULL, and the call to tabsetPanel doesn't have to change.

Second, I had to create reactive objects that held the selections made by the user on each widget that resides on a tabPanel, and set the selected parameter of the widget to to that reactive object. That way, when tabsetPanel2 is rebuilt, it loads the previously entered info.

Third, I had to create a reactive object to hold the name of the selected tab. That way, when tabsetPanel2 is rebuilt, it automatically goes to the tab the user was just on.

All of the code can be found in the github repository mentioned in the question.

Create multiple tabs within one shiny module

Probably the issue come from the way the function tabsetPanel consumes its arguments.
The function wants tabPanels separated per commas.

While doing what you are doing you provide two tabPanels within one argument.

So you have got to come up with something that allows you to provide one tab per argument. By returning a list from your module and using the function do.call you can achieve this.

library(shiny)
library(tidyverse)

resultlistUI <- function(id) {
  ns <- NS(id)
  list(
    tabPanel(
      title = "Result1",
      "Some text here 2"
    ),
    tabPanel(
      title = "Result2",
      "Some text here 3"
    ))
}

resultlist <- function(input, output, session) {
}

ui <- fluidPage(

  do.call(tabsetPanel, 
          list(id = 'tabs', 
               tabPanel(
                 title = "Tab 1",
                 "Some text here"
               )) %>% append(resultlistUI(id = "resultlist1")))

)

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

shinyApp(ui = ui, server = server)

R shiny Condition a tab in the navbar based on previous tabs condition

I'm not an expert in js and css but I have managed to come up with a solution that works.

 ##Data
 Poly = data.frame(Strat = c("A","A","A","A","A","B","B","B","B","B"), long = c(174.5012, 174.5026, 174.5026, 174.5014,174.5012,174.5012 ,174.5020, 174.5020,174.5012,174.5012),lat = c(-35.84014, -35.84018, -35.84137,-35.84138,-35.84014,-35.84014,-35.84014,-35.84197,-35.84197,-35.84014))
 Points = data.frame(long = c(174.5014 ,174.5017, 174.5021, 174.5023, 174.5020, 174.5017 ,174.5021 ,174.5017, 174.5021, 174.5019), lat = c(-35.84187, -35.84165, -35.84220 ,-35.84121, -35.84133, -35.84034, -35.84082, -35.84101, -35.84112, -35.84084))

    library('leaflet')
    library('shiny')
    library(shinyjs)

    ##JS Code for enabling and diabling
    jscode <- "shinyjs.disabletab =function(name){
    $('ul li:has(a[data-value= \"Data\"])').addClass('disabled');

    }

    shinyjs.enabletab =function(name){
    $('ul li:has(a[data-value= \"Data\"])').removeClass('disabled');
    } "

    #UI
    ui <- navbarPage(title = "navigation bar", 

                     tabPanel("Home", fluidPage(bootstrapPage(
                       checkboxInput("check_box", label = "Click me to continue", FALSE),
                       ## Main text
                       mainPanel(
                         tags$div()
                       )

                     ))),

                     tabPanel(title = "View Data",
                              value = "Data",
                              bootstrapPage(
                                mainPanel(
                                ),
                                leafletOutput("map", width ="100%", height = "600px")
                              )
                     ),

                     #To use js code in the app
                     useShinyjs(),
                     extendShinyjs(text = jscode)
    )

    server = function(input, output, session){

      mymap <- reactive({
        leaflet() %>% addTiles(urlTemplate = "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png", attribution = NULL, layerId = NULL, group = NULL, options = tileOptions()) %>%  
          clearShapes() %>%
          clearMarkers() %>%      
          fitBounds(lng1 = 174.5042, lat1= -35.83814,lng2= 174.5001, lat2 = -35.8424) 
      })

      output$map <- renderLeaflet({
        mymap()      
      })
      myfun <- function(map) {
        print("adding points")
        map %>% clearShapes() %>%
          clearControls() %>% 
          clearMarkers() %>% 
          addCircles(lng = Points$long, lat = Points$lat, color = "blue",fillOpacity = 1,radius = 1)   
      }

      AddStrataPoly <- function(map) {
        print("adding polygons")    
        for(i in 1:length(unique(Poly$Strat))) {
          map <- map %>% addPolygons(lng = Poly[Poly$Strat == unique(Poly$Strat)[i],]$long, lat = Poly[Poly$Strat == unique(Poly$Strat)[i],]$lat, layerId = unique(Poly$Strat)[i], color = 'gray60', options = list(fillOpacity = 0.1))
        } 
        map
      }

      observe({
        leafletProxy("map") %>% myfun() %>% AddStrataPoly() 
      })

      observeEvent(input$check_box,{

        if(input$check_box){#If true enable, else disable
          js$enabletab("abc")
        }else{
          js$disabletab("abc")
        }

      })

    }

    shinyApp(ui, server)

Hope it helps!

[EDIT]:
I know that there is an accepted answer to this question but still editing the answer so that it could be helpful for someone else later.

While posting the I answer did not realise that the click event exists even when the the navbar is disabled.

If the above js code is replaced with the one below the click event is removed and solution works as expected:

##JS Code for enabling and diabling
jscode <- "shinyjs.disabletab =function(name){
$('ul li:has(a[data-value= \"Data\"])').addClass('disabled');
$('.nav li.disabled a').prop('disabled',true)
}

shinyjs.enabletab =function(name){
$('.nav li.disabled a').prop('disabled',false)
$('ul li:has(a[data-value= \"Data\"])').removeClass('disabled');
} "

Preload all tabs when shiny app loads

You have the right idea, suspendWhenHidden seems to be the key. The problem is that the Rmd rendering needs cylFun to have a value, and cylFun depends on the selectionBox input value you create with renderUI. You have the suspendWhenHidden option for the plot and table, but these cannot be calculated without selectionBox, and the markdown works without them.

So just add

  outputOptions(output, "selectList", suspendWhenHidden = FALSE)

and it should work. You can also remove the outputOptions for the table and plot on tab 2.

---

Related Topics