diff --git a/DESCRIPTION b/DESCRIPTION
index 886ba3c1d..5cef2eda3 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -29,6 +29,7 @@ Depends:
teal (>= 1.0.0.9003),
teal.transform (>= 0.7.0)
Imports:
+ base64enc (>= 0.1-3),
bslib (>= 0.8.0),
checkmate (>= 2.1.0),
colourpicker (>= 1.3.0),
@@ -48,6 +49,7 @@ Imports:
lattice (>= 0.18-4),
lifecycle (>= 0.2.0),
MASS (>= 7.3-60),
+ rmarkdown (>= 2.23),
rtables (>= 0.6.11),
scales (>= 1.3.0),
shinyjs (>= 2.1.0),
@@ -73,7 +75,6 @@ Suggests:
nestcolor (>= 0.1.0),
pkgload,
rlang (>= 1.0.0),
- rmarkdown (>= 2.23),
roxy.shinylive,
rvest,
shinytest2,
diff --git a/NAMESPACE b/NAMESPACE
index 302a2f68e..10d634628 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -8,6 +8,8 @@ S3method(create_sparklines,default)
S3method(create_sparklines,factor)
S3method(create_sparklines,logical)
S3method(create_sparklines,numeric)
+S3method(teal.reporter::to_rmd,markdown_internal)
+S3method(tools::toHTML,markdown_internal)
export(add_facet_labels)
export(get_scatterplotmatrix_stats)
export(tm_a_pca)
@@ -23,6 +25,7 @@ export(tm_g_scatterplot)
export(tm_g_scatterplotmatrix)
export(tm_missing_data)
export(tm_outliers)
+export(tm_rmarkdown)
export(tm_t_crosstable)
export(tm_variable_browser)
import(ggplot2)
diff --git a/R/tm_rmarkdown.R b/R/tm_rmarkdown.R
new file mode 100644
index 000000000..2815a63c3
--- /dev/null
+++ b/R/tm_rmarkdown.R
@@ -0,0 +1,329 @@
+#' `teal` module: Rmarkdown render
+#'
+#' Module to render R Markdown files using the data provided in the `teal_data` object.
+#'
+#' The R Markdown file should be designed to accept variables available in the datanames of the module.
+#'
+#' For example, if the `teal_data` object contains datasets named "mtcars" and "iris",
+#' the R Markdown file can use these as variables as they will be available in the R Markdown environment.
+#'
+#' The libraries used in the R Markdown file must be available in the deployed shiny
+#' app environment.
+#'
+#' When developing the R Markdown file, the working data can be simulated on a code chunk,
+#' which in turn can look for the presence of `.raw_data` object to determine if it is being
+#' run inside the `teal` module or not.
+#'
+#' Example R markdown file:
+#'
+#' ``````md
+#' ---
+#' title: "R Markdown Report"
+#' output: html_document
+#' ---
+#'
+#' ```{r eval=!exists(".raw_data")}
+#' mtcars <- datasets::mtcars
+#' iris <- datasets::iris
+#' ```
+#'
+#' ```{r}
+#' summary(mtcars) |> print()
+#' summary(iris) |> print()
+#' ```
+#' ``````
+#'
+#' @inheritParams teal::module
+#' @inheritParams shared_params
+#'
+#' @param rmd_content (`character`) Content of the R Markdown file to be rendered.
+#' This can be the value of `readLines("path/to/file.Rmd")`.
+#' @param allow_download (`logical`) whether to allow downloading of the R Markdown file.
+#' Defaults to `TRUE`.
+#' @param extra_transform (`list`) of [teal::teal_transform_module()] that will be added in the module's UI.
+#' This can be used to create interactive inputs that modify the parameters in R Markdown rendering.
+#'
+#' @inherit shared_params return
+#'
+#' @inheritSection teal::example_module Reporting
+#'
+#' @examplesShinylive
+#' library(teal.modules.general)
+#' interactive <- function() TRUE
+#' {{ next_example }}
+#' @examples
+#'
+#' # general data example
+#' data <- teal_data()
+#' data <- within(data, {
+#' CO2 <- CO2
+#' })
+#'
+#' app <- init(
+#' data = data,
+#' modules = modules(
+#' tm_rmarkdown(
+#' label = "RMarkdown Module",
+#' rmd_content = c(
+#' "---",
+#' "title: \"R Markdown Report\"",
+#' "output: html_document",
+#' "---",
+#' "",
+#' "```{r}",
+#' "summary(CO2) |> print()",
+#' "```"
+#' )
+#' )
+#' )
+#' )
+#' if (interactive()) {
+#' shinyApp(app$ui, app$server)
+#' }
+#'
+#' @examples
+#' nrow_transform <- teal_transform_module(
+#' label = "N Rows selector",
+#' ui = function(id) {
+#' ns <- NS(id)
+#' tags$div(
+#' numericInput(ns("n_rows"), "Show n rows", value = 5, min = 0, max = 200, step = 5)
+#' )
+#' },
+#' server = function(id, data) {
+#' moduleServer(id, function(input, output, session) {
+#' reactive({
+#' req(data())
+#' within(data(),
+#' {
+#' n_rows <- n_rows_value
+#' },
+#' n_rows_value = input$n_rows
+#' )
+#' })
+#' })
+#' }
+#' )
+#'
+#' app <- init(
+#' data = data,
+#' modules = modules(
+#' tm_rmarkdown(
+#' label = "RMarkdown Module",
+#' rmd_content = readLines(system.file(file.path("sample_files", "test.Rmd"), package = "teal.modules.general")),
+#' allow_download = FALSE,
+#' extra_transform = list(nrow_transform)
+#' )
+#' )
+#' ) |> shiny::runApp()
+#' @export
+tm_rmarkdown <- function(label = "RMarkdown Module",
+ rmd_content,
+ datanames = "all",
+ allow_download = TRUE,
+ pre_output = NULL,
+ post_output = NULL,
+ transformators = list(),
+ extra_transform = list()) {
+ message("Initializing tm_rmarkdown")
+
+ # Start of assertions
+
+ checkmate::assert_string(label)
+ checkmate::assert_character(rmd_content)
+ checkmate::assert_flag(allow_download)
+
+ checkmate::assert_multi_class(pre_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
+ checkmate::assert_multi_class(post_output, c("shiny.tag", "shiny.tag.list", "html"), null.ok = TRUE)
+
+ # End of assertions
+
+ # Make UI args
+ args <- as.list(environment())
+
+ ans <- module(
+ label = label,
+ server = srv_rmarkdown,
+ server_args = list(rmd_content = rmd_content, allow_download = allow_download, extra_transform = extra_transform),
+ ui = ui_rmarkdown,
+ ui_args = args,
+ transformators = transformators,
+ datanames = datanames
+ )
+ # attr(ans, "teal_bookmarkable") <- TRUE
+ disable_src(ans)
+}
+
+# UI function for the rmarkdown module
+ui_rmarkdown <- function(id, rmd_content, allow_download, extra_transform, ...) {
+ args <- list(...)
+ ns <- NS(id)
+
+ teal.widgets::standard_layout(
+ output = teal.widgets::white_small_well(
+ tags$div(
+ tags$h4("Rendered report from Rmd"),
+ if (allow_download) {
+ downloadButton(
+ ns("download_rmd"),
+ sprintf("Download R Markdown file"),
+ class = "btn-primary btn-sm"
+ )
+ },
+ ui_transform_teal_data(ns("extra_transform"), transformators = extra_transform)
+ ),
+ tags$hr(),
+ uiOutput(ns("rmd_output"))
+ ),
+ encoding = NULL,
+ pre_output = args$pre_output,
+ post_output = args$post_output
+ )
+}
+
+# Server function for the rmarkdown module
+srv_rmarkdown <- function(id, data, rmd_content, allow_download, extra_transform) {
+ checkmate::assert_class(data, "reactive")
+ checkmate::assert_class(isolate(data()), "teal_data")
+ moduleServer(id, function(input, output, session) {
+ pre_decorated_q_r <- reactive({
+ data_q <- req(data())
+ teal.reporter::teal_card(data_q) <- c(
+ teal.reporter::teal_card(data_q),
+ teal.reporter::teal_card("## Module's output(s)")
+ )
+ data_q
+ })
+
+ q_r <- data_with_output_decorated <- teal::srv_transform_teal_data(
+ "extra_transform",
+ data = pre_decorated_q_r,
+ transformators = extra_transform
+ )
+
+ if (allow_download) {
+ output$download_rmd <- downloadHandler(
+ filename = function() "teal_module.Rmd", # TODO: find a better name
+ content = function(file) {
+ # find the end of the YAML header or start of the file
+ # and insert the contents of teal.code::get_code(q_r())
+ yaml_end <- which(rmd_content == "---")[2]
+ insert_pos <- if (!is.na(yaml_end)) yaml_end else 0
+ note_lines <- c(
+ "",
+ "### Pre-processing data",
+ "",
+ "The following code chunk was automatically added by the teal markdown module.",
+ "It shows how to generate the data used in this report.",
+ "",
+ "```{r}",
+ teal.code::get_code(q_r()),
+ "```",
+ ""
+ )
+ rmd_content <- append(rmd_content, note_lines, after = insert_pos)
+ writeLines(rmd_content, con = file)
+ },
+ contentType = "text/plain"
+ )
+ }
+
+ clean_up_r <- shiny::reactiveVal(list())
+ # Can only clean on sessionEnded as temporary files are needed for the reporter
+ # during session
+ onSessionEnded(function() {
+ logger::log_debug("srv_rmarkdown: cleaning up temporary folders.")
+ lapply(shiny::isolate(clean_up_r()), function(f) f())
+ }, session)
+
+ rendered_path_r <- reactive({
+ datasets <- req(q_r()) # Ensure data is available
+
+ temp_dir <- tempfile(pattern = "rmd_")
+ dir.create(temp_dir, showWarnings = FALSE, recursive = TRUE)
+ temp_rmd <- tempfile(pattern = "rmarkdown_module-", tmpdir = temp_dir, fileext = ".Rmd")
+ # Schedule cleanup of temp files when reactive is re-executed
+ shiny::isolate({
+ old_clean_up <- clean_up_r()
+ clean_up_r(c(old_clean_up, function() unlink(temp_dir, recursive = TRUE)))
+ })
+ writeLines(rmd_content, con = temp_rmd)
+
+ tryCatch(
+ {
+ rmarkdown::render(
+ temp_rmd,
+ output_format = rmarkdown::md_document(
+ variant = "markdown",
+ standalone = TRUE,
+ dev = "png"
+ ),
+ envir = environment(datasets),
+ quiet = TRUE,
+ runtime = "static"
+ )
+ },
+ error = function(e) {
+ warning("Error rendering RMD file: ", e$message) # verbose error in logs
+ e
+ }
+ )
+ })
+
+ rendered_html_r <- reactive({
+ output_path <- req(rendered_path_r())
+ validate(
+ need(inherits(output_path, "character"), "Error rendering RMD file. Please contact the app developer.")
+ )
+ htmltools::includeMarkdown(output_path)
+ })
+
+ output$rmd_output <- renderUI(rendered_html_r())
+
+ reactive({
+ out_data <- q_r()
+ report_doc <- .markdown_internal(rendered_path_r(), rendered_html_r())
+ teal.reporter::teal_card(out_data) <- c(
+ teal.reporter::teal_card(out_data), report_doc
+ )
+ out_data
+ })
+ })
+}
+
+#' @exportS3Method tools::toHTML
+toHTML.markdown_internal <- function(block, ...) {
+ cached_html <- attr(block, "cached_html", exact = TRUE)
+ if (!is.null(cached_html)) {
+ return(cached_html)
+ }
+ NextMethod(unclass(block), ...)
+}
+
+#' @exportS3Method teal.reporter::to_rmd
+to_rmd.markdown_internal <- function(block, figures_dir = "figures", include_chunk_output = TRUE, ...) {
+ old_base_path <- attr(block, "old_base_path", exact = TRUE)
+ parent_path <- attr(block, "parent_path", exact = TRUE)
+ new_base_path <- file.path(figures_dir, old_base_path)
+
+ # Copy figures from old path to new location
+ dir.create(figures_dir, showWarnings = FALSE, recursive = TRUE)
+ file.copy(file.path(parent_path, old_base_path), figures_dir, recursive = TRUE)
+
+ # Change the image paths in the markdown content
+ block <- gsub(pattern = old_base_path, replacement = new_base_path, x = block, fixed = TRUE)
+ NextMethod(unclass(block), ...)
+}
+
+.markdown_internal <- function(markdown_file, rendered_html) {
+ base_file <- basename(markdown_file)
+
+ # Create new custom structure with contents and images in base64 as attribute
+ structure(
+ readLines(markdown_file),
+ class = c("markdown_internal", "character"),
+ parent_path = dirname(markdown_file),
+ old_base_path = sprintf("%s_files/", tools::file_path_sans_ext(base_file)),
+ cached_html = rendered_html
+ )
+}
diff --git a/inst/sample_files/test.Rmd b/inst/sample_files/test.Rmd
new file mode 100644
index 000000000..3fb2760c8
--- /dev/null
+++ b/inst/sample_files/test.Rmd
@@ -0,0 +1,32 @@
+---
+title: "Test R Markdown"
+output: html_document
+---
+
+```{r, eval=!exists(".raw_data"), include=FALSE}
+# Set your local data here. note that when used in teal the `data` must be available to the module
+CO2 <- datasets::CO2
+n_rows <- Inf
+```
+
+This is an example of an R markdown file with an inline r execution that gives the current date: `r Sys.Date()`
+
+Code chunk that performs a simple calculation (`1+1`)
+
+```{r}
+1 + 1
+```
+
+Code chunk that shows the structure of the params object
+
+Code chunk that shows the summary of the first `n_rows` of the `CO2` dataset if it is provided
+
+```{r}
+summary(head(CO2, n = n_rows))
+```
+
+Code chunk that plots the first `n_rows` of the `CO2` dataset if it is provided
+
+```{r}
+plot(head(CO2, n = n_rows))
+```
diff --git a/man/tm_rmarkdown.Rd b/man/tm_rmarkdown.Rd
new file mode 100644
index 000000000..1054dd3ae
--- /dev/null
+++ b/man/tm_rmarkdown.Rd
@@ -0,0 +1,161 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tm_rmarkdown.R
+\name{tm_rmarkdown}
+\alias{tm_rmarkdown}
+\title{\code{teal} module: Rmarkdown render}
+\usage{
+tm_rmarkdown(
+ label = "RMarkdown Module",
+ rmd_content,
+ datanames = "all",
+ allow_download = TRUE,
+ pre_output = NULL,
+ post_output = NULL,
+ transformators = list(),
+ extra_transform = list()
+)
+}
+\arguments{
+\item{label}{(\code{character(1)}) Label shown in the navigation item for the module or module group.
+For \code{modules()} defaults to \code{"root"}. See \code{Details}.}
+
+\item{rmd_content}{(\code{character}) Content of the R Markdown file to be rendered.
+This can be the value of \code{readLines("path/to/file.Rmd")}.}
+
+\item{datanames}{(\code{character}) Names of the datasets relevant to the item.
+There are 2 reserved values that have specific behaviors:
+\itemize{
+\item The keyword \code{"all"} includes all datasets available in the data passed to the teal application.
+\item \code{NULL} hides the sidebar panel completely.
+\item If \code{transformators} are specified, their \code{datanames} are automatically added to this \code{datanames}
+argument.
+}}
+
+\item{allow_download}{(\code{logical}) whether to allow downloading of the R Markdown file.
+Defaults to \code{TRUE}.}
+
+\item{pre_output}{(\code{shiny.tag}) optional, text or UI element to be displayed before the module's output,
+providing context or a title.
+with text placed before the output to put the output into context. For example a title.}
+
+\item{post_output}{(\code{shiny.tag}) optional, text or UI element to be displayed after the module's output,
+adding context or further instructions. Elements like \code{shiny::helpText()} are useful.}
+
+\item{transformators}{(\code{list} of \code{teal_transform_module}) that will be applied to transform module's data input.
+To learn more check \code{vignette("transform-input-data", package = "teal")}.}
+
+\item{extra_transform}{(\code{list}) of \code{\link[teal:teal_transform_module]{teal::teal_transform_module()}} that will be added in the module's UI.
+This can be used to create interactive inputs that modify the parameters in R Markdown rendering.}
+}
+\value{
+Object of class \code{teal_module} to be used in \code{teal} applications.
+}
+\description{
+Module to render R Markdown files using the data provided in the \code{teal_data} object.
+}
+\details{
+The R Markdown file should be designed to accept variables available in the datanames of the module.
+
+For example, if the \code{teal_data} object contains datasets named "mtcars" and "iris",
+the R Markdown file can use these as variables as they will be available in the R Markdown environment.
+
+The libraries used in the R Markdown file must be available in the deployed shiny
+app environment.
+
+When developing the R Markdown file, the working data can be simulated on a code chunk,
+which in turn can look for the presence of \code{.raw_data} object to determine if it is being
+run inside the \code{teal} module or not.
+
+Example R markdown file:
+
+\if{html}{\out{}}\preformatted{---
+title: "R Markdown Report"
+output: html_document
+---
+
+```\{r eval=!exists(".raw_data")\}
+mtcars <- datasets::mtcars
+iris <- datasets::iris
+```
+
+```\{r\}
+summary(mtcars) |> print()
+summary(iris) |> print()
+```
+}\if{html}{\out{
}}
+}
+\examples{
+
+# general data example
+data <- teal_data()
+data <- within(data, {
+ CO2 <- CO2
+})
+
+app <- init(
+ data = data,
+ modules = modules(
+ tm_rmarkdown(
+ label = "RMarkdown Module",
+ rmd_content = c(
+ "---",
+ "title: \"R Markdown Report\"",
+ "output: html_document",
+ "---",
+ "",
+ "```{r}",
+ "summary(CO2) |> print()",
+ "```"
+ )
+ )
+ )
+)
+if (interactive()) {
+ shinyApp(app$ui, app$server)
+}
+
+nrow_transform <- teal_transform_module(
+ label = "N Rows selector",
+ ui = function(id) {
+ ns <- NS(id)
+ tags$div(
+ numericInput(ns("n_rows"), "Show n rows", value = 5, min = 0, max = 200, step = 5)
+ )
+ },
+ server = function(id, data) {
+ moduleServer(id, function(input, output, session) {
+ reactive({
+ req(data())
+ within(data(),
+ {
+ n_rows <- n_rows_value
+ },
+ n_rows_value = input$n_rows
+ )
+ })
+ })
+ }
+)
+
+app <- init(
+ data = data,
+ modules = modules(
+ tm_rmarkdown(
+ label = "RMarkdown Module",
+ rmd_content = readLines(system.file(file.path("sample_files", "test.Rmd"), package = "teal.modules.general")),
+ allow_download = FALSE,
+ extra_transform = list(nrow_transform)
+ )
+ )
+) |> shiny::runApp()
+}
+\section{Examples in Shinylive}{
+\describe{
+ \item{example-1}{
+ \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokrcQAxLqkQ11XfxQpFC6cAAesKgiSoHBBsZc1AD6sVA2MUEhRroA7rSkABYq7Km4uiBKuroAwgDyAEzxNQ1KAL6KEEpoqE0q+eyVAZm6ALxDwbiDfEIioqO608JiAxBVVaQwSYwwLADW-EQ5ECtra9RQ9HD+YwpgWACyewdHuvcCS7eTq6e62-xJxFUZHmBBOPyqt0MUM+g3Bt00pBEiF0ClRd1eT0OqywcFQREYpFRtxh3zhYCIglIqEpyIKG2SBwIgngZBJ4IhYChhjZ7OJeFhP1uAAMRSBGK0eWTRMydmx2HV6rYAD4APl0qEYKlI6X5pMFYBFQuJeqqHVOZt0HQ6tBMunYWrUlh0NlsFW+oiKEFYAEF0OxugASQS0MqB0QyHSMDoSiBgVoAXSAA}{Open in Shinylive}
+ \if{html}{\out{}}
+ \if{html}{\out{}}
+ }
+}
+}
+