如何用跨函数重写相同的代码答案

【问题标题】：How to rewrite the same code with across function如何用跨函数重写相同的代码
【发布时间】：2022-01-02 08:17:59
【问题描述】：

我编写了以下代码

out %>% group_by(tests0, GROUP) %>% 
  summarise(
            mean0 = mean(score0, na.rm = T),
            stderr0 = std.error(score0, na.rm = T), 
            mean7 = mean(score7, na.rm = T), 
            stederr7 = std.error(score7, na.rm = T),
            diff.std.mean = t.test(score0, score7, paired = T)$estimate, 
            p.value = t.test(score0, score7, paired = T)$p.value, 
            )

我得到了以下输出

 tests0     GROUP    mean0 stderr0 mean7 stederr7 diff.std.mean p.value
   <fct>      <fct>    <dbl>   <dbl> <dbl>    <dbl>         <dbl>   <dbl>
 1 ADAS_CogT0 CONTROL   12.6   0.525  13.6    0.662        -1.15  0.00182
 2 ADAS_CogT0 TRAINING  14.0   0.613  12.6    0.570         1.40  0.00295
 3 PVF_T0     CONTROL   32.1   1.22   31.3    1.45          0.498 0.636  
 4 PVF_T0     TRAINING  31.6   1.37   34.3    1.51         -2.48  0.0102 
 5 ROCF_CT0   CONTROL   29.6   0.893  30.3    0.821        -0.180 0.835  
 6 ROCF_CT0   TRAINING  30.1   0.906  29.5    0.929         0.489 0.615  
 7 ROCF_IT0   CONTROL   12.8   0.563  12.2    0.683         0.580 0.356  
 8 ROCF_IT0   TRAINING  10.9   0.735  12.3    0.768        -1.44  0.0238 
 9 ROCF_RT0   CONTROL   12.1   0.725  12.5    0.797        -0.370 0.598  
10 ROCF_RT0   TRAINING  10.5   0.746  10.9    0.742        -0.534 0.370  
11 SVF_T0     CONTROL   35.5   1.05   34      1.15          1.42  0.107  
12 SVF_T0     TRAINING  34.1   1.04   32.9    1.16          0.962 0.231

如果我想通过across function 做同样的事情，我应该怎么做才能获得相同的结果，如上面的代码所示？实际上，我遇到了麻烦，因为我从这个问题Reproduce a complex table with double headesrs 下发布的答案中提取了一些示例，但我无法正确适应它。

这里是数据集

