Merge pull request #53 from TanguyBarthelemy/develop

Add word output

.lintr

@@ -3,6 +3,8 @@ linters: linters_with_defaults(
         object_usage_linter = NULL,
         object_name_linter = NULL,
         line_length_linter = NULL,
-        commented_code_linter = NULL
+        commented_code_linter = NULL,
+        cyclocomp_linter = NULL,
+        brace_linter = NULL
     )
 encoding: "UTF-8"

DESCRIPTION

@@ -26,20 +26,22 @@ Imports:
     utils,
     stats,
     grDevices,
-    graphics
+    graphics,
+    methods
 Suggests: 
     kableExtra,
     testthat (>= 3.0.0),
     knitr,
     rmarkdown,
     readxl,
-    formattable
+    flextable
 Remotes:
     github::rjdverse/rjd3toolkit
 Collate: 
     'rjd3revisions-package.R'
     'check.R'
     'conversion.R'
+    'format_table.R'
     'report.R'
     'revisions.R'
     'revision_analysis.R'

NAMESPACE

@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(View,default)
+S3method(View,rjd3rev_rslts)
 S3method(View,rjd3rev_vintages)
 S3method(check_horizontal,data.frame)
 S3method(check_horizontal,default)
@@ -20,6 +22,7 @@ S3method(print,rjd3rev_vintages)
 S3method(summary,rjd3rev_revisions)
 S3method(summary,rjd3rev_rslts)
 S3method(summary,rjd3rev_vintages)
+export(View)
 export(bias)
 export(check_date_month)
 export(check_date_quarter)
@@ -43,6 +46,7 @@ export(revision_analysis)
 export(set_all_thresholds_to_default)
 export(set_thresholds_to_default)
 export(signalnoise)
+export(simulate_long)
 export(slope_and_drift)
 export(theil)
 export(theil2)
@@ -54,6 +58,8 @@ importFrom(grDevices,palette.colors)
 importFrom(graphics,legend)
 importFrom(graphics,par)
 importFrom(graphics,title)
+importFrom(methods,hasArg)
+importFrom(stats,as.formula)
 importFrom(stats,end)
 importFrom(stats,frequency)
 importFrom(stats,median)
@@ -62,6 +68,7 @@ importFrom(stats,quantile)
 importFrom(stats,reshape)
 importFrom(stats,rnorm)
 importFrom(stats,start)
+importFrom(stats,time)
 importFrom(stats,ts)
 importFrom(stats,ts.plot)
 importFrom(tools,file_ext)

NEWS.md

@@ -8,8 +8,18 @@ to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
 ## [Unreleased]
 
+### Added
+
 * user-defined thresholds for tests assessment
 * possibility to add plot of revisions in report
+* New `View()`, `summary()` and `print()` method to visualize the revision analysis
+
+
+### Changed
+
+* pivot from {formattable} dependency to {flextable} to build the tables
+* `simulate_long()` is now an exported function to construct datasets example
+
 
 ## [1.3.2] - 2024-07-10
 

R/check.R

