Блестящие модули: передача значений из 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 передается как на нижнюю панель, так и на главную панель:

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, я использую только серверную функцию с 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)
}

Как вывести параметры визуализированного пользовательского интерфейса после того, как отрендерено и вызвана функция по умолчанию?

---

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. На первый взгляд, это не работает для меня; реактивные значения, необходимые для каждой нижней панели, изменяются в соответствии с графиком, выбранным пользователем. Может быть, я могу включить вызов renderUI в функцию bottom_panel, объявить эти идентификаторы как реактивные и использовать их при создании панели?

Answer 1

Чтобы извлечь входные значения из динамически созданного объекта (через renderUI),

• Используйте session$ns для доступа к пространству имен в модуле сервера
• Назовите динамически созданный объектas ns("ID").

Вот простой пример, где

1. Вы выбираете единицу в первом пользовательском интерфейсе / модуле, переходите к 1 и 3
2. Показываете выбранное значение.

Соответствует ли это тому, что вы хотите сделать?

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