From 6e859a634705938e35da23bfa9b85cc2b273cdf9 Mon Sep 17 00:00:00 2001 From: Tanguy BARTHELEMY Date: Tue, 9 Apr 2024 15:57:14 +0200 Subject: [PATCH 01/13] update Rbuildignore --- .Rbuildignore | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.Rbuildignore b/.Rbuildignore index ed64ada..9d46f30 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -8,3 +8,6 @@ ^\.github$ ^LICENSE$ ^README\.Rmd$ + +^TO_DO$ +^\.lintr$ From bbb59c79721ac962676685b99da814ceb6a2bcf6 Mon Sep 17 00:00:00 2001 From: Tanguy BARTHELEMY Date: Tue, 9 Apr 2024 15:57:42 +0200 Subject: [PATCH 02/13] add new tests for creation of vintages --- tests/testthat.R | 12 ++ tests/testthat/test-create_vintages.R | 193 ++++++++++++++++++++++++++ 2 files changed, 205 insertions(+) create mode 100644 tests/testthat.R create mode 100644 tests/testthat/test-create_vintages.R diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..e79a88b --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,12 @@ +# This file is part of the standard setup for testthat. +# It is recommended that you do not modify it. +# +# Where should you do additional test configuration? +# Learn more about the roles of various files in: +# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview +# * https://testthat.r-lib.org/articles/special-files.html + +library(testthat) +library(rjd3revisions) + +test_check("rjd3revisions") diff --git a/tests/testthat/test-create_vintages.R b/tests/testthat/test-create_vintages.R new file mode 100644 index 0000000..6380ce1 --- /dev/null +++ b/tests/testthat/test-create_vintages.R @@ -0,0 +1,193 @@ +values_long <- c( + .8, .2, NA, NA, .8, .1, NA, NA, + .7, .1, NA, NA, .7, .2, .5, NA, + .7, .2, .5, NA, .7, .3, .7, NA, + .7, .2, .7, .4, .7, .3, .7, .3 +) + +input_long_1 <- data.frame( + rev_date = rep(x = c( + "2022-07-31", "2022-08-31", "2022-09-30", "2022-10-31", + "2022-11-30", "2022-12-31", "2023-01-31", "2023-02-28" + ), each = 4L), + time_period = rep(x = c("2022Q1", "2022Q2", "2022Q3", "2022Q4"), times = 8L), + obs_value = values_long +) + +input_long_2 <- data.frame( + rev_date = rep(x = c( + "31/07/2022", "31/08/2022", "30/09/2022", "31/10/2022", + "30/11/2022", "31/12/2022", "31/01/2023", "28/02/2023" + ), each = 4L), + time_period = c(rep(x = c("2022 T1", "2022 T2", "2022 T3", "2022 T4"), times = 8L)), + obs_value = values_long +) + +input_long_3 <- data.frame( + rev_date = rep(x = c( + "2022-07-31", "2022-08-31", "2022-09-30", "2022-10-31", + "2022-11-30", "2022-12-31", "2023-01-31", "2023-02-28" + ), each = 4L), + time_period = rep(x = c("2022-01-01", "2022-04-01", "2022-07-01", "2022-10-01"), times = 8L), + obs_value = values_long +) + +input_long_4 <- data.frame( + rev_date = rep(x = c( + "07/31/22", "08/31/22", "09/30/22", "10/31/22", + "11/30/22", "12/31/22", "01/31/23", "02/28/23" + ), each = 4L), + time_period = c(rep(x = c("2022 Q1", "2022 Q2", "2022 Q3", "2022 Q4"), times = 8L)), + obs_value = values_long +) + +values_horizontal <- c(0.8, 0.8, 0.7, 0.7, 0.7, 0.7, 0.7, 0.7, 0.2, 0.1, + 0.1, 0.2, 0.2, 0.3, 0.2, 0.3, NA, NA, NA, 0.5, 0.5, 0.7, 0.7, + 0.7, NA, NA, NA, NA, NA, NA, 0.4, 0.3) + +input_horizontal_1 <- structure( + .Data = values_horizontal, + dim = c(8L, 4L), + dimnames = list( + c("2022-07-31", "2022-08-31", "2022-09-30", "2022-10-31", + "2022-11-30", "2022-12-31", "2023-01-31", "2023-02-28"), + c("2022Q1", "2022Q2", "2022Q3", "2022Q4")) +) + +input_horizontal_2 <- structure( + .Data = values_horizontal, + dim = c(8L, 4L), + dimnames = list( + c("31/07/2022", "31/08/2022", "30/09/2022", "31/10/2022", + "30/11/2022", "31/12/2022", "31/01/2023", "28/02/2023"), + c("2022 T1", "2022 T2", "2022 T3", "2022 T4")) +) + +input_horizontal_3 <- structure( + .Data = values_horizontal, + dim = c(8L, 4L), + dimnames = list( + c("2022-07-31", "2022-08-31", "2022-09-30", "2022-10-31", + "2022-11-30", "2022-12-31", "2023-01-31", "2023-02-28"), + c("2022-01-01", "2022-04-01", "2022-07-01", "2022-10-01")) +) + +input_horizontal_4 <- structure( + .Data = values_horizontal, + dim = c(8L, 4L), + dimnames = list( + c("07/31/22", "08/31/22", "09/30/22", "10/31/22", + "11/30/22", "12/31/22", "01/31/23", "02/28/23"), + c("2022Q1", "2022Q2", "2022Q3", "2022Q4")) +) + +values_vertical <- c(0.8, 0.2, NA, NA, 0.8, 0.1, NA, NA, 0.7, 0.1, NA, + NA, 0.7, 0.2, 0.5, NA, 0.7, 0.2, 0.5, NA, 0.7, 0.3, 0.7, NA, + 0.7, 0.2, 0.7, 0.4, 0.7, 0.3, 0.7, 0.3) + +input_vertical_1 <- structure( + .Data = values_vertical, + dim = c(4L, 8L), + dimnames = list( + NULL, c("2022-07-31", "2022-08-31", "2022-09-30", "2022-10-31", + "2022-11-30", "2022-12-31", "2023-01-31", "2023-02-28")), + tsp = c(2022, 2022.75, 4), + class = c("mts", "ts", "matrix", "array") +) + +input_vertical_2 <- structure( + .Data = values_vertical, + dim = c(4L, 8L), + dimnames = list( + NULL, + c("31/07/2022", "31/08/2022", "30/09/2022", "31/10/2022", + "30/11/2022", "31/12/2022", "31/01/2023", "28/02/2023")), + tsp = c(2022, 2022.75, 4), + class = c("mts", "ts", "matrix", "array") +) + +input_vertical_3 <- structure( + .Data = values_vertical, + dim = c(4L, 8L), + dimnames = list( + NULL, c("07/31/22", "08/31/22", "09/30/22", "10/31/22", + "11/30/22", "12/31/22", "01/31/23", "02/28/23")), + tsp = c(2022, 2022.75, 4), + class = c("mts", "ts", "matrix", "array") +) + +input_vertical_4 <- structure( + .Data = values_vertical, + dim = c(4L, 8L), + dimnames = list( + c("2022Q1", "2022Q2", "2022Q3", "2022Q4"), + c("2022-07-31", "2022-08-31", "2022-09-30", "2022-10-31", + "2022-11-30", "2022-12-31", "2023-01-31", "2023-02-28") + ) +) + +input_vertical_5 <- structure( + .Data = values_vertical, + dim = c(4L, 8L), + dimnames = list( + c("2022 T1", "2022 T2", "2022 T3", "2022 T4"), + c("31/07/2022", "31/08/2022", "30/09/2022", "31/10/2022", + "30/11/2022", "31/12/2022", "31/01/2023", "28/02/2023") + ) +) + +input_vertical_6 <- structure( + .Data = values_vertical, + dim = c(4L, 8L), + dimnames = list( + c("2022-01-01", "2022-04-01", "2022-07-01", "2022-10-01"), + c("2022-07-31", "2022-08-31", "2022-09-30", "2022-10-31", + "2022-11-30", "2022-12-31", "2023-01-31", "2023-02-28") + ) +) + +input_vertical_7 <- structure( + .Data = values_vertical, + dim = c(4L, 8L), + dimnames = list( + c("2022Q1", "2022Q2", "2022Q3", "2022Q4"), + c("07/31/22", "08/31/22", "09/30/22", "10/31/22", + "11/30/22", "12/31/22", "01/31/23", "02/28/23") + ) +) + +test_that("Creation of vintages works for all format", { + + vintage1 <- create_vintages(x = input_long_1, type = "long", periodicity = 4L) + vintage2 <- create_vintages(x = input_long_2, type = "long", periodicity = 4L, date_format = "%d/%m/%Y") + vintage3 <- create_vintages(x = input_long_3, type = "long", periodicity = 4L) + vintage4 <- create_vintages(x = input_long_4, type = "long", periodicity = 4L, date_format = "%m/%d/%y") + + vintage5 <- create_vintages(x = input_horizontal_1, type = "horizontal", periodicity = 4L) + vintage6 <- create_vintages(x = input_horizontal_2, type = "horizontal", periodicity = 4L, date_format = "%d/%m/%Y") + vintage7 <- create_vintages(x = input_horizontal_3, type = "horizontal", periodicity = 4L) + vintage8 <- create_vintages(x = input_horizontal_4, type = "horizontal", periodicity = 4L, date_format = "%m/%d/%y") + + vintage9 <- create_vintages(x = input_vertical_1, type = "vertical") + vintage10 <- create_vintages(x = input_vertical_2, type = "vertical", date_format = "%d/%m/%Y") + vintage11 <- create_vintages(x = input_vertical_3, type = "vertical", date_format = "%m/%d/%y") + vintage12 <- create_vintages(x = input_vertical_4, type = "vertical", periodicity = 4L) + vintage13 <- create_vintages(x = input_vertical_5, type = "vertical", periodicity = 4L, date_format = "%d/%m/%Y") + vintage14 <- create_vintages(x = input_vertical_6, type = "vertical", periodicity = 4L) + vintage15 <- create_vintages(x = input_vertical_7, type = "vertical", periodicity = 4L, date_format = "%m/%d/%y") + + expect_identical(vintage1, vintage2) + expect_identical(vintage1, vintage3) + expect_identical(vintage1, vintage4) + expect_identical(vintage1, vintage5) + expect_identical(vintage1, vintage6) + expect_identical(vintage1, vintage7) + expect_identical(vintage1, vintage8) + expect_identical(vintage1, vintage9) + expect_identical(vintage1, vintage10) + expect_identical(vintage1, vintage11) + expect_identical(vintage1, vintage12) + expect_identical(vintage1, vintage13) + expect_identical(vintage1, vintage14) + expect_identical(vintage1, vintage15) +}) From 47a59485cf0c13569e4c8123fde347f3d0e9e29b Mon Sep 17 00:00:00 2001 From: Tanguy BARTHELEMY Date: Tue, 9 Apr 2024 16:06:54 +0200 Subject: [PATCH 03/13] update DESCRIPTION file --- DESCRIPTION | 32 ++++++++++++++++++-------------- 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8e16840..78db251 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,11 +2,11 @@ Package: rjd3revisions Type: Package Title: Revision analysis with 'JDemetra+ 3.0' Version: 1.1.0 -Authors@R: - person(given = "Corentin", - family = "Lemasson", - role = c("aut", "cre"), - email = "corentin.lemasson@nbb.be") +Authors@R: c( + person(given = "Corentin", family = "Lemasson", + email = "corentin.lemasson@nbb.be", role = c("aut", "cre")), + person(given = "Tanguy", family = "Barthelemy", + email = "tanguy.barthelemy@insee.fr", role = "aut")) Description: Interface around 'JDemetra+ 3.x' sa-toolkit (), STACE project. It performs a battery of tests on revisions and submit a report @@ -16,16 +16,18 @@ Description: Interface around 'JDemetra+ 3.x' sa-toolkit Depends: R (>= 3.6.0) Imports: - rJava (>= 1.0-6), - rjd3toolkit (>= 3.0.1), - knitr, - rmarkdown + rJava (>= 1.0-6), + rjd3toolkit (>= 3.0.1), + checkmate, + knitr, + rmarkdown +Suggests: + readxl, + formattable, + kableExtra, + testthat (>= 3.0.0) Remotes: - github::rjdemetra/rjd3toolkit -Suggest: - readxl, - formattable, - kableExtra + github::rjdemetra/rjd3toolkit SystemRequirements: Java (>= 17) License: EUPL Encoding: UTF-8 @@ -36,9 +38,11 @@ Collate: 'report.R' 'revision_analysis.R' 'revisions.R' + 'simulate.R' 'tests.R' 'vintages.R' 'zzz.R' RoxygenNote: 7.3.1 VignetteBuilder: knitr URL: https://rjdemetra.github.io/rjd3revisions/ +Config/testthat/edition: 3 From 9007520a9996eb777b44c4debf21a78ebab0e337 Mon Sep 17 00:00:00 2001 From: Tanguy BARTHELEMY Date: Tue, 9 Apr 2024 16:07:41 +0200 Subject: [PATCH 04/13] document package --- NAMESPACE | 7 +++ man/check_horizontal.Rd | 32 ++++++++++++++ man/check_long.Rd | 31 +++++++++++++ man/check_vertical.Rd | 35 +++++++++++++++ man/create_vintages.Rd | 75 +++++++++++++++----------------- man/create_vintages_from_csv.Rd | 6 +-- man/create_vintages_from_xlsx.Rd | 6 +-- man/revision_analysis.Rd | 10 +++-- vignettes/rjd3revisions.Rmd | 6 +-- 9 files changed, 155 insertions(+), 53 deletions(-) create mode 100644 man/check_horizontal.Rd create mode 100644 man/check_long.Rd create mode 100644 man/check_vertical.Rd diff --git a/NAMESPACE b/NAMESPACE index 9fb0f46..8f8aa5a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,9 @@ # Generated by roxygen2: do not edit by hand +S3method(check_horizontal,data.frame) +S3method(check_horizontal,default) +S3method(check_horizontal,matrix) +S3method(check_vertical,data.frame) S3method(check_vertical,default) S3method(check_vertical,matrix) S3method(check_vertical,mts) @@ -11,6 +15,9 @@ S3method(plot,rjd3rev_revision_analysis) S3method(print,rjd3rev_revision_analysis) S3method(summary,rjd3rev_revision_analysis) export(bias) +export(check_horizontal) +export(check_long) +export(check_vertical) export(cointegration) export(create_vintages) export(create_vintages_from_csv) diff --git a/man/check_horizontal.Rd b/man/check_horizontal.Rd new file mode 100644 index 0000000..d488f35 --- /dev/null +++ b/man/check_horizontal.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/vintages.R +\name{check_horizontal} +\alias{check_horizontal} +\title{Check horizontal format} +\usage{ +check_horizontal(x, ...) +} +\arguments{ +\item{x}{a formatted \code{data.frame} containing the input in the horizontal format} + +\item{date_format}{\code{character} string corresponding to the format used in +the input data.frame for the revision dates.} +} +\value{ +the same input but with date formatted +} +\description{ +Check horizontal format +} +\examples{ + +long_format <- rjd3revisions:::simulate_long( + start_period = as.Date("2020-01-01"), + n_period = 24, + n_revision = 6, + periodicity = 12L +) +horizontal_format <- rjd3revisions:::from_long_to_horizontal(long_format) +check_horizontal(horizontal_format) + +} diff --git a/man/check_long.Rd b/man/check_long.Rd new file mode 100644 index 0000000..e9db5a8 --- /dev/null +++ b/man/check_long.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/vintages.R +\name{check_long} +\alias{check_long} +\title{Check long format} +\usage{ +check_long(x, date_format = "\%Y-\%m-\%d") +} +\arguments{ +\item{x}{a formatted \code{data.frame} containing the input in the long format} + +\item{date_format}{\code{character} string corresponding to the format used in +the input data.frame for the revision dates.} +} +\value{ +the same input but with column and date formatted +} +\description{ +Check long format +} +\examples{ + +long_format <- rjd3revisions:::simulate_long( + start_period = as.Date("2020-01-01"), + n_period = 24, + n_revision = 6, + periodicity = 12L +) +check_long(long_format) + +} diff --git a/man/check_vertical.Rd b/man/check_vertical.Rd new file mode 100644 index 0000000..9d3a8fd --- /dev/null +++ b/man/check_vertical.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/vintages.R +\name{check_vertical} +\alias{check_vertical} +\title{Check vertical format} +\usage{ +check_vertical(x, ...) +} +\arguments{ +\item{x}{a formatted \code{data.frame} containing the input in the vertical format} + +\item{periodicity}{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 +the input data.frame for the revision dates.} +} +\value{ +the same input but in a ts object and with revision date formatted +} +\description{ +Check vertical format +} +\examples{ + +long_format <- rjd3revisions:::simulate_long( + start_period = as.Date("2020-01-01"), + n_period = 24, + n_revision = 6, + periodicity = 12L +) +vertical_format <- rjd3revisions:::from_long_to_vertical(long_format, periodicity = 12L) +check_vertical(vertical_format) + +} diff --git a/man/create_vintages.Rd b/man/create_vintages.Rd index e4d7ce3..52fb435 100644 --- a/man/create_vintages.Rd +++ b/man/create_vintages.Rd @@ -2,39 +2,9 @@ % Please edit documentation in R/vintages.R \name{create_vintages} \alias{create_vintages} -\alias{create_vintages.data.frame} -\alias{create_vintages.mts} -\alias{create_vintages.matrix} -\alias{create_vintages.default} \title{Create vintage tables} \usage{ create_vintages(x, ...) - -create_vintages.data.frame( - x, - type = c("long", "horizontal", "vertical"), - periodicity = c(4L, 12L, 1L), - date_format = "\%Y-\%m-\%d", - ... -) - -\method{create_vintages}{mts}( - x, - type = c("long", "horizontal", "vertical"), - periodicity = NULL, - date_format = "\%Y-\%m-\%d", - ... -) - -\method{create_vintages}{matrix}( - x, - type = c("long", "horizontal", "vertical"), - periodicity = c(4L, 12L, 1L), - date_format = "\%Y-\%m-\%d", - ... -) - -\method{create_vintages}{default}(x, ...) } \arguments{ \item{x}{a formatted object containing the input. It can be of type @@ -45,10 +15,18 @@ vintage views (selected by the argument `type`.} between `"long"`, `"horizontal"` and `"vertical"` approach.} \item{periodicity}{periodicity of the time period (12, 4 or 1 for resp. -monthly,quarterly or annual data)} +monthly, quarterly or annual data)} -\item{date_format}{character string corresponding to the format used in +\item{date_format}{\code{character} string corresponding to the format used in the input data.frame for the revision dates.} + +\item{vintage_selection}{\code{Date} vector (or a character vector with the +same format as date_format) of length <= 2, specifying the range of revision +dates to retain. As an example: +c(start = "2022-02-02", end = "2022-08-05") or +c(start = as.Date("2022-02-02"), end = as.Date("2022-08-05")) would keep all +the vintages whose revision date is between 02 Feb. 2022 and 05 Aug. 2022. +If missing (by default), the whole range is selected.} } \value{ an object of class `rjd3rev_vintages` which contains the four @@ -99,15 +77,21 @@ non-redundant storage of data. } \examples{ ## creating the input -df <- data.frame(rev_date = c(rep("2022-07-31",4), rep("2022-08-31",4), - rep("2022-09-30",4), rep("2022-10-31",4), - rep("2022-11-30",4), rep("2022-12-31",4), - rep("2023-01-31",4), rep("2023-02-28",4)), - time_period = c(rep(c("2022Q1","2022Q2","2022Q3","2022Q4"),8)), - obs_value = c(.8,.2,NA,NA, .8,.1,NA,NA, - .7,.1,NA,NA, .7,.2,.5,NA, - .7,.2,.5,NA, .7,.3,.7,NA, - .7,.2,.7,.4, .7,.3,.7,.3)) + +df <- data.frame( + rev_date = rep(x = c( + "2022-07-31", "2022-08-31", "2022-09-30", "2022-10-31", + "2022-11-30", "2022-12-31", "2023-01-31", "2023-02-28" + ), each = 4L), + time_period = rep(x = c("2022Q1", "2022Q2", "2022Q3", "2022Q4"), times = 8L), + obs_value = c( + .8, .2, NA, NA, .8, .1, NA, NA, + .7, .1, NA, NA, .7, .2, .5, NA, + .7, .2, .5, NA, .7, .3, .7, NA, + .7, .2, .7, .4, .7, .3, .7, .3 + ) +) + vintages <- create_vintages(x = df, type = "long", periodicity = 4L) ## specifying the format of revision dates @@ -118,4 +102,13 @@ vintages <- create_vintages( date_format= "\%Y-\%m-\%d" ) +## including vintage selection +vintages <- create_vintages( + x = df, + type ="long", + periodicity = 4L, + date_format= "\%Y-\%m-\%d", + vintage_selection = c(start="2022-10-31", end="2023-01-31") +) + } diff --git a/man/create_vintages_from_csv.Rd b/man/create_vintages_from_csv.Rd index c6f0759..a3505c3 100644 --- a/man/create_vintages_from_csv.Rd +++ b/man/create_vintages_from_csv.Rd @@ -7,7 +7,7 @@ create_vintages_from_csv( file, type = c("long", "horizontal", "vertical"), - periodicity = c(4L, 12L, 1L), + periodicity, date_format = "\%Y-\%m-\%d", ... ) @@ -20,9 +20,9 @@ to be read from.} between `"long"`, `"horizontal"` and `"vertical"` approach.} \item{periodicity}{periodicity of the time period (12, 4 or 1 for resp. -monthly,quarterly or annual data)} +monthly, quarterly or annual data)} -\item{date_format}{character string corresponding to the format used in +\item{date_format}{\code{character} string corresponding to the format used in the input data.frame for the revision dates.} \item{...}{Arguments to be passed to `read.csv()`, for example: diff --git a/man/create_vintages_from_xlsx.Rd b/man/create_vintages_from_xlsx.Rd index 44ddf43..6ddb8cf 100644 --- a/man/create_vintages_from_xlsx.Rd +++ b/man/create_vintages_from_xlsx.Rd @@ -7,7 +7,7 @@ create_vintages_from_xlsx( file, type = c("long", "horizontal", "vertical"), - periodicity = c(4L, 12L, 1L), + periodicity, date_format = "\%Y-\%m-\%d", ... ) @@ -20,9 +20,9 @@ to be read from.} between `"long"`, `"horizontal"` and `"vertical"` approach.} \item{periodicity}{periodicity of the time period (12, 4 or 1 for resp. -monthly,quarterly or annual data)} +monthly, quarterly or annual data)} -\item{date_format}{character string corresponding to the format used in +\item{date_format}{\code{character} string corresponding to the format used in the input data.frame for the revision dates.} \item{...}{Arguments to be passed to `readxl::read_excel()`, for example: diff --git a/man/revision_analysis.Rd b/man/revision_analysis.Rd index 5001f0e..6dfc018 100644 --- a/man/revision_analysis.Rd +++ b/man/revision_analysis.Rd @@ -37,7 +37,7 @@ information about interests and drawbacks of each view.} Allow the user to limit the number of releases under investigation). When `view = "vertical"`, the user is invited to limit the number of vintages upstream through -the parameter `vintage.selection` in `create_vintages()` +the parameter `vintage_selection` in `create_vintages()` whenever necessary.} \item{transf.diff}{differentiation to apply to the data prior testing. Only @@ -98,7 +98,7 @@ for(i in 1:4) { df<-data.frame(rev_date, time_period, obs_values) ## Create a `"rjd3rev_vintages"` object with the input -vintages<-create_vintages(df, periodicity = 4, revdate.format= "\%Y-\%m-\%d") +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 ## Call using all default parameters @@ -115,7 +115,11 @@ rslt2<-revision_analysis(vintages, gap = 1, view = "diagonal", n.releases = 3) #summary(rslt2) ## Call to evaluate revisions for a specific range of vintage periods -vintages<-create_vintages(df, periodicity = 4, vintage.selection = list(start="2021-12-31", end="2023-06-30")) +vintages <- create_vintages( + x = df, + periodicity = 4, + vintage_selection = c(start="2021-12-31", end="2023-06-30") +) rslt3<-revision_analysis(vintages, gap=2, view = "vertical") #render_report(rslt3) #summary(rslt3) diff --git a/vignettes/rjd3revisions.Rmd b/vignettes/rjd3revisions.Rmd index 977a224..c9bf576 100644 --- a/vignettes/rjd3revisions.Rmd +++ b/vignettes/rjd3revisions.Rmd @@ -91,7 +91,7 @@ rslt<-revision_analysis(vintages, gap = 1, view = "diagonal", n.releases = 3) Finally to create the report and get a summary of the results, you can use ```{r} -render_report(rslt) +get_report(rslt) summary(rslt) print(rslt) @@ -149,7 +149,7 @@ For some of the parametric tests, prior transformation of the vintage data may b As part of the arguments of the `revision_analysis()` function, you can choose the view and the gap to consider, restrict the number of releases under investigation when diagonal view is selected and/or change the default setting about the prior transformation of the data (including the possibility to add a prior log-transformation of your data). -The function `render_report()` applied on the output of `revision_analysis()` will generate an enhanced HTML report including both a formatted summary of the results and full explanations about each tests (which are also included in the vignette below). The formatted summary of the results display the p-value of each test (except for Theil's tests where the value of the statistics is provided) and their interpretation. An appreciation 'good', 'uncertain', 'bad' and 'severe' is indeed associated to each test following the usual statistical interpretation of p-values and the orientation of the tests. This allows a quick visual interpretation of the results and is similar to what is done in the GUI of JDemetra+. +The function `get_report()` applied on the output of `revision_analysis()` will generate an enhanced HTML report including both a formatted summary of the results and full explanations about each tests (which are also included in the vignette below). The formatted summary of the results display the p-value of each test (except for Theil's tests where the value of the statistics is provided) and their interpretation. An appreciation 'good', 'uncertain', 'bad' and 'severe' is indeed associated to each test following the usual statistical interpretation of p-values and the orientation of the tests. This allows a quick visual interpretation of the results and is similar to what is done in the GUI of JDemetra+. In addition to the function `revision_analysis()`, the user can also perform tests individually if they want to. To list all functions available in the package (and therefore finding the different functions corresponding to the individual tests), you can do @@ -163,7 +163,7 @@ Use help(‘name of the functions’) or ?‘name of the functions’ for more i The detailed results of each test are part of the output returned by the function `revision_analysis()`. Alternatively, the functions associated with the individual test will give you the same result specific to this test. -In addition to the visual report that you can get by applying the function `render_report()` on the output of the function `revision_analysis()`, you can also apply the usual `summary()`, `print()` and `plot()` functions to this output. The function `summary()`, in particular, will print only the formatted table of the report with the main results. The `print()` will provide the same unformatted information together with some extra ones and `plot()` will plot the revisions over time. +In addition to the visual report that you can get by applying the function `get_report()` on the output of the function `revision_analysis()`, you can also apply the usual `summary()`, `print()` and `plot()` functions to this output. The function `summary()`, in particular, will print only the formatted table of the report with the main results. The `print()` will provide the same unformatted information together with some extra ones and `plot()` will plot the revisions over time. # Tests description and interpretation From 3826d36dc85559d93e81cc2346bbd42a6dd3b9f9 Mon Sep 17 00:00:00 2001 From: Tanguy BARTHELEMY Date: Tue, 9 Apr 2024 16:08:41 +0200 Subject: [PATCH 05/13] add new functions to simulate data --- R/simulate.R | 99 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 99 insertions(+) create mode 100644 R/simulate.R diff --git a/R/simulate.R b/R/simulate.R new file mode 100644 index 0000000..5b5785a --- /dev/null +++ b/R/simulate.R @@ -0,0 +1,99 @@ + +simulate_series <- function(n, periodicity = 12L) { + + # Check n + checkmate::assert_count(n, na.ok = FALSE, null.ok = FALSE) + + # Check periodicity + checkmate::assert_number(x = periodicity, na.ok = FALSE, finite = TRUE, null.ok = FALSE) + checkmate::assert_choice(x = periodicity, choices = c(1L, 4L, 12L)) + + coeff <- list( + phi = NULL, + d = 1, + theta = 2.8, + B_phi = NULL, + B_D = 1, + B_theta = -0.2 + ) + + JD_model <- rjd3toolkit::sarima_model( + phi = coeff$phi, + d = coeff$d, + theta = coeff$theta, + bphi = coeff$B_phi, + bd = coeff$B_D, + btheta = coeff$B_theta, + period = periodicity + ) + + return(rjd3toolkit::sarima_random(model = JD_model, length = n)) +} + +simulate_revision <- function(n, init = stats::rnorm(1, 0, 1)) { + + # Check n + checkmate::assert_count(n, na.ok = FALSE, null.ok = FALSE) + + # Check init + checkmate::assert_number(init, na.ok = FALSE, finite = TRUE, null.ok = FALSE) + + return(init + stats::rnorm(n, mean = 0, sd = 2 ** (2 - seq_len(n)))) +} + +simulate_long <- function(n_period = 50, + n_revision = 10, + start_period = as.Date("2012-01-01"), + periodicity = 12L) { + # Check n_period + checkmate::assert_count(n_period, positive = TRUE, na.ok = FALSE, null.ok = FALSE) + + # Check n_revision + checkmate::assert_count(n_revision, positive = TRUE, na.ok = FALSE, null.ok = FALSE) + + # Check start_period + checkmate::check_date(start_period, len = 1, null.ok = FALSE) + + # Check periodicity + checkmate::assert_number(x = periodicity, na.ok = FALSE, finite = TRUE, null.ok = FALSE) + checkmate::assert_choice(x = periodicity, choices = c(1L, 4L, 12L)) + + if (periodicity == 12L) { + by <- "month" + } else if (periodicity == 4L) { + by <- "quarter" + } else { + stop("Cas non trait\u00e9") + } + + time_period <- seq.Date(from = start_period, by = by, length.out = n_period) + rev_date <- as.Date(sort(sample( + x = min(time_period):(max(time_period) + 2 * 30 * 12 / periodicity), # On rajoute 2 périodes supplémentaires + size = n_revision, + replace = FALSE + ))) + final_series <- simulate_series(n_period) + + long <- data.frame( + rev_date = integer(), + time_period = integer(), + obs_values = double() + ) + + for (index_period in seq_along(time_period)) { + period <- time_period[index_period] + value <- final_series[index_period] + nb_NA <- sum(rev_date < period) + revised_series <- c(rep(NA_real_, nb_NA), + simulate_revision(n = n_revision - nb_NA, init = value)) + long <- rbind(long, data.frame( + rev_date = rev_date, + time_period = period, + obs_values = revised_series + )) + } + + long <- long[order(long$rev_date , long$time_period ), ] + + return(long) +} From 491d63b5c4cd0127782ce1a430666146a5f136ba Mon Sep 17 00:00:00 2001 From: Tanguy BARTHELEMY Date: Tue, 9 Apr 2024 16:09:45 +0200 Subject: [PATCH 06/13] change testing of class --- R/revisions.R | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/R/revisions.R b/R/revisions.R index 525a8bb..142a5af 100644 --- a/R/revisions.R +++ b/R/revisions.R @@ -24,11 +24,8 @@ #' vintages<-create_vintages(df, periodicity = 4) #' revisions<-get_revisions(vintages, gap=1) #' -get_revisions<-function(vintages, gap=1) { - if (!class(vintages)=="rjd3rev_vintages") { - warning("Wrong input. vintages must be an object of class 'rjd3rev_vintages'.") - return(NULL) - } +get_revisions<-function(vintages, gap = 1) { + checkmate::assert_class(x = vintages, classes = "rjd3rev_vintages") get_vd_rev <- function(vt, gap) { n<-dim(vt)[2] From 2b90b6af7ed5b4b3df3412c1d00cc916bfbccc02 Mon Sep 17 00:00:00 2001 From: Tanguy BARTHELEMY Date: Tue, 9 Apr 2024 16:10:28 +0200 Subject: [PATCH 07/13] add contributing to readme --- README.Rmd | 4 +++- README.md | 6 ++++-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/README.Rmd b/README.Rmd index b539c22..e697ed1 100644 --- a/README.Rmd +++ b/README.Rmd @@ -93,9 +93,11 @@ plot(rslt) This README.md file gives you a quick example of how to proceed. Consult the vignette (with `browseVignettes("rjd3revisions")`) and the documentation of each function (for example: `?create_vintages`, `?revision_analysis`) to see the current possibilities of the tool. -## Contributing +## Package Maintenance and contributing Any contribution is welcome and should be done through pull requests and/or issues. +pull requests should include **updated tests** and **updated documentation**. If functionality is changed, docstrings should be added or updated. + ## Licensing diff --git a/README.md b/README.md index 3a9a1a5..8cc5ba9 100644 --- a/README.md +++ b/README.md @@ -84,10 +84,12 @@ the vignette (with `browseVignettes("rjd3revisions")`) and the documentation of each function (for example: `?create_vintages`, `?revision_analysis`) to see the current possibilities of the tool. -## Contributing +## Package Maintenance and contributing Any contribution is welcome and should be done through pull requests -and/or issues. +and/or issues. pull requests should include **updated tests** and +**updated documentation**. If functionality is changed, docstrings +should be added or updated. ## Licensing From 904af5aaebaa6ece04fa3fc2e960ea9dc05a8ad2 Mon Sep 17 00:00:00 2001 From: Tanguy BARTHELEMY Date: Tue, 9 Apr 2024 16:10:57 +0200 Subject: [PATCH 08/13] add documentation for vintage creation --- R/vintages.R | 431 ++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 325 insertions(+), 106 deletions(-) diff --git a/R/vintages.R b/R/vintages.R index 96640a9..9b128af 100644 --- a/R/vintages.R +++ b/R/vintages.R @@ -1,11 +1,33 @@ # Check functions -------------------------------------------------------------- +#' Check long format +#' +#' @param x a formatted \code{data.frame} containing the input in the long format +#' @param date_format \code{character} string corresponding to the format used in +#' the input data.frame for the revision dates. +#' +#' @return the same input but with column and date formatted +#' @export +#' +#' @examples +#' +#' long_format <- rjd3revisions:::simulate_long( +#' start_period = as.Date("2020-01-01"), +#' n_period = 24, +#' n_revision = 6, +#' periodicity = 12L +#' ) +#' check_long(long_format) +#' check_long <- function(x, date_format = "%Y-%m-%d") { + + # Check input checkmate::assert_data_frame(x, ncols = 3L) checkmate::assert_numeric(x[, 3, drop = TRUE], .var.name = "The third column") - rev_date <- convert_rev_date(x[, 1, drop = TRUE], date_format = date_format) - time_period <- convert_time_period(x[, 2, drop = TRUE], date_format = date_format) + + rev_date <- convert_rev_date(x = x[, 1, drop = TRUE], date_format = date_format) + time_period <- convert_time_period(x = x[, 2, drop = TRUE], date_format = date_format) # Long format long <- x @@ -14,10 +36,33 @@ check_long <- function(x, date_format = "%Y-%m-%d") { long$revdate <- rev_date long$time <- time_period long <- long[order(long$revdate, long$time), ] + rownames(long) <- NULL return(long) } +#' 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. +#' 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. +#' +#' @return the same input but in a ts object and with revision date formatted +#' @export +#' +#' @examples +#' +#' long_format <- rjd3revisions:::simulate_long( +#' start_period = as.Date("2020-01-01"), +#' n_period = 24, +#' n_revision = 6, +#' periodicity = 12L +#' ) +#' vertical_format <- rjd3revisions:::from_long_to_vertical(long_format, periodicity = 12L) +#' check_vertical(vertical_format) +#' check_vertical <- function(x, ...) { return(UseMethod("check_vertical", x)) } @@ -25,36 +70,44 @@ check_vertical <- function(x, ...) { #' @exportS3Method check_vertical mts check_vertical.mts <- function( x, + periodicity, date_format = "%Y-%m-%d", - periodicity = NULL, ... ) { # Check data type checkmate::assert_matrix(x, mode = "numeric") # Check frequency - checkmate::assert_choice(x = frequency(x), choices = c(4L, 12L, 1L)) - if (!is.null(periodicity)) { - checkmate::assert_set_equal(x = frequency(x), y = periodicity) + checkmate::assert_choice(x = stats::frequency(x), choices = c(1L, 4L, 12L)) + if (!missing(periodicity)) { + # Check periodicity + checkmate::assert_count(x = periodicity, positive = TRUE, na.ok = FALSE, null.ok = FALSE) + checkmate::assert_choice(x = periodicity, choices = c(1L, 4L, 12L)) + checkmate::assert_set_equal(x = stats::frequency(x), y = periodicity) } # Vertical format vertical <- x - colnames(vertical) <- as.character(convert_rev_date(colnames(vertical), date_format)) + colnames(vertical) <- as.character(convert_rev_date(x = colnames(vertical), date_format = date_format)) return(vertical) } +#' @exportS3Method check_vertical data.frame +check_vertical.data.frame <- function(x, ...) { + return(UseMethod("check_vertical", as.matrix(x))) +} + #' @exportS3Method check_vertical matrix check_vertical.matrix <- function( x, + periodicity, date_format = "%Y-%m-%d", - periodicity = c(4L, 12L, 1L), ... ) { # Check periodicity - checkmate::assert_number(x = periodicity, na.ok = FALSE, finite = TRUE, null.ok = FALSE) - checkmate::assert_choice(x = periodicity, choices = c(4L, 12L, 1L)) + checkmate::assert_count(x = periodicity, positive = TRUE, na.ok = FALSE, null.ok = FALSE) + checkmate::assert_choice(x = periodicity, choices = c(1L, 4L, 12L)) # Check data type checkmate::assert_matrix(x, mode = "numeric") @@ -64,14 +117,12 @@ check_vertical.matrix <- function( # Vertical format vertical <- x - colnames(vertical) <- as.character(convert_rev_date(colnames(vertical), date_format)) - rownames(vertical) <- as.character(convert_time_period(rownames(vertical), date_format)) # Check date periods - real_time_period <- convert_time_period(rownames(vertical), date_format) + real_time_period <- convert_time_period(x = rownames(vertical), date_format = date_format) - start_year <- as.integer(format(min(real_time_period), format = "%Y")) - start_month <- as.integer(format(min(real_time_period), format = "%m")) + start_year <- as.integer(format(x = min(real_time_period), format = "%Y")) + start_month <- as.integer(format(x = min(real_time_period), format = "%m")) if (periodicity == 12L) { start <- c(start_year, start_month) @@ -88,9 +139,12 @@ check_vertical.matrix <- function( length.out = nrow(x) ) } - checkmate::assert_set_equal(real_time_period, theo_time_period) + checkmate::assert_set_equal(x = real_time_period, y = theo_time_period) + + colnames(vertical) <- as.character(convert_rev_date(x = colnames(vertical), date_format = date_format)) + rownames(vertical) <- as.character(convert_time_period(x = rownames(vertical), date_format = date_format)) - vertical <- ts( + vertical <- stats::ts( data = vertical[as.character(theo_time_period), ], start = start, frequency = periodicity @@ -104,14 +158,49 @@ check_vertical.default <- function(x, ...) { stop("The function requires a matrix or a mts object!") } -check_horizontal <- function(x, date_format = "%Y-%m-%d") { +#' Check horizontal format +#' +#' @param x a formatted \code{data.frame} containing the input in the horizontal format +#' @param date_format \code{character} string corresponding to the format used in +#' the input data.frame for the revision dates. +#' +#' @return the same input but with date formatted +#' @export +#' +#' @examples +#' +#' long_format <- rjd3revisions:::simulate_long( +#' start_period = as.Date("2020-01-01"), +#' n_period = 24, +#' n_revision = 6, +#' periodicity = 12L +#' ) +#' horizontal_format <- rjd3revisions:::from_long_to_horizontal(long_format) +#' check_horizontal(horizontal_format) +#' +check_horizontal <- function(x, ...) { + return(UseMethod("check_horizontal", x)) +} + +#' @exportS3Method check_horizontal data.frame +check_horizontal.data.frame <- function(x, ...) { + return(UseMethod("check_horizontal", as.matrix(x))) +} + +#' @exportS3Method check_horizontal matrix +check_horizontal.matrix <- function(x, date_format = "%Y-%m-%d") { horizontal <- x - colnames(horizontal) <- as.character(convert_time_period(colnames(horizontal), date_format)) - rownames(horizontal) <- as.character(convert_rev_date(rownames(horizontal), date_format)) + colnames(horizontal) <- as.character(convert_time_period(x = colnames(horizontal), date_format = date_format)) + rownames(horizontal) <- as.character(convert_rev_date(x = rownames(horizontal), date_format = date_format)) return(horizontal) } +#' @exportS3Method check_horizontal default +check_horizontal.default <- function(x, ...) { + stop("The function requires a matrix or a mts object!") +} + # Convert_functions ------------------------------------------------------------ @@ -146,10 +235,15 @@ convert_rev_date <- function(x, date_format = "%Y-%m-%d") { return(as.Date(x, format = date_format)) } -from_long_to_vertical <- function(x, date_format = "%Y-%m-%d", periodicity) { +from_long_to_vertical <- function(x, periodicity, date_format = "%Y-%m-%d") { + # Check input x <- check_long(x) - vertical <- reshape( + # Check periodicity + checkmate::assert_count(x = periodicity, positive = TRUE, na.ok = FALSE, null.ok = FALSE) + checkmate::assert_choice(x = periodicity, choices = c(1L, 4L, 12L)) + + vertical <- stats::reshape( data = x, timevar = "revdate", idvar = "time", @@ -160,13 +254,14 @@ from_long_to_vertical <- function(x, date_format = "%Y-%m-%d", periodicity) { time_periods <- vertical$time vertical <- as.matrix(vertical[, -1]) rownames(vertical) <- as.character(time_periods) - return(check_vertical(vertical, date_format = date_format, periodicity = periodicity)) + return(check_vertical(x = vertical, periodicity = periodicity, date_format = date_format)) } from_long_to_horizontal <- function(x) { + # Check input x <- check_long(x) - horizontal <- reshape( + horizontal <- stats::reshape( data = x, timevar = "time", idvar = "revdate", @@ -180,32 +275,39 @@ from_long_to_horizontal <- function(x) { } from_long_to_diagonal <- function(x, periodicity) { - x <- check_long(x) + # Check input + x <- check_long(x = x) + + # Check periodicity + checkmate::assert_count(x = periodicity, positive = TRUE, na.ok = FALSE, null.ok = FALSE) + checkmate::assert_choice(x = periodicity, choices = c(1L, 4L, 12L)) - horizontal <- from_long_to_horizontal(x) - diagonal <- from_horizontal_to_diagonal(horizontal, periodicity) + horizontal <- from_long_to_horizontal(x = x) + diagonal <- from_horizontal_to_diagonal(x = horizontal, periodicity = periodicity) return(diagonal) } from_vertical_to_long <- function(x, date_format = "%Y-%m-%d") { - x <- check_vertical(x, date_format) + # Check input + x <- check_vertical(x = x, date_format = date_format) + vertical <- t(t(x)) - if (frequency(x) == 12L) { + if (stats::frequency(x) == 12L) { time_period <- seq.Date( - from = as.Date(paste0(start(x)[1], "-", start(x)[2], "-01")), + from = as.Date(paste0(stats::start(x)[1], "-", stats::start(x)[2], "-01")), by = "month", length.out = nrow(x) ) - } else if (frequency(x) == 4L) { + } else if (stats::frequency(x) == 4L) { time_period <- seq.Date( - from = as.Date(paste0(start(x)[1], "-", 3 * start(x)[2] - 2, "-01")), + from = as.Date(paste0(stats::start(x)[1], "-", 3 * stats::start(x)[2] - 2, "-01")), by = "quarter", length.out = nrow(x) ) } rownames(vertical) <- as.character(time_period) - long <- reshape( + long <- stats::reshape( data = data.frame(time = rownames(vertical), vertical, check.names = FALSE) , direction = "long", varying = colnames(vertical), @@ -220,21 +322,24 @@ from_vertical_to_long <- function(x, date_format = "%Y-%m-%d") { long$time <- convert_time_period(long$time, date_format) long <- long[order(long$revdate, long$time), ] rownames(long) <- NULL + return(long) } from_vertical_to_horizontal <- function(x, date_format = "%Y-%m-%d") { - x <- check_vertical(x, date_format) + # Check input + x <- check_vertical(x = x, date_format = date_format) + horizontal <- t(x) - if (frequency(x) == 12L) { + if (stats::frequency(x) == 12L) { time_period <- seq.Date( - from = as.Date(paste0(start(x)[1], "-", start(x)[2], "-01")), + from = as.Date(paste0(stats::start(x)[1], "-", stats::start(x)[2], "-01")), by = "month", length.out = nrow(x) ) - } else if (frequency(x) == 4L) { + } else if (stats::frequency(x) == 4L) { time_period <- seq.Date( - from = as.Date(paste0(start(x)[1], "-", 3 * start(x)[2] - 2, "-01")), + from = as.Date(paste0(stats::start(x)[1], "-", 3 * stats::start(x)[2] - 2, "-01")), by = "quarter", length.out = nrow(x) ) @@ -244,9 +349,11 @@ from_vertical_to_horizontal <- function(x, date_format = "%Y-%m-%d") { } from_vertical_to_diagonal <- function(x, date_format = "%Y-%m-%d") { + # Check input x <- check_vertical(x, date_format) + horizontal <- from_vertical_to_horizontal(x, date_format) - diagonal <- from_horizontal_to_diagonal(horizontal, periodicity) + diagonal <- from_horizontal_to_diagonal(x = horizontal, stats::frequency(x)) return(diagonal) } @@ -254,7 +361,7 @@ from_horizontal_to_long <- function(x, date_format = "%Y-%m-%d") { horizontal <- check_horizontal(x, date_format = date_format) - long <- reshape( + long <- stats::reshape( data = data.frame(revdate = rownames(horizontal), horizontal, check.names = FALSE) , direction = "long", varying = colnames(horizontal), @@ -269,16 +376,29 @@ from_horizontal_to_long <- function(x, date_format = "%Y-%m-%d") { long$time <- convert_time_period(long$time, date_format) long <- long[order(long$revdate, long$time), ] rownames(long) <- NULL + return(long) } -from_horizontal_to_vertical <- function(x, date_format = "%Y-%m-%d", periodicity) { - horizontal <- check_horizontal(x, date_format = date_format) - return(check_vertical(t(horizontal), date_format, periodicity)) +from_horizontal_to_vertical <- function(x, periodicity, date_format = "%Y-%m-%d") { + # Check input + horizontal <- check_horizontal(x = x, date_format = date_format) + + # Check periodicity + checkmate::assert_count(x = periodicity, positive = TRUE, na.ok = FALSE, null.ok = FALSE) + checkmate::assert_choice(x = periodicity, choices = c(1L, 4L, 12L)) + + return(check_vertical(x = t(horizontal), periodicity = periodicity, date_format = date_format)) } -from_horizontal_to_diagonal <- function(x, date_format = "%Y-%m-%d", periodicity) { - horizontal <- check_horizontal(x, date_format = date_format) +from_horizontal_to_diagonal <- function(x, periodicity, date_format = "%Y-%m-%d") { + # Check input + horizontal <- check_horizontal(x = x, date_format = date_format) + + # Check periodicity + checkmate::assert_count(x = periodicity, positive = TRUE, na.ok = FALSE, null.ok = FALSE) + checkmate::assert_choice(x = periodicity, choices = c(1L, 4L, 12L)) + diagonal <- apply( X = horizontal, MARGIN = 2, @@ -308,9 +428,9 @@ from_horizontal_to_diagonal <- function(x, date_format = "%Y-%m-%d", periodicity length.out = ncol(x) ) } - checkmate::assert_set_equal(real_time_period, theo_time_period) + checkmate::assert_set_equal(x = real_time_period, y = theo_time_period) - diagonal <- ts( + diagonal <- stats::ts( data = diagonal[as.character(theo_time_period), ], start = start, frequency = periodicity @@ -374,24 +494,37 @@ from_horizontal_to_diagonal <- function(x, date_format = "%Y-%m-%d", periodicity #' @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. -#' monthly,quarterly or annual data) -#' @param date_format character string corresponding to the format used in +#' 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. +#' @param vintage_selection \code{Date} vector (or a character vector with the +#' same format as date_format) of length <= 2, specifying the range of revision +#' dates to retain. As an example: +#' c(start = "2022-02-02", end = "2022-08-05") or +#' c(start = as.Date("2022-02-02"), end = as.Date("2022-08-05")) would keep all +#' the vintages whose revision date is between 02 Feb. 2022 and 05 Aug. 2022. +#' If missing (by default), the whole range is selected. #' #' @return an object of class `rjd3rev_vintages` which contains the four #' different view of a revision #' @export #' @examples #' ## creating the input -#' df <- data.frame(rev_date = c(rep("2022-07-31",4), rep("2022-08-31",4), -#' rep("2022-09-30",4), rep("2022-10-31",4), -#' rep("2022-11-30",4), rep("2022-12-31",4), -#' rep("2023-01-31",4), rep("2023-02-28",4)), -#' time_period = c(rep(c("2022Q1","2022Q2","2022Q3","2022Q4"),8)), -#' obs_value = c(.8,.2,NA,NA, .8,.1,NA,NA, -#' .7,.1,NA,NA, .7,.2,.5,NA, -#' .7,.2,.5,NA, .7,.3,.7,NA, -#' .7,.2,.7,.4, .7,.3,.7,.3)) +#' +#' df <- data.frame( +#' rev_date = rep(x = c( +#' "2022-07-31", "2022-08-31", "2022-09-30", "2022-10-31", +#' "2022-11-30", "2022-12-31", "2023-01-31", "2023-02-28" +#' ), each = 4L), +#' time_period = rep(x = c("2022Q1", "2022Q2", "2022Q3", "2022Q4"), times = 8L), +#' obs_value = c( +#' .8, .2, NA, NA, .8, .1, NA, NA, +#' .7, .1, NA, NA, .7, .2, .5, NA, +#' .7, .2, .5, NA, .7, .3, .7, NA, +#' .7, .2, .7, .4, .7, .3, .7, .3 +#' ) +#' ) +#' #' vintages <- create_vintages(x = df, type = "long", periodicity = 4L) #' #' ## specifying the format of revision dates @@ -402,38 +535,65 @@ from_horizontal_to_diagonal <- function(x, date_format = "%Y-%m-%d", periodicity #' date_format= "%Y-%m-%d" #' ) #' +#' ## including vintage selection +#' vintages <- create_vintages( +#' x = df, +#' type ="long", +#' periodicity = 4L, +#' date_format= "%Y-%m-%d", +#' vintage_selection = c(start="2022-10-31", end="2023-01-31") +#' ) +#' create_vintages <- function(x, ...) { return(UseMethod("create_vintages", x)) } #' @exportS3Method create_vintages data.frame -#' @rdname create_vintages create_vintages.data.frame <- function( x, type = c("long", "horizontal", "vertical"), - periodicity = c(4L, 12L, 1L), + periodicity, date_format = "%Y-%m-%d", + vintage_selection, ... ) { - # check type + # Check type type <- match.arg(type) - # check periodicity - checkmate::assert_number(x = periodicity, na.ok = FALSE, finite = TRUE, null.ok = FALSE) - checkmate::assert_choice(x = periodicity, choices = c(4L, 12L, 1L)) + # Check periodicity + checkmate::assert_count(x = periodicity, positive = TRUE, na.ok = FALSE, null.ok = FALSE) + checkmate::assert_choice(x = periodicity, choices = c(1L, 4L, 12L)) if (type == "long") { - # check x input - long <- check_long(x, date_format) + # Check x input + long <- check_long(x = x, date_format = date_format) + + if (!missing(vintage_selection)) { + + vintage_selection <- as.Date(vintage_selection, format = date_format) + revdate <- long$revdate + + # Check vintage_selection + checkmate::assert_date(vintage_selection, min.len = 0, max.len = 2, null.ok = FALSE, any.missing = FALSE) + checkmate::assert_set_equal(x = length(unique(names(vintage_selection))), y = length(vintage_selection)) + sapply(X = names(vintage_selection), FUN = checkmate::assert_choice, choices = c("start", "end")) + checkmate::assert_true(vintage_selection["start"] <= vintage_selection["end"], na.ok = TRUE) + checkmate::assert_true(vintage_selection["start"] <= max(revdate), na.ok = TRUE) + checkmate::assert_true(vintage_selection["end"] >= min(revdate), na.ok = TRUE) + + index <- ((is.na(vintage_selection["start"]) | revdate >= vintage_selection["start"]) + & (is.na(vintage_selection["end"]) | revdate <= vintage_selection["end"])) + long <- long[index, ] + } # Horizontal format - horizontal <- from_long_to_horizontal(long) + horizontal <- from_long_to_horizontal(x = long) # Vertical format - vertical <- from_long_to_vertical(long, date_format = date_format, periodicity = periodicity) + vertical <- from_long_to_vertical(x = long, periodicity = periodicity, date_format = "%Y-%m-%d") # Diagonal format - diagonal <- from_horizontal_to_diagonal(horizontal, periodicity = periodicity) + diagonal <- from_horizontal_to_diagonal(x = horizontal, periodicity = periodicity, date_format = "%Y-%m-%d") return(structure( list( @@ -451,16 +611,16 @@ create_vintages.data.frame <- function( } #' @exportS3Method create_vintages mts -#' @rdname create_vintages create_vintages.mts <- function( x, type = c("long", "horizontal", "vertical"), - periodicity = NULL, + periodicity, date_format = "%Y-%m-%d", + vintage_selection, ... ) { - # check type + # Check type type <- match.arg(type) if (type %in% c("horizontal", "long")) { @@ -468,14 +628,34 @@ create_vintages.mts <- function( } else if (type == "vertical") { # Vertical format - vertical <- check_vertical(x, date_format, periodicity) + vertical <- check_vertical(x = x, periodicity = periodicity, date_format = date_format) + + if (!missing(vintage_selection)) { + + vintage_selection <- as.Date(vintage_selection, format = date_format) + revdate <- as.Date(colnames(vertical)) + + # Check vintage_selection + checkmate::assert_date(vintage_selection, min.len = 0, max.len = 2, null.ok = FALSE, any.missing = FALSE) + checkmate::assert_set_equal(x = length(unique(names(vintage_selection))), y = length(vintage_selection)) + sapply(X = names(vintage_selection), FUN = checkmate::assert_choice, choices = c("start", "end")) + checkmate::assert_true(vintage_selection["start"] <= vintage_selection["end"], na.ok = TRUE) + checkmate::assert_true(vintage_selection["start"] <= max(revdate), na.ok = TRUE) + checkmate::assert_true(vintage_selection["end"] >= min(revdate), na.ok = TRUE) + + index <- ((is.na(vintage_selection["start"]) | revdate >= vintage_selection["start"]) + & (is.na(vintage_selection["end"]) | revdate <= vintage_selection["end"])) + vertical <- vertical[, index, drop = FALSE] + attr(vertical, "class") <- c("mts", "ts", "matrix", "array") + + } # Horizontal format - horizontal <- from_vertical_to_horizontal(vertical) + horizontal <- from_vertical_to_horizontal(x = vertical, date_format = "%Y-%m-%d") # Long format - long <- from_vertical_to_long(vertical, date_format) + long <- from_vertical_to_long(x = vertical, date_format = "%Y-%m-%d") # Diagonal format - diagonal <- from_horizontal_to_diagonal(horizontal, periodicity = frequency(vertical)) + diagonal <- from_horizontal_to_diagonal(x = horizontal, periodicity = stats::frequency(vertical), date_format = "%Y-%m-%d") } return(structure( @@ -490,53 +670,93 @@ create_vintages.mts <- function( } #' @exportS3Method create_vintages matrix -#' @rdname create_vintages create_vintages.matrix <- function( x, type = c("long", "horizontal", "vertical"), - periodicity = c(4L, 12L, 1L), + periodicity, date_format = "%Y-%m-%d", + vintage_selection, ... ) { - # check type + # Check type type <- match.arg(type) - # check periodicity - checkmate::assert_number(x = periodicity, na.ok = FALSE, finite = TRUE, null.ok = FALSE) - checkmate::assert_choice(x = periodicity, choices = c(4L, 12L, 1L)) + # Check periodicity + checkmate::assert_count(x = periodicity, positive = TRUE, na.ok = FALSE, null.ok = FALSE) + checkmate::assert_choice(x = periodicity, choices = c(1L, 4L, 12L)) if (type == "long") { stop("Wrong type for mts data.") } else if (type == "horizontal") { - # check x input + # Check x input checkmate::assert_matrix(x, mode = "numeric") if (length(rownames(x)) == 0 || length(colnames(x)) == 0) { stop("Revisions dates or time periods are missing.") } # Horizontal format - horizontal <- check_horizontal(x, date_format = date_format) + horizontal <- check_horizontal(x = x, date_format = date_format) + + # Check vintage_selection + if (!missing(vintage_selection)) { + + vintage_selection <- as.Date(vintage_selection, format = date_format) + revdate <- as.Date(rownames(horizontal)) + + # Check vintage_selection + checkmate::assert_date(vintage_selection, min.len = 0, max.len = 2, null.ok = FALSE, any.missing = FALSE) + checkmate::assert_set_equal(x = length(unique(names(vintage_selection))), y = length(vintage_selection)) + sapply(X = names(vintage_selection), FUN = checkmate::assert_choice, choices = c("start", "end")) + checkmate::assert_true(vintage_selection["start"] <= vintage_selection["end"], na.ok = TRUE) + checkmate::assert_true(vintage_selection["start"] <= max(revdate), na.ok = TRUE) + checkmate::assert_true(vintage_selection["end"] >= min(revdate), na.ok = TRUE) + + index <- ((is.na(vintage_selection["start"]) | revdate >= vintage_selection["start"]) + & (is.na(vintage_selection["end"]) | revdate <= vintage_selection["end"])) + horizontal <- horizontal[index, , drop = FALSE] + + } # Vertical format - vertical <- from_horizontal_to_vertical(horizontal, date_format = date_format, periodicity = periodicity) + vertical <- from_horizontal_to_vertical(x = horizontal, periodicity = periodicity, date_format = "%Y-%m-%d") # Long format - long <- from_horizontal_to_long(horizontal, date_format) + long <- from_horizontal_to_long(x = horizontal, date_format = "%Y-%m-%d") # Diagonal format - diagonal <- from_horizontal_to_diagonal(horizontal, periodicity = frequency(vertical)) + diagonal <- from_horizontal_to_diagonal(x = horizontal, periodicity = stats::frequency(vertical), date_format = "%Y-%m-%d") } else if (type == "vertical") { # Vertical format - vertical <- check_vertical(x, date_format, periodicity) + vertical <- check_vertical(x = x, periodicity = periodicity, date_format = date_format) + + # Check vintage_selection + if (!missing(vintage_selection)) { + + vintage_selection <- as.Date(vintage_selection, format = date_format) + revdate <- as.Date(colnames(vertical)) + + # Check vintage_selection + checkmate::assert_date(vintage_selection, min.len = 0, max.len = 2, null.ok = FALSE, any.missing = FALSE) + checkmate::assert_set_equal(x = length(unique(names(vintage_selection))), y = length(vintage_selection)) + sapply(X = names(vintage_selection), FUN = checkmate::assert_choice, choices = c("start", "end")) + checkmate::assert_true(vintage_selection["start"] <= vintage_selection["end"], na.ok = TRUE) + checkmate::assert_true(vintage_selection["start"] <= max(revdate), na.ok = TRUE) + checkmate::assert_true(vintage_selection["end"] >= min(revdate), na.ok = TRUE) + + index <- ((is.na(vintage_selection["start"]) | revdate >= vintage_selection["start"]) + & (is.na(vintage_selection["end"]) | revdate <= vintage_selection["end"])) + vertical <- vertical[, index, drop = FALSE] + + } # Horizontal format - horizontal <- from_vertical_to_horizontal(vertical) + horizontal <- from_vertical_to_horizontal(x = vertical, date_format = "%Y-%m-%d") # Long format - long <- from_vertical_to_long(vertical, date_format) + long <- from_vertical_to_long(x = vertical, date_format = "%Y-%m-%d") # Diagonal format - diagonal <- from_horizontal_to_diagonal(horizontal, periodicity = frequency(vertical)) + diagonal <- from_horizontal_to_diagonal(x = horizontal, periodicity = stats::frequency(vertical), date_format = "%Y-%m-%d") } return(structure( @@ -551,7 +771,6 @@ create_vintages.matrix <- function( } #' @exportS3Method create_vintages default -#' @rdname create_vintages create_vintages.default <- function(x, ...) { stop("The function requires a data.frame, a matrix or a mts object!") } @@ -587,20 +806,20 @@ create_vintages.default <- function(x, ...) { #' create_vintages_from_csv <- function(file, type = c("long", "horizontal", "vertical"), - periodicity = c(4L, 12L, 1L), + periodicity, date_format = "%Y-%m-%d", ...) { - # check of inputs + # Check of inputs file <- normalizePath(file, mustWork = TRUE) - # check type + # Check type type <- match.arg(type) - # check periodicity - checkmate::assert_number(x = periodicity, na.ok = FALSE, finite = TRUE, null.ok = FALSE) - checkmate::assert_choice(x = periodicity, choices = c(4L, 12L, 1L)) + # Check periodicity + checkmate::assert_count(x = periodicity, positive = TRUE, na.ok = FALSE, null.ok = FALSE) + checkmate::assert_choice(x = periodicity, choices = c(1L, 4L, 12L)) - df <- read.csv(file, ...) + df <- utils::read.csv(file = file, ...) return(create_vintages( x = df, @@ -638,22 +857,22 @@ create_vintages_from_csv <- function(file, #' create_vintages_from_xlsx<-function(file, type = c("long", "horizontal", "vertical"), - periodicity = c(4L, 12L, 1L), + periodicity, date_format = "%Y-%m-%d", ...) { - if (!require(readxl)) { + if (!requireNamespace("readxl", quietly = TRUE)) { stop("package 'readxl' must be installed to run the function 'create_vintages_from_xlsx'") } - # check of inputs + # Check of inputs file <- normalizePath(file, mustWork = TRUE) - # check type + # Check type type <- match.arg(type) - # check periodicity - checkmate::assert_number(x = periodicity, na.ok = FALSE, finite = TRUE, null.ok = FALSE) - checkmate::assert_choice(x = periodicity, choices = c(4L, 12L, 1L)) + # Check periodicity + checkmate::assert_count(x = periodicity, positive = TRUE, na.ok = FALSE, null.ok = FALSE) + checkmate::assert_choice(x = periodicity, choices = c(1L, 4L, 12L)) df <- readxl::read_excel(path = file, ...) From 459f8e4814816946fed734b8f3135fd46a70768a Mon Sep 17 00:00:00 2001 From: Tanguy BARTHELEMY Date: Tue, 9 Apr 2024 16:11:59 +0200 Subject: [PATCH 09/13] resolve dependance conflict --- R/jd3_ts.R | 6 +++--- R/output.R | 6 +++--- R/revision_analysis.R | 20 ++++++++++++-------- R/tests.R | 6 +++--- 4 files changed, 21 insertions(+), 17 deletions(-) diff --git a/R/jd3_ts.R b/R/jd3_ts.R index a14cabe..c8d27b9 100644 --- a/R/jd3_ts.R +++ b/R/jd3_ts.R @@ -2,8 +2,8 @@ ts_r2jd<-function(s) { if (is.null(s)) { return(NULL) } - freq<-frequency(s) - start<-start(s) + freq<-stats::frequency(s) + start<-stats::start(s) .jcall("jdplus/toolkit/base/r/timeseries/TsUtility", "Ljdplus/toolkit/base/r/timeseries/TsData;", "of", as.integer(freq), as.integer(start[1]), as.integer(start[2]), as.double(s)) } @@ -21,7 +21,7 @@ ts_jd2r<-function(s) { pstart<-.jcall("jdplus/toolkit/base/r/timeseries/TsUtility", "[I", "startPeriod", s) jx<-.jcall(s, "Ljdplus/toolkit/base/api/data/DoubleSeq;", "getValues") x<-.jcall(jx, "[D", "toArray") - ts(x, start=pstart[2:3], frequency=pstart[1]) + stats::ts(x, start=pstart[2:3], frequency=pstart[1]) } matrix_jd2r<-function(s) { diff --git a/R/output.R b/R/output.R index 6f301bb..2aac083 100644 --- a/R/output.R +++ b/R/output.R @@ -47,7 +47,7 @@ plot.rjd3rev_revision_analysis <- function(x, ...) { nc<-4 } - ts.plot(rev, gpars=list(xlab="", ylab="", col=c(1:nc), type="h", lwd=2, ...)) - legend("topleft", bty="n", lty=1, lwd=2, col=c(1:nc), legend=colnames(rev)) - title(main = "Size of Revisions") + stats::ts.plot(rev, gpars=list(xlab="", ylab="", col=c(1:nc), type="h", lwd=2, ...)) + graphics::legend("topleft", bty="n", lty=1, lwd=2, col=c(1:nc), legend=colnames(rev)) + graphics::title(main = "Size of Revisions") } diff --git a/R/revision_analysis.R b/R/revision_analysis.R index c5b23c4..21b51d1 100644 --- a/R/revision_analysis.R +++ b/R/revision_analysis.R @@ -32,7 +32,7 @@ #' Allow the user to limit the number of releases under #' investigation). When `view = "vertical"`, the user is #' invited to limit the number of vintages upstream through -#' the parameter `vintage.selection` in `create_vintages()` +#' the parameter `vintage_selection` in `create_vintages()` #' whenever necessary. #' @param transf.diff differentiation to apply to the data prior testing. Only #' used for regressions including vintage data as regressor @@ -77,7 +77,7 @@ #' df<-data.frame(rev_date, time_period, obs_values) #' #' ## Create a `"rjd3rev_vintages"` object with the input -#' vintages<-create_vintages(df, periodicity = 4, revdate.format= "%Y-%m-%d") +#' 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 #' #' ## Call using all default parameters @@ -94,7 +94,11 @@ #' #summary(rslt2) #' #' ## Call to evaluate revisions for a specific range of vintage periods -#' vintages<-create_vintages(df, periodicity = 4, vintage.selection = list(start="2021-12-31", end="2023-06-30")) +#' vintages <- create_vintages( +#' x = df, +#' periodicity = 4, +#' vintage_selection = c(start="2021-12-31", end="2023-06-30") +#' ) #' rslt3<-revision_analysis(vintages, gap=2, view = "vertical") #' #render_report(rslt3) #' #summary(rslt3) @@ -135,7 +139,7 @@ revision_analysis<-function(vintages, ## Revisions and Vintages Transformation rv_notrf<-get_vd_rev(vt, gap) - freq<-frequency(vt) + freq<-stats::frequency(vt) ### Log transformation if (transf.log) { @@ -302,7 +306,7 @@ revision_analysis<-function(vintages, if (!is.null(orth1)) { orth1_rslt<-format_reg_output(orth1, is_log, FALSE) orth1_m_q<-c(rep("", nrevs), eval_pvals(orth1[, "intercept.pvalue"], h0_good=TRUE)) - orth1_r_q<-c(rep("", nrevs), eval_pvals(pf(orth1[, "F"], nrevs, orth1[, "N"]-nrevs-1), h0_good=TRUE)) + orth1_r_q<-c(rep("", nrevs), eval_pvals(stats::pf(orth1[, "F"], nrevs, orth1[, "N"]-nrevs-1), h0_good=TRUE)) orth1_diagnostics<-regression_diagnostics(orth1) } else { orth1_rslt<-orth1_diagnostics<-NULL @@ -562,10 +566,10 @@ get_vd_rev <- function(vt, gap) { check_seasonality <- function(x) { - if (frequency(x)>1) { + if (stats::frequency(x)>1) { x_diff<-diff(x) - lb_pval<-try(seasonality_qs(x_diff, frequency(x))$pvalue, silent=TRUE) # Ljung-Box - fd_pval<-try(seasonality_friedman(x_diff, frequency(x))$pvalue, silent=TRUE) # Friedman non-parametric test + lb_pval<-try(seasonality_qs(x_diff, stats::frequency(x))$pvalue, silent=TRUE) # Ljung-Box + fd_pval<-try(seasonality_friedman(x_diff, stats::frequency(x))$pvalue, silent=TRUE) # Friedman non-parametric test test_succeeded<-c(!"try-error" %in% class(lb_pval), !"try-error" %in% class(fd_pval)) if (all(test_succeeded)) { diff --git a/R/tests.R b/R/tests.R index b5fe622..5af73eb 100644 --- a/R/tests.R +++ b/R/tests.R @@ -90,9 +90,9 @@ descriptive_statistics<-function(revisions.view, rounding=3) { mn<-mean(rc) sd<-sd(rc) min<-min(rc) - q10<-quantile(rc, .1) - q50<-median(rc) - q90<-quantile(rc, .9) + q10<-stats::quantile(rc, .1) + q50<-stats::median(rc) + q90<-stats::quantile(rc, .9) max<-max(rc) pp<-length(rc[rc>0])/n p0<-length(rc[rc==0])/n From 2855dc00148163052477f563ec505675a6069a34 Mon Sep 17 00:00:00 2001 From: Tanguy BARTHELEMY Date: Tue, 9 Apr 2024 18:00:12 +0200 Subject: [PATCH 10/13] add gha to check, test and lint the package --- .github/workflows/R-CMD-check.yaml | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 0a94d35..e3e084a 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -44,7 +44,16 @@ jobs: http-user-agent: ${{ matrix.config.http-user-agent }} use-public-rspm: true - - name: Set up for RProtoBuf + - name: Set up for RProtoBuf on Windows + if: runner.os == 'Windows' + run: choco install protoc + + - name: Set up for RProtoBuf on macos + if: runner.os == 'macOS' + run: brew install protobuf + + - name: Set up for RProtoBuf on ubuntu + if: runner.os == 'Linux' run: sudo apt-get update -y && sudo apt-get install protobuf-compiler libprotobuf-dev libprotoc-dev - uses: r-lib/actions/setup-r-dependencies@v2 @@ -56,3 +65,5 @@ jobs: with: upload-snapshots: true build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' + build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' + error-on: '"error"' From 04838bb94db05c805cddcc63546ca2c7d8548c06 Mon Sep 17 00:00:00 2001 From: Tanguy BARTHELEMY Date: Tue, 9 Apr 2024 18:05:37 +0200 Subject: [PATCH 11/13] remove excedent line --- .github/workflows/R-CMD-check.yaml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index e3e084a..e0b443a 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -65,5 +65,4 @@ jobs: with: upload-snapshots: true build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' - build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' error-on: '"error"' From 3f63584ed03716ce90ca7e7babb8dc412aa452a4 Mon Sep 17 00:00:00 2001 From: Tanguy BARTHELEMY Date: Wed, 10 Apr 2024 10:57:17 +0200 Subject: [PATCH 12/13] solve bug in testing --- .lintr | 3 +- R/simulate.R | 12 ++--- tests/testthat/test-create_vintages.R | 64 +++++++++++++++------------ 3 files changed, 44 insertions(+), 35 deletions(-) diff --git a/.lintr b/.lintr index 09edcec..f744e7b 100644 --- a/.lintr +++ b/.lintr @@ -1,7 +1,8 @@ linters: linters_with_defaults( indentation_linter = lintr::indentation_linter(indent = 4L), indentation_linter = NULL, - #infix_spaces_linter = NULL, + infix_spaces_linter = NULL, + trailing_whitespace_linter = NULL, paren_body_linter = NULL, function_left_parentheses_linter = NULL, spaces_left_parentheses_linter = NULL, diff --git a/R/simulate.R b/R/simulate.R index 5b5785a..855d164 100644 --- a/R/simulate.R +++ b/R/simulate.R @@ -67,11 +67,13 @@ simulate_long <- function(n_period = 50, } time_period <- seq.Date(from = start_period, by = by, length.out = n_period) - rev_date <- as.Date(sort(sample( - x = min(time_period):(max(time_period) + 2 * 30 * 12 / periodicity), # On rajoute 2 périodes supplémentaires - size = n_revision, - replace = FALSE - ))) + rev_date <- as.Date( + x = sort(sample( + x = min(time_period):(max(time_period) + 2 * 30 * 12 / periodicity), # On rajoute 2 périodes supplémentaires + size = n_revision, + replace = FALSE)), + origin = "1970-01-01" + ) final_series <- simulate_series(n_period) long <- data.frame( diff --git a/tests/testthat/test-create_vintages.R b/tests/testthat/test-create_vintages.R index 6380ce1..ce0dc1e 100644 --- a/tests/testthat/test-create_vintages.R +++ b/tests/testthat/test-create_vintages.R @@ -85,35 +85,41 @@ values_vertical <- c(0.8, 0.2, NA, NA, 0.8, 0.1, NA, NA, 0.7, 0.1, NA, NA, 0.7, 0.2, 0.5, NA, 0.7, 0.2, 0.5, NA, 0.7, 0.3, 0.7, NA, 0.7, 0.2, 0.7, 0.4, 0.7, 0.3, 0.7, 0.3) -input_vertical_1 <- structure( - .Data = values_vertical, - dim = c(4L, 8L), - dimnames = list( - NULL, c("2022-07-31", "2022-08-31", "2022-09-30", "2022-10-31", - "2022-11-30", "2022-12-31", "2023-01-31", "2023-02-28")), - tsp = c(2022, 2022.75, 4), - class = c("mts", "ts", "matrix", "array") -) - -input_vertical_2 <- structure( - .Data = values_vertical, - dim = c(4L, 8L), - dimnames = list( - NULL, - c("31/07/2022", "31/08/2022", "30/09/2022", "31/10/2022", - "30/11/2022", "31/12/2022", "31/01/2023", "28/02/2023")), - tsp = c(2022, 2022.75, 4), - class = c("mts", "ts", "matrix", "array") -) - -input_vertical_3 <- structure( - .Data = values_vertical, - dim = c(4L, 8L), - dimnames = list( - NULL, c("07/31/22", "08/31/22", "09/30/22", "10/31/22", - "11/30/22", "12/31/22", "01/31/23", "02/28/23")), - tsp = c(2022, 2022.75, 4), - class = c("mts", "ts", "matrix", "array") +input_vertical_1 <- ts( + data = structure( + .Data = values_vertical, + dim = c(4L, 8L), + dimnames = list( + NULL, c("2022-07-31", "2022-08-31", "2022-09-30", "2022-10-31", + "2022-11-30", "2022-12-31", "2023-01-31", "2023-02-28")) + ), + start = 2022, + frequency = 4 +) + +input_vertical_2 <- ts( + data = structure( + .Data = values_vertical, + dim = c(4L, 8L), + dimnames = list( + NULL, + c("31/07/2022", "31/08/2022", "30/09/2022", "31/10/2022", + "30/11/2022", "31/12/2022", "31/01/2023", "28/02/2023")) + ), + start = 2022, + frequency = 4 +) + +input_vertical_3 <- ts( + data = structure( + .Data = values_vertical, + dim = c(4L, 8L), + dimnames = list( + NULL, c("07/31/22", "08/31/22", "09/30/22", "10/31/22", + "11/30/22", "12/31/22", "01/31/23", "02/28/23")) + ), + start = 2022, + frequency = 4 ) input_vertical_4 <- structure( From bbe0751a2ab9a66c593ac9c446f089b58b3a9f82 Mon Sep 17 00:00:00 2001 From: Tanguy BARTHELEMY Date: Wed, 10 Apr 2024 15:51:23 +0200 Subject: [PATCH 13/13] add periodicity 1 --- R/simulate.R | 7 ++--- R/vintages.R | 26 +++++++++++++----- tests/testthat/test-create_vintages.R | 39 +++++++++++++++++++++++++++ vignettes/rjd3revisions.Rmd | 6 ++--- 4 files changed, 66 insertions(+), 12 deletions(-) diff --git a/R/simulate.R b/R/simulate.R index 855d164..0c17689 100644 --- a/R/simulate.R +++ b/R/simulate.R @@ -62,8 +62,8 @@ simulate_long <- function(n_period = 50, by <- "month" } else if (periodicity == 4L) { by <- "quarter" - } else { - stop("Cas non trait\u00e9") + } else if (periodicity == 1L) { + by <- "year" } time_period <- seq.Date(from = start_period, by = by, length.out = n_period) @@ -74,7 +74,7 @@ simulate_long <- function(n_period = 50, replace = FALSE)), origin = "1970-01-01" ) - final_series <- simulate_series(n_period) + final_series <- simulate_series(n_period, periodicity = periodicity) long <- data.frame( rev_date = integer(), @@ -96,6 +96,7 @@ simulate_long <- function(n_period = 50, } long <- long[order(long$rev_date , long$time_period ), ] + rownames(long) <- NULL return(long) } diff --git a/R/vintages.R b/R/vintages.R index 9b128af..8c8c1cf 100644 --- a/R/vintages.R +++ b/R/vintages.R @@ -138,6 +138,13 @@ check_vertical.matrix <- function( by = "quarter", length.out = nrow(x) ) + } else if (periodicity == 1L) { + start <- c(start_year, 1L + ((start_month - 1L) %/% 3L)) + theo_time_period <- seq.Date( + from = min(real_time_period), + by = "year", + length.out = nrow(x) + ) } checkmate::assert_set_equal(x = real_time_period, y = theo_time_period) @@ -237,7 +244,7 @@ convert_rev_date <- function(x, date_format = "%Y-%m-%d") { from_long_to_vertical <- function(x, periodicity, date_format = "%Y-%m-%d") { # Check input - x <- check_long(x) + x <- check_long(x = x, date_format = date_format) # Check periodicity checkmate::assert_count(x = periodicity, positive = TRUE, na.ok = FALSE, null.ok = FALSE) @@ -257,9 +264,9 @@ from_long_to_vertical <- function(x, periodicity, date_format = "%Y-%m-%d") { return(check_vertical(x = vertical, periodicity = periodicity, date_format = date_format)) } -from_long_to_horizontal <- function(x) { +from_long_to_horizontal <- function(x, date_format = "%Y-%m-%d") { # Check input - x <- check_long(x) + x <- check_long(x = x, date_format = date_format) horizontal <- stats::reshape( data = x, @@ -274,9 +281,9 @@ from_long_to_horizontal <- function(x) { return(horizontal) } -from_long_to_diagonal <- function(x, periodicity) { +from_long_to_diagonal <- function(x, periodicity, date_format = "%Y-%m-%d") { # Check input - x <- check_long(x = x) + x <- check_long(x = x, date_format = date_format) # Check periodicity checkmate::assert_count(x = periodicity, positive = TRUE, na.ok = FALSE, null.ok = FALSE) @@ -408,7 +415,7 @@ from_horizontal_to_diagonal <- function(x, periodicity, date_format = "%Y-%m-%d" diagonal <- do.call(what = rbind, diagonal) colnames(diagonal) <- paste0("Release[", seq_len(ncol(diagonal)), "]") - real_time_period <- convert_time_period(rownames(diagonal), date_format) + real_time_period <- convert_time_period(x = rownames(diagonal), date_format = date_format) start_year <- as.integer(format(min(real_time_period), format = "%Y")) start_month <- as.integer(format(min(real_time_period), format = "%m")) @@ -427,6 +434,13 @@ from_horizontal_to_diagonal <- function(x, periodicity, date_format = "%Y-%m-%d" by = "quarter", length.out = ncol(x) ) + } else if (periodicity == 1L) { + start <- c(start_year, 1L + ((start_month - 1L) %/% 3L)) + theo_time_period <- seq.Date( + from = min(real_time_period), + by = "year", + length.out = ncol(x) + ) } checkmate::assert_set_equal(x = real_time_period, y = theo_time_period) diff --git a/tests/testthat/test-create_vintages.R b/tests/testthat/test-create_vintages.R index ce0dc1e..32c7399 100644 --- a/tests/testthat/test-create_vintages.R +++ b/tests/testthat/test-create_vintages.R @@ -196,4 +196,43 @@ test_that("Creation of vintages works for all format", { expect_identical(vintage1, vintage13) expect_identical(vintage1, vintage14) expect_identical(vintage1, vintage15) + +}) + + +test_that("Creation of vintages works for all format", { + + vintage1 <- create_vintages(x = input_long_1, type = "long", periodicity = 4L) + vintage2 <- create_vintages(x = input_long_2, type = "long", periodicity = 4L, date_format = "%d/%m/%Y") + vintage3 <- create_vintages(x = input_long_3, type = "long", periodicity = 4L) + vintage4 <- create_vintages(x = input_long_4, type = "long", periodicity = 4L, date_format = "%m/%d/%y") + + vintage5 <- create_vintages(x = input_horizontal_1, type = "horizontal", periodicity = 4L) + vintage6 <- create_vintages(x = input_horizontal_2, type = "horizontal", periodicity = 4L, date_format = "%d/%m/%Y") + vintage7 <- create_vintages(x = input_horizontal_3, type = "horizontal", periodicity = 4L) + vintage8 <- create_vintages(x = input_horizontal_4, type = "horizontal", periodicity = 4L, date_format = "%m/%d/%y") + + vintage9 <- create_vintages(x = input_vertical_1, type = "vertical") + vintage10 <- create_vintages(x = input_vertical_2, type = "vertical", date_format = "%d/%m/%Y") + vintage11 <- create_vintages(x = input_vertical_3, type = "vertical", date_format = "%m/%d/%y") + vintage12 <- create_vintages(x = input_vertical_4, type = "vertical", periodicity = 4L) + vintage13 <- create_vintages(x = input_vertical_5, type = "vertical", periodicity = 4L, date_format = "%d/%m/%Y") + vintage14 <- create_vintages(x = input_vertical_6, type = "vertical", periodicity = 4L) + vintage15 <- create_vintages(x = input_vertical_7, type = "vertical", periodicity = 4L, date_format = "%m/%d/%y") + + expect_identical(vintage1, vintage2) + expect_identical(vintage1, vintage3) + expect_identical(vintage1, vintage4) + expect_identical(vintage1, vintage5) + expect_identical(vintage1, vintage6) + expect_identical(vintage1, vintage7) + expect_identical(vintage1, vintage8) + expect_identical(vintage1, vintage9) + expect_identical(vintage1, vintage10) + expect_identical(vintage1, vintage11) + expect_identical(vintage1, vintage12) + expect_identical(vintage1, vintage13) + expect_identical(vintage1, vintage14) + expect_identical(vintage1, vintage15) + }) diff --git a/vignettes/rjd3revisions.Rmd b/vignettes/rjd3revisions.Rmd index c9bf576..977a224 100644 --- a/vignettes/rjd3revisions.Rmd +++ b/vignettes/rjd3revisions.Rmd @@ -91,7 +91,7 @@ rslt<-revision_analysis(vintages, gap = 1, view = "diagonal", n.releases = 3) Finally to create the report and get a summary of the results, you can use ```{r} -get_report(rslt) +render_report(rslt) summary(rslt) print(rslt) @@ -149,7 +149,7 @@ For some of the parametric tests, prior transformation of the vintage data may b As part of the arguments of the `revision_analysis()` function, you can choose the view and the gap to consider, restrict the number of releases under investigation when diagonal view is selected and/or change the default setting about the prior transformation of the data (including the possibility to add a prior log-transformation of your data). -The function `get_report()` applied on the output of `revision_analysis()` will generate an enhanced HTML report including both a formatted summary of the results and full explanations about each tests (which are also included in the vignette below). The formatted summary of the results display the p-value of each test (except for Theil's tests where the value of the statistics is provided) and their interpretation. An appreciation 'good', 'uncertain', 'bad' and 'severe' is indeed associated to each test following the usual statistical interpretation of p-values and the orientation of the tests. This allows a quick visual interpretation of the results and is similar to what is done in the GUI of JDemetra+. +The function `render_report()` applied on the output of `revision_analysis()` will generate an enhanced HTML report including both a formatted summary of the results and full explanations about each tests (which are also included in the vignette below). The formatted summary of the results display the p-value of each test (except for Theil's tests where the value of the statistics is provided) and their interpretation. An appreciation 'good', 'uncertain', 'bad' and 'severe' is indeed associated to each test following the usual statistical interpretation of p-values and the orientation of the tests. This allows a quick visual interpretation of the results and is similar to what is done in the GUI of JDemetra+. In addition to the function `revision_analysis()`, the user can also perform tests individually if they want to. To list all functions available in the package (and therefore finding the different functions corresponding to the individual tests), you can do @@ -163,7 +163,7 @@ Use help(‘name of the functions’) or ?‘name of the functions’ for more i The detailed results of each test are part of the output returned by the function `revision_analysis()`. Alternatively, the functions associated with the individual test will give you the same result specific to this test. -In addition to the visual report that you can get by applying the function `get_report()` on the output of the function `revision_analysis()`, you can also apply the usual `summary()`, `print()` and `plot()` functions to this output. The function `summary()`, in particular, will print only the formatted table of the report with the main results. The `print()` will provide the same unformatted information together with some extra ones and `plot()` will plot the revisions over time. +In addition to the visual report that you can get by applying the function `render_report()` on the output of the function `revision_analysis()`, you can also apply the usual `summary()`, `print()` and `plot()` functions to this output. The function `summary()`, in particular, will print only the formatted table of the report with the main results. The `print()` will provide the same unformatted information together with some extra ones and `plot()` will plot the revisions over time. # Tests description and interpretation