flexdashboard ::renderValueBox 在闪亮的应用程序中不起作用

Question

我正在尝试在shinydashboard 环境中使用flexdashboard::renderValueBox 函数。然而，同样的作品，但没有创建框。见：

我无法使用shiny::box 函数：

box(valueBoxOutput(outputId = "box1", width = 3), title = "boxs"))

为什么我需要根据反应对象pred_1()改变值（如background颜色、图标和标题）。我还需要使用十六进制颜色 (#color)，shinydashboard 的 valueBox 函数不支持。

我的代码：

library(shiny)
library(flexdashboard)
library(shinydashboard)
library(conflicted)
library(scales)
library(tibble)

conflict_prefer(name = "box", winner = "shinydashboard")
conflict_prefer(name = "valueBox", winner = "flexdashboard")
conflict_prefer(name = "valueBoxOutput", winner = "flexdashboard")
conflict_prefer(name = "renderValueBox", winner = "flexdashboard")

header <- dashboardHeader()

sidebar <- dashboardSidebar(
  sidebarMenu(

  id = "tabs", width = 300,
  
  menuItem("Analysis", tabName = "dashboard", icon = icon("list-ol"))
  
  )
)

body <- dashboardBody(

tabItems(
  
  tabItem(tabName = "dashboard", titlePanel("Analysis"), 
          
          fluidPage(
            
            column(2, 

                   box(title = "Analysis", width = 75, 
                       sliderInput(
                         inputId = 'aa', label = 'AA', 
                         value = 0.5 * 100, 
                         min = 0 * 100, 
                         max = 1 * 100, 
                         step = 1
                       ), 
                       
                       sliderInput(
                         inputId = 'bb', label = 'BB', 
                         value = 0.5 * 100, 
                         min = 0 * 100, 
                         max = 1 * 100, 
                         step = 1
                       ), 
                       
                       sliderInput(
                         inputId = 'cc', label = 'CC', 
                         value = 2.5, min = 1, max = 5, step = .15
                       ), 
                       
                       sliderInput(
                         inputId = 'dd', label = 'DD', 
                         value = 2.5, min = 1, max = 5, step = .15
                       )
                   )
            ), 
            
            column(8, 
                   valueBoxOutput(outputId = "box1", width = 3), title = "boxs")
             )
          )
       )
    )

ui <- dashboardPage(header, sidebar, body)

server <- function(input, output, session) {
  
  ac <- function(aa, bb, cc, dd) {
    (aa + cc) + (bb ^ dd)
  }
  
  reac_1 <- reactive({
    tibble(
      aa = input$aa, 
      bb = input$bb, 
      cc = input$cc, 
      dd = input$dd
    )
  })
  
  pred_1 <- reactive({
    temp <- reac_1()
    ac(
      aa = input$aa, 
      bb = input$bb, 
      cc = input$cc, 
      dd = input$dd
    )
  })
  
  output$box1 <- renderValueBox(
    expr = valueBox(
      value = scales::number(x = pred_1() / 100, accuracy = 0.01), 
      caption = ifelse(test = pred_1() / 100 <= 2.33, yes = 'AAAAAAAAAA', 
                       ifelse(test = pred_1() / 100 <= 3.67, yes = 'BBBBBBBBB', 
                              no = 'CCCCCCCCCC')), 
      color = ifelse(test = pred_1() / 100 <= 2.33, yes = '#020202', 
                     ifelse(test = pred_1() / 100 <= 3.67, yes = '#000000', 
                            no = '#006cba')), 
      icon = ifelse(test = pred_1() / 100 <= 2.33, yes = 'fa-times-circle', 
                    ifelse(test = pred_1() / 100 <= 3.67, yes = 'fa-exclamation-circle', 
                           no = 'fa-check-circle'))
    )
  )
}

shinyApp(ui, server)

Answer 1

我可以让它与shinydashboard::valueBox一起工作

library(shiny)
library(flexdashboard)
library(shinydashboard)
library(scales)
library(tibble)

header <- dashboardHeader()

sidebar <- dashboardSidebar(
  sidebarMenu(
    
    id = "tabs", width = 300,
    
    menuItem("Analysis", tabName = "dashboard", icon = icon("list-ol"))
    
  )
)

body <- dashboardBody(
  
  tabItems(
    
    tabItem(tabName = "dashboard", titlePanel("Analysis"), 
            
            fluidPage(
              
              column(2, 
                     
                     box(title = "Analysis", width = 75, 
                         sliderInput(
                           inputId = 'aa', label = 'AA', 
                           value = 0.5 * 100, 
                           min = 0 * 100, 
                           max = 1 * 100, 
                           step = 1
                         ), 
                         
                         sliderInput(
                           inputId = 'bb', label = 'BB', 
                           value = 0.5 * 100, 
                           min = 0 * 100, 
                           max = 1 * 100, 
                           step = 1
                         ), 
                         
                         sliderInput(
                           inputId = 'cc', label = 'CC', 
                           value = 2.5, min = 1, max = 5, step = .15
                         ), 
                         
                         sliderInput(
                           inputId = 'dd', label = 'DD', 
                           value = 2.5, min = 1, max = 5, step = .15
                         )
                     )
              ), 
              
              column(8, 
                     shinydashboard::valueBoxOutput(outputId = "box1", width = 3), title = "boxs")
            )
    )
  )
)

ui <- dashboardPage(header, sidebar, body)

server <- function(input, output, session) {
  
  ac <- function(aa, bb, cc, dd) {
    (aa + cc) + (bb ^ dd)
  }
  
  reac_1 <- reactive({
    tibble(
      aa = input$aa, 
      bb = input$bb, 
      cc = input$cc, 
      dd = input$dd
    )
  })
  
  pred_1 <- reactive({
    temp <- reac_1()
    ac(
      aa = input$aa, 
      bb = input$bb, 
      cc = input$cc, 
      dd = input$dd
    )
  })
  
  output$box1 <- shinydashboard::renderValueBox(
    shinydashboard::valueBox(
      value = scales::number(x = pred_1() / 100, accuracy = 0.01), 
      subtitle =ifelse(test = pred_1() / 100 <= 2.33, yes = 'AAAAAAAAAA', 
                       ifelse(test = pred_1() / 100 <= 3.67, yes = 'BBBBBBBBB', 
                              no = 'CCCCCCCCCC')), 
      color = ifelse(test = pred_1() / 100 <= 2.33, yes = 'red', 
                     ifelse(test = pred_1() / 100 <= 3.67, yes = 'green', 
                            no = 'blue')), 
      icon = icon(ifelse(test = pred_1() / 100 <= 2.33, yes = 'fa-times-circle', 
                    ifelse(test = pred_1() / 100 <= 3.67, yes = 'fa-exclamation-circle', 
                           no = 'fa-check-circle')))
    )
  )
}

shinyApp(ui, server)