Сброс модального при закрытии в блестящем приложении - PullRequest
4 голосов
/ 20 сентября 2019

У меня блестящее приложение, в котором отображается таблица данных.Существует столбец с флажком, который позволяет пользователю выбрать строку и при нажатии кнопки отображается модальное.Модал содержит таблицу с подмножеством таблицы данных, включая только выбранную строку (мое реальное приложение вызывает другую функцию, но эффект тот же)

Однако, когда пользователь отменяет выбор строки и выбирает другую строку,предыдущий контент в модели отображается перед заменой новым.

Есть ли способ сброса модели при каждом нажатии кнопки?

Вот код, который я использую:

      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();
                              });'
                  )
                )

Но это не работает

Спасибо

1 Ответ

1 голос
/ 23 сентября 2019

Проблема здесь в том, что 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)
...