Jak přepsat stejný kód přes funkci

Můžete použít argument .names v across():

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

^{Vytvořen na 2021-11-26 do reprex balíček (v2.0.1)}

EDIT

Pokud dáváte přednost seznamu, že by bylo jednodušší určit samostatných částí, a pak svázat je dohromady:

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)

Tady je jiný přístup, možná budete chtít, aby zvážila. První jsem vzal svůj kód a vyjmout a vložit jej do funkce. Abstrakce názvy sloupců a odstranění závislosti na plotrix balíček pro výpočet standardní chyby jsou pouze změny.

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)
}

Pak, protože testovací data měla pouze jedna úroveň faktoru a nedostatečné velikosti vzorku pro plotrix::std.chybová funkce, které jste použili, jsem představil změnu v test0' faktor, zdvojnásobil velikost vzorku, a upustil nepoužité hladiny, protože by způsobit iterací na prázdné rámy. Kromě toho jsem přidal score8 ukázat, jak jsi mohl běžet na jiných proměnných.

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

Pak jsem rozdělil rámu do úrovně faktoru, aplikuje funkci na každý z rozděluje, pak remerged dat dohromady uvnitř funkce, která vám umožní manipulovat skóre a skupiny proměnných. Předpokládal jsem, že 2 každý, který je bezpečný s skóre proměnných od vašeho dělají párový t-test, a to je snadno rozšířitelná pomocí skupiny proměnných (pokud jste jednoduše přesunout skóre proměnných do pozice 1 a 2, a použít všechny zbývající proměnné předané do funkce jako skupina proměnných).

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()
}

Všimněte si, že pokud budete chtít aplikovat na jiná data, stačí pouze změnit sloupce prošel do skupiny a skóre proměnných. By mělo být poměrně snadné změnit, že pokud chcete jako tak, jen myslel, že to byl dobrý rámec pro to, co se vám zdá, že se snaží dělat. Přemýšlejte o tom, jak zvládnout případ, kdy test0 je null a test7 je non-null (nebo naopak), protože tyto připomínky jsou zahrnuty do své souhrnné statistiky, ale nutně vyloučeny z t-testu. Hodně štěstí.

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'))

Já nemám funkci, tzv. std.error takže jsem použil sd, ale samozřejmě můžete změnit.

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

Ve skutečnosti, jen bych dal výše uvedený kód ve funkci, která bere x a y argument a pak spustit fun(df, x = score0, y = score7). Ale, jen tak pro zábavu, pokud je nutné použít .x a .ytady je jeden způsob, jak (i když imo to by bylo trochu hloupé to dělat)

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

Myslel jsem, že z možných řešení (které může nebo nemusí pomoci) pomocí across() "ručně", bez použití funkcí jednoho sloupce najednou. Výsledný výstup je data.frame seznam sloupců, které jsou hluboce vnořené, takže unnest() přijde vhod. Také jsem použil possibly() jak řešit případ, kdy dva sloupce nejsou k dispozici, pamatujte, že across() může odpovídat libovolný počet sloupců a t.test() potřebuje x a y argumenty.

Kód:

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

^{Vytvořen na 2021-11-29 do reprex balíček (v2.0.1)}