@@ -246,7 +246,7 @@ check_long <- function(x, date_format = "%Y-%m-%d") {
 #' Check vertical format
 #'
 #' @param x a formatted \code{data.frame} containing the input in the vertical format
-#' @param periodicity periodicity of the time period (12, 4 or 1 for resp.
+#' @param periodicity Integer. Periodicity of the time period (12, 4 or 1 for resp.
 #' monthly, quarterly or annual data)
 #' @param date_format \code{character} string corresponding to the format used in
 #' the input data.frame for the revision dates.

R/format_table.R

@@ -0,0 +1,45 @@
+theme_design <- function(x) {
+    x <- flextable::border_remove(x)
+    std_border <- flextable::fp_border_default(width = 4, color = "white")
+    # x <- fontsize(x, size = 10, part = "all")
+    x <- flextable::font(x, fontname = "Helvetica Neue", part = "all")
+    x <- flextable::align(x, align = "center", part = "all")
+
+    x <- flextable::bg(x, bg = "gray94", part = "body")
+    x <- flextable::bg(x, bg = "gray74", part = "header")
+    x <- flextable::bg(x, bg = "#7ca2ff", part = "footer")
+    x <- flextable::color(x, color = "black", part = "all")
+
+    x <- flextable::bg(x, j = 1L, bg = "gray74")
+    x <- flextable::color(x, j = 1L, color = "black")
+
+    x <- flextable::padding(x, padding = 6, part = "all")
+    x <- flextable::border_outer(x, part = "all", border = std_border)
+    x <- flextable::border_inner_h(x, border = std_border, part = "all")
+    x <- flextable::border_inner_v(x, border = std_border, part = "all")
+    x <- flextable::set_table_properties(x, layout = "autofit")
+    return(x)
+}
+
+create_formula <- function(col, status) {
+    return(as.formula(sprintf("~ grepl(x = `%s`, pattern = \"%s\")", col, status)))
+}
+
+format_column <- function(x, col) {
+    x <- flextable::bg(x, create_formula(col, "Good"), col, bg = "#4CAF50")
+    x <- flextable::bg(x, create_formula(col, "Uncertain"), col, bg = "#FFEB3B")
+    x <- flextable::bg(x, create_formula(col, "Bad"), col, bg = "#ff3737")
+    x <- flextable::bg(x, create_formula(col, "Severe"), col, bg = "#c10000")
+    x <- flextable::bold(x, create_formula(col, "Severe"), col)
+    x <- flextable::color(x, create_formula(col, "Severe"), col, color = "white")
+    return(x)
+}
+
+format_table <- function(x, col = "Tests") {
+    formatted_table <- cbind(
+        data.frame(Tests = rownames(x)),
+        as.data.frame(x)
+    )
+    colnames(formatted_table)[1] <- col
+    return(formatted_table)
+}

R/report.R

@@ -1,10 +1,11 @@
 #' Generate report on Revision Analysis
 #'
-#' @param rslt an object of class `"rjd3rev_vintages"` which is the output
+#' @param rslt an object of class `"rjd3rev_rslts"` which is the output
 #'             of the function `revision_analysis()`
 #' @param output_file path or name of the output file containing the report
 #' @param output_dir path of the dir containing the output file (Optional)
-#' @param output_format either an HTML document (default) or a PDF document
+#' @param output_format either an HTML document (default), a PDF document or a
+#' Word document
 #' @param plot_revisions Boolean. Default is FALSE meaning that a plot with the
 #'   revisions will not be added to the report.
 #' @param open_report Boolean. Default is TRUE meaning that the report will
@@ -20,25 +21,16 @@
 #' @examples
 #'
 #' ## Simulated data
-#' period_range <- seq(as.Date('2011-01-01'),as.Date('2020-10-01'),by='quarter')
-#' qtr <- (as.numeric(substr(period_range,6,7))+2)/3
-#' time_period <- rep(paste0(format(period_range, "%Y"), "Q", qtr),5)
-#' np <- length(period_range)
-#' rev_date <- c(rep("2021-06-30",np), rep("2021-12-31",np), rep("2022-06-30",np),
-#'             rep("2022-12-31",np), rep("2023-06-30",np))
-#' set.seed(1)
-#' xt <- cumsum(sample(rnorm(1000,0,1), np, TRUE))
-#' rev <- rnorm(np*4,0,.1)
-#' obs_values <- xt
-#' for(i in 1:4) {
-#'   xt <- xt+rev[(1+(i-1)*np):(i*np)]
-#'   obs_values <- c(obs_values,xt)
-#' }
-#' df <- data.frame(rev_date, time_period, obs_values)
+#' df_long <- simulate_long(
+#'     n_period = 10L * 4L,
+#'     n_revision = 5L,
+#'     periodicity = 4L,
+#'     start_period = as.Date("2010-01-01")
+#' )
 #'
 #' ## Make analysis and generate the report
 #'
-#' vintages <- create_vintages(df, periodicity = 4L, type = "long")
+#' vintages <- create_vintages(df_long, periodicity = 4L, type = "long")
 #' rslt <- revision_analysis(vintages, view = "diagonal")
 #'
 #' \dontrun{
@@ -51,13 +43,14 @@
 #' )
 #' }
 #'
-render_report <- function(rslt,
-                          output_file,
-                          output_dir,
-                          output_format = c("html_document", "pdf_document"),
-                          plot_revisions = FALSE,
-                          open_report = TRUE,
-                          ...) {
+render_report <- function(
+        rslt,
+        output_file,
+        output_dir,
+        output_format = c("html_document", "pdf_document", "word_document"),
+        plot_revisions = FALSE,
+        open_report = TRUE,
+        ...) {
 
     # Check input
     checkmate::assert_class(rslt, "rjd3rev_rslts")
@@ -81,6 +74,8 @@ render_report <- function(rslt,
             ext <- "html"
         } else if (output_format == "pdf_document") {
             ext <- "pdf"
+        } else if (output_format == "word_document") {
+            ext <- "docx"
         }
     }
     output_file <- tools::file_path_sans_ext(output_file)
@@ -95,6 +90,7 @@ render_report <- function(rslt,
     }
 
     e <- list2env(list(
+        rslt = rslt,
         descriptive_statistics = rslt$descriptive.statistics,
         main_results = rslt$summary,
         add_plot = plot_revisions,