Перераспределять значения столбцов внутри групп на основе критериев возраста и родства
Проблема: У меня есть набор данных о людях с указанием групп домохозяйств, отношений между членами домохозяйства, а также индивидуального возраста и дохода домохозяйства.
В настоящее время общий доход домохозяйства hy040g:hy050g вводится полностью для каждого члена домохозяйства, однако его необходимо перераспределить между отдельными лицами в соответствии с разными правилами (например, если в доме проживает несколько супружеских пар).
Пример фрейма данных
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
Код для воспроизведения
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))
Правила:
hy040g:hy090g распределяется (i) самому старшему члену семьи полностью, если он не состоит в браке, или (ii) поровну самому старшему человеку и его супругу, если он состоит в браке.
hy110g распределяется поровну среди всех членов домохозяйства в возрасте до 17 лет (или равномерно среди каждого члена домохозяйства, если никто не моложе 17 лет)
Ибо hy050g распределяется поровну среди всех членов домохозяйства в возрасте до 19 лет (равномерно для каждого члена домохозяйства, если никто не моложе 19 лет)
Желаемый результат
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
Подход:
До сих пор я пробовал подход, основанный на dplyr, создав вспомогательные столбцы (ниже), а затем перейдя к ifselse. Здесь я сталкиваюсь с проблемами (например, когда в семье проживает несколько супружеских пар), и я думаю, что может быть более элегантный способ отобразить их...
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)))
Ответы 2
Попробуй это
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"))
Ваш ответ можно улучшить, добавив дополнительную вспомогательную информацию. Пожалуйста, отредактируйте , добавив дополнительную информацию, например цитаты или документацию, чтобы другие могли подтвердить правильность вашего ответа. Более подробную информацию о том, как писать хорошие ответы, вы можете найти в справочном центре.
Это тоже должно завершить работу
library(dplyr)
library(stringr)
df %>%
group_by(household) %>%
mutate(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()
)) %>%
ungroup() %>%
select(household:r04, ends_with(".d"))
спасибо - это решение хорошо работает с данными моего примера. К сожалению, реальная среда, в которой я работаю, защищена и использует старую версию purrr (0.3.4), и решение выдает ошибки (вызвано ошибкой в
purrr:::stop_bad_type())