如何从闪亮的模块调用闪亮的模块?

Gui*_*ing 2 r shiny

如何从第一个模块中传递选择的闪亮模块中调用闪亮模块?作为一个例子,我编写了一个应用程序来在 DT::data 表(模块StarWars)中显示来自dplyr 的星球大战主题。来自同一数据集的相关电影应显示在另一个子选项卡(模块电影)中的另一个 DT::data 表中。我通过在从模块的反应性值sw_rows_selected_rct表选择的受试者星球大战到模块薄膜,但在模块浏览器()语句薄膜不通过。

# 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)
Run Code Online (Sandbox Code Playgroud)

sho*_*aco 5

您的代码有一些错误。请记住,observeand observeEvents 没有返回值。通过nameofReactive(newValue). 如果您将反应式提供 给模块,而不是反应式的当前,那么您的初始目标是可能的,这样它就可以在使用应用程序的整个过程中发生变化。在模块中,你就必须给你价值的反应,而应使用()上的反应。哦,您最后的输出名称错误(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)
Run Code Online (Sandbox Code Playgroud)