Problem: I have a dataframe of individuals, specifying household groups, relationships between household members, and individual ages, and household income.
Currently total household income hy040g:hy050gis entered in full for each individual in the household, however this needs to be redistributed to individuals according to different rules (e.g. where there are multiple married couples in a house).
Example Dataframe
household age r01 r02 r03 r04 hy040g hy060g hy070g hy080g hy090g hy110g hy050g
1 1 40 <NA> spouse parent parent 40 20 30 0 60 100 120
2 1 38 spouse <NA> parent parent 40 20 30 0 60 100 120
3 1 17 child child <NA> sibling 40 20 30 0 60 100 120
4 1 9 child child sibling <NA> 40 20 30 0 60 100 120
5 2 68 <NA> spouse parent grandparent 100 10 15 80 25 80 70
6 2 74 spouse <NA> parent grandparent 100 10 15 80 25 80 70
7 2 34 child child <NA> parent 100 10 15 80 25 80 70
8 2 2 grandchild grandchild child <NA> 100 10 15 80 25 80 70
9 3 89 <NA> parent <NA> <NA> 0 0 30 50 0 0 0
10 3 54 child <NA> <NA> <NA> 0 0 30 50 0 0 0
11 4 35 <NA> <NA> <NA> <NA> 30 40 0 0 0 25 10
Code to reproduce
df <- data.frame(household = c(rep(1,4), rep(2,4), rep(3, 2), 4),
age = c(40,38,17,9,68,74,34,2,89,54,35),
r01 = c(NA, "spouse", "child", "child", NA, "spouse", "child", "grandchild", NA, "child", NA),
r02 = c("spouse", NA, "child", "child", "spouse", NA, "child", "grandchild", "parent", NA, NA),
r03 = c("parent", "parent", NA, "sibling", "parent", "parent", NA, "child", rep(NA,3)),
r04 = c(rep("parent",2), "sibling", NA, rep("grandparent", 2), "parent", rep(NA,4)),
hy040g = c(rep(40,4), rep(100,4), 0, 0, 30),
hy060g = c(rep(20,4), rep(10,4), 0, 0, 40),
hy070g = c(rep(30,4), rep(15,4), 30, 30, 0),
hy080g = c(rep(0,4), rep(80,4), 50, 50, 0),
hy090g = c(rep(60,4), rep(25,4), rep(0,3)),
hy110g = c(rep(100,4), rep(80,4), 0, 0, 25),
hy050g = c(rep(120,4), rep(70,4), 0, 0, 10))
Rules:
hy040g:hy090g distributed (i) to the oldest person in household in full if they are unmarried, or (ii) evenly to the oldest person and their spouse if married.
hy110g distributed evenly among all household members aged under 17 (or evenly to every household member if nobody is aged under 17)
For hy050g distributed evenly among all household members aged under 19 (of evenly to every household member is nobody is aged under 19)
Desired Output
household age r01 r02 r03 r04 hy040g.d hy060g.d hy070g.d hy080g.d hy090g.d hy110g.d hy050g.d
1 1 40 <NA> spouse parent parent 20 10 15.0 0 30.0 0 0
2 1 38 spouse <NA> parent parent 20 10 15.0 0 30.0 0 0
3 1 17 child child <NA> sibling 0 0 0.0 0 0.0 0 60
4 1 9 child child sibling <NA> 0 0 0.0 0 0.0 100 60
5 2 68 <NA> spouse parent grandparent 50 5 7.5 40 12.5 0 0
6 2 74 spouse <NA> parent grandparent 50 5 7.5 40 12.5 0 0
7 2 34 child child <NA> parent 0 0 0.0 0 0.0 0 0
8 2 2 grandchild grandchild child <NA> 0 0 0.0 0 0.0 80 70
9 3 89 <NA> parent <NA> <NA> 0 0 30.0 50 0.0 0 0
10 3 54 child <NA> <NA> <NA> 0 0 0.0 0 0.0 0 0
11 4 35 <NA> <NA> <NA> <NA> 30 40 0.0 0 0.0 25 10
Approach:
So far I have tried a primarily dplyr approach, creating helper columns (below) then moving to ifselse. I'm running into issues here (e.g. where there are multiple married couples within a household), and I think there might be a more elegant way of mapping these across...
df %>%
rowwise() %>%
mutate(married = as.numeric(length(na.omit(match(c(r01, r02, r03, r04), "spouse")))) > 0,
u19 = age > 19,
u17 = age > 17) %>%
group_by(household) %>%
mutate(oldest = +(age == max(age)))
Try this
library(dplyr)
library(tidyr)
library(purrr)
library(stringr)
df %>%
nest(.by = household, .key = "data") %>%
mutate(data = map(
data,
~mutate(.x,
oldest = (age == max(age)),
spouse_oldest = str_detect(string = str_glue("r0{which(oldest)}") %>% get(),
pattern = "spouse"),
across(hy040g:hy090g, ~ifelse(oldest|spouse_oldest,
.x/sum(c(oldest, spouse_oldest), na.rm =TRUE),
0),
.names = "{.col}.d"),
# hy110g
hy110g.d = case_when(
sum(age < 17)!=0 ~ ifelse(age < 17, hy110g / sum(age< 17), 0),
TRUE ~ hy110g / n()
),
# hy050g
hy050.d = case_when(
sum(age < 19)!=0 ~ ifelse(age < 19, hy050g / sum(age < 19), 0),
TRUE ~ hy050g / n()
))
)) %>%
unnest(data) %>%
select(household:r04, ends_with(".d"))