带有观察值和反应值的闪亮模块

时间:2018-06-27 17:21:03

标签: r module shiny reactive-programming

我一直在尝试使用modules来重构以下简单的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)    

我知道我对reactValues以及在模块内部使用observe语句的方式一定做错了,但这是我使用模块结构的最佳尝试,因此可以帮助我弄清楚我在做什么。做错事会很有帮助。

1 个答案:

答案 0 :(得分:1)

这是工作代码。有各种各样的更改,因此,我将带您到this Github page,它也为将renderUI与模块一起使用建立了结构。通常,我认为您代码中的问题涉及尝试在callModule函数内定义反应性值,以及来回传递滑块和数字框的值。

使用模块的其他功能是,在您实际的UI调用中,您需要调用UI模块,然后可以在其中调用uiOutput。在renderUI内可以设置输入。此外,在模块内部,您不需要会话名称空间,但需要将这些ID封装在session$ns()中,以确保它们在各个模块中都可以使用。

UI和服务器模块:

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和服务器功能:

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

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

shinyApp(ui = ui, server = server)