為什么閃亮的動態UI 模塊沒有提供所需的輸出？

我試圖模塊化這個堆疊溢位問題中提出的閃亮應用程式閃亮：更好的方法在選項卡面板中回圈創建表格。下面是模塊化的reprex 代碼（與鏈接帖子中的原始代碼不同，但具有相同的結構）。但是，輸出為空。我無法弄清楚這里的問題是什么，我懷疑這可能與id動態 UIrenderUI部分中的output[[id]] = renderDataTable()和DataTableOutput(id)發生有關（通常render*功能出現在服務器中，而出現在*OutputUI 中。）。

我知道當使用閃亮的模塊時，我們必須NS(id, 'name')在 UI 中使用輸出元素。這里似乎我們不能做同樣的事情，即output[[NS(id, 'name')]]在服務器動態 UI 中。我不確定這是否可能是問題所在。

如果有任何建議，我將不勝感激。謝謝。

## library
library(shiny)
library(shinydashboard)
library(datasets)
library(dplyr)
library(DT)

## data
cars <- mtcars
irises <- iris
cars$team <- sample(c("Team1", "Team2"), nrow(cars), replace = TRUE)
irises$team <-
  sample(c("Team1", "Team2"), nrow(irises), replace = TRUE)

## module UI
tab_ui <- function(id) {
  uiOutput(NS(id, "content"))
}

## module Server
tab_server <- function(id, data, Team, var) {
  moduleServer(id, function(input, output, session) {
    table <- reactive({
      data %>% filter(team == Team)
    })

    output$content <- renderUI({
      lapply(sort(unique(table()[[var]])), function(i) {
        id <- paste0("content_", i)

        output[[id]] <-
          DT::renderDataTable(datatable(table()[table()[[var]] == i, ]))

        fluidRow(
          box(
            width = "100%",
            title = paste0(var, " ", i),
            status = "info",
            solidHeader = TRUE,
            collapsible = TRUE,
            DT::dataTableOutput(id)
          )
        )
      })
    })
  })
}

## UI
ui <- dashboardPage(
  dashboardHeader(title = "Teams"),
  dashboardSidebar(sidebarMenu(
    menuItem("Team 1",
      tabName = "tab_team1"
    ),
    menuItem("Team 2",
      tabName = "tab_team2"
    )
  )),
  dashboardBody(tabItems(
    tabItem(
      tabName = "tab_team1",
      fluidRow(
        tabBox(
          title = "",
          width = "100%",
          tabPanel(
            title = "A",
            tab_ui("team1_tabA")
          ), # module ui
          tabPanel(
            title = "B",
            tab_ui("team1_tabB")
          ) # module ui
        )
      )
    ),
    tabItem(
      tabName = "tab_team2",
      fluidRow(
        tabBox(
          title = "",
          width = "100%",
          tabPanel(
            title = "A",
            tab_ui("team2_tabA")
          ), # module ui
          tabPanel(
            title = "B",
            tab_ui("team2_tabB")
          ) # module ui
        )
      )
    )
  ))
)

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

  # module server
  tab_server("team1_tabA", data = cars, Team = "Team1", var = "gear")
  tab_server("team1_tabB", data = irises, Team = "Team1", var = "Species")
  tab_server("team2_tabA", data = cars, Team = "Team2", var = "gear")
  tab_server("team2_tabB", data = irises, Team = "Team2", var = "Species")
}

shinyApp(ui, server)

uj5u.com熱心網友回復：

嘗試這個

team_ui <- function(id) {
  ns <- NS(id)
  fluidRow(
    column(12,
           shinydashboard::box(width=12,
             title = "My Table",
              uiOutput(ns("Team_content"))
           )
    )
  )
}

team_server <- function(id,df,t,var) {
  moduleServer(
    id,
    function(input, output, session) {
      ns <- session$ns
      table <- df %>% dplyr::filter(team == as.character(t))
      
      output$Team_content <- renderUI({
        lapply(sort(unique(table[[as.character(var)]])), function(i) {
          idd <- paste0(t, "_content_A_", i)
          
          output[[idd]] <- DT::renderDataTable(datatable(table[table[[as.character(var)]] == i, ]))
          
          fluidRow(
            box(
              width = "100%",
              title = paste0(as.character(var),": ", i),
              status = "info",
              solidHeader = TRUE,
              collapsible = TRUE,
              DT::dataTableOutput(ns(idd))
            )
          )
        })
      })
      
    })
}
    

cars <- mtcars
irises <- iris
cars$team <- sample(c("Team1", "Team2"), nrow(cars), replace = TRUE)
irises$team <-
  sample(c("Team1", "Team2"), nrow(irises), replace = TRUE)

# UI
ui <- dashboardPage(
  dashboardHeader(title = "Teams"),
  dashboardSidebar(sidebarMenu(
    menuItem("Team 1",
             tabName = "tab_team1",
             icon = icon("dashboard")),
    menuItem("Team 2",
             tabName = "tab_team2",
             icon = icon("dashboard"))
  )),
  dashboardBody(tabItems(
    tabItem(tabName = "tab_team1",
            fluidRow(
              tabBox(
                title = "",
                width = "100%",
                tabPanel(title = "A", team_ui("Team1_content_A")),
                tabPanel(title = "B", team_ui("Team1_content_B"))
              )
            )) ,
    tabItem(tabName = "tab_team2",
            fluidRow(
              tabBox(
                title = "",
                width = "100%",
                tabPanel(title = "A", team_ui("Team2_content_A")),
                tabPanel(title = "B", team_ui("Team2_content_B"))
              )
            ))
  ))
)



server <- function(input, output, session) {
 
  team_server("Team1_content_A",cars,"Team1",'gear')
  team_server("Team1_content_B",irises,"Team1",'Species')
  team_server("Team2_content_A",cars,"Team2",'gear')
  team_server("Team2_content_B",irises,"Team2",'Species')
  
}
shinyApp(ui, server)

標籤：r 用户界面 闪亮的 模块

上一篇：使用另一個包含鍵對的資料框更改資料框列中的值

下一篇：R：“ifelseif”與“or”三種情況