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

Question

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

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

有谁知道 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)