首页 > 解决方案 > dplyr:简化创建匹配和绝对差异变量

问题描述

我有一个关于每个人的友谊和特征的数据集,我正在尝试创建变量,如果它们在二元测量上匹配,以及它们对于连续测量的绝对差异是什么。

我可以很容易地做到这一点,但我想知道是否有一种不同的方法可以比我的方法更精简,因为我有大约 60 个变量可以做到这一点。

样本数据:

dat <- read.table(text = "id.x  id.y    male.x  smoke.x drink.x everfight.x grades.x    male.y  smoke.y drink.y everfight.y grades.y
1   6   0   2   4   1   3   0   2   1   0   2
2   7   0   2   4   0   5   0   2   3   1   4
3   8   1   4   4   1   2   0   4   2   1   1
4   9   0   2   3   1   2   0   3   2   0   1
5   10  1   2   4   0   4   1   4   1   0   4", header = TRUE)

这是我所做的:

dat <- dat %>%
       mutate(sex_match = case_when(male.x == male.y ~ 1,
                                    TRUE ~ 0),
              fight_match = case_when(everfight.x == everfight.y ~ 1,
                                      TRUE ~ 0),
              smoke_diff   = abs(smoke.x  - smoke.y),
              drink_diff   = abs(drink.x  - drink.y),
              grades_diff  = abs(grades.x - grades.y))

这正是我想要的:

id.x id.y male.x smoke.x drink.x everfight.x grades.x male.y smoke.y drink.y everfight.y grades.y sex_match fight_match smoke_diff drink_diff grades_diff
 1    6      0       2       4           1        3      0       2       1           0        2         1           0          0          3           1
 2    7      0       2       4           0        5      0       2       3           1        4         1           0          0          1           1
 3    8      1       4       4           1        2      0       4       2           1        1         0           1          0          2           1
 4    9      0       2       3           1        2      0       3       2           0        1         1           0          1          1           1
 5   10      1       2       4           0        4      1       4       1           0        4         1           1          2          3           0

但是,我想知道是否有一种方法可以通过循环或应用来识别相应的变量并在上面的示例输出中创建匹配和绝对差异的新变量。

更新

最终使用了 Jon 回答的大部分内容和 akrun 的一部分,这对我来说最有效:

non_binary <- dat %>% select(., contains(".x")) %>%
                      select(., -id.x) %>%
                      select_if(~!all(. %in% 0:1)) %>% 
                      rename_with(~str_remove(., '.x')) %>%
                      names()
dat %>%
  pivot_longer(-c(id.x:id.y), 
               names_to = c("var", ".value"),
               names_pattern = "(.+).(.+)") %>%
  mutate(match = if_else(var %in% non_binary, abs(x - y), 1L * (x == y))) %>%
  mutate(col_name = paste(var, ifelse(var %in% non_binary, "diff", "match"), sep = "_")) %>%
  select(-c(var:y)) %>%
  pivot_wider(names_from = col_name, values_from = match)

感谢你们俩!

标签: rloopsdplyrapplydata-manipulation

解决方案


这是一个 tidyr/dplyr 方法。首先,我重塑为一个长格式,每个 id/变量组合都有一行,每个版本都有列。然后我可以一次比较每一对,然后重新塑造。

library(dplyr); library(tidyr)
non_binary <- c("smoke", "drink", "grades")
dat %>%
  pivot_longer(-c(id.x:id.y), 
               names_to = c("var", ".value"),
               names_pattern = "(.+).(.+)") %>%
  mutate(match = if_else(var %in% non_binary, abs(x - y), 1L * (x == y))) %>%
  mutate(col_name = paste(var, ifelse(var %in% non_binary, "diff", "match"), sep = "_")) %>%
  select(-c(var:y)) %>%
  pivot_wider(names_from = col_name, values_from = match)

结果,可以附加到原始数据:

# A tibble: 5 x 7
   id.x  id.y male_match smoke_diff drink_diff everfight_match grades_diff
  <int> <int>      <int>      <int>      <int>           <int>       <int>
1     1     6          1          0          3               0           1
2     2     7          1          0          1               0           1
3     3     8          0          0          2               1           1
4     4     9          1          1          1               0           1
5     5    10          1          2          3               1           0

推荐阅读