Shiny应用图表网格布局优化与功能改进技术问询

以下是满足所有需求的完整代码，同时解决了原代码中的冗余问题和细节错误：

核心优化点说明 #

• 网格布局：使用patchwork包将三个箱线图横向拼接，实现单页无滚动查看
• 下拉框视觉区分：通过CSS为不同物种前缀的下拉框设置专属颜色标签，快速识别分类
• ANOVA结果嵌入：将重复测量ANOVA的p值直接作为箱线图副标题，无需单独文本输出
• 代码去重：通过循环逻辑生成所有图表，避免重复编写三次相同的渲染代码

# 加载依赖包
library(shiny)
library(dplyr)
library(ggplot2)
library(stringr)
library(lme4)
library(lmerTest)
library(patchwork)

# 生成模拟数据
fulldf <- data.frame(
  ID = rep(1:100, each = 4),  # 每个ID重复4次
  dog_weight_raw = runif(400, min = 5, max = 30),
  dog_size_raw = runif(400, min = 10, max = 50),
  dog_width_raw = runif(400, min = 5, max = 20),
  cat_whiskers_raw = runif(400, min = 0, max = 10),
  cat_length_raw = runif(400, min = 20, max = 60),
  cat_weight_raw = runif(400, min = 2, max = 8),
  cat_class_raw = runif(400, min = 20, max = 80),
  cat_breed_log10 = runif(400, min = 2, max = 8),
  cat_size_log10 = runif(400, min = 54, max = 200),
  rabbit_height_log10 = runif(400, min = 10, max = 30),
  rabbit_length_log10 = runif(400, min = 15, max = 40),
  timepoint = rep(1:4, each = 100)  # 时间点1-4重复100次
)
fulldf$timepoint <- as.factor(fulldf$timepoint)

# 生成标记列表（筛选_raw和_log10结尾的列）
markers <- names(fulldf)[grep("log10$|_raw$", names(fulldf))] %>% sort()

# UI部分
ui <- fluidPage(
  titlePanel("标记箱线图"),
  
  # 自定义CSS：为不同物种的下拉框设置颜色
  tags$style(HTML("
    .dog-select label { color: #8B4513; font-weight: bold; }
    .cat-select label { color: #FFA500; font-weight: bold; }
    .rabbit-select label { color: #808080; font-weight: bold; }
  ")),
  
  sidebarLayout(
    sidebarPanel(
      # Dog类标记选择框
      tags$div(class = "dog-select",
        selectInput(
          inputId = "markerselect1",
          label = "选择Dog类标记:",
          choices = markers,
          selected = markers[str_detect(markers, "^dog")][1]  # 默认选中第一个Dog标记
        )
      ),
      # Cat类标记选择框
      tags$div(class = "cat-select",
        selectInput(
          inputId = "markerselect2",
          label = "选择Cat类标记:",
          choices = markers,
          selected = markers[str_detect(markers, "^cat")][1]  # 默认选中第一个Cat标记
        )
      ),
      # Rabbit类标记选择框
      tags$div(class = "rabbit-select",
        selectInput(
          inputId = "markerselect3",
          label = "选择Rabbit类标记:",
          choices = markers,
          selected = markers[str_detect(markers, "^rabbit")][1]  # 默认选中第一个Rabbit标记
        )
      ),
      width = 3
    ),
    
    mainPanel(
      # 单个输出：组合后的网格箱线图
      plotOutput(outputId = "combined_boxplots", height = "600px")
    )
  )
)

# Server部分
server <- function(input, output) {
  
  # 计算重复测量ANOVA结果的函数
  compute_anova <- function(column_name) {
    filtered_df <- fulldf %>%
      select(timepoint, ID, !!sym(column_name)) %>%
      filter(!is.na(.[[column_name]]) & is.finite(.[[column_name]]))
    
    # 拟合线性混合模型
    lmer_model <- lmer(formula = as.formula(paste(column_name, "~ timepoint + (1 | ID)")), 
                       data = filtered_df)
    anova_result <- anova(lmer_model, type = "III")
    p_value <- formatC(anova_result[["Pr(>F)"]][1], format = "f", digits = 5)
    # 显著p值添加星号标记
    p_value_display <- ifelse(as.numeric(p_value) < 0.05, paste0(p_value, "*"), p_value)
    
    paste("重复测量ANOVA p值:", p_value_display)
  }
  
  # 生成带ANOVA副标题的箱线图函数
  create_boxplot <- function(column_name) {
    anova_text <- compute_anova(column_name)
    
    ggplot(data = fulldf, aes(x = timepoint, y = .data[[column_name]], color = timepoint)) +
      geom_boxplot() +
      labs(x = "时间点", y = column_name, subtitle = anova_text) +
      theme_classic() +
      theme(legend.position = "none")  # 隐藏图例（时间点分组已明确）
  }
  
  # 渲染组合网格图
  output$combined_boxplots <- renderPlot({
    # 获取三个选中的标记
    selected_markers <- c(input$markerselect1, input$markerselect2, input$markerselect3)
    
    # 批量生成三个箱线图并横向拼接
    plots <- lapply(selected_markers, create_boxplot)
    plots[[1]] + plots[[2]] + plots[[3]] + plot_layout(ncol = 3)
  })
}

# 运行应用
shinyApp(ui = ui, server = server)

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