如何将R Shiny组件嵌入主面板图表并修改valueBox形状与字体

1. 将下拉选择组件嵌入主面板图表区域 #

把原本独立在mainPanel外的三个selectInput移动到mainPanel内部，放在图表输出上方，用fluidRow和column维持并排布局，即可让选择框与图表处于同一主面板区域。

2. 调整valueBox的形状与字体样式 #

通过自定义CSS修正small-box（valueBox的底层容器）的尺寸、内边距，同时调整数值字体大小，设置统一的背景色与边框样式，使其更贴近示例图效果。

修改后的完整代码 #

library(shiny)
library(tidyverse)
library(scales)
library(ggpubr)
library(corrr)
library(shinydashboard)
library(DT)

dataset <- iris %>%
  mutate(week = seq(from = as.Date("2017-03-12"), to = as.Date("2020-01-22"), by = "weeks"))

ui <- fluidPage(
  tags$style('.container-fluid {
                             background-color: Lavender;
              }'),
  # 自定义valueBox样式
  tags$style(HTML("
    .small-box {
      height: 80px;
      width: 180px;
      padding: 15px;
      border-radius: 8px;
      border-style: solid;
      border-width: 2px;
    }
    .small-box .inner h3 {
      font-size: 2.5em;
      margin: 0;
    }
  ")),
  
  fluidRow(
    column(3, offset = 7,
           div(valueBoxOutput("vbox"), style = "color:white; background-color:#6724C6;")),
    column(2, align='right', 
           dateRangeInput("week", "Week", width="280",
                          end="2020-01-22", start="2017-03-12"))
  ),
  
  mainPanel(width = 12,
            # 将选择框移到主面板内部，放在图表上方
            fluidRow(
              column(4,
                     selectInput("variable1", "Variable 1:", selected="Petal.Length",
                                 choices=names(dataset[1:4]))),
              column(4,
                     selectInput("variable2", "Variable 2:", selected="Sepal.Length",
                                 choices=names(dataset[1:4]))),
              column(4,
                     selectInput("variable3", "Variable 3:", selected="Species",
                                 choices=names(dataset[5])))
            ),
            plotOutput("distPlot"),
            dataTableOutput("txt"),
            verbatimTextOutput("write"),
  ),
  fluidRow(column(12, textInput("caption","Caption","Data Summary")))
)

server <- function(input, output) {
  
  output$vbox <- renderValueBox({
    valueBox(
      value = round(cor(q()[,input$variable1], q()[,input$variable2]),2),
      subtitle = "相关系数",
      color = "purple"
    )  
  })
  
  q <- reactive({
    dataset %>%
      filter(week >= min(input$week) & week <= max(input$week))
  })
  
  output$distPlot <- renderPlot({
    ggplot(q(), aes_string(input$variable1, input$variable2)) + geom_smooth()
  })
  
  output$txt <- renderDataTable({
    datatable(
      q()[,c(input$variable1,input$variable2)],
      options = list(
        scrollX = TRUE,
        scrollY = "250px"
      )        
    )
  })
  
  output$write <- renderText({ input$caption })
}

shinyApp(ui = ui, server = server)

关键修改说明 #

• 选择框嵌入：将三个selectInput从外部fluidRow迁移到mainPanel内的fluidRow中，实现与图表同区域布局。
• valueBox样式：通过CSS设置small-box的高度、宽度、圆角、边框，放大数值字体（.inner h3的font-size），添加subtitle明确内容含义，背景色通过color = "purple"与自定义CSS配合统一。
• 移除原代码中错误的width: 0px设置，确保valueBox正常显示。

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