使用来自一个闪亮模块的结果/输出来更新另一个模块中的选择输入

Question

在弄清楚如何使用新的闪亮模块时，我想模拟以下应用程序。当单击和取消单击数据表的行时，它会使用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)

我已经完成了大部分工作，但是在更新输入框时遇到了困难。我想知道它是否与命名空间的工作方式有关，并且可能需要对 Car 模块中的 DFTable 模块进行嵌套调用，但我不确定。我可以添加一个 textOutput 元素，该元素打印所选表格行中的预期信息。我的单文件应用程序代码如下：

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)

任何帮助将不胜感激

Answer 1

好的，多一点试验和错误让我得到了正确的答案 - 需要在应用服务器功能中为 car_rows_selected 项目提供双箭头 <<- 运算符，以便它可以在 @987654323 中使用@模块：在服务端函数中查找car_rows_selected <<- callModule(DFTable, 'id_table')

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)

我仍然对模块命名空间的工作方式有所了解 - 也许这不是最“正确”的方法，但至少它有效 - 如果有人稍后发布更合适的答案，我很乐意接受