访问Shiny模块中的父名称空间

时间:2018-08-06 13:29:44

标签: r shiny

我正在尝试从子模块内部的父名称空间对updateSelectInput进行选择。据我所知,在模块函数中,我位于名称空间中,因此无法从父名称空间访问和更新selectInput。我该怎么解决?

library(shiny)
library(shinydashboard)

moduleUI <- function(id) {
  ns <- NS(id)
  box(
    title=actionLink(ns("link"),"This is a link"),
    plotOutput(ns("plot"))
  )
}

module <- function(input, output,session,number) {
  output$plot <- renderPlot({
    plot(number)
  })

  observeEvent(input$link,{
    print(paste0("Number is: ",number))
    updateSelectInput(session,"selectInput",selected=number)  #Doesn't work
  })
}

ui <-  
  dashboardPage(
    dashboardHeader(title="Title"),
    dashboardSidebar(
      selectInput("selectInput","Choose one option",choices=seq(1,10),selected=1)
    ),
    dashboardBody(
      moduleUI("5"),
      moduleUI("10")
    )
  )

server <- function(session,input, output) {
  callModule(module=module,id="5",5)
  callModule(module=module,id="10",10)
}

shinyApp(ui = ui, server = server)

2 个答案:

答案 0 :(得分:1)

花了一段时间,但我找到了一种方法来获取子模块以更新超级模块。

Shiny设计为必须通过模块参数或返回值来访问其他模块。我们无法在模块之间传递窗口小部件ID,但可以传递父级的会话信息。

library(shiny)

moduleUI <- function(id) {
  ns <- NS(id)
  uiOutput(ns("my_link"))
}

module <- function(input, output, session, number, parent) {
  output$my_link <- renderUI({ 
    actionLink(session$ns("link"), paste0("This is a link to ", number))
  })

  observeEvent(input$link,{
    updateSelectInput(session = parent,"selectInput",selected = number)  ### use parent session
  })
}

ui <-  fluidPage(
    selectInput("selectInput","Choose one option",choices=seq(1,10),selected=1),
    moduleUI("5"),
    moduleUI("10")
)

server <- function(session,input, output) {
  callModule(module = module, id = "5", 5, parent = session) ### pass session information
  callModule(module = module, id = "10", 10, parent = session) ### pass session information
}

shinyApp(ui = ui, server = server)

特别注意:

  • 当子模块被调用时,我们传递当前会话信息
  • 我们在更新输入选择器时使用父会话

答案 1 :(得分:0)

我认为理想的做法是让子模块观察和更新超级模块。但是,我只能提供符合我上面的评论的解决方案:超级模块中的每个子模块都有一个观察者。如果您有许多子模块,这将很快变得麻烦。

library(shiny)
library(shinydashboard)

moduleUI <- function(id) {
  ns <- NS(id)
  box(
    title=actionLink(ns("link"),"This is a link"),
    plotOutput(ns("plot"))
  )
}

module <- function(input, output,session,number) {
  current = reactiveValues()
  current$return_value = 0

  returnvalue <- reactive(current$return_value)

  output$plot <- renderPlot({
    plot(number)
  })

  observeEvent(input$link,{
    print(paste0("Number is: ",number))
    current$return_value = current$return_value + 1
  })

  return(list(rv = returnvalue, num = number))
}

ui <-  
  dashboardPage(
    dashboardHeader(title="Title"),
    dashboardSidebar(
      selectInput("inputID","Choose one option",choices=seq(1,10),selected=1),
      actionButton("button","Knap")
    ),
    dashboardBody(
      moduleUI("5"),
      moduleUI("10")
    )
  )

server <- function(session,input, output) {
  val1 <- callModule(module=module,id="5",5)
  val2 <- callModule(module=module,id="10",10)

  observeEvent(val1$rv(),{
    updateSelectInput(session,inputId="inputID",selected=val1$num)
  })

  observeEvent(val2$rv(),{
    updateSelectInput(session,inputId="inputID",selected=val2$num)
  })

}

shinyApp(ui = ui, server = server)

Tobias问题的主要变化:

  • 子模块具有不同的名称
  • 每个子模块的单独观察者
  • 子模块包含一个return_value,该链接在每次单击链接时都会更新。这样可以确保超级模块中的观察者可以进行观察更改。
  • 子模块返回具有两个值的列表:如上所述的return_value,以及用于更新UI的值。