> dput(head(out, 100))
structure(list(ID = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 
13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 
29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 
45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 
61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 
77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 
93, 94, 95, 96, 97, 98, 99, 100), GROUP = structure(c(2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L), .Label = c("CONTROL", "TRAINING"), class = "factor"), 
    Gender = structure(c(1L, 2L, 1L, 2L, 1L, 2L, 2L, 1L, 2L, 
    2L, 2L, 2L, 2L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 1L, 2L, 2L, 
    2L, 2L, 1L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 
    2L, 1L, 1L, 1L, 2L, 2L, 1L, 2L, 1L, 2L, 2L, 2L, 2L, 1L, 1L, 
    2L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 2L, 2L, 2L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 1L, 2L, 2L, 2L, 2L, 1L, 
    1L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 
    2L), .Label = c("M", "F"), class = "factor"), Age = c(74, 
    76, 81, 74, 69, 72, 75, 83, 78, 72, 82, 68, 72, 72, 73, 80, 
    69, 72, 70, 80, 75, 80, 78, 74, 82, 74, 80, 82, 78, 81, 66, 
    71, 70, 79, 78, 73, 72, 77, 77, 71, 83, 74, 70, 71, 77, 69, 
    67, 64, 79, 71, 77, 77, 73, 67, 68, 79, 81, 67, 84, 75, 80, 
    73, 68, 74, 77, 79, 79, 72, 73, 78, 76, 78, 77, 74, 78, 77, 
    77, 82, 77, 70, 77, 81, 79, 75, 74, 78, 69, 77, 73, 77, 70, 
    79, 70, 72, 77, 72, 71, 71, 73, 81), Education = c(18, 4, 
    8, 5, 8, 11, 5, 5, 4, 8, 8, 12, 5, 18, 13, 5, 13, 13, 5, 
    5, 13, 5, 3, 8, 17, 5, 8, 5, 5, 8, 17, 8, 18, 18, 13, 13, 
    13, 13, 15, 17, 8, 5, 5, 13, 8, 5, 11, 13, 8, 8, 8, 5, 13, 
    8, 5, 17, 8, 12, 13, 5, 8, 8, 8, 5, 3, 8, 18, 5, 8, 13, 8, 
    5, 17, 8, 5, 17, 5, 8, 11, 8, 8, 5, 12, 3, 8, 8, 8, 13, 5, 
    5, 8, 8, 13, 5, 5, 8, 13, 5, 8, 12), tests0 = structure(c(1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("ADAS_CogT0", 
    "PVF_T0", "ROCF_CT0", "ROCF_IT0", "ROCF_RT0", "SVF_T0"), class = "factor"), 
    score0 = c(14.66, 15.33, 17.33, 19, 7.66, 12.6, 18.67, 14.99, 
    17.99, 17.33, 13.66, 16.99, 10.66, 9.66, 14.99, 15.66, 13.33, 
    4.33, 14.33, 15.99, 16.33, 10.66, 14.66, 10.66, 19.33, 17.66, 
    15.99, 20.66, 20.6, 17, 10.33, 6.33, 6.66, 19.99, 13.33, 
    24.33, 12.33, 10.33, 12.33, 9.66, 10.99, 13.99, 23, 6.32, 
    11.32, 13.99, 14.66, 8.99, 14.33, 9.99, 7.33, 15.66, 14, 
    7.99, 23.32, 14.66, 9.99, 5.66, 6.99, 11.66, 10.33, 6.99, 
    19.32, NA, 10, 17.66, 13.66, 10.32, NA, NA, 8.66, 9, 6.99, 
    14.99, 9.66, 13.66, 15.32, 12, 14, 13.66, 11.99, 15.66, 16, 
    15, 16.99, 20, 11, 7.99, 8.33, 8.32, 14.99, 18.66, 10.33, 
    11.99, 9.32, 17, 14.33, 14.66, 16.6, 9.99), tests7 = structure(c(1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("ADAS_CogT7", 
    "PVF_T7", "ROCF_CT7", "ROCF_IT7", "ROCF_RT7", "SVF_T7"), class = "factor"), 
    score7 = c(16, 9.32, 21.33, 17, 8.32, 11, 14.99, 10.99, 17, 
    18.33, 13.32, 14.34, 8.99, 7, 11.99, 15.33, 6.99, 5.33, 12.32, 
    13, 21.32, 7.99, 13.33, 11.99, 17.32, 16.32, 16.33, 14.66, 
    18.99, 17.33, 7.99, 9.33, 10.99, NA, 12.99, 16.33, 21.66, 
    9, 9.34, 8.66, 8.33, 13.66, 15.66, 6.66, 10.99, 13.33, 13.33, 
    7.99, 11.99, 11.32, 7.33, 9.66, 6.99, NA, 15.99, 15.66, 14.66, 
    6.32, 7, 11, 14, 10.33, 24.66, NA, 14.99, NA, 15.99, 9.32, 
    NA, NA, 9.99, 9.33, 7.66, 17.33, 10.32, 16, 17, 12.99, 15, 
    14.33, 10, 14.99, 19, 13.99, 19.33, NA, 10, 6.99, 11.66, 
    6.66, 14.33, 16, 8.66, 10, NA, 20, 14.99, 19.66, 26.66, 8.99
    )), row.names = c(NA, -100L), class = c("tbl_df", "tbl", 
"data.frame"))
>

您可以在下面找到我想要的方法。它是一种需要 .x 操作的方法。

out %>%    
group_by(across(all_of(tests0, GROUP))) %>%    summarise(across(starts_with('score'),                         
list(mean = ~ mean(.x,na.rm = T),            
stderr = ~ std.error(.x, na.rm = TRUE),            
diff.std.mean = ~ t.test(.x, na.rm = T)))$estimate,              
p.value = ~ t.test(.x, na.rm = T)))$p.value)),.groups = "drop")

