multiple modelstudio objects overlap

[tcash21]

I made a minimal reprex below but the general idea is that I want my user to be able to press a button and see the modelstudio results. This works the first time, but if they run it again, the results overlap. I've tried a bunch of things including removing and re-adding the HTML element, but wasn't sure if there's something simple I'm missing to be able to do this.

library(r2d3)
library(modelStudio)
library(DALEX)

ui <- fluidPage(
  actionButton(inputId = 'go', "Go"),
  uiOutput('dashboard')
)

ms <- reactiveValues(model = NULL)

server <- function(input, output) {
  #:# id of div where modelStudio will appear
  WIDGET_ID = 'MODELSTUDIO'

  observeEvent(input$go, {
    model <- glm(survived ~., data = titanic_imputed, family = "binomial")
    explainer <- DALEX::explain(model,
                                data = titanic_imputed,
                                y = titanic_imputed$survived,
                                label = "Titanic GLM",
                                verbose = FALSE)
    ms$model <- modelStudio(explainer,
                      widget_id = WIDGET_ID,  #:# use the widget_id 
                      show_info = FALSE)    
    ms$model$elementId <- NULL                      #:# remove elementId to stop the warning

  })

  #:# basic render d3 output
  output[[WIDGET_ID]] <- renderD3({
    if(input$go == 0){
      return()
    } else{
      ms$model 
    }

  })

  #:# use render ui to set proper width and height
  output$dashboard <- renderUI({
    if(input$go == 0){
      return()
    } else {
      d3Output(WIDGET_ID, width=ms$model$width, height=ms$model$height)  
    }

  })
}

shinyApp(ui = ui, server = server)

[hbaniecki]

Hi, I did some tests concerning this issue, and at this moment:

1. I have no clue why simply adding removeUI(selector = paste0("#", WIDGET_ID), immediate = TRUE) in observeEvent() doesn't fix the issue. Looking at the (web) console: the whole widget with modelStudio is properly removed from the HTML code, and then, when it is (re)rendered, it appears with doubled elements for some unknown reason. Is there some invisible caching mechanism? (open question)
2. I used removeUI() with shinyjs::refresh() to fix the above issue, but I believe it is not satisfactory, as there could be drawbacks of refreshing with respect to other UI elements in the app. Example:

   
   library(r2d3)
   library(modelStudio)
   library(DALEX)
   library(shiny)

ui <- fluidPage( shinyjs::useShinyjs(), # ------------------------------------ need to add this actionButton(inputId = 'go', "Go"), uiOutput('dashboard') )

ms <- reactiveValues(model = NULL, iter = 0)

server <- function(input, output) {

:# id of div where modelStudio will appear

WIDGET_ID = 'MODELSTUDIO'

observeEvent(input$go, { removeUI(selector = paste0("#", WIDGET_ID), immediate = TRUE) # ---- shiny shinyjs::refresh() # ----------------------------------------------- shinyjs ms$iter <- ms$iter + 1 # ---- change explain() label to see the change in ms print(ms$iter)

model <- glm(survived ~., data = titanic_imputed, family = "binomial")
explainer <- DALEX::explain(model,
                            data = titanic_imputed,
                            y = titanic_imputed$survived,
                            label = ifelse(ms$iter == 1, "Titanic GLM", "IT CHANGED"),
                            verbose = FALSE)
x <- modelStudio(explainer,
                        widget_id = WIDGET_ID,  #:# use the widget_id 
                        show_info = TRUE)    
x$elementId <- NULL                      #:# remove elementId to stop the warning
ms$model <- x

})

:# basic render d3 output

output[[WIDGET_ID]] <- renderD3({ ms$model })

:# use render ui to set proper width and height

output$dashboard <- renderUI({ d3Output(WIDGET_ID, width=ms$model$width, height=ms$model$height)
}) }

shinyApp(ui = ui, server = server)

[tcash21]

Thank you for the prompt reply! I incorporated your fix but just needed to capture some tab switching logic since it refreshes everything. Here's what I did in case you're curious:

observeEvent(input$tabs, {
    if(input$tabs == 'Data Explorer' & !is.null(input$i_file)){
      removeUI(selector = paste0("#", WIDGET_ID), immediate = TRUE) # ---- shiny
      shinyjs::refresh() # ----------------------------------------------- shinyjs
    }
  })

[hbaniecki]

Thanks for the above code chunk. Hopefully, this discussion helps someone in the future (do not hesitate to reopen if needed).