Good morning all!
I’ve been trying to get this sorted for a few days now and unable to resolve it.
I have a large table with many options which the user is filtering. As this table is fairly large (million or so rows) and has many interacting options, I want the users options to keep up with their choices i.e. if they use picker 1 to select option a, then picker 2 will only show them the options in line with their first filter e.g.
| col1 | col2 |
|---|---|
| A | 1 |
| A | 2 |
| A | 3 |
| B | 4 |
if picker for col1 is A
then picker for col2 should show 1,2,3 and not 4
This can then extend to many different columns.
I’ve followed a few tutorials mainly https://mastering-shiny.org/action-dynamic.html and https://gist.github.com/jcheng5/45813fd5b4ae6b418cc8a081e8d21830 however these both demand that the user starts at a beginning. I want the user to be able to start with any picker.
I have tried to incorporate freezeReactiveValue in but cant seem to get it to work.
My example for this is as follows
library(shiny)
df <- mtcars %>%
rownames_to_column(var = "car")
car_choices <- c("All", unique(df$car))
cyl_choices <- c("All",unique(df$cyl))
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "car_btn",
label = "car",
choices = car_choices,
selected = "All"
),
selectInput(
inputId = "cyl_btn",
label = "cyl",
choices = cyl_choices,
selected = "All"
)
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output, session) {
data <- reactive({
df %>%
filter(car %in% car_sel(),
cyl %in% cyl_sel())
})
car_sel <- reactive({
req(input$car_btn)
if(input$car_btn == "All"){car_choices[-1]}else{input$car_btn}
})
observeEvent(data(), ignoreInit = T, {
choices <- c("All", unique(data()$car))
updateSelectInput(inputId = "car_btn", choices = choices, selected = input$car_btn)
})
cyl_sel <- reactive({
req(input$cyl_btn)
if(input$cyl_btn == "All"){cyl_choices[-1]}else{input$cyl_btn}
})
observeEvent(data(), ignoreInit = T, {
choices <- c("All", unique(data()$cyl))
updateSelectInput(inputId = "cyl_btn", choices = choices, selected = input$cyl_btn)
})
output$distPlot <- renderPlot({
Sys.sleep(1)#added to slow the reactives down to mimic a large table being filtered
data() %>%
ggplot(aes(x=cyl))+
geom_bar()
})
}
shinyApp(ui = ui, server = server)
this works but can create options which are no longer applicable as the data flows through the reactives. If I add freezeReactiveValue which should stop all dependencies until everything has been worked through the app never resolves.
library(shiny)
df <- mtcars %>%
rownames_to_column(var = "car")
car_choices <- c("All", unique(df$car))
cyl_choices <- c("All",unique(df$cyl))
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "car_btn",
label = "car",
choices = car_choices,
selected = "All"
),
selectInput(
inputId = "cyl_btn",
label = "cyl",
choices = cyl_choices,
selected = "All"
)
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output, session) {
data <- reactive({
df %>%
filter(car %in% car_sel(),
cyl %in% cyl_sel())
})
car_sel <- reactive({
req(input$car_btn)
if(input$car_btn == "All"){car_choices[-1]}else{input$car_btn}
})
observeEvent(data(), ignoreInit = T, {
freezeReactiveValue(input, "car_btn") #freeze added
choices <- c("All", unique(data()$car))
updateSelectInput(inputId = "car_btn", choices = choices, selected = input$car_btn)
})
cyl_sel <- reactive({
req(input$cyl_btn)
if(input$cyl_btn == "All"){cyl_choices[-1]}else{input$cyl_btn}
})
observeEvent(data(), ignoreInit = T, {
freezeReactiveValue(input, "cyl_btn") #freeze added
choices <- c("All", unique(data()$cyl))
updateSelectInput(inputId = "cyl_btn", choices = choices, selected = input$cyl_btn)
})
output$distPlot <- renderPlot({
Sys.sleep(1)
data() %>%
ggplot(aes(x=cyl))+
geom_bar()
})
}
shinyApp(ui = ui, server = server)
Clearly I’m misunderstanding something here!!
Any help would be much appreciated.
2
The way I approach this situation is to compute each filter separately and
then find the available choices based on what other filters leave available.
library(shiny)
tbl <- data.frame(x = c("A", "A", "B", "C"), y = c(1, 2, 2, 3))
ui <- fluidPage(
selectInput("x", "x", choices = NULL, multiple = TRUE),
selectInput("y", "y", choices = NULL, multiple = TRUE),
tableOutput("tbl"),
)
server <- function(input, output, session) {
x_matches <- reactive(!isTruthy(input$x) | tbl$x %in% input$x)
y_matches <- reactive(!isTruthy(input$y) | tbl$y %in% input$y)
output$tbl <- renderTable({
tbl[x_matches() & y_matches(), , drop = FALSE]
})
x_choices <- reactive(unique(tbl$x[y_matches()]))
y_choices <- reactive(unique(tbl$y[x_matches()]))
observe({
updateSelectInput(session, "x", choices = x_choices(), selected = isolate(input$x))
})
observe({
updateSelectInput(session, "y", choices = y_choices(), selected = isolate(input$y))
})
}
shinyApp(ui, server)