Merge pull request #13 from TanguyBarthelemy/develop

Add function and documentation

.Rbuildignore

@@ -8,3 +8,6 @@
 ^\.github$
 ^LICENSE$
 ^README\.Rmd$
+
+^TO_DO$
+^\.lintr$

.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,4 @@ jobs:
         with:
           upload-snapshots: true
           build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'
+          error-on: '"error"'

.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,

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 = "[email protected]")
+Authors@R: c(
+    person(given = "Corentin", family = "Lemasson",
+           email = "[email protected]", role = c("aut", "cre")), 
+    person(given = "Tanguy", family = "Barthelemy",
+           email = "[email protected]", role = "aut"))
 Description: Interface around 'JDemetra+ 3.x' sa-toolkit 
              (<https://github.com/jdemetra/jdemetra-core>), 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

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)

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) {

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")
 }

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)) {

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]

R/simulate.R

@@ -0,0 +1,102 @@
+
+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 if (periodicity == 1L) {
+        by <- "year"
+    }
+
+    time_period <- seq.Date(from = start_period, by = by, length.out = n_period)
+    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, periodicity = periodicity)
+
+    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  ), ]
+    rownames(long) <- NULL
+
+    return(long)
+}

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