在闪亮的应用程序中关闭它时重置模态

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

这里的问题是，disTable仅在触发时才会呈现modalDialog（选中复选框时尚未呈现）。

disTable我们可以通过设置强制闪亮更早渲染（当input$checked_rows更改时）：

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

请检查以下内容：

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)