RinteRface / bs4Dash

Bootstrap 4 shinydashboard using AdminLTE3
https://bs4dash.rinterface.com
Other
437 stars 81 forks source link

Maximizing tabBox does not render the graph correctly #262

Open fsalemi opened 2 years ago

fsalemi commented 2 years ago

Hello David, I have an animate process app with shinyDashboard. The tabs need to be maximized for better presentation. As you can see in the following code. This works perfectly, however when I maximize the tab and try to redraw the graph by changing the animation speed in the dropdown menu, the length of the timeline will shrink to 6 and not 12 (full screen). Is there anyway to resize the graph after initial render? Thanks in advance,

## app.R ##
library(shiny)
library(shinyWidgets)
library(bs4Dash)
library(shinycssloaders)
library(processmapR)
library(processanimateR)
library(eventdataR)

ui <- dashboardPage(
  dashboardHeader(
  ),
  dashboardSidebar(
    width = 0
  ),
  dashboardBody(
    tags$head(
      tags$script(
        "$(function() {
              $('[data-card-widget=\"maximize\"]').on('click', function() {
                setTimeout(function() {
                  var isMaximized = $('html').hasClass('maximized-card');
                  if (isMaximized) {
                    $('#process').css('height', '100%');
                  } else {
                    $('#process').css('height', '100%');
                  }
                }, 300);
                $('#process').trigger('resize');
              });
            });
            "
      )
    ),

    fluidRow(
      tabBox(
        id = "Box one",
        height = "79.0vh",
        maximizable = T,
        title = p("", div(style = "position: absolute; right: 35px; top: 3px;",
                          dropdownButton(
                            icon = icon("cog"),
                            size = "default",
                            circle = F,
                            tooltip = F,
                            label = "",
                            right = T,
                            width = "250px",
                            radioButtons("duration",
                                         "Animation Speed",
                                         c("Slow" = 600,
                                           "Medium" = 300,
                                           "Fast" = 90
                                         ),
                                         selected = 300)))),
        tabPanel(
          title = "Tab one",
          align  = "center",
          withSpinner(
            processanimaterOutput("process", height = "76.5vh"), type=6)
        ),
        tabPanel(
          title = "Tab two",
        )
      ),
      tabBox(
        id = "Box two",
        height = "79.0vh",
        maximizable = T,
        tabPanel(
          title = "Tab three",
        )
      )
    )
  )
)

server <- function(input, output) { 
  observe({
    myGraph <- animate_process(patients , process_map(patients)
                               , mode = "absolute"
                               , jitter = 20
                               , repeat_count = 10
                               , duration = as.numeric(input$duration)
                               , initial_state = "paused"
                               , mapping = token_aes(color = token_scale("heading" 
                                                                         , scale = "ordinal" 
                                                                         , range = RColorBrewer::brewer.pal(12, "Paired")
                               )
                               , size = token_scale(5)
                               )
    )

    output$process <- renderProcessanimater({
      myGraph
    })
  })

}

shinyApp(ui, server)

giphy11 image

DivadNojnarg commented 2 years ago

Hi,

I am unable to run your code:

Warning: Error in UseMethod: no applicable method for 'filter' applied to an object of class "NULL"
fsalemi commented 2 years ago

Hello David, Thanks for checking this. Sorry for the error above. I just corrected it and also simplified my code a little bit.

## app.R ##
library(shiny)
library(shinyWidgets)
library(bs4Dash)
library(shinycssloaders)
library(processmapR)
library(processanimateR)
library(eventdataR)

