如何在 R 中进行嵌套的 2 级整形？

Question

我目前正在做一个调查项目，询问受访者的经济活动。 所以我们会询问他们拥有的工作/业务，并且由于一些工作/业务是季节性的，我们会询问他们每个季节的收入、成本和利润。

我有点坚持如何在 R 中从宽到长重塑这个。 这就是我所拥有的：

受访者姓名	工作名称_1	季节性_type_1	工作名称_2	季节性类型_2	cst_1_1	rev_1_1	cst_1_2	rev_1_2	cst_2_1	rev_2_1	cst_2_2	rev_2_2
詹姆士	农民	前高后低	老师	活跃/不活跃	5000	6000	2000	3000	100	200	0	0
爱丽丝	牲畜饲养	前高后低	理发师	活跃/不活跃	100000	200000	20000	30000	5000	7000	2000	0

我希望 output 看起来像：

受访者姓名	工作编号	工作名称	季数	季节	成本	收入
詹姆士	1	农民	1	高的	5000	6000
詹姆士	1	农民	2	低的	2000	3000
詹姆士	2	老师	1	积极的	100	200
詹姆士	2	老师	2	不活跃	0	0
爱丽丝	1	牲畜饲养	1	高的	100000	200000
爱丽丝	1	牲畜饲养	2	低的	2000	3000
爱丽丝	2	理发师	1	积极的	5000	7000
爱丽丝	2	理发师	2	不活跃	2000	0

任何人都知道如何做到这一点？ 我使用了熔化 function 但不知道如何不丢失 2 级信息。 融化给我的只是job_season_1，job_season_2，job_season_3，job_season_4，它们丢失了工作和季节之间的配对信息。

非常感谢！

这是上表中的玩具数据集：

survey = data.frame(respondent_name = c("James", "Alice"),
                    job_name_1 = c("farmer", "livestock rearing"),
                    seasonality_type_1 = c("high / low", "high / low"), 
                    job_name_2 = c("teacher", "barber"),
                    seasonality_type_2 = c("active / inactive", "active / inactive"),
                    cst_1_1 = c(5000, 100000),
                    rev_1_1 = c(6000, 200000),
                    cst_1_2 = c(2000, 20000),
                    rev_1_2 = c(3000, 30000),
                    cst_2_1 = c(100, 5000),
                    rev_2_1 = c(200, 7000),
                    cst_2_2 = c(0, 2000),
                    rev_2_2 = c(0, 0)
                    )

Answer 1

首先将季节性类型 1 和类型 2 分成 2 列，然后melt ，对于融化，我使用列号，因为您的列名太长

library(data.table)
survey[, c("s1", "s2") := tstrsplit(seasonality_type_1, "/")]
survey[, c("s1_2", "s2_2") := tstrsplit(seasonality_type_2, "/")]
melt(survey, id.vars=1, measure.vars=list(c(2,2,4,4),c(14,15,16,17), c(6,8,10,12), c(7,9,11,13)))

Answer 2

这使用 tidyverse 而不是 data.table，但可以让你大部分时间......

library(tidyverse)

survey2 <- survey %>%
  separate(seasonality_type_1, 
       sep = " / ", 
       into = c("season_1_1", "season_1_2")) %>%
  separate(seasonality_type_2,
       sep = " / ",
       into = c("season_2_1", "season_2_2")) %>%
  pivot_longer(cols = starts_with("job_name"),
           names_to = "job_number",
           names_prefix = "job_name_",
           values_to = "job"
          )

  survey2_1 <- survey2 %>%
    select(respondent_name, job_number, job, ends_with("_1")) %>%
    mutate(
      season = 1,
      cost = ifelse(job_number == 1, cst_1_1, cst_2_1)
    )

  survey2_2 <- survey2 %>%
    select(respondent_name, job_number, job, ends_with("_2")) %>%
    mutate(
      season = 2,
      cost = ifelse(job_number == 1, cst_1_2, cst_2_2)
    )

