Using results/output from one shiny module to updateSelectInput within another

Question

In figuring out how to use the new shiny modules, I would like to emulate the following app. When the rows of the datatable are clicked and unclicked, it updates the entries in the selectInput box, using updateSelectInput.

library(shiny)

## prepare dataframe -----------------------------------------------------------
df <- mtcars
df$model <- rownames(df)
rownames(df) <- NULL
df <- df[1:10, c(12, 1:5)]
car_names <- data.frame(df$model)


## app -------------------------------------------------------------------------
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput('car_input', 'Select car:', df$model, multiple = TRUE)
    ),
    mainPanel(
      DT::dataTableOutput('table')
    )
  )
)

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

  output$table <- DT::renderDataTable(df)
  car_rows_selected <- reactive(car_names[input$table_rows_selected, ])
  observe({ updateSelectInput(session, 'car_input', selected = car_rows_selected()) })

}

shinyApp(ui = ui, server = server)

I have got most of the way there, but am having difficulty with updating the input box. I wonder if it has something to do with the way the namespaces work, and perhaps requires a nested call to the DFTable module within the Car module, but I'm not sure. I am able to add a textOutput element that prints the expected information from the selected table rows. My code for a single file app is below:

library(shiny)

## prepare dataframe -----------------------------------------------------------
df <- mtcars
df$model <- rownames(df)
rownames(df) <- NULL
df <- df[1:10, c(12, 1:5)]
car_names <- data.frame(df$model)


## select module ---------------------------------------------------------------
CarInput <- function(id){
  ns <- NS(id)
  selectInput(ns('car_input'), 'Select car:', df$model, multiple = TRUE)
}

Car <- function(input, output, session, ...) {

# I was thinking perhaps I needed to call the DFTable module as a nested module within this Car module
  car_rows_selected <- callModule(DFTable, 'id_inner')
  observe({ updateSelectInput(session, 'car_input', selected = car_rows_selected()) })

}


## datatable module ------------------------------------------------------------
DFTableOutput <- function(id){
  ns <- NS(id)
  DT::dataTableOutput(ns('table'))
}

DFTable <- function(input, output, session, ...){

  output$table <- DT::renderDataTable(df)
  return(reactive(car_names[input$table_rows_selected, ]))

}


## app -------------------------------------------------------------------------
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      CarInput('id_car'),
      textOutput('selected') # NB. this outputs expected values
    ),
    mainPanel(
      DFTableOutput('id_table')
    )
  )
)

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

  callModule(Car, 'id_car')
  callModule(DFTable, 'id_table')

  output$selected <- callModule(DFTable, 'id_table') # NB this works as expected (see textOutput in ui section above)

  car_rows_selected <- callModule(DFTable, 'id_table')
  observe({ updateSelectInput(session, 'car_input', selected = car_rows_selected()) })

}

shinyApp(ui = ui, server = server)

Any help would be greatly appreciated

Jonny Jonny · Accepted Answer · 2016-04-29T15:34:30

OK, a little more trial and error got me to the right answer - the car_rows_selected item needed to be given the double arrow <<- operator in the app server function in order for it to be useable in the Car module: look for the car_rows_selected <<- callModule(DFTable, 'id_table') in the server function

library(shiny)

## prepare dataframe -----------------------------------------------------------
df <- mtcars
df$model <- rownames(df)
rownames(df) <- NULL
df <- df[1:10, c(12, 1:5)]
car_names <- data.frame(df$model)

## select module ---------------------------------------------------------------
CarInput <- function(id){
  ns <- NS(id)
  selectInput(ns('car_input'), 'Select car:', df$model, multiple = TRUE)
}

Car <- function(input, output, session, ...) {

  observe({ updateSelectInput(session, 'car_input', selected = car_rows_selected()) })

}


## datatable module ------------------------------------------------------------
DFTableOutput <- function(id){
  ns <- NS(id)
  DT::dataTableOutput(ns('table'))
}

DFTable <- function(input, output, session, ...){

  output$table <- DT::renderDataTable(df)
  reactive(car_names[input$table_rows_selected, ])

}


## app -------------------------------------------------------------------------
ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      CarInput('id_car')
    ),
    mainPanel(
      DFTableOutput('id_table')
    )
  )
)

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

  callModule(Car, 'id_car')
  car_rows_selected <<- callModule(DFTable, 'id_table')

}

shinyApp(ui = ui, server = server)

I'm still getting my head around the way module namespaces work - perhaps this isn't the most "correct" approach but at least it works - happy to accept a more appropriate answer if someone posts one later

Using results/output from one shiny module to updateSelectInput within another

1 Answers