How to call a shiny module from a shiny module?

放肆的年华 提交于 2021-01-04 06:53:14

问题


How do I call a shiny module from within a shiny module with passing selections from the first module? As an example I wrote a app to show the Star Wars subjects from dplyr in a DT::data table (module StarWars). The related films from the same data set should be shown in another DT::data table in another sub tab (module Films). I pass the table selected subject in a reactive value sw_rows_selected_rct from module StarWars to module Films but browser() statement in module Films is not passed.

# 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)

回答1:


Your code had a few errors. Remember, observe and observeEvents don't have return values. Set the value of your reactives through the nameofReactive(newValue). Your initial goal is possible if you give the reactive to the module, not the current value of the reactive, so that it can change throughout the course of using the app. In the module, you then have to you the value of the reactive, by using () on the reactive. Oh, and your last output had the wrong name (output$Films should be correct). Here is the working app:

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)


来源:https://stackoverflow.com/questions/44925191/how-to-call-a-shiny-module-from-a-shiny-module

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!