'shiny: updateSelectInput for a module UI (after insertUI)

The following shiny app uses modules, it works:

library(shiny)


LHSchoices <- c("X1", "X2", "X3", "X4")

LHSchoices2 <- c("S1", "S2", "S3", "S4")

#------------------------------------------------------------------------------#

# MODULE UI ----
variablesUI <- function(id, number) {

  ns <- NS(id)

  tagList(
    fluidRow(
      column(6,
             selectInput(ns("variable"),
                         paste0("Select Variable ", number),
                         choices = c("Choose" = "", LHSchoices)
             )
      ),

      column(6,
             numericInput(ns("value.variable"),
                          label = paste0("Value ", number),
                          value = 0, min = 0
             )
      )
    )
  )

}

#------------------------------------------------------------------------------#

# MODULE SERVER ----

variables <- function(input, output, session, variable.number){
  reactive({

    req(input$variable, input$value.variable)

    # Create Pair: variable and its value
    df <- data.frame(
      "variable.number" = variable.number,
      "variable" = input$variable,
      "value" = input$value.variable,
      stringsAsFactors = FALSE
    )

    return(df)

  })
}

#------------------------------------------------------------------------------#

# Shiny UI ----

ui <- fixedPage(
  tabsetPanel(type = "tabs",id="tabs",
              tabPanel("t1",value="t1"),
              tabPanel("t2",value="t2")),

  variablesUI("var1", 1),
  h5(""),
  actionButton("insertBtn", "Add another line"),

  verbatimTextOutput("test1"),
  tableOutput("test2")
)

# Shiny Server ----

server <- function(input, output) {

  add.variable <- reactiveValues()

  add.variable$df <- data.frame("variable.number" = numeric(0),
                                "variable" = character(0),
                                "value" = numeric(0),
                                stringsAsFactors = FALSE)

  var1 <- callModule(variables, paste0("var", 1), 1)

  observe(add.variable$df[1, ] <- var1())

  observeEvent(input$insertBtn, {

    btn <- sum(input$insertBtn, 1)

    insertUI(
      selector = "h5",
      where = "beforeEnd",
      ui = tagList(
        variablesUI(paste0("var", btn), btn)
      )
    )

    newline <- callModule(variables, paste0("var", btn), btn)

    observeEvent(newline(), {
      add.variable$df[btn, ] <- newline()
    })

  })

  output$test1 <- renderPrint({
    print(add.variable$df)
  })

  output$test2 <- renderTable({
    add.variable$df
  })

}

#------------------------------------------------------------------------------#

shinyApp(ui, server)

Now, I would like to update the selectInput, with dynamic choices. For this, I found this answer, and it is possible to use the function updateSelectInput.

But in this app, the selectInput is in a module. The following doesn't work

  observe({
    updateSelectInput(session, "variable",
                      choices = choices_var()
    )})

choices_var() is some reactive values (it can depend on the selected tab for example).

Here is the full code.

library(shiny)


LHSchoices <- c("X1", "X2", "X3", "X4")

LHSchoices2 <- c("S1", "S2", "S3", "S4")

#------------------------------------------------------------------------------#

# MODULE UI ----
variablesUI <- function(id, number) {

  ns <- NS(id)

  tagList(
    fluidRow(
      column(6,
             selectInput(ns("variable"),
                         paste0("Select Variable ", number),
                         choices = c("Choose" = "", LHSchoices)
             )
      ),

      column(6,
             numericInput(ns("value.variable"),
                          label = paste0("Value ", number),
                          value = 0, min = 0
             )
      )
    )
  )

}

#------------------------------------------------------------------------------#

# MODULE SERVER ----

variables <- function(input, output, session, variable.number){
  reactive({

    req(input$variable, input$value.variable)

    # Create Pair: variable and its value
    df <- data.frame(
      "variable.number" = variable.number,
      "variable" = input$variable,
      "value" = input$value.variable,
      stringsAsFactors = FALSE
    )

    return(df)

  })
}

#------------------------------------------------------------------------------#

# Shiny UI ----

ui <- fixedPage(
  tabsetPanel(type = "tabs",id="tabs",
              tabPanel("tab1",value="t1"),
              tabPanel("tab2",value="t2")),

  variablesUI("var1", 1),
  h5(""),
  actionButton("insertBtn", "Add another line"),

  verbatimTextOutput("test1"),
  tableOutput("test2")
)

# Shiny Server ----

server <- function(input, output,session) {


  choices_var <- reactive({
    if (input$tabs=="t1"){

      choices_var <- LHSchoices
    }
    if (input$tabs=="t2") {
      choices_var <- LHSchoices2
    }
    return(choices_var)
  })

  observe({
    updateSelectInput(session, "variable",
                      choices = choices_var()
    )})


  add.variable <- reactiveValues()

  add.variable$df <- data.frame("variable.number" = numeric(0),
                                "variable" = character(0),
                                "value" = numeric(0),
                                stringsAsFactors = FALSE)

  var1 <- callModule(variables, paste0("var", 1), 1)

  observe(add.variable$df[1, ] <- var1())

  observeEvent(input$insertBtn, {

    btn <- sum(input$insertBtn, 1)

    insertUI(
      selector = "h5",
      where = "beforeEnd",
      ui = tagList(
        variablesUI(paste0("var", btn), btn)
      )
    )

    newline <- callModule(variables, paste0("var", btn), btn)

    observeEvent(newline(), {
      add.variable$df[btn, ] <- newline()
    })

  })

  output$test1 <- renderPrint({
    print(add.variable$df)
  })

  output$test2 <- renderTable({
    add.variable$df
  })

}

#------------------------------------------------------------------------------#

shinyApp(ui, server)

I would like to how to modify the code so that the choices can be modified.

EDIT: I succeded to update the first UI by adding the code below. So now my question is: how can we dynamically reach the variablesUI?

  choices_var <<- reactive({
    if (input$tabs=="t1"){

      choices_var <- LHSchoices
    }
    if (input$tabs=="t2") {
      choices_var <- LHSchoices2
    }
    return(choices_var)
  })

  observeEvent({
    choices_var()
  }, {
    updateSelectInput(session, "var1-variable",
                      choices = choices_var())
  })

EDIT 2: I can do it manually as below, but that would be really ugly, and the number of added UI should be limited.

  observeEvent({
    choices_var()
  }, {
    updateSelectInput(session, "var1-variable",
                      choices = choices_var())
  })

  observeEvent({
    choices_var()
  }, {
    updateSelectInput(session, "var2-variable",
                      choices = choices_var())
  })

EDIT 3

Now my question becomes more specific: when inserting a selectInput using insertUI, how to update the choices of newly inserted selectInput with updateSelectInput ?



Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source