R 中频率表的舍入

Question

我想知道是否有精通 R/RMarkdown 的人能够指导我解决问题。我希望生成一个频率表，到目前为止，我一直在使用 arsenal 包的 tableby，因为它可以轻松方便地集成到 RMarkdown docx/html 中。然而，我被要求提供四舍五入的频率（精确到最接近的 5 或 10），并且一直在尝试寻找方法来做到这一点，但没有取得太大成功。

我生成了一个假的简单数据集，因为出于保密原因我无法共享我的数据，这就是我制作普通表的方式。

set.seed(1234)

library(dplyr)
library(arsenal)

x1 <- c(rep("Man",40),rep("Woman",60)) %>% as.factor()
x2 <- sample(c("Sick","Healthy"),100,replace=TRUE) %>% as.factor()

df <- data.frame(x1,x2)

Control_notrounded <- tableby.control(digits=0,digits.pct=2,cat.stats=c("countpct","Nmiss2"))

table <- tableby(x1~x2,control=Control_notrounded,data=df)
print(summary(table))

但是，即使使用传统舍入函数四舍五入到最接近的 10 是通过传递digits=-1 来执行的，但这似乎不是该函数的有效方法，因为我收到一条警告，指示数字必须 >=0。

Control_rounded <- tableby.control(digits=-1,digits.pct=2,cat.stats=c("countpct","Nmiss2"))
table2 <- tableby(x1~x2,control=Control_rounded,data=df)
print(summary(table2))

有什么办法可以做到吗？否则，是否有人有一个替代包可以允许创建具有舍入值的相对简单的频率表？

Answer 1

我可以建议使用

gtsummary

包来创建基线表 - 然后尝试我在其他地方描述的以下

round_5_gtsummary()

函数（在 https://github.com/zheer-kejlberg/gtsummary-round5） :

set.seed(1234)

library(dplyr)
library(gtsummary)
library(stringr)

x1 <- c(rep("Man",40),rep("Woman",60)) %>% as.factor()
x2 <- sample(c("Sick","Healthy"),100,replace=TRUE) %>% as.factor()
df <- data.frame(x1,x2)

round_5_gtsummary <- function(table) {
  round_5 <- function(x) { round(x/5)*5 }
  round_5_get_summary <- function(x, N, decimals = 1) {
    x <- stringr::str_remove(x, " \\([<]*[0-9]*[,]*[0-9]*[.]*[0-9]*%\\)$")
    x <- as.numeric(stringr::str_remove(x, ","))
    if (x > N-5) {
      N <- round_5(N)
      return(paste0(">", N-5, "(>", round((N-5)/N*100, decimals), "%)"))
    } else if (x >= 5) {
      return(paste0(round_5(x), " (", round(round_5(x)/round_5(N)*100,decimals),"%)"))
    } else {
      return(paste0("<", 5," (<", round(5/round_5(N)*100,decimals),"%)"))
    }
  }
  body <- table$table_body
  stats_column_indices <- which(grepl("^stat_", colnames(body)))
  Ns <- table$table_styling$header$modify_stat_n[c(stats_column_indices)]
  table$table_styling$header$label[c(stats_column_indices)] <- paste0("**", table$table_styling$header$modify_stat_level[c(stats_column_indices)], "**", ", N = ", round_5(Ns))
  for (column_no in stats_column_indices) {
    column <- pull(body, column_no)
    cat_indices <- (body$var_type == "categorical" | body$var_type == "dichotomous" | body$label == "Unknown") & !is.na(body$stat_1)
    column[cat_indices] <- sapply(column[cat_indices], round_5_get_summary, N = Ns[column_no-5])
    table$table_body[column_no] <- column
  }
  return(table)
}

df %>% tbl_summary(by = "x1") %>% 
  add_overall(last = TRUE) %>% 
  round_5_gtsummary()  %>%
  add_p()

结果：