specifically delete some duplicated columns

Viewed 98

I was trying to write a function to drop repeated columns (with the same content), specifically comparing in pairs only those that share the same name plus a suffix.

For example: compare if "col1" and "col1_suffix" have the same content.

I have written some code but maybe there would be some alternatives to make it more readable? (thinking about the future readers)

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
2 Answers

What about the base R code below?

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]
  • Output
> 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

Update

A possible dplyr option (sorry that I am not good at pipes)

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

gives

    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

Below are two different suggestions building up on your original approach.

In the first approach I tried to build one consecutive pipe. We can use str_subset instead of the first purrr::keep and we can replace the second keep if we place the function inside map in .x[...]. We do not need intermediate variable if we wrap the final call to select into curly braces.

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(.))}
}

In the second approach I basically do the opposite and tear the pipe appart into intermediate variables: column names col_nms, original column names org_nms, an index idx, and the variables to remove rm_vars. Although much more verbose, this approach seems to be far more readable (at least to me) then any of the alternatives. Looking at the object names of the intermediate variables alone, gives us a picture about what is going. Also in terms of debugging, this approach will be easy to maintain. This is also one of the reasons for why the pipe operator is less used in packages and functions, than in interactive analysis.

# 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))
}

Created on 2021-08-18 by the reprex package (v2.0.1)

Finally, I wonder if it wouldn't be better to only delete one of the duplicate columns, instead of both. I would have a nice approach to do that, but apparently that is not intended, is it?

Related