rshinyshiny-reactivityshinymodules

How to pass and receive variables to a module function, then act on it?


I would like to pass a variable (or tibble/data.frame) to a module function, then receive a variable (or tibble/data.frame) from the module. Then act on the returned variable. So that each time I call the moduleServer with a unique namespace I can pass unique variable and get same the ui/module with different content, then act differently. As appose to using a global reactive variable.

The following code pattern/code block works in some situations (which I would like to keep if i can):

but its seems very inefficient in how the reactivity managed in the upper module server. It needs to nest the reactivity before passing it to the lower module.

library(shiny)
library(tidyverse)

lower_UI <- function(id) {
  tagList(
    uiOutput(NS(id, "text3")),
    textOutput(NS(id,"verbose3")),
    actionButton(NS(id,"goButton"), label = "beep me", class = "btn-success")
  )
}

lower <- function(id, pass) {
  moduleServer(id, function(input, output, session) {

    lowerV = reactiveValues(returnV = NULL, inV = pass)


    output$text3 <- renderUI(textInput(session$ns("text3"), "test-lower", "test"))
    output$verbose3 <- renderText(paste0(input$text3, " ", lowerV$inV))

    observe({
      lowerV$returnV = paste0("beeped: ", input$text3, " ", lowerV$inV)
    }) %>% bindEvent(input$goButton)



    return(reactive(lowerV$returnV))
})
}

upper_UI <- function(id) {
  tagList(
    uiOutput(NS(id, "text_in")),
    lower_UI(NS(id, "test"))
  )

}

upper <- function(id) {
  moduleServer(id, function(input, output, session) {

    upperV <- reactiveValues(one = NULL, react = NULL)

    static = "static"

    output$text_in <- renderUI(textInput(NS(id, "upper_text"), "test-upper", "reactive"))

    observe({
      upperV$react <- input$upper_text
    }) %>% bindEvent(input$upper_text)

    # pick static or reactive
    upperV$one <- reactive(lower("test", pass = upperV$react))
    #upperV$one <- reactive(lower("test", pass = static))

    observeEvent(upperV$one()(), {
      if(!is.null(upperV$one()())){
        print(upperV$one()())
      }
    })
  })
}

ui <- fluidPage(
  upper_UI("upper")
)

server <- function(input, output, session) {
  upper("upper")
}

shinyApp(ui, server)

the bug: I updated observe to observeEvent(upperV$one()(),, since it should only triggers when the module return value is updated from the button click.

This works for the first button click. However, after that I am getting odd behaviour where input data from upper-test streams to print & lower-test would update print after button click. Instead of only updating print after button click. This does not seem to happen when I am passing a tibble.

side question: is there a better method? Have I missed something obvious? can it be made more efficient?

Why do I have an issue with the efficiency? > I am not sure is it suppose to work this way. It seems overly complex for basic function behaviour. Based on other posts It seems like should be able to pass them as reactive objects.


Solution

  • Ok, after much playing around, the fix is uprising easy.

    The issue was that every time the text is updated and passed to the module, the module initialised and I forgot to prevent the button from triggering.

    The fix:

     bindEvent(input$goButton, ignoreInit = TRUE)
    

    Full code with some other testing enhancements:

    library(shiny)
    library(tidyverse)
    
    lower_UI <- function(id) {
      tagList(
        uiOutput(NS(id, "text3")),
        textOutput(NS(id,"verbose3")),
        actionButton(NS(id,"goButton"), label = "beep me", class = "btn-success")
      )
    }
    
    lower <- function(id, pass) {
      moduleServer(id, function(input, output, session) {
        
        lowerV = reactiveValues(returnV = NULL, inV = pass)
        
        output$text3 <- renderUI(textInput(session$ns("text3"), "test-lower", "test"))
        output$verbose3 <- renderText(paste0(input$text3, " ", lowerV$inV))
        
        observe({
          lowerV$returnV = paste0("beeped: ", input$text3, " ", lowerV$inV)
          # change ingoreInit to False to return a stream from the upper module
        }) %>% bindEvent(input$goButton, ignoreInit = TRUE)
        
        
        
        return(reactive(lowerV$returnV))
      })
    }
    
    upper_UI <- function(id) {
      tagList(
        uiOutput(NS(id, "text_in"))
        #pass events
        #,actionButton(NS(id,"firstGoButton"), label = "beep me 2", class = "btn-success")
        ,lower_UI(NS(id, "test"))
      )
      
    }
    
    upper <- function(id) {
      moduleServer(id, function(input, output, session) {
        
        upperV <- reactiveValues(one = NULL, react = NULL)
        
        static = "static"
        
        output$text_in <- renderUI(textInput(NS(id, "upper_text"), "test-upper", "reactive"))
        
        # stream information in
        observe({
          upperV$react <- input$upper_text
        }) %>% bindEvent(input$upper_text)
        
        #event based information
        #observe({
        #  upperV$react <- input$upper_text
        #  print(id)
        #}) %>% bindEvent(input$firstGoButton)
        
        
        # pick static or reactive
        upperV$one <- reactive(lower("test", pass = upperV$react))
        #upperV$one <- reactive(lower("test", pass = static))
        
        observeEvent(upperV$one()(), {
          if(!is.null(upperV$one)){
            print(upperV$one()())
          }
        })
      })
    }
    
    ui <- fluidPage(
      upper_UI("upper")
    )
    
    server <- function(input, output, session) {
      upper("upper")
    }
    
    shinyApp(ui, server)