Как создавать подгруппы на основе критериев групповых отношений
Контекст: У меня есть набор данных об отдельных людях, сгруппированных по домохозяйствам, который включает параметры отношений для каждого человека, описывающие их отношения с каждым другим членом домохозяйства.
Цель: я пытаюсь создать подгруппы внутри домохозяйств в соответствии с налоговыми единицами. Физические лица считаются единой налоговой единицей, если они являются (1) супругом или (2) ребенком-иждивенцем. Ребенком-иждивенцем считается ребенок до 18 лет или ребенок до 23 лет, являющийся студентом.
В пределах данного домохозяйства может существовать одна налоговая единица или несколько налоговых единиц. Другие супружеские пары или отдельные лица в каждом домохозяйстве, у которых нет детей-иждивенцев, образуют отдельные налоговые единицы.
Пример фрейма данных:
household name age student r01 r02 r03 r04 r05
1 1 john 60 0 <NA> spouse parent parent parent
2 1 mary 56 0 spouse <NA> parent parent parent
3 1 fiona 25 0 child child <NA> sibling sibling
4 1 tim 20 1 child child sibling <NA> sibling
5 1 nora 16 0 child child sibling sibling <NA>
6 2 terrence 58 0 <NA> spouse child-in-law step-child-in-law parent
7 2 siobhan 57 0 spouse <NA> child step-child parent
8 2 jim 90 0 parent-in-law parent <NA> spouse grand-parent
9 2 maire 87 0 step-parent-in-law step-parent spouse <NA> other
10 2 eoin 21 1 child child grand-child other <NA>
11 3 ronald 50 0 <NA> <NA> <NA> <NA> <NA>
Код для воспроизведения:
df <- data.frame(household = c(rep(1,5), rep(2,5), 3),
name = c("john", "mary", "fiona", "tim", "nora", "terrence", "siobhan", "jim", "maire", "eoin", "ronald"),
age = c(60, 56, 25, 20, 16, 58, 57, 90, 87, 21, 50),
student = c(0,0,0,1,0,0,0,0,0,1,0),
r01 = c(NA, "spouse", rep("child",3), NA, "spouse", "parent-in-law", "step-parent-in-law", "child", NA),
r02 = c("spouse", NA, rep("child", 3), "spouse", NA, "parent", "step-parent", "child", NA),
r03 = c(rep("parent",2), NA, rep("sibling", 2), "child-in-law", "child", NA, "spouse", "grand-child", NA),
r04 = c(rep("parent",2), "sibling", NA, "sibling", "step-child-in-law", "step-child", "spouse", NA, "other", NA),
r05 = c(rep("parent", 2), rep("sibling",2), NA, rep("parent", 2), "grand-parent", "other", NA, NA))
Подход: Для начала я создал переменные для перечисления порядка членов семьи и для идентификации зависимого ребенка.
df <- df %>%
group_by(household) %>%
mutate(fam_mem = row_number(),
dep_child = ifelse(age < 18 | (age < 23 & student == 1), 1, 0))
Следующим моим шагом было определение родителей детей-иждивенцев, используя match, однако именно здесь я застрял, поскольку match сообщит мне, являются ли они родителем, но я не могу связать это со статусом зависимости.
После этого я надеялся отсортировать по статусу зависимости и использовать lag, чтобы создать новое имя переменной домохозяйства, которое группируется в налоговые единицы, например. 1a, 2a, 2b, 3a.
Желаемый результат
household name age student r01 r02 r03 r04 r05 fam_mem dep_child household_tax_unit
<dbl> <chr> <dbl> <dbl> <chr> <chr> <chr> <chr> <chr> <int> <dbl> <chr>
1 1 john 60 0 NA spouse parent parent parent 1 0 1a
2 1 mary 56 0 spouse NA parent parent parent 2 0 1a
3 1 fiona 25 0 child child NA sibling sibling 3 0 1b
4 1 tim 20 1 child child sibling NA sibling 4 1 1a
5 1 nora 16 0 child child sibling sibling NA 5 1 1a
6 2 terrence 58 0 NA spouse child-in-law step-child-in-law parent 1 0 2a
7 2 siobhan 57 0 spouse NA child step-child parent 2 0 2a
8 2 jim 90 0 parent-in-law parent NA spouse grand-parent 3 0 2b
9 2 maire 87 0 step-parent-in-law step-parent spouse NA other 4 0 2b
10 2 eoin 21 1 child child grand-child other NA 5 1 2a
11 3 ronald 50 0 NA NA NA NA NA 1 0 3a
Джон и Мэри делят налоговую единицу со своими детьми-иждивенцами Тимом и Норой, а Фионе предоставляется собственная налоговая единица, поскольку она не является ребенком-иждивенцем.
Терренс и Шивобхан женаты и делят налоговую единицу со своим ребенком-иждивенцем Эоином, в то время как Джим и Мэр используют другую налоговую единицу, поскольку их ребенок / приемный ребенок не является иждивенцем и они женаты.
Рональд живет один, поэтому является единицей единого налога.
спасибо, я добавил желаемый результат выше
Ответы 2
Функция memb создает матрицу инцидентности mm из столбцов r и dep_child. Строка с логическим условием, отмеченным ##, является ключевой строкой, а следующая строка обеспечивает симметричность mm. Теперь дано mm, сформируем граф-граф g. Наконец, создайте вектор принадлежности как результат функции memb.
library(dplyr)
library(igraph)
memb <- function(dep_child, r) {
m <- as.matrix(r)[, 1:nrow(r), drop = FALSE]
m[is.na(m)] <- ""
mm <- m == "spouse" | (m == "child" & dep_child) ##
mm <- mm | t(mm)
g <- graph_from_adjacency_matrix(mm, mode = "undirected")
components(g)$membership
}
df %>%
mutate(unit = row_number(),
dep_child = +(age < 18 | (age < 23 & student == 1)),
memb = memb(dep_child, pick(starts_with("r"))),
memb = paste0(household, letters[memb]), .by = household)
предоставление
household name age student r01 r02 r03
1 1 john 60 0 <NA> spouse parent
2 1 mary 56 0 spouse <NA> parent
3 1 fiona 25 0 child child <NA>
4 1 tim 20 1 child child sibling
5 1 nora 16 0 child child sibling
6 2 terrence 58 0 <NA> spouse child-in-law
7 2 siobhan 57 0 spouse <NA> child
8 2 jim 90 0 parent-in-law parent <NA>
9 2 maire 87 0 step-parent-in-law step-parent spouse
10 2 eoin 21 1 child child grand-child
11 3 ronald 50 0 <NA> <NA> <NA>
r04 r05 unit dep_child memb
1 parent parent 1 0 1a
2 parent parent 2 0 1a
3 sibling sibling 3 0 1b
4 <NA> sibling 4 1 1a
5 sibling <NA> 5 1 1a
6 step-child-in-law parent 1 0 2a
7 step-child parent 2 0 2a
8 spouse grand-parent 3 0 2b
9 <NA> other 4 0 2b
10 other <NA> 5 1 2a
11 <NA> <NA> 1 0 3a
Возможно, просто рассмотреть student also? Например, измените строку мутации на: memb = memb(if_else(age<23 & student==1, 17,age), pick(starts_with("r"))),
Обновлено, чтобы исправить ошибки и привести выходные значения в соответствие с недавно опубликованными желаемыми выходными данными.
Вот подход, использующий igraph для определения групп. Обратите внимание, что это не охватывает все случаи (например, если родитель появляется позже пятого человека в домохозяйстве, это может неправильно отразить отношения между родителями и детьми). Но это работает для вашей выборки данных.
# create test data
df <- read.table(text = "household name age student r01 r02 r03 r04 r05
1 1 john 60 0 <NA> spouse parent parent parent
2 1 mary 56 0 spouse <NA> parent parent parent
3 1 fiona 25 0 child child <NA> sibling sibling
4 1 tim 20 1 child child sibling <NA> sibling
5 1 nora 16 0 child child sibling sibling <NA>
6 2 terrence 58 0 <NA> spouse child-in-law step-child-in-law parent
7 2 siobhan 57 0 spouse <NA> child step-child parent
8 2 jim 90 0 parent-in-law parent <NA> spouse grand-parent
9 2 maire 87 0 step-parent-in-law step-parent spouse <NA> other
10 2 eoin 21 1 child child grand-child other <NA>
11 3 ronald 50 0 <NA> <NA> <NA> <NA> <NA>
")
library(tidyverse)
library(igraph)
# add a person identifier to the data
df <- df %>%
mutate(person = row_number(), .by = household)
# pivot wider to define relationships between person and r_person
# filter to keep only required relationships
df_pivot <- df %>%
pivot_longer(starts_with("r"), names_to = "r_person")%>%
mutate(person = paste0(household, "-", person)) %>%
mutate(r_person = as.numeric(substring(r_person, 2), .by = household)) %>%
mutate(r_person = paste0(household, "-", r_person)) %>%
filter(r_person != person & (value %in% c("spouse") | (value == "child" & (age <= 23 | student == 1))))
# function to define groups using igraph. The result is a data.frame which can be
# joined to the original data
make_groups <- function(data) {
# create a graph from the pivoted data.frame
rel_graph <- graph_from_data_frame(select(data, r_person, person))
# The membership component is a named vector of group identifier for each
# connected group
group_vector <- components(rel_graph)$membership
# return a data frame with household, person (as per orignal data frame) along
# with group_id
data %>%
mutate(
group_id = group_vector[person]
) %>%
distinct(person, group_id) %>%
separate_wider_delim(person, names = c("household", "person"), delim = "-") %>%
mutate(person = as.integer(person), household = as.integer(household))
}
# use this function to create the lookup with the group_id variable
lookup_groups <- make_groups(df_pivot)
# join this with the original data, then re-calculate group_id for the ungrouped
# members of each household, and recode to household_id + letter format
want <- df %>%
left_join(lookup_groups, by = c("household", "person")) %>%
mutate(
group_id = if_else(is.na(group_id), 1000000000 + row_number(), group_id),
group_id = paste0(household, letters[as.factor(group_id)]),
.by = household
)
want
#> household name age student r01 r02 r03
#> 1 1 john 60 0 <NA> spouse parent
#> 2 1 mary 56 0 spouse <NA> parent
#> 3 1 fiona 25 0 child child <NA>
#> 4 1 tim 20 1 child child sibling
#> 5 1 nora 16 0 child child sibling
#> 6 2 terrence 58 0 <NA> spouse child-in-law
#> 7 2 siobhan 57 0 spouse <NA> child
#> 8 2 jim 90 0 parent-in-law parent <NA>
#> 9 2 maire 87 0 step-parent-in-law step-parent spouse
#> 10 2 eoin 21 1 child child grand-child
#> 11 3 ronald 50 0 <NA> <NA> <NA>
#> r04 r05 person group_id
#> 1 parent parent 1 1a
#> 2 parent parent 2 1a
#> 3 sibling sibling 3 1b
#> 4 <NA> sibling 4 1a
#> 5 sibling <NA> 5 1a
#> 6 step-child-in-law parent 1 2a
#> 7 step-child parent 2 2a
#> 8 spouse grand-parent 3 2b
#> 9 <NA> other 4 2b
#> 10 other <NA> 5 2a
#> 11 <NA> <NA> 1 3a
Created on 2024-07-12 with reprex v2.1.0
пожалуйста, покажите желаемый результат