-1

Here is an 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")
  })

}))

Now I perform the following set of actions:

  1. Starting the app
  2. Set the value of Select number of fields 2 to e.g. 3
  3. Press the Go2! button
  4. Within the left column, the number of input fields is changed, but I'd like the first and the last field to be filled with text, so I click on the Go2! button again
  5. Click on the Go! button so that the UI in the middle is generated.

My aim would be to avoid steps 4 and 5, but to get the same result.

I tried to solve the issue with a reactiveValues-variable and a simulated click (as proposed 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
  })

}))

Now the second UI is generated, but the fields remain empty. I have to click on Go2! three times before all the UIs get completely updated.

I also tried doing the following within the 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)

Again the course of events look a bit different, but still clicking thrice is necessary to get what I want.

Any suggestions on how to achieve the final result by clicking on the Go2! button only once?

Community
  • 1
  • 1
AnjaM
  • 2,941
  • 8
  • 39
  • 62

1 Answers1

2

I was able to extend your idea and make it work, though I must admit it's not the prettiest solution. The first problem was that you need to make sure the text fields are generated before we make the call to update their values, so I added a

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

to output$fields and changed the rest of the val$update values accordingly. This took care of step 4. The next problem (to fix step 5) was that the creation of the radio buttons was sometimes called before the text inputs were updated. I don't know how to ask shiny to let us know when an update is done, so instead what I did was modify the javascript that clicks on the button to wait 50 milliseconds before clicking.

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

Again, this isn't optimal, but it's late and at least it works and it's something you can use as a basis. Here's the full code

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
      })

    })
)

Hope this helps

DeanAttali
  • 25,268
  • 10
  • 92
  • 118