Resetting modal when closing it in a shiny app

Question

I have a shiny app where a datatable is displayed. There is a column with a checkbox that allows the user to select the row and when pressing a button a modal is displayed. The modal contains a table with a subset of the datatable including only the row selected (my real app triggers another function but the effect is the same)

However, when the user deselects the row and selects another row, the previous content in the model is displayed before being replaced with the new one.

Is there any way of resetting the model everytime the button is pressed?

Here is the code I am using:

      library(shinydashboard)
      library(shinydashboardPlus)
      library(shiny)
      library(flextable)
      data(mtcars)


      header <- dashboardHeader()

      sidebar <- dashboardSidebar()

      body <- dashboardBody(

            fluidPage(
              tags$head(tags$style("#modal1 .modal-body {padding: 10px}
                #modal1 .modal-content  {-webkit-border-radius: 12px !important;-moz-border-radius: 12px !important;border-radius: 12px !important;}
                #modal1 .modal-dialog { width: 800px; display: inline-block; text-align: left; vertical-align: top;}
                #modal1 .modal-header {background-color: #339FFF; border-top-left-radius: 6px; border-top-right-radius: 6px}
                #modal1 .modal { text-align: center; padding-right:10px; padding-top: 24px;}
                #moda1 .close { font-size: 16px}")),        
              tags$script(HTML('$(".modal").on("hidden.modal1", function(){
                                  $(this).removeData();
                              });'
                  )
                ),             
              fluidRow(
                column(2,offset = 2,
                  HTML('<div class="btn-group" role="group" aria-label="Basic example">'),
                  actionButton(inputId = "Compare_row_head",label = "Get full data"),
                  HTML('</div>')
                ),

                column(12,dataTableOutput("tabla")),
                  tags$script(HTML('$(document).on("click", "input", function () {
                  var checkboxes = document.getElementsByName("row_selected");
                  var checkboxesChecked = [];
                  for (var i=0; i<checkboxes.length; i++) {
                    if (checkboxes[i].checked) {
                      checkboxesChecked.push(checkboxes[i].value);
                    }
                  }
                  Shiny.onInputChange("checked_rows",checkboxesChecked);})')
                  ),
                tags$script("$(document).on('click', '#Main_table button', function () {
                          Shiny.onInputChange('lastClickId',this.id);
                          Shiny.onInputChange('lastClick', Math.random())
                          });")

              )
            )
      )

      ui <- dashboardPagePlus(enable_preloader = TRUE, sidebar_fullCollapse = TRUE, header, sidebar, body)


      ## Server side
      server = function(input, output, session) {

      data("mtcars")
        # Reactive function creating the DT output object
        output$tabla <- renderDataTable({    
            req(mtcars)    
            data <- mtcars
            data
            data[["Select"]]<-paste0('<input type="checkbox" name="row_selected" value="Row',1:nrow(data),'"><br>')
            datatable(data, escape = FALSE)
          })

        ###Modal visualisation 
        observeEvent(input$Compare_row_head,{
          showModal(tags$div(id="modal1", annotation_modal1))
          }
        )

        annotation_modal1<-modalDialog(
          fluidPage(
            h3(strong("Example modal"),align="left"),
            uiOutput('disTable')
          ),
          size="l"
        )

          output$disTable <- renderUI({
          req(input$checked_rows)
          row_to_sel=as.numeric(gsub("Row","",input$checked_rows))

          if (length(row_to_sel)){
          #if (length(s)) {
            #df <- vals$fake_sales
            df <- mtcars
            df <- as.data.frame(df[row_to_sel,])
            ft <- flextable(df)
            ft <- flextable::bold(ft, part="header")
            ft <- flextable::autofit(ft)
            ft <- flextable::width(ft, j=2, width=.1)
            ft <- flextable::align(ft, align = "left", part = "all" )
            ft %>% htmltools_value()
          }
        })
      } # Server R

      shinyApp(ui, server)

In the code pasted above I have tried to reset the modal using this:

              tags$script(HTML('$(".modal").on("hidden.modal1", function(){
                                  $(this).removeData();
                              });'
                  )
                )

But it doesn't work

Thanks

Answer 1

The problem here is, that disTable only is rendered when your modalDialog is triggered (not already when the boxes are checked).

We can force shiny to render disTable earlier (when input$checked_rows is changed) by setting:

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

Please check the following:

library(shinydashboard)
library(shinydashboardPlus)
library(shiny)
library(DT)
library(flextable)
data(mtcars)


header <- dashboardHeader()

sidebar <- dashboardSidebar()

body <- dashboardBody(

  fluidPage(
    tags$head(tags$style("#modal1 .modal-body {padding: 10px}
                #modal1 .modal-content  {-webkit-border-radius: 12px !important;-moz-border-radius: 12px !important;border-radius: 12px !important;}
                #modal1 .modal-dialog { width: 800px; display: inline-block; text-align: left; vertical-align: top;}
                #modal1 .modal-header {background-color: #339FFF; border-top-left-radius: 6px; border-top-right-radius: 6px}
                #modal1 .modal { text-align: center; padding-right:10px; padding-top: 24px;}
                #moda1 .close { font-size: 16px}")),
    fluidRow(
      column(2,offset = 2,
             HTML('<div class="btn-group" role="group" aria-label="Basic example">'),
             actionButton(inputId = "Compare_row_head",label = "Get full data"),
             HTML('</div>')
      ),

      column(12,dataTableOutput("tabla")),
      tags$script(HTML('$(document).on("click", "input", function () {
                  var checkboxes = document.getElementsByName("row_selected");
                  var checkboxesChecked = [];
                  for (var i=0; i<checkboxes.length; i++) {
                    if (checkboxes[i].checked) {
                      checkboxesChecked.push(checkboxes[i].value);
                    }
                  }
                  Shiny.onInputChange("checked_rows",checkboxesChecked);})')
      ),
      tags$script("$(document).on('click', '#Main_table button', function () {
                          Shiny.onInputChange('lastClickId',this.id);
                          Shiny.onInputChange('lastClick', Math.random())
                          });")

    )
  )
)

ui <- dashboardPagePlus(enable_preloader = TRUE, sidebar_fullCollapse = TRUE, header, sidebar, body)


## Server side
server = function(input, output, session) {

  data("mtcars")
  # Reactive function creating the DT output object
  output$tabla <- renderDataTable({    
    req(mtcars)    
    data <- mtcars
    data
    data[["Select"]]<-paste0('<input type="checkbox" name="row_selected" value="Row',1:nrow(data),'"><br>')
    datatable(data, escape = FALSE)
  })

  ###Modal visualisation 
  observeEvent(input$Compare_row_head,{
    showModal(tags$div(id="modal1", annotation_modal1))
  }
  )

  annotation_modal1 <- modalDialog(
    fluidPage(
      h3(strong("Example modal"), align="left"),
      uiOutput('disTable')
    ),
    size="l"
  )

  output$disTable <- renderUI({

    req(input$checked_rows)
    row_to_sel=as.numeric(gsub("Row", "", input$checked_rows))

    if (length(row_to_sel)){
      #if (length(s)) {
      #df <- vals$fake_sales
      df <- mtcars
      df <- as.data.frame(df[row_to_sel,])
      ft <- flextable(df)
      ft <- flextable::bold(ft, part="header")
      ft <- flextable::autofit(ft)
      ft <- flextable::width(ft, j=2, width=.1)
      ft <- flextable::align(ft, align = "left", part = "all" )
      ft %>% htmltools_value()
    }
  })

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

} # Server R

shinyApp(ui, server)