在R语言的apply函数中添加条件语句的实现问题

原功能函数 #

现有基于apply和outer实现的函数，可判断df中每行c2与其他行c2的差值绝对值是否小于1e7，返回匹配行的c3列ID：

df$match <- apply(outer(df$c2, df$c2, function(x, y) abs(x - y) <  1e7) &
                       diag(nrow(df)) == 0, 
                       MARGIN = 1,
                       function(x) paste(df$c3[x], collapse = ", "))

现有数据 #

c1     c2         c3                 match
1      52426577   chr1.52426577_T    chr2.43668478_G, chr2.47207905_G, chr2.47959251_C, chr2.49606475_C
1      108023890  chr1.108023890_A   
1      129776943  chr1.129776943_T   
2      39943710   chr2.39943710_C    chr2.43668478_G, chr2.47207905_G, chr2.47959251_C, 
2      43668478   chr2.43668478_G    chr1.52426577_T, chr2.39943710_C, chr2.47207905_G, chr2.47959251_C
2      47207905   chr2.47207905_G    chr1.52426577_T, chr2.39943710_C, chr2.43668478_G, chr2.47959251_C
2      47959251   chr2.47959251_C    chr1.52426577_T, chr2.39943710_C, chr2.43668478_G, chr2.47207905_G

尝试修改后的错误代码 #

尝试添加条件仅比较c1列相同的行，运行报错attempt to apply non-function：

df$match <- apply(outer(df$c2, df$c2, function(x, y) if(df$c1(x) == df$c1(y)) abs(x - y) <  1e7) &
                       diag(nrow(df)) == 0, 
                       MARGIN = 1,
                       function(x) paste(df$c3[x], collapse = ", "))

尝试dplyr分组的错误代码 #

用dplyr分组实现时同样报错：

df$match <- sapply(df$c3, function(x){
  df %>%
    group_by(c1) %>%
    filter(abs(c2 - c2[c3 == x]) < 1e7,
           c3 != x) %>%
    pull(c3) %>%
    paste0(collapse = ',')
})

报错信息：

Error in `filter()`:
! Problem while computing `..1 = abs(d2 - d2[d3 == x]) < 1e+07`.
✖ Input `..1` must be of size 17 or 1, not size 0.
ℹ The error occurred in group 2: d1 = 2.

期望结果 #

仅在c1相同的行内匹配，得到如下结果：

c1     c2         c3                 match
1      52426577   chr1.52426577_T    
1      108023890  chr1.108023890_A   
1      129776943  chr1.129776943_T   
2      39943710   chr2.39943710_C    chr2.43668478_G, chr2.47207905_G, chr2.47959251_C 
2      43668478   chr2.43668478_G    chr2.39943710_C, chr2.47207905_G, chr2.47959251_C
2      47207905   chr2.47207905_G    chr2.39943710_C, chr2.43668478_G, chr2.47959251_C
2      47959251   chr2.47959251_C    chr2.39943710_C, chr2.43668478_G, chr2.47207905_G

解决方法 #

方法1：修正原apply+outer逻辑 #

原错误是df$c1(x)的写法错误，需通过索引取对应行的c1值。正确逻辑是先构建c1匹配矩阵，再与c2阈值矩阵结合：

# 构建c1相同的矩阵：同组为TRUE，不同组为FALSE
c1_match <- outer(df$c1, df$c1, `==`)
# 构建c2差值小于阈值的矩阵
c2_match <- outer(df$c2, df$c2, function(x, y) abs(x - y) < 1e7)
# 排除自身匹配（对角线设为FALSE）
no_self <- !diag(nrow(df))

# 合并条件：c1相同 + c2阈值匹配 + 非自身
df$match <- apply(c1_match & c2_match & no_self, MARGIN = 1, function(x) {
  paste(df$c3[x], collapse = ", ")
})

方法2：dplyr分组修正版 #

原dplyr代码问题在于分组内索引匹配逻辑混乱，改为按c1分组后，针对每组内每行匹配同组其他符合条件的行：

library(dplyr)
library(purrr)

df <- df %>%
  group_by(c1) %>%
  mutate(match = map_chr(row_number(), function(i) {
    target_c2 <- c2[i]
    # 同组内排除自身，且c2差值小于阈值的c3值
    matches <- c3[c2 != target_c2 & abs(c2 - target_c2) < 1e7]
    paste(matches, collapse = ", ")
  })) %>%
  ungroup()

两种方法均可得到期望结果：c1=1组内无符合阈值的匹配，match为空；c1=2组内每行均能匹配到同组其他符合条件的c3值。

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