r - 如何在 Shiny Dashboard 的同一选项卡中显示一个下方的图表?
问题描述
在选项卡中的 Shiny Dashboard 中,我试图根据复选框输入的选择在另一个下方绘制图表。请在下面找到我的 UI 和服务器代码。
d <-
data.frame(
year = c(1995, 1995, 1995, 1996, 1996, 1996, 1997, 1997, 1997),
Product_Name = c(
"Table",
"Chair",
"Bed",
"Table",
"Chair",
"Bed",
"Table",
"Chair",
"Bed"
),
Product_desc = c("X", "X", "X", "Y", "Y", "Y", "Z", "Z", "Z"),
Cost = c(1, 2, 3, 4, 2, 3, 4, 5, 6)
)
ui <- shinyUI(fluidPage(
useShinydashboard(),
tabPanel(
"Plot",
sidebarLayout(
sidebarPanel(
uiOutput('checkbox'),
#width = 2,
position = "bottom"),
mainPanel(uiOutput("graph"))
)
)
))
我的服务器代码是
server <- function(input, output, session) {
output$checkbox <- renderUI({
checkboxGroupInput("year", "year", choices = (unique(d$year)))
})
output$graph <- renderUI({
# create tabPanel with datatable in it
myTabs = lapply(length(input$year), function(i) {
tabPanel("Plots",
fluidRow(plotOutput(paste0("plot", i))))
})
do.call(tabsetPanel, myTabs)
})
observe (lapply(length(input$year), function(i) {
#because expressions are evaluated at app init
#print("I am in Render")
output[[paste0("plot", i)]] <- renderPlot({
#print ("bbb")
if (length(input$year) > 0) {
d %>%
ggplot(aes(Product_Name, Cost)) +
geom_col(aes(fill = Product_desc),
position = position_dodge(preserve = "single")) +
facet_wrap( ~ input$year[i],
scales = "free_x",
strip.position = "bottom") +
theme(strip.placement = "outside") +
theme_bw()
}
})
}))
}
当我使用代码时,会生成图表,但它们会相互重叠。但我希望每张图都一个接一个地显示。
此外,复选框选项将根据用户在其他一些仪表板页面中的选择而动态变化。
有人可以建议我如何克服这个
解决方案
您需要遍历绘图而不是选项卡:
library(shiny)
library(shinydashboard)
library(shinyWidgets)
d <-
data.frame(
year = c(1995, 1995, 1995, 1996, 1996, 1996, 1997, 1997, 1997),
Product_Name = c(
"Table",
"Chair",
"Bed",
"Table",
"Chair",
"Bed",
"Table",
"Chair",
"Bed"
),
Product_desc = c("X", "X", "X", "Y", "Y", "Y", "Z", "Z", "Z"),
Cost = c(1, 2, 3, 4, 2, 3, 4, 5, 6)
)
ui <- shinyUI(fluidPage(
useShinydashboard(),
tabPanel(
"Plot",
sidebarLayout(
sidebarPanel(
uiOutput('checkbox'),
#width = 2,
position = "bottom"),
mainPanel(uiOutput("graph"))
)
)
))
server <- function(input, output, session) {
output$checkbox <- renderUI({
checkboxGroupInput("year", "year", choices = (unique(d$year)))
})
output$graph <- renderUI({
# create tabPanel with datatable in it
req(input$year)
tabPanel("Plots",
fluidRow(lapply(as.list(paste0("plot", seq_along(input$year))), plotOutput)))
})
observe (lapply(length(input$year), function(i) {
#because expressions are evaluated at app init
#print("I am in Render")
output[[paste0("plot", i)]] <- renderPlot({
#print ("bbb")
if (length(input$year) > 0) {
d %>%
ggplot(aes(Product_Name, Cost)) +
geom_col(aes(fill = Product_desc),
position = position_dodge(preserve = "single")) +
facet_wrap( ~ input$year[i],
scales = "free_x",
strip.position = "bottom") +
theme(strip.placement = "outside") +
theme_bw()
}
})
}))
}
shinyApp(ui, server)
推荐阅读
- javascript - 我能够检查隐藏类型变量,但我收到通过 JS 将 HTML 表单的输入类型隐藏变量发送到 PHP 文件的错误
- java - HikariCP 与 JDBC 指标 Spring Boot2
- python - 如何循环遍历每个源文件并将特定列复制到新工作簿中,每个新的“粘贴”转移到相邻列?
- linux - 使用 gstreamer 混合多个 rtp 音频流
- java - 使用 Spans 获取 EditText 的左侧部分文本
- python - x 和 y 不能大于 2-D,但具有 (1,) 和 (1, 224, 224, 3) 形状
- json - 如何从json中获取id?
- clearcase - 无法确定路径名的 VOB
- java - 显然 java 在 Linux 和 Windows 上没有相同的 nashorn.jar
- entity-framework - 具有多个 where 子句的 EFCore 查询,它们一起充当 AND 但不是 OR