以智能方式将所有列一一比较

Question

有变量

xyz

，我想过滤其中任何一个没有巨大差距（差距小于5％）。 下面的代码可以模拟，但是如果想要更多的变量进行比较，代码会很无聊。有什么聪明的方法吗？谢谢！

library(tidyverse)
diamonds %>% select(x,y,z) %>% filter(abs((x-y)/max(x,y))<0.05,
                                      abs((x-z)/max(x,z))<0.05,
                                      abs((y-z)/max(y,z))<0.05)

Answer 1

这里有一个方法。

• 编写一个函数

  gap

  来计算相对距离；
• 将该函数应用于两两列的每个组合；
• 现在找出哪些间隙在允许的最大间隙内，并将逻辑结果放入按列绑定的 tibble 中 (

  map_dfc

  )；

• rowSums

  将查找共有多少行

  TRUE

  并将其与创建新列的列数进行比较

  keep

  ;
• 与原始数据集绑定，过滤值保留并清理。

suppressPackageStartupMessages(
  library(tidyverse)
)
data(diamonds, package = "ggplot2")

gap <- function(data) {
  x <- data[[1]]
  y <- data[[2]]
  abs((x - y)/max(x, y))
}

max_gap <- 0.05

diamonds %>% 
  select(x, y, z) %>%
  combn(m = 2L, gap, simplify = FALSE) %>%
  map_dfc(\(x) x < max_gap) %>%
  mutate(keep = rowSums(.) == ncol(.)) %>%
  bind_cols(diamonds) %>%
  filter(keep) %>%
  select(-(1:4))
#> New names:
#> • `` -> `...1`
#> • `` -> `...2`
#> • `` -> `...3`
#> # A tibble: 2,023 × 10
#>    carat cut       color clarity depth table price     x     y     z
#>    <dbl> <ord>     <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>
#>  1  0.23 Ideal     E     SI2      61.5    55   326  3.95  3.98  2.43
#>  2  0.21 Premium   E     SI1      59.8    61   326  3.89  3.84  2.31
#>  3  0.29 Premium   I     VS2      62.4    58   334  4.2   4.23  2.63
#>  4  0.31 Good      J     SI2      63.3    58   335  4.34  4.35  2.75
#>  5  0.24 Very Good J     VVS2     62.8    57   336  3.94  3.96  2.48
#>  6  0.24 Very Good I     VVS1     62.3    57   336  3.95  3.98  2.47
#>  7  0.26 Very Good H     SI1      61.9    55   337  4.07  4.11  2.53
#>  8  0.22 Fair      E     VS2      65.1    61   337  3.87  3.78  2.49
#>  9  0.3  Good      J     SI1      64      55   339  4.25  4.28  2.73
#> 10  0.23 Ideal     J     VS1      62.8    56   340  3.93  3.9   2.46
#> # ℹ 2,013 more rows

^{创建于2023年12月5日}

---

为了使代码更通用，请使用列向量进行选择。这将避免对要在管道末端丢弃的列进行硬编码。

cols_to_process <- c("x", "y", "z")

diamonds %>% 
  select(all_of(cols_to_process)) %>%
  combn(m = 2L, gap, simplify = FALSE) %>%
  map_dfc(\(x) x < max_gap) %>%
  mutate(keep = rowSums(.) == ncol(.)) %>%
  bind_cols(diamonds) %>%
  filter(keep) %>%
  select(-seq_along(cols_to_process), -keep)