如何使用 R 中的 dplyr 包在列中保留具有相同值的行？答案

【问题标题】：How to left rows with the same values in columns using dplyr package in R?如何使用 R 中的 dplyr 包在列中保留具有相同值的行？
【发布时间】：2022-01-14 07:48:08
【问题描述】：

我想知道如何使用dplyr 包过滤列中具有相同值的行？我尝试做一些与question 中的要求和建议相反的事情，但没有任何效果。

我使用 apply 函数的方法，但收到以下错误：

same_vals <- apply(mydata, 1, function(x) all(x == x[1]))

final <- mydata %>% 
  filter(same_vals)


Error: Can't subset elements that don't exist.
x Location 1 doesn't exist.
i There are only 0 elements.

apply 每次尝试使用它都会让我发疯。它对我的示例数据都不起作用：

set.seed(2022)
test <- tibble(id = floor(runif(10, min = 0, max = 111)),
       var1 = ceiling(runif(10, min = 5, max = 10)),
       var2 = c(6, 5, 4, 8, 12, 1223, 14, 1, 90, 1),
       var3 = c(6, 3, 4, 8, 11, 45, 56, 78, 0, 9))


# A tibble: 10 x 4
      id  var1  var2  var3
   <dbl> <dbl> <dbl> <dbl>
 1    90     6     6     6
 2    71     6     5     3
 3    13     6     4     4
 4    60     8     8     8
 5    20     9    12    11
 6    70     6  1223    45
 7     8     9    14    56
 8     4     8     1    78
 9    41     8    90     0
10    84    10     1     9

test1 <- apply(test, 1, function(x) all(x == x[1]))

test %>% 
  filter(test1)

# A tibble: 0 x 4
# ... with 4 variables: id <dbl>, var1 <dbl>, var2 <dbl>, var3 <dbl>

理想的输出

# A tibble: 10 x 4
      id  var1  var2  var3
   <dbl> <dbl> <dbl> <dbl>
 1    90     6     6     6
 4    60     8     8     8

【问题讨论】：

标签： r dplyr filter

【解决方案1】：

您可以比较每行的最小值和最大值：

vars <- test[,-1]
test[do.call(pmin, vars) == do.call(pmax, vars),]

# A tibble: 2 x 4
     id  var1  var2  var3
  <dbl> <dbl> <dbl> <dbl>
1    90     6     6     6
2    60     8     8     8

【讨论】：

【解决方案2】：

更新：再次在 akrun 的帮助下：我们可以使用 if_all：

test %>% filter(if_all(var2:var3, ~ . == var1))

     id  var1  var2  var3
  <dbl> <dbl> <dbl> <dbl>
1    90     6     6     6
2    60     8     8     8

更新的基准测试：包括 Ronak 的解决方案和 akrun 辅助的 tarjae if_all 解决方案：

第一个答案： 这个问题问得好！每当我需要大量时间来解决一个问题时，我都会注意到解决方案并不像我想象的那么明显。在这种情况下，我完全同意 OP，即有时事情会让人发疯。

我原以为if_all 应该适用于这项任务，因为它是为这种情况而创建的（据我所知，在多个列中使用过滤器）。但我无法应用它。

因此我决定写一个函数（注意我编程经验不是很丰富）欢迎评论提高自己：

# function to filter only rows with same values across some (not all) columns!

library(dplyr)
library(tidyr)

tarjae <- function(x) {
  x %>% 
    pivot_longer(-1) %>% 
    group_by(group = rep(row_number(), each=ncol(test[,-1]), length.out=n())) %>% 
    add_count(value) %>% 
    filter(ncol(test[,-1]) == n) %>%
    pivot_wider(names_from = name, values_from = value) %>%
    ungroup() %>% 
    select(-c(group, n))
}


tarjae(test)

 id  var1  var2  var3
  <int> <int> <int> <int>
1    90     6     6     6
2    60     8     8     8

