【问题标题】：specifically delete some duplicated columns专门删除一些重复的列
【发布时间】：2021-10-14 10:04:20
【问题描述】：

我试图编写一个函数来删除重复的列（具有相同的内容），专门成对比较那些具有相同名称和后缀的人。

例如：比较"col1"和"col1_suffix"是否有相同的内容。

我已经编写了一些代码，但也许有一些替代方案可以使其更具可读性？（考虑未来的读者）

library(tidyverse)


df <- data.frame(
  stringsAsFactors = FALSE,
  id = c("3333", "7658", "7759",
         "7934", "3327", "4738"),
  turn = c("manana", "tarde", "tarde", "tarde",
            "tarde", "manana"),
  answ_parte_general = c(78.75, 78.75, 76.75, 76.5, 76.5, 75.25),
  answ_global = c(78.75, 78.75, 76.75, 76.5, 76.5, 75.25),
  answ_r = c(78.75, 78.75, 76.75, 76.5, 76.5, 75.25),
  result = c(
    "passed",
    "passed",
    "passed",
    "passed",
    "passed",
    "passed"
  ),
  points = c(29.574, 29.574, 28.892, 28.807, 28.807,
             28.381),
  answ_r_previous = c(76.75, 77.75, 64.75, 74.5, 68.5, 72.25),
  result_previous = c(
    "passed",
    "passed",
    "passed",
    "passed",
    "passed",
    "passed"
  ),
  points_previous = c(28.892, 29.233, 24.801, 28.125, 26.08,
                      27.358),
  diff_points = c(2, 1, 12, 2, 8, 3)
)
df
#>     id   turn answ_parte_general answ_global answ_r result points
#> 1 3333 manana              78.75       78.75  78.75 passed 29.574
#> 2 7658  tarde              78.75       78.75  78.75 passed 29.574
#> 3 7759  tarde              76.75       76.75  76.75 passed 28.892
#> 4 7934  tarde              76.50       76.50  76.50 passed 28.807
#> 5 3327  tarde              76.50       76.50  76.50 passed 28.807
#> 6 4738 manana              75.25       75.25  75.25 passed 28.381
#>   answ_r_previous result_previous points_previous diff_points
#> 1           76.75          passed          28.892           2
#> 2           77.75          passed          29.233           1
#> 3           64.75          passed          24.801          12
#> 4           74.50          passed          28.125           2
#> 5           68.50          passed          26.080           8
#> 6           72.25          passed          27.358           3

drop_repeated_columns <- function(df, suffix = "_previous") {
  columns_to_drop <- colnames(df) %>%
    purrr::keep( ~ str_detect(., suffix)) %>%
    purrr::keep( ~ purrr::map_lgl(., ~ identical(pull(df, .),
                                                 pull(
                                                   df, str_remove(., suffix)
                                                 )))) %>%
    c(., str_remove(., suffix))
  df %>%
    select(-all_of(columns_to_drop))
}
df %>%
  drop_repeated_columns()
#>     id   turn answ_parte_general answ_global answ_r points answ_r_previous
#> 1 3333 manana              78.75       78.75  78.75 29.574           76.75
#> 2 7658  tarde              78.75       78.75  78.75 29.574           77.75
#> 3 7759  tarde              76.75       76.75  76.75 28.892           64.75
#> 4 7934  tarde              76.50       76.50  76.50 28.807           74.50
#> 5 3327  tarde              76.50       76.50  76.50 28.807           68.50
#> 6 4738 manana              75.25       75.25  75.25 28.381           72.25
#>   points_previous diff_points
#> 1          28.892           2
#> 2          29.233           1
#> 3          24.801          12
#> 4          28.125           2
#> 5          26.080           8
#> 6          27.358           3

【问题讨论】：

标签： r dataframe tidyverse subset

【解决方案1】：

下面的基本 R 代码呢？

u <- do.call(
  c,
  lapply(
    split.default(df, gsub("_previous", "", names(df))),
    function(x) names(x[!any(duplicated(as.list(x)))])
  )
)

dfout <- df[names(df) %in% u]

输出

> dfout
    id   turn answ_parte_general answ_global answ_r points answ_r_previous
