如何用环形图展示Likert量表的前后得分变化（按性别区分）

问题背景 #

我们有10名受试者的干预前后Likert量表得分（0-10分），需要制作满足以下要求的环形图：

• 环形刻度0-10，每个刻度宽度完全一致
• 用线条连接每位受试者的干预前、后得分
• 线条按性别分组着色
• 得分无变化的受试者（如0→0）用环形箭头展示

数据如下：

df <- data.frame(
  ID= c(1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10),
  Time = c("before","after","before","after","before","after","before","after","before","after","before","after","before","after","before","after","before","after","before","after"),
  Group = c("Male","Male","Male","Male","Male","Male","Male","Male","Male","Male","Female","Female","Female","Female","Female","Female","Female","Female","Female","Female"),
  Score = c(0,4,1,5,3,7,0,0,0,2,1,9,1,9,1,8,1,8,1,4)
)

此前尝试用circlize包制作和弦图，但环形刻度宽度随对应人数多少变化（0和1区域过大），不符合需求。

解决方案 #

通过手动定义每个刻度的扇形区域，确保0-10每个刻度宽度一致，再分别绘制连线和箭头，代码如下：

library(circlize)
library(dplyr)
library(tidyr)  # 用于pivot_wider函数

# 整理宽格式数据：合并同一受试者的前后得分与性别
df_merged <- df %>%
  pivot_wider(
    id_cols = ID,
    names_from = Time,
    values_from = c(Score, Group)
  ) %>%
  rename(
    before_score = Score_before,
    after_score = Score_after,
    group = Group_before  # 性别无变化，取任意一列即可
  )

# 定义性别颜色映射
color_map <- c(Male = "#1f77b4", Female = "#ff7f0e")

# 清空环形图环境并设置参数
circos.clear()
circos.par(
  start.degree = 90,    # 将0刻度置于顶部
  gap.degree = 0,       # 刻度间无间隙
  track.height = 0.1,   # 外圈刻度轨道高度
  canvas.xlim = c(-1.2, 1.2),  # 调整画布范围，避免箭头超出
  canvas.ylim = c(-1.2, 1.2)
)

# 初始化环形：每个刻度对应等宽扇形
circos.initialize(
  factors = 0:10,
  xlim = matrix(c(0, 1), nrow = 11, ncol = 2)  # 每个刻度x轴范围0-1，保证宽度一致
)

# 绘制外圈刻度与标签
circos.track(
  ylim = c(0, 1),
  panel.fun = function(x, y) {
    # 绘制垂直刻度线
    circos.segments(
      x0 = 0, y0 = 0, x1 = 0, y1 = 0.2,
      sector.index = CELL_META$sector.index,
      col = "black", lwd = 1
    )
    # 绘制刻度标签
    circos.text(
      x = 0, y = 0.3,
      labels = CELL_META$sector.index,
      facing = "clockwise", niceFacing = TRUE,
      cex = 0.8
    )
  },
  bg.border = NA  # 隐藏轨道边框
)

# 遍历绘制每个受试者的连线/箭头
for(i in seq_len(nrow(df_merged))){
  b_score <- df_merged$before_score[i]
  a_score <- df_merged$after_score[i]
  g <- df_merged$group[i]
  line_color <- color_map[g]
  
  if(b_score != a_score){
    # 绘制前后得分连线
    circos.link(
      sector.index1 = b_score, point1 = c(0.5, 0.5),
      sector.index2 = a_score, point2 = c(0.5, 0.5),
      col = line_color, lwd = 2, border = NA
    )
  } else {
    # 得分无变化时绘制环形箭头
    sector_start <- circos.start.degree(b_score)
    # 设置箭头起始和结束角度，避开刻度线
    arrow_start <- sector_start + 15
    arrow_end <- sector_start + 345
    
    circos.arrow(
      start.degree = arrow_start,
      end.degree = arrow_end,
      sector.index = b_score,
      col = line_color,
      lwd = 2,
      arrow.head.length = 0.06,
      arrow.head.width = 0.06
    )
  }
}

# 添加性别分组图例
legend(
  "bottomright",
  legend = names(color_map),
  fill = color_map,
  title = "性别",
  bty = "n",
  cex = 0.9
)

关键说明 #

1. 等宽刻度实现：通过circos.initialize给每个刻度（0-10）分配相同的x轴范围（0-1），确保所有扇形宽度一致，不受数据分布影响。
2. 连线与箭头区分：用circos.link连接不同得分，用circos.arrow处理得分无变化的情况，箭头角度避开刻度线避免重叠。
3. 颜色分组：提前定义性别对应的颜色，确保线条颜色与分组匹配。

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