如何为HH包likert函数的各离散类别添加视觉区分图案？

要给HH包绘制的Likert图每个条形类别添加独特图案（斜线、横线、点、叉号等），可以基于lattice系统的自定义panel函数，结合grid包的底层绘图工具实现。以下是完整的可复现代码和说明：

可复现数据与自定义图案绘制代码 #

library(HH)
library(grid)
library(viridis)

# 生成测试数据
set.seed(123)
survey_data <- data.frame(
  评估维度 = rep(c("服务质量", "产品性能", "售后支持"), each = 100),
  满意度 = sample(c("非常不满意", "不满意", "一般", "满意", "非常满意"), 300, replace = TRUE)
)

# 定义每个满意度对应的图案绘制函数
pattern_drawers <- list(
  "非常不满意" = function(x, y, w, h) {
    # 45度斜线填充
    grid.hlines(y = seq(y - h/2, y + h/2, length.out = 10),
                x = seq(x - w/2, x + w/2, length.out = 10),
                default.units = "native", gp = gpar(col = "black", lwd = 0.5))
  },
  "不满意" = function(x, y, w, h) {
    # 横向平行线填充
    grid.hlines(y = seq(y - h/2 + h/10, y + h/2 - h/10, length.out = 5),
                x = rep(x - w/2, 5), x2 = rep(x + w/2, 5),
                default.units = "native", gp = gpar(col = "black", lwd = 0.5))
  },
  "一般" = function(x, y, w, h) {
    # 圆点填充
    grid.points(x = seq(x - w/2 + w/10, x + w/2 - w/10, length.out = 5),
                y = rep(y, 5), pch = 16, size = unit(0.5, "mm"),
                default.units = "native", gp = gpar(col = "black"))
  },
  "满意" = function(x, y, w, h) {
    # 纵向平行线填充
    grid.vlines(x = seq(x - w/2 + w/10, x + w/2 - w/10, length.out = 5),
                y = rep(y - h/2, 5), y2 = rep(y + h/2, 5),
                default.units = "native", gp = gpar(col = "black", lwd = 0.5))
  },
  "非常满意" = function(x, y, w, h) {
    # 叉号标记
    grid.segments(x0 = x - w/3, y0 = y - h/3, x1 = x + w/3, y1 = y + h/3,
                  default.units = "native", gp = gpar(col = "black", lwd = 1))
    grid.segments(x0 = x + w/3, y0 = y - h/3, x1 = x - w/3, y1 = y + h/3,
                  default.units = "native", gp = gpar(col = "black", lwd = 1))
  }
)

# 自定义panel函数：先绘制原Likert条形，再叠加图案
custom_likert_panel <- function(...) {
  # 调用HH包默认的panel函数绘制条形
  panel.likert(...)
  
  # 进入当前绘图视口，获取坐标信息
  pushViewport(current.viewport())
  
  # 提取当前绘图的数据集
  plot_data <- trellis.last.object()$panel.args[[1]]$data
  rating_levels <- levels(plot_data$满意度)
  item_levels <- levels(plot_data$评估维度)
  
  # 遍历每个评估维度和满意度类别，绘制对应图案
  for (item_idx in seq_along(item_levels)) {
    item_subset <- subset(plot_data, 评估维度 == item_levels[item_idx])
    y_pos <- item_idx  # lattice中y轴位置对应维度索引
    
    # 计算每个满意度条形的中心位置和宽度
    total_responses <- sum(item_subset$Freq)
    cumulative_freq <- cumsum(item_subset$Freq)
    bar_lefts <- (cumulative_freq - item_subset$Freq)/total_responses - 0.5
    bar_rights <- cumulative_freq/total_responses - 0.5
    
    for (rating_idx in seq_along(rating_levels)) {
      rating <- rating_levels[rating_idx]
      bar_center <- (bar_lefts[rating_idx] + bar_rights[rating_idx])/2
      bar_width <- bar_rights[rating_idx] - bar_lefts[rating_idx]
      bar_height <- 0.8  # 控制图案覆盖的条形高度，可按需调整
      
      # 调用对应图案的绘制函数
      pattern_drawers[[rating]](bar_center, y_pos, bar_width, bar_height)
    }
  }
  
  popViewport()
}

# 最终绘制带图案的Likert图
likert(满意度 ~ 评估维度, data = survey_data,
       col = viridis(5),  # 搭配色盲友好配色
       panel = custom_likert_panel)

关键说明 #

• 图案自定义：你可以修改pattern_drawers中的函数，替换成其他图案（比如波浪线、方块等），只需调整grid包的绘图函数即可。
• 参数调整：修改lwd（线条粗细）、size（点大小）、bar_height（图案覆盖高度）等参数，可优化图案的显示效果。
• 配色兼容：保留了色盲友好的viridis配色，图案用黑色绘制，确保颜色和图案双重区分，最大化可访问性。

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