Reputation: 1706
I want to add a condition to this code to avoid a message error when my different selectinputs are empty. I tried to use req()
in reactive expression but doesnt work. I also tried to add a condition like if(input$name == NULL){return(NULL)}
for different inputs but doesnt work too ..
Any help wil be appreciated
Code :
l <- NULL
l$name <- c('b','e','d','b','b','d','e','e','b','b')
l$age <- c(20,20,21,21,20,22,22,30,21,32)
l$gender <- c('Female', 'Female', 'Male', 'Female', 'Male','Male',
'Female','Male',"Female","Male")
l <- as.data.frame(l)
l$name <- as.character(l$name)
l$age <- as.numeric(l$age)
l$gender <- as.character(l$gender)
library(shiny)
server <- shinyServer(function(input,output){
assign('All Names', unique(sort(l$name)))
assign("All Ages", unique(sort(l$age)))
assign('All Genders', unique(sort(l$gender)))
data1 <- reactive(l[which(l$name %in% if(exists(input$name))
{get(input$name)}else{input$name}),])
data2 <- reactive(data1()[which(data1()$age %in% if(exists(input$age))
{get(input$age)}else{input$age}),])
data3 <- eventReactive(input$go_baba, {
data2()[which(data2()$gender %in% if(exists(input$gender))
{get(input$gender)}else{input$gender}),]
})
output$table3 <- renderTable(data3())
output$Box1 = renderUI(
if((is.null(input$age)) & (is.null(input$gender))){
selectInput("name", "Choose Name", choices=c("All Names",unique(sort(l$name))), selected = input$name)
} else{selectInput("name", "Choose Name", choices=c("All Names",unique(l[l$gender %in% (if(exists(input$gender)){get(input$gender)}else{input$gender}) & l$age %in% (if(exists(input$age)){get(input$age)}else{input$age}) , "name"])), selected = input$name, multiple = T)
}
)
output$Box2 = renderUI(
if((is.null(input$name)) & (is.null(input$gender))){
selectInput("age", "Choose Age", choices=c("All Ages", unique(sort(l$age))), selected = input$age)
}else{selectInput("age", "Choose Age", choices=c("All Ages",unique(l[l$gender %in% (if(exists(input$gender)){get(input$gender)}else{input$gender}) & l$name %in% (if(exists(input$name)){get(input$name)}else{input$name}) , "age"])), selected = input$age, multiple = T)}
)
output$Box3 = renderUI(
if((is.null(input$name)) & (is.null(input$age))){
selectInput("gender", "Choose Gender", choices=c("All Genders", unique(sort(l$gender))), selected = input$gender)
}else{
selectInput("gender", "Choose Gender", choices=c("All Genders", unique(l[l$name %in% (if(exists(input$name)){get(input$name)}else{input$name}) & l$age %in% (if(exists(input$age)){get(input$age)}else{input$age}), "gender"])), selected = input$gender, multiple = TRUE)
}
)
})
ui <-shinyUI(fluidPage(
uiOutput("Box1"),
uiOutput("Box2"),
uiOutput("Box3"),
actionButton("go_baba", "GO !"),
tableOutput("table3")
))
shinyApp(ui,server)
Upvotes: 1
Views: 3331
Reputation: 6155
A handy tool in this case is validate(need(condition, message))
. It displays a message if the condition is not fulfilled and stops executing the current output. More info here. You can also use req(!is.null(input$...))
instead, which has the exact same effect but without message.
I rewrote your code to make it more readable:
library(shiny)
l <- data.frame( name = c('b','e','d','b','b','d','e','e','b','b'),
age = c(20,20,21,21,20,22,22,30,21,32),
gender = c('Female', 'Female', 'Male', 'Female', 'Male','Male', 'Female','Male',"Female","Male"),
stringsAsFactors = F)
server <- shinyServer(function(input,output){
# subset l according to inputs
data <- eventReactive(input$go_baba, {
out <- l
if(!"All Names" %in% input$name) out <- subset(l, name %in% input$name)
if(!"All Ages" %in% input$age) out <- subset(l, age %in% input$age)
if(!"All Genders" %in% input$gender) out <- subset(l, gender %in% input$gender)
return(out)
})
# display the result as table
output$table3 <- renderTable({
data()
})
# selectInput for Date
output$Box1 = renderUI({
selectInput("name", "Choose Name", choices=c("All Names", unique(sort(l$name))), selected=NULL, multiple=T)
})
# selectInput for Age
output$Box2 = renderUI({
validate(need(!is.null(input$name), "Please choose a name"))
selectInput("age", "Choose Age", choices=c("All Ages", unique(l$age)), selected=NULL,
multiple = T)
})
# selectInput for Gender
output$Box3 = renderUI({
validate(need(!is.null(input$age), "Please choose an age"))
selectInput("gender", "Choose Gender", choices=c("All Genders", unique(l$gender)), selected=NULL)
})
})
ui <-shinyUI(fluidPage(
uiOutput("Box1"),
uiOutput("Box2"),
uiOutput("Box3"),
conditionalPanel(condition="input.age != null & input.gender != null", actionButton("go_baba", "GO !")),
tableOutput("table3")
))
shinyApp(ui,server)
Upvotes: 3