Shiny Modules：将值从 renderUI（在服务器函数中）传递到另一个模块的服务器函数

Question

（我通读了this 问题，尽管标题相似，但它与我的问题无关——或者，如果是的话，我太笨了，看不出它是如何应用的。）

我正在模块化我的 Shiny 代码，以便添加额外的图表只需要在单独的文件中添加几个函数。存在三个面板——侧面板（用户在其中选择图形）、底部面板（用户在其中选择图形参数）和主面板（在其中显示图形）。

侧面板不变，但底部面板会根据侧面板中的选择而变化。

side_panel.R

# UI function
sidePanelInput <- function(id, label='side panel') { # Some input w/ ns = selected_graph }

# Server function
sidePanel <- function(input, output, session) {
    selected_graph <- reactive({input$selected_graph})
    return(selected_graph)

在我的 app.R 文件中，selected_graph 被传递到底部面板和主面板：

app.R

# ...
sidePanel <- callModule(sidePanel, 'side')
bottomPanel <- callModule(bottomPanel, 'bottom', data=some_data, selected_graph=sidePanel)
mainPanel <- callModule(mainPanel, "main", data=some_data, selected_graph=sidePanel, params=bottomPanel)

# ...

到目前为止一切都很好（注意bottomPanel 也返回了一些东西，然后传递给了mainPanel）。所有这些来回传递都很好。这是我的问题：每个图表的底部面板都不同，并在单独的文件中定义。这意味着bottomPanel 模块需要知道从sidePanel 吐出的反应中渲染什么。这也意味着我不使用bottomPanel的UI功能，我只使用renderUI的服务器功能：

bottom_panel.R

source('graphs')
bottomPanel <- function(input, output, session, data, selected_graph) {
    # Call the function of the graph, depending on what the selected graph is
    output$bottomPanel <- renderUI({
        tagList(
            match.fun(paste(selected_graph(), '_bottom_panel', sep=''))(session$ns('id'))
        )
    })

    # So, if the selected graph is 'scatter_1', then the function call will be
    # scatter_1_bottom_panel(session$ns('id')) -- An example of a bottom_panel function
    # is provided at the end of this question, but it works as intended

    # Now, we set the defaults (specific to the graph); for example, slider-ranges
    # will be set according to mins and maxes in the data. Similar to above, a 
    # match.fun() call is used here to determine how the defaults are set
    observe({
        match.fun(paste(selected_graph(), '_bottom_panel_defaults', sep=''))(session, data)
    })

    # Here is my problem. I need to output the parameters of the newly-rendered
    # bottom panel, so that those parameters can be passed to the main panel. This
    # as it is doesn't work, because one apparently can't read from server output
    params <- reactive({output$bottomPanel})
    return(params)
}

渲染后的UI在渲染并调用默认值函数后如何输出参数？

---

example_bottom_panel.R

scat_2_bottom_panel <- function(id) {
    ns <- NS(id)
    panel <- wellPanel(
        sliderInput(
            inputId = ns('duration_range'),
            label = 'Duration of Sound [ms]',
            min = 0,
            max = 10000,
            value = c(0, 10000),
            step = 100,
            round = FALSE,
            ticks = TRUE
        )
    )
    return(panel)
}

example_default_function.R

scatter_1_bottom_panel_defaults <- function(session, data) { 
    updateSliderInput(session, 'duration_range', value=c(min(data$duration), max(data$duration)))
}

---

我已经阅读了上面链接的问题几次，似乎这是在服务器功能中所做的：

xvar <- reactive({input[[ "xvar" ]] })
yvar <- reactive({input[[ "yvar" ]] })

然后xvar 和yvar 被用作renderUI 调用中的参数。乍一看，这对我不起作用；每个底部面板所需的反应值根据用户选择的图表而变化。也许我可以在 bottom_panel 函数中包含 renderUI 调用，将这些 ID 声明为响应式，然后在面板生成中使用它们？

Answer 1

从动态创建的对象中检索输入值（通过renderUI），

• 使用session$ns访问服务器模块中的命名空间
• 将动态创建的对象命名为ns("ID")。

这是一个简单的例子，其中

1. 您在第一个 ui/module 中选择单元，将其传递给第二个和第三个。
2. 您在第二个 ui/module 中选择值，传递给第三个。
3. 在第三个 ui/module 中显示选定的值。

这符合你想做的吗？

library(shiny)


setUnitUI <- function(id) {
  ns <- NS(id)
  selectInput(ns('unit'), 'unit', c('km', 'mile'))
}

setValueUI <- function(id) {
  ns <- NS(id)
  uiOutput(ns('dynamicSlider'))
}

showValueUI <- function(id) {
  ns <- NS(id)
  textOutput(ns('value'))
}

ui <- fluidPage(
  setUnitUI('unit'),
  setValueUI('value'),
  showValueUI('show')
)


setUnitModule <- function(input, output, session) {
  reactive(input$unit)
}

setValueModule <- function(input, output, session, unitGetter) {
  output$dynamicSlider <- renderUI({
    ns <- session$ns
    unit <- unitGetter()
    if (unit == 'km') {
      sliderInput(ns('pickValue'), paste('Pick value in', unit), 
                  min=0, max=150, value=0)
    } else {
      sliderInput(ns('pickValue'), paste('Pick value in', unit), 
                  min=0, max=100, value=0)
    }
  })

  reactive(input$pickValue)
}

showValueModule <- function(input, output, session, unitGetter, valueGetter) {
  output$value <- renderText(paste('You chose', valueGetter(), unitGetter()))
}

server <- function(input, output, session) {
  unitGetter <- callModule(setUnitModule, 'unit')
  valueGetter <- callModule(setValueModule, 'value', unitGetter)
  callModule(showValueModule, 'show', unitGetter, valueGetter)
}


shinyApp(ui, server, options=list(launch.browser=TRUE))