还缺少什么：

• 收入与成本的类似计算
• 删除不需要的列，在survey2_1 和survey2_2 中以相似的列名结尾
• 加入（rbind）survey2_1 和survey2_2

Answer 3

简短的回答

library(tidyverse)
seasonality_desc <- tribble(
  ~ job_number, ~ season_number, ~ season,
  1,            1,               "high",
  1,            2,               "low",
  2,            1,               "active",
  2,            2,               "inactive"
)
survey %>% 
  select(!contains("seasonality_type")) %>% 
  rename_with(
    ~ str_replace(.x, pattern = "^(cst|rev)_([0-9])_([0-9])$", 
                  replacement = "\\1_\\3_\\2"), 
    .cols = matches("^(cst|rev)_[0-9]_[0-9]$")
  ) %>% 
  pivot_longer(
    !respondent_name, names_to = c(".value", "job_number"), 
    names_pattern = "(.*)_([0-9]+)$", 
    names_transform = list(job_number = as.numeric)
  ) %>% 
  pivot_longer(
    matches("cst|rev"), names_to = c(".value", "season_number"),
    names_sep = "_", names_transform = list(season_number = as.numeric)
  ) %>% 
  left_join(seasonality_desc, by = c("job_number", "season_number")) %>% 
  select(
    respondent_name, job_number, job_name, season_number, season, cost = cst, 
    revenue = rev
  )
#> # A tibble: 8 × 7
#>   respondent_name job_number job_name       season_number season    cost revenue
#>   <chr>                <dbl> <chr>                  <dbl> <chr>    <dbl>   <dbl>
#> 1 James                    1 farmer                     1 high       5e3    6000
#> 2 James                    1 farmer                     2 low        2e3    3000
#> 3 James                    2 teacher                    1 active     1e2     200
#> 4 James                    2 teacher                    2 inactive   0         0
#> 5 Alice                    1 livestock rea…             1 high       1e5  200000
#> 6 Alice                    1 livestock rea…             2 low        2e4   30000
#> 7 Alice                    2 barber                     1 active     5e3    7000
#> 8 Alice                    2 barber                     2 inactive   2e3       0

^{由代表 package (v2.0.1) 于 2022 年 2 月 4 日创建}

长答案

我们将使用tidyr的pivot_longer()的两个实例来延长数据集，但在这之间还需要一些其他的争论。

删除元数据

首先， seasonality_type_1和seasonality_type_2不提供任何个人级别的信息，而只是指定与job_number上下文中不同季节编号相对应的标签的元数据。 因此，手动创建一个包含这些标签的 tibble，并从原始数据集中删除元数据：

library(tidyverse)

seasonality_desc <- tribble(
  ~ job_number, ~ season_number, ~ season,
  1,            1,               "high",
  1,            2,               "low",
  2,            1,               "active",
  2,            2,               "inactive"
)

survey2 <-  select(survey, !contains("seasonality_type"))
knitr::kable(survey2)

受访者姓名	工作名称_1	工作名称_2	cst_1_1	rev_1_1	cst_1_2	rev_1_2	cst_2_1	rev_2_1	cst_2_2	rev_2_2
詹姆士	农民	老师	5e+03	6e+03	2000	3000	100	200	0	0
爱丽丝	牲畜饲养	理发师	1e+05	2e+05	20000	30000	5000	7000	2000	0

第一个pivot：作业号

第一个 pivot 按作业名称和编号。 不幸的是，工作编号出现在cst / rev列名的中间，这与pivot_longer()配合得不好。 您可以手动将工作编号与季节编号切换，但如果您正在寻找一种自动化的方式，这是使用正则表达式的一种方法：

survey3 <- rename_with(
  survey2,
  ~ str_replace(.x, pattern = "^(cst|rev)_([0-9])_([0-9])$", 
                replacement = "\\1_\\3_\\2"), 
  .cols = matches("^(cst|rev)_[0-9]_[0-9]$")
)
knitr::kable(survey3)