基准测试： Waldi 排名第一，tarjae 排名最后 :-(

library(microbenchmark)
mbm = microbenchmark(
  tarjae = tarjae(test),
  Yuriy = test %>% 
    rowwise() %>% 
    filter(n_distinct(c_across(-id)) == 1),
  Mikko1 = test %>% filter(sapply(1:nrow(test), function(i) {all(diff(as.numeric(test[i,2:4])) == 0)})),
  Mikko2 = test %>% 
    rowwise() %>% 
    mutate(diff = sum(diff(var1:var3))) %>% 
    filter(diff == 0),
  Waldi = test[do.call(pmin, test[,-1]) == do.call(pmax, vars),],
  Claudiu1 = test %>% 
    rowwise() %>% 
    mutate(unique =  n_distinct(c_across(var1:var3))),
  Claudiu2 = test %>% 
    rowwise() %>% 
    mutate(unique =  n_distinct(c_across(var1:var3), na.rm = TRUE)),
  times=50
)
mbm

autoplot(mbm)

Unit: microseconds
     expr       min        lq        mean     median        uq       max neval   cld
   tarjae 15099.000 15422.300 16147.84108 15672.5005 16134.201 22529.301    50     e
    Yuriy  3995.102  4106.401  4228.88304  4173.9010  4331.300  4640.902    50   cd 
   Mikko1  1325.702  1369.702  1456.27518  1405.0010  1474.001  2071.201    50  b   
   Mikko2  4159.700  4256.300  4503.31502  4316.2010  4435.201 10515.101    50    d 
    Waldi    63.601    87.901    95.26902    92.9015    94.801   209.901    50 a    
 Claudiu1  3817.500  3877.801  4050.05700  3974.6515  4065.101  5529.501    50   c  
 Claudiu2  4003.502  4093.501  4252.04898  4170.2010  4272.501  6003.801    50   cd

【讨论】：

基本 R 函数获胜 ;)

【解决方案3】：

df <- data.frame(
          id = c(90, 71, 13, 60, 20, 70, 8, 4, 41, 84),
        var1 = c(6, 6, 6, 8, 9, 6, 9, 8, 8, 10),
        var2 = c(6, 5, 4, 8, 12, 1223, 14, 1, 90, 1),
        var3 = c(6, 3, 4, 8, 11, 45, 56, 78, 0, 9)
                  )

library(tidyverse)
df %>% 
  rowwise() %>% 
  filter(n_distinct(c_across(-id)) == 1) 
#> # A tibble: 2 x 4
#> # Rowwise: 
#>      id  var1  var2  var3
#>   <dbl> <dbl> <dbl> <dbl>
#> 1    90     6     6     6
#> 2    60     8     8     8

^{由reprex package (v2.0.1) 于 2022 年 1 月 14 日创建}

【讨论】：

【解决方案4】：

不是很原生的tidyverse，但可以满足你的需求？

library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union

set.seed(2022)
test <- tibble(id = floor(runif(10, min = 0, max = 111)),
               var1 = ceiling(runif(10, min = 5, max = 10)),
               var2 = c(6, 5, 4, 8, 12, 1223, 14, 1, 90, 1),
               var3 = c(6, 3, 4, 8, 11, 45, 56, 78, 0, 9))

test %>% filter(sapply(1:nrow(test), function(i) {all(diff(as.numeric(test[i,2:4])) == 0)}))
#> # A tibble: 2 × 4
#>      id  var1  var2  var3
#>   <dbl> <dbl> <dbl> <dbl>
#> 1    90     6     6     6
#> 2    60     8     8     8

^{由reprex package (v2.0.1) 于 2022 年 1 月 14 日创建}

编辑：

这是一个完全整洁的方式：

test %>% 
  rowwise() %>% 
  filter(all(diff(var1:var3) == 0))

【讨论】：

我喜欢“完全整洁的方式”！谢谢！
是的，但sum(diff(.)) 并不等同于所有重复值。您可以在任意情况下将该总和设为零，例如sum(diff(c(6, 5, 6)))，因为 0+0=0 和 1-1=0, 2-2=0 等等
@ClaudiuPapasteri，谢谢，已相应编辑

【解决方案5】：

您可以选择行标准差或方差为 0 的行。

test[matrixStats::rowSds(as.matrix(test[-1])) == 0, ]

# A tibble: 2 x 4
#     id  var1  var2  var3
#  <dbl> <dbl> <dbl> <dbl>
#1    90     6     6     6
#2    60     8     8     8

【讨论】：

【解决方案6】：

这是@Yuriy Saraykin 回答的后续，我认为他的解决方案是tidyverse 方式最具代表性的，并使用了强大的n_distinct 函数。他的答案几乎在所有情况下都能达到您想要的结果，但我想扩展一下在缺失数据的情况下使用它，因为NA 始终是一个独特的值。

library(dplyr)
library(tidyr)  

