Multiple reactive selectinput based on another in R shiny

Question

I am using the code below to allow multiple selected inputs to react to each other. So, when one is changed, the values in the other fields should be updated. However, I have a problem with that, from what I read here I am supposed to use updateSelectInput but I don't know how, can anyone help me? When I choose aa category and then source everything is ok, but when I add bb category then the sources go back to their initial values.

This is my code:

library(shiny)
library(shinydashboard)
library(magrittr)
library(dplyr)
library(DT)
library(lubridate)
library(tidyr)


DATE = rep(seq(as.Date('2018/01/01'), as.Date('2018/03/01'), by = "day"), each = 4, 3)
CATEGORY = rep(c('aa', 'bb'), each = 360)
SOURCE = rep(c("A", "B", "C", "D"), 180)
REVENUE = as.numeric(sample(c(1000:2000), 720, replace = T)) 
PLAN = 1500
WEEKDAYS <- weekdays(DATE)
MONTH = months(DATE)
df <- data.frame(DATE, WEEKDAYS, MONTH, CATEGORY, SOURCE, REVENUE, PLAN)

is.not.null <- function(x)
  ! is.null(x)

ui <- fluidPage(titlePanel("Test revenue"),
                sidebarLayout(
                  sidebarPanel(
                    uiOutput("month"),
                    uiOutput("category"),
                    uiOutput("sources")
                    
                  ),
                  mainPanel(tabsetPanel(
                    type = "tabs",
                    tabPanel("Revenue",
                             DT::dataTableOutput("table_subset_revenue"))
                    
                  ))
                ))

################################################

server = shinyServer(function(input, output) {
  data <- df
  
  output$table <- DT::renderDataTable({
    if (is.null(data)) {
      return()
    }
    DT::datatable(data, options = list(scrollX = T))
  })
  
  output$month <- renderUI({
    selectInput(
      inputId = "MONTH",
      "Select month",
      choices = var_month(),
      multiple = F
    )
  })
  output$category <- renderUI({
    selectInput(
      inputId = "CATEGORY",
      "Select category",
      choices = var_category(),
      multiple = T
    )
  })
  output$sources <- renderUI({
    selectInput(
      inputId = "SOURCE",
      "Select source",
      choices = var_source(),
      multiple = T
    )
  })
  
  data_filtered_revenue <- reactive({
    filter(df,
           MONTH %in% month(),
           CATEGORY %in% category(),
           SOURCE %in% sources()) %>%
      group_by(DATE, WEEKDAYS, MONTH) %>%
      summarise(Revenue = sum(REVENUE),
                Plan = sum(PLAN)) %>%
      ungroup() %>%
      mutate(Revenue_cum = cumsum(Revenue),
             Plan_cum = cumsum(Plan)) 
      
  })
  
  ######################################################################################
  
  month <- reactive({
    if (is.null(input$MONTH))
      unique(df$MONTH)
    else
      input$MONTH
  })
  
  category <- reactive({
    if (is.null(input$CATEGORY))
      unique(df$CATEGORY)
    else
      input$CATEGORY
  })
  
  sources <- reactive({
    if (is.null(input$SOURCE))
      unique(df$SOURCE)
    else
      input$SOURCE
  })
  
  var_month <- reactive({
    file1 <- data
    if (is.null(data)) {
      return()
    }
    as.list(unique(file1$MONTH))
  })
  
  var_category <- reactive({
    filter(data, MONTH %in% month()) %>%
      pull(CATEGORY) %>%
      unique()
  })
  
  var_source <- reactive({
    filter(data, MONTH %in% month(), CATEGORY %in% category()) %>%
      pull(SOURCE) %>%
      unique()
  })
  
  output$table_subset_revenue <- DT::renderDataTable({
    DT::datatable(data_filtered_revenue())
  })
  
  
})

shinyApp(ui, server)

You might want to check [shinyWidgets::selectizeGroupUI()](https://dreamrs.github.io/shinyWidgets/reference/selectizeGroup-module.html) - [here](https://stackoverflow.com/questions/70716955/selectizegroupui-unable-to-set-filter-widths-inline-true-error-when-aws-dep/70726085#70726085) you can find another example. — ismirsehregal, Sep 13 '22 at 07:36

score 1 · Accepted Answer · answered Sep 16 '22 at 13:40

1

Set choices to NULL within renderUI and update it via updateSelectInput while keeping the current selection:

 output$sources <- renderUI({
    selectInput(
      inputId = "SOURCE",
      "Select source",
      choices = NULL,
      multiple = T
    )
  })
  
  observeEvent(var_source(),{
  updateSelectInput(
    inputId = "SOURCE",
    choices = var_source(),
    selected = input$SOURCE
  )
  })

answered Sep 16 '22 at 13:40

Gerda

43
3

should I do this for every `renderUI` ? – Zizou Sep 22 '22 at 12:29

Multiple reactive selectinput based on another in R shiny

1 Answers1