Группирование фрейма данных в матрицы на основе переменной и транспонирование - PullRequest
Новая
       122

Группирование фрейма данных в матрицы на основе переменной и транспонирование

2 голосов
/ 07 мая 2020

Вот некоторые фиктивные данные, связанные с этой проблемой: 

    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, который мне нужно было бы различать guish между домашними хозяйствами): 

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», чтобы Если нужно, могу дать ссылку на любую дополнительную информацию?

Заранее большое спасибо!

Ответы [ 3 ]

1 голос
/ 07 мая 2020

Один из подходов:

  • Разделите ваш фрейм данных на HHID на группы
  • Создайте настраиваемую функцию для приема VAR столбцов, сделайте из нее квадратную матрицу и транспонировать
  • Используйте rbindlist, чтобы снова преобразовать в строки, используя fill, чтобы добавить NA, поскольку длины в списке различаются
  • Замените VAR столбцы (с 5 по 9) на новые VAR столбцов

Сообщите мне, работает ли это для вас. 

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)

Выход 

   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
0 голосов
/ 07 мая 2020

дополнительное решение 

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))
0 голосов
/ 07 мая 2020

Вы можете разделить данные на HHID, применить анонимную функцию для обработки матрицы, а затем разделить ее. 

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

Вот анонимная функция: 

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
}
...