r - 使用来自 Shiny 模块的数字输入值作为用户定义函数的输入，并使用该函数的输出作为另一个模块中的输入

Question

我有一个带有两个模块和一个用户定义函数的 Shiny 应用程序：

• 第一个模块创建两个数值输入，其值设置为 1 和 2。
• 用户定义的函数应该取第一个模块的值并加 1。
• 第二个模块应该获取函数的结果，再次加 1 并渲染结果。

该应用程序抛出错误Warning: Error in user_function: could not find function "user_function"，我不知道为什么。任何帮助和解释将不胜感激！

下面是最小的示例代码。

first_module.R

#Define ui
first_module_ui <- function(id) {
  ns <- NS(id)
  
  tagList(
    numericInput(
      inputId = ns("first_input_1"),
      label = "Input 1:",
      value = 1
    ),
    numericInput(
      inputId = ns("first_input_2"),
      label = "Input 2:",
      value = 2
    )
  )
}

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

用户函数.R

#User defined function
user_function <- function(first_module_res) {
    
      function_result_1 <- reactive({first_module_res$first_input_1 + 1})
      function_result_2 <- reactive({first_module_res$first_input_2 + 1})
      
      return(
        list(
          function_result_1 = function_result_1,
          function_result_2 = function_result_2
        )
      )
  }

second_module.R

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

#Define server logic
second_module_server <- function(input, output, session, function_result) {
    ns <- session$ns
    
    function_result_1 <- reactive({function_result$result_1 + 1})
    
      output$second_input <- renderUI({
        disabled(textInput(
          inputId = ns("second_input_1"),
          label = "Second input 1:",
          value = function_result_1()
        ))
      })
      
      function_result_2 <- reactive({function_result$result_2 + 1})
    
      output$second_input_2 <- renderUI({
        disabled(textInput(
          inputId = ns("second_input_2"),
          label = "Second input 2:",
          value = function_result_2()
        ))
      })

    return(
      list(reactive({second_input_1()}),
           reactive({second_input_2()}))
           )
  }

应用程序.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")
        )
    )
)

# Define server logic 
server <- function(input, output, session) {
    
    first_module_res <- callModule(first_module_server, "first")
    
    observe(
        function_result <- user_function(first_module_res),
        
        second_module_res <- callModule(second_module_server, "second", function_result)
    )
}

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

标签： rshinyshinymodules

Answer 1

您的代码中有 2 个错误：

• 在 app.R 中，您不需要observe. 如果使用observe，还应该将表达式括在花括号中。但是，您也有一个逗号observe导致错误
• 在第二个模块中，您必须使用function_result$function_result_1()而不是function_result$result_1()

另外，我将 UI 元素的输出 ID 命名为与输入 ID 不同，否则我认为这不是很好的风格。

second_module.R

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

#Define server logic
second_module_server <- function(input, output, session, function_result) {
  ns <- session$ns
  
  function_result_1 <- reactive({
    function_result$function_result_1() + 1})

  output$UI_second_input_1 <- renderUI({
    disabled(textInput(
      inputId = ns("second_input_1"),
      label = "Second input 1:",
      value = function_result_1()
    ))
  })

  function_result_2 <- reactive({function_result$function_result_2() + 1})

  output$UI_second_input_2 <- renderUI({
    disabled(textInput(
      inputId = ns("second_input_2"),
      label = "Second input 2:",
      value = function_result_2()
    ))
  })

  return(
    list(reactive({second_input_1()}),
         reactive({second_input_2()}))
  )
}

应用程序.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")
        )
    )
)

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

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