Nested box content is not rendered when main box is initially collapsed

[mattantaliss]

This is the same sort of problem raised in #42, but occurs in nested boxes with shinydashboard_0.6.1. Here is an example app in which the idea is to render a slider input control via JS code (since the shinydashboard sliderInput isn't powerful enough yet) and provide some selection information in htmlOutput:

library(shinydashboard)

kR1EndDefault <- 5
kR3StartDefault <- 8
kMonths <- c("Aug", "Sep", "Oct", "Nov", "Dec", "Jan",
             "Feb", "Mar", "Apr", "May", "Jun", "Jul")

CalcMonthRange <- function(inputControl, rng) {
  if (is.na(inputControl[1]) | is.na(inputControl[2])) {
    r1.end <- kR1EndDefault + 1
    r3.start <- kR3StartDefault + 1
  } else {
    r1.end <- inputControl[1] + 1
    r3.start <- inputControl[2] + 1
  }

  switch(rng,
         r1 = ifelse(r1.end == 1,
                     kMonths[1],
                     paste0(kMonths[1], "--", kMonths[r1.end])),
         r2 = ifelse(r1.end + 1 == r3.start - 1,
                     kMonths[r1.end + 1],
                     paste0(kMonths[r1.end + 1], "--", kMonths[r3.start - 1])),
         r3 = ifelse(r3.start == 12,
                     kMonths[12],
                     paste0(kMonths[r3.start], "--", kMonths[12]))
  )
}

ui <- dashboardPage(
  dashboardHeader(disable = TRUE),
  dashboardSidebar(disable = TRUE),
  dashboardBody(
    fluidRow(
      box(
        title = "Inputs",
        collapsible = TRUE,
        collapsed = TRUE,
        width = 12,
        box( # XXX
          title = "Month Selection", # XXX
          uiOutput("slMonthsUI"),
          sliderInput(
            inputId = "slMonths",
            label = "Months",
            min = 0,
            max = 1,
            value = 0,
            step = 1
          ),
          htmlOutput(outputId = "htmlMonths")
        ) # XXX
      )
    )
  )
)

server <- function(input, output) {
  output$slMonthsUI <- renderUI({
    list(
      (HTML(
        sprintf(
          '<script type="text/javascript">
            $(document).ready(function() {
              $(\'#slMonths\').data(\'ionRangeSlider\').update({
                type: "double",
                values: [%s],
                min: 0,
                max: 11,
                from: %i,
                to: %i,
                min_interval: 2,
                drag_interval: true,
                hide_min_max: false,
                grid: false
              })
            })
          </script>',
          paste(paste0('"', kMonths, '"'), collapse = ','),
          kR1EndDefault,
          kR3StartDefault
        )
      ))
    )
  })

  output$htmlMonths <- renderText({
    HTML(
      sprintf(
        paste0("<i>Current selection</i><br /><pre>",
               "Range1: %-8s     [Range2: %s]<br />",
               "Range3: %-8s",
               "</pre>"),
        CalcMonthRange(input$slMonths, "r1"),
        CalcMonthRange(input$slMonths, "r2"),
        CalcMonthRange(input$slMonths, "r3")
      )
    )
  })
}

shinyApp(ui, server)

Neither the rendered UI nor the rendered text are displayed after expanding the initially collapsed "Inputs" box. If the "Inputs" box is initially expanded or the lines marked with # XXX are commented out, all is well.

Here's the session info:

> sessionInfo()
R version 3.3.3 (2017-03-06)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows >= 8 x64 (build 9200)

locale:
[1] LC_COLLATE=English_United States.1252  LC_CTYPE=English_United States.1252   
[3] LC_MONETARY=English_United States.1252 LC_NUMERIC=C                          
[5] LC_TIME=English_United States.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] shinydashboard_0.6.1 shiny_1.0.3         

loaded via a namespace (and not attached):
[1] R6_2.2.2        htmltools_0.3.6 tools_3.3.3     Rcpp_0.12.12    jsonlite_1.5    digest_0.6.12  
[7] xtable_1.8-2    httpuv_1.3.5    mime_0.5 

[gbisschoff]

Hi, I am experiencing the save behavior with a similar setup (Using nested boxes). Just one more comment - even if the box starts out expanded if I collapse it and expand it again the reactivity stops working. I created a simple example using the good old histogram example. I am also using shinydashboard_0.6.1 & shiny_1.0.3.

