Shiny / Shinydashboard: динамическое количество элементов вывода / значенийBoxes - PullRequest
Новая
       7

Shiny / Shinydashboard: динамическое количество элементов вывода / значенийBoxes

0 голосов
/ 30 мая 2018

Я сейчас пытаюсь настроить пользовательский интерфейс, который динамически создает ValueBoxes.

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

На самом деле работает следующее, но поля не отображаются должным образом, см. . 

library(shiny)
library(shinydashboard)

ui <- pageWithSidebar(            
  headerPanel("Dynamic number of valueBoxes"),            
  sidebarPanel(
    selectInput(inputId = "choosevar",
                label = "Choose Cut Variable:",
                choices = c("Nr. of Gears"="gear", "Nr. of Carburators"="carb"))
  ),            
  mainPanel(
    # This is the dynamic UI for the plots
    uiOutput("plots")
  )
)


server <- function(input, output) {
  #dynamically create the right number of htmlOutput
  # renderUI
  output$plots <- renderUI({
    plot_output_list <- lapply(unique(mtcars[,input$choosevar]), function(i) {
      plotname <- paste0("plot", i)
      # valueBoxOutput(plotname)
      htmlOutput(plotname)
    })

    tagList(plot_output_list)
  }) 

  # Call renderPlot for each one. Plots are only actually generated when they
  # are visible on the web page. 

  for (i in 1:max(unique(mtcars[,"gear"]),unique(mtcars[,"carb"]))) {
    local({
      my_i <- i
      plotname <- paste0("plot", my_i)

      output[[plotname]] <- renderUI({
        valueBox(
          input$choosevar,
          my_i,
          icon = icon("credit-card")
        )
      })


    })

  }
}

# Run the application 
shinyApp(ui = ui, server = server)

Спасибо за любые подсказки!

1 Ответ

0 голосов
/ 30 мая 2018

Вы смешиваете элементы shinydashboard с обычным блеском.Вы должны создать панель управления, так как поля значений предназначены для панелей мониторинга.Должно работать следующее: 

library(shiny)
library(shinydashboard)

ui = dashboardPage(
  dashboardHeader(title = "Dynamic number of valueBoxes"),
  dashboardSidebar(
    selectInput(inputId = "choosevar",
                label = "Choose Cut Variable:",
                choices = c("Nr. of Gears"="gear", "Nr. of Carburators"="carb"))
  ),
  dashboardBody(
    uiOutput("plots")
  )

)

server <- function(input, output) {
  #dynamically create the right number of htmlOutput
  # renderUI
  output$plots <- renderUI({
    plot_output_list <- lapply(unique(mtcars[,input$choosevar]), function(i) {
      plotname <- paste0("plot", i)
      valueBoxOutput(plotname)
      # htmlOutput(plotname)
    })

    tagList(plot_output_list)
  }) 

  # Call renderPlot for each one. Plots are only actually generated when they
  # are visible on the web page. 

  for (i in 1:max(unique(mtcars[,"gear"]),unique(mtcars[,"carb"]))) {
    local({
      my_i <- i
      plotname <- paste0("plot", my_i)

      output[[plotname]] <- renderUI({
        valueBox(
          input$choosevar,
          my_i,
          icon = icon("credit-card")
        )
      })
    })
  }
}

# Run the application 
shinyApp(ui = ui, server = server)
...