Using input from different module to subset data in shiny

user_12001356 0
Viewed 101

I am still quite new to coding but wanted to learn about modules. I am trying to build an app that will display data based on a selected date range. I tried to do this with different modules for selecting the dates and other modules to handle data and eventually create plots. The goal is to reuse some of these modules in different parts of the app. I seem to have become stuck following the article here. I realise that the article describes the callModule method of using modules.

Here is a sample of the app and modules:

library(shiny)

source("test_modules.R")

ui <- fluidPage(
  dateSelectUI("demoDate"),
  
  demoSummaryUI("Demo")
)

server <- function(input, output, session){
  
  demo_date <- dateSelectServer("demoDate")
  
  demoSummaryServer("Demo",
                    dataset = test_app,
                    date_range = demo_date)
  
  
}
shinyApp(ui, server)

dateSelectUI <- function(id){
  
  tagList(dateRangeInput(NS(id, "dateRange"), "Dates", 
                         start = min(ymd(arise_app$year_m)),
                         end = max(ymd(arise_app$year_m)),
                         format = "dd-mm-yyyy")
  )
  
}

dateSelectServer <- function(id){
  
  moduleServer(id, function(input, output, session){
    
    return(
      list(
        min_date <- reactive({input$dateRange[1]}),
        max_date <- reactive({input$dateRange[2]})
      )
    ) 
    
  })
  
}

demoSummaryUI <- function(id){
  
  tagList(infoBoxOutput(NS(id, "numbers"), width = 6),
          infoBoxOutput(NS(id, "period"), width = 6),
          
          # this was to test that the date selection works
          verbatimTextOutput(NS(id, "verbatim"))
  )
  
}


demoSummaryServer <- function(id, dataset, date_range){
  
  moduleServer(id, function(input, output, session){
    
    output$verbatim <- renderPrint({date_range})
    
    # eventually, the data can be filter by date selected:
    # dataset <- dataset %>%
    #   filter(year_m >= date_range$min_date() & year_m <= date_range$max_date())

  })
  
}

And data:

dput(test_app)
structure(list(BMI = c(36, 32, 25, 35, 25, 30, 39, 44, 38, 24
), prosthesis = c("SIGMA", "SIGMA", "ATTUNE", "ATTUNE", "ATTUNE", 
"SIGMA", "ATTUNE", "ATTUNE", "SIGMA", "SIGMA"), op_duration = structure(c(59, 
60, 121, 63, 73, 64, 81, 60, 60, 65), class = "difftime", units = "mins"), 
    year_m = structure(c(18262, 18262, 18322, 18262, 18262, 18262, 
    18262, 18262, 18293, 18293), class = "Date")), row.names = c(NA, 
-10L), class = c("tbl_df", "tbl", "data.frame"))

I would be really interested to know how to fix this and grateful for anyone who can help.

shiny r
1 Answers

You were almost there, here's the complete example for reproducibility (fixing some issues with your example):

library(shiny)
library(lubridate)
library(tibble)
library(dplyr)

test_app <- structure(list(BMI = c(36, 32, 25, 35, 25, 30, 39, 44, 38, 24), 
                           prosthesis = c("SIGMA", "SIGMA", "ATTUNE", "ATTUNE", 
                                          "ATTUNE", "SIGMA", "ATTUNE", "ATTUNE", 
                                          "SIGMA", "SIGMA"), 
                           op_duration = structure(c(59, 60, 121, 63, 73, 
                                                     64, 81, 60, 60, 65), 
                                                   class = "difftime", 
                                                   units = "mins"), 
                           year_m = structure(c(18262, 18262, 18322, 18262, 18262, 
                                                18262, 18262, 18262, 18293, 18293), 
                                              class = "Date")), 
                      row.names = c(NA, -10L), 
                      class = c("tbl_df", "tbl", "data.frame"))

dateSelectUI <- function(id) {
   dateRangeInput(NS(id, "dateRange"), "Dates", 
                  start = min(ymd(test_app$year_m)),
                  end = max(ymd(test_app$year_m)),
                  format = "dd-mm-yyyy")
}

dateSelectServer <- function(id) {
   moduleServer(id, function(input, output, session) {
      list(
         min_date = reactive({input$dateRange[1]}),
         max_date = reactive({input$dateRange[2]})
      ) 
   })
}

demoSummaryUI <- function(id) {
   verbatimTextOutput(NS(id, "verbatim"))
}


demoSummaryServer <- function(id, dataset, date_range) {
   moduleServer(id, function(input, output, session){
      output$verbatim <- renderPrint({
         dataset %>%
            filter(year_m >= date_range$min_date() & 
                   year_m <= date_range$max_date())
      })
   })
}

ui <- fluidPage(
   dateSelectUI("demoDate"),
   demoSummaryUI("Demo")
)

server <- function(input, output, session) {
   demo_date <- dateSelectServer("demoDate")
   demoSummaryServer("Demo",
                     dataset = test_app,
                     date_range = demo_date)
}
shinyApp(ui, server)

I think your major problem was that you assigned the list elements via <- and not via =. Once fixed, your module is returning a list of reactives. To get the value of the reactive you have to "call" it, as you did correctly in your commented code: date_range$min_date().

user_41257510
Related