CODEWITHSUNDEEP
rshinyshinydashboard
ismirsehregal
ismirsehregal

Reputation: 33397

Shiny/shinydashboard: Dynamic Number of Output Elements/valueBoxes

I'm currently trying to set up a UI that is creating valueBoxes dynamically.

I' picked up the code shown here which does exactly what I want, but using plots.

Actually the following works, but the boxes aren't rendered as expected: enter image description 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)

Thanks for any hints!

Upvotes: 2

Views: 1116

Answers (1)

SeGa
SeGa

Reputation: 9809

You are mixing shinydashboard elements with normal shiny-uis. You have to create a dashboard-ui, as the valueboxes are for dashboards. The following should work:

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)

Upvotes: 6

Related Questions