【问题讨论】：

希望以上内容足以为您提供解决方案……甚至与我的不同。

标签： r dplyr tidyverse across

【解决方案1】：

您可以在across() 中使用参数.names：

library(dplyr)
out %>%
  group_by(tests0, GROUP) %>%
  summarize(across(c(score0, score7), sd, na.rm = TRUE, .names = "sd_{.col}"), 
            across(c(score0, score7), mean, na.rm = TRUE, .names = "mean_{.col}"), 
            diff.std.mean = t.test(score0, score7, paired = T)$estimate, 
            p.value = t.test(score0, score7, paired = T)$p.value) %>%
  ungroup()
#> `summarise()` has grouped output by 'tests0'. You can override using the `.groups` argument.
#> # A tibble: 2 x 8
#>   tests0 GROUP sd_score0 sd_score7 mean_score0 mean_score7 diff.std.mean p.value
#>   <fct>  <fct>     <dbl>     <dbl>       <dbl>       <dbl>         <dbl>   <dbl>
#> 1 ADAS_~ CONT~      3.72      4.81        12.5        13.5         -1.24 0.00471
#> 2 ADAS_~ TRAI~      4.55      4.15        14.0        12.6          1.40 0.00295

^{由reprex package (v2.0.1) 于 2021 年 11 月 26 日创建}

编辑

如果您更喜欢列表，则可以更轻松地确定单独的部分，然后将它们绑定在一起：


library(data.table)
by <- c("tests0", "GROUP")
out_dt <- data.table::data.table(out)
means <- out_dt[, sapply(.SD, function(x) list(mean = mean(x, na.rm = TRUE))), 
                by = by, .SDcols = patterns("^score")]
sds <- out_dt[, sapply(.SD, function(x) list(sd = sd(x, na.rm = TRUE))), 
                by = by, .SDcols = patterns("^score")]
t_est <- out_dt[, .(diff.std.mean = t.test(score0, score7, paired = T)$estimate), by = by]
tpvalue <- out_dt[, .(p.value = t.test(score0, score7, paired = T)$p.value), by = by] 
list(means = means, sds = sds, diff.std.mean = t_est, p.value = tpvalue)

【讨论】：

感谢您的回答。其实我试过做这个尝试。 out %>% group_by(across(all_of(by))) %>% summarise(across(starts_with('score'), list( mean = ~ mean(.x,na.rm = T), stderr = ~ std.error(.x, na.rm = TRUE), diff.std.mean = ~ t.test(.x, get(str_replace(cur_column(), "score", "score7")))$estimate, p.value = ~ t.test(.x, get(str_replace(cur_column(), "score0", "score7")))$p.value ) ), .groups = "drop")
使用括号外的列表。你认为有可能做同样的事情吗？
实际上，如果查看我的评论，您会发现我想操作 list() 函数，尤其是 .x 内的索引
我更新了我的答案，它现在返回一个列表
我不明白你想要达到的目标。请使用正确的输入和所需的输出更新您的问题。

【解决方案2】：

这是您可能要考虑的另一种方法。首先，我将您的代码剪切并粘贴到一个函数中。唯一的变化是提取列名并删除对 plotrix 包的依赖以计算标准误差。

g <- function (df)
{
  nms <- c(names(df)[1:2],
           paste0('mean',   sub(".*[a-z]","",names(df)[3])),
           paste0('stderr', sub(".*[a-z]","",names(df)[3])),
           paste0('mean',   sub(".*[a-z]","",names(df)[4])),
           paste0('stderr', sub(".*[a-z]","",names(df)[4])),
           'diff.std.mean', 'p.value')
  
  z <- df %>% group_by(df[,1:2]) %>%
    summarize(
    x1 = mean(pull(df[,3]), na.rm = T),
    x2 = sd(pull(df[,3]), na.rm=T) / sqrt(sum(!is.na(pull(df[,3])))),
    x3 = mean(pull(df[,4]), na.rm = T),
    x4 = sd(pull(df[,4]), na.rm=T) / sqrt(sum(!is.na(pull(df[,4])))),
    x5 = t.test(pull(df[,3]), pull(df[,4]), paired = T)$estimate, 
    x6 = t.test(pull(df[,3]), pull(df[,4]), paired = T)$p.value)
    colnames(z) <- nms
    return(z)
}

