Как отображать графики один под другим на одной вкладке в Shiny Dashboard? - PullRequest
Новая
       16

Как отображать графики один под другим на одной вкладке в Shiny Dashboard?

0 голосов
/ 04 ноября 2019

В Shiny Dashboard на вкладке я пытаюсь построить графики один под другим, основываясь на выборе входов для флажков. Пожалуйста, найдите мой пользовательский интерфейс и код сервера ниже. 

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()
  }
  })

  }))

  }

Когда я использую код, график генерируется, но они перекрываются надруг с другом. Но я хочу, чтобы каждый график отображался один за другим.

Кроме того, параметры флажков будут динамически меняться в зависимости от выбора пользователя на некоторых других страницах панели мониторинга.

Может кто-нибудь подсказать, как мнепреодолеть это

Заранее спасибо.

Дэвид

1 Ответ

1 голос
/ 05 ноября 2019

Вам нужно будет перебирать графики, а не вкладки: 

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