将指定的列转置为具有分组数据的行

Question

我有一个这样的数据框：

  household person R01 R02 R03 R04 R05
1         1      1  NA   1   7   7  NA
2         1      2   1  NA   7   7  NA
3         1      3   3   3  NA  11  NA
4         1      4   3   3  11  NA  NA
5         2      1  NA   7  16  NA  NA
6         2      2   3  NA   7  NA  NA
7         2      3  15   3  NA  NA  NA

我正在尝试添加新列，这些新列是列 R01 到 R05 的分组转置版本，如下所示：

  household person R01 R02 R03 R04 R05 R01x R02x R03x R04x R05x
1         1      1  NA   1   7   7  NA   NA    1    3    3   NA
2         1      2   1  NA   7   7  NA    1   NA    3    3   NA
3         1      3   3   3  NA  11  NA    7    7   NA   11   NA
4         1      4   3   3  11  NA  NA    7    7   11   NA   NA
5         2      1  NA   7  16  NA  NA   NA    3   15   NA   NA
6         2      2   3  NA   7  NA  NA    7   NA    3   NA   NA
7         2      3  15   3  NA  NA  NA   16    7   NA   NA   NA

我尝试了各种使用 t() 并使用 gather() 和 spread() 进行整形的尝试，但我不认为它们的设计目的是为了执行此操作，因为我正在四处移动数据而不仅仅是重塑它。

示例代码

df <- data.frame(household = c(rep(1,4),rep(2,3)),
                 person = c(1:4,1:3),
                 R01 = c(NA,1,3,3,NA,3,15),
                 R02 = c(1,NA,3,3,7,NA,3),
                 R03 = c(7,7,NA,11,16,7,NA),
                 R04 = c(7,7,11,rep(NA,4)),
                 R05 = rep(NA,7))

Answer 1

部分使用，这里有一种方法。

根据他们的组拆分数据框
得到他们的列数至少有一个非NA（做转置很重要）
使用在第 2 步中创建的长度大小减小它们的大小，然后执行 transposition。
（再次）交换 colnames 和 rownames 在 transposition 中（首先）交换的 colnames 和 rownames。
将列与原始数据框绑定。

l <- split(df[startsWith(colnames(df), "R")], df$household)
len <- lapply(l, \(l) ncol(l) - (sum(sapply(l, \(x) any(!is.na(x))))))
l <- mapply(\(x, y) t(x[1:(length(x) - y)]), l, len, SIMPLIFY = F)

l <- lapply(l, function(x){
  r <- paste0(rownames(x), "x")
  c <- colnames(x)
  rownames(x) <- c
  colnames(x) <- r
  data.frame(x)
})

cbind(df, bind_rows(l))

输出

  household person R01 R02 R03 R04 R05 R01x R02x R03x R04x
1         1      1  NA   1   7   7  NA   NA    1    3    3
2         1      2   1  NA   7   7  NA    1   NA    3    3
3         1      3   3   3  NA  11  NA    7    7   NA   11
4         1      4   3   3  11  NA  NA    7    7   11   NA
5         2      1  NA   7  16  NA  NA   NA    3   15   NA
6         2      2   3  NA   7  NA  NA    7   NA    3   NA
7         2      3  15   3  NA  NA  NA   16    7   NA   NA

Answer 2

参考我的，可以转置group_modify()内的矩阵：

library(dplyr)

df %>%
  group_by(household) %>%
  group_modify(~ {
    mat <- t(.x[-1][1:nrow(.x)])
    colnames(mat) <- paste0(rownames(mat), "x")
    cbind(.x, mat)
  }) %>%
  ungroup()

# # A tibble: 7 × 11
#   household person   R01   R02   R03   R04 R05    R01x  R02x  R03x  R04x
#       <dbl>  <int> <dbl> <dbl> <dbl> <dbl> <lgl> <dbl> <dbl> <dbl> <dbl>
# 1         1      1    NA     1     7     7 NA       NA     1     3     3
# 2         1      2     1    NA     7     7 NA        1    NA     3     3
# 3         1      3     3     3    NA    11 NA        7     7    NA    11
# 4         1      4     3     3    11    NA NA        7     7    11    NA
# 5         2      1    NA     7    16    NA NA       NA     3    15    NA
# 6         2      2     3    NA     7    NA NA        7    NA     3    NA
# 7         2      3    15     3    NA    NA NA       16     7    NA    NA

Answer 3

df %>%
  left_join(pivot_longer(.,starts_with('R'), names_to = 'name', 
                         names_pattern = "(\d+)", values_drop_na = TRUE, 
                         names_transform = list(name = as.integer)) %>%
              pivot_wider(c(household,name), names_from = person,
                          names_glue = "R0{person}x"),
            by = c('household', person = 'name'))

 household person R01 R02 R03 R04 R05 R01x R02x R03x R04x
1         1      1  NA   1   7   7  NA   NA    1    3    3
2         1      2   1  NA   7   7  NA    1   NA    3    3
3         1      3   3   3  NA  11  NA    7    7   NA   11
4         1      4   3   3  11  NA  NA    7    7   11   NA
5         2      1  NA   7  16  NA  NA   NA    3   15   NA
6         2      2   3  NA   7  NA  NA    7   NA    3   NA
7         2      3  15   3  NA  NA  NA   16    7   NA   NA

另一个解决方案：

df %>%
  left_join(
    reshape2::recast(.,household+variable~person,id.var = c('household', 'person'))%>%
    group_by(household) %>%
    mutate(person = seq_along(variable), variable = NULL))

  household person R01 R02 R03 R04 R05  1  2  3  4
1         1      1  NA   1   7   7  NA NA  1  3  3
2         1      2   1  NA   7   7  NA  1 NA  3  3
3         1      3   3   3  NA  11  NA  7  7 NA 11
4         1      4   3   3  11  NA  NA  7  7 11 NA
5         2      1  NA   7  16  NA  NA NA  3 15 NA
6         2      2   3  NA   7  NA  NA  7 NA  3 NA
7         2      3  15   3  NA  NA  NA 16  7 NA NA

Answer 4

这是一种方法。

library(dplyr)

transposed_df <- df %>%
  group_split(household) %>%
  lapply(\(x){
    select(x, -1:-2) %>%
      t() %>%
      head(nrow(x)) %>%
      as_tibble() %>%
      setNames(paste0(names(x)[-1:-2], 'x'))
  }) %>%
  bind_rows()

df %>%
  bind_cols(transposed_df)
#>   household person R01 R02 R03 R04 R05 R01x R02x R03x R04x
#> 1         1      1  NA   1   7   7  NA   NA    1    3    3
#> 2         1      2   1  NA   7   7  NA    1   NA    3    3
#> 3         1      3   3   3  NA  11  NA    7    7   NA   11
#> 4         1      4   3   3  11  NA  NA    7    7   11   NA
#> 5         2      1  NA   7  16  NA  NA   NA    3   15   NA
#> 6         2      2   3  NA   7  NA  NA    7   NA    3   NA
#> 7         2      3  15   3  NA  NA  NA   16    7   NA   NA

将指定的列转置为具有分组数据的行

Transpose specified columns columns to rows with grouped data

r

dataframe

dplyr