зеркало из https://github.com/microsoft/wpa.git
215 строки
7.0 KiB
R
215 строки
7.0 KiB
R
# --------------------------------------------------------------------------------------------
|
|
# Copyright (c) Microsoft Corporation. All rights reserved.
|
|
# Licensed under the MIT License. See LICENSE.txt in the project root for license information.
|
|
# --------------------------------------------------------------------------------------------
|
|
|
|
#' @title Generate HTML report with list inputs
|
|
#'
|
|
#' @description
|
|
#' This is a support function using a list-pmap workflow to
|
|
#' create a HTML document, using RMarkdown as the engine.
|
|
#'
|
|
#' @param title Character string to specify the title of the chunk.
|
|
#' @param filename File name to be used in the exported HTML.
|
|
#' @param outputs A list of outputs to be added to the HTML report.
|
|
#' Note that `outputs`, `titles`, `echos`, and `levels` must have the same length
|
|
#' @param titles A list/vector of character strings to specify the title of the chunks.
|
|
#' @param subheaders A list/vector of character strings to specify the subheaders for each chunk.
|
|
#' @param echos A list/vector of logical values to specify whether to display code.
|
|
#' @param levels A list/vector of numeric value to specify the header level of the chunk.
|
|
#' @param theme Character vector to specify theme to be used for the report.
|
|
#' E.g. "united", "default".
|
|
#' @param preamble A preamble to appear at the beginning of the report, passed as a text string.
|
|
#'
|
|
#' @importFrom purrr pmap
|
|
#' @importFrom purrr reduce
|
|
#'
|
|
#' @family Reports
|
|
#'
|
|
#' @section Creating a custom report:
|
|
#'
|
|
#' Below is an example on how to set up a custom report.
|
|
#'
|
|
#' The first step is to define the content that will go into a report and assign
|
|
#' the outputs to a list.
|
|
#' ```
|
|
#' # Step 1: Define Content
|
|
#' output_list <-
|
|
#' list(sq_data %>% workloads_summary(return = "plot"),
|
|
#' sq_data %>% workloads_summary(return = "table")) %>%
|
|
#' purrr::map_if(is.data.frame, create_dt)
|
|
#' ```
|
|
#' The next step is to add a list of titles for each of the objects on the list:
|
|
#' ```
|
|
#' # Step 2: Add Corresponding Titles
|
|
#' title_list <- c("Workloads Summary - Plot", "Workloads Summary - Table")
|
|
#' n_title <- length(title_list)
|
|
#' ```
|
|
#' The final step is to run `generate_report()`. This can all be wrapped within
|
|
#' a function such that the function can be used to generate a HTML report.
|
|
#' ```
|
|
#' # Step 3: Generate Report
|
|
#' generate_report(title = "My First Report",
|
|
#' filename = "My First Report",
|
|
#' outputs = output_list,
|
|
#' titles = title_list,
|
|
#' subheaders = rep("", n_title),
|
|
#' echos = rep(FALSE, n_title
|
|
#' ```
|
|
#' @return
|
|
#' An HTML report with the same file name as specified in the arguments is
|
|
#' generated in the working directory. No outputs are directly returned by the
|
|
#' function.
|
|
#'
|
|
#' @export
|
|
generate_report <- function(title = "My minimal HTML generator",
|
|
filename = "minimal_html",
|
|
outputs = output_list,
|
|
titles,
|
|
subheaders,
|
|
echos,
|
|
levels,
|
|
theme = "united",
|
|
preamble = ""){
|
|
|
|
|
|
|
|
## Title of document
|
|
title_chr <- paste0('title: \"', title, '\"')
|
|
|
|
|
|
## chunk loopage
|
|
## merged to create `chunk_merged`
|
|
chunk_merged <-
|
|
list(output = outputs,
|
|
title = titles,
|
|
subheader = subheaders,
|
|
echo = echos,
|
|
level = levels,
|
|
id = seq(1, length(outputs))) %>%
|
|
purrr::pmap(function(output, title, subheader, echo, level, id){
|
|
|
|
generate_chunks(level = level,
|
|
title = title,
|
|
subheader = subheader,
|
|
echo = echo,
|
|
object = paste0("outputs[[", id, "]]"))
|
|
|
|
}) %>%
|
|
purrr::reduce(c)
|
|
|
|
# wpa_logo <- system.file("logos/logo.PNG", package = "wpa")
|
|
|
|
## markdown object
|
|
markobj <- c('---',
|
|
title_chr <- paste0('title: \"', title, '\"'),
|
|
'output: ',
|
|
' html_document:',
|
|
paste0(' theme: ', theme),
|
|
# ' theme: united',
|
|
' toc: true',
|
|
' toc_float:',
|
|
' collapsed: false',
|
|
' smooth_scroll: true',
|
|
'---',
|
|
# paste0('![]("', wpa_logo, '")'),
|
|
'',
|
|
preamble,
|
|
'',
|
|
chunk_merged)
|
|
|
|
writeLines(markobj, paste0(filename, ".Rmd"))
|
|
rmarkdown::render(paste0(filename, ".Rmd"))
|
|
|
|
## Load in browser
|
|
utils::browseURL(paste0(filename, ".html"))
|
|
|
|
## Deletes specified files
|
|
unlink(c(paste0(filename, ".Rmd"),
|
|
paste0(filename, ".md")))
|
|
|
|
|
|
}
|
|
|
|
|
|
#' @title Generate chunk strings
|
|
#'
|
|
#' @description This is used as a supporting function for `generate_report()`
|
|
#' and not directly used. `generate_report()`` works by creating a
|
|
#' loop structure around generate_chunks(), and binds them together
|
|
#' to create a report.
|
|
#'
|
|
#' @details
|
|
#' `generate_chunks()` is primarily a wrapper around paste() functions,
|
|
#' to create a structured character vector that will form the individual
|
|
#' chunks. No plots 'exist' within the environment of `generate_chunks()`.
|
|
#'
|
|
#' @param level Numeric value to specify the header level of the chunk.
|
|
#' @param title Character string to specify the title of the chunk.
|
|
#' @param subheader Character string to specify the subheader of the chunk.
|
|
#' @param echo Logical value to specify whether to display code.
|
|
#' @param object Character string to specify name of the object to show.
|
|
generate_chunks <- function(level = 3,
|
|
title,
|
|
subheader = "",
|
|
echo = FALSE,
|
|
object){
|
|
|
|
level_hash <- paste(rep('#', level), collapse = "")
|
|
|
|
obj <- c(paste(level_hash, title),
|
|
subheader,
|
|
paste0('```{r, echo=',
|
|
echo,
|
|
', fig.height=9, fig.width=12}'),
|
|
object,
|
|
'```',
|
|
' ')
|
|
|
|
return(obj)
|
|
}
|
|
|
|
#' Read preamble
|
|
#'
|
|
#' Read in a preamble to be used within each individual reporting function.
|
|
#' Reads from the Markdown file installed with the package.
|
|
#'
|
|
#' @param path Text string containing the path for the appropriate Markdown file.
|
|
#'
|
|
#' @export
|
|
read_preamble <- function(path){
|
|
|
|
full_path <- paste0("/preamble/", path)
|
|
|
|
complete_path <- paste0(path.package("wpa"), full_path)
|
|
|
|
text <- suppressWarnings(readLines(complete_path))
|
|
|
|
return(text)
|
|
}
|
|
|
|
#' Display HTML fragment in RMarkdown chunk, from Markdown text
|
|
#'
|
|
#' @description
|
|
#' This is a wrapper around `markdown::markdownToHTML()`, where
|
|
#' the default behaviour is to produce a HTML fragment.
|
|
#' `htmltools::HTML()` is then used to evaluate the HTML code
|
|
#' within a RMarkdown chunk.
|
|
#'
|
|
#' @importFrom htmltools HTML
|
|
#' @importFrom markdown markdownToHTML
|
|
#'
|
|
#' @param text Character vector containing Markdown text
|
|
#'
|
|
md2html <- function(text){
|
|
|
|
html_chunk <- markdown::markdownToHTML(text = text,
|
|
fragment.only = TRUE)
|
|
|
|
htmltools::HTML(html_chunk)
|
|
|
|
}
|
|
|
|
|
|
|