-1

这是一个 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 和模拟点击来解决问题（如此处建议）：

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!在所有 UI 完全更新之前，我必须单击3 次。

我还尝试在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!仅单击一次按钮来实现最终结果的任何建议？

4

1 回答 1

2

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

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

并相应地output$fields更改了其余的 val$update 值。这解决了第 4 步。下一个问题（修复第 5 步）是有时会在文本输入更新之前调用单选按钮的创建。我不知道如何要求闪亮让我们知道更新何时完成，所以我所做的是修改点击按钮的 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
      })

    })
)

希望这可以帮助

于 2015-07-21T08:08:19.350 回答