主页 / coding / 问题 / 77780644
Accepted
fe108
Asked: 2024-01-08 21:35:45 +0800 CST

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

  • 772

我正在 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 相同，如果忽略顺序）

8 个回答

  1. 基础R：

    df$assessment <- apply(df, 1, \(x) identical(table(x[1:3]), table(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

    可重现的数据：

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

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

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

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

    • 11
  2. Best Answer

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

    df %>%
  rowwise() %>%
  mutate(result = all(sort(c_across(col1:col3)) == sort(c_across(col4:col6))))

# A tibble: 4 × 7
# Rowwise: 
  col1  col2  col3  col4  col5  col6  result
  <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
    • 8

  3. 避免迭代行

    通常，迭代行很慢，并且我发现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
            )
    )

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

    • 5

  4. 在基本 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
    • 4

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

    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
    • 4

  6. 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))
    • 3

  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
    • 3

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

    library(dplyr)
library(tidyr)

df %>%
  pivot_longer(cols = starts_with("col"), names_to = "col_set") %>%
  group_by(group = (row_number() - 1) %/% ncol(df) + 1) %>% 
  mutate(x = lead(value, 3)) %>% 
  na.omit() %>% 
  mutate(across(c(value, x), ~sort(.))) %>% 
  summarize(check = all(value == x), .groups = "drop") %>% 
  bind_cols(df) %>% 
  select(-group)

# A tibble: 4 × 7
  check col1  col2  col3  col4  col5  col6 
  <lgl> <chr> <chr> <chr> <chr> <chr> <chr>
1 FALSE a     a     a     a     a     b    
2 TRUE  b     b     a     b     a     b    
3 TRUE  c     d     a     d     c     a    
4 TRUE  d     a     a     a     d     a
    • 3

相关问题