Wang
Wang

Reputation: 1460

Dynamically update two selectInput boxes based on the others selection in R Shiny module is not working

I have two selectInput boxes in my ShinyApp. Both of them take the same inputs, i.e., the column names of an uploaded table.

I want to make the two input box mutually exclusive, meaning if a column name is selected in one input box, it will become unavailable in the second input box, and vice versa.

Here is my code, and it works.

library(shiny)


ui <- fluidPage(
  fileInput(inputId = "rawFile",
            label = "Upload Data Table:",
            multiple = FALSE,
            accept = c(".csv")
            ),
  uiOutput(outputId = "v1",
           label = "Select Variable 1"
           ),
  uiOutput(outputId = "v2",
           label = "Select Variable 2"
           )
  )

server <- function(input, output, session){
  inputData <- reactive({
    inFile <- input$rawFile
    if(is.null(inFile)){return(NULL)}
    extension <- tools::file_ext(inFile$name)
    filepath <- inFile$datapath
    df <- read.csv(filepath, header = TRUE)
    return(df)
  })

output$v1 <- renderUI({
  shiny::req(inputData())
  selectInput(inputId = "v1",
              label = "Select columns to remove",
              multiple = TRUE,
              choices = names(inputData())
  )
})
output$v2 <- renderUI({
  shiny::req(inputData())
  selectInput(inputId = "v2",
              label = "Select columns to remove",
              multiple = TRUE,
              choices = names(inputData())
  )
})


  observe({
    if(!is.null(input$v2))
      updateSelectInput(session, "v1", 
                        choices = names(inputData())[!(names(inputData()) %in% input$v2)], 
                        selected = isolate(input$v1) 
                        )
  })
  
  observe({
    if(!is.null(input$v1))
      updateSelectInput(session, "v2", 
                        choices = names(inputData())[!(names(inputData()) %in% input$v1)], 
                        selected = isolate(input$v2) 
                        )
  })
}

shinyApp(ui = ui, server = server)

But when I put this code in a module, it is not working. I don't where the problem is.

library(shiny)

ui_1 <- function(id){
  ns <- NS(id)
  tagList(
    fluidPage(
      fileInput(inputId = ns("rawFile"),
                label = "Upload Data Table:",
                multiple = FALSE,
                accept = c(".csv")
                ),
      uiOutput(outputId = ns("v1"),
               label = "Select Variable 1"
               ),
      uiOutput(outputId = ns("v2"),
               label = "Select Variable 2"
               )
      )
  )
}


server_1 <- function(id){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    
    inputData <- reactive({
      inFile <- input$rawFile
      if(is.null(inFile)){return(NULL)}
      extension <- tools::file_ext(inFile$name)
      filepath <- inFile$datapath
      df <- read.csv(filepath, header = TRUE)
      return(df)
    })
    
    output$v1 <- renderUI({
      shiny::req(inputData())
      selectInput(inputId = ns("v1"),
                  label = "Select columns to remove",
                  multiple = TRUE,
                  choices = names(inputData())
      )
    })
    output$v2 <- renderUI({
      shiny::req(inputData())
      selectInput(inputId = ns("v2"),
                  label = "Select columns to remove",
                  multiple = TRUE,
                  choices = names(inputData())
      )
    })
    
    
    observe({
      if(!is.null(input$v2))
        updateSelectInput(session, ns("v1"), 
                          choices = names(inputData())[!(names(inputData()) %in% input$v2)], 
                          selected = isolate(input$v1) 
        )
    })
    
    observe({
      if(!is.null(input$v1))
        updateSelectInput(session, ns("v2"), 
                          choices = names(inputData())[!(names(inputData()) %in% input$v1)], 
                          selected = isolate(input$v2) 
        )
    })
    
    }
  )
}

Upvotes: 0

Views: 80

Answers (1)

stefan
stefan

Reputation: 125697

The issue is that you wrapped the input id's in ns() inside your updateSelectInputs. You have to do so in renderUI only.

Note: I replaced the code to read a file with mtcars.

library(shiny)

ui_1 <- function(id) {
  ns <- NS(id)
  tagList(
    fluidPage(
      fileInput(
        inputId = ns("rawFile"),
        label = "Upload Data Table:",
        multiple = FALSE,
        accept = c(".csv")
      ),
      uiOutput(
        outputId = ns("v1"),
        label = "Select Variable 1"
      ),
      uiOutput(
        outputId = ns("v2"),
        label = "Select Variable 2"
      )
    )
  )
}

server_1 <- function(id) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    inputData <- reactive({
      mtcars
    })
    
    output$v1 <- renderUI({
      shiny::req(inputData())
      
      selectInput(
        inputId = ns("v1"),
        label = "Select columns to remove",
        multiple = TRUE,
        choices = names(inputData())
      )
    })
    
    output$v2 <- renderUI({
      shiny::req(inputData())
      
      selectInput(
        inputId = ns("v2"),
        label = "Select columns to remove",
        multiple = TRUE,
        choices = names(inputData())
      )
    })
    
    observe({
      if (!is.null(input$v2)) {
        updateSelectInput(session, "v1",
          choices = names(inputData())[!(names(inputData()) %in% input$v2)],
          selected = isolate(input$v1)
        )
      }
    })

    observe({
      if (!is.null(input$v1)) {
        updateSelectInput(session, "v2",
          choices = names(inputData())[!(names(inputData()) %in% input$v1)],
          selected = isolate(input$v2)
        )
      }
    })
  })
}

ui <- fluidPage(
  ui_1("foo")  
)

server <- function(input, output, session) {
  server_1("foo")
}

shinyApp(ui, server)

enter image description here

Upvotes: 1

Related Questions