使用 dplyr 查找配对列的差异答案

【问题标题】：Finding the differences of paired-columns using dplyr使用 dplyr 查找配对列的差异
【发布时间】：2021-01-22 16:50:16
【问题描述】：

set.seed(3)
library(dplyr)
dat <- tibble(Measure = c("Height","Weight","Width","Length"),
             AD1_1= rpois(4,10),
             AD1_2= rpois(4,9),
             AD2_1= rpois(4,10),
             AD2_2= rpois(4,9),
             AD3_1= rpois(4,10),
             AD3_2= rpois(4,9),
             AD4_1= rpois(4,10),
             AD4_2= rpois(4,9),
             AD5_1= rpois(4,10),
             AD5_2= rpois(4,9),
             AD6_1= rpois(4,10),
             AD6_2= rpois(4,9))

假设我有这样的数据。我希望计算每个 AD 的差异，并与带下划线的数字配对，即 AD1diff、AD2diff、AD3diff。

而不是写

dat %>%
mutate(AD1diff = AD1_1 - AD1_2,
       AD2diff = AD2_1 - AD2_2,
...)

什么是写这个的有效方法？

【问题讨论】：

标签： r dplyr

【解决方案1】：

一个dplyr 选项可以是：

dat %>%
 mutate(across(ends_with("_1"), .names = "{col}_diff") - across(ends_with("_2"))) %>%
 rename_with(~ sub("_\\d+", "", .), ends_with("_diff"))

  Measure AD1_1 AD1_2 AD2_1 AD2_2 AD3_1 AD3_2 AD4_1 AD4_2 AD5_1 AD5_2 AD6_1 AD6_2 AD1_diff AD2_diff AD3_diff AD4_diff AD5_diff AD6_diff
  <chr>   <int> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int>    <int>    <int>    <int>    <int>    <int>    <int>
1 Height      6    10    10     3    12     8     7     5     7     5     8     9       -4        7        4        2        2       -1
2 Weight      8     9    13     6    14     7     8     7    13    11    10     9       -1        7        7        1        2        1
3 Width      10     9    11     5    12     8     7    11     9     5     5     6        1        6        4       -4        4       -1
4 Length      8     9     8     7     8    13     8     7     6    11    14     6       -1        1       -5        1       -5        8

【讨论】：

谢谢，这正是我希望的解决方案的样子。小问题，您能简要解释一下这是如何工作的吗？（底层逻辑）在我的实际项目中，我需要做比简单减法更复杂的计算，我想完全理解这段代码。
在mutate() 中，它会从以_1 结尾的列中减去以_2 结尾的列，并创建具有_1 变量名称和_diff 后缀的新列（即AD1_1_diff)。然后，rename_with() 通过删除第一个下划线及其后面的数字来更正名称。
@aiorr 这是智能代码，但这里的其他一些答案做同样的事情，可能更容易直观地理解。我从未见过两个 acrosss 在同一个 mutate 中使用！
对于未来的读者来说，要使用函数而不是操作，可以使用minus <- function(x,y){x-y} 和mutate(minus(across(ends_with("_1"), .names = "{col}_minus"), across(ends_with("_2"))))
此过程实质上意味着您比较两个数据集：一个具有以_1 结尾的变量，另一个具有_2。因此，它与dat %>% select(ends_with("_1")) - dat %>% select(ends_with("_2")) 相同。由于这些是列表，因此您无法以这种方式比较它们。

【解决方案2】：

执行此操作的“整洁”方法是将数据从宽格式转换为长格式，进行分组减法，然后返回宽格式：

library(tidyr)
dat_long = dat %>% pivot_longer(
  cols = starts_with("AD"),
  names_sep = "_",
  names_to = c("group", "obs")
) 

dat_long %>% head
# # A tibble: 48 x 4
#    Measure group obs   value
#    <chr>   <chr> <chr> <int>
#  1 Height  AD1   1         6
#  2 Height  AD1   2        10
#  3 Height  AD2   1        10
#  4 Height  AD2   2         3
#  5 Height  AD3   1        12
#  6 Height  AD3   2         8

dat_long %>%
  group_by(Measure, group) %>% 
  summarize(diff = value[obs == 1] - value[obs == 2]) %>%
  pivot_wider(names_from = "group", values_from = "diff") %>%
  rename_with(.fn = ~ paste0(., "diff"), .cols = starts_with("AD"))
# # A tibble: 4 x 7
# # Groups:   Measure [4]
#   Measure AD1diff AD2diff AD3diff AD4diff AD5diff AD6diff
#   <chr>     <int>   <int>   <int>   <int>   <int>   <int>
# 1 Height       -4       7       4       2       2      -1
# 2 Length       -1       1      -5       1      -5       8
# 3 Weight       -1       7       7       1       2       1
# 4 Width         1       6       4      -4       4      -1

