Проблема с изменением цифр в 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
Стоит ли изучать PHP в 2023-2024 годах?
Стоит ли изучать PHP в 2023-2024 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
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

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