代码之家 › 专栏 › 技术社区 › Mark

如何删除在两列中以相反顺序包含相同对的行

dplyr r

4

Mark · 技术社区 · 7 年前

在相关矩阵中,我想去掉那些与另一行基本上包含相同信息的行,除了

   var1 var2      value
1   cyl  mpg -0.8521620
2  disp  mpg -0.8475514
3    wt  mpg -0.8676594
4   mpg  cyl -0.8521620
5  disp  cyl  0.9020329
6    hp  cyl  0.8324475
7    vs  cyl -0.8108118
8   mpg disp -0.8475514
9   cyl disp  0.9020329
10   wt disp  0.8879799
11  cyl   hp  0.8324475
12  mpg   wt -0.8676594
13 disp   wt  0.8879799
14  cyl   vs -0.8108118

在这里,我们可以删除例如第4行mpg vs cyl,因为第1行已经有cyl vs mpg了

我知道我可以在列值中筛选唯一的值,但我不想这样做,因为我的庞大数据集实际上有可能在多对列中获得相同的相关分数。所以必须通过名字匹配来完成 var1 和 var2

到目前为止,我已经编写了这段代码来过滤出高于某个相关值但不是1的数据行(变量vs自身)

mtcars %>% 
  as.matrix %>%
  cor %>%
  as.data.frame %>%
  rownames_to_column(var = 'var1') %>%
  gather(var2, value, -var1) %>%
  filter(value > 0.8 | value < -0.8) %>%
  filter(value != 1)

编辑

安德烈的回答

cor %>% {(function(x){x[upper.tri(x)]<-NA; x})(.)} %>%

Unit: milliseconds
   expr      min       lq     mean   median       uq      max neval cld
   Andre 4.818793 5.113676 5.630160 5.408955 5.704825 22.33730   100  a 
   Rui   5.413692 5.761669 7.531146 6.003656 6.583750 78.02836   100   b

3 回复 | 直到 7 年前

1

4

Andre Elrico 7 年前

mtcars %>% 
    as.matrix %>%
    cor %>% {(function(x){x[upper.tri(x)]<-NA; x})(.)} %>%
    as.data.frame %>%
    rownames_to_column(var = 'var1') %>%
    gather(var2, value, -var1) %>%
    filter(value > 0.8 | value < -0.8) %>%
    filter(value != 1)

结果:

#  var1 var2      value
#1  cyl  mpg -0.8521620
#2 disp  mpg -0.8475514
#3   wt  mpg -0.8676594
#4 disp  cyl  0.9020329
#5   hp  cyl  0.8324475
#6   vs  cyl -0.8108118
#7   wt disp  0.8879799

使用的技巧:

使用匿名函数 READ MORE
{ 围绕匿名函数来防止默认管道行为(管道到第一个可能的位置),似乎没有这一步就可以工作,但我觉得这样做更安全。 READ MORE
?upper.tri )(您甚至可以在该步骤中删除对角线,以删除最后一个代码段 filter(value != 1)

我的建议是:

mtcars %>% 
    as.matrix %>%
    cor %>% {(function(x){x[upper.tri(x, diag = T)]<-NA; x})(.)} %>%
    as.data.frame %>%
    rownames_to_column(var = 'var1') %>%
    gather(var2, value, -var1) %>%
    filter(value > 0.8 | value < -0.8)

2

Rui Barradas 7 年前

另一种方法就是 filter 通过 var1 < var2 .

mtcars %>% 
  as.matrix %>%
  cor %>%
  as.data.frame %>%
  rownames_to_column(var = 'var1') %>%
  gather(var2, value, -var1) %>%
  filter(value > 0.8 | value < -0.8) %>%
  filter(value != 1) %>%
  filter(var1 < var2)
#  var1 var2      value
#1  cyl  mpg -0.8521620
#2 disp  mpg -0.8475514
#3  cyl disp  0.9020329
#4  cyl   hp  0.8324475
#5  mpg   wt -0.8676594
#6 disp   wt  0.8879799
#7  cyl   vs -0.8108118

3

1

zx8754 7 年前

基础

x <- cor(mtcars)
x[ upper.tri(x, diag = TRUE) | abs(x) < 0.8  ] <- NA
na.omit(data.frame(as.table(x)))
#    Var1 Var2       Freq
# 2   cyl  mpg -0.8521620
# 3  disp  mpg -0.8475514
# 6    wt  mpg -0.8676594
# 14 disp  cyl  0.9020329
# 15   hp  cyl  0.8324475
# 19   vs  cyl -0.8108118
# 28   wt disp  0.8879799

与公认的答案相比:

microbenchmark::microbenchmark(
  base = {
    x <- cor(mtcars)
    x[ upper.tri(x, diag = TRUE) | abs(x) < 0.8  ] <- NA
    na.omit(data.frame(as.table(x)))
  },
  tidy = {
    mtcars %>% 
      as.matrix %>%
      cor %>% {(function(x){x[upper.tri(x, diag = T)]<-NA; x})(.)} %>%
      as.data.frame %>%
      rownames_to_column(var = 'var1') %>%
      gather(var2, value, -var1) %>%
      filter(value > 0.8 | value < -0.8)    
  })
# Unit: microseconds
# expr      min        lq      mean   median        uq      max neval
# base  683.994  718.1025  790.9333  750.099  796.2825  2288.63   100
# tidy 3278.397 3405.3260 3660.0932 3488.334 3676.3870 10212.20   100