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

时间:2017-07-05 11:38:47

标签: r shiny

如何通过从第一个模块传递选择来从闪亮模块中调用闪亮模块? 作为一个例子,我写了一个应用程序,在DT :: data表(模块 StarWars )中显示来自 dplyr 的星球大战主题。来自相同数据集的相关电影应该显示在另一个子选项卡(模块电影)中的另一个DT :: data表中。 我将表格中的选定主题从模块 StarWars 中的无效值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)

1 个答案:

答案 0 :(得分:4)

您的代码有一些错误。请注意,observeobserveEvent没有返回值。通过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)