检查 R 中的列集是否相同（按行顺序）

Question

我正在 R 工作，如果可能的话，我更喜欢 dplyr 解决方案。

样本数据：

data.frame(
  col1 = c("a", "b", "c", "d"),
  col2 = c("a", "b", "d", "a"),
  col3 = rep("a", 4L),
  col4 = c("a", "b", "d", "a"),
  col5 = c("a", "a", "c", "d"),
  col6 = rep(c("b", "a"), each = 2L)
)

第 1 列	列2	第 3 列	第 4 列	第5栏	第 6 栏
A	A	A	A	A	乙
乙	乙	A	乙	A	乙
C	d	A	d	C	A
d	A	A	A	d	A

问题

我想知道每一行的col1、 col2和col3是否与col4、col5和col6相同，但应忽略 col1 - col3 和 col4 - col6 的顺序。

因此，对于第 1 行，如果 col1 - col3 分别包含 a、a、b，并且 col4 - col6 分别包含 b、a、a，则将被视为匹配。

期望的结果

在“评估”栏中添加注释以帮助理解

第 1 列	列2	第 3 列	第 4 列	第5栏	第 6 栏	评估
A	A	A	A	A	乙	FALSE（因为 1-3 与 4-6 不同）
乙	乙	A	乙	A	乙	TRUE（因为 1-3 与 4-6 相同，如果忽略顺序）
C	d	A	d	C	A	TRUE（因为 1-3 与 4-6 相同，如果忽略顺序）
d	A	A	A	d	A	TRUE（因为 1-3 与 4-6 相同，如果忽略顺序）

Answer 1

基础R：

\n

df$assessment <- apply(df, 1, \\(x) identical(table(x[1:3]), table(x[4:6])))\n\n#   col1 col2 col3 col4 col5 col6 assessment\n# 1    a    a    a    a    a    b      FALSE\n# 2    b    b    a    b    a    b       TRUE\n# 3    c    d    a    d    c    a       TRUE\n# 4    d    a    a    a    d    a       TRUE\n

\n

可重现的数据：

\n

df <- data.frame(\n  col1 = c("a", "b", "c", "d"), col2 = c("a", "b", "d", "a"),\n  col3 = c("a", "a", "a", "a"), col4 = c("a", "b", "d", "a"),\n  col5 = c("a", "a", "c", "d"), col6 = c("b", "b", "a", "a")\n)\n

\n

PS:\n为什么用 table() 和 indentical 而不是 sort()、==、all()？我希望它能够随着列数的增加而更好地扩展（假设唯一值的数量较少）。例子：

\n

df <- as.data.frame(lapply(1:600, \\(x) sample(letters, size = 4000, replace = TRUE)))\nbench::mark(\n  apply(df, 1, \\(x) identical(table(x[1:300]), table(x[301:600]))),\n  apply(df, 1, \\(x) all(sort(x[1:300]) == sort(x[301:600])))\n)\n#   expression                                                   min median `itr/sec` mem_alloc \n#   <bch:expr>                                                 <bch> <bch:>     <dbl> <bch:byt>   \n# 1 apply(df, 1, function(x) identical(table(x[1:300]), table\xe2\x80\xa6 1.68s  1.68s     0.594     333MB   \n# 2 apply(df, 1, function(x) all(sort(x[1:300]) == sort(x[301\xe2\x80\xa6 9.01s  9.01s     0.111     191MB \n

\n

PS 2：替换table(x)为collapse::fcount(x, sort = TRUE)可大幅提升速度。

\n

Answer 2

使用 dplyr 您可以执行以下操作：

\n

df %>%\n  rowwise() %>%\n  mutate(result = all(sort(c_across(col1:col3)) == sort(c_across(col4:col6))))\n\n# A tibble: 4 \xc3\x97 7\n# Rowwise: \n  col1  col2  col3  col4  col5  col6  result\n  <chr> <chr> <chr> <chr> <chr> <chr> <lgl> \n1 a     a     a     a     a     b     FALSE \n2 b     b     a     b     a     b     TRUE  \n3 c     d     a     d     c     a     TRUE  \n4 d     a     a     a     d     a     TRUE  \n

\n

Answer 3

在基本 R 中，您可以使用vapplyand sort：

df$assessment <- vapply(seq_len(nrow(df)), \(x) 
                        all(sort(unlist(df[x,1:3])) == sort(unlist(df[x,4:6]))), logical(1))

输出：

#   col1 col2 col3 col4 col5 col6 assessment
# 1    a    a    a    a    a    b      FALSE
# 2    b    b    a    b    a    b       TRUE
# 3    c    d    a    d    c    a       TRUE
# 4    d    a    a    a    d    a       TRUE

Answer 4

Adplyr和vecsets选项可以是：

df %>%
 rowwise() %>%
 mutate(cond = vsetequal(c_across(col1:col3), c_across(col4:col6), multiple = TRUE))

  col1  col2  col3  col4  col5  col6  cond 
  <chr> <chr> <chr> <chr> <chr> <chr> <lgl>
