0

Please have a look at the shiny snippet at the end of the post. It gets the job done, since it allows me to filter a dataset according to its my choices of the variables var1 (only a single choice permitted) and var2 (multiple choices permitted).

However, the app could be better: right now, no matter what my choice of var1, all the values of var2 are shown in the second menu, even when the chosen combination of var1 and var2 does not exist in the original dataset df.

Can I make the app smarter? I would like, after my choice of var1, the var2 menu to show only the values of var2 for which the (var1, var2) combination really exists.

Is it possible to achieve that? In the real app I am developing, I have more than 2 menus, so the solution proposed should be general enough.

Many thanks!

library(shiny)
library(shinyWidgets)
library(tidyverse)
library(DT)


df <- tibble(var1=c(rep("x",3), rep("y",3),
                    rep("w",3), rep("z",3)),
             var2=c(rep("a",4), rep("b", 4), rep("c",4)),
             value=seq(12))


var1_list <- df |>
    pull(var1) |>
    unique() |>
    sort()


var2_list <- df |>
    pull(var2) |>
    unique() |>
    sort()


ui <- fluidPage(
    pickerInput("var1","Var1 Selection",
                        choices=var1_list,
                        selected=var1_list,
                options = list(`actions-box` = TRUE,`selected-text-format` = "count > 3"),choicesOpt = list(
                                                                                              content = var1_list ),multiple = F)   ,

    pickerInput("var2","Var2 Selection",
                        choices=var2_list,
                        selected=var2_list,
                options = list(`actions-box` = TRUE,`selected-text-format` = "count > 3"),choicesOpt = list(
                                                                                              content = var2_list ),multiple = T) ,

    mainPanel(DTOutput("table") )

    
)


server <- function(input, output) {

    filtered_data <- reactive({

        df |> filter(var1 %in% input$var1,
                     var2 %in% input$var2)

    })

    output$table <- renderDT({datatable(filtered_data()) })

    
}

shinyApp(ui = ui, server = server)
Konrad Rudolph
  • 530,221
  • 131
  • 937
  • 1,214
larry77
  • 1,309
  • 14
  • 29
  • 1
    How about using `updatePickerInput` https://search.r-project.org/CRAN/refmans/shinyWidgets/html/updatePickerInput.html? – Kota Mori Sep 13 '22 at 12:58
  • Possible duplicate: https://stackoverflow.com/questions/51486530/update-dropdown-values-in-r-shiny-dynamically or https://stackoverflow.com/questions/34929206/selectinput-that-is-dependent-on-another-selectinput – MrFlick Sep 13 '22 at 13:01

1 Answers1

0

Indeed it is true that very similar questions were asked before (I was not efficient in looking). The snippet at the end of the post achieves what I need.

library(shiny)
library(shinyWidgets)
library(tidyverse)
library(DT)
#> 
#> Attaching package: 'DT'
#> The following objects are masked from 'package:shiny':
#> 
#>     dataTableOutput, renderDataTable


df <- tibble(var1=c(rep("x",3), rep("y",3),
                    rep("w",3), rep("z",3)),
             var2=c(rep("a",4), rep("b", 4), rep("c",4)),
             value=seq(12))


var1_list <- df |>
    pull(var1) |>
    unique() |>
    sort()


var2_list <- df |>
    pull(var2) |>
    unique() |>
    sort()


ui <- fluidPage(
    pickerInput("var1","Var1 Selection",
                        choices=var1_list,
                        selected=var1_list,
                options = list(`actions-box` = TRUE,`selected-text-format` = "count > 3"),choicesOpt = list(
                                                                                              content = var1_list ),multiple = F)   ,

    pickerInput("var2","Var2 Selection",
                        choices=var2_list,
                        selected=var2_list,
                options = list(`actions-box` = TRUE,`selected-text-format` = "count > 3"),choicesOpt = list(
                                                                                              content = var2_list ),multiple = T) ,

    mainPanel(DTOutput("table") )

    
)


server <- function(input, output, session) {

    var2_choice <- reactive({
        df |> filter(var1 %in% input$var1) |>
            pull(var2) |>
            unique() |>
            sort()

        
    })

    observeEvent(var2_choice(), {
    updatePickerInput(session, "var2", choices=var2_choice())
  })

    
    filtered_data <- reactive({

        df |> filter(var1 %in% input$var1,
                     var2 %in% input$var2)

    })

    output$table <- renderDT({datatable(filtered_data()) })

    
}

shinyApp(ui = ui, server = server)
Shiny applications not supported in static R Markdown documents

Created on 2022-09-13 by the reprex package (v2.0.1)

larry77
  • 1,309
  • 14
  • 29