使用 dplyr 創建多功能描述表

Question

我正在嘗試創建一個簡單的代碼，我可以一遍又一遍地重用（只需最少的調整），以便能夠打印匯總統計表。

一個可重現的示例為按組分解的變量V1創建一個包含 M 和 SD 的表：

data <- as.data.frame(cbind(1:100, sample(1:2), rnorm(100), rnorm(100)))
names(data) <- c("ID", "Group", "V1", "V2")


library(dplyr)
descriptives <- data %>% group_by(Group) %>%
  summarize(
    Mean = mean(V2)
    , SD = sd(V2)
  )

descriptives

我想修改這個函數，以便它為我的數據集中的所有變量計算 M 和 SD。

我希望能夠用類似vars東西替換對V1的調用，它只是我數據集中所有變量的列表； 在這個例子中，V1 和 V2。 但通常我有 100 個變量。 我希望它以這種方式工作的原因是，我可以做一些非常簡單的事情，例如：

vars <- names(data[3:4])

並非常快速地選擇我想要匯總統計的列。

我的願望清單有幾件事：

給定變量的 M 和 SD 應該彼此相鄰，我想在每對上方添加一個帶有變量名稱的列。

我希望最終產品看起來像

我想使用 dplyr，但我願意接受其他選擇。 我還想了解如何切換表的行和列，以便變量位於不同的行上，並且每個組都有一列（或兩列，一列用於 M，另一列用於 SD）。 像這樣：

關閉，但沒有雪茄：

1. newish summarise(across()) 有助於：

dplyr::group_by(df, Group) %>% 
  dplyr::summarise(dplyr::across(.cols = c(V1, V2), .fns = c(mean, sd)))

但是我不知道如何在不制作多個表並使用rbind()堆疊它們的情況下對其進行縮放。

2. 我真的很喜歡table1() （ 小插圖）的格式，但據我所知，我只能按另一個變量對列 M/SD 進行分層。 我真的希望我可以添加額外的分組變量。

Answer 1

排序有限制，但如果我們使用select ，則可以對列名上的子字符串重新排序

library(dplyr)
library(stringr)
data %>%
    group_by(Group) %>% 
    summarise_at(vars(vars), list(Mean = mean, SD = sd)) %>% 
    select(Group, order(str_remove(names(.)[-1], "_.*")) + 1)
# A tibble: 2 x 5
#  Group V1_Mean V1_SD  V2_Mean V2_SD
#  <dbl>   <dbl> <dbl>    <dbl> <dbl>
#1     1   0.165 0.915  0.146   1.16 
#2     2   0.308 1.31  -0.00711 0.854

Answer 2

在dplyr之外，您可以使用tables包，它允許從表公式中創建匯總統計信息：

library(tables)

vars <- c("V1","V2")
vars <- paste(vars, collapse="+")

table <- as.formula(paste("(group = factor(Group)) ~ (", vars ,")*(mean+sd)"))
table
# (group = factor(Group)) ~ (V1 + V2) * (mean + sd)

tables::tabular(table, data = data)
#       V1              V2            
# group mean     sd     mean    sd    
# 1     -0.15759 0.9771  0.1405 1.0697
# 2      0.05084 0.9039 -0.1470 0.9949

Answer 3

我在這里有一個類似的問題，並使用tidyverse得到了一些非常有用和簡單的答案。 最后提出了一個非常強大的方法，我將其封裝在一個function並定期使用。

library(tidyverse)

baseline_table <- function(data, variables, grouping_var) {
        
        
        data %>% 
                group_by(!!sym(grouping_var)) %>% 
                summarise(
                        across(
                                all_of(variables),
                                ~ paste0(mean(.) %>% round(2), "(±", sd(.) %>% round(2), ")")
                        )
                ) %>% pivot_longer(
                        cols = -grouping_var,
                        names_to = "variable"
                ) %>% pivot_wider(
                        names_from = grouping_var
                )
        
        
        
}

它需要三個arguments ， data ， variables和grouping_var - 所有這些都是不言自明的。

這是使用帶有2 level和3 level分組mtcars的測試。

baseline_table(
        data = mtcars,
        variables = c("mpg", "hp"),
        grouping_var = "am"
)

# A tibble: 2 x 3
  variable `0`            `1`           
  <chr>    <chr>          <chr>         
1 mpg      17.15(±3.83)   24.39(±6.17)  
2 hp       160.26(±53.91) 126.85(±84.06)

---

baseline_table(
        data = mtcars,
        variables = c("mpg", "hp"),
        grouping_var = "cyl"
)

# A tibble: 2 x 4
  variable `4`           `6`            `8`           
  <chr>    <chr>         <chr>          <chr>         
