在另一个模块中使用一个Shiny模块的变量值

问题描述

我有三个模块:

  • 一个模块创建一个值为{1的numericInput
  • 第二个模块创建一个textInput,它是通过服务器功能中的renderUI创建的。该值等于第一个模块的值+ 1。
  • 第三个模块的功能应与第二个模块相同,但其值应等于第二个模块的值+ 1。

第二和第三模块中的textInputrenderUI的选择是有意的。该代码在没有第三个模块的情况下可以工作,但是当包含第三个模块时,将引发以下错误Error in $: object of type 'closure' is not subsettable。下面是最小的示例代码。帮助将不胜感激!

first_module.R

#Define ui
first_module_ui <- function(id) {
  ns <- NS(id)
  
  tagList(numericInput(
    inputId = ns("first_input"),label = "First input:",value = 1
  ))
}

#Define server logic
first_module_server <- function(input,output,session) {
  return(input)
}

second_module.R

#Define ui
second_module_ui <- function(id) {
  ns <- NS(id)
  
  tagList(uIoUtput(outputId = ns("second_input")))
}

#Define server logic
second_module_server <- function(input,session,first_module_res) {
    ns <- session$ns
    
    observe({
      second_input <- first_module_res$first_input + 1
      output$second_input <- renderUI({
        disabled(textInput(
          inputId = ns("second_input"),label = "Second input:",value = second_input
        ))
      })
    })
    return(reactive({second_input}))
  }

third_module.R

#Define ui
third_module_ui <- function(id) {
  ns <- NS(id)
  
  tagList(uIoUtput(outputId = ns("third_input")))
}

#Define server logic
third_module_server <- function(input,second_module_res) {
    ns <- session$ns
    
    observe({
      third_input <- second_module_res$second_input + 1
      output$third_input <- renderUI({
        disabled(textInput(
          inputId = ns("third_input"),label = "Third input:",value = third_input
        ))
      })
    })
  }

app.R

library(shiny)
library(shinyjs)

# Define UI
ui <- fluidPage(
    
    useShinyjs(),# Application title
    titlePanel("Demo"),# Sidebar 
    sidebarLayout(
        sidebarPanel(
            first_module_ui("first")
        ),mainPanel(
            second_module_ui("second"),third_module_ui("third")
        )
    )
)

# Define server logic 
server <- function(input,session) {
    
    callModule(first_module_server,"first")
    first_module_res <- callModule(first_module_server,"first")
    
    callModule(second_module_server,"second",first_module_res)
    second_module_res <- callModule(second_module_server,first_module_res)
    
    callModule(third_module_server,"third",second_module_res)
    
}

# Run the application 
shinyApp(ui = ui,server = server)

解决方法

您的代码存在一些问题:

  • 您不需要observe,可以改用reactive,因为您的兴趣在于返回值(请参见here
  • 您应该将反应堆的计算值
  • 您不需要两次调用模块

由于您如何从模块服务器函数返回值,因此您的代码无法正常工作。从第一个模块返回完整的input,这使您可以在第二个模块中访问第一个模块的input中的值,就像在{{1}中没有任何模块的情况下访问它一样}来自主应用程序的功能。这意味着您不需要用括号来评估反应性,就可以像使用server一样执行first_module_res$first_input

但是,第二个模块不返回input$first_input,而是由您创建的反应式(通过返回值中的input)。现在,它变成输入到第三个模块中的值,并需要在其中用方括号reactive({})进行评估。还要注意,您直接评估了反应式,因为它是唯一返回的值(而不是第二个模块的完整second_module_res())。

input

编辑

您可以从带有多个反应堆的模块中返回列表:

library(shiny)
library(shinyjs)

#Define ui
first_module_ui <- function(id) {
  ns <- NS(id)
  
  tagList(numericInput(
    inputId = ns("first_input"),label = "First input:",value = 1
  ))
}

#Define server logic
first_module_server <- function(input,output,session) {
  return(input)
}

#Define ui
second_module_ui <- function(id) {
  ns <- NS(id)
  
  tagList(uiOutput(outputId = ns("second_input")))
}

#Define server logic
second_module_server <- function(input,session,first_module_res) {
  ns <- session$ns
  
  second_input <- reactive({
    first_module_res$first_input + 1
  })
  
    output$second_input <- renderUI({
      disabled(textInput(
        inputId = ns("second_input"),label = "Second input:",value = second_input()
      ))
    })
  return(reactive({second_input()}))
}

#Define ui
third_module_ui <- function(id) {
  ns <- NS(id)
  
  tagList(uiOutput(outputId = ns("third_input")))
}

#Define server logic
third_module_server <- function(input,second_module_res) {
  ns <- session$ns
  
  third_input <- reactive({
    second_module_res() + 1
  })
  
    output$third_input <- renderUI({
      disabled(textInput(
        inputId = ns("third_input"),label = "Third input:",value = third_input()
      ))
    })
}

# Define UI
ui <- fluidPage(
  
  useShinyjs(),# Application title
  titlePanel("Demo"),# Sidebar 
  sidebarLayout(
    sidebarPanel(
      first_module_ui("first")
    ),mainPanel(
      second_module_ui("second"),third_module_ui("third")
    )
  )
)

# Define server logic 
server <- function(input,session) {
  
  first_module_res <- callModule(first_module_server,"first")
  
  second_module_res <- callModule(second_module_server,"second",first_module_res)
  
  callModule(third_module_server,"third",second_module_res)
  
}

# Run the application 
shinyApp(ui = ui,server = server)