如何在 Shiny 儀表板的同一選項卡中顯示一個下一個圖形？

Question

在選項卡中的 Shiny 儀表板中，我正在嘗試 plot 根據復選框輸入的選擇，一個下一個圖表。 請在下面找到我的 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()
  }
  })

  }))

  }

當我使用代碼時，會生成圖表，但它們會相互重疊。 但我希望每張圖都一個接一個地顯示。

此外，復選框選項將根據用戶在其他一些儀表板頁面中的選擇而動態變化。

有人可以建議我如何克服這個

Answer 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)