R 使用一个模块的结果/输出在另一个模块中更新SelectInput

在了解如何使用新的闪亮模块时，我想模拟以下应用程序。单击并取消选中数据表的行时，它会使用

updateSelectInput

更新

selectInput

框中的条目

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)

库（闪亮）
##准备数据帧-----------------------------------------------------------
df好的，再经过一点尝试和错误，我得到了正确的答案-所选的
car\u rows\u项目需要给出双箭头

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)

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)