Big blue LOADING.... with modules and appendTab/removeTab

[ArthurPERE]

Hello,

On the code below, when I append the tab (in clicking on the checkbox), remove it (in clicking on the same checkbox) and append either the same tab or another tab. There is a big blue LOADING... that appear and don't want to disappear. When I append another tab, the same LOADING... appear. The tabBox is now "cursed" and now even if you deload all modules (removing all tab), and append a tab, the big blue LOADING... appear.

That bug depends on the type of the spinner :

• the spinner 6, big blue LOADING....
• the spinner 1, big blue bar at the top of the box

I try it on Linux and windows, on R version 3.6.3 and 4.0.5

This is the R code for that bug :

library(shiny)
library(shinycssloaders)
library(shinydashboardPlus)
library(shinydashboard)
library(purrr)
library(tibble)
library(dplyr)

# module
moduleui = function(id){
  ns = NS(id)
  tagList(
    withSpinner(plotOutput(ns("plot")))
  )
}

module = function(id){
  moduleServer(id, function(input, output, session){

    output$plot = renderPlot({
      print("plot")
      Sys.sleep(2)
      plot(rnorm(60))
    })

  })
}

# ui 
ui = dashboardPage(
  dashboardHeader(title = "tabBoxes"), dashboardSidebar(
    sidebarMenu(
      id = "mnu_MENU",
      menuItem("aee", tabName = "aee")
    )
  ), 
  dashboardBody(
    tabItems(
      tabItem("aee",
        fluidRow(
          checkboxGroupInput("chkgrp_TOOLS", label = "choose", choices = paste0("mod", 1:3), inline = T),
          tabBox(title = "choice", id = "tabs_tools", width = 12)
        )
      )
    )
  )
)

server = function(input, output, session){
  tabNames = vector('character')

  tools <- tribble(
    ~name, ~fct, ~title,
    "mod1", moduleui, "mod1",
    "mod2", moduleui, "mod2",
    "mod3", moduleui, "mod3",
  )

  observeEvent(input$chkgrp_TOOLS, ignoreNULL = F, {

    before <- tabNames
    after <- input$chkgrp_TOOLS

    # remove the tab
    before[!before %in% after] %>%
      walk(~ {
        # remove the tab
        removeTab(inputId = "tabs_tools", target = .)
      })

    # append the tab
    tools %>%
      filter(name %in% after[!after %in% before]) %>%
      pwalk(function(name, fct, title) {
        appendTab("tabs_tools", tabPanel(name, fct(title)), select = T)
      })

    print(paste("Before :", paste(before, collapse = ", ")))
    print(paste("After :", paste(after, collapse = ", ")))
    print(paste("Remove :", paste(before[!before %in% after], collapse = ", ")))
    print(paste("Append :", paste(after[!after %in% before], collapse = ", ")))

    tabNames <<- input$chkgrp_TOOLS
  })
  module("mod1")
  module("mod2")
  module("mod3")
}

shinyApp(ui, server)

Thanks, Regards, Arthur

[daattali]

Thanks for the report Arthur. Could you try to shorten the code to be as minimal as possible and use the least number of packages possible? It would be easier to troubleshoot with a minimal code

[ArthurPERE]

Hello,

This is a cleaner code, with fewer dependency :

library(shiny)
library(shinycssloaders)

moduleui = function(id){
  ns = NS(id)
  tagList(
    withSpinner(plotOutput(ns("plot")))
  )
}

module = function(id){
  moduleServer(id, function(input, output, session){
    output$plot = renderPlot({
      print("plot")
      Sys.sleep(2)
      plot(rnorm(60))
    })
  })
}

ui = fluidPage(
  checkboxGroupInput("chkgrp_TOOLS", label = "choose", choices = paste0("mod", 1:3), inline = T),
  tabsetPanel(id = "tabs_tools")
)

server = function(input, output, session){
  tabNames = c()

  observeEvent(input$chkgrp_TOOLS, ignoreNULL = F, {

    before <- tabNames
    after <- input$chkgrp_TOOLS

    # remove the tab
    lapply(before[!before %in% after], function(x) {
      removeTab(inputId = "tabs_tools", target = x)
    })

    # append the tab
    lapply(after[!after %in% before], function(x) {
      appendTab("tabs_tools", tabPanel(x, moduleui(x)), select = T)
    })

    tabNames <<- input$chkgrp_TOOLS
  })
  module("mod1")
  module("mod2")
  module("mod3")
}
shinyApp(ui, server)

This bug may be related to the spinner which continue to spin in the background, even if the plot is here. But I don't really know.

Thanks, Regard, Arthur

[daattali]

