如何在 Shiny Dashboard 的同一选项卡中显示一个在另一个下方的图表？答案

【问题标题】：How to display graphs one below another in the same tab in Shiny Dashboard?如何在 Shiny Dashboard 的同一选项卡中显示一个在另一个下方的图表？
【发布时间】：2020-02-29 16:01:03
【问题描述】：

在选项卡中的 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()
  }
  })

  }))

  }

当我使用代码时，会生成图表，但它们会相互重叠。但我希望每张图一个接一个地显示。

此外，复选框选项将根据用户在其他一些仪表板页面中的选择而动态变化。

有人可以建议我如何克服这个问题

【问题讨论】：

标签： r checkbox shiny shinydashboard

【解决方案1】：

您需要遍历绘图而不是选项卡：

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)

【讨论】：