Reputation: 79
Edit: to add sample data.
I would like to include a 'Select all' option for multiple SelectInputs. So if I select 'all' countries the second selectInput dropdown will display all regions, and if I select a specific country I can either select 'all' regions for that country or a specific one.
select all works for country level but I don't know how to apply it to the second region level.
I would like to do this without pickerInPut if at all possible.
Data:
Country <- c('England', 'Scotland', 'Wales', 'Ireland', 'Spain', 'England', 'Scotland', 'Wales', 'Ireland', 'Spain', 'England', 'Scotland', 'Wales', 'Ireland', 'Spain' , 'England', 'Scotland', 'Wales', 'Ireland', 'Spain')
Region <- c('North' , 'East', 'South', 'South', 'North' , 'South', 'East', 'North' , 'South', 'West', 'North' , 'South' , 'North' , 'West', 'North' , 'West', 'West', 'East', 'East', 'South')
Value <- c(100, 150, 400, 300, 100, 150, 300, 200, 500, 600, 300, 200, 250, 300, 100, 150, 300, 200, 500, 600)
Outcomes <- c('Green', 'Red','' , 'Amber', 'Green', 'Green', 'Red','' , 'Red', 'Amber', 'Red', 'Green', 'Green', 'Green','' ,'' , 'Amber', 'Amber', 'Red', 'Red')
Outputs <- c('Red', 'Green', 'Green', 'Green', '','' , 'Amber', 'Green', 'Red','' , 'Red', 'Amber', 'Red', 'Green', 'Green', '','' , 'Amber', 'Amber', 'Red')
Risk <- c('Green', 'Green', 'Red', 'Red','' , 'Amber', 'Green', 'Green', 'Amber','' , 'Green', 'Red', 'Amber', 'Green', 'Green', 'Red', '', 'Red', 'Amber', '')
Joined_data <- data.frame(Country, Region, Value, Outcomes, Outputs, Risk)
list<- unique(Joined_data$Country)
list2 <- unique(Joined_data$`Region`)
UI:
ui<- dashboardPage(
dashboardHeader(title = "Performance"),
dashboardSidebar(selectizeInput(inputId = "Country", label = "Country", choices = c('All', list)),
(selectizeInput(inputId = "Region", label = "Region", choices = c('All', list2)))),
dashboardBody(
fluidRow(
box(valueBoxOutput(outputId = "Total", width = 12), title = "Total"),
box(valueBoxOutput(outputId = "Value", width = 12), title = "Value"),
)
),
)
Server:
server <- function(input, output, session) {
Test <- reactive({
if(input$Country == 'All') {
Joined_data %>%
filter(`Contract Locality` == input$Locality)
} else {
Joined_data %>%
filter(`Country` == input$Country, `Region` == input$Region)
}})
output$Total <- renderValueBox({
valueBox(Test() %>%
tally(),
req(input$Country)
})
output$Value <- renderValueBox({
valueBox(Test() %>%
summarise("Annualised_Value" = sum(`Value (Annualised)`)) %>%
prettyNum(big.mark = ","),
req(input$Country)
})
Country.choice <- reactive({
Joined_data %>%
filter(Country == input$Country %>%
pull(Region)
})
observe({
updateSelectizeInput(session, "Region", choices = Country.choice())
})
}
shiny::shinyApp(ui=ui,server=server)
Upvotes: 0
Views: 1158
Reputation: 21349
Perhaps pickerInput
will meet your needs as shown in an example below.
ui = fluidPage(
titlePanel(title=div(img(src="YBS.png", height = 140, width = 140), "This is a Test")),
sidebarLayout(
sidebarPanel(
uiOutput("organt"),
uiOutput("cellt")
),
mainPanel(
tableOutput("MegaData")
)
)
)
server = function(input, output, session) {
df1 <- veteran
MegaP <- df1 %>% mutate(Organ=ifelse(trt==1,"Lung","Skin"))
output$organt <- renderUI({
selectInput("OrganT",
label = "Organ",
choices = unique(MegaP$Organ),
multiple = T,
selected = "All")
})
MegaP1 <- reactive({
data <- subset(MegaP, Organ %in% req(input$OrganT))
})
output$cellt <- renderUI({
req(MegaP1())
mychoices <- as.character(unique(MegaP1()$celltype))
pickerInput(inputId = "Cell",
label = "Cell Line",
choices = mychoices,
multiple = TRUE,
options = list(`actions-box` = TRUE)
)
})
selectedData <- reactive({
req(MegaP1(),input$Cell)
data <- subset(MegaP1(), celltype %in% input$Cell)
})
output$MegaData = renderTable({
selectedData()
})
}
shinyApp(ui = ui, server = server)
Edit:
To do this without using pickerInput, you can try the following:
dat <- data.frame(Country, Region, Value, Outcomes, Outputs, Risk)
list<- unique(dat$Country)
list2 <- unique(dat$`Region`)
app <- shinyApp(
ui = shinyUI(
pageWithSidebar(
headerPanel("Simple Test"),
sidebarPanel(
selectInput("cy", "Country", choices = c("All", list )),
selectInput("rg", "Region", choices = c("All", list2 ))
),
mainPanel(
DTOutput("out")
)
)
),
server = function(input, output, session) {
filtered <- reactive({
rows <- (input$cy == "All" | dat$Country == input$cy) &
(input$rg == "All" | dat$Region == input$rg)
dat[rows,,drop = FALSE]
})
output$out <- renderDT(filtered())
}
)
Upvotes: 2