library(shinydashboard)
library(shiny)

ui <- dashboardPage(
  dashboardHeader(title = "Boxes"),
  dashboardSidebar(),
  dashboardBody(
    uiOutput("Body")
  )

)

server <- function(input, output) {
  output$Body<-renderUI({
    fluidRow(
      class="row-padded-2",
      box(title = "Histogram", width = 12,status = "primary", solidHeader = TRUE,
          collapsible = TRUE, collapsed = FALSE,
          box(
            title = "Inputs", solidHeader = TRUE,
            width = 6,
            "Box content here", br(), "More box content",
            sliderInput("slider", "Slider input:", 1, 100, 50),
            actionButton("update","Update")
          ),
          box(
            title = "Histogram", solidHeader = TRUE,
            width = 6,
            plotOutput("plot3", height = 250)
          )
      )
    )
  })

  data<-eventReactive(input$update,{
    n<-input$slider
    rnorm(n)
  })

  output$plot3<-renderPlot(
    hist(data())
  )

}

shinyApp(ui, server)

[keqiang]

I have the same issue here where the inner box depends on an outside reactive value, it won't update accordingly after expanded if the enclosing box is collapsed as the reactive value gets updated.

[heylue]

Same issue here with shinydashboard 0.7.0. Have you found any workarounds other than not using nested boxes ?

[keqiang]

@heylue I'm including a piece of Javascript code to get around this issue. Make sure you save it to a file say 'helper.js' under 'www' directory and include it in your project using tags$script(). Hope this helps.

  /* 
  There is an issue where nested shinydashboard boxes are collapsed when some outside reactive value updates, and the nested box will not update accordingly.
  This function monitors all the expanding event and force the inner box refresh by sending to the server an event.
  */
  jQuery(function($) {
    // listening to box expanding events, [data-widget="collapse"] is the plus button(or minus when expanded)
    $('.box').find('[data-widget="collapse"]').click(function(event) {
      // find the enclosing collapsed box of the clicked button and then look for child #data-table-1 which has a data table widget
      const myDataTable = $(this).closest(".collapsed-box").find("#data-table-1");
      if(myDataTable.length > 0) { // if found, let the server know
        setTimeout(function(){
          Shiny.onInputChange("theBoxExpanded", Date.now());
        }, 800); // 800ms to ensure the box is fully expanded
      }
    });
  });

Then on the server, you can observe 'input$theBoxExpanded' and re-trigger the inner box to be updated. In my case, I only need to use shinyjs::show('data-talbe-1') which will then redraw itself and thus get the new data.

[gdurif]

Any update on this issue ? same problem with a very simple example.

Here is a MWE, the inside box which is not collapsed by default is not rendered when the main box (which is initially collapsed) is uncollapsed.

Note 1: collapsing and uncollapsing the inside box triggers the rendering.

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
    dashboardHeader(disable = TRUE), dashboardSidebar(disable = TRUE),
    dashboardBody(
        fluidRow(
            box(
                title = "Inputs", collapsible = TRUE, collapsed = TRUE,
                width = 12,
                box(
                    title = "Test", collapsible = TRUE, collapsed = FALSE,
                    uiOutput("test1_ui"),
                    uiOutput("test2_ui")
                )
            )
        )
    )
)

server <- function(input, output, session) {
    output$test1_ui <- renderUI({
        tagList("RENDER ME")
    })
    output$test2_ui <- renderUI({
        actionButton("click", label = "Click Me")
    })
}

shinyApp(ui, server)

Session info:

• Ubuntu 18.04
• R 4.1.
• shinydashboard 0.7.1 and shiny 1.6.0

Note 2: the same problem was observed before update to R 4.1.0

Note 3: I am really not sure how to use the suggested workaround, because my app (not the example) is far more complicated.

[thothal]

I just composed an answer on SO for a similar problem and as a workaround you can listen to the shown.bs.collapse event and re-trigger it (after some delay) for shiny-bound-output children:

js <- "$(() => $('body').on('shown.bs.collapse', '.box', function(evt) { 
      setTimeout(function(){
         $(evt.target).find('.shiny-bound-output').trigger('shown.bs.collapse');
      }, 800);
   }))"

[gunawebs]

SO, what's the official answer on this one?