控制闪亮的更新顺序

Question

这是一个 MWE：

library(shiny)

runApp(shinyApp(
ui = pageWithSidebar(

  fluidRow(
    column(3, wellPanel(

    numericInput("numFields", "Select number of fields", 2, min = 1),
    br(),
    uiOutput("fields"),
    br(),
    actionButton("goButton", "Go!")

    )),

    column(3, wellPanel(      
      uiOutput("morefields")      
    )),

    column(3, wellPanel(

      numericInput("numFields2", "Select number of fields 2", 2, min = 1),
      br(),
      actionButton("goButton2", "Go2!")      

    ))    
  ),

server = function(input, output, session){

  output$fields <- renderUI({
    numFields <- as.integer(input$numFields)
    lapply(1:numFields, function(i) {
      textInput(paste0("field", i), paste0("Type in field ", i))
    })
  })

  output$morefields <- renderUI({

    if (input$goButton == 0) return(NULL)

    isolate({
      numFields <- as.integer(input$numFields)
      lapply(1:numFields, function(i) {
        checkboxInput(paste0("checkbox", i), paste0("Checkbox for field ",
                                                input[[paste0("field", i)]]))
      })
    })
  })

  observeEvent(input$goButton2, {
    numFields2 <- as.integer(input$numFields2)
    last_field <- paste0("field", numFields2)
    updateNumericInput(session, "numFields", value = numFields2)
    updateTextInput(session, "field1", value = "This is the first field")
    updateTextInput(session, last_field, value = "This is the last field")
  })

}))

现在我执行以下一组操作：

1. 启动应用程序
2. 将Select number of fields 2 的值设置为例如3
3. 按下Go2!按钮
4. 在左栏中，输入字段的数量发生了变化，但我希望第一个和最后一个字段都填充文本，所以我再次单击Go2! 按钮
5. 点击Go!按钮，生成中间的UI。

我的目标是避免第 4 步和第 5 步，但要获得相同的结果。

我尝试使用reactiveValues-variable 和模拟点击（建议here）来解决问题：

library(shiny)
library(shinyjs)
jscode <- "shinyjs.click = function(id) { $('#' + id).click(); }"

runApp(shinyApp(
ui = pageWithSidebar(

  useShinyjs(),
  extendShinyjs(text = jscode),

  fluidRow(...)),

server = function(input, output, session){

  vals <- reactiveValues(update = 0)

  output$fields <- renderUI({...})

  output$morefields <- renderUI({...})

  observeEvent(input$goButton2, {
    numFields2 <- as.integer(input$numFields2)
    updateNumericInput(session, "numFields", value = numFields2)
    vals$update <- 1
  })

  observeEvent(vals$update, {
    if (vals$update != 1) return(NULL)

    numFields2 <- as.integer(input$numFields2)
    last_field <- paste0("field", numFields2)
    updateTextInput(session, "field1", value = "This is the first field")
    updateTextInput(session, last_field, value = "This is the last field")

    vals$update <- 2
  })

  observeEvent(vals$update, {
    if (vals$update != 2) return(NULL)    
    js$click("goButton")
    vals$update <- 0
  })

}))

现在第二个 UI 已生成，但字段仍为空。我必须点击Go2! 三次才能完全更新所有用户界面。

我还尝试在server-part 中执行以下操作：

  observeEvent(input$goButton2, {
    numFields2 <- as.integer(input$numFields2)
    updateNumericInput(session, "numFields", value = numFields2)
  }, priority = 2)

  observeEvent(vals$update, {
    numFields2 <- as.integer(input$numFields2)
    last_field <- paste0("field", numFields2)
    updateTextInput(session, "field1", value = "This is the first field")
    updateTextInput(session, last_field, value = "This is the last field")
  }, priority = 1)

  observeEvent(input$goButton2, {
    js$click("goButton")
  }, priority = 0)

再一次，事件的进程看起来有点不同，但仍然需要单击三次才能得到我想要的。

关于如何通过单击Go2! 按钮一次来达到最终结果的任何建议？

Answer 1

我能够扩展您的想法并使其发挥作用，但我必须承认这不是最漂亮的解决方案。第一个问题是您需要确保在我们调用更新它们的值之前生成文本字段，所以我添加了一个

    isolate(
      if (vals$update == 1) {
        vals$update <- 2
      }
    )

到output$fields 并相应地更改了其余的 val$update 值。这解决了第 4 步。下一个问题（修复第 5 步）是有时会在文本输入更新之前调用单选按钮的创建。我不知道如何让 Shiny 让我们知道更新何时完成，所以我所做的是修改点击按钮的 javascript 等待 50 毫秒再点击。

jscode <- "shinyjs.click = function(id) { setTimeout(function(){ $('#' + id).click(); }, 50); }"

同样，这不是最佳的，但它已经晚了，至少它有效，并且它是你可以用作基础的东西。这是完整的代码

library(shiny)
library(shinyjs)
jscode <- "shinyjs.click = function(id) { setTimeout(function(){ $('#' + id).click(); }, 50); }"

runApp(shinyApp(
  ui = fluidPage(
    useShinyjs(),
    extendShinyjs(text = jscode),

    fluidRow(
      column(3, wellPanel(

        numericInput("numFields", "Select number of fields", 2, min = 1),
        br(),
        uiOutput("fields"),
        br(),
        actionButton("goButton", "Go!")

      )),

      column(3, wellPanel(      
        uiOutput("morefields")      
      )),

      column(3, wellPanel(

        numericInput("numFields2", "Select number of fields 2", 2, min = 1),
        br(),
        actionButton("goButton2", "Go2!")      

      ))    
    )),

    server = function(input, output, session){
      vals <- reactiveValues(update = 0)

      output$fields <- renderUI({
        isolate(
          if (vals$update == 1) {
            vals$update <- 2
          }
        )
        numFields <- as.integer(input$numFields)
        lapply(1:numFields, function(i) {
          textInput(paste0("field", i), paste0("Type in field ", i))
        })
      })

      output$morefields <- renderUI({

        if (input$goButton == 0) return(NULL)

        isolate({
          numFields <- as.integer(input$numFields)
          lapply(1:numFields, function(i) {
            checkboxInput(paste0("checkbox", i), paste0("Checkbox for field ",
                                                        input[[paste0("field", i)]]))
          })
        })
      })

      observeEvent(input$goButton2, {
        numFields2 <- as.integer(input$numFields2)
        vals$update <- 1
        updateNumericInput(session, "numFields", value = numFields2)
      })

      observeEvent(vals$update, {
        if (vals$update != 2) return(NULL)

        numFields2 <- as.integer(input$numFields2)
        last_field <- paste0("field", numFields2)
        updateTextInput(session, "field1", value = "This is the first field")
        updateTextInput(session, last_field, value = "This is the last field")

        vals$update <- 3
      })

      observeEvent(vals$update, {
        if (vals$update != 3) return(NULL)    
        js$click("goButton")
        vals$update <- 0
      })

    })
)

希望对你有帮助