1 mpg      26.66(±4.51)  19.74(±1.45)   15.1(±2.56)   
2 hp       82.64(±20.93) 122.29(±24.26) 209.21(±50.98)

它開箱即用，適用於所有data ，下面我使用了iris ，

baseline_table(
        data = iris,
        variables = c("Sepal.Length", "Sepal.Width"),
        grouping_var = "Species"
)

# A tibble: 2 x 4
  variable     setosa      versicolor  virginica  
  <chr>        <chr>       <chr>       <chr>      
1 Sepal.Length 5.01(±0.35) 5.94(±0.52) 6.59(±0.64)
2 Sepal.Width  3.43(±0.38) 2.77(±0.31) 2.97(±0.32)

當然; 一些grouping variables並不直接適用於此。 即cyl但它確實是一個很好的例子。 但您可以相應地重新編碼grouping variables ，

baseline_table(
        data = mtcars %>% mutate(cyl = paste(cyl, "Cylinders", sep = " ")),
        variables = c("mpg", "hp"),
        grouping_var = "cyl"
)

# A tibble: 2 x 4
  variable `4 Cylinders` `6 Cylinders`  `8 Cylinders` 
  <chr>    <chr>         <chr>          <chr>         
1 mpg      26.66(±4.51)  19.74(±1.45)   15.1(±2.56)   
2 hp       82.64(±20.93) 122.29(±24.26) 209.21(±50.98)

您還可以修改函數以包含描述性字符串，關於values ，

baseline_table <- function(data, variables, grouping_var) {
        
        # Generate the table; 
        tmpTable <- data %>% 
                group_by(!!sym(grouping_var)) %>% 
                summarise(
                        across(
                                all_of(variables),
                                ~ paste0(mean(.) %>% round(2), "(±", sd(.) %>% round(2), ")")
                        )
                ) %>% pivot_longer(
                        cols = -grouping_var,
                        names_to = "variable"
                ) %>% pivot_wider(
                        names_from = grouping_var
                )
        
        # Generate Descriptives dynamically
        tmpDesc <- tmpTable[1,] %>% mutate(
                across(.fns = ~ paste("Mean (±SD)"))
        ) %>% mutate(
                variable = ""
        )
        
        
        bind_rows(
                tmpDesc,
                tmpTable
        )
        
        
        
}

當然，這個擴展有點笨拙 - 但它仍然很健壯。 output是，

# A tibble: 3 x 4
  variable `4 Cylinders` `6 Cylinders`  `8 Cylinders` 
  <chr>    <chr>         <chr>          <chr>         
1 ""       Mean (±SD)    Mean (±SD)     Mean (±SD)    
2 "mpg"    26.66(±4.51)  19.74(±1.45)   15.1(±2.56)   
3 "hp"     82.64(±20.93) 122.29(±24.26) 209.21(±50.98)

更新：如評論中所述，我已經重寫了該function以增加靈活性。

library(tidyverse)

baseline_table <- function(data, variables, grouping_var) {

        data %>% 
                group_by(!!!syms(grouping_var)) %>% 
                summarise(
                        across(
                                all_of(variables),
                                ~ paste0(mean(.) %>% round(2), "(±", sd(.) %>% round(2), ")")
                        )
                ) %>% unite(
                        "grouping",
                        all_of(grouping_var)
                ) %>% pivot_longer(
                        cols = -"grouping",
                        names_to = "variables"
                ) %>% pivot_wider(
                        names_from = "grouping"
                )
}

它以相同的方式工作，並且輸出相同，除非有多個grouping_var ，

baseline_table(
        mtcars,
        variables = c("hp", "mpg"),
        grouping_var = c("am", "cyl")
)

# A tibble: 2 x 7
  variables `0_4`         `0_6`         `0_8`          `1_4`         `1_6`          `1_8`       
  <chr>     <chr>         <chr>         <chr>          <chr>         <chr>          <chr>       
1 hp        84.67(±19.66) 115.25(±9.18) 194.17(±33.36) 81.88(±22.66) 131.67(±37.53) 299.5(±50.2)
2 mpg       22.9(±1.45)   19.12(±1.63)  15.05(±2.77)   28.08(±4.48)  20.57(±0.75)   15.4(±0.57) 

在更新的function我使用了unite和一個默認的seperator 。 顯然，您可以修改它以滿足您的需求，例如，列colnames表示，例如4 Cylinder (Automatic) 6 Cylinder (Automatic)等。

Answer 4

原始代碼的輕微變化，如果您指定不需要 ID（或已經分組的組）列，而是其他所有內容，則可以更簡單/靈活地使用across() ：

data %>%
  group_by(Group) %>%
  summarize(across(-ID, .fns = list(Mean = mean, SD = sd), .names = "{.col}_{.fn}"))

