r - 如何从 Shiny 的模块调用 Shiny 的模块？

Question

如何从第一个模块中传递选择的 Shiny 模块中调用 Shiny 模块？
例如，我编写了一个应用程序来显示来自 的星球大战主题。 dplyr 在 DT::data 表中(模块 StarWars )。来自同一数据集的相关电影应显示在另一个子选项卡(模块电影)中的另一个 DT::data 表中。
我通过来自模块 的 react 值 sw_rows_selected_rct 中的表选择主题星球大战 到模块 电影 但是模块中的 browser() 语句 电影 没有通过。

# Test call of modules inside modules

library(tidyverse)

#' Shiny StarWars module
#'
ui_Films <-
  function(id,
           title = id,
           ...,
           value = title,
           icon = NULL) {
    ns <- shiny::NS(id)
    tab <- tabPanel(title,
                    h4("StarWars Films"),
                    DT::dataTableOutput(outputId = ns("Films")))
  }

ui_StarWars <-
  function(id,
           title = id,
           ...,
           value = title,
           icon = NULL) {
    ns <- shiny::NS(id)
    tab <- tabPanel(title,
                    DT::dataTableOutput(outputId = ns("StarWars")),
                    tabsetPanel(ui_Films(
                      id = ns("Films"), title = "...by Films"
                    )))
  }


ui <- shinyUI(navbarPage(
  "Call Modules in Modules test",
  ui_StarWars("StarWars", title = "StarWars")
))

Films <-
  function(input,
           output,
           session,
           sw_data,
           sw_selection) {
    ns <- session$ns
    sw_films_rct <- observe({
      req(sw_data, is.data.frame(sw_selection))
      browser() # not reached!!!
      sw_films_rct <-
        sw_data %>% {
          if (is_null(sw_selection))
            .
          else
            filter(., name == sw_selection$name)
        }
    })

    output$StarWarsFilms <- DT::renderDataTable({
      req(is.data.frame(sw_films_rct))
      DT::datatable(sw_films_rct,
                    selection = 'single',
                    options = list(pageLength = 5))
    })
  }

StarWars <-
  function(input, output, session, sw_data) {
    sw_rows_selected_rct = reactiveVal()
    ns <- session$ns

    sw_rows_selected_rct = observeEvent(input$StarWars_rows_selected, {
      req(sw_data, input$StarWars_rows_selected != 0)
      browser()
      sw_data[input$StarWars_rows_selected, ]
    })

    md_films <- callModule(
      module = Films,
      id = "Films",
      sw_data = sw_data,
      sw_selection = sw_rows_selected_rct
    )
    output$StarWars <- DT::renderDataTable({
      req(is.data.frame(sw_data))
      DT::datatable(sw_data,
                    selection = 'single',
                    options = list(pageLength = 5))
    })
  }

server <- shinyServer(function(input, output, session) {
  sw_data_rct = reactive({
    dplyr::starwars %>% mutate(films = NULL,
                               vehicles = NULL,
                               starships = NULL)
  })
  md_StarWars = callModule(module = StarWars,
                           id = "StarWars",
                           sw_data = sw_data_rct())
})

# Run the application
shinyApp(ui = ui, server = server)

Answer 1

您的代码有一些错误。记住，observe和 observeEvent s 没有返回值。通过 nameofReactive(newValue) 设置您的 react 值.如果您将响应式(Reactive)提供给模块，而不是响应式(Reactive)的当前值，那么您的初始目标是可能的，这样它就可以在使用应用程序的整个过程中发生变化。在模块中，您必须使用 () 获得 react 性的值。在 react 性上。哦，您最后的输出名称错误( output$Films 应该是正确的)。这是工作应用程序:

library(tidyverse)

#' Shiny StarWars module 
#'
ui_Films <-
  function(id, title = id, ..., value = title, icon = NULL) {
    ns <- shiny::NS(id)
    tab <- tabPanel(title,
                    h4("StarWars Films"),
                    DT::dataTableOutput(outputId = ns("Films"))
    )
  }

ui_StarWars <-
  function(id, title = id, ..., value = title, icon = NULL) {
    ns <- shiny::NS(id)
    tab <- tabPanel(title,
                    DT::dataTableOutput(outputId = ns("StarWars")),
                    tabsetPanel(
                      ui_Films(id = ns("Films"), title = "...by Films"))
    )
  }


ui <- shinyUI(
  navbarPage(
    "Call Modules in Modules test",
    ui_StarWars("StarWars", title = "StarWars")
  )
)

Films <-
  function(input, output, session, sw_data, sw_selection) {
    ns <- session$ns
    sw_films_rct <- reactiveVal()
    observe({
      sw_films_rct(sw_data() %>% {if(is_null(sw_selection())) . else filter(., name == sw_selection()$name)})
    })

    output$Films <- DT::renderDataTable({
      req(is.data.frame(sw_films_rct()))
      DT::datatable(sw_films_rct(),
                    selection = 'single',
                    options = list(pageLength = 5))
    })
  }

StarWars <-
  function(input, output, session, sw_data) {
    sw_rows_selected_rct= reactiveVal()
    ns <- session$ns

     observeEvent(input$StarWars_rows_selected, {
      req(sw_data(), input$StarWars_rows_selected != 0)

       sw_rows_selected_rct(sw_data()[input$StarWars_rows_selected,])
    })

    md_films <- callModule(module = Films, id = "Films", 
                           sw_data= sw_data, 
                           sw_selection= sw_rows_selected_rct)
    output$StarWars <- DT::renderDataTable({
      req(is.data.frame(sw_data()))
      DT::datatable(sw_data(),
                    selection = 'single',
                    options = list(pageLength = 5))
    })
  }

server <- shinyServer(function(input, output, session) {
  sw_data_rct= reactive({dplyr::starwars %>% mutate(films = NULL, vehicles = NULL, starships = NULL)})
  md_StarWars= callModule(module = StarWars, id = "StarWars", sw_data = sw_data_rct)
})

# Run the application
shinyApp(ui = ui, server = server)