Я наткнулся на проблему, когда хочу, чтобы в R markdown были и выходные данные kable, и таблицы форматирования. Используя этот пост, я создал структуру для печати двух форматируемых наборов данных один за другим с помощью lapply. Код ниже работает точно так, как я хотел
do.call(div,
invisible(lapply(1:3, function(i) {
obj1 <- div(paste("Text", i, "goes here. \n"),
show_plot(print(get_format_table(df))))
obj2 <- div(paste("Text", i, "goes here. \n"),
show_plot(print(get_format_table(df1))))
list(obj1, obj2)
}
, давая результат
введите описание изображения здесь
Но проблема началась с kable стол. Без переноса print он дает текст html в документе
foo1 <- function(data, i) {
knitr::kable(data, caption = paste("Text", i, "goes here."), "html") %>%
kableExtra::kable_styling(.)
}
do.call(div,
invisible(lapply(1:3, function(i) {
obj1 <- div(paste("Text", i, "goes here. \n"),
show_plot(print(get_format_table(df))))
obj2 <- div(paste("Text", i, "goes here. \n"),
show_plot(print(get_format_table(df1))))
list(foo1(df, i), obj1, obj2)
}
))
)
введите описание изображения здесь
Когда я оборачиваю print на kable, он печатает два раза даже после использования invisible.
foo1 <- function(data, i) {
knitr::kable(data, caption = paste("Text", i, "goes here."), "html") %>%
kableExtra::kable_styling(.)
}
do.call(div,
invisible(lapply(1:3, function(i) {
obj1 <- div(paste("Text", i, "goes here. \n"),
show_plot(print(get_format_table(df))))
obj2 <- div(paste("Text", i, "goes here. \n"),
show_plot(print(get_format_table(df1))))
list(print(foo1(df, i)), obj1, obj2)
}
))
)
введите описание изображения здесь
В идеале он должен печатать только это (в порядке то есть Text1 kable plot, Text1 formattable plot, Text1 formattable plot2, Text2 kable plot, Text2 formattable plot, Text2 formattable plot2, ...
введите здесь описание изображения
Кто-нибудь знает, как исправить код. Я вставляю полный код ниже
---
title: "testing"
author: "xyz"
date: "30/07/2020"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r formattable, echo = FALSE}
library(formattable)
library(htmltools)
suppressMessages(library(dplyr))
df <- data.frame(
id = 1:10,
name = c("Bob", "Ashley", "James", "David", "Jenny",
"Hans", "Leo", "John", "Emily", "Lee"),
test1_score = c(8.9, 9.5, 9.6, 8.9, 9.1, 9.3, 9.3, 9.9, 8.5, 8.6)
)
df1 <- data.frame(
id = 1:3,
name = c("Hal", "Bal", "Sal"),
test1_score = c(24, 31, 32)
)
```
```{r create_functions, echo=FALSE}
get_format_table <- function(data) {
return(formattable::formattable(data, list(test1_score = color_bar("pink"))))
}
show_plot <- function(plot_object) {
div(style="margin:auto;text-align:center", plot_object)
}
foo1 <- function(data, i) {
knitr::kable(data, caption = paste("Text", i, "goes here."), "html") %>%
kableExtra::kable_styling(.)
}
```
```{r output, echo = FALSE, include = TRUE, results = 'asis'}
do.call(div,
invisible(lapply(1:3, function(i) {
obj1 <- div(paste("Text", i, "goes here. \n"),
show_plot(print(get_format_table(df))))
obj2 <- div(paste("Text", i, "goes here. \n"),
show_plot(print(get_format_table(df1))))
list(print(foo1(df, i)), obj1, obj2)
}
))
)
```
К сожалению, for циклы не работают с таблицей форматирования и lapply дублируют печать для kable