Shiny应用geom_text显示异常：仅部分类别显示p值星号

开发的Shiny应用中，勾选「Show p-value levels」后，p值星号仅在Retail Trade等部分类别正常显示，Transportation等类别无法显示星号。

错误原因 #

1. Sig列字符编码异常：从dput输出可见，Sig列中的星号显示为乱码（如"�ˆ—�ˆ—�ˆ—"），这是字符编码错误导致的，ggplot无法识别这些乱码字符，因此无法渲染星号。
2. y轴范围计算逻辑漏洞：当筛选后的数据集里没有有效星号行时，原代码的max_y_text会返回异常值，可能导致y轴范围设置不合理，星号被挤出可视区域。

修复方案 #

步骤1：修复数据中的Sig列编码 #

先将数据里的乱码替换为标准星号：

# 修复Sig列的乱码星号
table_E.9_9$Sig <- dplyr::case_when(
  table_E.9_9$Sig == "�ˆ—�ˆ—�ˆ—" ~ "***",
  table_E.9_9$Sig == "�ˆ—�ˆ—" ~ "**",
  table_E.9_9$Sig == "�ˆ—" ~ "*",
  TRUE ~ table_E.9_9$Sig
)

步骤2：修正Shiny应用代码 #

修改server部分的星号渲染逻辑，确保y轴范围计算正确：

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput('cat','Select Category', unique(table_E.9_9$Ent_or_Rev)),
      checkboxInput("control_mean",label = "Show average for non-recipients", value = FALSE),
      checkboxInput("p_values",label = "Show p-value levels", value = FALSE),
      checkboxInput("error_bars",label = "Show 95% confidence intervals", value = FALSE),
      actionButton("Explain_p_values", "Explain p-values"),
      actionButton("Explain_error_bars", "Explain 95% confidence intervals")
    ),
    mainPanel(plotOutput('plot_overall'))
  )
)

server <- function(input, output, session) {
  # 补充定义说明文本（原代码缺失部分）
  p_value_text <- "P值星号表示统计显著性：*** p<0.001, ** p<0.01, * p<0.05"
  CI_text <- "95%置信区间表示有95%的概率真实值落在该区间内"
  
  observeEvent(input$Explain_p_values, {showModal(modalDialog(p_value_text))})
  observeEvent(input$Explain_error_bars, {showModal(modalDialog(CI_text))})
  
  output$plot_overall <- renderPlot({
    cbPalette_4 <- c("#999999",  "#F0E442", "#0072B2", "#D55E00")
    fun_select_cat <- function(table, cat) {
      table %>% 
        filter(Ent_or_Rev == cat)
    }
    
    table_E.9_9_filtered <- fun_select_cat(table_E.9_9, input$cat) %>% 
      ungroup()
    
    control_y <- table_E.9_9_filtered %>% pull(Control) %>% unique()
    
    title <- if (input$cat == "Number of Enterprises") {
      input$cat
    } else {
      paste(input$cat, "(USD)", sep = " ")
    }

    layer_error <- if (input$error_bars) {
      geom_errorbar(aes(ymin = lower, ymax = higher), width = 0.25, position = position_dodge(width = 0.9))
    }
    
    layer_p <- if (input$p_values) {
      column_y_text <- if (input$error_bars) {   
        "higher"                                  
      } else {                                    
        "new_est"
      }
      # 仅基于有效星号行计算最大y值，无有效星号时取所有数据最大值
      valid_sig_rows <- table_E.9_9_filtered %>% filter(!is.na(Sig) & Sig %in% c("*", "**", "***"))
      max_y_text <- if(nrow(valid_sig_rows) > 0){
        max(valid_sig_rows[[column_y_text]])
      } else {
        max(table_E.9_9_filtered[[column_y_text]])
      }
      
      list(
        geom_text(aes(label = Sig, y = 1.05 * .data[[column_y_text]]), 
                  position = position_dodge(width = 0.9), 
                  na.rm = TRUE),
        expand_limits(y = c(0, max_y_text * 1.05))
      )
    }
    
    layer_control <- if (input$control_mean) {
      list(
        annotate("label",
                 x = 3.75, y = control_y,
                 label = "Control\nmean",
                 colour = "#CC79A7",
                 fontface = 2,
                 size = 4.2,
                 label.size = 0,
                 fill = NA,
                 vjust = 0
        ),
        geom_hline(aes(yintercept = Control), linetype = "dashed", col = "#CC79A7", size = 1.5),
        expand_limits(x = c(1, nlevels(table_E.9_9$Treatment) + 1.1))
      )
    }
 
    table_E.9_9_filtered %>% 
      ggplot(aes(x = Treatment, y = new_est, fill = variable)) +
      geom_col(position = position_dodge(width = 0.9)) +
      scale_fill_manual(values = cbPalette_4) +
      scale_y_continuous(labels = scales::label_comma(), expand = c(0, 0)) +
      theme_classic() +
      scale_x_discrete(drop = FALSE) +
      theme(
        plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
        axis.text = element_text(size = 12),
        legend.title = element_blank(),
        legend.text = element_text(size = 12)
      ) +
      layer_p +
      layer_error +
      layer_control +
      labs(title = title, x = NULL, y = NULL)
    
  })
}
shinyApp(ui = ui, server = server)

关键修复点 #

1. 字符编码修复：将Sig列中的乱码替换为标准星号，确保ggplot能正确渲染。
2. y轴范围优化：基于有效星号行计算y轴上限，避免乱码行干扰，保证星号始终在可视区域内。
3. 映射简化：移除geom_text中不必要的group=variable参数，依赖position_dodge与fill=variable的配合实现正确对齐。

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