如何使用 shinydashboard 在 shinyapp 中显示一系列仪表，每行固定数量的仪表

Question

我想以网格方式显示一系列表盘（圆形仪表）。 最好我想压缩大量的仪表——比如，连续 6 个或 12 个，然后我们将 go 多行。 我发现 R package plotly的plot_ly()有一些不错的仪表图。 但是在相邻的小框中呈现这些plot_ly()正成为一个挑战。

我试过shinydashboard::valueBox()但这些值框只接受一个标量值。 所以我无法在其中放入 plot object。

UPDATE1：最后，我使用了标准的shinydashboard::box()但是仪表太高了，正如你在屏幕截图中看到的那样。 盒子之间的填充是浪费空间。 仪表也没有居中。

更新 2： plotly 图表会在数据刷新时更改其大小（宽度/高度）。 所以我们需要在 plot_ly() 中添加参数： width = 250, height = 175以获取更新。

创建新的 reprex shiny 应用程序以查看新问题。 屏幕 1 - 正在加载 shiny 应用程序 - 一切正常。

屏幕 2 - 一旦数据刷新 - 全部消失。

这是演示 UI 崩溃问题的新 reprex。

# 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

编辑：这是另一种使用splitLayout的方法。 请注意plotlyOutput为我们提供了一个height参数：

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)

---

只需使用shinydashboard::box()的width参数。 作为替代检查splitLayout()或库（ 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)