diff --git a/.lintr b/.lintr index 85625e2..ba23475 100644 --- a/.lintr +++ b/.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" diff --git a/DESCRIPTION b/DESCRIPTION index 21ca01d..4720b5b 100644 --- a/DESCRIPTION +++ b/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' diff --git a/NAMESPACE b/NAMESPACE index 4b0d5c7..9f2c9b7 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index 547f524..7d02812 100644 --- a/NEWS.md +++ b/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 diff --git a/R/check.R b/R/check.R index 7e3e93e..0c8fe43 100644 --- a/R/check.R +++ b/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. diff --git a/R/format_table.R b/R/format_table.R new file mode 100644 index 0000000..ad9d855 --- /dev/null +++ b/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) +} diff --git a/R/report.R b/R/report.R index 06cc806..c06f93c 100644 --- a/R/report.R +++ b/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, diff --git a/R/revision_analysis.R b/R/revision_analysis.R index 52854a9..4e84f5c 100644 --- a/R/revision_analysis.R +++ b/R/revision_analysis.R @@ -59,30 +59,23 @@ #' @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 = 10L, +#' periodicity = 4L, +#' start_period = as.Date("2010-01-01") +#' ) #' #' ## Create a `"rjd3rev_vintages"` object with the input -#' vintages <- create_vintages(x = df, periodicity = 4, date_format = "%Y-%m-%d") -#' # revisions <- get_revisions(vintages, gap = 1) # just to get a first insight of the revisions +#' vintages <- create_vintages(x = df_long, periodicity = 4L, date_format = "%Y-%m-%d") +#' # revisions <- get_revisions(vintages, gap = 1L) # just to get a first insight of the revisions #' #' ## Call using all default parameters #' rslt1 <- revision_analysis(vintages) #' # render_report(rslt1) -#' # summary(rslt1) # formatted summary only +#' summary(rslt1) # formatted summary only +#' View(rslt1) # formatted tables in viewer panel #' #' ## Calls using diagonal view (suited in many situations such as to evaluate GDP estimates) #' ## Note: when input are not growth rates but the gross series, differentiation is @@ -90,25 +83,30 @@ #' ## must be set to TRUE manually whenever a log-transformation of the data is necessary #' rslt2 <- revision_analysis(vintages, gap = 1, view = "diagonal", n.releases = 3) #' # render_report(rslt2) -#' # summary(rslt2) +#' summary(rslt2) +#' View(rslt2) #' #' ## Call to evaluate revisions for a specific range of vintage periods #' vintages <- create_vintages( -#' x = df, -#' periodicity = 4, -#' vintage_selection = c(start="2021-12-31", end="2023-06-30") +#' x = df_long, +#' periodicity = 4L, +#' vintage_selection = c(start = "2012-12-31", end = "2018-06-30") #' ) -#' rslt3 <- revision_analysis(vintages, gap=2, view = "vertical") +#' rslt3 <- revision_analysis(vintages, gap = 2, view = "vertical") #' #render_report(rslt3) -#' #summary(rslt3) +#' summary(rslt3) +#' View(rslt3) #' #' ## Note that it is possible to change thresholds values for quality #' ## assessment using options (see vignette for details) -#' options(augmented_t_threshold = c(severe = 0.005, bad = 0.01, uncertain = 0.05), -#' slope_and_drift_threshold = c(severe = 0.005, bad = 0.05, uncertain = 0.10), -#' theil_u2_threshold = c(uncertain = .5, bad = .7, severe = 1)) +#' options( +#' augmented_t_threshold = c(severe = 0.005, bad = 0.01, uncertain = 0.05), +#' slope_and_drift_threshold = c(severe = 0.005, bad = 0.05, uncertain = 0.10), +#' theil_u2_threshold = c(uncertain = .5, bad = .7, severe = 1) +#' ) #' rslt4 <- revision_analysis(vintages, gap = 1, view = "diagonal", n.releases = 3) #' summary(rslt4) +#' View(rslt4) #' revision_analysis <- function(vintages, gap = 1, @@ -320,7 +318,8 @@ revision_analysis <- function(vintages, autocorrelation_test = ac_infos$ac_rslt, seasonality_test = seas_infos$seas_rslt), signalnoise = list(signal_noise = sn_infos$sn_rslt), - varbased = var_based_rslt + varbased = var_based_rslt, + view = view ), class = "rjd3rev_rslts") ) } @@ -609,14 +608,14 @@ eval_test <- function(val, threshold, ascending = TRUE) { - if(is.null(threshold)){ + if (is.null(threshold)) { stop("Some user-defined thresholds are defined as NULL. See ?set_thresholds_to_default or ?set_all_thresholds_to_default to reset tests thresholds to their default values", call. = FALSE) } - if(!all(tolower(names(threshold)) %in% c("good", "uncertain", "bad", "severe"))){ + if (!all(tolower(names(threshold)) %in% c("good", "uncertain", "bad", "severe"))) { stop("Possible values for quality assessment are 'good', 'uncertain', 'bad', 'severe'. Please check your options.", call. = FALSE) } - if(is.unsorted(threshold)){ + if (is.unsorted(threshold)) { stop("User-defined thresholds must be defined in an ascending order. See vignette for more information.", call. = FALSE) } @@ -625,20 +624,20 @@ eval_test <- function(val, nt <- length(threshold) qualities <- c() - for(i in 1:n){ + for (i in 1:n) { quality <- "good" - if(!is.na(val[i])){ - if(ascending){ - for (k in 1:nt){ - if(val[i] < threshold[k]){ + if (!is.na(val[i])) { + if (ascending) { + for (k in 1:nt) { + if (val[i] < threshold[k]) { quality <- names(threshold)[k] break } } - }else{ - for (k in nt:1){ - if(val[i] > threshold[k]){ + } else { + for (k in nt:1) { + if (val[i] > threshold[k]) { quality <- names(threshold)[k] break } @@ -705,41 +704,154 @@ regression_diagnostics <- function(reg_output, thr_res_jb, thr_res_bp, thr_res_w # Generic functions ------------------------------------------------------------ -#' Print function for objects of class "rjd3rev_rslts" +#' @title Print function for objects of class \code{rjd3rev_rslts} +#' +#' @param x an object of class \code{rjd3rev_rslts} +#' @param \dots further arguments passed to the \code{\link{print}} function. #' -#' @param x an object of class "rjd3rev_rslts" -#' @param \dots further arguments passed to the print() function. -#' @export #' @exportS3Method print rjd3rev_rslts +#' @method print rjd3rev_rslts +#' @export #' print.rjd3rev_rslts <- function(x, ...) { - - print(list(call = x$call, - descriptive_statistics = x$descriptive.statistics, - parametric_analysis = x$summary, ...)) + print(x$summary) } -#' Summary function for objects of class "rjd3rev_rslts" +#' Summary function for objects of class \code{rjd3rev_rslts} #' -#' @param object an object of class "rjd3rev_rslts" +#' @param object an object of class \code{rjd3rev_rslts} #' @param ... further arguments passed to or from other methods. #' @exportS3Method summary rjd3rev_rslts +#' @method summary rjd3rev_rslts #' @export #' summary.rjd3rev_rslts <- function(object, ...) { + cat("Object of class rjd3rev_rslts\n") + cat("View:", object$view, "\n") + nb_revisions <- ncol(object$revisions) + cat("There are", nb_revisions, "from", start(object$revisions), "to", end(object$revisions), "\n\n") + cat("List of all tests:\n") + categories <- setdiff(names(object), c("call", "revisions", "descriptive.statistics", "summary", "view")) + for (cate in categories) { + cat("-", cate, ":") + cat("", names(object[[cate]]), sep = "\n\t- ") + } + + revisions_dates <- colnames(object$revisions) + cat("\nRevisions analysis dates:", paste0("\n\t- ", "[", seq_len(nb_revisions), "]: ", revisions_dates), "\n") - x <- object - if (!requireNamespace("formattable", quietly = TRUE)) { - warning("Please install 'formattable': install.packages('formattable') to get more visual output") - return(x$summary) + summary_tests <- object$summary + cat("\nTests results:\n") + print(summary_tests) +} + +#' @rdname View +#' @export +View <- function(x, ...) { + UseMethod("View") +} + +#' @rdname View +#' @exportS3Method View default +#' @method View default +#' @export +View.default <- function(x, ...) { + utils::View(x, ...) +} + +build_table <- function(x, type = c("summary", "stats-desc", "revisions", "tests")) { + + # Check type + type <- match.arg(type) + + if (!requireNamespace("flextable", quietly = TRUE)) { + warning("Please install 'flextable': install.packages('flextable') to get more visual output") + if (type == "summary") { + return(x$summary) + } else if (type == "stats-desc") { + return(x$descriptive.statistics) + } else if (type == "revisions") { + return(x$revisions) + } else if (type == "tests") { + message("Feature not implemented yet.") + } } else { - format_font <- function(x) { - formattable::formatter("span", - style = x ~ formattable::style(color = ifelse(substr(x, 1, 1) == "G", "green", - ifelse(substr(x, 1, 1) == "U", "orange", "red")), - font.weight = ifelse(substr(x, 1, 1) == "S", "bold", "plain"))) + if (type == "summary") { + main_results <- x$summary |> + format_table() |> + flextable::flextable() |> + theme_design() + for (col in colnames(x$summary)[-1]) { + main_results <- main_results |> + format_column(col = col) + } + return(main_results) + } else if (type == "stats-desc") { + stat_desc <- x$descriptive.statistics[c("N", "mean revision", "st.dev.", "% positive", "% zero", "% negative"), , drop = FALSE] |> + format_table() |> + flextable::flextable() |> + theme_design() + return(stat_desc) + } else if (type == "revisions") { + revisions_table <- data.frame(Time = time(x$revisions), + x$revisions, + check.names = FALSE) |> + flextable::flextable() |> + theme_design() + return(revisions_table) + } else if (type == "tests") { + message("Feature not implemented yet.") + } + } + return(invisible(NULL)) +} + +#' View function for objects of class \code{rjd3rev_rslts} +#' +#' @param x an object of class \code{rjd3rev_rslts} +#' @param type type of view to display +#' @param ... further arguments passed to \code{\link{View}}. +#' +#' @exportS3Method View rjd3rev_rslts +#' @method View rjd3rev_rslts +#' @export +#' +View.rjd3rev_rslts <- function( + x, + type = c("summary", "stats-desc", "revisions", "tests"), + ...) { + + # Check type + type <- match.arg(type) + + if (type == "all") { + for (new_type in c("all", "summary", "stats-desc", "revisions", "tests")) { + View(x, new_type, ...) } - nc <- ncol(x$summary) - return(list(formattable::formattable(x$summary, apply(x$summary[, 2:nc, drop = FALSE], 2, format_font)))) + return(invisible(NULL)) + } else if (type == "tests") { + message("Feature not implemented yet.") + return(invisible(NULL)) + } + + if (!hasArg(title)) { + title <- "" + } + + table_output <- build_table(x, type) + + if (!requireNamespace("flextable", quietly = TRUE)) { + warning("Please install 'flextable': install.packages('flextable') to get more visual output") + + utils::View(table_output, title = paste(title, switch( + type, + "summary" = "Tests summary", + "stat-desc" = "Descriptive statistics", + "revisions" = "Revisions", + "tests" = "All tests" + ))) + } else { + print(table_output) } + return(invisible(NULL)) } diff --git a/R/revisions.R b/R/revisions.R index a020626..26d05c0 100644 --- a/R/revisions.R +++ b/R/revisions.R @@ -108,7 +108,7 @@ plot.rjd3rev_revisions <- function(x, view = c("vertical", "diagonal"), n_rev = #' @param n_col number of columns to display. Can be either the last n columns #' (verical view), the last n rows (horizontal view) or the first n columns #' (diagonal view). -#' @param \dots further arguments passed to the print() function. +#' @param \dots further arguments passed to the \code{\link{print}} function. #' @exportS3Method print rjd3rev_revisions #' @export #' diff --git a/R/rjd3revisions-package.R b/R/rjd3revisions-package.R index b881a97..b8f8800 100644 --- a/R/rjd3revisions-package.R +++ b/R/rjd3revisions-package.R @@ -6,6 +6,8 @@ #' @importFrom graphics par #' @importFrom graphics title #' @importFrom grDevices palette.colors +#' @importFrom methods hasArg +#' @importFrom stats as.formula #' @importFrom stats end #' @importFrom stats frequency #' @importFrom stats median @@ -14,6 +16,7 @@ #' @importFrom stats reshape #' @importFrom stats rnorm #' @importFrom stats start +#' @importFrom stats time #' @importFrom stats ts #' @importFrom stats ts.plot #' @importFrom tools file_ext diff --git a/R/simulate.R b/R/simulate.R index e4c4dcb..959405e 100644 --- a/R/simulate.R +++ b/R/simulate.R @@ -41,6 +41,30 @@ simulate_revision <- function(n, init = stats::rnorm(1, 0, 1)) { return(init + stats::rnorm(n, mean = 0, sd = 2 ** (2 - seq_len(n)))) } + +#' Simulate long datasets with revisions +#' +#' @param n_period Integer. Number of different time-period (length of the +#' simulated series). +#' @param n_revision Integer. Number of different revision dates. +#' @param start_period Date. Start of the series. +#' @param periodicity Integer. Periodicity of the time period (12, 4 or 1 for +#' resp. monthly, quarterly or annual data). +#' +#' @returns A dataset in the long format. See \code{\link{create_vintages}} for +#' more information about the different data formats. +#' +#' @export +#' +#' @examples +#' +#' simulate_long(n_period = 100L, n_revision = 10L) +#' simulate_long(periodicity = 1L) +#' simulate_long(start_period = as.Date("2000-01-01"), +#' n_period = 10L * 12L, +#' periodicity = 12L) +#' simulate_long(periodicity = 4L, n_period = 5L * 4L) +#' simulate_long <- function(n_period = 50, n_revision = 10, start_period = as.Date("2012-01-01"), diff --git a/R/tests.R b/R/tests.R index 947cddb..7dfcb7e 100644 --- a/R/tests.R +++ b/R/tests.R @@ -80,25 +80,17 @@ matrix_r2jd <- function(s) { #' #' @export #' @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") +#' ) #' #' ## Create vintage and get descriptive statistics of revisions -#' vintages <- create_vintages(df, periodicity = 4) +#' vintages <- create_vintages(df_long, periodicity = 4) #' revisions <- get_revisions(vintages, gap = 1) #' descriptive_statistics(revisions$diagonal_view, rounding = 1) #' @@ -147,25 +139,17 @@ descriptive_statistics <- function(revisions.view, rounding = 3) { #' @export #' #' @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") +#' ) #' #' ## Create vintage and test -#' vintages <- create_vintages(df, periodicity = 4) +#' vintages <- create_vintages(df_long, periodicity = 4) #' theil(vintages$diagonal_view) #' theil <- function(vintages.view, gap = 1, na.zero = FALSE) { @@ -194,25 +178,17 @@ theil <- function(vintages.view, gap = 1, na.zero = FALSE) { #' @export #' #' @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") +#' ) #' #' ## Create vintage and test -#' vintages <- create_vintages(df, periodicity = 4) +#' vintages <- create_vintages(df_long, periodicity = 4) #' theil2(vintages$diagonal_view) #' theil2 <- function(vintages.view, gap = 1, na.zero = FALSE) { @@ -238,25 +214,17 @@ theil2 <- function(vintages.view, gap = 1, na.zero = FALSE) { #' @export #' #' @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") +#' ) #' #' ## Create vintage and test -#' vintages <- create_vintages(df, periodicity = 4) +#' vintages <- create_vintages(df_long, periodicity = 4) #' revisions <- get_revisions(vintages, gap = 1) #' bias(revisions$diagonal_view) #' @@ -299,25 +267,17 @@ bias <- function(revisions.view, na.zero = FALSE) { #' @export #' #' @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") +#' ) #' #' ## Create vintage and test -#' vintages <- create_vintages(df, periodicity = 4) +#' vintages <- create_vintages(df_long, periodicity = 4L) #' slope_and_drift(vintages$diagonal_view) #' slope_and_drift <- function(vintages.view, gap = 1, na.zero = FALSE) { @@ -358,25 +318,17 @@ slope_and_drift <- function(vintages.view, gap = 1, na.zero = FALSE) { #' @export #' #' @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") +#' ) #' #' ## Create vintage and test -#' vintages <- create_vintages(df, periodicity = 4) +#' vintages <- create_vintages(df_long, periodicity = 4L) #' efficiencyModel1(vintages$diagonal_view) #' efficiencyModel1 <- function(vintages.view, gap = 1, na.zero = FALSE) { @@ -418,25 +370,17 @@ efficiencyModel1 <- function(vintages.view, gap = 1, na.zero = FALSE) { #' @export #' #' @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") +#' ) #' #' ## Create vintage and test -#' vintages <- create_vintages(df, periodicity = 4) +#' vintages <- create_vintages(df_long, periodicity = 4L) #' efficiencyModel2(vintages$diagonal_view) #' efficiencyModel2 <- function(vintages.view, gap = 1, na.zero = FALSE) { @@ -480,25 +424,17 @@ efficiencyModel2 <- function(vintages.view, gap = 1, na.zero = FALSE) { #' @export #' #' @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") +#' ) #' #' ## Create vintage and test -#' vintages <- create_vintages(df, periodicity = 4) +#' vintages <- create_vintages(df_long, periodicity = 4L) #' revisions <- get_revisions(vintages, gap = 1) #' orthogonallyModel1(revisions$diagonal_view) #' @@ -540,25 +476,17 @@ orthogonallyModel1 <- function(revisions.view, nrevs = 1, na.zero = FALSE) { #' @export #' #' @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") +#' ) #' #' ## Create vintage and test -#' vintages <- create_vintages(df, periodicity = 4) +#' vintages <- create_vintages(df_long, periodicity = 4L) #' revisions <- get_revisions(vintages, gap = 1) #' orthogonallyModel2(revisions$diagonal_view) #' @@ -605,24 +533,15 @@ orthogonallyModel2 <- function(revisions.view, reference = 1, na.zero = FALSE) { #' #' @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") +#' ) #' #' ## Create vintage and test -#' vintages <- create_vintages(df, periodicity = 4) +#' vintages <- create_vintages(df_long, periodicity = 4L) #' signalnoise(vintages$diagonal_view) #' signalnoise <- function(vintages.view, gap = 1, na.zero = FALSE) { @@ -661,24 +580,15 @@ signalnoise <- function(vintages.view, gap = 1, na.zero = FALSE) { #' #' @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") +#' ) #' #' ## Create vintage and test -#' vintages <- create_vintages(df, periodicity = 4) +#' vintages <- create_vintages(df_long, periodicity = 4L) #' unitroot(vintages$diagonal_view) #' unitroot <- function(vintages.view, adfk = 1, na.zero = FALSE) { @@ -708,25 +618,17 @@ unitroot <- function(vintages.view, adfk = 1, na.zero = FALSE) { #' @export #' #' @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") +#' ) #' #' ## Create vintage and test -#' vintages <- create_vintages(df, periodicity = 4) +#' vintages <- create_vintages(df_long, periodicity = 4L) #' cointegration(vintages$diagonal_view) #' cointegration <- function(vintages.view, adfk = 1, na.zero = FALSE) { @@ -769,24 +671,15 @@ get_rownames_diag <- function(vt, gap) { #' #' @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") +#' ) #' #' ## Create vintage and test -#' vintages <- create_vintages(df, periodicity = 4) +#' vintages <- create_vintages(df_long, periodicity = 4L) #' vecm(vintages$diagonal_view) #' vecm <- function(vintages.view, lag = 2, model = c("none", "cnt", "trend"), na.zero = FALSE) { diff --git a/R/thresholds.R b/R/thresholds.R index 1039e63..3c14d85 100644 --- a/R/thresholds.R +++ b/R/thresholds.R @@ -7,7 +7,7 @@ #' #' set_all_thresholds_to_default() #' -set_all_thresholds_to_default <- function(diagnostic_tests = TRUE){ +set_all_thresholds_to_default <- function(diagnostic_tests = TRUE) { threshold_option_names <- c("theil_u1_threshold", "theil_u2_threshold", "t_threshold", "augmented_t_threshold", @@ -17,13 +17,13 @@ set_all_thresholds_to_default <- function(diagnostic_tests = TRUE){ "seas_threshold", "signal_noise1_threshold", "signal_noise2_threshold") - if(diagnostic_tests){ + if (diagnostic_tests) { threshold_option_names <- c(threshold_option_names, "jb_res_threshold", "bp_res_threshold", "white_res_threshold", "arch_res_threshold") } - for(threshold_option_name in threshold_option_names){ + for (threshold_option_name in threshold_option_names) { set_thresholds_to_default(threshold_option_name) } @@ -40,29 +40,26 @@ set_all_thresholds_to_default <- function(diagnostic_tests = TRUE){ #' #' set_thresholds_to_default("t_threshold") #' -set_thresholds_to_default <- function(threshold_option_name){ - - switch(threshold_option_name, - theil_u1_threshold = {options(theil_u1_threshold = c(uncertain = .8, bad = .9, severe = .99))}, - theil_u2_threshold = {options(theil_u2_threshold = c(uncertain = .8, bad = .9, severe = 1))}, - t_threshold = {options(t_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05))}, - augmented_t_threshold = {options(augmented_t_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05))}, - slope_and_drift_threshold = {options(slope_and_drift_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05))}, - eff1_threshold = {options(eff1_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05))}, - eff2_threshold = {options(eff2_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05))}, - orth1_threshold = {options(orth1_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05))}, - orth2_threshold = {options(orth2_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05))}, - autocorr_threshold = {options(autocorr_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05))}, - seas_threshold= {options(seas_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05))}, - signal_noise1_threshold = {options(signal_noise1_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05))}, - signal_noise2_threshold = {options(signal_noise2_threshold = c(uncertain = 0.05))}, - jb_res_threshold = {options(jb_res_threshold = c(bad = 0.01, uncertain = 0.1))}, - bp_res_threshold = {options(bp_res_threshold = c(bad = 0.01, uncertain = 0.1))}, - white_res_threshold = {options(white_res_threshold = c(bad = 0.01, uncertain = 0.1))}, - arch_res_threshold = {options(arch_res_threshold = c(bad = 0.01, uncertain = 0.1))}, - stop("Test not found") - ) +set_thresholds_to_default <- function(threshold_option_name) { + switch( + threshold_option_name, + theil_u1_threshold = { options(theil_u1_threshold = c(uncertain = .8, bad = .9, severe = .99)) }, + theil_u2_threshold = { options(theil_u2_threshold = c(uncertain = .8, bad = .9, severe = 1)) }, + t_threshold = { options(t_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05)) }, + augmented_t_threshold = { options(augmented_t_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05)) }, + slope_and_drift_threshold = { options(slope_and_drift_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05)) }, + eff1_threshold = { options(eff1_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05)) }, + eff2_threshold = { options(eff2_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05)) }, + orth1_threshold = { options(orth1_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05)) }, + orth2_threshold = { options(orth2_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05)) }, + autocorr_threshold = { options(autocorr_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05)) }, + seas_threshold = { options(seas_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05)) }, + signal_noise1_threshold = { options(signal_noise1_threshold = c(severe = 0.001, bad = 0.01, uncertain = 0.05)) }, + signal_noise2_threshold = { options(signal_noise2_threshold = c(uncertain = 0.05)) }, + jb_res_threshold = { options(jb_res_threshold = c(bad = 0.01, uncertain = 0.1)) }, + bp_res_threshold = { options(bp_res_threshold = c(bad = 0.01, uncertain = 0.1)) }, + white_res_threshold = { options(white_res_threshold = c(bad = 0.01, uncertain = 0.1)) }, + arch_res_threshold = { options(arch_res_threshold = c(bad = 0.01, uncertain = 0.1)) }, + stop("Test not found") + ) } - - - diff --git a/R/vintages.R b/R/vintages.R index 1afea12..4af7560 100644 --- a/R/vintages.R +++ b/R/vintages.R @@ -50,7 +50,7 @@ #' vintage views (selected by the argument `type`. #' @param type character specifying the type of representation of the input #' between `"long"`, `"horizontal"` and `"vertical"` approach. -#' @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. @@ -493,7 +493,7 @@ create_vintages_from_xlsx <- function(file, #' @param n_col number of columns to display. Can be either the last n columns #' (verical view), the last n rows (horizontal view) or the first n columns #' (diagonal view). This argument is not used for the long view. -#' @param ... further arguments passed to the print() function. +#' @param ... further arguments passed to the \code{\link{print}} function. #' #' @exportS3Method print rjd3rev_vintages #' @method print rjd3rev_vintages @@ -577,6 +577,8 @@ summary.rjd3rev_vintages <- function(object, ...) { #' @details #' Generate the view of the vintages in different format. With the type argument, you can choose the view to display. You can choose between the long, horizontal, vertical and diagonal view. #' +#' @rdname View +#' #' @exportS3Method View rjd3rev_vintages #' @method View rjd3rev_vintages #' @export @@ -589,7 +591,7 @@ View.rjd3rev_vintages <- function( # Check type type <- match.arg(type) - if (missing(title)) { + if (!hasArg(title)) { title <- "" } diff --git a/R/zzz.R b/R/zzz.R index 108ba5c..8793079 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -50,7 +50,6 @@ NULL if (is.null(getOption("signal_noise2_threshold"))) { set_thresholds_to_default("signal_noise2_threshold") } - if (is.null(getOption("jb_res_threshold"))) { set_thresholds_to_default("jb_res_threshold") } diff --git a/inst/templates/report.Rmd b/inst/templates/report.Rmd index ddbf3f5..e7f985e 100644 --- a/inst/templates/report.Rmd +++ b/inst/templates/report.Rmd @@ -2,12 +2,12 @@ title: "Generated Report on Revision Analysis" date: "`r format(Sys.time(), '%d %B, %Y')`" output: - pdf_document: - toc: true html_document: theme: cerulean toc: true toc_float: true + pdf_document: + toc: true always_allow_html: true bibliography: revision_analysis.bib nocite: '@*' @@ -15,11 +15,8 @@ nocite: '@*' ```{r setup, include=FALSE} knitr::opts_chunk$set(echo = TRUE) -output_format <- knitr::opts_knit$get("rmarkdown.pandoc.to") -options("knitr.table.format" = output_format) ``` - # Content in a nutshell Descriptive statistics provide basic information about the extend of revisions. @@ -32,18 +29,13 @@ For some parametric tests, transformation may be important to avoid misleading r # Descriptive statistics ```{r descriptivetable, echo = FALSE} -selection <- c("N", "mean revision", "st.dev.", "% positive", "% zero", "% negative") - -if (!requireNamespace("kableExtra", quietly = TRUE)) { - knitr::kable(descriptive_statistics[selection, , drop = FALSE]) - warning("Please install kableExtra: install.packages('kableExtra') to get more visual table output") -} else { - kableExtra::kable_minimal(knitr::kable(descriptive_statistics[selection, , drop = FALSE])) -} +rslt |> build_table(type = "stats-desc") +``` +```{r plot revisions, echo = FALSE} if (add_plot) { - stats::ts.plot(revisions, gpars = list(xlab = "", ylab = "", col = c(1:ncol(revisions)), type = "h", lwd = 2)) - graphics::legend("topleft", bty = "n", lty = 1, lwd = 2, col = c(1:ncol(revisions)), legend = colnames(revisions)) + stats::ts.plot(revisions, gpars = list(xlab = "", ylab = "", col = seq_len(ncol(revisions)), type = "h", lwd = 2)) + graphics::legend("topleft", bty = "n", lty = 1, lwd = 2, col = seq_len(ncol(revisions)), legend = colnames(revisions)) graphics::title(main = "Revisions size") } ``` @@ -52,29 +44,7 @@ if (add_plot) { # Main Results ```{r summarytable, echo = FALSE} -if (!requireNamespace("kableExtra", quietly = TRUE)) { - knitr::kable(main_results) -} else { - format_font <- function(x) { - kableExtra::cell_spec(x, - color = ifelse(is.na(x), "black", - ifelse(substr(x, 1, 1) == "G", "green", - ifelse(substr(x, 1, 1) == "U", "orange", "red"))), - bold = ifelse(is.na(x), FALSE, - ifelse(substr(x, 1, 1) == "S", TRUE, FALSE))) - } - nc <- ncol(main_results) - main_results[, -1L] <- apply(X = main_results[, -1L, drop = FALSE], - MARGIN = 2L, - FUN = format_font) - if (getOption("knitr.table.format") == "latex") { - rownames(main_results) <- gsub(x = rownames(main_results), - pattern = "_", - replacement = "\\_", - fixed = TRUE) - } - kableExtra::kable_minimal(knitr::kable(main_results, escape = FALSE)) -} +rslt |> build_table(type = "summary") ``` # Tests description @@ -86,7 +56,7 @@ if (!requireNamespace("kableExtra", quietly = TRUE)) { In the context of revision analysis, Theil's inequality coefficient, also known as Theil's U, provides a measure of the accuracy of a set of preliminary estimates (P) compared to a latter version (L). There exists a few definitions of Theil's statistics leading to different interpretation of the results. In this package, two definitions are considered. The first statistic, U1, is given by $$ -U_1=\frac{\sqrt{\frac{1}{n}\sum^n_{t=1}(L_t-P_t)^2}}{\sqrt{\frac{1}{n}\sum^n_{t=1}L_t^2}+\sqrt{\frac{1}{n}\sum^n_{t=1}P_t^2}} \\ \\ +U_1=\frac{\sqrt{\frac{1}{n}\sum^n_{t=1}(L_t-P_t)^2}}{\sqrt{\frac{1}{n}\sum^n_{t=1}L_t^2}+\sqrt{\frac{1}{n}\sum^n_{t=1}P_t^2}} $$ U1 is bounded between 0 and 1. The closer the value of U1 is to zero, the better the forecast method. However, this classic definition of Theil's statistic suffers from a number of limitations. In particular, a set of near zero preliminary estimates would always give a value of the U1 statistic close to 1 even though they are close to the latter estimates. diff --git a/man/View.rjd3rev_vintages.Rd b/man/View.Rd similarity index 82% rename from man/View.rjd3rev_vintages.Rd rename to man/View.Rd index e97ae66..1df10ad 100644 --- a/man/View.rjd3rev_vintages.Rd +++ b/man/View.Rd @@ -1,17 +1,23 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vintages.R -\name{View.rjd3rev_vintages} +% Please edit documentation in R/revision_analysis.R, R/vintages.R +\name{View} +\alias{View} +\alias{View.default} \alias{View.rjd3rev_vintages} \title{View function for objects of class "rjd3rev_vintages"} \usage{ +View(x, ...) + +\method{View}{default}(x, ...) + \method{View}{rjd3rev_vintages}(x, type = c("all", "long", "horizontal", "vertical", "diagonal"), ...) } \arguments{ \item{x}{an object of class "rjd3rev_vintages".} -\item{type}{type of view to display} - \item{...}{further arguments passed to the \code{View} method.} + +\item{type}{type of view to display} } \description{ Display the different view in a different panel to visualize the data in a table / matrix format diff --git a/man/View.rjd3rev_rslts.Rd b/man/View.rjd3rev_rslts.Rd new file mode 100644 index 0000000..8abc072 --- /dev/null +++ b/man/View.rjd3rev_rslts.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/revision_analysis.R +\name{View.rjd3rev_rslts} +\alias{View.rjd3rev_rslts} +\title{View function for objects of class \code{rjd3rev_rslts}} +\usage{ +\method{View}{rjd3rev_rslts}(x, type = c("summary", "stats-desc", "revisions", "tests"), ...) +} +\arguments{ +\item{x}{an object of class \code{rjd3rev_rslts}} + +\item{type}{type of view to display} + +\item{...}{further arguments passed to \code{\link{View}}.} +} +\description{ +View function for objects of class \code{rjd3rev_rslts} +} diff --git a/man/bias.Rd b/man/bias.Rd index 02bc0b1..62ccaa3 100644 --- a/man/bias.Rd +++ b/man/bias.Rd @@ -17,25 +17,17 @@ rather as data not (yet) available (the default).} Estimate bias using t-test and augmented t-test } \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") +) ## Create vintage and test -vintages <- create_vintages(df, periodicity = 4) +vintages <- create_vintages(df_long, periodicity = 4) revisions <- get_revisions(vintages, gap = 1) bias(revisions$diagonal_view) diff --git a/man/check_vertical.Rd b/man/check_vertical.Rd index 7fdef53..28f7537 100644 --- a/man/check_vertical.Rd +++ b/man/check_vertical.Rd @@ -23,7 +23,7 @@ check_vertical(x, ...) \item{...}{Arguments to be passed to \code{check_vertical} according to the class of the object \code{x}} -\item{periodicity}{periodicity of the time period (12, 4 or 1 for resp. +\item{periodicity}{Integer. Periodicity of the time period (12, 4 or 1 for resp. monthly, quarterly or annual data)} \item{date_format}{\code{character} string corresponding to the format used in diff --git a/man/cointegration.Rd b/man/cointegration.Rd index b040a86..9376d11 100644 --- a/man/cointegration.Rd +++ b/man/cointegration.Rd @@ -19,25 +19,17 @@ rather as data not (yet) available (the default).} Cointegration tests (Engle-Granger) } \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") +) ## Create vintage and test -vintages <- create_vintages(df, periodicity = 4) +vintages <- create_vintages(df_long, periodicity = 4L) cointegration(vintages$diagonal_view) } diff --git a/man/create_vintages.Rd b/man/create_vintages.Rd index 8a9dbb9..faddec3 100644 --- a/man/create_vintages.Rd +++ b/man/create_vintages.Rd @@ -49,7 +49,7 @@ vintage views (selected by the argument \code{type}.} \item{type}{character specifying the type of representation of the input between \code{"long"}, \code{"horizontal"} and \code{"vertical"} approach.} -\item{periodicity}{periodicity of the time period (12, 4 or 1 for resp. +\item{periodicity}{Integer. Periodicity of the time period (12, 4 or 1 for resp. monthly, quarterly or annual data)} \item{date_format}{\code{character} string corresponding to the format used in diff --git a/man/create_vintages_from_csv.Rd b/man/create_vintages_from_csv.Rd index 8104cc6..d55aa4b 100644 --- a/man/create_vintages_from_csv.Rd +++ b/man/create_vintages_from_csv.Rd @@ -19,7 +19,7 @@ to be read from.} \item{type}{character specifying the type of representation of the input between \code{"long"}, \code{"horizontal"} and \code{"vertical"} approach.} -\item{periodicity}{periodicity of the time period (12, 4 or 1 for resp. +\item{periodicity}{Integer. Periodicity of the time period (12, 4 or 1 for resp. monthly, quarterly or annual data)} \item{date_format}{\code{character} string corresponding to the format used in diff --git a/man/create_vintages_from_xlsx.Rd b/man/create_vintages_from_xlsx.Rd index 48fa564..a8cec53 100644 --- a/man/create_vintages_from_xlsx.Rd +++ b/man/create_vintages_from_xlsx.Rd @@ -18,7 +18,7 @@ to be read from.} \item{type}{character specifying the type of representation of the input between \code{"long"}, \code{"horizontal"} and \code{"vertical"} approach.} -\item{periodicity}{periodicity of the time period (12, 4 or 1 for resp. +\item{periodicity}{Integer. Periodicity of the time period (12, 4 or 1 for resp. monthly, quarterly or annual data)} \item{...}{Arguments to be passed to \code{readxl::read_excel()}, for example: diff --git a/man/descriptive_statistics.Rd b/man/descriptive_statistics.Rd index a6ba6a3..81a2f35 100644 --- a/man/descriptive_statistics.Rd +++ b/man/descriptive_statistics.Rd @@ -16,25 +16,17 @@ descriptive_statistics(revisions.view, rounding = 3) Descriptive statistics } \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") +) ## Create vintage and get descriptive statistics of revisions -vintages <- create_vintages(df, periodicity = 4) +vintages <- create_vintages(df_long, periodicity = 4) revisions <- get_revisions(vintages, gap = 1) descriptive_statistics(revisions$diagonal_view, rounding = 1) diff --git a/man/efficiencyModel1.Rd b/man/efficiencyModel1.Rd index cba3ef0..e8a8fc3 100644 --- a/man/efficiencyModel1.Rd +++ b/man/efficiencyModel1.Rd @@ -21,25 +21,17 @@ rather as data not (yet) available (the default).} Linear regression model of the revisions (R) on a preliminary vintage (P) } \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") +) ## Create vintage and test -vintages <- create_vintages(df, periodicity = 4) +vintages <- create_vintages(df_long, periodicity = 4L) efficiencyModel1(vintages$diagonal_view) } diff --git a/man/efficiencyModel2.Rd b/man/efficiencyModel2.Rd index 9b6958f..01f666e 100644 --- a/man/efficiencyModel2.Rd +++ b/man/efficiencyModel2.Rd @@ -21,25 +21,17 @@ rather as data not (yet) available (the default).} Linear regression model of R_v on R_\{v-1\} } \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") +) ## Create vintage and test -vintages <- create_vintages(df, periodicity = 4) +vintages <- create_vintages(df_long, periodicity = 4L) efficiencyModel2(vintages$diagonal_view) } diff --git a/man/orthogonallyModel1.Rd b/man/orthogonallyModel1.Rd index 1c9e86f..756e726 100644 --- a/man/orthogonallyModel1.Rd +++ b/man/orthogonallyModel1.Rd @@ -19,25 +19,17 @@ rather as data not (yet) available (the default).} Linear regression model of R_v on R_\{v-1\},...,R_\{v-p\}. (p=nrevs) } \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") +) ## Create vintage and test -vintages <- create_vintages(df, periodicity = 4) +vintages <- create_vintages(df_long, periodicity = 4L) revisions <- get_revisions(vintages, gap = 1) orthogonallyModel1(revisions$diagonal_view) diff --git a/man/orthogonallyModel2.Rd b/man/orthogonallyModel2.Rd index 373863b..268d616 100644 --- a/man/orthogonallyModel2.Rd +++ b/man/orthogonallyModel2.Rd @@ -19,25 +19,17 @@ rather as data not (yet) available (the default).} Linear regression model of R_v on R_\{v-k\} (k = reference) } \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") +) ## Create vintage and test -vintages <- create_vintages(df, periodicity = 4) +vintages <- create_vintages(df_long, periodicity = 4L) revisions <- get_revisions(vintages, gap = 1) orthogonallyModel2(revisions$diagonal_view) diff --git a/man/print.rjd3rev_revisions.Rd b/man/print.rjd3rev_revisions.Rd index 16bf344..3303273 100644 --- a/man/print.rjd3rev_revisions.Rd +++ b/man/print.rjd3rev_revisions.Rd @@ -16,7 +16,7 @@ corresponds to the number of columns.} (verical view), the last n rows (horizontal view) or the first n columns (diagonal view).} -\item{\dots}{further arguments passed to the print() function.} +\item{\dots}{further arguments passed to the \code{\link{print}} function.} } \description{ Print function for objects of class \code{"rjd3rev_revisions"} diff --git a/man/print.rjd3rev_rslts.Rd b/man/print.rjd3rev_rslts.Rd index 4950883..a69e433 100644 --- a/man/print.rjd3rev_rslts.Rd +++ b/man/print.rjd3rev_rslts.Rd @@ -2,15 +2,15 @@ % Please edit documentation in R/revision_analysis.R \name{print.rjd3rev_rslts} \alias{print.rjd3rev_rslts} -\title{Print function for objects of class "rjd3rev_rslts"} +\title{Print function for objects of class \code{rjd3rev_rslts}} \usage{ \method{print}{rjd3rev_rslts}(x, ...) } \arguments{ -\item{x}{an object of class "rjd3rev_rslts"} +\item{x}{an object of class \code{rjd3rev_rslts}} -\item{\dots}{further arguments passed to the print() function.} +\item{\dots}{further arguments passed to the \code{\link{print}} function.} } \description{ -Print function for objects of class "rjd3rev_rslts" +Print function for objects of class \code{rjd3rev_rslts} } diff --git a/man/print.rjd3rev_vintages.Rd b/man/print.rjd3rev_vintages.Rd index b1503f8..4be2b9c 100644 --- a/man/print.rjd3rev_vintages.Rd +++ b/man/print.rjd3rev_vintages.Rd @@ -16,7 +16,7 @@ corresponds to the number of columns.} (verical view), the last n rows (horizontal view) or the first n columns (diagonal view). This argument is not used for the long view.} -\item{...}{further arguments passed to the print() function.} +\item{...}{further arguments passed to the \code{\link{print}} function.} } \description{ Print function for objects of class \code{"rjd3rev_vintages"} diff --git a/man/render_report.Rd b/man/render_report.Rd index d98562a..8ccc5c2 100644 --- a/man/render_report.Rd +++ b/man/render_report.Rd @@ -8,21 +8,22 @@ render_report( rslt, output_file, output_dir, - output_format = c("html_document", "pdf_document"), + output_format = c("html_document", "pdf_document", "word_document"), plot_revisions = FALSE, open_report = TRUE, ... ) } \arguments{ -\item{rslt}{an object of class \code{"rjd3rev_vintages"} which is the output +\item{rslt}{an object of class \code{"rjd3rev_rslts"} which is the output of the function \code{revision_analysis()}} \item{output_file}{path or name of the output file containing the report} \item{output_dir}{path of the dir containing the output file (Optional)} -\item{output_format}{either an HTML document (default) or a PDF document} +\item{output_format}{either an HTML document (default), a PDF document or a +Word document} \item{plot_revisions}{Boolean. Default is FALSE meaning that a plot with the revisions will not be added to the report.} @@ -42,25 +43,16 @@ Generate report on Revision Analysis \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{ diff --git a/man/revision_analysis.Rd b/man/revision_analysis.Rd index 822747e..e4418b3 100644 --- a/man/revision_analysis.Rd +++ b/man/revision_analysis.Rd @@ -81,30 +81,23 @@ about each tests. \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 = 10L, + periodicity = 4L, + start_period = as.Date("2010-01-01") +) ## Create a `"rjd3rev_vintages"` object with the input -vintages <- create_vintages(x = df, periodicity = 4, date_format = "\%Y-\%m-\%d") -# revisions <- get_revisions(vintages, gap = 1) # just to get a first insight of the revisions +vintages <- create_vintages(x = df_long, periodicity = 4L, date_format = "\%Y-\%m-\%d") +# revisions <- get_revisions(vintages, gap = 1L) # just to get a first insight of the revisions ## Call using all default parameters rslt1 <- revision_analysis(vintages) # render_report(rslt1) -# summary(rslt1) # formatted summary only +summary(rslt1) # formatted summary only +View(rslt1) # formatted tables in viewer panel ## Calls using diagonal view (suited in many situations such as to evaluate GDP estimates) ## Note: when input are not growth rates but the gross series, differentiation is @@ -112,25 +105,30 @@ rslt1 <- revision_analysis(vintages) ## must be set to TRUE manually whenever a log-transformation of the data is necessary rslt2 <- revision_analysis(vintages, gap = 1, view = "diagonal", n.releases = 3) # render_report(rslt2) -# summary(rslt2) +summary(rslt2) +View(rslt2) ## Call to evaluate revisions for a specific range of vintage periods vintages <- create_vintages( - x = df, - periodicity = 4, - vintage_selection = c(start="2021-12-31", end="2023-06-30") + x = df_long, + periodicity = 4L, + vintage_selection = c(start = "2012-12-31", end = "2018-06-30") ) -rslt3 <- revision_analysis(vintages, gap=2, view = "vertical") +rslt3 <- revision_analysis(vintages, gap = 2, view = "vertical") #render_report(rslt3) -#summary(rslt3) +summary(rslt3) +View(rslt3) ## Note that it is possible to change thresholds values for quality ## assessment using options (see vignette for details) -options(augmented_t_threshold = c(severe = 0.005, bad = 0.01, uncertain = 0.05), - slope_and_drift_threshold = c(severe = 0.005, bad = 0.05, uncertain = 0.10), - theil_u2_threshold = c(uncertain = .5, bad = .7, severe = 1)) +options( + augmented_t_threshold = c(severe = 0.005, bad = 0.01, uncertain = 0.05), + slope_and_drift_threshold = c(severe = 0.005, bad = 0.05, uncertain = 0.10), + theil_u2_threshold = c(uncertain = .5, bad = .7, severe = 1) +) rslt4 <- revision_analysis(vintages, gap = 1, view = "diagonal", n.releases = 3) summary(rslt4) +View(rslt4) } \seealso{ diff --git a/man/signalnoise.Rd b/man/signalnoise.Rd index a3c7ddf..257b6f9 100644 --- a/man/signalnoise.Rd +++ b/man/signalnoise.Rd @@ -24,24 +24,15 @@ For 'news': R on L (latter estimate). } \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") +) ## Create vintage and test -vintages <- create_vintages(df, periodicity = 4) +vintages <- create_vintages(df_long, periodicity = 4L) signalnoise(vintages$diagonal_view) } diff --git a/man/simulate_long.Rd b/man/simulate_long.Rd new file mode 100644 index 0000000..5b6849a --- /dev/null +++ b/man/simulate_long.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simulate.R +\name{simulate_long} +\alias{simulate_long} +\title{Simulate long datasets with revisions} +\usage{ +simulate_long( + n_period = 50, + n_revision = 10, + start_period = as.Date("2012-01-01"), + periodicity = 12L +) +} +\arguments{ +\item{n_period}{Integer. Number of different time-period (length of the +simulated series).} + +\item{n_revision}{Integer. Number of different revision dates.} + +\item{start_period}{Date. Start of the series.} + +\item{periodicity}{Integer. Periodicity of the time period (12, 4 or 1 for +resp. monthly, quarterly or annual data).} +} +\value{ +A dataset in the long format. See \code{\link{create_vintages}} for +more information about the different data formats. +} +\description{ +Simulate long datasets with revisions +} +\examples{ + +simulate_long(n_period = 100L, n_revision = 10L) +simulate_long(periodicity = 1L) +simulate_long(start_period = as.Date("2000-01-01"), + n_period = 10L * 12L, + periodicity = 12L) +simulate_long(periodicity = 4L, n_period = 5L * 4L) + +} diff --git a/man/slope_and_drift.Rd b/man/slope_and_drift.Rd index 99db685..9f6f7f9 100644 --- a/man/slope_and_drift.Rd +++ b/man/slope_and_drift.Rd @@ -21,25 +21,17 @@ rather as data not (yet) available (the default).} Linear regression model of a latter vintage (L) on a preliminary vintage (P) } \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") +) ## Create vintage and test -vintages <- create_vintages(df, periodicity = 4) +vintages <- create_vintages(df_long, periodicity = 4L) slope_and_drift(vintages$diagonal_view) } diff --git a/man/summary.rjd3rev_rslts.Rd b/man/summary.rjd3rev_rslts.Rd index d6048e0..c5993ff 100644 --- a/man/summary.rjd3rev_rslts.Rd +++ b/man/summary.rjd3rev_rslts.Rd @@ -2,15 +2,15 @@ % Please edit documentation in R/revision_analysis.R \name{summary.rjd3rev_rslts} \alias{summary.rjd3rev_rslts} -\title{Summary function for objects of class "rjd3rev_rslts"} +\title{Summary function for objects of class \code{rjd3rev_rslts}} \usage{ \method{summary}{rjd3rev_rslts}(object, ...) } \arguments{ -\item{object}{an object of class "rjd3rev_rslts"} +\item{object}{an object of class \code{rjd3rev_rslts}} \item{...}{further arguments passed to or from other methods.} } \description{ -Summary function for objects of class "rjd3rev_rslts" +Summary function for objects of class \code{rjd3rev_rslts} } diff --git a/man/theil.Rd b/man/theil.Rd index 23c506f..ec610f4 100644 --- a/man/theil.Rd +++ b/man/theil.Rd @@ -21,25 +21,17 @@ rather as data not (yet) available (the default).} Theil's Inequality Coefficient U1 } \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") +) ## Create vintage and test -vintages <- create_vintages(df, periodicity = 4) +vintages <- create_vintages(df_long, periodicity = 4) theil(vintages$diagonal_view) } diff --git a/man/theil2.Rd b/man/theil2.Rd index 111754e..00caf7e 100644 --- a/man/theil2.Rd +++ b/man/theil2.Rd @@ -21,25 +21,17 @@ rather as data not (yet) available (the default).} Theil's Inequality Coefficient U2 } \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") +) ## Create vintage and test -vintages <- create_vintages(df, periodicity = 4) +vintages <- create_vintages(df_long, periodicity = 4) theil2(vintages$diagonal_view) } diff --git a/man/unitroot.Rd b/man/unitroot.Rd index d6403f0..340d726 100644 --- a/man/unitroot.Rd +++ b/man/unitroot.Rd @@ -20,24 +20,15 @@ Unit root test } \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") +) ## Create vintage and test -vintages <- create_vintages(df, periodicity = 4) +vintages <- create_vintages(df_long, periodicity = 4L) unitroot(vintages$diagonal_view) } diff --git a/man/vecm.Rd b/man/vecm.Rd index 799a6b8..c3c5fc7 100644 --- a/man/vecm.Rd +++ b/man/vecm.Rd @@ -28,24 +28,15 @@ among the different component series. } \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") +) ## Create vintage and test -vintages <- create_vintages(df, periodicity = 4) +vintages <- create_vintages(df_long, periodicity = 4L) vecm(vintages$diagonal_view) } diff --git a/vignettes/rjd3revisions.Rmd b/vignettes/rjd3revisions.Rmd index 59815a0..66309b9 100644 --- a/vignettes/rjd3revisions.Rmd +++ b/vignettes/rjd3revisions.Rmd @@ -270,9 +270,11 @@ It is possible for the user to change the default values of the thresholds consi Here's how to customize a threshold. Thresholds values should be defined as an ascending numeric vector. We start from -Inf and each element of the vector should be understood as the upper or lower bound (depending on the null hypothesis) of the corresponding assessment. Furthermore, the assessment "good" is always the one not to be mentioned. Depending on the test, it will be interpreted adequately. Finally, only the assessments 'good' (implicitly), 'uncertain', 'bad' and 'severe' are allowed but they don't all have to be used if it is not necessary. Here is an example of how to modify threshold values for some of the tests. The list with the name of all test thresholds that can be modified can be found in the list below. ```{r options, echo = TRUE, eval = FALSE} -options(list(augmented_t_threshold = c(severe = 0.005, bad = 0.05, uncertain = 0.1), - t_threshold = c(bad = 0.05, uncertain = 0.1), - theil_u2_threshold = c(uncertain = .5, bad = .75, severe = 1))) +options( + augmented_t_threshold = c(severe = 0.005, bad = 0.05, uncertain = 0.1), + t_threshold = c(bad = 0.05, uncertain = 0.1), + theil_u2_threshold = c(uncertain = .5, bad = .75, severe = 1) +) rslt2 <- revision_analysis(vintages, gap = 1, view = "diagonal", n.releases = 3) summary(rslt2)