Question

在弄清楚如何使用新的闪亮模块时，我想模仿以下应用程序。单击并取消选中数据表的行时，将使用selectInput更新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)

我已经完成了大部分工作，但是在更新输入框时遇到了困难。我想知道它是否与命名空间的工作方式有关，并且可能需要对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项需要在app服务器功能中获得双箭头<<-运算符才能使用它在Car模块中：在服务器函数中查找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)

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

使用一个闪亮模块的结果/输出来更新另一个闪亮的模块

1 个答案: