У меня проблема с корректировкой цифр для tbl_summary()
. Вот мой код:
library(flextable)
library(dplyr)
library(officer)
library(gtsummary)
library(janitor)
### Effect size
my_ES_test <- function(data, variable, by, ...) {
aovmod = aov(data[[variable]] ~ data[[by]])
lsr::etaSquared(aovmod)[1,1]
}
### Standard Error Mean
sem <- function(x){
sqrt(var(x, na.rm=TRUE)/sum(!is.na(x)))
}
### Pooled Standard Error
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))
}
### gtsummary
Iris_data <- iris %>%
select(names(iris))%>%
tbl_summary(
by = Species,
digits = all_continuous() ~ c(2,2),
type = list(everything() ~ "continuous"),
statistic = all_continuous() ~ "{mean} ± {sem}",
label = list(Sepal.Length = "Sepal Length",
Sepal.Width = "Sepal Width",
Petal.Length = "Petal Length",
Petal.Width = "Petal Width")
) %>%
add_stat(fns = all_continuous() ~ PSE) %>%
add_stat(fns = all_continuous() ~ my_ES_test) %>%
add_p(
test = all_continuous() ~ "aov", pvalue_fun = function(x) style_pvalue(x, digits = 3)
) %>%
modify_header(label = "**Size**", p.value = "**p-value**", add_stat_1 = "**PSE**", add_stat_2 = "**\U03B7\U00B2**") %>%
modify_footnote(add_stat_1 = "Pooled Standard Error", abbreviation = FALSE) %>%
bold_levels() %>%
bold_labels() %>%
as_flex_table()
В целом таблица работает отлично. Однако, если я переместил p-значение выше add_stat(fns = all_continuous() ~ PSE)
, то цифры p-значения вернутся к исходному формату без трех цифр. Это способ исправить это? Кроме того, я не могу настроить цифры для PSE по некоторым причинам с помощью purrr::partial(style_ratio, digits = 3)
. Пытаюсь снова и снова, но так и не могу решить проблему.
Спасибо.
Привет, доктор Сьоберг, я обновил набор данных.
Вы можете использовать функцию modify_fmt_fun()
, чтобы изменить функцию, которая форматирует/стилизует столбцы. Это то, о чем вы спрашиваете?
library(dplyr, warn.conflicts = FALSE)
library(officer)
library(gtsummary)
#> #BlackLivesMatter
### Effect size
my_ES_test <- function(data, variable, by, ...) {
aovmod = aov(data[[variable]] ~ data[[by]])
lsr::etaSquared(aovmod)[1,1]
}
### Standard Error Mean
sem <- function(x){
sqrt(var(x, na.rm=TRUE)/sum(!is.na(x)))
}
### Pooled Standard Error
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))
}
### gtsummary
iris %>%
select(names(iris))%>%
tbl_summary(
by = Species,
statistic = all_continuous() ~ "{mean} ± {sem}"
) %>%
add_p(
test = all_continuous() ~ "aov",
pvalue_fun = function(x) style_pvalue(x, digits = 3)
) %>%
add_stat(fns = all_continuous() ~ PSE) %>%
add_stat(fns = all_continuous() ~ my_ES_test) %>%
modify_header(label = "**Size**", p.value = "**p-value**", add_stat_1 = "**PSE**", add_stat_2 = "**\U03B7\U00B2**") %>%
modify_footnote(add_stat_1 = "Pooled Standard Error", abbreviation = FALSE) %>%
modify_fmt_fun( c(add_stat_1, add_stat_2) ~ purrr::partial(style_sigfig, digits = 5)) %>%
as_kable()
Размер | сетоза, N = 50 | лишай, N = 50 | виргиния, N = 50 | р-значение | ПСЭ | η² |
---|---|---|---|---|---|---|
Чашелистик.Длина | 5,01 ± 0,05 | 5,94 ± 0,07 | 6,59 ± 0,09 | <0,001 | 0,12610 | 0,61871 |
Сепал.Ширина | 3,43 ± 0,05 | 2,77 ± 0,04 | 2,97 ± 0,05 | <0,001 | 0,08321 | 0,40078 |
Лепесток.Длина | 1,46 ± 0,02 | 4,26 ± 0,07 | 5,55 ± 0,08 | <0,001 | 0,10541 | 0,94137 |
Лепесток.Ширина | 0,25 ± 0,01 | 1,33 ± 0,03 | 2,03 ± 0,04 | <0,001 | 0,05013 | 0,92888 |
Created on 2022-04-24 by the reprex package (v2.0.1)
Привет, доктор Шоберг. Да, это именно то, что я ищу! Большое спасибо за ваш быстрый ответ!
Не могли бы вы обновить свой пост воспроизводимым примером, который мы можем запустить на наших машинах?