我有一个 Shiny 的应用程序,其中显示了一个数据表。有一列带有复选框,允许用户选择该行,并在按下按钮时显示模式。模态包含一个表,该表具有数据表的子集,该子表仅包括选定的行(我的真实应用触发了另一个功能,但效果相同)

但是,当用户取消选择该行并选择另一行时,将显示模型中的先前内容,然后将其替换为新内容。

每次按下按钮有什么方法可以重置模型?

这是我正在使用的代码:

      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)

在上面粘贴的代码中,我尝试使用以下方法重置模式:
              tags$script(HTML('$(".modal").on("hidden.modal1", function(){
                                  $(this).removeData();
                              });'
                  )
                )

但这不起作用

谢谢

最佳答案

这里的问题是,仅当触发disTable时才呈现modalDialog(在选中复选框时尚未呈现)。

我们可以通过设置以下方式来强制Shiny提早渲染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)

10-05 22:15