8

I'm trying to updateSelectInput on a selectInput from the parent namespace inside a sub-module. In the module function, I'm inside the namespace as far as I understand, and therefore I can't access and update the selectInput from the parent namespace. How can I solve this?

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)
Tobias D
  • 345
  • 2
  • 12
  • Is there a reason for placing the observer within the module? One alternative would be for the modules to return a value and the server to observe changes in this value. – Simon.S.A. Aug 06 '18 at 22:48
  • I'm not quite sure how I can do that. See above edit. I can't really return the value from the modules and save in the same variable, as done above. – Tobias D Aug 07 '18 at 12:35
  • Your question depends on how to work across name spaces with Shiny modules. This is a much broader question. It would be excellent if you were to edit and rename your question to reflect this - then many others might benefit. – Simon.S.A. Aug 09 '18 at 01:55
  • Have updated the title and question and removed the second example, since it doesn't help much. Thanks. – Tobias D Aug 09 '18 at 07:53

2 Answers2

12

Took me a while, but I found a way to get the sub-module to update the super-module.

Shiny is designed so that access to other modules must be done via module arguments or returned values. We can not pass the widget ID between modules, but we can pass the session information of the parent.

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)

In particular note that:

  • we pass the current session information when the sub-module is called
  • we use the parent session when updating the input selector
Simon.S.A.
  • 6,240
  • 7
  • 22
  • 41
1

I think the ideal would be to get the sub-module to observe and update the super-module. However, I can only offer a solution in line with my comment above: having one observer per sub-module in the super-module. This will rapidly get cumbersome if you have many sub-modules.

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)

Key changes from Tobias's question:

  • sub-modules have different names
  • separate observer for each sub-module
  • sub-module contains a return_value that gets updated every time the link is clicked. This ensures the observer in the super-module has a change to observe.
  • sub-module returns a list with two values: return_value as described above, and the value to update the UI with.
Simon.S.A.
  • 6,240
  • 7
  • 22
  • 41
  • Thanks for the suggestion. I have many sub-modules so it does indeed get quite cumbersome, as you said. – Tobias D Aug 08 '18 at 06:57