how to display a series of gauges in shinyapp using shinydashboard with fixed number of gauges per row

Question

I want to display a series of dials (circular gauges) in a grid fashion. Preferably I want to squeeze a large number of gauges—say, 6 or 12 in a row, and then we will go multiple rows. I have discovered that plot_ly() of the R package plotly has some nice gauge plots. But rendering these plot_ly() guages in small adjacent boxes is becoming a challenge.

I tried shinydashboard::valueBox() but these value boxes accept only one scalar value. So I could not fit a plot object inside it.

UPDATE1: Finally, I used the standard shinydashboard::box() but the gauges are too TALL as you see in the screenshot. The padding between boxes is wasted space. Also the gauges are not centered in well.

UPDATE 2: The plotly charts change their size (width/height) when the data refreshes. So we need to add the parameters: width = 250, height = 175 in the plot_ly() also to get the updates in place.

Created the new reprex shiny app to see the new problem. Screen 1 - on loading shiny app - ALL GOOD.

Screen 2 - as soon as data refreshes - ALL GONE.

Here is the new reprex that demonstrates the UI collapse problem.

# reprex for stackoverflow
library(shiny)
library(plotly)
library(shinydashboard)

N <- 24
dt1 <-  dt1 <- data.table(
  value = rnorm(N,mean = 50),
  barcolor = sample(c("red", "yellow", "aqua", "blue", "light-blue", "green"),size = N,replace = T)
)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    tags$style(".recalculating { opacity: inherit !important; }"),
    fluidPage(
      fluidRow(do.call(splitLayout, c(lapply(1:6, function(i) {
        plotlyOutput(paste0("gauge_", i), height = "175px")
      }), cellWidths = "16%"))),
      fluidRow(do.call(splitLayout, c(lapply(7:12, function(i) {
        plotlyOutput(paste0("gauge_", i), height = "175px")
      }), cellWidths = "16%")), style = "margin-top:10px"),
      fluidRow(do.call(splitLayout, c(lapply(13:18, function(i) {
        plotlyOutput(paste0("gauge_", i), height = "175px")
      }), cellWidths = "16%")), style = "margin-top:10px"),
      fluidRow(do.call(splitLayout, c(lapply(19:24, function(i) {
        plotlyOutput(paste0("gauge_", i), height = "175px")
      }), cellWidths = "16%")), style = "margin-top:10px")
    )
  )
)

server <- function(input, output, session) {
  data <- reactiveVal(value = dt1)
    observe({
    invalidateLater(5000)
      dt1 <- data.table(
      value = round(rnorm(N,mean = 50,sd = 10),0),
      barcolor = sample(c("red", "yellow", "aqua", "blue", "light-blue", "green"),size = N,replace = T)
    )
    data(dt1)
  })

 # data <- reactiveFileReader(10000,session = session,filePath = "~/JSW-VTPL/data/grid.csv",readFunc = fread)

  lapply(seq_len(N), function(i) {
    output[[paste0("gauge_", i)]] <- renderPlotly({
      plot_ly(
        title = list(text = paste("Gauge_",i)),
        type = "indicator",
        mode = "gauge+number",
        value = data()[i, value],
        domain = list(x = c(0, 1), y = c(0, 1)),
        gauge =
          list(
            shape = "indicator",
            axis = list(range = c(0,100)),
            color =  "grey",
            bar = list(color = data()[i,barcolor]))
      ) %>%
        layout(autosize = F, margin =  list(
          l = 50,
          r = 50,
          b = 0,
          t = 10,
          pad = 4
        ))
    })
  })
}

shinyApp(ui, server)

Answer 1

Edit: Here is another approach using splitLayout. Please note that plotlyOutput provides us with a height parameter:

library(shiny)
library(plotly)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    fluidPage(
      fluidRow(do.call(splitLayout, c(lapply(1:4, function(i) {
        plotlyOutput(paste0("gauge_", i), height = "275px")
      }), cellWidths = "25%"))),
      fluidRow(do.call(splitLayout, c(lapply(5:8, function(i) {
        plotlyOutput(paste0("gauge_", i), height = "275px")
      }), cellWidths = "25%")), style = "margin-top:10px")
    )
  )
)

server <- function(input, output) {
  data <- reactive({
    data.frame(
      value = sample(0:100, 8),
      color = sample(c("#FF0000", "#00FF00", "#0000FF", "#FFFF00", "#00FFFF", "#FF00FF"), 8, replace = TRUE)
    )
  })
  
  lapply(1:8, function(i) {
    output[[paste0("gauge_", i)]] <- renderPlotly({
      plot_ly(
        type = "indicator",
        mode = "gauge+number",
        value = data()[i, "value"],
        domain = c(0, 100),
        title = list(text = paste("Gauge", i)),
        gauge = list(color = data()[i, "color"])
      ) %>% layout(autosize = F, margin =  list(
        l = 50,
        r = 50,
        b = 0,
        t = 10,
        pad = 4
      ))
    })
  })
}

shinyApp(ui, server)

---

Just use shinydashboard::box()'s width parameter. As an alternative check splitLayout() or library(gridlayout):

library(shiny)
library(plotly)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(
      lapply(1:4, function(i) {
        box(
          plotlyOutput(paste0("gauge_", i)), width = 3
        )
      })
    ),
    fluidRow(
      lapply(5:8, function(i) {
        box(
          plotlyOutput(paste0("gauge_", i)), width = 3
        )
      })
    )
  )
)

server <- function(input, output) {
  data <- reactive({
    data.frame(
      value = sample(0:100, 8),
      color = sample(c("#FF0000", "#00FF00", "#0000FF", "#FFFF00", "#00FFFF", "#FF00FF"), 8, replace = TRUE)
    )
  })
  
  lapply(1:8, function(i) {
    output[[paste0("gauge_", i)]] <- renderPlotly({
      plot_ly(
        type = "indicator",
        mode = "gauge+number",
        value = data()[i, "value"],
        domain = c(0, 100),
        title = list(text = paste("Gauge", i)),
        gauge = list(color = data()[i, "color"])
      )
    })
  })
}

shinyApp(ui, server)