set.seed(2022)
test <- tibble(id = floor(runif(10, min = 0, max = 111)),
               var1 = c(6, 6, 6, 8, 9, NA, NA, 8, 8, NA),
               var2 = c(6, 5, 4, 8, 7, 12, NA, 1, 9, NA),
               var3 = c(6, 3, 4, 8, 7, 45, NA, 78, 0, 3))

# count number of distinct values by row across columns -- NAs are all counted as unique values
test %>% 
  rowwise() %>% 
  mutate(unique =  n_distinct(c_across(var1:var3)))
#> # A tibble: 10 x 5
#> # Rowwise: 
#>       id  var1  var2  var3 unique
#>    <dbl> <dbl> <dbl> <dbl>  <int>
#>  1    90     6     6     6      1
#>  2    71     6     5     3      3
#>  3    13     6     4     4      2
#>  4    60     8     8     8      1
#>  5    20     9     7     7      2
#>  6    70    NA    12    45      3
#>  7     8    NA    NA    NA      1
#>  8     4     8     1    78      3
#>  9    41     8     9     0      3
#> 10    84    NA    NA     3      2

# Filter out rows with same value on colums -- NAs are all counted as unique values
test %>% 
  rowwise() %>% 
  filter(n_distinct(c_across(var1:var3)) == 1) 
#> # A tibble: 3 x 4
#> # Rowwise: 
#>      id  var1  var2  var3
#>   <dbl> <dbl> <dbl> <dbl>
#> 1    90     6     6     6
#> 2    60     8     8     8
#> 3     8    NA    NA    NA


# count number of distinct values by row across columns -- NAs excluded from count
test %>% 
  rowwise() %>% 
  mutate(unique =  n_distinct(c_across(var1:var3), na.rm = TRUE))
#> # A tibble: 10 x 5
#> # Rowwise: 
#>       id  var1  var2  var3 unique
#>    <dbl> <dbl> <dbl> <dbl>  <int>
#>  1    90     6     6     6      1
#>  2    71     6     5     3      3
#>  3    13     6     4     4      2
#>  4    60     8     8     8      1
#>  5    20     9     7     7      2
#>  6    70    NA    12    45      2
#>  7     8    NA    NA    NA      0
#>  8     4     8     1    78      3
#>  9    41     8     9     0      3
#> 10    84    NA    NA     3      1

# Filter out rows with same value on colums -- NAs excluded from count
test %>% 
  rowwise() %>% 
  filter(n_distinct(c_across(var1:var3), na.rm = TRUE) == 1) 
#> # A tibble: 3 x 4
#> # Rowwise: 
#>      id  var1  var2  var3
#>   <dbl> <dbl> <dbl> <dbl>
#> 1    90     6     6     6
#> 2    60     8     8     8
#> 3    84    NA    NA     3


# count number of distinct values by row across columns -- NAs excluded altogether
test %>% 
  tidyr::drop_na(var1:var3) %>%
  rowwise() %>% 
  mutate(unique =  n_distinct(c_across(var1:var3), na.rm = TRUE))
#> # A tibble: 7 x 5
#> # Rowwise: 
#>      id  var1  var2  var3 unique
#>   <dbl> <dbl> <dbl> <dbl>  <int>
#> 1    90     6     6     6      1
#> 2    71     6     5     3      3
#> 3    13     6     4     4      2
#> 4    60     8     8     8      1
#> 5    20     9     7     7      2
#> 6     4     8     1    78      3
#> 7    41     8     9     0      3

# Filter out rows with same value on colums -- NAs excluded altogether
test %>% 
  tidyr::drop_na(var1:var3) %>%
  rowwise() %>% 
  filter(n_distinct(c_across(var1:var3), na.rm = TRUE) == 1)
#> # A tibble: 2 x 4
#> # Rowwise: 
#>      id  var1  var2  var3
#>   <dbl> <dbl> <dbl> <dbl>
#> 1    90     6     6     6
#> 2    60     8     8     8

^{由reprex package (v2.0.1) 于 2022-01-14 创建}

【讨论】：

非常好！谢谢！

【解决方案7】：

还为自己找到了另一个看起来几乎像 Ronak 建议的解决方案。 data.table，需要一点dplyr 和matrixStats 包：

setDT(test)

test[, sd_var := matrixStats::rowSds(as.matrix(.SD)),
     .SDcols = c("var1", "var2", "var3"), by = 1:nrow(test)] %>% 
  .[sd_var == 0, , ]

   id var1 var2 var3 sd_var
1: 90    6    6    6      0
2: 60    8    8    8      0

【讨论】：