如何在R Shiny应用程序中从模块返回变量到服务器？

Question

我在一个R Shiny应用程序中遇到了从模块返回变量到服务器的问题。在一个模块中，我希望当观察到按钮按下时返回一个值，因此我将return()语句包装在observeEvent()内部的块中。然而，期望的值没有被返回，整个observeEvent()块似乎被返回了。

我尝试创建了一个最小化的工作示例来说明问题:

ui.R

# ui.R

fluidPage(
  input_module_ui("input"),
  actionButton("print_input_button",
               label = "Print Input")
)

server.R

# server.R

function(input, output, session) {

  # Calling input module.
  input_module_return <- callModule(input_module, "input")

  observeEvent(input$print_input_button, {
    print(input_module_return)
  })

}

global.R

# global.R

source("modules/input.R")

input.R

# input.R

input_module_ui <- function(id) {

  ns <- NS(id)

  tagList(
    textInput(ns("text_input"),
              label = h2("Input Text:")),
    actionButton(ns("submit_input"),
                 label = "Submit Input")
  )

}

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

  print("I should only print once")

  observeEvent(input$submit_input, {
    print("Return input")
    return(input$text_input)
  })

}

在测试这个应用程序时，我在文本输入框中输入了“test”并提交我的输入。然而，当我尝试打印输出时，与我预期的打印“test”不同，下面的内容被打印出来：

<Observer>
  Public:
    .autoDestroy: TRUE
    .autoDestroyHandle: function () 
    clone: function (deep = FALSE) 
    .createContext: function () 
    .ctx: environment
    destroy: function () 
    .destroyed: FALSE
    .domain: session_proxy
    .execCount: 3
    .func: function () 
    initialize: function (observerFunc, label, suspended = FALSE, priority = 0, 
    .invalidateCallbacks: list
    .label: observeEvent(input$submit_input)
    .onDomainEnded: function () 
    onInvalidate: function (callback) 
    .onResume: function () 
    .prevId: 1896
    .priority: 0
    resume: function () 
    run: function () 
    self: Observer, R6
    setAutoDestroy: function (autoDestroy) 
    setPriority: function (priority = 0) 
    suspend: function () 
    .suspended: FALSE

我相信这对应于input.R中的最后一个块：

observeEvent(input$submit_input, {
    print("Return input")
    return(input$text_input)
  })

如何使此应用程序按预期工作，并在观察到input$submit_input时返回input$text_input？

- michaelmccarthy404

Answer 1

你已经接近让这个工作了。闪亮模块的诀窍是将变量作为反应值传递进出它们。我对你的代码进行了两个小改动，以获得我认为你希望看到的结果。

首先是从服务器模块返回input$text_input的反应版本（而不是从观察者本身返回，观察者应该只告诉应用程序你想要发生什么）。

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

  print("I should only print once")

  observeEvent(input$submit_input, {
    print("Return input")
  })

  return(reactive({input$text_input}))

}

第二个变化是现在来自input_module的输出具有反应性。如果你想要值而不是函数内容，需要使用()解析对象。因此，在您的服务器函数中：

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

  # Calling input module.
  input_module_return <- callModule(input_module, "input")

  observeEvent(input$print_input_button, {
    print(input_module_return())
  })

}

输出：

Listening on http://127.0.0.1:6796
[1] "I should only print once"
[1] "Return input"
[1] "test"

- phalteman

Answer 2

我发现上面的代码在我的情况下出错了。因此，我认为我可以提供一个更通用的答案。

library(shiny)
library(tidyverse)

lower_UI <- function(id) {
  tagList(
    uiOutput(NS(id, "text3")),
    textOutput(NS(id,"verbose3")),
    actionButton(NS(id,"goButton"), label = "beep me", class = "btn-success")
  )
}

lower <- function(id) {
  moduleServer(id, function(input, output, session) {

    retV = reactiveValues(output = NULL)
    output$text3 <- renderUI(textInput(session$ns("text3"), "test", "test"))
    output$verbose3 <- renderText(input$text3)
    observe({

      retV$output = input$text3
    }) %>% bindEvent(input$goButton)

    return(reactive(retV$output))
})
}

upper_UI <- function(id) {
  lower_UI(NS(id, "test"))
}

upper <- function(id) {
  moduleServer(id, function(input, output, session) {

  uRV <- reactiveValues(one = NULL)
  output$one <- lower("test")

  observe({
    print(uRV$one())
    })
  })
}

ui <- fluidPage(
  upper_UI("upper")
)

server <- function(input, output, session) {
  upper("upper")
}

shinyApp(ui, server)

- Aaron C

---

你能对你在这里概括的内容提供一些解释吗？并解释一下为什么这些方法有帮助？这将帮助未来的读者更好地理解如何将这些方法应用到自己的问题上。谢谢！ - undefined

我承认，我记不清我为什么说那样的话了。看代码的话，我猜测通过返回一个局部的响应式值（在服务器模块内声明）可以灵活地对该变量进行操作和更新。 - undefined