Search code examples
shinynamespacesmodularity

Data Table Using Modularity in RShiny

I'm trying to make a simple Shiny dashboard using the iris dataset in R.

What I accomplished so far: The current dashboard has two dropdowns. One that filters the Species column and one for the subspecies column that's dependent on the first dropdown. These two dropdowns work.

What's not working: Based on the two dropdowns, I'd like to see a datatable which should be a filtered dataset.

I think I'm using a wrong name space ?

Any advice would be of great help!

library(shiny)
library(DT)
library(dplyr)


## global.R
# Create sub_species column
iris2 <- iris %>% 
  mutate(
    subspecies = case_when(
      startsWith(as.character(Species), "setosa") ~ rep(c("setosa1", "setosa2"), length.out = n()),
      startsWith(as.character(Species), "versicolor") ~ rep(c("versicolor1", "versicolor2"), length.out = n()),
      startsWith(as.character(Species), "virginica") ~ rep(c("virginica1", "virginica2"), length.out = n())
    )
  ) 


## ui.R
fluidPage(
  sidebarLayout(
    sidebarPanel(
      dropdownsUI("dropdowns")
    ),
    
    mainPanel(
      DT::dataTableOutput("table1")
    )
  )
)


## server.R
function(input, output, session) {
  subspeciesServer("dropdowns")
  
  data1 <- filteredDataServer("table1")
  output$table1 <- DT::renderDataTable({
    data1()
  })
}


## modules.R
# UI logic
dropdownsUI <- function(id) {
  ns <- NS(id) 
  
  # All input IDs in the function body must be wrapped with ns()
  tagList(
    selectInput(ns("speciesDropdown"), label = "Species:", choices = c("setosa", "versicolor", "virginica")),
    uiOutput(ns("subspeciesDropdown")),
    DT::dataTableOutput(ns("datatable"))
  )
}

# Sub Species Dropdown logic
subspeciesServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    
    dependent_subspecies <- reactive({
      iris2 %>%
        filter(Species == req(input$speciesDropdown)) %>% 
        pull(subspecies) %>%
        unique()
    })
    
    output$subspeciesDropdown <- renderUI({
      selectInput("vars_subspecies", "Sub Species:", choices = dependent_subspecies())
    })
  }
  )
}

# Filtered data logic
filteredDataServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    
    df <- reactive({
      req(input$speciesDropdown, input$subspeciesDropdown)
      
      iris2 %>%
        # may be this what's causing the error ?
        filter(Species %in% input$speciesDropdown & subspecies %in% input$vars_subspecies) 
    })
    return(df)
  }
  )
}

enter image description here

Solution

  • Apart from namespace issue, you had a few other issues. You need to pass the reactive variables between modules. They are not available globally. Try this

    library(shiny)
library(DT)
library(dplyr)

## global.R
# Create sub_species column
iris2 <- iris %>% 
  dplyr::mutate(
    subspecies = case_when(
      startsWith(as.character(Species), "setosa") ~ rep(c("setosa1", "setosa2"), length.out = n()),
      startsWith(as.character(Species), "versicolor") ~ rep(c("versicolor1", "versicolor2"), length.out = n()),
      startsWith(as.character(Species), "virginica") ~ rep(c("virginica1", "virginica2"), length.out = n())
    )
  ) 

## modules.R
# UI logic
dropdownsUI <- function(id) {
  ns <- NS(id) 
  
  # All input IDs in the function body must be wrapped with ns()
  tagList(
    selectInput(ns("speciesDropdown"), label = "Species:", choices = c("setosa", "versicolor", "virginica")),
    uiOutput(ns("subspeciesDropdown"))
    #,DT::dataTableOutput(ns("datatable"))
  )
}

# Sub Species Dropdown logic
subspeciesServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    rv <- reactiveValues()
    
    dependent_subspecies <- reactive({
      iris2 %>%
        filter(Species == req(input$speciesDropdown)) %>% 
        pull(subspecies) %>%
        unique()
    })
    
    output$subspeciesDropdown <- renderUI({
      req(dependent_subspecies())
      selectInput(ns("vars_subspecies"), "Sub Species:", choices = dependent_subspecies())
    })
    
    observe({
      
      rv$var1 <- input$speciesDropdown
      rv$var2 <- input$vars_subspecies
    })
    return(rv)
  }
  )
}

# Filtered data logic
filteredDataServer <- function(id,sp,subsp,mydf) {
  moduleServer(id, function(input, output, session) {
    
    df <- reactive({
      mydf  %>% dplyr::filter(subspecies %in% subsp())
    })
    
    return(df)
  }
  )
}

## ui.R
ui <-  fluidPage(
    sidebarLayout(
      sidebarPanel(
        dropdownsUI("dropdowns")
      ),
      
      mainPanel(
        DT::dataTableOutput("table1")
      )
    )
)

## server.R
server <- function(input, output, session) {
  myvars <- subspeciesServer("dropdowns")
  
  data1 <- filteredDataServer("table1", reactive(myvars$var1), reactive(myvars$var2),iris2)
 
  output$table1 <- DT::renderDataTable({
    datatable(req(data1()))
  })
}

shinyApp(ui = ui, server = server)