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

时间:2017-07-18 13:11:39

标签: r module namespaces shiny

我需要我的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)
    }
  })

}

1 个答案:

答案 0 :(得分: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)