r - Shiny 的条件信息框输出

Question

我有一个使用shinyDashboard创建的仪表板，它将显示一些操作信息。我们的 IT 组织有 5 个领域，我们可以根据环境中发生的情况声明“接触”或“不接触”。

我使用一个简单的 REST API 来获取数据，它看起来像(单列数据框):

Status
eECC:Touch
DOC:Touch
CCC:Touch
GEN:Touch
IT:No Touch

该数据帧被写入.RData 文件并使用reactiveFileReader() 加载。一旦到达那里，我想构建一些 infoBox()es 以在屏幕顶部显示横幅以显示环境以及它们是否可以进行更改。这是我的 ui.R 代码的剪辑:

 fluidRow(
    h4("Touch / No Touch", align="center"),
    infoBox("ECC", "TOUCH", icon = icon("ok", lib = "glyphicon"), width = 2, color = "green"),
    infoBox("DOC", "TOUCH", icon = icon("ok", lib = "glyphicon"), width = 2, color = "green"),
    infoBox("CCC", "TOUCH", icon = icon("ok", lib = "glyphicon"), width = 2, color = "green"),
    infoBox("GEN","TOUCH", icon = icon("ok", lib = "glyphicon"), width = 2, color = "green"),
    infoBox("IT", "NO TOUCH", icon = icon("alert", lib = "glyphicon"), width = 2, color = "red")
    ),

所以，我知道这是一个静态示例。它最初是作为概念验证而放置的。我想做的是获取从 touchNoTouchDF.RData 文件读取数据时获得的输入，并根据 RData 文件中的内容更改颜色、图标和文本。

我的第一次尝试是使用 if else 语句，但 Shiny 的似乎并不喜欢这样，或者我做错了:

fluidRow(
h4("Touch / No Touch", align="center"),
if(touchNoTouchDF[1] == "ECC:Touch") {
infoBox("ECC", "TOUCH", icon = icon("ok", lib = "glyphicon"), width = 2, color = "green")} else { infoBox("ECC", "TOUCH", icon = icon("ok", lib = "glyphicon"), width = 2, color = "green")},
...
...

这似乎不起作用，所以我的下一个想法是在我的数据框中的 infoBox() 函数内“构建”字符串并处理 R 脚本中的逻辑。因此，我的数据框(现在为 2 列)将如下所示:

Status      UI
ECC:Touch   "ECC", "TOUCH", icon = icon("ok", lib = "glyphicon"), width... 

然后，在构建 UI 时，只需执行以下操作:

fluidRow(
  h4("Touch / No Touch", align="center"),
  infoBox(touchNoTouchDF[1,2]),
  infoBox(touchNoTouchDF[2,2]),
  infoBox(touchNoTouchDF[3,2]),
  infoBox(touchNoTouchDF[4,2]),
  infoBox(touchNoTouchDF[5,2])
),

嗯，这只是打印信息框上的文本(全部大写字母，对我来说也很奇怪......)。不管怎样，我似乎不知道如何使这些 infoBox()es 与我从 RData 文件中读取的内容动态化。有小费吗？将文本调用到 infoBox() 函数时，除了数据框和行/列之外，是否还必须使用某个函数？提前致谢!

Answer 1

您应该尝试在 Shiny 应用程序的服务器部分中渲染 infoBox。下面的工作示例:

## app.R ##
library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(infoBoxOutput('infoBox1'), valueBoxOutput('valueBox1'))
  )
)

server <- function(input, output) {
  output$infoBox1 <- renderInfoBox({
    x <- runif(1, 0, 10)
    color <- 'green'
    if(x < 5) color <- 'red'
    infoBox(value = x, title = 'Infobox example', color = color)
  })
  output$valueBox1 <- renderValueBox({
    x <- runif(1, 0, 10)
    color <- 'green'
    if(x < 5) color <- 'red'
    valueBox(value = x, subtitle = 'Valuebox example', color = color)
  })
}

shinyApp(ui, server)