# A tibble: 2 x 5
  Group V1_Mean V1_SD V2_Mean V2_SD
  <dbl>   <dbl> <dbl>   <dbl> <dbl>
1     1 -0.0167 0.979   0.145  1.02
2     2  0.119  1.11   -0.277  1.05

編輯：如果你想准確地創建你的（第一個）目標，你可以使用gt包來制作一個帶有列扳手的 html 表：

data %>%
  group_by(Group) %>%
  summarize(across(-ID, .fns = list(Mean = mean, SD = sd), .names = "{.col}_{.fn}")) %>%
  gt::gt() %>%
  gt::tab_spanner_delim("_") %>%
  gt::fmt_number(-Group, decimals = 2)

至於你的另一個問題，你可以交替地做這樣的事情來獲得組合和轉置的變化：

data %>%
  group_by(Group) %>%
  summarize(across(-ID, .fns = ~paste0(
    sprintf("%.2f", mean(.x)),
    sprintf(" (%.2f)", sd(.x))))) %>%
  t() %>%
  as.data.frame() 


               V1           V2
Group            1            2
V1    -0.02 (0.98)  0.12 (1.11)
V2     0.15 (1.02) -0.28 (1.05)

Answer 5

制作精美匯總表的一種方法是使用名為gtsummary的包（請注意，我是該包的合著者，僅供參考）。 下面我只是在data2稍微格式化數據並刪除ID變量。 然后是對 gtsummary 的兩行調用來匯總您的數據。 by 語句對表格進行分層，在統計輸入中，我只是告訴顯示平均值和標准差，默認情況下 gtsummary 將顯示中位數 q1-q3。 此表可以在所有降價選項（word、pdf、html）中呈現。

library(dplyr)
library(gtsummary)
data <- as.data.frame(cbind(1:100, sample(1:2), rnorm(100), rnorm(100)))
names(data) <- c("ID", "Group", "V1", "V2")

data2 <- data %>% 
          mutate(Group = ifelse(Group == 1, "Group Var1","Group Var2")) %>%
          select(-ID)

tbl_summary(data2, by = Group,
            statistic = all_continuous()~ "{mean} ({sd})")

如果您想要多個層但不想使用tbl_strata您可以將兩個變量合並為一列並在 by 語句中使用它。 您可以根據需要unite()盡可能多的變量（盡管可能不推薦）

trial %>%
  tidyr::unite(col = "trt_grade", trt, grade, sep = ", ") %>% 
    select(age, marker,stage,trt_grade) %>%
    tbl_summary(by = c(trt_grade))

Answer 6

一個data.table選項

dcast(
  setDT(data)[,
    c(
      .(Meas = c("M", "Sd")),
      lapply(.SD, function(x) c(mean(x), sd(x)))
    ),
    Group,
    .SDcols = patterns("V\\d")
  ], Group ~ Meas,
  value.var = c("V1", "V2")
)

給

   Group       V1_M    V1_Sd        V2_M     V2_Sd
1:     1 -0.2392583 1.097343 -0.08048455 0.7851212
2:     2  0.1059716 1.011769 -0.23356373 0.9927975

Answer 7

您還可以使用基礎 R：

# using do.call to make the result a data.frame
do.call(
       data.frame
        # here you aggregate for all the functions you need
      ,(aggregate(. ~ Group, data = data[,-1], FUN = function(x) c(mn = mean(x), sd = sd(x))))
       )

這導致了這樣的事情：

 Group      V1.mn    V1.sd      V2.mn    V2.sd
1     1  0.1239868 1.008214 0.07215481 1.026059
2     2 -0.2324611 1.048230 0.11348897 1.071467

如果你想要一張更漂亮的桌子， kableExtra真的kableExtra 。 請注意， %>%應該在kableExtra導入，但以防萬一，從 R 4.1 開始，您可以使用|>代替它：

library(kableExtra)
# data manipulation as above, note the [,-1] to remove the Group column
do.call(
        data.frame
       ,(aggregate(. ~ Group, data = data[,-1], FUN = function(x) c(mn = mean(x), sd = sd(x)))))[,-1] %>%
  # here you define as a kable, and give the names you want to columns
  kbl(col.names = rep(c('mean','sd'),2)  ) %>%
  # some formatting
  kable_paper() %>%
  # adding the first header
  add_header_above(c( "Group 1" = 2, "Group 2" = 2)) %>%
  # another header if you need it
  add_header_above(c( "Big group" = 4)) 

你可以找到更多來制作很棒的桌子。

---

萬一，你也可以嘗試這樣的事情：

do.call(data.frame,
        aggregate(. ~ Group, data = data[,-1], FUN = function(x) paste0(round(mean(x),2),' (', round(sd(x),2),')'))
        ) %>%
 kbl() %>%
 kable_paper()

這導致：