порядок управления обновлениями в блестящей

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!, чтобы создать пользовательский интерфейс в середине.

Моя цель состояла в том, чтобы избежать шагов 4 и 5, но получить тот же результат.

Я попытался решить эту проблему с reactiveValues -переменными и моделируемой мыши (как это было предложено 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 
    }) 

})) 

Теперь второй пользовательский интерфейс генерируется, но поля остаются пустыми. Я должен нажать на Go2! три раза, прежде чем все пользовательские интерфейсы полностью обновятся.

Я также попытался сделать следующее в server -части:

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 и изменил остальные значения обновления Вэл $ соответственно. Это позаботилось о шаге 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 
     }) 

    }) 
) 

Надеется, что это помогает