受访者姓名	工作名称_1	工作名称_2	cst_1_1	rev_1_1	cst_2_1	rev_2_1	cst_1_2	rev_1_2	cst_2_2	rev_2_2
詹姆士	农民	老师	5e+03	6e+03	2000	3000	100	200	0	0
爱丽丝	牲畜饲养	理发师	1e+05	2e+05	20000	30000	5000	7000	2000	0

现在注意一个模式：除了respondent_name之外的所有列名的格式都是<VARIABLE>_<JOB NUMBER> - 正是我们将提供pivot_longer()的规范（抱歉，堆栈溢出很难为桌子）：

survey4 <- survey3 %>% 
  pivot_longer(
    !respondent_name, names_to = c(".value", "job_number"), 
    names_pattern = "(.*)_([0-9]+)$", 
    names_transform = list(job_number = as.numeric)
  )
knitr::kable(survey4)

|respondent_name | job_number|job_name          | cst_1| rev_1| cst_2| rev_2|
|:---------------|----------:|:-----------------|-----:|-----:|-----:|-----:|
|James           |          1|farmer            | 5e+03| 6e+03|  2000|  3000|
|James           |          2|teacher           | 1e+02| 2e+02|     0|     0|
|Alice           |          1|livestock rearing | 1e+05| 2e+05| 20000| 30000|
|Alice           |          2|barber            | 5e+03| 7e+03|  2000|     0|

第二部pivot：季号

现在对于第二个 pivot，请注意cst和rev列的格式为<VARIABLE>_<SEASON NUMBER> - 正是我们将提供的规范pivot_longer() 。 这一次，只需指定一个下划线来分隔名称就足够了（我们上次不能，因为列名中存在多个下划线）（再次为表格道歉）：

survey5 <- survey4 %>%
  pivot_longer(
    matches("cst|rev"), names_to = c(".value", "season_number"),
    names_sep = "_", names_transform = list(season_number = as.numeric)
  )
knitr::kable(survey5)

|respondent_name | job_number|job_name          | season_number|   cst|   rev|
|:---------------|----------:|:-----------------|-------------:|-----:|-----:|
|James           |          1|farmer            |             1| 5e+03| 6e+03|
|James           |          1|farmer            |             2| 2e+03| 3e+03|
|James           |          2|teacher           |             1| 1e+02| 2e+02|
|James           |          2|teacher           |             2| 0e+00| 0e+00|
|Alice           |          1|livestock rearing |             1| 1e+05| 2e+05|
|Alice           |          1|livestock rearing |             2| 2e+04| 3e+04|
|Alice           |          2|barber            |             1| 5e+03| 7e+03|
|Alice           |          2|barber            |             2| 2e+03| 0e+00|

添加标签并清洁

现在我们可以添加存储在我们之前创建的元数据seasonality_desc中的标签，根据需要重新排序列，并将“cst”重命名为“cost”，将“rev”重命名为“revenue”：

survey6 <- survey5 %>% 
  left_join(seasonality_desc, by = c("job_number", "season_number")) %>% 
  select(
    respondent_name, job_number, job_name, season_number, season, cost = cst, 
    revenue = rev
  )
knitr::kable(survey6)

受访者姓名	工作编号	工作名称	季数	季节	成本	收入
詹姆士	1	农民	1	高的	5e+03	6e+03
詹姆士	1	农民	2	低的	2e+03	3e+03
詹姆士	2	老师	1	积极的	1e+02	2e+02
詹姆士	2	老师	2	不活跃	0e+00	0e+00
爱丽丝	1	牲畜饲养	1	高的	1e+05	2e+05
爱丽丝	1	牲畜饲养	2	低的	2e+04	3e+04
爱丽丝	2	理发师	1	积极的	5e+03	7e+03
爱丽丝	2	理发师	2	不活跃	2e+03	0e+00