From ce369946d4d58a9fb78687b0c42691a06399ba90 Mon Sep 17 00:00:00 2001 From: "Douglas R. Mesquita Azevedo" Date: Thu, 21 Dec 2023 08:44:10 +0100 Subject: [PATCH] Fix report (#110) * Removing rstudioapi from the list of dependencies * adding names to perfomance output list based on the repetition * Updating benchmark function to work with the new crete_report function * updating quarto template * updating and simplifying report auxiliar functions * Fixing wrong parameter name in create_report call * running quarto in the destination location (other than root) * Breaking message into two rows (lintr) * preventing report to run in case any other problem happens during the benchmark execution * combining data before sending it to quarto * adjusting after lintr * adjusting after lintr * Making report more robust for different versions * returning list directly Co-authored-by: Jakub Nowicki * using with_dir instead of manually changing working directory * adding documentation to report utils functions * updating WORDLIST --------- Co-authored-by: Jakub Nowicki --- DESCRIPTION | 4 +- NAMESPACE | 3 +- R/benchmark.R | 22 ++-- R/benchmark_cypress.R | 1 + R/benchmark_shinytest2.R | 1 + R/shiny_benchmark-class.R | 1 - R/utils_report.R | 180 +++++++++++++++++++++-------- inst/WORDLIST | 6 + inst/templates/report_template.qmd | 132 ++++++++++----------- man/benchmark.Rd | 4 +- man/combine_performances.Rd | 30 +++++ man/create_report.Rd | 23 +++- man/prepare_dir_and_template.Rd | 15 ++- man/prepare_file_paths.Rd | 5 + 14 files changed, 282 insertions(+), 145 deletions(-) create mode 100644 man/combine_performances.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 308ec4c..d628ed8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -30,6 +30,7 @@ Suggests: spelling Imports: dplyr, + fs, ggplot2, glue, jsonlite, @@ -37,9 +38,8 @@ Imports: progress, quarto, renv, - rstudioapi, shinytest2, stringr, testthat, - fs + withr Language: en-US diff --git a/NAMESPACE b/NAMESPACE index 0667af5..0785bee 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,6 +6,7 @@ S3method(summary,shiny_benchmark) export(benchmark) export(benchmark_cypress) export(benchmark_shinytest2) +export(combine_performances) export(create_report) export(load_example) export(run_cypress_ptest) @@ -21,7 +22,6 @@ importFrom(progress,progress_bar) importFrom(quarto,quarto_render) importFrom(renv,activate) importFrom(renv,restore) -importFrom(rstudioapi,selectDirectory) importFrom(shinytest2,test_app) importFrom(stats,median) importFrom(stringr,str_trim) @@ -29,3 +29,4 @@ importFrom(testthat,ListReporter) importFrom(utils,globalVariables) importFrom(utils,menu) importFrom(utils,read.table) +importFrom(withr,with_dir) diff --git a/R/benchmark.R b/R/benchmark.R index 52e5ae0..0400537 100644 --- a/R/benchmark.R +++ b/R/benchmark.R @@ -17,7 +17,7 @@ #' @param renv_prompt Prompt the user before taking any action? #' @param n_rep Number of replications desired #' @param debug Logical. TRUE to display all the system messages on runtime -#' @param report_dir Name of the folder where the report should be saved, +#' @param report_file Name of the file (.html) where the report should be saved, #' when default (NULL), then report is not saved #' #' @importFrom glue glue @@ -33,7 +33,7 @@ benchmark <- function( renv_prompt = TRUE, n_rep = 1, debug = FALSE, - report_dir = NULL + report_file = NULL ) { # Get the call parameters call_benchmark <- match.call() @@ -106,13 +106,17 @@ benchmark <- function( class(out) <- "shiny_benchmark" # create report conditionally - if (!is.null(report_dir)) { - report_name <- glue(type, "_report") - create_report(report_params = out$perf_file, - report_name = report_name, - report_dir = report_dir) - } else { - message("`report_dir` not passed, report will not be saved.") + if (!is.null(report_file)) { + # combine performances into a single data.frame + performance <- combine_performances( + performance <- out$performance + ) + + # create report + create_report( + report_params = list(performance = performance), + file = report_file + ) } return(out) diff --git a/R/benchmark_cypress.R b/R/benchmark_cypress.R index 8fdb75d..80a44bd 100644 --- a/R/benchmark_cypress.R +++ b/R/benchmark_cypress.R @@ -144,5 +144,6 @@ run_cypress_ptest <- function( checkout_files(debug = debug) # return times + names(perf_file) <- paste0("rep", 1:n_rep) return(perf_file) } diff --git a/R/benchmark_shinytest2.R b/R/benchmark_shinytest2.R index ab306ba..f2fcb5a 100644 --- a/R/benchmark_shinytest2.R +++ b/R/benchmark_shinytest2.R @@ -145,5 +145,6 @@ run_shinytest2_ptest <- function( checkout_files(debug = debug) # return times + names(perf_file) <- paste0("rep", 1:n_rep) return(perf_file) } diff --git a/R/shiny_benchmark-class.R b/R/shiny_benchmark-class.R index 34bf8ee..34a5066 100644 --- a/R/shiny_benchmark-class.R +++ b/R/shiny_benchmark-class.R @@ -7,7 +7,6 @@ #' @importFrom methods new #' #' @export - shiny_benchmark_class <- setClass( Class = "shiny_benchmark", representation( diff --git a/R/utils_report.R b/R/utils_report.R index 047ac80..f76b790 100644 --- a/R/utils_report.R +++ b/R/utils_report.R @@ -1,73 +1,159 @@ -#' Create a performance report for the tests that were run +#' @title Combine list of performances in a single data.frame +#' +#' @param performance_list list of tests containing commits with dates, duration +#' time and test name +#' +#' @return data.frame combining all the elements from performance list. Also, it +#' adds the branch name for each one of the tables. +#' +#' @examples +#' performance1 <- data.frame(t1 = 1, t2 = 2) +#' performance2 <- data.frame(t1 = 3, t2 = 4) +#' performance_list <- list( +#' branch1 = performance1, +#' branch2 = performance2 +#' ) +#' +#' combine_performances(performance_list) +#' +#' @export +combine_performances <- function(performance_list) { + # create an unique data.frame for all branches and repetitions + df_all <- mapply( + performance_list, + names(performance_list), + FUN = function(x, y) { + df <- bind_rows(x) + df$branch <- y + + return(df) + }, + SIMPLIFY = FALSE + ) + + # bind rows + df_all <- bind_rows(df_all) + + # return a single data.frame + return(df_all) +} + +#' @title Create a performance report for the tests that were run #' #' @param report_params list of tests containing commits with dates, duration #' time and test name -#' @param report_name name of the file to which the report should be saved, without -#' the extension -#' @param report_dir name of the folder where the report should be saved +#' @param file name of the file to which the report should be saved (.html) +#' +#' @return None. This function is called for side effects +#' +#' report_params <- list( +#' performance = data.frame( +#' date = Sys.time(), +#' rep_id = 1, +#' test_name = rep(c("t1", "t2"), each = 10), +#' duration_ms = rpois(n = 20, lambda = 10), +#' branch = paste0("b", 1:10) +#' ) +#' ) +#' +#' create_report( +#' report_params = report_params, +#' file = tempfile(fileext = ".html") +#' ) #' #' @importFrom quarto quarto_render -#' @importFrom rstudioapi selectDirectory +#' @importFrom withr with_dir #' @export -create_report <- function(report_params, report_name, report_dir) { - if (report_dir == "" || is.na(report_dir)) { - message( - "The name specified for the report's directory cannot be an empty string or NA. ", - "Make sure you're using RStudio" +create_report <- function(report_params, file = NULL) { + # stop execution in case file is not provided + if (is.null(file)) { + return( + message("`file` cannot be NULL") ) - report_dir <- selectDirectory(caption = "Please pick the report's directory") - if (is.null(report_dir)) { - return( - message("No directory selected. Process aborted.") + } + + # manage template in order to create the report + report_dir <- dirname(file) + report_file <- basename(file) + report_template_file <- prepare_dir_and_template( + report_dir = report_dir + ) + report_template_file <- basename(report_template_file) + + # generate HTML + # execute order in the destination + with_dir( + new = report_dir, + code = { + quarto_render( + input = report_template_file, + output_file = report_file, + execute_params = report_params ) } - message(glue("The report will be automatically saved in folder {report_dir}.")) - } + ) +} +#' @title Prepare directory for the report +#' @description Prepare user's directory for the report and copy the report template from +#' the package to the user's directory +#' +#' @param report_dir name of the folder where the report should be saved +#' +#' @return character. Path to report.qmd +#' +#' @examples +#' if (interactive()) { +#' prepare_dir_and_template(report_dir = tempdir()) +#' } +prepare_dir_and_template <- function(report_dir) { + # create folders if needed file_paths <- prepare_file_paths(report_dir) - prepare_dir_and_template(report_dir = report_dir, - file_paths = file_paths) - message( - glue( - "Report template was copied for you. ", - "You can edit and re-render it in {file_paths[2]}" - ) + dir.create( + path = report_dir, + recursive = TRUE, + showWarnings = FALSE + ) + + # copy file from template to report dir + file.copy( + from = file_paths$package, + to = file_paths$user, + overwrite = TRUE ) + + # inform user about the report message( glue( - "You're creating a report named {report_name}. ", - "It'll be created in the following dir: {report_dir}" + "Report template was created at `{report_dir}`. + You can edit the and re-render it in {file_paths$user}" ) ) - message("This function is experimental!") - report_file <- file.path(report_dir, glue(report_name, ".html")) - quarto_render(input = file_paths[2], - output_file = report_file, - execute_params = report_params) + # return template path + return(file_paths$user) } - -#' Prepare user's directory for the report and copy the report template from -#' the package to the user's directory -#' -#' @param report_dir name of the folder where the report should be saved -#' @param file_paths two-element vector with paths to template reports -prepare_dir_and_template <- function(report_dir, file_paths) { - dir.create(path = report_dir, showWarnings = FALSE) - file.copy(from = file_paths[1], - to = file_paths[2], - overwrite = TRUE) -} - -#' Prepare file paths for package and user sides report templates +#' @title Prepare file paths for package and user sides report templates #' #' @param report_dir name of the folder where the report should be saved #' #' @return two-element vector with paths to template reports +#' +#' @examples +#' if (interactive()) { +#' prepare_file_paths(report_dir = tempdir()) +#' } prepare_file_paths <- function(report_dir) { - template_file_pkg <- system.file("templates", "report_template.qmd", - package = "shiny.benchmark") + template_file_pkg <- system.file( + "templates", + "report_template.qmd", + package = "shiny.benchmark" + ) template_file_usr <- file.path(report_dir, "report.qmd") - return(c(template_file_pkg, template_file_usr)) + + list( + package = template_file_pkg, + user = template_file_usr + ) } diff --git a/inst/WORDLIST b/inst/WORDLIST index 6cab662..fb87545 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -11,3 +11,9 @@ renv repo sendTime shinytest +fileext +params +qmd +rpois +Sys +tempfile diff --git a/inst/templates/report_template.qmd b/inst/templates/report_template.qmd index e018ffb..7e1b061 100644 --- a/inst/templates/report_template.qmd +++ b/inst/templates/report_template.qmd @@ -1,68 +1,70 @@ --- -title: "Performance comparison" +title: "Performance report" format: html: toc: true toc_float: true params: - test_output: "" + performance: "" --- ```{r include = FALSE} -suppressPackageStartupMessages({ - library(DT) - library(dplyr) - library(echarts4r) -}) -DT_options <- list( +library(DT) +library(dplyr) +library(echarts4r) + +dt_options <- list( initComplete = JS( "function(settings, json) {", "$(this.api().table().header()).css({'background-color': '#1a384c', 'color': '#fff'});", - "}") + "}" + ) ) ``` -## Versions +## App's Versions -This report aims to compare different versions of the app. Here is the list of versions and the development dates: +This report aims to compare different versions of your Shiny application. Here is the list of versions and the development dates (last commit for each version): ```{r data_prep, echo = FALSE} -out <- params$test_output -df_all_branches <- NULL -for (n in range(1:length(out))) { - tmp_list <- out[[n]][[1]] - tmp_df <- data.frame(matrix( - unlist(tmp_list), - nrow = length(tmp_list$date), - byrow = FALSE - )) - colnames(tmp_df) <- names(tmp_list) - tmp_df$branch <- names(out)[n] - df_all_branches <- bind_rows(df_all_branches, tmp_df) -} -df_all_branches$date <- - format(as.POSIXct( - as.numeric(df_all_branches$date), - origin = "1970-01-01", - tz = "UTC" - ), - "%Y-%m-%d %H:%M:%S") -df_all_branches$duration_ms <- - as.numeric(df_all_branches$duration_ms) +args <- lapply(X = params$performance, FUN = unlist) +df_all <- cbind.data.frame(args) +names(df_all) <- names(params$performance) + +df_all$duration_ms <- round(x = df_all$duration_ms, digits = 4) +df_all$date <- as.POSIXct( + df_all$date, + origin = "1970-01-01", + tz = "UTC" +) + +# we assume that the first branch/hash is the baseline +baseline <- df_all$branch[1] +df_all <- df_all %>% + filter(branch == baseline) %>% + group_by(test_name) %>% + summarise(baseline = min(duration_ms)) %>% + ungroup() %>% + right_join(df_all, by = "test_name") %>% + mutate(tf = baseline / duration_ms) ``` ```{r tab, echo = FALSE} -df_by_dates <- df_all_branches %>% - select(rep_id, branch, date) %>% +df_by_dates <- df_all %>% + select(branch, date) %>% unique() %>% arrange(desc(date)) + datatable( data = df_by_dates, rownames = FALSE, - colnames = c("Repository", "Branch", "Date"), - options = DT_options, - ) %>% - formatDate(columns = "date", method = "toLocaleString") + colnames = c("Branch", "Date"), + options = dt_options, +) %>% + formatDate( + columns = "date", + method = "toLocaleString" + ) ``` ## Raw data @@ -70,60 +72,42 @@ datatable( The time spent to compute each of the tests is displayed below as well as their respective branch. ```{r raw data, echo=FALSE} -df_display <- df_all_branches %>% +df_display <- df_all %>% select(branch, test_name, duration_ms) %>% arrange(test_name, branch) + datatable( data = df_display, rownames = FALSE, - colnames = c("Branch", "Test name", "Duration (ms)"), - options = DT_options + colnames = c("Branch", "Test name", "Duration (ms)"), + options = dt_options ) ``` ## Visualizations -```{r preparing data, echo=FALSE} -baseline <- min(df_all_branches$duration_ms) -df_baseline <- df_all_branches %>% - filter(duration_ms == baseline) %>% - select(test_name, duration_ms) %>% - rename(baseline = duration_ms) -# join it with the main dataset -times_faster <- function(a, b) b/a -df_comp <- df_all_branches %>% left_join(df_baseline, by = character(), suffix = c("", ".y")) %>% - select(-test_name.y) %>% - mutate(tf = times_faster(duration_ms, baseline)) -``` - ### Comparing the tests across branches ```{r comp branches, echo=FALSE} -df_comp %>% - group_by(branch) %>% - e_charts(x = test_name) %>% - e_bar(serie = duration_ms) %>% +# maybe boxplot is not the best idea here +df_all %>% + mutate(x_axis = paste0(branch, ": ", test_name)) %>% + group_by(x_axis) %>% + e_charts() %>% + e_boxplot(serie = duration_ms) %>% e_axis_labels(y = "Time (ms)") %>% - e_x_axis(axisLabel = list(interval = 0, rotate = 10)) %>% - e_mark_line(data = list(yAxis = df_comp$baseline[1]), - title = "Baseline", - lineStyle = list(color = "#757575")) -``` - -```{r comp branches by test, echo=FALSE} -df_comp %>% - group_by(test_name) %>% - e_charts(branch) %>% - e_scatter(duration_ms, symbol_size = 6) %>% - e_facet(rows = ceiling(length(unique(df_comp$test_name))/4), cols = 4, - legend_pos = "top", legend_space = 12) - + e_x_axis( + axisLabel = list( + interval = 0, + rotate = 10 + ) + ) ``` ### Comparing the durations of particular tests over time ```{r comp over time, echo=FALSE, warning=FALSE} -df_comp %>% +df_all %>% select(test_name, date, duration_ms) %>% group_by(test_name) %>% arrange(date) %>% diff --git a/man/benchmark.Rd b/man/benchmark.Rd index 52ceac0..c70d143 100644 --- a/man/benchmark.Rd +++ b/man/benchmark.Rd @@ -15,7 +15,7 @@ benchmark( renv_prompt = TRUE, n_rep = 1, debug = FALSE, - report_dir = NULL + report_file = NULL ) } \arguments{ @@ -46,7 +46,7 @@ packages will be used in all branches.} \item{debug}{Logical. TRUE to display all the system messages on runtime} -\item{report_dir}{Name of the folder where the report should be saved, +\item{report_file}{Name of the file (.html) where the report should be saved, when default (NULL), then report is not saved} } \description{ diff --git a/man/combine_performances.Rd b/man/combine_performances.Rd new file mode 100644 index 0000000..02d577f --- /dev/null +++ b/man/combine_performances.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils_report.R +\name{combine_performances} +\alias{combine_performances} +\title{Combine list of performances in a single data.frame} +\usage{ +combine_performances(performance_list) +} +\arguments{ +\item{performance_list}{list of tests containing commits with dates, duration +time and test name} +} +\value{ +data.frame combining all the elements from performance list. Also, it +adds the branch name for each one of the tables. +} +\description{ +Combine list of performances in a single data.frame +} +\examples{ +performance1 <- data.frame(t1 = 1, t2 = 2) +performance2 <- data.frame(t1 = 3, t2 = 4) +performance_list <- list( + branch1 = performance1, + branch2 = performance2 +) + +combine_performances(performance_list) + +} diff --git a/man/create_report.Rd b/man/create_report.Rd index 6ce4f23..0b9a909 100644 --- a/man/create_report.Rd +++ b/man/create_report.Rd @@ -4,16 +4,31 @@ \alias{create_report} \title{Create a performance report for the tests that were run} \usage{ -create_report(report_params, report_name, report_dir) +create_report(report_params, file = NULL) } \arguments{ \item{report_params}{list of tests containing commits with dates, duration time and test name} -\item{report_name}{name of the file to which the report should be saved, without -the extension} +\item{file}{name of the file to which the report should be saved (.html)} +} +\value{ +None. This function is called for side effects + +report_params <- list( +performance = data.frame( +date = Sys.time(), +rep_id = 1, +test_name = rep(c("t1", "t2"), each = 10), +duration_ms = rpois(n = 20, lambda = 10), +branch = paste0("b", 1:10) +) +) -\item{report_dir}{name of the folder where the report should be saved} +create_report( +report_params = report_params, +file = tempfile(fileext = ".html") +) } \description{ Create a performance report for the tests that were run diff --git a/man/prepare_dir_and_template.Rd b/man/prepare_dir_and_template.Rd index e64fc2d..dd597ea 100644 --- a/man/prepare_dir_and_template.Rd +++ b/man/prepare_dir_and_template.Rd @@ -2,17 +2,22 @@ % Please edit documentation in R/utils_report.R \name{prepare_dir_and_template} \alias{prepare_dir_and_template} -\title{Prepare user's directory for the report and copy the report template from -the package to the user's directory} +\title{Prepare directory for the report} \usage{ -prepare_dir_and_template(report_dir, file_paths) +prepare_dir_and_template(report_dir) } \arguments{ \item{report_dir}{name of the folder where the report should be saved} - -\item{file_paths}{two-element vector with paths to template reports} +} +\value{ +character. Path to report.qmd } \description{ Prepare user's directory for the report and copy the report template from the package to the user's directory } +\examples{ +if (interactive()) { + prepare_dir_and_template(report_dir = tempdir()) +} +} diff --git a/man/prepare_file_paths.Rd b/man/prepare_file_paths.Rd index 97ac3e3..673d7d2 100644 --- a/man/prepare_file_paths.Rd +++ b/man/prepare_file_paths.Rd @@ -15,3 +15,8 @@ two-element vector with paths to template reports \description{ Prepare file paths for package and user sides report templates } +\examples{ +if (interactive()) { + prepare_file_paths(report_dir = tempdir()) +} +}