I'll have a look when I can find some time. But the code here is not really using proper reactivity and is doing things in a strange way, so perhaps that's contributing to the issue. But I'll look when I can.

[jernest1]

I'm also seeing this behavior. shinycssloaders version 1.0.0. Here's an example:

require(shiny)
require(shinycssloaders)
tab1 <- tabPanel(
  title = "Tab 1",
  value = "tab1",
  fluidPage(
    uiOutput("appendTab2"),
    uiOutput("removeTab2")
  )
)
tab2 <- tabPanel(
  title = "Tab 2",
  value = "tab2",
  withSpinner(
    type = 8,
    plotOutput("plot")
  )
)
shinyApp(
  ui = tabsetPanel(
    id = "myTabsetPanel",
    tab1
  ),
  server = function(input, output, session) {
    d <- reactiveValues(
      tab2Present = F
    )
    output$appendTab2 <- renderUI({
      if(is.null(d$tab2Present)) return()
      if(d$tab2Present) return()
      actionButton("appendTab2", label = "Append tab 2")
    })
    output$removeTab2 <- renderUI({
      req(d$tab2Present)
      actionButton("removeTab2", label = "Remove tab 2")
    })
    observeEvent(input$appendTab2, {
      d$tab2Present <- T
      appendTab("myTabsetPanel", tab = tab2)
    })
    observeEvent(input$removeTab2, {
      d$tab2Present <- F
      removeTab("myTabsetPanel", target = "tab2")
    })
    output$plot <- renderPlot({
      plot(1:10, 1:10)
    })
  }
)

[daattali]

@jernest1 could you provide a minimal reprex please

[jernest1]

@daattali I updated my comment with a reprex.

[daattali]

I don't think this has anything to do with modules as modules are not in this reprex at all.

If I change your example to use showTab/hideTab instead of append/remove, then it works. In general I would recommend such an approach even regardless of this issue you're having - it's always better to hide something in the UI and re-show it rather than removing it entirely and rebuilding the UI again every time. The following works:

library(shiny)
library(shinycssloaders)

ui <- fluidPage(
  tabsetPanel(
    id = "myTabsetPanel",
    tabPanel(
      title = "Tab 1",
      value = "tab1",
      actionButton("showhide", "Show/hide tab"),
      actionButton("replot","replot")
    )
  )
)

server <- function(input, output, session) {
    observeEvent(input$showhide, {
      if (input$showhide == 1) {
        appendTab(
          "myTabsetPanel",
          tabPanel(
            title = "Tab 2",
            value = "tab2",
            withSpinner(
              type = 8,
              plotOutput("plot")
            )
          )
        )
      } else if (input$showhide %% 2 == 1) {
        showTab("myTabsetPanel", "tab2")
      } else {
        hideTab("myTabsetPanel", "tab2")
      }
    })
    output$plot <- renderPlot({
      input$replot
      plot(1:10, 1:10)
    })
}

shinyApp(ui, server)

I would suggest this type of code, although you can even initialize the tab from the UI instead of from the server, and then hide it immediately in the server. In general, it's best to create as much of the UI as possible from the UI object, and only rely on append/remove for things that are truly very dynamic.

Just as a test, I wanted to see if the problem is the fact that the plot gets removed and re-added. So I tried something else that's very similar to your original code, but instead of adding/removing the entire tab, I'm adding/removing the plot itself from the tab. This also works:

library(shiny)
library(shinycssloaders)

ui <- fluidPage(
  tabsetPanel(
    id = "myTabsetPanel",
    tabPanel(
      title = "Tab 1",
      value = "tab1",
      actionButton("showhide", "Show/hide plot"),
      actionButton("replot","replot")
    ),
    tabPanel(
      title = "Tab 2",
      value = "tab2",
      div(id = "placeholder")
    )
  )
)

server <- function(input, output, session) {
  observeEvent(input$showhide, {
  if (input$showhide %% 2 == 1) {
      insertUI("#placeholder", "beforeEnd", 
               withSpinner(
                 type = 8,
                 plotOutput("plot")
               ))
    } else {
      removeUI("#placeholder > div")
    }
  })
  output$plot <- renderPlot({
    input$replot
    plot(1:10, 1:10)
  })
}

shinyApp(ui, server)

I've seen that shiny's new functions appendTab+removeTab have caused other issues and had some bugs. Given that fact, and given that the loader works fine when using removeUI/insertUI, I assume that the issue is with how appendTab works. Perhaps a contributor can spend more time looking into this to see if it's fixable from shinycssloader's end. If you're happy with one of the other solutions, you can close this issue.

[daattali]

Closing due to no reprex