# report_about_r_scripts -------------------------------------------------------
#' Create a HTML Report About R Scripts
#'
#' Create a HTML Report about each R script below a root directory. The report
#' will contain an overview plot showing the number or rows for each script. In
#' addition, one plot is generated per script, showing for each function
#' defined in the script, the number of expressions contained in the function.
#'
#' @param root path to directory from which to start looking for R scripts
#' @param scripts optional. Paths to R scripts, relative to the path given in
#' \code{root}
#' @param show if \code{TRUE} the created HTML file is opened in your default
#' browser
#'
#' @return path to the created HTML file, invisibly
#'
#' @export
#'
report_about_r_scripts <- function(
root, scripts = dir(root, "\\.R$", ignore.case = TRUE, recursive = TRUE),
show = TRUE
)
{
#kwb.utils::assignArgumentDefaults(kwb.fakin::report_about_r_scripts)
#kwb.utils::assignPackageObjects("kwb.fakin")
trees <- kwb.code::parse_scripts(root = root, scripts = scripts)
script_info <- kwb.code::to_full_script_info(trees)
all_function_info <- kwb.code::get_full_function_info(trees)
rmd_source <- c(
kwb.prep:::rmd_intro("R Script Analysis"),
code_to_r_block("kwb.fakin:::plot_row_numbers(params$script_info)"),
"",
"# Overview of Scripts and Functions",
"",
get_rmd_script_function_enumeration(all_function_info),
"",
"# Functions per Script",
"",
get_rmd_per_script(all_function_info, scripts = names(trees))
)
invisible(kwb.prep:::render_text(
rmd_source,
show = show,
params_to_rmd = list(
script_info = script_info,
all_function_info = all_function_info
))
)
}
# code_to_r_block --------------------------------------------------------------
code_to_r_block <- function(code_lines, echo = FALSE)
{
c(
sprintf("```{r echo = %s}", echo),
code_lines,
"```"
)
}
# get_rmd_per_script -----------------------------------------------------------
get_rmd_per_script <- function(all_function_info, scripts)
{
rmd_text <- character(0)
for (script in scripts) {
#script <- scripts[1]
rmd_text <- c(rmd_text, sprintf(
"## %s {#%s}\n\n", script, path_to_acronym(script)
))
belongs_to_script <- all_function_info$script == script
rmd_new <- if (any(belongs_to_script)) {
c(
get_rmd_function_enumeration(all_function_info, script),
"",
"These functions contain the following numbers of expressions:",
"",
code_to_r_block(sprintf(
"kwb.fakin:::plot_expression_numbers(%s, \"%s\")",
"params$all_function_info", script
))
)
} else {
"There are no functions defined in this script."
}
rmd_text <- c(rmd_text, rmd_new, "")
}
rmd_text
}
# get_rmd_script_function_enumeration ------------------------------------------
get_rmd_script_function_enumeration <- function(all_function_info)
{
function_info_list <- split(all_function_info, all_function_info$script)
unlist(lapply(names(function_info_list), function(script) {
c(
paste(sprintf("* [%s](#%s)", script, path_to_acronym(script))),
paste(sprintf(" + %s()", function_info_list[[script]]$functionName))
)
}))
}
# path_to_acronym --------------------------------------------------------------
path_to_acronym <- function(x)
{
x <- gsub("[/ _.]", "-", tolower(x))
x <- gsub("^-+", "", x)
x
}
# get_rmd_function_enumeration -------------------------------------------------
get_rmd_function_enumeration <- function(all_function_info, script)
{
function_info <- filter_function_info_for_script(all_function_info, script)
c(
sprintf("The script `%s` defines the following functions:", script),
"",
paste(sprintf("* %s()", function_info$functionName))
)
}
# plot_row_numbers -------------------------------------------------------------
plot_row_numbers <- function(script_info)
{
plot_horizontal_bars(
data = script_info, column_values = "rows", column_labels = "script",
xlab = "Number of Lines in Script"
)
}
# plot_expression_numbers ------------------------------------------------------
plot_expression_numbers <- function(all_function_info, script)
{
function_info <- filter_function_info_for_script(all_function_info, script)
plot_horizontal_bars(
data = function_info,
column_values = "n.expr",
column_labels = "functionName",
xlab = "Number of Expressions in Function"
)
}
# filter_function_info_for_script ----------------------------------------------
filter_function_info_for_script <- function(all_function_info, script)
{
# Get the vector of script names
scripts <- kwb.utils::selectColumns(all_function_info, "script")
function_info <- all_function_info[scripts == script, ]
# Get the vector of function names
function_names <- kwb.utils::selectColumns(function_info, "functionName")
# Order rows by function name
function_info[order(function_names), ]
}
# plot_horizontal_bars ---------------------------------------------------------
plot_horizontal_bars <- function(data, column_values, column_labels, xlab = "")
{
values <- kwb.utils::selectColumns(data, column_values)
text_labels <- kwb.utils::selectColumns(data, column_labels)
n_digits <- nchar(as.character(max(values))) - 1
x_max <- 1.2 * round(max(values), - n_digits)
x_shift <- 0.03 * x_max
y <- graphics::barplot(
xlim = c(-x_max, x_max), values, horiz = TRUE, las = 1, xlab = xlab,
axes = FALSE
)
graphics::axis(1, at = seq(0, x_max, by = 10^n_digits))
graphics::text(-x_shift, y, text_labels, adj = 1, cex = 0.8)
graphics::text(values + x_shift, y, values, cex = 0.8, adj = 0)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.