在 Shiny，R 中按顺序生成动态用户界面答案

【问题标题】：Sequentially Generating a Dynamic User Interface in Shiny, R在 Shiny，R 中按顺序生成动态用户界面
【发布时间】：2017-01-04 07:00:53
【问题描述】：

我在 R 中创建了一个动态用户界面，它在一个流动的行环境中生成四个 selectizeInput 框，并有一组匹配的观察者观察输入。如果选择了addFilter 按钮，则会生成一个带有另外四个框的附加流体行。

我的问题是保存以前输入的值。我有一组存储用户输入的反应值。然后将这些值输入到updateselectize 上的观察者中。如果用户点击缓慢，一切正常。但是，如果用户快速单击，有时这些值会被删除。

我相信会发生这种情况，因为当脚本开始设置新界面时，带有观察者的旧界面还没有完全呈现；但值已被重置。

下面是 MWE。请注意，要触发该错误，您需要快速双击添加过滤器按钮。

服务器.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("")
    )
  )
))

【问题讨论】：

代码格式是个人喜好。第一次编辑也没有改善任何东西。回滚到原始状态。
@DirtySockSniffer 提高清晰度和可读性是编辑的公认理由。回滚到之前的版本。
@Hack-R - 我不会像喝醉了的吼猴一样格式化我的代码如何为这篇文章添加任何有用的东西？此外，仅仅因为你把你的作业写成一行并不意味着这是标准。
@DirtySockSniffer 这是一个有趣的 Dilbert 参考方法，提醒 OP 以可读的方式格式化代码。顺便说一下，这篇 Meta 帖子验证了我的编辑。 meta.stackoverflow.com/questions/260245/… 此外，我不明白你的最后一句话，但我使用的格式是谷歌与谷歌在风格指南中发布的 R 项目联合开发的格式......
感谢您引用 R 项目样式，因为这确实很有帮助。我将对我的“hack”R 风格进行更改。

标签： r shiny selectize.js

【解决方案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)

【讨论】：