ui <- dashboardPage(
  dashboardHeader(
  ),
  dashboardSidebar(
    width = 0
  ),
  dashboardBody(
    tags$head(
      tags$script(
        "$(function() {
              $('[data-card-widget=\"maximize\"]').on('click', function() {
                setTimeout(function() {
                  var isMaximized = $('html').hasClass('maximized-card');
                  if (isMaximized) {
                    $('#process').css('height', '100%');
                  } else {
                    $('#process').css('height', '100%');
                  }
                }, 300);
                $('#process').trigger('resize');
              });
            });
            "
      )
    ),

    fluidRow(
      tabBox(
        id = "Box one",
        height = "79.0vh",
        maximizable = T,
        title = p("", div(style = "position: absolute; right: 35px; top: 3px;",
                          dropdownButton(
                            icon = icon("cog"),
                            size = "default",
                            circle = F,
                            tooltip = F,
                            label = "",
                            right = T,
                            width = "250px",
                            radioButtons("duration",
                                         "Animation Speed",
                                         c("Slow" = 600,
                                           "Medium" = 300,
                                           "Fast" = 90
                                         ),
                                         selected = 300)))),
        tabPanel(
          title = "Tab one",
          align  = "center",
          withSpinner(
            processanimaterOutput("process", height = "76.5vh"), type=6)
        ),
        tabPanel(
          title = "Tab two",
        )
      ),
      tabBox(
        id = "Box two",
        height = "79.0vh",
        maximizable = T,
        tabPanel(
          title = "Tab three",
        )
      )
    )
  )
)

server <- function(input, output) { 
  observe({
    myMap <- process_map(patients, render = F)
    myGraph <- animate_process(patients, myMap, duration = as.numeric(input$duration), initial_state = "paused")
    output$process <- renderProcessanimater(myGraph)
  })

}

shinyApp(ui, server)

My issue is that in maximized tab mode, when I change the "Animation Speed" in dropdown menu, which actually rendering the graph again, the time-line slider underneath the graph shows in smaller size and not the actual window width in maximized width. As it is shown in the above picture. Again, thanks for looking into this.

DivadNojnarg commented 2 years ago

Few tips. To disable sidebar and header:

dashboardHeader(disable = TRUE),
dashboardSidebar(disable = TRUE)

You don't have to wrap your server code inside observe. Also notice that as myMap is not reactive, there is no need to put it in the server function. It might be defined globally once for all users outside:

myMap <- process_map(patients, render = F)
server <- function(input, output) { 
  myGraph <- reactive(animate_process(patients, myMap, duration = as.numeric(input$duration), initial_state = "paused"))
  output$process <- renderProcessanimater(myGraph())
}

Regarding your issue, while the graph resizes on maximize, the radio button also triggers a re-rendering and the initial width is calculate based on the new width. In theory, there should be no need for rendering everything each time, just update the underlying widget data. Usually, htmlwidget developers expose proxies that can be used on the server side. I tried to change the default widget behavior in https://github.com/DivadNojnarg/processanimateR/tree/feature-proxy. Basically, what I did is to expose a proxy and a method to specifically change the timeline and speed. You'll notice the only data I send is the duration and the widget id:

#' Create a processAnimater proxy
#'
#' Avoids to re-render the same graph. Must be called on the server side
#'
#' @param shinyId Widget unique id.
#' @param session Shiny session.
#
#' @export
processAnimaterProxy <- function(shinyId,  session = shiny::getDefaultReactiveDomain()){
  if (is.null(session)) {
    stop("Proxy function must be called from the server function of a Shiny app")
  }

  object <- list(id = shinyId, session = session)
  class(object) <- "processAnimater_Proxy"
  object
}

#' Update processAnimater timeline
#'
#' @param proxy Proxy id.
#' @param duration New duration.
#' @export
updateTimeline <- function(proxy, duration) {
  data <- list(id = proxy$id, duration = as.numeric(duration))
  proxy$session$sendCustomMessage("update_timeline_processAnimater", data)
  return(proxy)
}

On the JS side, I have couple of edits. Notice the update_timeline_processAnimater event listener. This is the same as called in the above updateTimeline function and a way for me to pass data from R to JavaScript:

if (HTMLWidgets.shinyMode) {
  Shiny.addCustomMessageHandler('update_timeline_processAnimater', function(e){
    // get container id
    var processInstance = HTMLWidgets.find('#' + e.id);
    if (typeof processInstance != 'undefined') {
      var control = processInstance.getPlaybackControl();
      var renderer = processInstance.getRenderer();
      var scales = processInstance.getScales();
      var el = processInstance.getEl();

      var data = renderer.getData();
      data.duration = e.duration;
      console.log(data);

      scales.update(data);
      control.renderPlaybackControl(data, renderer.getSvg(), el.offsetWidth, false);
      renderer.resize(el.offsetWidth, Math.max(0, el.offsetHeight - control.getHeight()));
    }
  });
}

