r - Shiny 的/ Shiny 的仪表板 : Dynamic Number of Output Elements/valueBoxes

Question

我目前正在尝试设置一个动态创建 valueBoxes 的 UI。

我选择了显示的代码 here这正是我想要的，但使用了绘图。

实际上以下工作正常，但框未按预期呈现:

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)

感谢任何提示!

Answer 1

您将 shinydashboard 元素与普通的 shiny-uis 混合在一起。您必须创建一个仪表板用户界面，因为值框用于仪表板。以下应该有效:

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)