Проблема с изменением цифр в tbl_summary

У меня проблема с корректировкой цифр для 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). Пытаюсь снова и снова, но так и не могу решить проблему.

Спасибо.

Не могли бы вы обновить свой пост воспроизводимым примером, который мы можем запустить на наших машинах?

Daniel D. Sjoberg 23.04.2022 00:15

Привет, доктор Сьоберг, я обновил набор данных.

Khanh Nguyen 24.04.2022 04:15
3 метода стилизации элементов HTML
3 метода стилизации элементов HTML
Когда дело доходит до применения какого-либо стиля к нашему HTML, существует три подхода: встроенный, внутренний и внешний. Предпочтительным обычно...
Формы c голосовым вводом в React с помощью Speechly
Формы c голосовым вводом в React с помощью Speechly
Пытались ли вы когда-нибудь заполнить веб-форму в области электронной коммерции, которая требует много кликов и выбора? Вас попросят заполнить дату,...
Стилизация и валидация html-формы без использования JavaScript (только HTML/CSS)
Стилизация и валидация html-формы без использования JavaScript (только HTML/CSS)
Будучи разработчиком веб-приложений, легко впасть в заблуждение, считая, что приложение без JavaScript не имеет права на жизнь. Нам становится удобно...
Flatpickr: простой модуль календаря для вашего приложения на React
Flatpickr: простой модуль календаря для вашего приложения на React
Если вы ищете пакет для быстрой интеграции календаря с выбором даты в ваше приложения, то библиотека Flatpickr отлично справится с этой задачей....
В чем разница между Promise и Observable?
В чем разница между Promise и Observable?
Разберитесь в этом вопросе, и вы значительно повысите уровень своей компетенции.
Что такое cURL в PHP? Встроенные функции и пример GET запроса
Что такое cURL в PHP? Встроенные функции и пример GET запроса
Клиент для URL-адресов, cURL, позволяет взаимодействовать с множеством различных серверов по множеству различных протоколов с синтаксисом URL.
0
2
33
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

Ответ принят как подходящий

Вы можете использовать функцию 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,055,94 ± 0,076,59 ± 0,09<0,0010,126100,61871
Сепал.Ширина3,43 ± 0,052,77 ± 0,042,97 ± 0,05<0,0010,083210,40078
Лепесток.Длина1,46 ± 0,024,26 ± 0,075,55 ± 0,08<0,0010,105410,94137
Лепесток.Ширина0,25 ± 0,011,33 ± 0,032,03 ± 0,04<0,0010,050130,92888

Created on 2022-04-24 by the reprex package (v2.0.1)

Привет, доктор Шоберг. Да, это именно то, что я ищу! Большое спасибо за ваш быстрый ответ!

Khanh Nguyen 25.04.2022 02:59

Другие вопросы по теме