如何在 tbl_summary() 和 eta 效应量中添加合并标准误差?

How to add pooled standard error in tbl_summary() and eta effect size?

我正在尝试将合并标准误差 (PSE) 和 Eta 平方包含在 tbl_summary() 中。 PSE 是由 sqrt(mean(residuals^2)/n) 计算的,我试图通过从 aov()lm() 中提取残差来逐步计算,但我得到了 The dimension of respected variable and the added statistic do not match. Expecting statistic/dataframe to be length/ no. rows 1 的错误。这是我的代码:

PSE <- function(data, variable, by,...) {
    aov(data[["variable"]] ~ as.factor(data[[by]]))$residuals
  }

Dataset_TPA_Full %>%
  select(diet,hardness_g,adhesiveness_g_sec, resilence, cohesion, springiness, gumminess, chewiness, firmness_g_force_1, density_g_l)%>% 
  tbl_summary(
    by = diet,
    statistic = all_continuous() ~ "{mean} ± {sem}",
    label = list(hardness_g = "Hardness (g)", 
                 adhesiveness_g_sec = "Adhesiveness (g/ sec)", 
                 resilence = "Resilience", 
                 cohesion = "Cohesion", 
                 springiness = "Springiness", 
                 gumminess = "Gumminess", 
                 chewiness = "Chewiness", 
                 firmness_g_force_1 = "Firmness (g)", 
                 density_g_l = "Density (g/ L)")
    ) %>% 
    add_p(
      test = all_continuous() ~ "aov",
    ) %>%
  add_stat(fns = all_continuous() ~ PSE) %>% 
  modify_header(label = "**Treatment**", p.value = "**p-value**") %>%
  bold_labels() %>%
  bold_levels()

此外,当我尝试使用此代码添加 Eta 平方时,当我将其放入 add_stat() 函数

时,它 return 缺少数据参数
my_ES_test <- function(data, variable, by, ...) {
  aovmod = aov(data[[variable]] ~ data[[by]])
  lsr::etaSquared(aovmod)[1,1]
}

你能帮我解决这个问题吗? 谢谢。

应该这样做:

library(gtsummary)
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union

sem <- function(x){
  sqrt(var(x, na.rm=TRUE)/sum(!is.na(x)))
}

PSE <- function(data, variable, by,...) {
  e <- aov(data[[variable]] ~ as.factor(data[[by]]))$residuals
  sqrt(mean(e^2)/length(e))
}

mtcars %>%
  select(cyl, mpg, hp, disp, drat, qsec)%>% 
  tbl_summary(
    by = cyl,
    statistic = all_continuous() ~ "{mean} ± {sem}",
    label = list(mpg = "Miles per Gallon", 
                 hp = "Horsepower", 
                 disp = "Displacement", 
                 drat = "Rear Axel Ratio", 
                 qsec = "1/4 Mile Time")
  ) %>% 
  add_p(
    test = all_continuous() ~ "aov",
  ) %>%
  add_stat(fns = all_continuous() ~ PSE) %>% 
  modify_header(label = "**Treatment**", p.value = "**p-value**", add_stat_1 = "**PSE**") %>%
  bold_labels() %>%
  bold_levels()

reprex package (v2.0.1)

于 2022-04-17 创建

请注意,PSE() 函数有两个问题。首先,data[["variable"]] 应该是 data[[variable]]variable 两边没有引号)。其次,你有函数 return 残差,而不是你在问题中描述的 PSE 计算。现在,它 return 是合适的结果。我也不确定你从哪里得到 sem() 函数,所以我只是做了一个计算均值标准误差的函数。


更新 PSE 功能

PSE <- function(data, variable, by,...) {
  s <- data %>% 
    group_by(!!sym(by)) %>% 
    summarise(s = var(!!sym(variable)), 
              n = n()) %>% 
    mutate(num = s*(n-1))
  psd <- sqrt(sum(s$num)/(sum(s$n) - nrow(s)))
  psd*sqrt(sum(1/s$n))
}