如何使用 selectInput 作为跨模块的响应式

问题描述 投票:0回答:1

我目前正在使用 golem 框架构建一个闪亮的应用程序并尝试使用模块,但是我在连接模块方面遇到了困难。我当前的配对应用程序由 3 个基本模块组成:1) 确定用户的数据选择,2) 绘制图形,3) 全局 UI。我的问题是如何构建模块,以便当用户在模块 1 中选择输入时,数据会根据这些选择进行过滤,然后可用于在下一个模块中进行绘图。然后,绘图模块使用 if/else 语句根据数据选择模块中使用的 inputselect 确定应显示哪个绘图。由于某种原因,我在侧面板中选择了输入,而不是在绘图模块中,所以我想将它们分开。任何帮助,即使是如何工作的基本结构,都会很棒!

下面是我尝试过的代码,错误在于我跨模块通信的方式。但是,我只是不确定如何解决它。


library(tidyverse)
library(shiny)
library(shinyWidgets)
library(shinydashboard)

data<- expand.grid(
  year = 1993:2005,
  species = c("Chinook", "Steelhead"),
  rear_type = c("Hatchery-origin", "Natural-origin"),
  doy = 90:180)
data<-data %>%
  mutate(SAR = rnorm(n(), mean = .05, sd = .01))



mod_dataselect_ui <- function(id){
  ns <- NS(id)
  tagList(

    #select species
    selectInput(inputId = ns("select_spp"),
                label = "Select species",
                choices =  c("Chinook", "Steelhead"),#data.pred$species
                selected = unique(data$species),
                width = "200px",
                multiple = T),

    #select rear type
    selectInput(inputId = ns("select_rear"),
                label = "Select rearing type",
                choices = c("Natural-origin", "Hatchery-origin"),
                selected = unique(data$rear_type),
                width = "200px",
                multiple = T),

    # prompt to select all years or by year
    selectInput(
      inputId = ns("year_display"),
      label = "View by",
      choices = c("All Years", "Year"),
      selected = "All Years"
    ),
    uiOutput(ns("year_picker"))
  )
}

mod_dataselect_server <- function(id){
  moduleServer( id, function(input, output, session){
    ns <- session$ns

    # Render the UI for the year picker
    output$year_picker <- renderUI({

      ns <- session$ns


      if (input$year_display == "Year") {
        pickerInput(
          inputId = ns("select_years"),
          label = "Select Year(s)",
          choices = unique(data$year),
          selected = 2000,
          options = list(`actions-box` = TRUE),
          multiple = TRUE
        )
      } else {
        NULL
      }
    })

    # Reactive for year_display
    year_display <- reactive({
      input$year_display
    })

    filtered_data <- reactive({
      if (input$year_display == "All Years") {
        data %>%
          filter(
            species %in% c(input$select_spp),
            rear_type %in% c(input$select_rear)
          )
      } else if (input$year_display == "Year" && !is.null(input$select_years)) {
        data %>%
          filter(
            species %in% c(input$select_spp),
            rear_type %in% c(input$select_rear),
            year %in% c(input$select_years)
          )
      } else {
        NULL
      }
    })

  })
}


mod_SAR_plot_ui <- function(id){
  ns <- NS(id)
  tagList(

    plotly::plotlyOutput(outputId = ns("SAR_plot"))

  )
}

#' SAR_plot Server Functions
#'
#' @noRd
mod_SAR_plot_server <- function(id, data){
  moduleServer(id, function(input, output, session){
    ns <- session$ns

    #    Retrieve reactive values from mod_dataselect_server
         dataselect_reactives <- mod_dataselect_server("dataselect_1")
         filtered_data <- dataselect_reactives$filtered_data
         year_display <- dataselect_reactives$year_display

    output$SAR_plot <- plotly::renderPlotly({

      # Filter data based on user selection
      if (dataselect_reactives$year_display == "All Years") {

        ggplotly(ggplot(dataselect_reactives$filtered_data, aes(x=doy, y=SAR))+
                   geom_point() + facet_grid(rear_type ~ species))

      } else if (dataselect_reactives$year_display == "Year") {

        ggplotly(dataselect_reactives$filtered_data, aes(x=doy, y=SAR))+
                   geom_point() + facet_grid(rear_type ~ year + species))
      }
    })
  })
}


app_ui <- function(request) {
  tagList(

    fluidPage(
      shinydashboard::dashboardPage(

        ## Sidebar content - used as a navigation menu to each tab
        sidebar = shinydashboard::dashboardSidebar(
          shinydashboard::sidebarMenu(
            # Setting id makes input$tabs give the tabName of currently-selected tab
            id = "tabs",
            shinydashboard::menuItem("Plots", tabName = "figs", icon = icon("chart-line")),
            div(id = "tabs_filter",
                conditionalPanel(condition = "input.tabs == 'figs'",  mod_dataselect_ui("dataselect_1"))
            )
          )
        ),
        body = shinydashboard::dashboardBody(
          shinydashboard::tabItems(
            shinydashboard::tabItem(tabName = "figs",mod_HydroSurv_ui("HydroSurv_ui_1"))
          )
        )
      )
    )
  )
}


app_server <- function(input, output, session) {

  filtered_data <- reactive(mod_dataselect_server("dataselect_1"))

  mod_SAR_plot_server("SAR_plot_1", filtered_data())
  mod_SAR_table_server("SAR_table_1", filtered_data())
}

shiny module shinydashboard shiny-reactivity golem
1个回答
0
投票

