Shiny и DT: как сбросить выход, который зависит от вычислений по входам? - PullRequest
Новая
       111

Shiny и DT: как сбросить выход, который зависит от вычислений по входам?

1 голос
/ 06 августа 2020

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

У меня довольно сложное приложение, для которого у меня возникли проблемы со сбросом вывода после actionButton («Подтвердить» на в этом примере) запускает повторную оценку числа reactiveValues, которое передает реактивную таблицу.

Это приводит к тому, что таблица selected отображается только один раз, и независимо от того, сколько раз таблица, которая ее передает, изменяется, он продолжает показывать тот же результат, что и при первом рендеринге.

Вам будет легко понять, что я имею в виду из этого примера. Поверьте, это минимакс от того, откуда я исхожу: 

library(shiny)
library(DT)
 

ui <- fluidPage(
  DTOutput("table"),
  actionButton("checkvalues", "Check")
  
)

server <- function(input, output, session) {
  
  primedata <- reactiveValues(data = NULL)
  primedata$data <- as.numeric(Sys.time()) %% 10000 
  
  tabledata <- reactive({
    
    data <- data.frame(rep(primedata$data, 5))
    for (i in 1:5) {
      data$V1[i] <- as.character(selectInput(paste0("sel", i), "",
                                             choices = c("None selected" = 0,
                                                          "Icecream", "Donut"), 
                                                          selected = 0, width = "120px"))
  }
    return(data)
    })
  
  
  output$table <- renderDataTable( #Generar tabla
    
    tabledata(), filter = 'top', escape = FALSE, selection = 'none', server = FALSE,
    callback = JS("table.rows().every(function(i, tab, row) {
            var $this = $(this.node());
            $this.attr('id', this.data()[0]);
            $this.addClass('shiny-input-container');
          });
          Shiny.unbindAll(table.table().node());
          Shiny.bindAll(table.table().node());")
    
  )
  
  # helper function for reading inputs in DT
  shinyValue = function(id, len) { 
    unlist(lapply(seq_len(len), function(i) { 
      value = input[[paste0(id, i)]] 
      if (is.null(value)) NA else value 
    })) 
  }
  
  observeEvent(input$checkvalues, {
    
    datos <- tabledata()
    
      selected <- cbind(datos, data.frame(N = shinyValue("sel", nrow(datos)))) 
      selected <- selected %>% group_by(N) %>% summarise("see" = n())
    showModal(modalDialog(
      title = HTML('<h3 style="text-align:center;">Problem: this table will keep showing the same results as the first one presented</h3>'),
      renderDT(datatable(selected, options = list(dom = 't', ordering = F))),
      footer = actionButton("Confirm", "Confirm")))
    
  })
  
  observeEvent(input$Confirm, {
    
     primedata$data <- as.numeric(Sys.time()) %% 10000
      
     removeModal() 

    })
  
}

shinyApp(ui, server)

1 Ответ

2 голосов
/ 07 августа 2020

Когда вы меняете primedata$data (нажав на кнопку «Подтвердить»), это повторно отображает таблицу, и вы должны отменить привязку перед этим: 

ui <- fluidPage(
  tags$head(tags$script(
    HTML(
      "Shiny.addCustomMessageHandler('unbindDT', function(id) {
        var $table = $('#'+id).find('table');
        if($table.length > 0){
          Shiny.unbindAll($table.DataTable().table().node());
        }
      })")
  )),
  DTOutput("table"),
  actionButton("checkvalues", "Check")
)


  observeEvent(input$Confirm, {
    
    session$sendCustomMessage("unbindDT", "table")
    
    primedata$data <- as.numeric(Sys.time()) %% 10000
    
    removeModal() 
    
  })
...