闪亮模块通讯

时间:2021-06-11 16:48:07

标签: r shiny shinymodules

我正在尝试根据用户输入创建动态 UI。首先,我在 Mod2.R 中使用 lapply 将 Mod1 的值返回到 Mod2 并将其保存在 reactiveVal 对象中,该对象位于 mod2.R 中并保存为 binner_step_data .然后,主应用程序还会对 Mod2.R(取决于 Mod1.R)的返回值执行 lapply 并将其保存在 reactiveVal 对象中,该对象保存为 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() })})
    )
  )
  
}

这是我的前两个模块,其中 Mod2.R 使用的是 Mod1.R 的返回值。现在这是使用 Mod2.R 返回值的主 app.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)

最后,我使用 renderPrint 来确认我需要的值正在传递到主服务器,但显然它们没有。我应该返回一个包含两个的列表,第一个元素是 Bin 名称,第二个元素是 Bin 标准(步骤名称 + 阈值)。处理来自两个模块的返回值以取回我需要的数据的最佳方法是什么?谢谢。

enter image description here

1 个答案:

答案 0 :(得分:0)

要将值移出服务器模块,您希望单个元素是反应式的,而不是整个列表。 BinnerStep.R 末尾的这个结构应该提供从服务器模块返回的反应元素列表。

old declaration ‘void f(int)’