您需要从第一个模块传递列表中的反应。然后将其作为反应对象传递到绘图模块。然后使用绘图模块内的

()
访问该值。试试这个

library(tidyverse)
library(shiny)
library(shinyWidgets)
library(shinydashboard)

data<- expand.grid(
  year = 1993:2005,
  species = c("Chinook", "Steelhead"),
  rear_type = c("Hatchery-origin", "Natural-origin"),
  doy = 90:180)
data<-data %>%
  dplyr::mutate(SAR = rnorm(n(), mean = .05, sd = .01))


mod_dataselect_ui <- function(id){
  ns <- NS(id)
  tagList(
    
    #select species
    selectInput(inputId = ns("select_spp"),
                label = "Select species",
                choices =  c("Chinook", "Steelhead"),#data.pred$species
                selected = unique(data$species),
                width = "200px",
                multiple = T),
    
    #select rear type
    selectInput(inputId = ns("select_rear"),
                label = "Select rearing type",
                choices = c("Natural-origin", "Hatchery-origin"),
                selected = unique(data$rear_type),
                width = "200px",
                multiple = T),
    
    # prompt to select all years or by year
    selectInput(
      inputId = ns("year_display"),
      label = "View by",
      choices = c("All Years", "Year"),
      selected = "All Years"
    ),
    uiOutput(ns("year_picker"))
  )
}

mod_dataselect_server <- function(id){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    
    # Render the UI for the year picker
    output$year_picker <- renderUI({
      req(input$year_display)
                
      if (input$year_display == "Year") {
        pickerInput(
          inputId = ns("select_years"),
          label = "Select Year(s)",
          choices = unique(data$year),
          selected = 2000,
          options = list(`actions-box` = TRUE),
          multiple = TRUE
        )
      } else {
        NULL
      }
    })
    
    # Reactive for year_display
    yr <- reactive({
      input$year_display
    })
    
    filtereddata <- reactive({
      if (input$year_display == "All Years") {
        df <- data %>%
          dplyr::filter(
            species %in% c(input$select_spp),
            rear_type %in% c(input$select_rear)
          )
      } else if (input$year_display == "Year") { 
        df <- data %>%
          dplyr::filter(
            species %in% c(input$select_spp),
            rear_type %in% c(input$select_rear)  
          )
        if (!is.null(input$select_years)) df <- df %>% dplyr::filter(year %in% c(input$select_years))
      } else {
        df <- NULL
      }
      df
    })

    return(list(filtered_data = filtereddata, year_display= yr))
    
  })
}


mod_SAR_plot_ui <- function(id){
  ns <- NS(id)
  tagList(
    
    plotly::plotlyOutput(outputId = ns("SAR_plot"))
    
  )
}

#' SAR_plot Server Functions
#'
#' @noRd
mod_SAR_plot_server <- function(id, data){
  moduleServer(id, function(input, output, session){
    ns <- session$ns
    
    #    Retrieve reactive values from mod_dataselect_server
    # dataselect_reactives <- mod_dataselect_server("dataselect_1")
    # filtered_data <- dataselect_reactives$filtered_data
    # year_display <- dataselect_reactives$year_display
    
    output$SAR_plot <- plotly::renderPlotly({
      dataselect_reactives <- data
      filtered_data <- dataselect_reactives$filtered_data()
      year_display <- dataselect_reactives$year_display()
      p <- NULL
      # Filter data based on user selection
      if (year_display == "All Years") {
        
        p <- ggplotly(ggplot(filtered_data, aes(x=doy, y=SAR))+
                   geom_point() + facet_grid(rear_type ~ species))
        
      } else if (year_display == "Year") {
        
        p <- ggplotly(ggplot(filtered_data, aes(x=doy, y=SAR))+
          geom_point() + facet_grid(rear_type ~ year + species))
      }
      p 
    })
  })
}


app_ui <- function(request) {
  tagList(
    
    fluidPage(
      shinydashboard::dashboardPage(
        dashboardHeader(),
        ## Sidebar content - used as a navigation menu to each tab
        sidebar = shinydashboard::dashboardSidebar(
          shinydashboard::sidebarMenu(
            # Setting id makes input$tabs give the tabName of currently-selected tab
            id = "tabs",
            shinydashboard::menuItem("Home", tabName = "home", icon = icon("home")),
            shinydashboard::menuItem("Plots", tabName = "figs1", icon = icon("chart-line"), 
                                     mod_dataselect_ui("dataselect_1"),
                                     shinydashboard::menuItem("Display Plots", tabName = "figs", icon = icon("chart-line"))  ### need to select this tab to display plots
                                     )   #,
            # div(id = "tabs_filter",
            #     conditionalPanel(condition = "input.tabs == 'figs'",  mod_dataselect_ui("dataselect_1"))
            # )
          )
        ),
        body = shinydashboard::dashboardBody(
          shinydashboard::tabItems(
            shinydashboard::tabItem(tabName = "figs", 
                                    # mod_HydroSurv_ui("HydroSurv_ui_1"),
                                    mod_SAR_plot_ui("SAR_plot_1") #,  mod_SAR_table_ui()
                                    )
          )
        )
      )
    )
  )
}


app_server <- function(input, output, session) {
  
  filtered_data <- mod_dataselect_server("dataselect_1")

  mod_SAR_plot_server("SAR_plot_1", filtered_data)  ### filtered_data is reactive
  # mod_SAR_table_server("SAR_table_1", filtered_data)
}

shinyApp(ui=app_ui, server=app_server)
© www.soinside.com 2019 - 2024. All rights reserved.