Я столкнулся с неожиданным поведением. Я собираюсь сделать следующее: - когда пользователи нажимают «Выбрать все», выбираются все строки в «Сводной таблице». Это работает. Однако приведенный ниже код не вызывается.

data <- eventReactive(input$selectAll,{
      print("Select All - restore data")
      rawdata

  })

- с другой стороны, когда пользователи нажимают «Отменить выбор всех», все строки в «Сводной таблице» отменяются. Это работает, и код ниже вызывает.

# Restore data when users click 'Deselect All'
  data <- eventReactive(input$deselectAll,{
      print("Deselect All - restore data")
      rawdata
  })

Есть идеи почему?

Вот мой полный код:

DATASET

colA <- c('A','B','C','D','E')
colB <- c(1,2,3,4,5)
rawdata <- as.data.frame(cbind(colA,colB))
View(rawdata)

Server.R

function(input, output, session) {

  # Activate tab 'Result' when users click 'Run'
  observeEvent(input$runButton, {
      updateTabsetPanel(session, "allResults", 'result')
  })

  # Create a dataset based on users' selected variables
  data <- eventReactive(input$inputVars_rows_selected,{
      print("Select Some Vars")
      rawdata[, c(input$inputVars_rows_selected)]
  })

  # Restore data when users click 'Select All'
  data <- eventReactive(input$selectAll,{
      print("Select All - restore data")
      rawdata
  })

  # Restore data when users click 'Deselect All'
  data <- eventReactive(input$deselectAll,{
      print("Deselect All - restore data")
      rawdata
  })

  ### VARIABLE SELECTION ####

  var <- reactiveValues()

  # Select all vars
  observeEvent(input$selectAll,{
      print("SelectAll ObserveEvent")
      var$selected <- 1:nrow(rawdata)
      print(var$selected)
  })

  # Deselect all vars
  observeEvent(input$deselectAll,{
      print("deselectAll ObserveEvent")
      var$selected <- 0
      print(var$selected)
      print(data())
  })

  ### RESULT TAB ###

  result <- eventReactive (input$runButton, {
      head(data(),2)
  })

  ### RENDERING FUNCTIONS ###

  # Default SummaryTable
  output$inputVars <- DT::renderDataTable({
      if (input$selectAll==0 & input$deselectAll==0) {
          print("Default Summary Table")
          DT::datatable(rawdata, options = list(paging = FALSE, searching = FALSE))
      } 
      else {
          DT::datatable(rawdata, options = list(paging = FALSE, searching = FALSE), selection = list(target = 'row', selected = var$selected))
      }
  })

  # Display results
  output$result <- DT::renderDataTable({
      DT::datatable(result(), options = list(paging = FALSE, searching = FALSE))
  })

  output$temp <- renderPrint({
      print(input$selectAll)
      print(input$deselectAll)
  })
}

Ui.R

fluidPage(

  sidebarPanel(
      actionButton("runButton", strong("Run!"))
  ),

  mainPanel(
      tabsetPanel(id = "allResults",
        tabPanel(value='inputVars',title='Variable Selection', 
                  verticalLayout(
                      DT::dataTableOutput('inputVars'),
                      br(),
                      fluidRow(align="bottom", 
                             column(2, actionButton("selectAll"  , strong("Select All"))),
                             column(3, actionButton("deselectAll", strong("Deselect All")))
                      )
                  )
                ),
        tabPanel(value='result',title='Result', DT::dataTableOutput('result')),
        tabPanel(value='temp',title="TEMP", verbatimTextOutput("temp"))
      )
  )

)

ОБНОВЛЕНО Server.R # 2: @Mike и @HubertL, я думаю, что вы правы: проблема вызвана тем, что eventReactive имеет кэшированные значения. В этой обновленной версии наблюдайте, как событие «Все» и «Отключить все» работают должным образом. Однако теперь eventReactive, соответствующий input $ inputVars_rows_selected, НИКОГДА не вызывается. Есть идеи почему?

