在 purrr::map 之后使用 kableExtra 为 broom::tidy 对象生成 HTML 表格

Question

这个问题与我之前在here上发布的问题相关。

使用这些玩具数据集，

testdata <- structure(list(subject = c("B001", "B001", "B001", "B001", "B001", 
"B002", "B002", "B002", "B002", "B002", "B003", "B003", "B003", 
"B003", "B003", "B004", "B004", "B004", "B004", "B004", "B005", 
"B005", "B005", "B005", "B005"), time_point = structure(c(1L, 
2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 
3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L), levels = c("Wk0", "Wk4", "Wk8", 
"Wk12", "Wk16"), class = "factor"), sfa = c(62.895, 84.705, 83.49, 
66.64, 72.19, 56.195, 93.945, 92.635, 88.51, 83.505, 92.67, 90.81, 
83.37, 90.205, 84.195, 88.065, 53.69, 93.14, 52.57, 95.995, 63.505, 
92.59, 80.87, 89.125, 67.305), mufa = c(14.455, 11.71, 12.58, 
21.135, 26.175, 13.285, 4.91, 6.08, 6.735, 12.745, 7.325, 7.605, 
15.735, 7.985, 12.32, 7.92, 42.045, 4.57, 24.305, 4.505, 18.585, 
5.955, 14.815, 8.775, 20.295), pufa = c(22.65, 3.58, 3.935, 12.23, 
1.635, 30.525, 1.135, 1.275, 4.76, 3.75, 0, 1.595, 0.885, 1.82, 
3.495, 4.01, 4.26, 2.29, 23.125, 0, 17.905, 1.455, 4.305, 2.1, 
12.4)), row.names = c(NA, -25L), class = c("tbl_df", "tbl", "data.frame"
))

我可以使用下面的代码生成多个单表

test1 <- lmer(sfa ~ time_point + (1| subject), data = testdata)
test2 <- lmer(mufa ~ time_point + (1| subject), data = testdata)
test3 <- lmer(pufa ~ time_point + (1| subject), data = testdata)

tidy(test1) %>%
  kbl() %>%
  kable_styling(font_size = 8)
tidy(test2) %>%
  kbl() %>%
  kable_styling(font_size = 8)
tidy(test3) %>%
  kbl() %>%
  kable_styling(font_size = 8)

然后在 R Markdown 中将它们渲染为 HTML 文档。

为了坚持 DRY 原则，我尝试使用

purrr::map()

如下

testdata |> 
  select(sfa:pufa) |>
  map(~ lmer(.x ~ time_point + (1| subject), data = testdata)) |>
  map( ~ tidy(.x) |> 
         kbl() |> 
         kable_styling()) 

但是，我得到了这些

如何使用

purrr::map

、

broom::tidy

和

kableExtra

在 HTML 中渲染多个单个表格？

Answer 1

由于您没有包含 Rmd 代码，我只能猜测缺少的部分是块选项

results='asis'

。

---
output: html_document
date: "2023-11-28"
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

```{r echo=FALSE}
testdata <- structure(list(subject = c(
  "B001", "B001", "B001", "B001", "B001",
  "B002", "B002", "B002", "B002", "B002", "B003", "B003", "B003",
  "B003", "B003", "B004", "B004", "B004", "B004", "B004", "B005",
  "B005", "B005", "B005", "B005"
), time_point = structure(c(
  1L,
  2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L, 1L, 2L,
  3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L
), levels = c(
  "Wk0", "Wk4", "Wk8",
  "Wk12", "Wk16"
), class = "factor"), sfa = c(
  62.895, 84.705, 83.49,
  66.64, 72.19, 56.195, 93.945, 92.635, 88.51, 83.505, 92.67, 90.81,
  83.37, 90.205, 84.195, 88.065, 53.69, 93.14, 52.57, 95.995, 63.505,
  92.59, 80.87, 89.125, 67.305
), mufa = c(
  14.455, 11.71, 12.58,
  21.135, 26.175, 13.285, 4.91, 6.08, 6.735, 12.745, 7.325, 7.605,
  15.735, 7.985, 12.32, 7.92, 42.045, 4.57, 24.305, 4.505, 18.585,
  5.955, 14.815, 8.775, 20.295
), pufa = c(
  22.65, 3.58, 3.935, 12.23,
  1.635, 30.525, 1.135, 1.275, 4.76, 3.75, 0, 1.595, 0.885, 1.82,
  3.495, 4.01, 4.26, 2.29, 23.125, 0, 17.905, 1.455, 4.305, 2.1,
  12.4
)), row.names = c(NA, -25L), class = c("tbl_df", "tbl", "data.frame"))
```

```{r include=FALSE}
library(tidyverse)
library(broom)
library(broom.mixed)
library(lme4)
library(kableExtra)
```

```{r results='asis'}
testdata |>
  select(sfa:pufa) |>
  map(~ lmer(
    .x ~ time_point + (1| subject),
    data = testdata
  )) |>
  map(~ tidy(.x) |>
    kbl() |>
    kable_styling(font_size = 8))
```