Grouping a dataframe into matrices based on a variable and transposing

user_9811202 0
Viewed 56

Here is some mock data related to this problem:

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

For each household in my data, I want to transpose the values in the lower triangle into the upper triangle so that for each household I essentially have a symmetrical matrix with the diagonal either NA or 0 (for this analysis, 0 and NA are interchangeable). So based on the above example, I would be looking for the following dataset: 

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

I have been able to do this for one household, as follows (though it misses the HHID which I would need to distinguish between households):

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

However, how would I go about doing this for multiple households across my dataset, also keeping the "HHID" and "PERS" information so that I can link on any extra info if needed?

Thank you so much in advance!

transpose r matrix group-by
3 Answers

One approach is:

  • Split your data frame by HHID into groups
  • Create a custom function to take VAR columns, make it a square matrix, and transpose
  • Use rbindlist to reconstruct into rows again using fill to add NA as lengths in the list differ
  • Replace VAR columns (5 through 9) with new VAR columns

Let me know if this works for you. 

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
user_34606700

You can split the data on the HHID, apply an anonymous function to do the matrix stuff, then unsplit it.

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

Here's the anonymous 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
}
user_75145270

additional solution

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