如何修改ggplot2代码生成贴合示例的STM模型主题概率图

问题1：类别名称移至主题线条顶部 #

当前类别名称位于每个facet左侧，需调整为对应类别主题线条的顶部，修改要点：

• 按category分组，在组内对主题按概率降序排序，确保同类别主题连续排列
• 调整strip文本位置参数，让类别标题对齐到组的顶部

问题2：修复灰色网格线间断问题 #

当前用geom_vline添加的竖线因facet的space="free_y"呈现间断，改用ggplot原生x轴网格线可实现贯穿整个绘图区域的连续线条。

完整修改后的代码 #

library(stm)
library(tidyverse)
library(ggplot2)

# Step 1: 建立主题与类别映射
topic_categories <- c(
  "Price" = "11,21,25,7",
  "Services" = "1,9,5",
  "Environment" = "18,13,24,3",
  "Hygiene" = "26,19,4,23",
  "Personnel" = "20,6,15",
  "Values" = "14,17,22",
  "Perception" = "2,16,8,12",
  "Others" = "10"
)

# Step 2: 生成主题概率数据框
topic_probabilities <- colMeans(stm26$theta)
topic_data <- data.frame(
  topic = 1:length(topic_probabilities),
  probability = topic_probabilities
)

# Step 3: 为主题分配类别
topic_data$category <- NA
for (cat in names(topic_categories)) {
  topics <- as.numeric(strsplit(topic_categories[cat], ",")[[1]])
  topic_data$category[topic_data$topic %in% topics] <- cat
}

# 新增：按类别分组排序，生成连续y轴顺序
topic_data <- topic_data %>%
  group_by(category) %>%
  arrange(desc(probability), .by_group = TRUE) %>%
  ungroup() %>%
  mutate(y_order = factor(row_number(), levels = row_number()))

# Step 4: 获取每个主题的关键词
top_words <- labelTopics(stm26, n = 2)
topic_data$top_words <- apply(top_words$prob, 1, function(x) paste(x, collapse = ", "))

# Step 5: 为类别分配颜色
category_colors <- c(
  "Price" = "#8f1f3f",
  "Services" = "#d4ae0b",
  "Environment" = "#de860b",
  "Hygiene" = "#6F8FCF",
  "Personnel" = "#c73200",
  "Values" = "#b7a4d6",
  "Perception" = "#3E7D49",
  "Others" = "#767676"
)

# Step 6: 绘制图表
ggplot(topic_data, aes(y = y_order, x = probability, color = category)) +
  geom_segment(aes(x = 0, xend = probability, yend = y_order), size = 0.5) +
  geom_point(size = 1) +
  geom_text(aes(label = top_words), hjust = 0, nudge_x = 0.002, size = 3) +
  scale_color_manual(values = category_colors) +
  scale_x_continuous(labels = scales::percent_format(accuracy = 1), 
                     limits = c(0, 0.18),
                     breaks = seq(0, 0.15, by = 0.05)) +
  facet_grid(category ~ ., scales = "free_y", space = "free_y", switch = "y") +
  theme_minimal() +
  theme(
    axis.title.y = element_blank(),
    axis.text.y = element_blank(),
    axis.ticks.y = element_blank(),
    panel.grid.major.y = element_blank(),
    panel.grid.minor.y = element_blank(),
    panel.grid.major.x = element_line(color = "lightgrey"),
    panel.grid.minor.x = element_blank(),  
    legend.position = "none",
    strip.placement = "outside",
    strip.text.y.left = element_text(angle = 0, hjust = 1, vjust = 0, face = "bold", margin = margin(b = 10)),
    plot.title = element_text(hjust = 0.5, face = "bold"),
    plot.subtitle = element_text(hjust = 0.5, face = "italic"),
    plot.margin = margin(5.5, 40, 5.5, 30)
  ) +
  labs(
    title = "Title",
    subtitle = "Subtitle",
    x = "Expected topic probability"
  )

修改说明 #

1. 类别名称位置：通过分组排序让同类别主题连续排列，调整strip.text.y.left的vjust=0将类别标题对齐到每组顶部，同时隐藏原y轴文本避免冗余。
2. 网格线问题：移除geom_vline，改用panel.grid.major.x实现贯穿整个绘图区域的连续灰色竖线，配合scale_x_continuous的breaks参数确保网格线位置精准。

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