1 a     a     a     a     a     b     FALSE
2 b     b     a     b     a     b     TRUE 
3 c     d     a     d     c     a     TRUE 
4 d     a     a     a     d     a     TRUE

与以下内容相同的想法purrr::pmap()：

df %>%
 mutate(cond = pmap_lgl(across(col1:col6), 
                        ~ vsetequal(c(...)[1:3], c(...)[4:6], multiple = TRUE)))

这是一个不合理的低效解决方案，但出于好奇：

df %>%
 rowwise() %>%
 mutate(cond = toString(sort(c_across(col1:col3))) == toString(sort(c_across(col4:col6))))

与以下内容相同的想法purrr:pmap()：

df %>%
 mutate(cond = pmap_lgl(across(col1:col6), 
                        ~ toString(sort(c(...)[1:3])) == toString(sort(c(...)[4:6]))))

使用 @SamR 的转置逻辑vecsets：

df %>%
 mutate(cond = map2_lgl(.x = across(col1:col3) %>% t() %>% data.frame(), 
                        .y = across(col4:col6) %>% t() %>% data.frame(), 
                        vsetequal))

使用相同的方法data.table::transpose()：

df %>%
 mutate(cond = map2_lgl(.x = data.table::transpose(across(col1:col3)), 
                        .y = data.table::transpose(across(col4:col6)), 
                        vsetequal))

Answer 5

避免迭代行

通常，迭代行很慢，并且我发现dplyr::rowwise()超过几千行的方法变得非常慢。它的使用速度往往更快，purrr::pmap()并且迭代列的速度也更快。

基本 R 方法

您可以转置相关列并迭代该列。

cols <- paste0("col", 1:6)

df$assessment <- df[cols] |>
    t() |>
    data.frame() |>
    sapply(\(x) all(sort(x[1:3]) == sort(x[4:6])))

#   col1 col2 col3 col4 col5 col6 assessment
# 1    a    a    a    a    a    b      FALSE
# 2    b    b    a    b    a    b       TRUE
# 3    c    d    a    d    c    a       TRUE
# 4    d    a    a    a    d    a       TRUE

tidyverse方法：从宽转长

或者，如果您想保留在tidyverse您可以从宽转换为长：

df %>%
    mutate(
        assessment = . |>
            mutate(id = row_number()) |>
            tidyr::pivot_longer(
                -id,
                names_to = "col",
                names_transform = readr::parse_number
            ) |>
            group_by(id) |>
            summarise(
                assessment = all(
                    sort(
                        value[col %in% 1:3]
                    ) ==
                        sort(
                            value[col %in% 4:6]
                        )
                )
            ) |>
            pull(
                assessment
            )
    )

这比较冗长，但我怀疑对于任何大小合理的数据集来说，它会快得多。

Answer 6

正如已经指出的，您应该避免行操作。这是一种使用辅助函数来比较集合的替代方案，该函数可以按行有效排序，以便比较完全矢量化。

library(dplyr)

f <- function(set1, set2) {
  s1 <- as.matrix(pick({{set1}}))
  s2 <- as.matrix(pick({{set2}}))
  row_sort <- function(m) matrix(m[order(row(m), m)], ncol = ncol(m), byrow = TRUE)
  !rowSums(row_sort(s1) != row_sort(s2)) > 0
}

dat %>%
  mutate(assessment = f(col1:col3, col4:col6))

  col1 col2 col3 col4 col5 col6 assessment
1    a    a    a    a    a    b      FALSE
2    b    b    a    b    a    b       TRUE
3    c    d    a    d    c    a       TRUE
4    d    a    a    a    d    a       TRUE

Answer 7

split.default用+尝试下面的代码colMeans

df$assessment <-
    colMeans(
        do.call(
            `==`,
            lapply(split.default(
                df,
                grepl("[1-3]$", names(df))
            ), \(d) apply(d, 1, sort))
        )
    ) == 1

这应该给

> df
  col1 col2 col3 col4 col5 col6 assessment
1    a    a    a    a    a    b      FALSE
2    b    b    a    b    a    b       TRUE
3    c    d    a    d    c    a       TRUE
4    d    a    a    a    d    a       TRUE

Answer 8

这句话虽然很啰嗦，但我无法抗拒。这是一个带有旋转功能的：

\n

library(dplyr)\nlibrary(tidyr)\n\ndf %>%\n  pivot_longer(cols = starts_with("col"), names_to = "col_set") %>%\n  group_by(group = (row_number() - 1) %/% ncol(df) + 1) %>% \n  mutate(x = lead(value, 3)) %>% \n  na.omit() %>% \n  mutate(across(c(value, x), ~sort(.))) %>% \n  summarize(check = all(value == x), .groups = "drop") %>% \n  bind_cols(df) %>% \n  select(-group)\n\n# A tibble: 4 \xc3\x97 7\n  check col1  col2  col3  col4  col5  col6 \n  <lgl> <chr> <chr> <chr> <chr> <chr> <chr>\n1 FALSE a     a     a     a     a     b    \n2 TRUE  b     b     a     b     a     b    \n3 TRUE  c     d     a     d     c     a    \n4 TRUE  d     a     a     a     d     a  \n

\n