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$ diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 0a94d35..e0b443a 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,4 @@ jobs: with: upload-snapshots: true build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' + error-on: '"error"' 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/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 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/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/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] diff --git a/R/simulate.R b/R/simulate.R new file mode 100644 index 0000000..0c17689 --- /dev/null +++ b/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) +} 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 diff --git a/R/vintages.R b/R/vintages.R index 96640a9..8c8c1cf 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) @@ -87,10 +138,20 @@ 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(real_time_period, theo_time_period) + checkmate::assert_set_equal(x = real_time_period, y = theo_time_period) - vertical <- ts( + 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 <- stats::ts( data = vertical[as.character(theo_time_period), ], start = start, frequency = periodicity @@ -104,14 +165,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 +242,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) { - x <- check_long(x) +from_long_to_vertical <- function(x, periodicity, date_format = "%Y-%m-%d") { + # Check input + x <- check_long(x = x, date_format = date_format) - 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 +261,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) { - x <- check_long(x) +from_long_to_horizontal <- function(x, date_format = "%Y-%m-%d") { + # Check input + x <- check_long(x = x, date_format = date_format) - horizontal <- reshape( + horizontal <- stats::reshape( data = x, timevar = "time", idvar = "revdate", @@ -179,33 +281,40 @@ from_long_to_horizontal <- function(x) { return(horizontal) } -from_long_to_diagonal <- function(x, periodicity) { - x <- check_long(x) +from_long_to_diagonal <- function(x, periodicity, date_format = "%Y-%m-%d") { + # Check input + x <- check_long(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)) - 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 +329,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 +356,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 +368,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 +383,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, @@ -288,7 +415,7 @@ from_horizontal_to_diagonal <- function(x, date_format = "%Y-%m-%d", periodicity 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")) @@ -307,10 +434,17 @@ from_horizontal_to_diagonal <- function(x, date_format = "%Y-%m-%d", periodicity 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(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 +508,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 +549,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 +625,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 +642,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 +684,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 +785,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 +820,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 +871,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, ...) 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 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/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..32c7399 --- /dev/null +++ b/tests/testthat/test-create_vintages.R @@ -0,0 +1,238 @@ +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 <- 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( + .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) + +}) + + +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) + +})