Reputation: 1460
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
Reputation: 125697
The issue is that you wrapped the input id's in ns()
inside your updateSelectInput
s. 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)
Upvotes: 1