This code is a start but does not seem to work (I see the same speed whatever value I selecte). You should ask @fmannhardt about what should go in this specific proxy JS code (I don't know vis.js at all and just did some quick exploration).

fsalemi commented 2 years ago

Thanks for your time and effort for this case. I cloned your version of processanimateR package and used it in my app, but as you mentioned it did not work and the length of the timeline slider shows up with the initial size of un-maximized initial window of 6 not 12. I will contact @fmannhardt later. As for the speed, in order to apply the change of speed (eg. Slow to Fast), the whole graph should be re-rendered each time we change the speed. In your code, you put the input$duration in a reactive function and per definition "Reactive expressions use lazy evaluation; that is, when their dependencies change, they don't re-execute right away but rather wait until they are called by someone else. Indeed, if they are not called then they will never re-execute." That is why when you select different speed it will not be applied. It should be in an observe function or you can change your code to:

myMap <- process_map(patients, render = F)
server <- function(input, output) {
    output$process <- renderProcessanimater({
      animate_process(patients, myMap, duration = as.numeric(input$duration), initial_state = "paused")
  })
}

Appreciate your other tips regarding shinydashboard. Thanks again for what you do for data science community and its impact on the real-life projects.

DivadNojnarg commented 2 years ago

Sorry I actually put the wrong code in my server function and forgot to send you the new version. With my new code, you only need observeEvent to account for input$duration changes:

observeEvent(input$duration, {
    processAnimaterProxy("process") %>% 
      updateTimeline(input$duration)

  }, ignoreInit = TRUE)

However, the JS part does not work, which means you'll have to check with @fmannhardt.

## app.R ##
library(shiny)
library(shinyWidgets)
library(bs4Dash)
library(shinycssloaders)
library(processmapR)
library(processanimateR)
library(eventdataR)
library(magrittr)

myMap <- process_map(patients, render = F) 
myGraph <-  animate_process(patients, myMap, duration = 300, initial_state = "paused")  

ui <- dashboardPage(
  dashboardHeader(disable = TRUE),
  dashboardSidebar(disable = TRUE),
  dashboardBody(
    tags$head(
      tags$script(
        "$(function() {
          $('[data-card-widget=\"maximize\"]').on('click', function() {
            $('#process').trigger('resize');
          });
        });"
      )
    ),

    fluidRow(
      tabBox(
        id = "Boxone",
        height = "79.0vh",
        maximizable = T,
        title = p(
          "", div(
            style = "position: absolute; right: 35px; top: 3px;",
            dropdownButton(
              icon = icon("cog"),
              size = "default",
              circle = F,
              tooltip = F,
              label = "",
              right = T,
              width = "250px",
              radioButtons(
                "duration",
                "Animation Speed",
                c("Slow" = 600,
                  "Medium" = 300,
                  "Fast" = 90
                ),
                selected = 300
              )
            )
          )
        ),
        tabPanel(
          title = "Tab one",
          align  = "center",
          withSpinner(
            processanimaterOutput("process", height = "76.5vh"), type=6)
        ),
        tabPanel(
          title = "Tab two",
        )
      ),
      tabBox(
        id = "Boxtwo",
        height = "79.0vh",
        maximizable = T,
        tabPanel(
          title = "Tab three",
        )
      )
    )
  )
)

server <- function(input, output) { 
  output$process <- renderProcessanimater(myGraph)

  observeEvent(input$duration, {
    processAnimaterProxy("process") %>% 
      updateTimeline(input$duration)

  }, ignoreInit = TRUE)
}

shinyApp(ui, server)
DivadNojnarg commented 2 years ago

If the graph has to be re-rendered based on new speed, then, there is probably no need for a proxy. However, there should be a way to avoid to trigger resize twice since resize is already invoked on maximize event and also at initial rendering.