Блестящие модули с наблюдениями и реактивными значениями

Question

Я пытался реконструировать следующее упрощенное приложение Shiny с использованием модулей , поскольку я считаю, что это будет наилучшим способом организации этого кода в гораздо более крупном приложении, где я буду использовать такие виды связанных слайдеров. числовые входы во многих местах.

Однако я не могу понять, как добиться такой же функциональности внутри модуля.

Вот пример приложения, которое работает точно так, как задумано, но не использует модули:

library(shiny)

# Let's build a linked Slider and Numeric Input

server <- function(input, output) {

  values <- reactiveValues(numval=1) 

  observe({
    values$numval <- input$slider
  })
  observe({
    values$numval <- input$number
  })

  output$slide <- renderUI({
    sliderInput(
      inputId = 'slider'
      ,label = 'SN'
      ,min = 0
      ,max = 10
      ,value = values$numval
    )})

  output$num <- renderUI({
    numericInput(
      inputId = 'number'
      ,label = 'SN'
      ,value = values$numval
      ,min = 0
      ,max = 10
    )
  })
}

ui <- fluidPage(
  uiOutput('slide'),
  uiOutput('num')
)


shinyApp(ui, server)

Вот моя попытка. (Обратите внимание, что «mortalityRate» и связанные строки являются лишь примером имен переменных, которые я буду использовать позже). Я попробовал несколько вариантов этой попытки, но неизбежно получаю ошибки, обычно указывающие на то, что я делаю что-то, что может быть сделано только внутри реактивного контекста:

numericSliderUI <- function(id, label = "Enter value", min = 1, max = 40, value) {
  ns <- NS(id)
  tagList(
    sliderInput(inputId = paste0(ns(id), "Slider"), label = label, min = min, max = max, value = value),
    numericInput(inputId = paste0(ns(id), "Numeric"), label = label, min = min, max = max, value = value)
  )
}

numericSlider <-
  function(input,
           output,
           session,
           value,
           mortalityRateSlider,
           mortalityRateNumeric
           ) {

  values <- reactiveValues(mortalityRate = value())
  observe({
      values[['mortalityRate']] <- mortalityRateSlider()
  })
  observe({
    values[['mortalityRate']] <- mortalityRateNumeric()
  })
  return( reactive( values[['mortalityRate']] ) )
}

library(shiny)
# source("modules.R") # I keep the modules in a separate file, but they're just pasted above for convenience here on StackOverflow.

ui <- fluidPage(
  uiOutput('mortalityRate')
)

server <- function(input, output) {
  values <- reactiveValues(mortalityRate = 1)
  mortalityRateValue <- callModule(
    numericSlider,
    id = 'mortalityRate',
    value = values[['mortalityRate']],
    mortalityRateSlider = reactive( input$mortalityRateSlider ),
    mortalityRateNumeric = reactive( input$mortalityRateNumeric )
  )
  values[['mortalityRate']] <- reactive( mortalityRateValue() )
  output$mortalityRate <- renderUI(numericSliderUI('mortalityRate', value = values[['mortalityRate']]))
}


shinyApp(ui = ui, server = server)    

Я знаю, что, должно быть, я что-то не так делаю с реактивными значениями и тем, как я использую операторы наблюдения внутри модуля, но это моя лучшая попытка использования структуры модуля, поэтому любая помощь поможет выяснить, что я делать неправильно было бы очень полезно.

Answer 1

Вот рабочий код. Существует множество изменений, поэтому я направлю вас на эту страницу Github , которая также устанавливает структуру для использования renderUI с модулями. В общем, я думаю, что проблемы в вашем коде связаны с попыткой определить реактивные значения внутри функции callModule и передачей значений ползунков и числовых полей вперед и назад.

Другие особенности использования модулей заключаются в том, что при фактическом вызове пользовательского интерфейса вам необходимо вызвать модуль пользовательского интерфейса, где, в свою очередь, вы можете вызвать uiOutput. Внутри renderUI находится место, где вы можете настроить входы. Кроме того, внутри модулей вам не нужны пространства имен сеансов, но вам нужно обернуть эти идентификаторы в session$ns(), чтобы они работали между модулями.

Пользовательский интерфейс и серверные модули:

numericSliderUI <- function(id) {
  ns <- NS(id)
  uiOutput(ns('mortalityRate'))
}

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

    values <- reactiveValues(mortalityRate = 1)

    observe({
      values[['mortalityRate']] <- input$Slider
    })

    observe({
      values[['mortalityRate']] <- input$Numeric
    })

    output$mortalityRate <- renderUI(
      tagList(
        sliderInput(inputId = session$ns("Slider"), label = "Enter value:", min = 1, max = 40, value = values[['mortalityRate']]),
        numericInput(inputId = session$ns("Numeric"), label = "Enter value:", min = 1, max = 40, value = values[['mortalityRate']])
      )
    )

    return(list(value = reactive({values[['mortalityRate']]})))
  }

Функции пользовательского интерфейса и сервера:

ui <- fluidPage(
  numericSliderUI('mortalityRate')
)

server <- function(input, output, session) {
  mortalityRateValue <- callModule(numericSlider, 'mortalityRate')
}

shinyApp(ui = ui, server = server)