R语言 如何将值从shiny模块的一个示例传递到同一模块的另一个示例?

daolsyd0  于 2023-06-27  发布在  其他
关注(0)|答案(1)|浏览(117)

我创造了一个人为的例子来证明我想要达到的目标。基本上,我有一个模块化的闪亮的应用程序,有两个标签,地区和地区。在区域选项卡中,我想显示一个表,其中数据集依赖于下拉菜单中选择的区域。在地区选项卡中,我想再次显示一个表,其中数据集依赖于先前选择的地区和在地区选项卡的下拉菜单中选择的地区。
然而,在试图让地区选项卡下拉菜单中的地区选择在地区选项卡中可访问,处理要显示的数据不起作用,我敢肯定,由于模块的范围问题。但这是一个足够常见的工作流程,让我相信有一个答案,我在这里。代码如下:
静态R Markdown文档不支持

library(shiny)
library(shinydashboard)
#> 
#> Attaching package: 'shinydashboard'
#> The following object is masked from 'package:graphics':
#> 
#>     box

get_regional_dataset = function(region){
  browser()
  if(region=="Morogoro"){
    mtcars
  }else{
    iris
  }
}

get_district_dataset = function(region,district){
  browser()
  if(region=="Morogoro" & district=="Morogoro MC"){
    mtcars
  }else{
    iris
  }
}

table_UI <- function(id) {
  ns <- NS(id)
  tagList(
    sidebarLayout(
      sidebarPanel(width = 2,
                   uiOutput(ns("selector")),
      ),
      mainPanel(
        DT::dataTableOutput(ns('table'))
      )
    )
  )
}

table_UI_district <- function(id) {
  ns <- NS(id)
  tagList(
    sidebarLayout(
      sidebarPanel(width = 2,
                   uiOutput(ns("selector"))
      ),
      mainPanel(
        DT::dataTableOutput(ns('table'))
      )
    )
  )
}

table_Server <- function(id, input) {
  moduleServer(id,function(input, output, session) {
    
    region_reactive_val = reactiveVal()
    
    observeEvent(input$region_choice,{
      region_reactive_val(input$region_choice)
      ds = get_regional_dataset(region_reactive_val())
      rate = get_reg_rate(region_reactive_val())
      
      output$table = DT::renderDataTable({
        ds
      })
    })
    
    observeEvent(input$district_choice,{
      if(id=="ER_district"){
        ds = get_district_dataset(region_reactive_val(),input$district_choice)
        rate = get_reg_rate(region_reactive_val())
      }
      
      output$table = DT::renderDataTable({
        ds
      })
    })
    
    if(id %in% c("ER")){
      output$selector=renderUI({
        selectInput(inputId=NS(id,"region_choice"),
                    label="Region",
                    choices = c("Morogoro","Lindi","Mtwara","Njombe","Ruvuma",
                                "Iringa"),selected = "Morogoro" )
      })
    }
    
    if(id %in% c("ER_district")){
      output$selector=renderUI({
        selectInput(inputId=NS(id,"district_choice"),
                    label="Council",
                    choices = c("Morogoro MC","Morogoro DC"))
      })
    }
  })
}

ui = fluidPage(
  tabsetPanel(id = 'cqi_indicators',
              tabPanel('Region',
                       tabsetPanel(
                         id='region_indicators',
                         tabPanel("Early Retention",table_UI("ER"))
                       )
              ),
              tabPanel('District',
                       tabsetPanel(
                         id='district_indicators',
                         tabPanel("Early Retention",table_UI_district("ER_district"))
                       )
              )
              
  )
)

server = function(input,output,session){
  table_Server("ER_district", input)
  table_Server("ER", input)
}

shinyApp(ui,server)
#> PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.

闪亮应用程序
reprex package(v2.0.1)于2023-06-24创建

icnyk63a

icnyk63a1#

你需要重新组织你的代码。试试这个

library(shiny)
library(shinydashboard)

get_regional_dataset = function(region){
  #browser()
  if(region=="Morogoro"){
    mtcars
  }else{
    iris
  }
}

get_district_dataset = function(region,district){
  #browser()
  if(region=="Morogoro" & district=="Morogoro MC"){
    mtcars
  }else{
    iris
  }
}

table_UI1 <- function(id) {
  ns <- NS(id)
  tagList(
    
      sidebarPanel(width = 2,
                   uiOutput(ns("selector")),
      )
    
  )
}

table_UI2 <- function(id) {
  ns <- NS(id)
  tagList(
 
      mainPanel(
        DT::dataTableOutput(ns('table'))
      )
    
  )
}

table_Server1 <- function(id) {
  moduleServer(id,function(input, output, session) {
    ns <- session$ns
    output$selector <- renderUI({
      if(id %in% c("ER_district")) {
        choices <- c("Morogoro MC","Morogoro DC")
        label <- "Region"
      }
      else { 
        choices <- c("Morogoro","Lindi","Mtwara","Njombe","Ruvuma","Iringa")
        label <- "Council"
      }
      
      selectInput(inputId=NS(id,"choice"),
                  label = label,
                  choices = choices)
    })
    return(reactive(input$choice))
  })
}

table_Server <- function(id, mychoice, mychoice2) {
  moduleServer(id,function(input, output, session) {
    rv <- reactiveValues()
    
    observe({
      
      rv$reg <<- mychoice()
      rv$dist <<- mychoice2()
      
      if (!is.null(mychoice())) rv$df <- get_regional_dataset(rv$reg)
      if(id=="ER_district"){
        if (!is.null(mychoice2())) rv$df <- get_district_dataset(rv$reg,rv$dist)
        
      }
    })
    
    output$table = DT::renderDataTable({
      rv$df
    })
    
  })
}

ui = fluidPage(
  tabsetPanel(id = 'cqi_indicators',
              tabPanel('Region',
                       tabsetPanel(
                         id='region_indicators',
                         tabPanel("Early Retention",table_UI1("ER"), table_UI2("ER"))
                       )
              ),
              tabPanel('District',
                       tabsetPanel(
                         id='district_indicators',
                         tabPanel("Early Retention",table_UI1("ER_district"), table_UI2("ER_district"))
                       )
              )
              
  )
)

server = function(input,output,session){
  
  choice1 <- table_Server1("ER")
  choice2 <- table_Server1("ER_district")
  
  table_Server("ER", choice1, choice2)
  table_Server("ER_district", choice1, choice2)
  
}

shinyApp(ui,server)

相关问题