闪亮模块访问命名空间之外的输出

Question

我需要我的 Shiny 模块来隐藏/显示命名空间之外的 div。我尝试将 div id 传递给模块服务器函数并使用shinyjs 来显示/隐藏它，但这不起作用。我没有收到错误，它只是不显示/隐藏 div。

我知道闪亮的模块文档说模块无法访问命名空间之外的输出。不过，文档确实为模块提供了一种使用反应式访问命名空间之外的输入的方法。

有谁知道是否有办法让 Shiny 模块访问命名空间之外的输出？

这是我想做的：

### ui.R ###
header <- dashboardHeader(
  title = a(href = 'http://google.com')
)

dashboardPage(
  skin = 'black',
  header,

  dashboardSidebar(
    sidebarMenu( id='tabs',
             menuItem('Edit Existing Client', tabName = 'client-info')
    )),

  dashboardBody(
    useShinyjs(),
    fluidRow(
      tabItems(
        tabItem(tabName = "client-info",
                div(selectClientModuleUI("clientinfons")),
                div(id='editclientinfo', uiOutput('editclientstuff'))
        )
      )
    )
  )
)

### server.R ###
shinyServer(function(session,input, output) {

  output$editclientstuff <- renderUI({
    div(
      fluidRow(
        column(6,
           textInput('editname', "Display name", value ='Testing name')
        ),
        column(6,
               numericInput('editastart','Start', value ='3') 
        )
      )
    )
  })


  callModule(selectClientModule, 'clientinfons', 'editclientinfo')
  shinyjs::hide(id='editclientstuff')
})

### in global.R ###
selectClientModuleUI <- function(id){
  ns <- NS(id)

  clientlist = c(0, 1, 2)
  names(clientlist) = c('Choose client', 'Fred', 'Kim')

  div( 
    selectInput(ns('selectclient'), 'Select client to edit', choices = clientlist, selected = NULL, multiple = FALSE)
  )
}

selectClientModule <- function(input, output, session, divtoshow = ''){
  observeEvent(input$selectclient, {
    if (!is.null(input$selectclient) && input$selectclient > 0){
      print(paste0("showing ", divtoshow))
      shinyjs::show(divtoshow)
    }
  })

}

Answer 1

这可以通过将值作为无功值（而不是无功值）提供给模块来实现。您可以更改模块中的反应值并将反应从模块返回到应用程序（注意，返回反应本身，而不是其值）。以下应用程序从模块内部切换主应用程序中的“divtoshow”。如果未选择任何内容，则隐藏它，否则显示它（注意，我稍微调整了代码，使其可以作为独立应用程序运行）：

library(shinydashboard)
library(shinyjs)


# Module
selectClientModuleUI <- function(id){
  ns <- NS(id)

  clientlist = c(0, 1, 2)
  names(clientlist) = c('Choose client', 'Fred', 'Kim')

  div( 
    selectInput(ns('selectclient'), 'Select client to edit', choices = clientlist, selected = NULL, multiple = FALSE)
  )
}

selectClientModule <- function(input, output, session, divtoshow){

  observeEvent(input$selectclient, {
    if (input$selectclient > 0){
      print(paste0("showing editclientinfo"))

      divtoshow("editclientinfo") # set the div to show to "editclientinfo", this will be visible outside the module
    }else{
      divtoshow("") # set the div to show to "", if nothing was chosen
    }
  })

    # return the div to show as reactive to the main app
    return(divtoshow)
}


# Main App
ui <- shinyUI(
  dashboardPage(
    skin = 'black',
    dashboardHeader(
      title = a(href = 'http://google.com')
    ),
    dashboardSidebar(
      sidebarMenu( id='tabs',
                   menuItem('Edit Existing Client', tabName = 'client-info')
      )),

    dashboardBody(
      useShinyjs(),
      fluidRow(
        tabItems(
          tabItem(tabName = "client-info",
                  div(selectClientModuleUI("clientinfons")),
                  div(id='editclientinfo', uiOutput('editclientstuff'))
          )
        )
      )
    )
  ))

server <- shinyServer(function(session,input, output) {

  output$editclientstuff <- renderUI({
    div(
      fluidRow(
        column(6,
               textInput('editname', "Display name", value ='Testing name')
        ),
        column(6,
               numericInput('editastart','Start', value ='3') 
        )
      )
    )
  })

    # store the div to show in a reactive
    divtoshow <- reactiveVal('')

    # divtoshow can be changed in side this module, so it's a return value
    divtoshow <- callModule(selectClientModule, 'clientinfons', divtoshow)

    # observe the value of divtoshow and toggle the corresponding div
    observeEvent(divtoshow(), {
      if(divtoshow() == "editclientinfo"){
        shinyjs::show("editclientinfo")
      }else{
        shinyjs::hide("editclientinfo")
      }

    })
})

shinyApp(ui, server)