1 3333 manana              78.75       78.75  78.75 29.574           76.75
2 7658  tarde              78.75       78.75  78.75 29.574           77.75
3 7759  tarde              76.75       76.75  76.75 28.892           64.75
4 7934  tarde              76.50       76.50  76.50 28.807           74.50
5 3327  tarde              76.50       76.50  76.50 28.807           68.50
6 4738 manana              75.25       75.25  75.25 28.381           72.25
  points_previous diff_points
1          28.892           2
2          29.233           1
3          24.801          12
4          28.125           2
5          26.080           8
6          27.358           3

更新

一个可能的dplyr 选项（对不起，我不擅长管道）

df %>%
  select(which(
    names(.) %in% ((.) %>%
      split.default(str_remove(names(.), "_previous")) %>%
      map(~ names(.x[!any(duplicated(unclass(.x)))])) %>%
      unlist())
  ))

给予

    id   turn answ_parte_general answ_global answ_r points answ_r_previous
1 3333 manana              78.75       78.75  78.75 29.574           76.75
2 7658  tarde              78.75       78.75  78.75 29.574           77.75
3 7759  tarde              76.75       76.75  76.75 28.892           64.75
4 7934  tarde              76.50       76.50  76.50 28.807           74.50
5 3327  tarde              76.50       76.50  76.50 28.807           68.50
6 4738 manana              75.25       75.25  75.25 28.381           72.25
  points_previous diff_points
1          28.892           2
2          29.233           1
3          24.801          12
4          28.125           2
5          26.080           8
6          27.358           3

【讨论】：

这是一个不错的选择 ? 简洁明了。我试图用 tidyverse 语法获得一个（因为我团队中的大多数人都喜欢它）。
@crestor 也许你可以查看我的更新。
我选择了您的答案，因为它非常有趣和创新。尽管源代码最终将是两个建议答案的组合。（我都赞成。）

【解决方案2】：

以下是基于您的原始方法的两个不同建议。

在第一种方法中，我尝试构建一个连续的管道。我们可以使用str_subset 代替第一个purrr::keep，如果我们将函数放在map 中的.x[...] 中，我们可以替换第二个keep。如果我们将对select 的最终调用包装到花括号中，则不需要中间变量。

library(tidyverse)

# one pipe
drop_repeated_columns <- function(df, suffix = "_previous") {

    colnames(df) %>%
    str_subset(., suffix) %>%
    map(., ~ .x[identical(pull(df, .), pull(df, str_remove(., suffix)))]) %>% 
    unlist %>% 
    c(., str_remove(., suffix)) %>% 
    {select(df, -all_of(.))}
}

在第二种方法中，我基本上做相反的事情，并将管道装置撕成中间变量：列名col_nms、原始列名org_nms、索引idx，以及要删除的变量rm_vars。虽然更冗长，但这种方法似乎比任何替代方法都更具可读性（至少对我而言）。仅查看中间变量的对象名称，就可以了解正在发生的事情。同样在调试方面，这种方法将易于维护。这也是为什么管道运算符在包和函数中的使用比在交互式分析中少的原因之一。

# without pipes but readable
drop_repeated_columns <- function(df, suffix = "_previous") {
  
  col_nms <- str_subset(colnames(df), suffix)
  org_nms <- str_remove(col_nms, suffix)
  
  idx <- map2_lgl(col_nms,
                  org_nms,
                 ~ identical(pull(df, .x), pull(df, .y)))
  
  rm_vars <- c(org_nms[idx],
               col_nms[idx])
  
  select(df, -all_of(rm_vars))
}

^{由reprex package (v2.0.1) 于 2021-08-18 创建}

最后，我想知道是否只删除一个重复的列而不是两个都更好。我会有一个很好的方法来做到这一点，但显然这不是故意的，是吗？

【讨论】：

酷！我想我可以从你的回答中学到很多东西。点赞！
@ThomasIsCoding：我也喜欢在data.frame 上使用`split.default` 的想法。还没见过这个技巧+1！
您的第一个建议相当不错。（我可以确认，如果它们相同，则目的是删除两列。目的是仅显示同一数据框的两个版本之间的差异。）