Последовательная генерация динамического пользовательского интерфейса в Shiny, R

Я создал динамический пользовательский интерфейс в R, который генерирует четыре selectizeInput боксы в среде текучих рядов с соответствующим набором наблюдателей, следящих за вводом. Если addFilter После выбора кнопки создается дополнительный ряд жидкости с четырьмя другими ячейками.

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

Я полагаю, что это происходит потому, что к моменту, когда скрипт настраивает новый интерфейс, старый с наблюдателями еще не был отрисован; но значения были сброшены.

Ниже MWE. Обратите внимание: чтобы вызвать ошибку, нужно быстро дважды щелкнуть кнопку "Добавить фильтр".

Server.R:

library(shiny)

shinyServer(function(session, input, output) {

  rValues <- reactiveValues(filter_counter = 1, filter_counter2 = 1, filter_waiter = 1, savedFil_1 = "", savedOp_1 = "",
                            savedCrit_1 = "", savedAO_1 = "")

  columns <- c("C1", "C2")

  operators <- c("O1", "O2")
  values <- c("V1", "V2")
  andor <- c("&&", "||")

  observeEvent(input$AddFilter,{
    if (rValues[['filter_waiter']] == 1) {
      # Step 1: Store 
      lapply(1:rValues$filter_counter, function(i) {
        rValues[[paste0("savedFil_", i)]] <- input[[paste0("fil_", i)]]
        rValues[[paste0("savedOp_", i)]] <- input[[paste0("filOperators_", i)]]
        rValues[[paste0("savedCrit_", i)]] <- input[[paste0("filCriteria_", i)]]
        rValues[[paste0("savedAO_", i)]] <- input[[paste0("andor_", i)]]
      })

      # Step 2: Increment counter
      rValues$filter_counter <- rValues$filter_counter + 1

      # Step 3: Set filter waiter
      rValues[['filter_waiter']] <- 0
    } 
  })

  output$filters <- renderUI({
    if (rValues[['filter_waiter']] == 1) {
      ui <- lapply(1:rValues$filter_counter, function(i) {
        fluidRow(
          column(4, selectizeInput(paste0("fil_", i), label = NULL, choices = NULL)),
          column(2, selectizeInput(paste0("filOperators_", i), label = NULL, choices = NULL)),
          column(4, selectizeInput(paste0("filCriteria_", i), label = NULL, choices = NULL)),
          column(2, selectizeInput(paste0("andor_", i), label = NULL, choices = NULL)))
      })
      return(ui)
    }
  })

  ### Create observers for filters
  observe({
    lapply(1:rValues$filter_counter, function(i){
      # Update the Selectizes
      updateSelectizeInput(session, paste0("fil_", i), selected = rValues[[paste0("savedFil_", i)]], choices = columns, server = TRUE)
      updateSelectizeInput(session, paste0("filOperators_", i), selected = rValues[[paste0("savedOp_", i)]], choices = operators, server = TRUE)
      updateSelectizeInput(session, paste0("filCriteria_", i), selected = rValues[[paste0("savedCrit_", i)]], choices = values, server = TRUE)
      updateSelectizeInput(session, paste0("andor_", i), selected = rValues[[paste0("savedAO_", i)]], choices =  c("", "&&", "||"), server = TRUE)
    })

    rValues[['filter_waiter']] <- 1
  })
})

И UI.R:

library(shiny)

shinyUI(fluidPage(

  # Application title
  titlePanel("Dynamic SelectizeInput UI"),

  sidebarLayout(
    sidebarPanel(
      actionButton("AddFilter", label = "Add a Filter"),
      uiOutput("filters")
    ),

    mainPanel(
      h1("")
    )
  )
))

1 ответ

Решение

Ваш код может быть упрощен. Вам не нужно обновлять элементы управления selectizeInput, так как вы генерируете новые элементы управления каждый раз при нажатии кнопки. У вас слишком много реактивных переменных. Я перехожу на глобальные переменные. Если вы не хотите использовать глобальные переменные, используйте реактивные переменные с изоляцией.

library(shiny)

filter_counter <- 0
filter_values  <- list()
columns        <- c("C1", "C2") 
operators      <- c("O1", "O2")
values         <- c("V1", "V2")
andor          <- c("&&", "||") 

server<- shinyServer(function(session, input, output) {   

  output$filters <- renderUI({  

      input$AddFilter  
      # Step 1: store filter values
      if ( filter_counter>0) {
          lapply(1:filter_counter, function(i) {
            filter_values[[paste0("savedFil_", i)]]  <<- input[[paste0("fil_", i)]]
            filter_values[[paste0("savedOp_", i)]]   <<- input[[paste0("filOperators_", i)]]
            filter_values[[paste0("savedCrit_", i)]] <<- input[[paste0("filCriteria_", i)]]
            filter_values[[paste0("savedAO_", i)]]   <<- input[[paste0("andor_", i)]]
          })
      }

      # Step 2: Increment counter 
      filter_counter <<-  filter_counter + 1 

      # Step 3: generate selectInputs
      ui <- lapply(1:filter_counter, function(i){ 
          fluidRow(
              column(4,selectizeInput(paste0("fil_", i), label= 'fil', selected = filter_values[[paste0("savedFil_", i)]], choices = columns )),
              column(2,selectizeInput(paste0("filOperators_", i),label= 'filop',  selected = filter_values[[paste0("savedOp_", i)]], choices = operators )),
              column(4,selectizeInput(paste0("filCriteria_", i),label= 'filcri',  selected = filter_values[[paste0("savedCrit_", i)]], choices = values )),
              column(2,selectizeInput(paste0("andor_", i),label= 'andor',  selected = filter_values[[paste0("savedAO_", i)]], choices =  c("", "&&", "||") ))
          )
      }) 

    })
})


ui <- shinyUI(fluidPage(

  # Application title
  titlePanel("Dynamic SelectizeInput UI"),

  sidebarLayout(
    sidebarPanel(
      actionButton("AddFilter", label = "Add a Filter"),
      uiOutput("filters")
    ),

    mainPanel(
      h1("")
    )
  )
))

shinyApp(ui , server)
Другие вопросы по тегам