Diego
Diego

Reputation: 422

Shiny Module Communication

I am trying to create a dynamic UI based on user inputs. First, I am using an lapply inside Mod2.R to return the values of Mod1 onto Mod2 and save it in a reactiveVal object, which lives inside mod2.R and is saved as binner_step_data. The main app then also does an lapply on the return value of Mod2.R (which depends on Mod1.R) and saves it in a reactiveVal object, which is saved as binner_data.

Mod1.R

   mod1_UI <- function(id) {
  ns <- NS(id)
  tagList(
    fluidRow(
      column(
        width = 6,
        selectInput(ns("sel_step_name"), "Step Name", choices = c("step1", "step2"))
      )  # Column
      ,
      column(
        width = 3,
        numericInput(ns("num_threshold"), "Threshold", value = 0)
      )  # Column
    ) # Row
  ) # tag list
}

mod1_Server <- function(input, output, session) {
  return(
    list(
      step_name = reactive({input$sel_step_name}),
      threshold = reactive({input$num_threshold})
    )
  )
}

Mod2.R

mod2_UI <- function(id) {
  ns <- NS(id)
  tagList(
    fluidRow(
      column(
        width = 12,
        selectInput(ns("sel_n_steps"), "Number of Steps", selected = NULL, choices = 1:3),
        uiOutput(ns("ui_mod1_steps"))
      )
    ),
    fluidRow(
      column(
        width = 12,
        textInput(ns("txt_bin_name"), "Bin Name", placeholder = "Name of Bin e.g., Blocker", value = "**")
      )  # Column
    )  # Fluid Row
  ) # tag list  
}

mod2_Server <- function(input, output, session) {
  ns <- session$ns
  
  binner_step_data <- reactiveVal()
  
  observeEvent(input$sel_n_steps{
    req(input$sel_n_steps)
    
    lapply(
      1:input$sel_n_steps,
      function(i) {
        res <- callModule(mod1_Server, paste0("binner_step", i), binner_number = reactive(i), dat = reactive(dat()))
        return(res)
      }
    ) %>% binner_step_data(.)
  })
  
  output$ui_mod1_steps <- renderUI({
    
    req(input$sel_n_steps)
    
    tagList(
      fluidRow(
        column(
          width = 12,
          lapply(
            1:as.numeric(input$sel_n_steps),
            function(i) {
              mod1_UI(ns(paste0("binner_step_", i)))
            }
          )  # lapply
        )  # Column
      )  # Fluid Row
    )  # Tag List
    
  })
  
  return(
    list(
      bin_name = reactive({input$txt_bin_name}),
      bin_criteria = reactive({lapply(binner_step_data(), function(step_data) { step_data() })})
    )
  )
  
}

Here are my first two modules, in which Mod2.R is using the return values of Mod1.R. Now here's the main app.R file that is using the return value of Mod2.R.

app.R

library(shiny)
library(tidyverse)

# Modules
source("Mod1.R")
source("Mod2.R")

ui <- fluidPage(
  fluidRow(
    column(
      width = 12,
      numericInput("num_bins", "Number of Bins", value = NULL, min = 1, max = 10)
    )  # Column
  )  # Fluid Row
  ,
  fluidRow(
    column(
      width = 12,
      uiOutput("ui_binners")
    )  # Column
  ),  # FLuid Row
  fluidRow(
    column(
      width = 12,
      verbatimTextOutput("reactive_output_from_mod2")
    )
  )
)

server <- function(input, output, session) {
  
  binner_data <- reactiveVal()
  
  # Modules -----------------------------------------------------------------
  
  observeEvent(input$num_bins, {
    req(input$num_bins)
    
    lapply(
      1:input$num_bins,
      function(i) {
        res <- callModule(mod2_Server, paste0("binner_", i))
        return(res)
      }
    ) %>% binner_data(.)
  })
  
  output$ui_binners <- renderUI({
    
    req(input$num_bins)
    
    tagList(
      fluidRow(
        column(
          width = 12,
          lapply(
            1:input$num_bins,
            function(i) {
              mod2_UI(paste0("binner_", i))
            }
          )  # lapply
        )  # Column
      )  # Fluid Row
    )  # Tag List
    
  })
  
  output$reactive_output_from_mod2 <- renderPrint({
    # req(input$sel_n_steps)
    binner_data()
  })
}

shinyApp(ui, server)

At the end, I'm using a renderPrint to confirm that the values I need are getting passed to the main server but apparently they are not. I should get back a list of two, with the first element being the Bin name and the second element being the Bin Criteria (Step Name + Threshold Value). What is the best way to handle the return values from the two modules to get back the data that I need? Thanks.

enter image description here

Upvotes: 0

Views: 243

Answers (1)

phalteman
phalteman

Reputation: 3532

To move values out of the server modules, you want the individual elements to be reactive, not the entire list. This structure at the end of BinnerStep.R should provide a list of reactive elements returned from the server module.

return(list(
  step_name = reactive({input$sel_step_name}),
  threshold = reactive({input$num_threshold}),
  rank_direction = reactive({input$sel_rank_direction})
))

Upvotes: 0

Related Questions