基於變量將 dataframe 分組為矩陣並轉置

Question

以下是與此問題相關的一些模擬數據：

    structure(list(HHID = c(1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 3L, 
3L, 3L, 4L, 4L, 4L, 4L, 4L), PERS = c(1L, 2L, 3L, 4L, 5L, 1L, 
2L, 3L, 4L, 1L, 2L, 3L, 1L, 2L, 3L, 4L, 5L), MARSTAT = c(2L, 
2L, 1L, 1L, 1L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 5L, 1L, 1L
), SEX = c(1L, 2L, 2L, 1L, 1L, 2L, 1L, 2L, 1L, 2L, 2L, 1L, 2L, 
1L, 2L, 2L, 1L), VAR1 = c(NA, 1L, 4L, 4L, 4L, NA, 1L, 5L, 4L, 
NA, 4L, 4L, NA, 1L, 8L, 4L, 4L), VAR2 = c(NA, NA, 4L, 4L, 4L, 
NA, NA, 4L, 5L, NA, NA, 6L, NA, NA, 12L, 4L, 4L), VAR3 = c(NA, 
NA, NA, 6L, 6L, NA, NA, NA, 7L, NA, NA, NA, NA, NA, NA, 11L, 
11L), VAR4 = c(NA, NA, NA, NA, 6L, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, 6L), VAR5 = c(NA_integer_, NA_integer_, NA_integer_, 
NA_integer_, NA_integer_, NA_integer_, NA_integer_, NA_integer_, 
NA_integer_, NA_integer_, NA_integer_, NA_integer_, NA_integer_, 
NA_integer_, NA_integer_, NA_integer_, NA_integer_), FLAG = c(0L, 
0L, 0L, 1L, 0L, 0L, 0L, 1L, 1L, 0L, 1L, 0L, 0L, 0L, 0L, 1L, 1L
)), .Names = c("HHID", "PERS", "MARSTAT", "SEX", "VAR1", "VAR2", 
"VAR3", "VAR4", "VAR5", "FLAG"), row.names = c(NA, 17L), class = "data.frame")

對於我數據中的每個家庭，我想將下三角形中的值轉置到上三角形中，這樣對於每個家庭，我基本上都有一個對稱矩陣，對角線為 NA 或 0（對於此分析，0 和 NA 是可互換的） . 因此，基於上面的示例，我將尋找以下數據集：

    structure(list(HHID = c(1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 3L, 
3L, 3L, 4L, 4L, 4L, 4L, 4L), PERS = c(1L, 2L, 3L, 4L, 5L, 1L, 
2L, 3L, 4L, 1L, 2L, 3L, 1L, 2L, 3L, 4L, 5L), MARSTAT = c(2L, 
2L, 1L, 1L, 1L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 5L, 1L, 1L
), SEX = c(1L, 2L, 2L, 1L, 1L, 2L, 1L, 2L, 1L, 2L, 2L, 1L, 2L, 
1L, 2L, 2L, 1L), VAR1 = c(NA, 1L, 4L, 4L, 4L, NA, 1L, 5L, 4L, 
NA, 4L, 4L, NA, 1L, 8L, 4L, 4L), VAR2 = c(1L, NA, 4L, 4L, 4L, 
1L, NA, 4L, 5L, 4L, NA, 6L, 1L, NA, 12L, 4L, 4L), VAR3 = c(4L, 
4L, NA, 6L, 6L, 5L, 4L, NA, 7L, 4L, 6L, NA, 8L, 12L, NA, 11L, 
11L), VAR4 = c(4L, 4L, 6L, NA, 6L, 4L, 5L, 7L, NA, NA, NA, NA, 
4L, 4L, 11L, NA, 6L), VAR5 = c(4L, 4L, 6L, 6L, NA, NA, NA, NA, 
NA, NA, NA, NA, 4L, 4L, 11L, 6L, NA), FLAG = c(0L, 0L, 0L, 1L, 
0L, 0L, 0L, 1L, 1L, 0L, 1L, 0L, 4L, 4L, 11L, 1L, 1L)), .Names = c("HHID", 
"PERS", "MARSTAT", "SEX", "VAR1", "VAR2", "VAR3", "VAR4", "VAR5", 
"FLAG"), class = "data.frame", row.names = c(NA, -17L))

我已經能夠為一個家庭執行此操作，如下所示（盡管它錯過了我需要區分家庭的 HHID）：

