如何在 R tidyverse 中仅将特定列从宽旋转到长？

Question

我正忙着弄清楚如何做一个我需要做的一些数据处理的特定支点。我有数据需要更宽地进行连接以避免乘法连接问题，但是我需要将其中的四列旋转回 long 才能获得最终数据集。实际数据相当笨拙，所以我将从一个我认为可以解决相同问题的玩具示例开始：

我现在拥有的数据：

A, B, C, D, E, F, G, H, I, J, K, L
w1, w2, w3, w4, l1, l2, l3, l4, l5, l6, l7, l8
w5, w6, w7, w8, l9, l10, l11, l12, l13, l14, l15, l16

我需要的格式：

A, B, C, D, M, N, O, P
w1, w2, w3, w4, l1, l2, l3, l4
w1, w2, w3, w4, l5, l6, l7, l8
w5, w6, w7, w8, l9, l10, l11, l12
w5, w6, w7, w8, l13, l14, l15, l16

基本上，我有一组数据，其中大部分列需要每 4 列加长（或“堆叠”）一次。一列需要l1, l5, l9, l13, l(4n+1)，下一列需要l2, l6, l10, l14, l(4n+2) 等。如果这样可以使枢轴更容易，我不介意重新排列列，但我不知道如何让R 为我做这件事。 pivot_longer 和 pivot_longer_spec 上的文档假定数据......比我必须使用的数据好一点，他们的例子对这项任务没有帮助。他们似乎还假设重要数据包含在列名中，但对于我拥有的这些数据，情况并非如此——我只需要特定配置中单元格中的数据。

实际的宽数据集如下所示：https://i.stack.imgur.com/hRhBw.png，所以我需要它的样子

[wide columns], T1.y, data.consensus_text_T2, data.consensus_text_T3, data.consensus_text_T4,
[wide columns], T7, data.consensus_text_T8.y, data.consensus_text_T9.y, data.consensus_text_T10.y,
[wide columns], T13, data.consensus_text_T14, data.consensus_text_T15, data.consensus_text_T16

以此类推，直到它在 T1.y 处重复，在 14 行后的宽列中出现新值。

感谢您的帮助！

Answer 1

1) pivot 假设 dd 在最后的注释中以可重复的方式定义转换为长格式，为新名称创建一个 name 列，并使用 gl 定义一个 i 列。 gl 的参数是每个输入行应该映射到的行数和列数（不包括 id 列）以及长格式数据帧中的行数。它等于 c(1,1,1,1,2,2,2,2) 重复到长格式数据帧中的行数。最后转换回宽格式。

library(dplyr)
library(tidyr)

dd %>%
  pivot_longer(-(A:D)) %>%
  mutate(name = rep(c("M", "N", "O", "P"), length = n()), i = gl(2, 4, n())) %>%
  pivot_wider(c(A:D, i)) %>%
  select(-i)

给予：

# A tibble: 4 x 8
  A     B     C     D     M     N     O     P    
  <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
1 w1    w2    w3    w4    l1    l2    l3    l4   
2 w1    w2    w3    w4    l5    l6    l7    l8   
3 w5    w6    w7    w8    l9    l10   l11   l12  
4 w5    w6    w7    w8    l13   l14   l15   l16  

1a)或更笼统地说：

nid <- 4  # first nid columns are id columns
newnames <- c("M", "N", "O", "P")

k <- length(newnames)
nc <- ncol(dd)
ids <- names(dd)[1:nid]
dd %>%
  pivot_longer(-(1:nid)) %>%
  mutate(name = rep(newnames, length = n()), 
         i = gl((nc-nid)/k, k, n())) %>%
  pivot_wider(all_of(c(ids, "i"))) %>%
  select(-i)

2) group_modify 另一种方法是逐行并显式构造每对输出行。

dd %>%
 group_by(across(A:D)) %>%
 group_modify(~ with(., tibble(M=c(E,I), N=c(F,J), O=c(G,L), P=c(H,L)))) %>%
 ungroup

2a)或更一般地

newnames <- c("M", "N", "O", "P")
dd %>%
 group_by(across(A:D)) %>%
 group_modify(~ matrix(unlist(.), ncol = length(newnames), byrow = TRUE) %>%
   as.data.frame %>%
   setNames(newnames)
 ) %>%
 ungroup

3)第三种方法是定义两半，然后通过左连接将它们交错。

id <- 1:4
i1 <- 5:8    # non-id columns that go in 1st row of pair
i2 <- 9:12   # non-id columns that go in 2nd row of pair

d1 <- dd[-i2]
d2 <- dd[-i1]
names(d1)[-id] <- names(d2)[-id] <- c("M", "N", "O", "P")
left_join(dd[id], bind_rows(d1, d2))

3a) 或更笼统地说：

nid <- 4  # no of id columns
newnames <- c("M", "N", "O", "P")

nc <- ncol(dd)
k <- length(newnames)
s <- split.default(dd, c(rep(0, nid), gl((nc - nid) / k, k)))
L <- lapply(s[-1], setNames, newnames)
r <- bind_rows(lapply(L, function(x) bind_cols(s[[1]], x)))
left_join(s[[1]], r)

注意

dd <- 
structure(list(A = c("w1", "w5"), B = c("w2", "w6"), C = c("w3", 
"w7"), D = c("w4", "w8"), E = c("l1", "l9"), F = c("l2", "l10"
), G = c("l3", "l11"), H = c("l4", "l12"), I = c("l5", "l13"), 
    J = c("l6", "l14"), K = c("l7", "l15"), L = c("l8", "l16"
    )), class = "data.frame", row.names = c(NA, -2L))