【讨论】：

【解决方案3】：

这是一个data.table 选项

setDT(dat)[
  ,
  paste0(
    unique(gsub("_\\d+", "", names(dat)[-1])),
    "diff"
  ) := lapply(
    split.default(.SD[, -1], gsub("_\\d+", "", names(dat)[-1])),
    function(x) do.call("-", x)
  )
]

给了

> dat
   Measure AD1_1 AD1_2 AD2_1 AD2_2 AD3_1 AD3_2 AD4_1 AD4_2 AD5_1 AD5_2 AD6_1
1:  Height     6    10    10     3    12     8     7     5     7     5     8
2:  Weight     8     9    13     6    14     7     8     7    13    11    10
3:   Width    10     9    11     5    12     8     7    11     9     5     5
4:  Length     8     9     8     7     8    13     8     7     6    11    14
   AD6_2 AD1diff AD2diff AD3diff AD4diff AD5diff AD6diff
1:     9      -4       7       4       2       2      -1
2:     9      -1       7       7       1       2       1
3:     6       1       6       4      -4       4      -1
4:     6      -1       1      -5       1      -5       8

或

setDT(dat)[
  ,
  c(.(Measure = Measure), setNames(lapply(
    split.default(.SD[, -1], gsub("_\\d+", "", names(dat)[-1])),
    function(x) do.call("-", x)
  ), paste0(
    unique(gsub("_\\d+", "", names(dat)[-1])),
    "diff"
  )))
]

给予

   Measure AD1diff AD2diff AD3diff AD4diff AD5diff AD6diff
1:  Height      -4       7       4       2       2      -1
2:  Weight      -1       7       7       1       2       1
3:   Width       1       6       4      -4       4      -1
4:  Length      -1       1      -5       1      -5       8

【讨论】：

【解决方案4】：

使用 tidyverse 包 `tidyr` 在变异前重新排列数据

require(dplyr)
require(tidyr)

#> Loading required package: tidyr

首先，tidyr::pivot_longer 数据框，以便每一列都有单独的行：

new_dat <- 
  pivot_longer(dat, cols = starts_with("AD"), # For columns whose names start with 'AD'...
               names_sep = "_", # separate columns using '_' in colname
               names_to = c("AD_number", "observation")) %>% 
  arrange(AD_number, Measure, observation)

head(new_dat, 9)
#> # A tibble: 9 x 4
#>   Measure AD_number observation value
#>   <chr>   <chr>     <chr>       <int>
#> 1 Height  AD1       1               6
#> 2 Height  AD1       2              10
#> 3 Length  AD1       1               8
#> 4 Length  AD1       2               9
#> 5 Weight  AD1       1               8
#> 6 Weight  AD1       2               9
#> 7 Width   AD1       1              10
#> 8 Width   AD1       2               9
#> 9 Height  AD2       1              10

然后，使用tidyr::pivot_wider（与pivot_longer 功能相反）为observation 中的每个值创建一个单独的列。这将与即将推出的mutate 操作非常兼容。

new_dat <-
  pivot_wider(new_dat,
            names_from = observation,
            values_from = value,
            names_prefix = "value_")

head(new_dat, 5)
#> # A tibble: 5 x 4
#>   Measure AD_number value_1 value_2
#>   <chr>   <chr>       <int>   <int>
#> 1 Height  AD1             6      10
#> 2 Length  AD1             8       9
#> 3 Weight  AD1             8       9
#> 4 Width   AD1            10       9
#> 5 Height  AD2            10       3

最后，改变数据：

new_dat <- 
  mutate(new_dat, diff = value_1 - value_2)

head(new_dat, 4)
#> # A tibble: 4 x 5
#>   Measure AD_number value_1 value_2  diff
#>   <chr>   <chr>       <int>   <int> <int>
#> 1 Height  AD1             6      10    -4
#> 2 Length  AD1             8       9    -1
#> 3 Weight  AD1             8       9    -1
#> 4 Width   AD1            10       9     1

^{由reprex package (v0.3.0) 于 2021-01-22 创建}

恢复原始数据格式是可能的，但可能不会使数据更易于使用：

rename(new_dat, 
       c(`1` = "value_1", `2` = "value_2")) %>% 
  pivot_wider(names_from = AD_number,
              values_from = c(`1`, `2`, diff),
              names_glue = "{AD_number}_{.value}") %>% 
  {.[,order(names(.))]} %>% 
  relocate(Measure)

【讨论】：

使用 tidyverse 包 tidyr 在变异前重新排列数据

使用 tidyverse 包 `tidyr` 在变异前重新排列数据