r - Shiny 的模块 : Pass values from renderUI (in server function) to another module's server function

(我通读了 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 吐出的 react 中渲染什么。这也意味着我不为 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 调用中的参数。乍一看，这对我不起作用；每个底部面板所需的 react 值根据用户选择的图表而变化。也许我可以在 bottom_panel 函数中包含 renderUI 调用，将这些 ID 声明为响应式，并在面板生成中使用它们？

最佳答案

要从动态创建的对象中检索输入值(通过 renderUI )，

使用 session$ns 访问服务器模块中的命名空间

将动态创建的对象命名为 ns("ID") 。

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

您在第一个 ui/module 中选择单元，将其传递给第二个和第三个。

您在第二个 ui/module 中选择值，传递给第三个。

在第三个 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))

关于r - Shiny 的模块 : Pass values from renderUI (in server function) to another module's server function，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/52007261/