flexdashboard::renderValueBox在shinydashboard中无法生成数值框如何解决

flexdashboard 提供的valueBox、renderValueBox、valueBoxOutput是专属flexdashboard框架设计的组件，和shinydashboard的布局、样式体系不兼容，因此会出现无报错但组件无法渲染的问题。

无需使用flexdashboard组件，直接改造shinydashboard原生valueBox，即可支持十六进制颜色自定义、内容样式随响应式变量动态变化的需求，修改后的完整可运行代码如下：

library(shiny)
library(shinydashboard)
library(scales)
library(tibble)
library(dplyr) # 若不想引入dplyr可将下文case_when换回原有嵌套ifelse写法

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(4, 
                     box(title = "Analysis", width = 12, 
                         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, 
                     box(title = "boxs", width = 12,
                         uiOutput(outputId = "box1", width = 3))
              )
            )
    )
  )
)

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 <- renderUI({
    val <- pred_1()/100
    # 动态计算配置
    show_val <- scales::number(x = val, accuracy = 0.01)
    caption <- case_when(
      val <= 2.33 ~ 'AAAAAAAAAA',
      val <= 3.67 ~ 'BBBBBBBBB',
      TRUE ~ 'CCCCCCCCCC'
    )
    bg_color <- case_when(
      val <= 2.33 ~ '#020202',
      val <= 3.67 ~ '#000000',
      TRUE ~ '#006cba'
    )
    icon_val <- case_when(
      val <= 2.33 ~ icon('times-circle'),
      val <= 3.67 ~ icon('exclamation-circle'),
      TRUE ~ icon('check-circle')
    )
    # 生成valueBox并覆盖背景色
    valueBox(
      value = show_val,
      subtitle = caption,
      icon = icon_val,
      color = "blue" # 预设值会被自定义样式覆盖，可随意填写
    ) %>% tagAppendAttributes(style = paste0("background-color: ", bg_color, " !important;"))
  })
}

shinyApp(ui, server)

• 移除了flexdashboard相关依赖和冲突处理逻辑，全部使用shinydashboard原生组件避免兼容问题
• 用renderUI+uiOutput的组合替代flexdashboard的渲染逻辑，通过tagAppendAttributes动态添加背景色样式，完美支持十六进制颜色码配置
• 保留原有响应式逻辑，数值、说明文字、图标、背景色均可随pred_1()动态变化
• 适配了你之前无法使用的box包裹输出组件的写法，可正常显示
• 调整了布局宽度参数，避免组件溢出显示异常

内容的提问来源于stack exchange，提问作者neves