[英]Dynamically Create box() within tabItem()
我正在使用shinydashboard
構建一個shiny
應用程序。 其目的是在每個tabItem()
(即儀表板的每個頁面)內顯示一組“卡片”(技術上是box()
元素)。 該應用程序由 external.csv 文件(在此表示中為 object dat
)驅動,該文件 (1) 定義應用程序內的頁面,(2) 指定每個頁面內box()
元素的數量。
我已經能夠使用dat
中的類別成功創建一組tabItem
(即頁面)。 從這里開始,我無法弄清楚如何為每個tabItem
動態添加正確數量的框。 如果您檢查dat
,您將看到有兩個類別(頁面):藍色和綠色。 藍色類別需要我渲染兩個框(框 A 和框 B),而綠色類別需要我渲染框 C - E。因此,名為“藍色”的頁面應該呈現兩個框,而名為“綠色”的頁面應該渲染三個盒子。
有人可以幫助我使用以下代碼,以便為正確的頁面呈現正確的框嗎? 如果 box_name 和 box_desc 可以分別作為box()
的標題和內容出現,則更加感謝!
library(shiny)
library(shinydashboard)
dat<-tibble::tibble(category = c("blue", "blue", "green", "green", "green"),
box_name = c("Box A", "Box B", "Box C", "Box D", "Box E"),
box_desc = c("Foo", "Bar", "Bar", "Foo", "Foo"))
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Blue", tabName = "blue", icon = icon("dashboard")),
menuItem("Green", icon = icon("th"), tabName = "green")
)
)
body <- dashboardBody(
uiOutput("render_reports")
)
header<-dashboardHeader()
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
output$render_reports <- renderUI({
pages <- lapply(unique(dat$category), function(name){
tabItem(tabName = name, fluidRow(box(
title = name, paste0("Something here about ", name), width = 12, solidHeader = TRUE, status = "primary"
)),
fluidRow(
box(title = "box_title here", "box_desc here")
))
})
items <- c(pages)
do.call(tabItems, items)
})
}
shinyApp(ui, server)
需要renderUI
嗎?
沒有renderUI
它可以正常工作(並且速度更快):
library(shiny)
library(shinydashboard)
dat <- tibble::tibble(
category = c("blue", "blue", "green", "green", "green"),
box_name = c("Box A", "Box B", "Box C", "Box D", "Box E"),
box_desc = c("Foo", "Bar", "Bar", "Foo", "Foo")
)
sidebar <- dashboardSidebar(sidebarMenu(
menuItem("Blue", tabName = "blue", icon = icon("dashboard")),
menuItem("Green", tabName = "green", icon = icon("th"))
))
body <- dashboardBody({
items <- lapply(unique(dat$category), function(name) {
tabItem(tabName = name, fluidRow(
lapply(which(dat$category %in% name), function(i) {
box(
dat$box_desc[i],
title = dat$box_name[i],
paste0("Something here about ", name),
width = 12,
solidHeader = TRUE,
status = "primary"
)
}))
)})
do.call(tabItems, items)
})
header <- dashboardHeader()
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {}
shinyApp(ui, server)
使用renderUI
僅在切換選項卡后才會呈現項目 - 因為在首次呈現 dashboardBody 時框不存在:
library(shiny)
library(shinydashboard)
dat <- tibble::tibble(
category = c("blue", "blue", "green", "green", "green"),
box_name = c("Box A", "Box B", "Box C", "Box D", "Box E"),
box_desc = c("Foo", "Bar", "Bar", "Foo", "Foo")
)
sidebar <- dashboardSidebar(sidebarMenu(
menuItem("Blue", tabName = "blue", icon = icon("dashboard")),
menuItem("Green", tabName = "green", icon = icon("th"))
))
body <- dashboardBody(uiOutput("renderReports"))
header <- dashboardHeader()
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
output$renderReports <- renderUI({
items <- lapply(unique(dat$category), function(name) {
tabItem(tabName = name, fluidRow(
lapply(which(dat$category %in% name), function(i) {
box(
dat$box_desc[i],
title = dat$box_name[i],
paste0("Something here about ", name),
width = 12,
solidHeader = TRUE,
status = "primary"
)
}))
)})
do.call(tabItems, items)
})
}
shinyApp(ui, server)
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.