然后，由于测试数据只有一个因子水平，并且您使用的 plotrix::std.error 函数的样本量不足，因此我引入了“test0”因子的变化，将样本量加倍，然后丢弃未使用的级别，因为它们会导致空帧上的迭代。此外，我添加了一个 score8 来展示如何在其他变量上运行。

s <- t %>% mutate(tests0 = case_when(Education <= 8 ~ 'ADAS_CogTO', T ~ 'PVF_T0'),
                  score8 = score0 + score7)
q <- rbind(s, s)  
fct_drop(q$tests0)

然后我按因子级别拆分框架，将函数应用于每个拆分，然后将数据重新合并到一个函数中，该函数允许您操纵分数和分组变量。我假设每个 2，这对于分数变量是安全的，因为您正在进行配对 t 检验，并且它很容易与组变量一起扩展（如果您只是将分数变量移动到位置 1 和 2，并使用所有剩余的变量作为组变量传递给函数）。

h <- function(df, group_vars, score_vars)
{
  z <- df %>% select(group_vars, score_vars) 
  z <- z  %>% group_by(z[,1:2]) %>%
              group_map( ~ g(.x), .keep = T) %>%
              bind_rows()
}

请注意，如果您希望将此应用于其他数据，您只需更改传递给 group 和 score 变量的列。如果您也愿意，应该很容易改变它，只是认为这是一个很好的框架，可以解决您似乎正在尝试做的事情。考虑一下您如何处理 test0 为空且 test7 为非空（反之亦然）的情况，因为这些观察结果包含在您的汇总统计数据中，但必然从 t 检验中排除。祝你好运。

x <- h(q, c("tests0", "GROUP"), c("score0", "score7")) %>%
 group_by(tests0) %>%
 pivot_wider(id_cols     = tests0,
             names_from  = GROUP,
             values_from = c("mean0","stderr0","mean7","stderr7",
                             'diff.std.mean', 'p.value'))

【讨论】：

感谢您的贡献。顺便说一句，我正在寻找操作代码以使用该 list() 函数获得相同的结果
这确实是一个很酷的函数，但实际上我正在寻找的 reksults 包括在 list() 函数中对 .x 索引的操作
虽然我不太明白你想说的“在 list() 函数中包含对 .x 索引的操作”我概括了名称/输入并使输出名称有条件在输入名称上（这似乎是你想要的）。
你看到最后的代码了吗？我提供的数据集下方的那个...如果您尝试按原样运行它，它会返回一些冗余值，因为 MEAN 列下的值与 DIFF.STD.MEAN 列下的值相同......这意味着.x in t.test() 函数应该以正确的方式重写以执行 t.test()....这只是为了更清楚....想要强制任何人持续编辑解决方案
让我们continue this discussion in chat。

【解决方案3】：

我没有名为std.error 的函数，所以我使用了sd，当然你可以更改它。

library(dplyr)
library(readr)

out %>% 
  group_by(tests0, GROUP) %>% 
  summarise(
    across(c(score0, score7), list(mean = mean, stderr = sd), na.rm = TRUE,
           .names = '{.fn}{parse_number(.col)}'),
    with(t.test(score0, score7, paired = T),
         tibble(diff.std.mean = estimate,
                p.value)))
# # A tibble: 2 × 8
#   tests0     GROUP    mean0 stderr0 mean7 stderr7 diff.std.mean p.value
#   <fct>      <fct>    <dbl>   <dbl> <dbl>   <dbl>         <dbl>   <dbl>
# 1 ADAS_CogT0 CONTROL   12.5    3.72  13.5    4.81         -1.24 0.00471
# 2 ADAS_CogT0 TRAINING  14.0    4.55  12.6    4.15          1.40 0.00295

