Coalescing multiple columns from both the left and right side

Viewed 111

Given the following data

df1 <- structure(list(ID = 1:3, alpha_1 = c(2L, 2L, 3L), 
alpha_2 = c(1L, 2L,
3L), alpha_3 = c(4L, 4L, 2L), alpha_4 = c(3L, NA, NA), beta_1 = c(NA,
2L, NA), beta_2 = c(3L, NA, 2L), charlie_1 = c(1L, NA, 1L), charlie_2 = c(NA,
2L, NA)), class = "data.frame", row.names = c(NA, -3L))

I'm trying to coalesce all columns sharing the same initial prefix name (i.e. coalesce alpha_1, alpha_2, alpha_3, alpha_4, and coalesce beta_1 beta_2, etc.), but from both the left and right sides. That is, I want to generate two new variables, say 'alpha_left' and 'alpha_right', whose columns would be, in this example, (2, 2, 3) and (3, 4, 2) respectively (first non-missing elements from the left and right side of the dataframe).

User @akrun offered a great solution for the coalescing part here, but I'm unsure how to create two new variables from both the left and right coalesces.

4 Answers

Here is an option in tidyverse

  1. Reshape to 'long' format - pivot_longer
  2. Grouped by 'ID'
  3. Do the summarise across the columns 'alpha' till 'charlie'
  4. Get the column name - cur_column()
  5. Create a tibble with the first non-NA element from the left and the right
  6. Change the column names by appending the 'nm1' as prefix
  7. Finally, unnest the list columns created in summarise
library(dplyr)
library(tidyr)
library(stringr)
df1 %>%
      pivot_longer(cols = contains("_"), 
         names_to = c( ".value", "grp"), names_sep = "_") %>% 
      group_by(ID) %>%
      summarise(across(alpha:charlie, ~ {
          nm1 <- cur_column()
        tbl1 <- tibble(left= .[complete.cases(.)][1], 
                     right = rev(.)[complete.cases(rev(.))][1]);
        names(tbl1) <- str_c(nm1, "_", names(tbl1))
        list(tbl1)})) %>%
     unnest(c(alpha, beta, charlie))

-output

# A tibble: 3 x 7
     ID alpha_left alpha_right beta_left beta_right charlie_left charlie_right
  <int>      <int>       <int>     <int>      <int>        <int>         <int>
1     1          2           3         3          3            1             1
2     2          2           4         2          2            2             2
3     3          3           2         2          2            1             1

Or using base R

lst1 <- lapply(split.default(df1[-1], sub("_\\d+$", "", names(df1)[-1])), 
         function(x) {
        x1 <- apply(x, 1, function(y) {
                     y1 <- na.omit(y)
         if(length(y1) > 1 ) y1[c(1, length(y1))] else y1[1]
           })
       if(is.vector(x1)) as.data.frame(matrix(x1)) else as.data.frame(t(x1)) 
})

You could also do:

df1[-1] %>%
  split.default(sub("_\\d+", "", names(.))) %>%
  imap_dfc(~data.frame(right = coalesce(!!!.x),
                       left = coalesce(!!!rev(.x))) %>%
            set_names(paste(.y, names(.), sep="_")))

  alpha_right alpha_left beta_right beta_left charlie_right charlie_left
1           2          3          3         3             1            1
2           2          4          2         2             2            2
3           3          2          2         2             1            1

One more approach not as elegant as @Onyambu's

library(tidyverse)

df1[-1] %>%
  split.default(sub("_\\d+", "", names(.))) %>%
  imap_dfc(~ .x %>% rowwise() %>%
            mutate(!!paste0(.y, '_left') := head(na.omit(c_across(everything())),1), 
                   !!paste0(.y, '_right') := tail(na.omit(c_across(!last_col())),1),
                   .keep = 'none' )
            )
#> # A tibble: 3 x 6
#> # Rowwise: 
#>   alpha_left alpha_right beta_left beta_right charlie_left charlie_right
#>        <int>       <int>     <int>      <int>        <int>         <int>
#> 1          2           3         3          3            1             1
#> 2          2           4         2          2            2             2
#> 3          3           2         2          2            1             1

Created on 2021-06-19 by the reprex package (v2.0.0)

Another option

library(tidyverse)
df1 <- structure(list(ID = 1:3, alpha_1 = c(2L, 2L, 3L), 
                      alpha_2 = c(1L, 2L,
                                  3L), alpha_3 = c(4L, 4L, 2L), alpha_4 = c(3L, NA, NA), beta_1 = c(NA,
                                                                                                    2L, NA), beta_2 = c(3L, NA, 2L), charlie_1 = c(1L, NA, 1L), charlie_2 = c(NA,
                                                                                                                                                                              2L, NA)), class = "data.frame", row.names = c(NA, -3L))

df1 %>% 
  pivot_longer(cols = -ID, names_sep = "_", names_to = c(".value", "set")) %>% 
  group_by(ID) %>% 
  fill(alpha:charlie, .direction = "updown") %>% 
  filter(set %in% range(set)) %>% 
  mutate(set = c("left", "right")) %>% 
  pivot_wider(id_cols = ID, names_from = set, values_from = alpha:charlie)
#> # A tibble: 3 x 7
#> # Groups:   ID [3]
#>      ID alpha_left alpha_right beta_left beta_right charlie_left charlie_right
#>   <int>      <int>       <int>     <int>      <int>        <int>         <int>
#> 1     1          2           3         3          3            1             1
#> 2     2          2           4         2          2            2             2
#> 3     3          3           2         2          2            1             1

Created on 2021-06-20 by the reprex package (v2.0.0)

Related