Share reactive data from observEvent inside shiny module

[Rupam]

Please consider the code below:

library(shiny)
library(dplyr)
library(echarts4r)

filterDataUI <- function(id){
  actionButton(NS(id, 'btn'), 'Filter')
}

filterDataServer <- function(id, data_){
  stopifnot(is.reactive(data_))
  moduleServer(id, function(input, output, session){
    
    observeEvent(input$btn, {
      showModal(modalDialog(
        title = 'Filter Data',
        checkboxGroupInput(NS(id, 'species'), 'Species',choices =  unique(data_()$Species),selected = unique(data_()$Species), inline = TRUE)
      ))
    })
  })
}

plotUI <- function(id){
  echarts4rOutput(NS(id, 'plot'))
}

plotServer <- function(id, data_){
  moduleServer(id, function(input, output, session){
    output$plot <- renderEcharts4r({
      data_() %>%
        e_charts(Species) %>%
        e_bar(Sepal.Length)
    })
  })
}


ui <- fluidPage(
  fluidRow(column(2, filterDataUI('filter'))),
  fluidRow(column(8, plotUI('bar')))
)

server <- function(input, output, session) {
  
  dataset <- reactive({
    d <- iris 
    d$Species <- as.character(d$Species)
    return(d)
    })
  
  filterDataServer('filter', dataset) 
  plotServer('bar', dataset)
}

shinyApp(ui, server)

I am trying to filter the data_ on the basis of 'species' input values (filterDataServer) and return the modified dataset which I need to use in plotServer, so that the specific check box selection reflects in the plot.
By default it will select all the values of Species and if a user deselect any selection from check box the data will get filtered.

[nirgrahamuk]

library(shiny)
library(dplyr)
library(echarts4r)

filterDataUI <- function(id){
  actionButton(NS(id, 'btn'), 'Filter')
}

filterDataServer <- function(id, data_){
  stopifnot(is.reactive(data_))
  moduleServer(id, function(input, output, session){
    
    observeEvent(input$btn, {
      showModal(modalDialog(
        title = 'Filter Data',
        checkboxGroupInput(NS(id, 'species'), 'Species',choices =  unique(data_()$Species),selected = unique(data_()$Species), inline = TRUE)
      ))
    })
    
    
    choices <- reactive({
      cs <-  unique(data_()$Species)
      if(input$btn>0)
        cs <- input$species
      cs
    })
    
    return(choices)
  })
}

plotUI <- function(id){
  echarts4rOutput(NS(id, 'plot'))
}

plotServer <- function(id, data_){
  moduleServer(id, function(input, output, session){
    output$plot <- renderEcharts4r({
      data_() %>%
        e_charts(Species) %>%
        e_bar(Sepal.Length)
    })
  })
}


ui <- fluidPage(
  fluidRow(column(2, filterDataUI('filter'))),
  fluidRow(column(8, plotUI('bar')))
)

server <- function(input, output, session) {
  
  dataset <- reactive({
    d <- iris 
    d$Species <- as.character(d$Species)
    return(d)
  })
  
 fds <- filterDataServer('filter', dataset) 
  plotServer('bar',  reactive(dplyr::filter(dataset(),Species %in% fds())))
 }

shinyApp(ui, server)

[Rupam]

Many thanks @nirgrahamuk . Just a follow-up question. What if I have more than one filtering option in observEvent? Do I need to make reactive statement for all other filters? and what change I need to do in return statement?

[nirgrahamuk]

Why don't you attempt this and get back, you can make a new reprex if you hit a problem.

If you are familiar with dplyr filter in general, then it hardly changes anything that we are using in a shiny context. Your filter module should return a list of the values set on it .

[Rupam]

@nirgrahamuk , Thanks for the guidance. I could return multiple reactive values and the filters are also working perfectly. But I noticed one issue in the above code you given. If you select 'Filter' button for two times, the filters get reset automatically. Is there any way to fix this?

[nirgrahamuk]

an updated filterServer with more statemanagement

filterDataServer <- function(id, data_) {
  stopifnot(is.reactive(data_))
  moduleServer(id, function(input, output, session) {
    triggered <- reactiveVal(0)

    observeEvent(input$btn, {
      showModal(modalDialog(
        title = "Filter Data",
        checkboxGroupInput(NS(id, "species"), "Species",
          choices = unique(data_()$Species),
          selected = choices(), inline = TRUE
        )
      ))
    })

    observeEvent(
      input$species,
      triggered(1)
    )

    choices <- reactive({
      input$species

      cs <- unique(data_()$Species)
      if (triggered() == 1) {
        cs <- input$species
      }
      cs
    })

    return(choices)
  })
}

[Rupam]

Amazing!! Thanks a lot!