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

时间:2018-05-30 15:33:11

标签: r shiny shinydashboard

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

我'拿起显示here的代码,它完全符合我的要求,但是使用了图表。

实际上以下情况有效,但这些方框未按预期呈现,see

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 :(得分:2)

您正在将shinydashboard元素与正常的闪亮uis混合。您必须创建仪表板-ui,因为值框用于仪表板。 以下应该有效:

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)