实际上，我只是将上面的代码放在一个接受x 和y 参数的函数中，然后运行fun(df, x = score0, y = score7)。但是，只是为了好玩，如果你必须使用.x 和.y，这是一种方法（虽然 imo 这样做会有点傻）

df %>% 
  group_by(tests0, GROUP) %>% 
  select(starts_with('score')) %>% 
  summarise(
    across(everything(), list(mean = mean, stderr = sd), na.rm = TRUE,
           .names = '{.fn}{parse_number(.col)}'),
    across(everything(), list(list)) %>% 
      pmap_dfr(~ t.test(.x, .y, paired = TRUE)[c('estimate', 'p.value')]) %>% 
      transmute(diff.std.mean = estimate, p.value))

# # A tibble: 2 × 8
# # Groups:   tests0 [1]
#   tests0     GROUP    mean0 stderr0 mean7 stderr7 diff.std.mean p.value
#   <fct>      <fct>    <dbl>   <dbl> <dbl>   <dbl>         <dbl>   <dbl>
# 1 ADAS_CogT0 CONTROL   12.5    3.72  13.5    4.81         -1.24 0.00471
# 2 ADAS_CogT0 TRAINING  14.0    4.55  12.6    4.15          1.40 0.00295

【讨论】：

嗨，好代码，从 t.test 拆分均值和 sd 的事实是因为编写代码更容易？您可以使用我在数据集上发布的解决方案来尝试解决方案吗？ t.test 函数应该如何编写 .x 脚本？
我拆分它是因为across 一次将函数应用于一列。对于t.test，您需要两列。
精确是什么意思？你是指数据集下面的代码吗？你认为总是使用 .x 索引来计算 t.test() 是可能的吗？
t.test 函数需要两列。 across 中的 .x 指的是单个列。我认为这是不可能的。
嗯，好的。这就是为什么通过使用 .y 索引我得到了一些错误......这就是我正在寻找的方式

【解决方案4】：

我想到了一种可能的解决方法（可能有帮助，也可能没有帮助），即“手动”使用across()，而不是一次应用一列函数。生成的输出是一个data.frame，其中包含深度嵌套的列表列，因此unnest() 将派上用场。我还使用possibly() 来解决两列不存在的情况，记住across() 可以匹配任意数量的列，而t.test() 需要x 和y 参数。

代码：

library(tidyverse)

data <-
  df %>%
  group_by(tests0, GROUP) %>%
  summarize(
    all = list(across(starts_with("score")) %>%
      {
        tibble(
          ttest   = data.frame(possibly(~ reduce(., ~ t.test(.x, .y, paired = TRUE))[c("estimate", 'p.value')], NA)(.)),
          means   = data.frame(map(., ~ mean(.x, na.rm = TRUE)) %>% set_names(., str_replace(names(.), "\\D+", "mean"))),
          stderrs = data.frame(map(., ~ sd(.x, na.rm = TRUE)) %>% set_names(., str_replace(names(.), "\\D+", "stederr")))
        )
      })
  )
#> `summarise()` has grouped output by 'tests0'. You can override using the `.groups` argument.


data %>%
  unnest(all) %>%
  unnest(-c("tests0", "GROUP"))
#> # A tibble: 2 × 8
#> # Groups:   tests0 [1]
#>   tests0     GROUP    estimate p.value mean0 mean7 stederr0 stederr7
#>   <fct>      <fct>       <dbl>   <dbl> <dbl> <dbl>    <dbl>    <dbl>
#> 1 ADAS_CogT0 CONTROL     -1.24 0.00471  12.5  13.5     3.72     4.81
#> 2 ADAS_CogT0 TRAINING     1.40 0.00295  14.0  12.6     4.55     4.15

^{由reprex package (v2.0.1) 于 2021 年 11 月 29 日创建}

【讨论】：

这可能是我正在寻找的答案....它只需要用 p.value 列完成