function(input, output, session) {

  # Activate tab 'Result' when users click 'Run'
  observeEvent(input$runButton, {
    updateTabsetPanel(session, "allResults", 'result')
  })

  data <- reactiveValues()

  # Create a dataset based on users' selected variables
   data <- eventReactive(input$inputVars_rows_selected,{
       print("Select Some Vars")
       print(input$inputVars_rows_selected)
       rawdata[, c(input$inputVars_rows_selected)]
  })


  ### VARIABLE SELECTION ####

  var <- reactiveValues()

  # Select all vars
  observeEvent(input$selectAll,{
    print("SelectAll ObserveEvent")
    data <- rawdata
    var$selected <- 1:nrow(rawdata)
    print(var$selected)
    print(data)

  })

  # Deselect all vars
  observeEvent(input$deselectAll,{
    print("deselectAll ObserveEvent")
    data <- rawdata
    var$selected <- 0
    print(var$selected)
    print(data)

  })

  ### RESULT TAB ###

  result <- eventReactive (input$runButton, {
    head(data(),2)
  })

  ### RENDERING FUNCTIONS ###

  # Default SummaryTable
  output$inputVars <- DT::renderDataTable({
    if (input$selectAll==0 & input$deselectAll==0) {
      print("Default Summary Table")
      DT::datatable(rawdata, options = list(paging = FALSE, searching = FALSE))
    } 
    else {
      DT::datatable(rawdata, options = list(paging = FALSE, searching = FALSE), selection = list(target = 'row', selected = var$selected))
    }
  })

  # Display results
  output$result <- DT::renderDataTable({
    DT::datatable(result(), options = list(paging = FALSE, searching = FALSE))
  })

  output$temp <- renderPrint({
    print(input$selectAll)
    print(input$deselectAll)
    print(input$inputVars_rows_selected)

  })
}
1
Ketty 27 Май 2017 в 23:26

2 ответа

Лучший ответ

Одна из причин заключается в том, что eventReactive «лениво оценивается», а не observeEvent, который оценивается немедленно.

Так что в вашем случае observeEvent, соответствующий deselectAll, фактически использует data(), так что reactiveEvent запускается.

  # Deselect all vars
  observeEvent(input$deselectAll,{
    print("deselectAll ObserveEvent")
    var$selected <- 0
    print(var$selected)
    print(data())
  })

Но observeEvent, соответствующий selectAll, не использует data(), поэтому reactiveEvent не запускается:

  # Select all vars
  observeEvent(input$selectAll,{
    print("SelectAll ObserveEvent")
    var$selected <- 1:nrow(rawdata)
    print(var$selected)
  })

Я предлагаю следующие изменения

  • Если вы добавите print(data()) здесь, вы получите некоторые поведения, которое вы ищем.

  • Но это все еще не совсем правильно, потому что комментарий Хьюберта о том, что одно определение data, которое перезаписывается, также допустимо - и обратите внимание, что не легко сказать, куда это данные извлекаются. Это потому, что eventReactive кэшировали значения, поэтому ваш print может не отображаться, если используется кэшированное значение - ваш код должен быть выполнено, чтобы вытащить это data().

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

  • Также нет необходимости использовать eventReactive здесь, вы, вероятно, хочу простой reactive. eventReactive обычно требуется, если вы хочу избежать "реакций" от всех других реактивных переменных в код, и я не вижу необходимости в этом здесь.

  • Я также рекомендовал бы поместить rawdata в reactiveValues что-то вроде этого: rv <- reactiveValues(rawdata=rawdata), а затем использовать его как rv$rawdata. Это делает его реактивным, и тогда что-то, что его использует, будет запущено и пересчитано, если оно когда-либо изменится.

Смотрите эту ссылку (Наблюдение за событием и событиеReactive) для обсуждение "лени" этих команд.

1
Mike Wise 27 Май 2017 в 21:28

Ниже приведен код, который работает. @Mike и @HubertL были правы. Причина в том, что реактивный ленив против наблюдения. Спасибо всем за помощь!

function(input, output, session) {

  # Activate tab 'Result' when users click 'Run'
  observeEvent(input$runButton, {
    updateTabsetPanel(session, "allResults", 'result')
  })  

  data <- reactive({
     print("Select Some Vars")
     print(input$inputVars_rows_selected)
     rawdata[input$inputVars_rows_selected,]
  })

  ### VARIABLE SELECTION ####

  var <- reactiveValues()

  # Select all vars
  observeEvent(input$selectAll,{
    print("SelectAll --- ObserveEvent")
    var$selected <- 1:nrow(rawdata)
    print(var$selected)
    print(input$inputVars_rows_selected)
  })

  # Deselect all vars
  observeEvent(input$deselectAll,{
    print("deselectAll --- ObserveEvent")
    var$selected <- 0
    print(var$selected)
  })

  ### RESULT TAB ###

  result <- eventReactive (input$runButton, {
    head(data(),5)
  })

  ### RENDERING FUNCTIONS ###

  # Default SummaryTable
  output$inputVars <- DT::renderDataTable({
    if (input$selectAll==0 & input$deselectAll==0) {
      print("Default Summary Table")
      DT::datatable(rawdata, options = list(paging = FALSE, searching = FALSE))
    } 
    else {
      DT::datatable(rawdata, options = list(paging = FALSE, searching = FALSE), selection = list(target = 'row', selected = var$selected))
    }
  })

  # Display results
  output$result <- DT::renderDataTable({
    DT::datatable(result(), options = list(paging = FALSE, searching = FALSE))
  })

  output$temp <- renderPrint({
    print(input$selectAll)
    print(input$deselectAll)
    print(input$inputVars_rows_selected)

  })
}
1
Ketty 29 Май 2017 в 18:47