Shiny/shinydashboard:输出元素/值框的动态数量

ism*_*gal 2 r shiny shinydashboard

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

我选择了此处显示的代码,它完全符合我的要求,但使用了绘图。

实际上以下工作,但框没有按预期呈现: 在此处输入图片说明

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)
Run Code Online (Sandbox Code Playgroud)

感谢您的任何提示!

SeG*_*eGa 5

您正在将 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)
Run Code Online (Sandbox Code Playgroud)