Dynamic Input Generation: cannot select choices

Hello everyone,

I am trying to build a R shiny app, with which users can select variable-domain combinations and manually adjust the value (variables are not unique, domains are not unique, but variable-domain combinations are unique). Everything works as intended apart from the fact that I seem to be unable to select a variable that is not unique.

I did check out the following links:
Link 1: But I believe, that I don't have the problem of not being able to update input, because as I change from variable a to c, the domain input choice is updated.

Link 2: But I believe, that I don't have the problem of changes not being saved as I add a position.

Link 3: I took some code from here...

Reproducible code:

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = ""), 
  dashboardSidebar(sidebarMenu( 
    menuItem("Input", tabName = "input")
  )),
  dashboardBody(
    tabItems(
      tabItem(tabName = "input", 
              box(title = "Define values for positions", width = 12,
                  uiOutput("add_var"), 
                  tags$p(actionButton("add_btn", "Add position"),
                         actionButton("rm_btn", "Remove position")
                         )
                  )
              )
      )
    )
)


##################server
server <- function(input, output, session) {
  data <- data.frame(variable = c("a", "b", "b", "c", "d", "d", "d"), 
                     domain = c("x", "y", "z", "z", "x", "y", "z"), 
                     value = c("text1", "text2", "text3", "text4", "text5", "text6", "text7"))
  
  # Track the number of input boxes to render
  counter <- reactiveValues(n = 0)
  
  # Track all user inputs
  AllInputs <- reactive({
    x <- reactiveValuesToList(input)
  })
  
  observeEvent(input$add_btn, {counter$n <- counter$n + 1})
  observeEvent(input$rm_btn, {
    if (counter$n > 0) counter$n <- counter$n - 1
  })
  
  input_pos <- reactive({
    n <- counter$n
    if (n > 0) {
      lapply(seq_len(n), function(i) {
        fluidRow(column(3, 
                        selectInput(inputId = paste0("var_name", i),
                                    label = "Select variable",
                                    choices = data$variable,
                                    selected = AllInputs()[[paste0("var_name", i)]])
                        ),
                 column(3, 
                        selectInput(inputId = paste0("dom_name", i),
                                    label = "Select domain",
                                    choices = data[data$variable==input[[paste0("var_name", i)]],"domain"],
                                    selected = AllInputs()[[paste0("dom_name", i)]])
                        ),
                 column(3, textInput(inputId = paste0("change", i),
                                     label = "Enter value",
                                     value = AllInputs()[[paste0("change", i)]])
                        )
                 )          
      })
      }
    })
  

  output$add_var <- renderUI({ input_pos() })
  
}

shinyApp(ui, server)

Any help is much appreciated!
Thanks :slight_smile:

################################################

Update: Now I tried to define the three inputs seperately and I can now select variables with multiple domains. However, my selection of variables and domains only gets saved when the variable has only one domain. If it has multiple domains and I press the add button, the selected inputs get reset, but the entered value remains.

Reproducible example:

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = ""), 
  dashboardSidebar(sidebarMenu( 
    menuItem("Input", tabName = "input")
  )),
  dashboardBody(
    tabItems(
      tabItem(tabName = "input", 
              box(title = "Define values for positions", width = 12,
                  fluidRow(column(3, uiOutput("pos_select")), column(3, uiOutput("dom_select")), column(2, uiOutput("change_select"))), 
                  tags$p(actionButton("add_btn", "Add position"),
                         actionButton("rm_btn", "Remove position")
                         )
                  )
              )
      )
    )
)


##################server
server <- function(input, output, session) {
  data <- data.frame(variable = c("a", "b", "b", "c", "d", "d", "d"), 
                     domain = c("x", "y", "z", "z", "x", "y", "z"), 
                     value = c("text1", "text2", "text3", "text4", "text5", "text6", "text7"))
  
  # Track the number of input boxes to render
  counter <- reactiveValues(n = 0)
  
  # Track all user inputs
  AllInputs <- reactive({
    x <- reactiveValuesToList(input)
  })
  
  observeEvent(input$add_btn, {counter$n <- counter$n + 1})
  observeEvent(input$rm_btn, {
    if (counter$n > 0) counter$n <- counter$n - 1
  })
  
  input_pos <- reactive({
    n <- counter$n
    if (n > 0) {
      isolate({
      lapply(seq_len(n), function(i) {
                  selectInput(inputId = paste0("var_name", i),
                              label = "Select variable",
                              choices = data$variable,
                              selected = AllInputs()[[paste0("var_name", i)]])
      })
      })
      }
    })
  
  input_dom <- reactive({
    n <- counter$n
    if (n > 0) {
        lapply(seq_len(n), function(i) {
                 selectInput(inputId = paste0("dom_name", i),
                             label = "Select domain",
                             choices = data[data$variable==input[[paste0("var_name", i)]],"domain"],
                             selected = AllInputs()[[paste0("dom_name", i)]])
      })
    }
  })
  
  input_change <- reactive({
    n <- counter$n
    if (n > 0) {
        lapply(seq_len(n), function(i) {
                textInput(inputId = paste0("change", i),
                          label = "Enter value",
                          value = AllInputs()[[paste0("change", i)]])
      })
    }
  })
  

  output$pos_select <- renderUI({ input_pos() })
  output$dom_select <- renderUI({ input_dom() })
  output$change_select <- renderUI({ input_change() })
  
}

shinyApp(ui, server)

####################################################

Update 2: I was able to solve it! I am providing the trivial solution in case someone will have the same problem in the future. I had to wrap the choices of the variable input into unique(). Then, the domains will be unique automatically in my case and everything works out!

selectInput(inputId = paste0("var_name", i),
                                    label = "Select variable",
                                    choices = unique(data$variable),
                                    selected = AllInputs()[[paste0("var_name", i)]])

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.