R data.table 测试列索引向量的行相等性

Question

我有一个类似于以下但有数百列和数百万行的数据表：

Name  A_1  A_2  A_3  B_1  C_1  B_2  D_1  D_2  B_3  C_2  C_3  
one   1    1    1    3     5   2    1     1   2    5    5    
two   40   40   40   2     6   2    4     4   2    6    6    
three 20   20   20   5     7   5    6     6   5    8    9    
four  30   30   31   1     6   1    2     2   1    6    6    

我想对包含相同前缀的所有变量进行逐行比较，但我不完全确定最好的方法。到目前为止，我使用以下编码提取了列名中具有相同前缀的列索引向量，如下所示：

combo1<-grep(pattern="^A", x=colnames(data))
combo2<-grep(pattern="^B", x=colnames(data))
combo3<-grep(pattern="^C", x=colnames(data))
combo4<-grep(pattern="^D", x=colnames(data))

我相信下一步是遍历每个向量中数据表的列并比较行值以查看它们是否相等，但我不确定最好的方法。

我希望最终结果为具有匹配前缀的列的每个向量添加列，以传达组合是否相等，如下所示：

Name  A_1  A_2  A_3  B_1  C_1  B_2  D_1  D_2  B_3  C_2  C_3  A_equal  B_equal  C_equal  D_equal
one   1    1    1    3     5   2    1     1   2    5    5    TRUE     FALSE    TRUE     TRUE
two   40   40   40   2     6   2    4     4   2    6    6    TRUE     TRUE     TRUE     TRUE
three 20   20   20   5     7   5    6     6   5    8    9    TRUE     TRUE     FALSE    TRUE
four  30   30   31   1     6   1    2     2   1    6    6    FALSE    TRUE     TRUE     TRUE

最好的方法是什么？

Answer 1

这是split.default 的一个选项，我们根据列名中的模式将data.frame 拆分为特定的较小data.frame 集，即提取没有_ 的子字符串和后面的数字）。然后用lapply循环data.frame的list，通过将第一列与完整数据集进行比较并检查它是否等于列数来获得rowSums，即我们是否有一个唯一的元素一行，它将给出 TRUE 或 FALSE

lst1 <- lapply(split.default(df1[-1], sub("_\\d+", "", names(df1)[-1])), 
              function(x)
           rowSums(x ==  x[,1])== ncol(x))
df1[paste0(names(lst1), "_equal")] <- lst1

-输出

df1
#   Name A_1 A_2 A_3 B_1 C_1 B_2 D_1 D_2 B_3 C_2 C_3 A_equal B_equal C_equal D_equal
#1   one   1   1   1   3   5   2   1   1   2   5   5    TRUE   FALSE    TRUE    TRUE
#2   two  40  40  40   2   6   2   4   4   2   6   6    TRUE    TRUE    TRUE    TRUE
#3 three  20  20  20   5   7   5   6   6   5   8   9    TRUE    TRUE   FALSE    TRUE
#4  four  30  30  31   1   6   1   2   2   1   6   6   FALSE    TRUE    TRUE    TRUE

---

或者使用tidyverse 的选项，我们使用pivot_longer 将数据重新整形为“长”格式，然后执行group_by，并检查across 列是否我们有一个唯一元素（n_distinct ) 并通过“名称”将输出与原始数据集连接

library(dplyr)
library(tidyr)
pivot_longer(df1, cols = -Name, names_to = c(".value", 'grp'), 
      names_sep="_") %>%
     group_by(Name) %>% 
     summarise(across(A:D, ~ n_distinct(., na.rm = TRUE) == 1,
          .names = '{.col}_equal'),
     .groups = 'drop') %>%
     left_join(df1, .)

-输出

#  Name A_1 A_2 A_3 B_1 C_1 B_2 D_1 D_2 B_3 C_2 C_3 A_equal B_equal C_equal D_equal
#1   one   1   1   1   3   5   2   1   1   2   5   5    TRUE   FALSE    TRUE    TRUE
#2   two  40  40  40   2   6   2   4   4   2   6   6    TRUE    TRUE    TRUE    TRUE
#3 three  20  20  20   5   7   5   6   6   5   8   9    TRUE    TRUE   FALSE    TRUE
#4  four  30  30  31   1   6   1   2   2   1   6   6   FALSE    TRUE    TRUE    TRUE

---

或者data.table，逻辑类似于tidyverse，我们使用melt而不是pivot_longer重新整形为“长”格式，然后按“名称”分组，循环数据子集。表（.SD）和lapply，用uniqueN检查唯一性，转换为逻辑== 1并加入on'名称'列

library(data.table)
setDT(df1)[melt(df1, measure = patterns('^A_\\d+$', '^B_\\d+', '^C_\\d+$', '^D_\\d+$'),
   value.name = paste0(LETTERS[1:4], '_equal'))[, 
   lapply(.SD, function(x) uniqueN(x, na.rm = TRUE) == 1),
   .(Name), .SDcols = patterns('equal$')], on = .(Name)]
#    Name A_1 A_2 A_3 B_1 C_1 B_2 D_1 D_2 B_3 C_2 C_3 A_equal B_equal C_equal D_equal
#1:   one   1   1   1   3   5   2   1   1   2   5   5    TRUE   FALSE    TRUE    TRUE
#2:   two  40  40  40   2   6   2   4   4   2   6   6    TRUE    TRUE    TRUE    TRUE
#3: three  20  20  20   5   7   5   6   6   5   8   9    TRUE    TRUE   FALSE    TRUE
#4:  four  30  30  31   1   6   1   2   2   1   6   6   FALSE    TRUE    TRUE    TRUE

数据

df1 <- structure(list(Name = c("one", "two", "three", "four"), A_1 = c(1L, 
40L, 20L, 30L), A_2 = c(1L, 40L, 20L, 30L), A_3 = c(1L, 40L, 
20L, 31L), B_1 = c(3L, 2L, 5L, 1L), C_1 = c(5L, 6L, 7L, 6L), 
    B_2 = c(2L, 2L, 5L, 1L), D_1 = c(1L, 4L, 6L, 2L), D_2 = c(1L, 
    4L, 6L, 2L), B_3 = c(2L, 2L, 5L, 1L), C_2 = c(5L, 6L, 8L, 
    6L), C_3 = c(5L, 6L, 9L, 6L)), class = "data.frame", row.names = c(NA, 
-4L))