r - 从左侧和右侧合并多个列

Question

给定以下数据

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

我正在尝试合并所有共享相同初始前缀名称的列(即合并 alpha_1、alpha_2、alpha_3、alpha_4 和合并 beta_1 beta_2 等)，但从左侧和右侧合并。也就是说，我想生成两个新变量，比如“alpha_left”和“alpha_right”，在这个例子中，它们的列分别是 (2, 2, 3) 和 (3, 4, 2) (第一个非缺失数据框左侧和右侧的元素)。

用户@akrun 为合并部分提供了一个很好的解决方案here ，但我不确定如何从左右合并创建两个新变量。

Answer 1

这是tidyverse 中的一个选项

1. reshape 为“长”格式 - pivot_longer
2. 按“ID”分组
3. summarise across 列 'alpha' 到 'charlie'
4. 获取列名 - cur_column()
5. 使用 left 和 right
中的第一个非 NA 元素创建一个 tibble
6. 通过附加“nm1”作为前缀来更改列名
7. 最后，unnest summarise
中创建的 list 列

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

-输出

# 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

---

或者使用 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)) 
})