CODEWITHSUNDEEP
rmoduleshinyreactive-programming
ctesta01
ctesta01

Reputation: 959

Shiny Modules with Observes and reactiveValues

I have been trying to reconstruct the following simplistic Shiny app using modules since I believe that will be the best way to organize this code inside a much larger application where I will use these kinds of linked-slider-numeric inputs in many places.

However, I cannot figure out how to achieve the same kind of functionality from within a module.

Here's an example app that works exactly as intended, but not using modules:

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)

Here's my attempt. (Note that "mortalityRate" and associated strings are just an example of the variable name(s) I'll be using later). I have tried several variations on this attempt, but inevitably I get errors, usually indicating I'm doing something that can only be done inside a reactive context:

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)

I know that I must be doing something wrong with the reactiveValues and the way I'm using the observe statements inside the module, but this is my best attempt at using the module structure, so any help figuring out what I'm doing wrong would be very helpful.

Upvotes: 3

Views: 2491

Answers (1)

phalteman
phalteman

Reputation: 3542

Here is working code. There are a variety of changes, so I'll direct you to this Github page that also sets up a structure for using renderUI with modules. In general, I think the problems in your code involved trying to define reactive values inside the callModule function, and in passing the values of the sliders and numeric box back and forth.

Other features of using modules are that in your actual UI call, you need to call the UI module, where in turn you can call uiOutput. Inside renderUI is where you can set up the inputs. Additionally, inside modules you don't need the session namespaces, but you do need to wrap those ids in session$ns() to ensure they work across modules.

UI and Server Modules:

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 and Server functions:

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

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

shinyApp(ui = ui, server = server)

Upvotes: 4

Related Questions