组合 add_header_above 和 spec_pointrange 以创建带分组的 table

Combining add_header_above and spec_pointrange to create a table with grouping

KableExtra 有一些非常好的功能,允许您使用 add_header_above 创建 table 和分组列,以及在 table 中呈现可视化效果。现在,我想知道是否可以将这两个功能结合起来?我想同时创建一个包含分组列和可视化的 table。

例如,假设示例数据 1 和 2 是两个不同分析的结果,但具有相同的兴趣变量,我想在相同的 table 中但在不同的组中呈现与此一致:https://cran.r-project.org/web/packages/kableExtra/readme/README.html.

有没有办法将这两个 table 合并为一个 table?

示例数据 1:

explanatory_var <- c("Urban", NA, "Married", NA, "Birth year", NA, NA, NA, NA)
levels <- c("No", "Yes", "No", "Yes", "1960", "1970", "1980", "1990", "2000")
hr <- c(NA, 0.96, NA, 0.51, NA, 1.95, 1.67, 1.46, 1.34)
low <- c(NA, 0.7, NA, 0.37, NA, 0.52, 0.52, 0.51, 0.5)
high <- c(NA, 1.32, NA, 0.71, NA, 1.77, 1.85, 2.26, 2.15)

dat <- tibble(explanatory_var, levels, hr, low, high)

data.frame(
  variable = dat$explanatory_var,
  factors = dat$levels,
  estimates = dat$hr,
  visualisation = ""
) %>%
  kable(booktabs = TRUE, linesep = "", caption = "HR", col.names = c("", "", "Estimates", "HR (95 % CI)")) %>% 
  kable_styling(latex_options = c("scale_down", "hold_position")) %>%
  column_spec(4, image = spec_pointrange(
    x = dat$hr,
    xmin = dat$low,
    xmax = dat$high,
    vline = 1)
  )

示例数据 2:

explanatory_var2 <- c("Urban", NA, "Married", NA, "Birth year", NA, NA, NA, NA)
levels2 <- c("No", "Yes", "No", "Yes", "1960", "1970", "1980", "1990", "2000")
hr2 <- c(NA, 0.8, NA, 0.41, NA, 1.7, 1.5, 1.3, 1.3)
low2 <- c(NA, 0.6, NA, 0.3, NA, 0.4, 0.6, 0.5, 0.5)
high2 <- c(NA, 1.3, NA, 0.7, NA, 1.7, 1.6, 2, 2.2)

dat2 <- tibble(explanatory_var2, levels2, hr2, low2, high2)

data.frame(
  variable = dat2$explanatory_var2,
  factors = dat2$levels2,
  estimates = dat2$hr2,
  visualisation = ""
) %>%
  kable(booktabs = TRUE, linesep = "", caption = "HR", col.names = c("", "", "Estimates", "HR (95 % CI)")) %>% 
  kable_styling(latex_options = c("scale_down", "hold_position")) %>%
  column_spec(4, image = spec_pointrange(
    x = dat2$hr2,
    xmin = dat2$low2,
    xmax = dat2$high2,
    vline = 1)
  )

这可能有效:

library(kableExtra)

tab0 <- data.frame(
  variable = dat$explanatory_var,
  factors = dat$levels,
  estimates = dat$hr,
  visualisation = "")

tab1 <- data.frame(
  variable = dat2$explanatory_var2,
  factors = dat2$levels2,
  estimates = dat2$hr2,
  visualisation = "")

tab_merge <- cbind(tab0, tab1) # merge both
tab_merge <- tab_merge[,c(1:4, 7:8)] # exclude duplicates

tab_merge %>%
  kable(booktabs = TRUE, linesep = "", caption = "HR", col.names = c("", "", "Estimates", "HR (95 % CI)",
                                                                     "Estimates", "HR (95 % CI)")) %>% 
  kable_styling(latex_options = c("scale_down", "hold_position")) %>%
  column_spec(4, image = spec_pointrange(
    x = dat2$hr2,
    xmin = dat2$low2,
    xmax = dat2$high2,
    vline = 1)) %>%
  column_spec(6, image = spec_pointrange(
    x = dat2$hr2,
    xmin = dat2$low2,
    xmax = dat2$high2,
    vline = 1)) %>%
  add_header_above(c(" " = 2, "dat" = 2, "dat2" = 2))

-输出