在模块化 R Shiny App 中调用 updateTabItem 后的 updatePickerInput

Question

目标：

我想 select DT Table 中的一行，切换选项卡，并将 pickerInput 值更新为 table 行中的值。

问题：

我可以很好地切换标签页（感谢另一个 post 关于使用父会话的建议）；但是，我似乎无法弄清楚如何让 updatePickerInput 正常工作。我认为 session 和 inputId 参数存在问题。 updatePickerInput 的会话不是父会话，而是更像是来自 updateTabItem 调用的“子”会话，这是有道理的。

代表：

下面是单个文件 app.r 脚本，其中包含两个面板的模块作为全局函数。

sessionInfo():

R 版本 4.0.3 (2020-10-10)

平台：x86_64-apple-darwin17.0（64 位）

运行下：macOS Big Sur 10.16

# Dependencies ----
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)
library(DT)

# Picker Module ----
# Picker UI
picker_ui <- function(id){
    box(width = 12
        , uiOutput(NS(id, "picker"))
    )
}
# Picker Server
picker_server <- function(id){
    moduleServer(id, function(input, output, session){
        # render pickerInput
        output$picker <- renderUI({
            ls_choices <- c("One", "Two", "Three")
            pickerInput(NS(id, "pickerInput")
                        , choices = ls_choices
                        , selected = NULL)
        })
    })
}

# Table Module ----
# Table UI
table_ui <- function(id){
    fluidPage(
        box(width  = 12
            , DTOutput(NS(id, "table"))
        )
    )
}
# Table Server
table_server <- function(id, parent){
    moduleServer(id, function(input, output, session){
        output$table <- renderDT({
            data <- c("One", "Two", "Three")
            df <- tibble("Labels" = data)
            datatable(df, rownames = F, selection = "single", options = list(dom = 'tip'))
        })
        observeEvent(input$table_cell_clicked, {
            req(input$table_cell_clicked$value)
            updateTabItems(session = parent, inputId = "tabs", selected = "picker")
            ################
            #### ISSUE #####
            ################
            updatePickerInput(session = session, inputId = "pickerInput", selected =  input$table_cell_clicked$value)
        })
    }) 
}

# Shiny App----
# UI
ui <- dashboardPage(
    dashboardHeader(title = "Demo")
    , dashboardSidebar(
        sidebarMenu(
            id = "tabs"
            , menuItem("Table", tabName = "table")
            , menuItem("Picker Input", tabName = "picker")
        )
    )
    , dashboardBody(
        tabItems(
            tabItem(tabName = "table"
                    , table_ui("table")
            )
            , tabItem(tabName = "picker"
                      , picker_ui("picker")
            )
        )
    )
)

# Server
server <- function(input, output, session) {
    table_server("table", session)
    picker_server("picker")
}

# Run App ----
shinyApp(ui, server)

Answer 1

您正在尝试使用 table 模块会话来更新选择器（实际上是在选择器模块会话中）

Return 来自选择器模块服务器的选择器模块会话：

# Picker Server
picker_server <- function(id){
  moduleServer(id, function(input, output, session){
    # render pickerInput
    output$picker <- renderUI({
      ls_choices <- c("One", "Two", "Three")
      pickerInput(NS(id, "pickerInput")
                  , choices = ls_choices
                  , selected = NULL)
    })
    return(session)
  })
}

在应用服务器中获取并传递给table模块：

# Server
server <- function(input, output, session) {
  picker_session = picker_server("picker")
  table_server("table", session, picker_session)
}

在table模块中使用它来更新选择器

# Table Server
table_server <- function(id, parent, picker_session){
  moduleServer(id, function(input, output, session){
    output$table <- renderDT({
      data <- c("One", "Two", "Three")
      df <- tibble("Labels" = data)
      datatable(df, rownames = F, selection = "single", options = list(dom = 'tip'))
    })
    observeEvent(input$table_cell_clicked, {
      req(input$table_cell_clicked$value)
      updateTabItems(session = parent, inputId = "tabs", selected = "picker")
      ################
      #### ISSUE #####
      ################
      updatePickerInput(session = picker_session, inputId = "pickerInput", selected =  input$table_cell_clicked$value)
    })
  }) 
}

在模块化 R Shiny App 中调用 updateTabItem 后的 updatePickerInput

updatePickerInput after updateTabItem call in modularized R Shiny App

r

shiny

shinydashboard

shinymodules

shinywidgets