在 RShiny 中使用模块化的数据表

Question

我正在尝试使用 R 中的 iris 数据集制作一个简单的闪亮仪表板。

到目前为止我所完成的工作：当前仪表板有两个下拉列表。一个用于过滤 Species 列，另一个用于过滤依赖于第一个下拉列表的 subspecies 列。这两个下拉菜单有效。

不起作用：根据两个下拉列表，我想看到一个数据表，它应该是经过过滤的数据集。

我想我使用了错误的名称空间？

任何建议都会有很大帮助！

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)
  }
  )
}

Answer 1

除了命名空间问题之外，您还遇到了一些其他问题。您需要在模块之间传递反应变量。它们在全球范围内不可用。试试这个

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)