HH1 <- df %>%
  filter(HHID == 1) %>%
  select(VAR1, VAR2, VAR3, VAR4, VAR5)

HH1 <- as.matrix(HH1)
HH1[is.na(HH1)] <- 0

T_HH1 <- t(HH1)
T_HH1[is.na(T_HH1)] <- 0

combo <- HH1 + T_HH1

A <- combo

但是，我將如何 go 為我的數據集中的多個家庭執行此操作，同時保留“HHID”和“PERS”信息，以便我可以在需要時鏈接任何額外的信息？

非常感謝您！

Answer 1

一種方法是：

• 按HHID將數據框拆分為組
• 創建自定義 function 以獲取VAR列，使其成為方陣，並轉置
• 使用rbindlist再次重構為行，使用fill添加NA ，因為列表中的長度不同
• 用新的VAR列替換VAR列（5 到 9）

讓我知道這是否適合您。

f <- function(m) {
  m <- m[, 1:nrow(m)]
  m[upper.tri(m)] <- t(m)[upper.tri(m)]
  m
}

df1[,5:9] <- rbindlist(lapply(split(df1[,5:9], df1$HHID), f), fill = TRUE)

Output

   HHID PERS MARSTAT SEX VAR1 VAR2 VAR3 VAR4 VAR5 FLAG
1     1    1       2   1   NA    1    4    4    4    0
2     1    2       2   2    1   NA    4    4    4    0
3     1    3       1   2    4    4   NA    6    6    0
4     1    4       1   1    4    4    6   NA    6    1
5     1    5       1   1    4    4    6    6   NA    0
6     2    1       2   2   NA    1    5    4   NA    0
7     2    2       2   1    1   NA    4    5   NA    0
8     2    3       1   2    5    4   NA    7   NA    1
9     2    4       1   1    4    5    7   NA   NA    1
10    3    1       1   2   NA    4    4   NA   NA    0
11    3    2       1   2    4   NA    6   NA   NA    1
12    3    3       1   1    4    6   NA   NA   NA    0
13    4    1       2   2   NA    1    8    4    4    0
14    4    2       2   1    1   NA   12    4    4    0
15    4    3       5   2    8   12   NA   11   11    0
16    4    4       1   2    4    4   11   NA    6    1
17    4    5       1   1    4    4   11    6   NA    1

Answer 2

您可以拆分 HHID 上的數據，應用匿名 function 來處理矩陣內容，然后將其拆分。

vars <- grep("^VAR", names(df))
df[, vars] <- unsplit(lapply(split(df[, vars], df$HHID), tt), df$HHID)

#    HHID PERS MARSTAT SEX VAR1 VAR2 VAR3 VAR4 VAR5 FLAG
# 1     1    1       2   1    0    1    4    4    4    0
# 2     1    2       2   2    1    0    4    4    4    0
# 3     1    3       1   2    4    4    0    6    6    0
# 4     1    4       1   1    4    4    6    0    6    1
# 5     1    5       1   1    4    4    6    6    0    0
# 6     2    1       2   2    0    1    5    4    0    0
# 7     2    2       2   1    1    0    4    5    0    0
# 8     2    3       1   2    5    4    0    7    0    0
# 9     2    4       1   1    4    5    7    0    0    0
# 10    3    1       1   2    0    4    4    0    0    0
# 11    3    2       1   2    4    0    6    0    0    0
# 12    3    3       1   1    4    6    0    0    0    0
# 13    4    1       2   2    0    1    8    4    4    0
# 14    4    2       2   1    1    0   12    4    4    0
# 15    4    3       5   2    8   12    0   11   11    0
# 16    4    4       1   2    4    4   11    0    6    1
# 17    4    5       1   1    4    4   11    6    0    1

---

這是匿名的 function：

tt <- function(x) {
  x <- x[, 1:nrow(x)]  # Make it square
  x[upper.tri(x)] <- 0 # replace upper triangle with 0
  x + t(x)             # add them together
}

Answer 3

額外的解決方案

library(purrr)
library(tidyverse)
df %>% 
  mutate_all(~ replace_na(., 0)) %>% 
  select(HHID, starts_with("VAR")) %>% 
  group_by(HHID) %>% 
  nest %>% 
  mutate(data = map(data, ~ .x + t(.x))) %>% 
  unnest(data) %>% 
  bind_cols(select(df, -starts_with("VAR"), -HHID))