基于特征矩阵计算字符串字符间欧氏距离的R语言实现需求

1. 准备环境与数据 #

首先加载所需工具包并定义示例数据：

library(tidyverse)

# 示例数据集
subj <- c(1, 1, 1, 2, 2)
session <- c(1, 1, 2, 1, 2)
items <- c("hfg", "hrfg", "thflk", "plht", "sdrpv")
df <- data.frame(subj, session, items)

# 特征矩阵
feature_matrix <- tribble(
  ~char, ~val1, ~val2, ~val3, ~val4, ~val5, ~val6, ~val7, ~val8, ~val9, ~val10, ~val11,
  "p", -1, 1, -1, -1, 1, 1, 0, -1, 1, 0, 0,
  "b", -1, 1, 0, -1, 1, 1, 0, -1, 1, 0, 0,
  "t", -1, 1, -1, -1, 1, -1, 1, -1, -1, 1, 0,
  "d", -1, 1, 0, -1, 1, -1, 1, -1, -1, 1, 0,
  "k", -1, 1, -1, -1, 1, -1, -1, -1, -1, -1, 0,
  "ɡ", -1, 1, 0, -1, 1, -1, -1, -1, -1, -1, 0,
  "f", -0.5, 1, -1, -1, 0, -1, 1, -1, 1, 0, 0,
  "v", -0.5, 1, 0, -1, 0, -1, 1, -1, 1, 0, 0,
  "s", -0.5, 1, -1, -1, 0, -1, 1, -1, -1, 1, 0,
  "c", -0.5, 1, 0, -1, 0, -1, 1, -1, -1, -1, 0,   
  "z", -0.5, 1, 0, -1, 0, -1, 1, -1, -1, 1, 0,
  "h", -0.5, 1, 0, -1, 0, -1, -1, 1, -1, -1, -1,
  "m", 0, 0, 1, 1, 1, 1, 0, -1, 1, 0, 0,
  "n", 0, 0, 1, 1, 1, -1, 1, -1, -1, 1, 0,
  "r", 0.5, 0, 1, 0, -1, -1, -1, 1, 1, -1, -1,  
  "l", 0.5, 0, 1, 0, -1, -1, 1, -1, -1, 1, 0,
  "w", 0.8, 0, 1, 0, 0, 1, -1, -1, 1, -1, 0,
  "j", 0.8, 0, 1, 0, 0, -1, 0, -1, -1, 0, 1 
)

2. 跨字符串距离计算（按受试者分组） #

先定义辅助函数计算两组字符的总距离，再按受试者生成所有items的两两组合并完成距离计算：

# 辅助函数：计算两个字符集合的总距离
calc_pair_distance <- function(chars1, chars2, features) {
  # 生成所有字符对
  char_pairs <- expand_grid(c1 = chars1, c2 = chars2)
  
  # 匹配特征值并计算平方差
  char_pairs <- char_pairs %>%
    left_join(features, by = c("c1" = "char")) %>%
    left_join(features, by = c("c2" = "char"), suffix = c("_1", "_2"))
  
  # 计算每个特征的平方差之和、开平方，最后求和得到总距离
  feature_cols1 <- str_subset(names(char_pairs), "^val.*_1$")
  feature_cols2 <- str_replace(feature_cols1, "_1", "_2")
  
  char_pairs %>%
    mutate(across(all_of(feature_cols1), ~ (. - char_pairs[[feature_cols2[cur_column() == feature_cols1]]])^2)) %>%
    summarise(across(all_of(feature_cols1), sum)) %>%
    mutate(across(everything(), sqrt)) %>%
    summarise(total_distance = sum(everything())) %>%
    pull(total_distance)
}

# 按受试者分组计算所有items两两之间的距离
cross_item_distances <- df %>%
  group_by(subj) %>%
  mutate(row_id = row_number()) %>%
  expand(row_id1 = row_id, row_id2 = row_id) %>%
  filter(row_id1 <= row_id2) %>% # 保留上三角矩阵，避免重复计算
  left_join(df, by = c("subj", "row_id1" = "row_id")) %>%
  left_join(df, by = c("subj", "row_id2" = "row_id"), suffix = c("_1", "_2")) %>%
  mutate(
    chars1 = str_split(items_1, ""),
    chars2 = str_split(items_2, "")
  ) %>%
  rowwise() %>%
  mutate(total_distance = calc_pair_distance(chars1, chars2, feature_matrix)) %>%
  ungroup() %>%
  select(subj, items_1, items_2, total_distance)

# 查看结果
head(cross_item_distances)

3. 字符串内部字符距离计算 #

计算每个字符串中所有字符对的距离，可生成详细的字符对距离，也可做汇总统计：

# 生成每个字符串内部所有字符对的距离
intra_string_distances <- df %>%
  mutate(chars = str_split(items, "")) %>%
  unnest(chars) %>%
  group_by(subj, session, items) %>%
  expand(c1 = chars, c2 = chars) %>%
  filter(c1 <= c2) %>% # 避免重复计算同一字符对
  left_join(feature_matrix, by = c("c1" = "char")) %>%
  left_join(feature_matrix, by = c("c2" = "char"), suffix = c("_1", "_2")) %>%
  rowwise() %>%
  mutate(
    pair_distance = sum(
      sqrt((val1_1 - val1_2)^2),
      sqrt((val2_1 - val2_2)^2),
      sqrt((val3_1 - val3_2)^2),
      sqrt((val4_1 - val4_2)^2),
      sqrt((val5_1 - val5_2)^2),
      sqrt((val6_1 - val6_2)^2),
      sqrt((val7_1 - val7_2)^2),
      sqrt((val8_1 - val8_2)^2),
      sqrt((val9_1 - val9_2)^2),
      sqrt((val10_1 - val10_2)^2),
      sqrt((val11_1 - val11_2)^2)
    )
  ) %>%
  ungroup() %>%
  select(subj, session, items, c1, c2, pair_distance)

# 汇总每个字符串的平均内部距离
intra_string_summary <- intra_string_distances %>%
  group_by(subj, session, items) %>%
  summarise(
    avg_intra_distance = mean(pair_distance),
    total_intra_distance = sum(pair_distance),
    .groups = "drop"
  )

# 查看结果
head(intra_string_distances)
head(intra_string_summary)

注意事项 #

• 针对5万行的数据集，expand生成两两组合会产生大量数据，保留非重复对（row_id1 <= row_id2）可显著减少计算量；
• 若处理速度较慢，可改用data.table包进行向量化优化，提升大数据处理效率；
• 确保feature_matrix包含所有items中出现的字符，避免匹配缺失导致计算错误。

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