闪亮的模块：将值从renderUI（在服务器功能中）传递到另一个模块的服务器功能

Question

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

我正在对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同时传递到底部面板和主面板：

应用程序

# ...
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吐出的反应堆中渲染什么。这也意味着我不使用UI函数bottomPanel，而只使用w /的服务器函数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 /模块中选择单位，然后将其传递给第二个和第三个。
2. 您在第二个ui /模块中选择值，然后传递给第三个。
3. 在第三个ui /模块中显示选定的值。

这符合您想要做什么？

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))