From d6d021cdf827e76ba0682ec3a81192213ea2c6bb Mon Sep 17 00:00:00 2001 From: Tanguy BARTHELEMY Date: Fri, 26 Jan 2024 10:49:17 +0100 Subject: [PATCH 1/6] update news.md --- NEWS.md | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/NEWS.md b/NEWS.md index 93000de..64ad05d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,12 @@ % Latest JDCruncheR news +# JDCruncheR development + + * Update readme + * resolve a bug + +--- + # JDCruncheR 0.2.4 * The functions' help pages as well as the package vignettes are now available both in French and English. From f60f0f6cef3d6342db5ab98e88b43c4be28b6646 Mon Sep 17 00:00:00 2001 From: Tanguy BARTHELEMY Date: Fri, 26 Jan 2024 10:50:17 +0100 Subject: [PATCH 2/6] rewrite with styler --- R/Cruncher.R | 93 +++--- R/QR_export.R | 107 +++--- R/QR_functions.R | 311 ++++++++++-------- R/QR_matrix_classes.R | 146 +++++--- R/extractQR.R | 240 ++++++++------ R/onLoad.R | 159 ++++----- R/param_file.R | 35 +- vignettes/Lancement_cruncher.Rmd | 141 ++++---- vignettes/Lancement_cruncher_pdf.Rmd | 134 +++++--- .../Using_the_cruncher_with_JDCruncheR.Rmd | 159 +++++---- ...Using_the_cruncher_with_JDCruncheR_pdf.Rmd | 144 ++++---- 11 files changed, 994 insertions(+), 675 deletions(-) diff --git a/R/Cruncher.R b/R/Cruncher.R index 480daad..8dd32ce 100644 --- a/R/Cruncher.R +++ b/R/Cruncher.R @@ -32,50 +32,60 @@ NULL cruncher <- function(workspace = workspace, cruncher_bin_directory = getOption("cruncher_bin_directory"), param_file_path, log_file) { - if (missing(workspace) || is.null(workspace)) + if (missing(workspace) || is.null(workspace)) { stop("Please call the cruncher() on a valid workspace") + } - if (length(workspace) == 0) + if (length(workspace) == 0) { stop("The first argument must be a non-null workspace path") + } - if (length(workspace) > 1) + if (length(workspace) > 1) { stop("Please specify only one workspace path") + } # The path to the workspace must be "whole", not relative/from the setwd. workspace <- normalizePath(workspace, mustWork = FALSE) workspace <- sub("\\.xml$", "", workspace) # To remove the .xml from the workspace name, if needed if (missing(param_file_path) || is.null(param_file_path)) { - param_file_path <- list.files(path = workspace, - recursive = TRUE, - pattern = "\\.params$", - full.names = TRUE) - if (length(param_file_path) != 0) + param_file_path <- list.files( + path = workspace, + recursive = TRUE, + pattern = "\\.params$", + full.names = TRUE + ) + if (length(param_file_path) != 0) { stop("No or more than one .param file was found") + } } workspace <- paste0(workspace, ".xml") - if (!file.exists(paste0(cruncher_bin_directory, "/jwsacruncher"))) + if (!file.exists(paste0(cruncher_bin_directory, "/jwsacruncher"))) { stop("There is an error in the path to the cruncher bin folder") - if (!file.exists(workspace)) + } + if (!file.exists(workspace)) { stop("There is an error in the path to the workspace") - if (!file.exists(param_file_path)) + } + if (!file.exists(param_file_path)) { stop("There is an error in the path to the .params file") + } wd <- getwd() setwd(cruncher_bin_directory) log <- shell(paste0( - "jwsacruncher \"" - , workspace - , "\" -x \"" - , param_file_path, "\"" + "jwsacruncher \"", + workspace, + "\" -x \"", + param_file_path, "\"" ), intern = TRUE) setwd(wd) - if (!missing(log_file) && !is.null(log_file)) + if (!missing(log_file) && !is.null(log_file)) { writeLines(text = log, con = log_file) + } return(invisible(workspace)) } @@ -131,45 +141,47 @@ cruncher_and_param <- function(workspace = workspace, delete_existing_file = NULL, log_file = NULL, ...) { - dossier_temp <- tempdir() fichier_param <- create_param_file(dossier_temp, output = output, ...) - workspace <- cruncher(workspace = workspace, cruncher_bin_directory = cruncher_bin_directory, - param_file_path = fichier_param, log_file = log_file) + workspace <- cruncher( + workspace = workspace, cruncher_bin_directory = cruncher_bin_directory, + param_file_path = fichier_param, log_file = log_file + ) if (rename_multi_documents) { - if (is.null(output)) + if (is.null(output)) { output <- paste0(sub("\\.xml", "", workspace), "\\Output") + } noms_multi_documents <- multiprocessing_names(workspace) - if (nrow(noms_multi_documents) == 0) + if (nrow(noms_multi_documents) == 0) { stop("There is no multiprocessing in the workspace!") + } noms_multi_documents$name <- paste0(output, "\\", noms_multi_documents$name) noms_multi_documents$file <- paste0(output, "\\", noms_multi_documents$file) noms_multi_documents <- noms_multi_documents[noms_multi_documents$name != noms_multi_documents$file, ] if (any(file.exists(noms_multi_documents$name))) { - if (is.null(delete_existing_file)) { message <- paste("There is already at least one file in ", output, ".\nDo you want to clear the output folder?") - delete_existing_file <- utils::winDialog(type = c("yesnocancel"), - message) + delete_existing_file <- utils::winDialog( + type = c("yesnocancel"), + message + ) delete_existing_file <- isTRUE(delete_existing_file == "YES") - } if (delete_existing_file) { unlink(noms_multi_documents$name[file.exists(noms_multi_documents$name)], - recursive = TRUE) + recursive = TRUE + ) file.rename(from = noms_multi_documents$file, to = noms_multi_documents$name) } else { warning("There were pre-existing files in the output folder: none were removed or renamed.") } - } else { file.rename(from = noms_multi_documents$file, to = noms_multi_documents$name) } - } return(invisible(workspace)) @@ -205,22 +217,26 @@ multiprocessing_names <- function(workspace) { stop("Please call multiprocessing_names() on a valid workspace") } - if (length(workspace) == 0) + if (length(workspace) == 0) { stop("The first argument must be a non-null workspace path") + } - if (length(workspace) > 1) + if (length(workspace) > 1) { stop("Please specify only one workspace path") + } workspace <- normalizePath(workspace, mustWork = FALSE) workspace <- paste0(sub("\\.xml$", "", workspace), ".xml") - if (!file.exists(workspace)) + if (!file.exists(workspace)) { stop("The workspace doesn't exist") + } xml_workspace <- suppressWarnings(XML::xmlParse(workspace, error = function(...) {})) noms_objets <- XML::xmlToDataFrame(nodes = XML::getNodeSet( doc = xml_workspace, - path = "//ns2:demetraGenericWorkspace/ns2:items/ns2:item")) + path = "//ns2:demetraGenericWorkspace/ns2:items/ns2:item" + )) noms_multi_documents <- noms_objets[grep("multi-documents", noms_objets$family), ] noms_multi_documents <- noms_multi_documents[, c("name", "file")] @@ -288,12 +304,15 @@ NULL update_workspace <- function(workspace = workspace, policy = "parameters", cruncher_bin_directory = getOption("cruncher_bin_directory")) { - dossier_temp <- tempdir() - fichier_param <- create_param_file(dossier_temp, output = dossier_temp, policy = policy, - matrix_item = NULL, tsmatrix_series = NULL) - workspace <- cruncher(workspace = workspace, cruncher_bin_directory = cruncher_bin_directory, - param_file_path = fichier_param) + fichier_param <- create_param_file(dossier_temp, + output = dossier_temp, policy = policy, + matrix_item = NULL, tsmatrix_series = NULL + ) + workspace <- cruncher( + workspace = workspace, cruncher_bin_directory = cruncher_bin_directory, + param_file_path = fichier_param + ) return(invisible(workspace)) } diff --git a/R/QR_export.R b/R/QR_export.R index 2788865..5ac7be4 100644 --- a/R/QR_export.R +++ b/R/QR_export.R @@ -46,16 +46,21 @@ export_xlsx.QR_matrix <- function(x, layout = c("all", "modalities", "values", " layout <- match.arg(layout) file_name <- ifelse(missing(file_name), "export.xls", file_name) wb <- XLConnect::loadWorkbook(filename = file_name, create = create) - sheets <- switch(layout, all = c("modalities", "values"), - combined = "values", - layout) - exp_data <- switch(layout, combined = { - data_v <- x[["values"]] - data_m <- x[["modalities"]] - joint_names <- colnames(data_m)[colnames(data_m) %in% colnames(data_v)] - data_v[, joint_names] <- data_m[, joint_names] - list(values = data_v) - }, x) + sheets <- switch(layout, + all = c("modalities", "values"), + combined = "values", + layout + ) + exp_data <- switch(layout, + combined = { + data_v <- x[["values"]] + data_m <- x[["modalities"]] + joint_names <- colnames(data_m)[colnames(data_m) %in% colnames(data_v)] + data_v[, joint_names] <- data_m[, joint_names] + list(values = data_v) + }, + x + ) XLConnect::createSheet(wb, sheets) if (clear_sheet) { XLConnect::clearSheet(wb, sheets) @@ -64,26 +69,36 @@ export_xlsx.QR_matrix <- function(x, layout = c("all", "modalities", "values", " XLConnect::setStyleAction(wb, XLConnect::XLC$STYLE_ACTION.DATA_FORMAT_ONLY) if (auto_format) { XLConnect::setDataFormatForType(wb, - type = XLConnect::XLC$DATA_TYPE.NUMERIC, - format = "0.000") + type = XLConnect::XLC$DATA_TYPE.NUMERIC, + format = "0.000" + ) cs <- XLConnect::createCellStyle(wb) - XLConnect::setBorder(cs, side = "all", - type = XLConnect::XLC$BORDER.THIN, - color = XLConnect::XLC$COLOR.BLACK) + XLConnect::setBorder(cs, + side = "all", + type = XLConnect::XLC$BORDER.THIN, + color = XLConnect::XLC$COLOR.BLACK + ) } for (s in sheets) { data <- exp_data[[s]] XLConnect::writeWorksheet(wb, data = data, sheet = s, header = TRUE) if (auto_format) { - XLConnect::setCellStyle(wb, sheet = s, row = 1:(nrow(data) + 1), - col = seq_len(ncol(data)), cellstyle = cs) XLConnect::setCellStyle(wb, - formula = paste0(s, "!", "$A$1:", - XLConnect::idx2cref(c(nrow(data) + 1, ncol(data)))), - cellstyle = cs) - XLConnect::setColumnWidth(wb, sheet = s, column = seq_len(ncol(data)), - width = -1) + sheet = s, row = 1:(nrow(data) + 1), + col = seq_len(ncol(data)), cellstyle = cs + ) + XLConnect::setCellStyle(wb, + formula = paste0( + s, "!", "$A$1:", + XLConnect::idx2cref(c(nrow(data) + 1, ncol(data))) + ), + cellstyle = cs + ) + XLConnect::setColumnWidth(wb, + sheet = s, column = seq_len(ncol(data)), + width = -1 + ) } } if (!missing(sheet_names) && length(sheet_names) == length(sheets)) { @@ -147,8 +162,9 @@ export_xlsx.mQR_matrix <- function(x, export_dir = "./", file_extension = c(".xls", ".xlsx"), layout = c("all", "modalities", "values", "combined"), ...) { - if (length(x) == 0) + if (length(x) == 0) { return(invisible(x)) + } file_extension <- match.arg(file_extension) layout_file <- match.arg(layout_file) layout <- match.arg(layout) @@ -159,43 +175,54 @@ export_xlsx.mQR_matrix <- function(x, export_dir = "./", QR_matrix_names <- paste0("QR_", seq_along(x)) } else { QR_matrix_names[is.na(QR_matrix_names)] <- "" - if (!is.na(match("", QR_matrix_names))) - QR_matrix_names[match("", QR_matrix_names)] <- paste0("QR_", - match("", QR_matrix_names)) + if (!is.na(match("", QR_matrix_names))) { + QR_matrix_names[match("", QR_matrix_names)] <- paste0( + "QR_", + match("", QR_matrix_names) + ) + } } if (layout_file == "ByQRMatrix") { # To export a quality report per file: - files_name <- normalizePath(file.path(export_dir, - paste0(QR_matrix_names, file_extension)), - mustWork = FALSE) + files_name <- normalizePath( + file.path( + export_dir, + paste0(QR_matrix_names, file_extension) + ), + mustWork = FALSE + ) for (i in seq_along(x)) { export_xlsx(x[[i]], layout = layout, file_name = files_name[i], ...) } } else { # To export a file per element of the quality report files_name <- switch(layout, - all = c("modalities", "values"), - combined = "values", - layout) + all = c("modalities", "values"), + combined = "values", + layout + ) final_layout <- switch(layout, - all = c("modalities", "values"), - layout) + all = c("modalities", "values"), + layout + ) files <- normalizePath( - file.path(export_dir, paste0(files_name, file_extension)), - mustWork = FALSE) + path = file.path(export_dir, paste0(files_name, file_extension)), + mustWork = FALSE + ) for (i in seq_along(x)) { # Index on the QR_matrix for (j in seq_along(final_layout)) { # Index on the elements - export_xlsx(x[[i]], layout = final_layout[j], file_name = files[j], - sheet_names = QR_matrix_names[i], - ...) + export_xlsx(x[[i]], + layout = final_layout[j], file_name = files[j], + sheet_names = QR_matrix_names[i], + ... + ) } } - } return(invisible(x)) diff --git a/R/QR_functions.R b/R/QR_functions.R index 416bda1..827c680 100644 --- a/R/QR_functions.R +++ b/R/QR_functions.R @@ -66,7 +66,7 @@ #' @return Un objet de type \code{\link{QR_matrix}} ou \code{\link{mQR_matrix}}. #' @examples \dontrun{ #' QR <- extract_QR() -#' QR <- compute_score(QR,n_contrib_score = 2) +#' QR <- compute_score(QR, n_contrib_score = 2) #' QR #' QR$modalities$score #' } @@ -129,33 +129,34 @@ NULL #' @return a \code{\link{QR_matrix}} or \code{\link{mQR_matrix}} object. #' @examples \dontrun{ #' QR <- extract_QR() -#' QR <- compute_score(QR,n_contrib_score = 2) +#' QR <- compute_score(QR, n_contrib_score = 2) #' QR #' QR$modalities$score #' } #' @name compute_score #' @seealso [Traduction française][fr-compute_score()] #' @export -compute_score.QR_matrix <- function( - x, - score_pond = c(qs_residual_sa_on_sa = 30, - f_residual_sa_on_sa = 30, - qs_residual_sa_on_i = 20, - f_residual_sa_on_i = 20, - f_residual_td_on_sa = 30, - f_residual_td_on_i = 20, - oos_mean = 15, - oos_mse = 10, - residuals_independency = 15, - residuals_homoskedasticity = 5, - residuals_skewness = 5, - m7 = 5, q_m2 = 5), - modalities = c("Good", "Uncertain", "", "Bad", "Severe"), - normalize_score_value, - na.rm = FALSE, - n_contrib_score, - conditional_indicator, - ...) { +compute_score.QR_matrix <- function(x, + score_pond = c( + qs_residual_sa_on_sa = 30, + f_residual_sa_on_sa = 30, + qs_residual_sa_on_i = 20, + f_residual_sa_on_i = 20, + f_residual_td_on_sa = 30, + f_residual_td_on_i = 20, + oos_mean = 15, + oos_mse = 10, + residuals_independency = 15, + residuals_homoskedasticity = 5, + residuals_skewness = 5, + m7 = 5, q_m2 = 5 + ), + modalities = c("Good", "Uncertain", "", "Bad", "Severe"), + normalize_score_value, + na.rm = FALSE, + n_contrib_score, + conditional_indicator, + ...) { # score_formula_exp <- as.expression(substitute(score_formula)) QR_modalities <- x$modalities @@ -163,35 +164,45 @@ compute_score.QR_matrix <- function( as.numeric(factor(x, levels = modalities, ordered = TRUE)) - 1 }) # Creation of an additionnal row to store the maximum score to normalise the score variable - QR_modalities <- rbind(QR_modalities, - length(modalities) - 1) - if (!all(names(score_pond) %in% colnames(QR_modalities))) + QR_modalities <- rbind( + QR_modalities, + length(modalities) - 1 + ) + if (!all(names(score_pond) %in% colnames(QR_modalities))) { stop("Missing variables: please check the score_pond parameter") + } # Weight changes with the conditional_indicator parameter if (!missing(conditional_indicator) && length(conditional_indicator) > 0) { for (i in seq_along(conditional_indicator)) { indicator_condition <- conditional_indicator[[i]] - if (any(is.na(match(c("indicator", "conditions", "conditions_modalities"), - names(indicator_condition))))) + if (any(is.na(match( + c("indicator", "conditions", "conditions_modalities"), + names(indicator_condition) + )))) { stop("There is an error in the specification of the indicator_condition variable") + } - indicator_variables <- c(indicator_condition$indicator, - indicator_condition$conditions) - if (!all(indicator_variables %in% colnames(x$modalities))) + indicator_variables <- c( + indicator_condition$indicator, + indicator_condition$conditions + ) + if (!all(indicator_variables %in% colnames(x$modalities))) { stop("Missing variables: please check the indicator_variables parameter") + } # Series for which at least one conditions is verified - series_to_change <- rowSums(sapply(indicator_condition$conditions, - function(name) { - x$modalities[, name] %in% indicator_condition$conditions_modalities - }), na.rm = TRUE) + series_to_change <- rowSums(sapply( + indicator_condition$conditions, + function(name) { + x$modalities[, name] %in% indicator_condition$conditions_modalities + } + ), na.rm = TRUE) series_to_change <- which(series_to_change > 0) if (indicator_condition$indicator[1] %in% names(score_pond)) { QR_modalities[series_to_change, indicator_condition$indicator[1]] <- - QR_modalities[series_to_change, indicator_condition$indicator[1]] / - score_pond[indicator_condition$indicator[1]] + QR_modalities[series_to_change, indicator_condition$indicator[1]] / score_pond[indicator_condition$indicator[1]] } } } @@ -202,50 +213,62 @@ compute_score.QR_matrix <- function( QR_modalities[, nom_var] <- QR_modalities[, nom_var] * score_pond[nom_var] } score <- base::rowSums(QR_modalities, - na.rm = na.rm) + na.rm = na.rm + ) total_pond_id <- length(score) if (!missing(normalize_score_value)) { - if (!is.numeric(normalize_score_value)) + if (!is.numeric(normalize_score_value)) { stop("The score's reference value must be a number!") + } score <- score / score[total_pond_id] * normalize_score_value } score <- score[-total_pond_id] - x$modalities[, grep("(_highest_contrib_score$)|(score)", - colnames(x$modalities))] <- NULL - x$values[, grep("(_highest_contrib_score$)|(score)", - colnames(x$values))] <- NULL + x$modalities[, grep( + "(_highest_contrib_score$)|(score)", + colnames(x$modalities) + )] <- NULL + x$values[, grep( + "(_highest_contrib_score$)|(score)", + colnames(x$values) + )] <- NULL x$modalities$score <- score x$values$score <- score x$score_formula <- paste(score_pond, "*", - names(score_pond), - collapse = " + ") - if (!missing(n_contrib_score) && - is.numeric(n_contrib_score) && - n_contrib_score >= 1) { + names(score_pond), + collapse = " + " + ) + if (!missing(n_contrib_score) + && is.numeric(n_contrib_score) + && n_contrib_score >= 1) { QR_modalities <- QR_modalities[-total_pond_id, ] n_contrib_score <- round(min(n_contrib_score, length(score_pond))) contrib <- t(sapply(seq_len(nrow(QR_modalities)), function(i) { ligne_i <- QR_modalities[i, ] res <- colnames(QR_modalities)[order(t(ligne_i), - decreasing = TRUE, - na.last = TRUE)] + decreasing = TRUE, + na.last = TRUE + )] ligne_i <- ligne_i[, res] lignes_a_modif <- which(is.na(ligne_i) | ligne_i == 0) res[lignes_a_modif] <- "" res })) - colnames(contrib) <- paste0(seq_along(score_pond), - "_highest_contrib_score") + colnames(contrib) <- paste0( + seq_along(score_pond), + "_highest_contrib_score" + ) ncol_before_contrib <- ncol(x$values) x$values <- cbind(x$values, contrib[, 1:n_contrib_score]) colnames(x$values)[1:n_contrib_score + ncol_before_contrib] <- - paste0(1:n_contrib_score, - "_highest_contrib_score") + paste0( + 1:n_contrib_score, + "_highest_contrib_score" + ) } return(x) @@ -260,7 +283,7 @@ compute_score <- function(x, ...) { UseMethod("compute_score", x) } #' @export -compute_score.default <- function(x, ...) { +compute_score.default <- function(x, ...) { stop("The function requires a QR_matrix or mQR_matrix object!") } @@ -314,8 +337,9 @@ weighted_score.default <- function(x, pond = 1) { #' @export weighted_score.QR_matrix <- function(x, pond = 1) { if (is.character(pond)) { - if (is.na(match(pond, colnames(x$values)))) + if (is.na(match(pond, colnames(x$values)))) { stop("The variable ", pond, " doesn't exist") + } pond <- x$values[, pond] } if (!is.na(match("score", colnames(x$modalities)))) { @@ -331,11 +355,13 @@ weighted_score.mQR_matrix <- function(x, pond = 1) { if (!is.list(pond)) { result <- lapply(x, weighted_score, pond = pond) } else { - if (length(pond) < length(x)) + if (length(pond) < length(x)) { stop("There are fewer weight sets than quality reports!") - result <- lapply(seq_along(x), - function(i) weighted_score(x[[i]], pond = pond[[i]])) - + } + result <- lapply( + seq_along(x), + function(i) weighted_score(x[[i]], pond = pond[[i]]) + ) } names(result) <- names(x) result <- mQR_matrix(result) @@ -386,8 +412,9 @@ NULL #' @export sort.QR_matrix <- function(x, decreasing = FALSE, sort_variables = "score", ...) { modalities <- x$modalities - if (!all(!is.na(match(sort_variables, colnames(modalities))))) + if (!all(!is.na(match(sort_variables, colnames(modalities))))) { stop("There is an error in the variables' names") + } modalities <- c(modalities[sort_variables], decreasing = decreasing) ordered_matrixBQ <- do.call(order, modalities) x$modalities <- x$modalities[ordered_matrixBQ, ] @@ -397,8 +424,10 @@ sort.QR_matrix <- function(x, decreasing = FALSE, sort_variables = "score", ...) #' @rdname sort #' @export sort.mQR_matrix <- function(x, decreasing = FALSE, sort_variables = "score", ...) { - result <- lapply(x, sort, sort_variables = sort_variables, - decreasing = decreasing, ...) + result <- lapply(x, sort, + sort_variables = sort_variables, + decreasing = decreasing, ... + ) result <- mQR_matrix(result) return(result) } @@ -443,7 +472,7 @@ NULL #' @examples \dontrun{ #' QR <- extract_QR() #' mQR <- mQR_matrix(QR, compute_score(QR)) -#' extract_score(QR) # NULL +#' extract_score(QR) # NULL #' extract_score(mQR) # List whose first element is NULL #' } #' @seealso [Traduction française][fr-extract_score()] @@ -471,28 +500,30 @@ extract_score.QR_matrix <- function(x, format_output = c("data.frame", "vector") score_variable <- "score" } - if (is.null(score)) + if (is.null(score)) { return(NULL) + } format_output <- match.arg(format_output) res <- switch(format_output, - data.frame = x$modalities[, c("series", score_variable)], - vector = { - names(score) <- x$modalities$series - score - } + data.frame = x$modalities[, c("series", score_variable)], + vector = { + names(score) <- x$modalities$series + score + } ) return(res) } #' @export -extract_score.mQR_matrix <- function( - x, - format_output = c("data.frame", "vector"), - weighted_score = FALSE) { - return(lapply(X = x, - FUN = extract_score, - format_output = format_output, - weighted_score = weighted_score)) +extract_score.mQR_matrix <- function(x, + format_output = c("data.frame", "vector"), + weighted_score = FALSE) { + return(lapply( + X = x, + FUN = extract_score, + format_output = format_output, + weighted_score = weighted_score + )) } @@ -509,9 +540,9 @@ extract_score.mQR_matrix <- function( #' @param ... noms des variables à retirer (ou conserver). #' @examples \dontrun{ #' QR <- compute_score(extract_QR()) -#' retain_indicators(QR,"score","m7") # On ne retient que les variables score et m7 -#' retain_indicators(QR,c("score","m7")) # équivalent -#' score(remove_indicator(QR,"score")) # Il n'y a plus de score +#' retain_indicators(QR, "score", "m7") # On ne retient que les variables score et m7 +#' retain_indicators(QR, c("score", "m7")) # équivalent +#' score(remove_indicator(QR, "score")) # Il n'y a plus de score #' } #' @keywords internal #' @name fr-remove_indicators @@ -528,9 +559,9 @@ NULL #' @param ... names of the variable to remove (or keep) #' @examples \dontrun{ #' QR <- compute_score(extract_QR()) -#' retain_indicators(QR,"score","m7") # Only the score and the m7 variables are kept -#' retain_indicators(QR,c("score","m7")) # equivalent syntax -#' score(remove_indicator(QR,"score")) # The score is removed +#' retain_indicators(QR, "score", "m7") # Only the score and the m7 variables are kept +#' retain_indicators(QR, c("score", "m7")) # equivalent syntax +#' score(remove_indicator(QR, "score")) # The score is removed #' } #' @family var QR_matrix manipulation #' @name QR_var_manipulation @@ -639,17 +670,20 @@ NULL #' @export rbind.QR_matrix <- function(..., check_formula = TRUE) { list_QR_matrix <- list(...) - if (length(list_QR_matrix) == 0) + if (length(list_QR_matrix) == 0) { return(QR_matrix()) + } if (check_formula) { list_formula <- sapply(list_QR_matrix, function(x) { - if (!is.QR_matrix(x)) + if (!is.QR_matrix(x)) { stop("All arguments of this function must be QR_matrix objects", call. = FALSE) + } x$score_formula }) list_formula_unique <- unique(list_formula) - if (length(list_formula) != length(list_QR_matrix) || length(list_formula_unique) != 1) + if (length(list_formula) != length(list_QR_matrix) || length(list_formula_unique) != 1) { stop("All QR_matrices must have the same score formulas") + } if (is.list(list_formula_unique)) { score_formula <- NULL } else { @@ -659,16 +693,23 @@ rbind.QR_matrix <- function(..., check_formula = TRUE) { score_formula <- NULL } - modalities <- do.call(rbind, - lapply(list_QR_matrix, function(x) { - if (!is.QR_matrix(x)) - stop("All arguments of this function must be QR_matrix objects", call. = FALSE) - x$modalities - })) - values <- do.call(rbind, - lapply(list_QR_matrix, function(x) x$values)) - QR <- QR_matrix(modalities = modalities, values = values, - score_formula = score_formula) + modalities <- do.call( + rbind, + lapply(list_QR_matrix, function(x) { + if (!is.QR_matrix(x)) { + stop("All arguments of this function must be QR_matrix objects", call. = FALSE) + } + x$modalities + }) + ) + values <- do.call( + rbind, + lapply(list_QR_matrix, function(x) x$values) + ) + QR <- QR_matrix( + modalities = modalities, values = values, + score_formula = score_formula + ) return(QR) } @@ -732,30 +773,39 @@ add_indicator.default <- function(x, indicator, variable_name, ...) { #' @export add_indicator.QR_matrix <- function(x, indicator, variable_name, ...) { if (is.vector(indicator)) { - if (is.null(names(indicator))) + if (is.null(names(indicator))) { stop("The vector's elements must be named!") + } indicator <- data.frame(series = names(indicator), val = indicator) } - if (!is.data.frame(indicator)) + if (!is.data.frame(indicator)) { stop("The function input must be a vector or a data.frame!") + } - if (!"series" %in% colnames(indicator)) + if (!"series" %in% colnames(indicator)) { stop('The data.frame is missing a column named "series"') - if (ncol(indicator) < 2) + } + if (ncol(indicator) < 2) { stop("The data.frame must have at least two columns") + } # The "series" variable is moved in first position - indicator <- indicator[, c("series", - grep("^series$", colnames(indicator), - invert = TRUE, - value = TRUE))] + indicator <- indicator[, c( + "series", + grep("^series$", colnames(indicator), + invert = TRUE, + value = TRUE + ) + )] if (missing(variable_name)) { variable_name <- colnames(indicator)[-1] } values <- x$values n_col <- ncol(values) values$initial_sort <- seq_len(nrow(values)) - values <- merge(values, indicator, by = "series", - all.x = TRUE, all.y = FALSE, ...) + values <- merge(values, indicator, + by = "series", + all.x = TRUE, all.y = FALSE, ... + ) values <- values[order(values$initial_sort, decreasing = FALSE), ] values$initial_sort <- NULL @@ -804,12 +854,11 @@ NULL #' @family var QR_matrix manipulation #' @seealso [Traduction française][fr-recode_indicator_num()] #' @export -recode_indicator_num <- function( - x, - variable_name, - breaks = c(0, .01, .05, .1, 1), - labels = c("Good", "Uncertain", "Bad", "Severe"), - ...) { +recode_indicator_num <- function(x, + variable_name, + breaks = c(0, .01, .05, .1, 1), + labels = c("Good", "Uncertain", "Bad", "Severe"), + ...) { UseMethod("recode_indicator_num", x) } #' @export @@ -817,19 +866,19 @@ recode_indicator_num.default <- function(x, variable_name, breaks, labels, ...) stop("This function requires a QR_matrix or mQR_matrix object") } #' @export -recode_indicator_num.QR_matrix <- function( - x, - variable_name, - breaks = c(0, .01, .05, .1, 1), - labels = c("Good", "Uncertain", "Bad", "Severe"), - ...) { +recode_indicator_num.QR_matrix <- function(x, + variable_name, + breaks = c(0, .01, .05, .1, 1), + labels = c("Good", "Uncertain", "Bad", "Severe"), + ...) { modalities <- x$modalities values <- x$values for (var in variable_name) { if (var %in% colnames(values)) { modalities[, var] <- cut(values[, var], - breaks = breaks, - labels = labels) + breaks = breaks, + labels = labels + ) } else { warning("The variable ", var, " couldn't be found.") } @@ -840,13 +889,17 @@ recode_indicator_num.QR_matrix <- function( return(x) } #' @export -recode_indicator_num.mQR_matrix <- function( - x, - variable_name, - breaks = c(0, .01, .05, .1, 1), - labels = c("Good", "Uncertain", "Bad", "Severe"), - ...) { - return(mQR_matrix(lapply( - X = x, FUN = recode_indicator_num, - variable_name = variable_name, breaks = breaks, labels = labels, ...))) +recode_indicator_num.mQR_matrix <- function(x, + variable_name, + breaks = c(0, .01, .05, .1, 1), + labels = c("Good", "Uncertain", "Bad", "Severe"), + ...) { + return(mQR_matrix(x = lapply( + X = x, + FUN = recode_indicator_num, + variable_name = variable_name, + breaks = breaks, + labels = labels, + ... + ))) } diff --git a/R/QR_matrix_classes.R b/R/QR_matrix_classes.R index 955e05d..d093e4d 100644 --- a/R/QR_matrix_classes.R +++ b/R/QR_matrix_classes.R @@ -55,8 +55,10 @@ NULL #' @seealso [Traduction française][fr-QR_matrix()] #' @export QR_matrix <- function(modalities = NULL, values = NULL, score_formula = NULL) { - QR <- list(modalities = modalities, values = values, - score_formula = score_formula) + QR <- list( + modalities = modalities, values = values, + score_formula = score_formula + ) class(QR) <- c("QR_matrix") QR } @@ -130,21 +132,35 @@ print.QR_matrix <- function(x, print_variables = TRUE, print_score_formula = TRU nb_var_modalities <- ncol(x$modalities) nb_var_values <- ncol(x$values) - if (is.null(nb_var) || is.null(nb_var_modalities) || is.null(nb_var_values) || - nb_var * nb_var_modalities * nb_var_values == 0) { + if (is.null(nb_var) + || is.null(nb_var_modalities) + || is.null(nb_var_values) + || nb_var * nb_var_modalities * nb_var_values == 0) { cat("The quality report matrix is empty") return(invisible(x)) } - cat(sprintf(ngettext(nb_var, "The quality report matrix has %d observations", - "The quality report matrix has %d observations"), - nb_var)) + cat(sprintf( + ngettext( + nb_var, "The quality report matrix has %d observations", + "The quality report matrix has %d observations" + ), + nb_var + )) cat("\n") - cat(sprintf(ngettext(nb_var_modalities, "There are %d indicators in the modalities matrix", - "There are %d indicators in the modalities matrix"), - nb_var_modalities)) - cat(sprintf(ngettext(nb_var_values, " and %d indicators in the values matrix", - " and %d indicators in the values matrix"), - nb_var_values)) + cat(sprintf( + ngettext( + nb_var_modalities, "There are %d indicators in the modalities matrix", + "There are %d indicators in the modalities matrix" + ), + nb_var_modalities + )) + cat(sprintf( + ngettext( + nb_var_values, " and %d indicators in the values matrix", + " and %d indicators in the values matrix" + ), + nb_var_values + )) cat("\n") if (print_variables) { cat("\n") @@ -155,25 +171,29 @@ print.QR_matrix <- function(x, print_variables = TRUE, print_score_formula = TRU names_var_values_sup <- paste(names_var_values_sup, collapse = " ") - cat(sprintf("The quality report matrix contains the following variables:\n%s\n", - names_var_modalities) - ) + cat(sprintf( + "The quality report matrix contains the following variables:\n%s\n", + names_var_modalities + )) cat("\n") if (all(names_var_values_sup == "")) { cat("There's no additionnal variable in the values matrix") } else { - cat(sprintf("The variables exclusively found in the values matrix are:\n%s", - names_var_values_sup)) + cat(sprintf( + "The variables exclusively found in the values matrix are:\n%s", + names_var_values_sup + )) } cat("\n") if (length(names_var_values_sup) > 1) { - - - cat(sprintf(ngettext(length(names_var_values_sup), - "There's no additionnal variable in the values matrix", - "The variables exclusively found in the values matrix are:\n%s"), - names_var_values_sup)) - + cat(sprintf( + ngettext( + length(names_var_values_sup), + "There's no additionnal variable in the values matrix", + "The variables exclusively found in the values matrix are:\n%s" + ), + names_var_values_sup + )) } cat("\n") @@ -184,15 +204,21 @@ print.QR_matrix <- function(x, print_variables = TRUE, print_score_formula = TRU if (is.null(score_value)) { cat("No score was calculated") } else { - cat(sprintf("The smallest score is %1g and the greatest is %2g\n", - min(score_value, na.rm = TRUE), max(score_value, na.rm = TRUE))) - cat(sprintf("The average score is %1g and its standard deviation is %2g", - mean(score_value, na.rm = TRUE), sd(score_value, na.rm = TRUE))) + cat(sprintf( + "The smallest score is %1g and the greatest is %2g\n", + min(score_value, na.rm = TRUE), max(score_value, na.rm = TRUE) + )) + cat(sprintf( + "The average score is %1g and its standard deviation is %2g", + mean(score_value, na.rm = TRUE), sd(score_value, na.rm = TRUE) + )) } if (print_score_formula && !is.null(x$score_formula)) { cat("\n\n") - cat(sprintf("The following formula was used to calculate the score:\n%s", - as.character(x$score_formula))) + cat(sprintf( + "The following formula was used to calculate the score:\n%s", + as.character(x$score_formula) + )) } return(invisible(x)) } @@ -204,9 +230,13 @@ print.mQR_matrix <- function(x, score_statistics = TRUE, ...) { cat("List without a quality report") return(invisible(x)) } - cat(sprintf(ngettext(length(x), "The object contains %d quality report(s)", - "The object contains %d quality report(s)"), - length(x))) + cat(sprintf( + ngettext( + length(x), "The object contains %d quality report(s)", + "The object contains %d quality report(s)" + ), + length(x) + )) cat("\n") bq_names <- names(x) bq_names[is.na(bq_names)] <- "" @@ -215,17 +245,25 @@ print.mQR_matrix <- function(x, score_statistics = TRUE, ...) { } else { bq_names_na <- sum(is.na(bq_names)) bq_valid_names <- bq_names[!is.na(bq_names)] - cat(sprintf(ngettext(length(bq_valid_names), - "%d quality report is named: %s", - "%d quality reports are named: %s"), - length(bq_valid_names), paste(bq_valid_names, collapse = " "))) + cat(sprintf( + ngettext( + length(bq_valid_names), + "%d quality report is named: %s", + "%d quality reports are named: %s" + ), + length(bq_valid_names), paste(bq_valid_names, collapse = " ") + )) if (length(bq_names_na) > 1) { cat("\n") - cat(sprintf(ngettext(bq_names_na, - "%d quality report isn't named", - "%d quality reports aren't named"), - bq_names_na)) + cat(sprintf( + ngettext( + bq_names_na, + "%d quality report isn't named", + "%d quality reports aren't named" + ), + bq_names_na + )) } } if (score_statistics) { @@ -235,10 +273,14 @@ print.mQR_matrix <- function(x, score_statistics = TRUE, ...) { if (is.null(all_score)) { cat("No quality report has a calculated score") } else { - cat(sprintf("The average score over all quality reports is %g\n", - mean(all_score, na.rm = TRUE))) - cat(sprintf("The smallest score is %1g and the greatest is %2g\n", - min(all_score, na.rm = TRUE), max(all_score, na.rm = TRUE))) + cat(sprintf( + "The average score over all quality reports is %g\n", + mean(all_score, na.rm = TRUE) + )) + cat(sprintf( + "The smallest score is %1g and the greatest is %2g\n", + min(all_score, na.rm = TRUE), max(all_score, na.rm = TRUE) + )) for (i in seq_along(score_values)) { cat("\n\n") @@ -254,10 +296,14 @@ print.mQR_matrix <- function(x, score_statistics = TRUE, ...) { if (is.null(score_value)) { cat(sprintf("There is no calculated score for the quality report n.%d%s", i, bq_name)) } else { - cat(sprintf("The quality report n.%d%s has an average score of %g\n", i, bq_name, - mean(score_value, na.rm = TRUE))) - cat(sprintf("The smallest score is %1g and the greatest is %2g\n", - min(score_value, na.rm = TRUE), max(score_value, na.rm = TRUE))) + cat(sprintf( + "The quality report n.%d%s has an average score of %g\n", i, bq_name, + mean(score_value, na.rm = TRUE) + )) + cat(sprintf( + "The smallest score is %1g and the greatest is %2g\n", + min(score_value, na.rm = TRUE), max(score_value, na.rm = TRUE) + )) } } } diff --git a/R/extractQR.R b/R/extractQR.R index d2781d4..3829faf 100644 --- a/R/extractQR.R +++ b/R/extractQR.R @@ -79,86 +79,122 @@ extract_QR <- function(matrix_output_file, sep = ";", dec = ",") { if (missing(matrix_output_file) || is.null(matrix_output_file)) { stop("Please call extract_QR() on a csv file containing at least one cruncher output matrix (demetra_m.csv for example)") } - if (length(matrix_output_file) == 0) + if (length(matrix_output_file) == 0) { stop("The chosen csv file is empty") - if (!file.exists(matrix_output_file) || length(grep("\\.csv$", matrix_output_file)) == 0) + } + if (!file.exists(matrix_output_file) || length(grep("\\.csv$", matrix_output_file)) == 0) { stop("The chosen file desn't exist or isn't a csv file") + } - demetra_m <- read.csv(file = matrix_output_file, - sep = sep, dec = dec, stringsAsFactors = FALSE, - na.strings = c("NA", "?")) - missing_variables <- which(is.na(match(c("qs.test.on.sa", "f.test.on.sa..seasonal.dummies.", - "qs.test.on.i", "f.test.on.i..seasonal.dummies.", - "f.test.on.sa..td.", "f.test.on.i..td.", "independence", "normality", - "skewness", "kurtosis"), - colnames(demetra_m)))) + demetra_m <- read.csv( + file = matrix_output_file, + sep = sep, dec = dec, stringsAsFactors = FALSE, + na.strings = c("NA", "?") + ) + missing_variables <- which(is.na(match( + c( + "qs.test.on.sa", "f.test.on.sa..seasonal.dummies.", + "qs.test.on.i", "f.test.on.i..seasonal.dummies.", + "f.test.on.sa..td.", "f.test.on.i..td.", "independence", "normality", + "skewness", "kurtosis" + ), + colnames(demetra_m) + ))) if (length(missing_variables) != 0) { - stop(paste0("The following variables are missing from the diagnostics matrix:\n", - c("qs.test.on.sa", "f.test.on.sa..seasonal.dummies.", - "qs.test.on.i", "f.test.on.i..seasonal.dummies.", - "f.test.on.sa..td.", "f.test.on.i..td.", "independence", "normality", - "skewness", "kurtosis")[missing_variables], - "\nPlease re-compute the export.")) + stop(paste0( + "The following variables are missing from the diagnostics matrix:\n", + c( + "qs.test.on.sa", "f.test.on.sa..seasonal.dummies.", + "qs.test.on.i", "f.test.on.i..seasonal.dummies.", + "f.test.on.sa..td.", "f.test.on.i..td.", "independence", "normality", + "skewness", "kurtosis" + )[missing_variables], + "\nPlease re-compute the export." + )) } - demetra_m$series <- gsub("(^ *)|(* $)", "", - gsub("(^.* \\* )|(\\[frozen\\])", "", demetra_m[, 1])) + demetra_m$series <- gsub( + "(^ *)|(* $)", "", + gsub("(^.* \\* )|(\\[frozen\\])", "", demetra_m[, 1]) + ) demetra_m$frequency <- extractFrequency(demetra_m) - demetra_m <- cbind(demetra_m, - extractARIMA(demetra_m), - extractStatQ(demetra_m), - extractOOS_test(demetra_m), - extractNormalityTests(demetra_m)) + demetra_m <- cbind( + demetra_m, + extractARIMA(demetra_m), + extractStatQ(demetra_m), + extractOOS_test(demetra_m), + extractNormalityTests(demetra_m) + ) demetra_m$pct_outliers_value <- demetra_m[, match("number.of.outliers", colnames(demetra_m)) + 1] * 100 demetra_m$pct_outliers_modality <- demetra_m$number.of.outliers demetra_m$m7_modality <- cut(demetra_m$m7 + 0, #+0 to force the variable type to be numeric in case of an NA - breaks = c(0, 1, 2, Inf), - labels = c("Good", "Bad", "Severe"), right = FALSE) + breaks = c(0, 1, 2, Inf), + labels = c("Good", "Bad", "Severe"), right = FALSE + ) - colnames(demetra_m)[match(c("qs.test.on.sa", "f.test.on.sa..seasonal.dummies.", - "qs.test.on.i", "f.test.on.i..seasonal.dummies.", - "f.test.on.sa..td.", "f.test.on.i..td.", "independence", "normality"), - colnames(demetra_m)) + 1] <- paste0(c("qs.test.on.sa", "f.test.on.sa..seasonal.dummies.", - "qs.test.on.i", "f.test.on.i..seasonal.dummies.", - "f.test.on.sa..td.", "f.test.on.i..td.", "independence", "normality"), "_pvalue") - modalities_variables <- c("series", "qs.test.on.sa", "f.test.on.sa..seasonal.dummies.", - "qs.test.on.i", "f.test.on.i..seasonal.dummies.", - "f.test.on.sa..td.", "f.test.on.i..td.", - "independence", "homoskedasticity_modality", - "skewness_modality", "kurtosis_modality", "normality", "oos_mean_modality", - "oos_mse_modality", "m7_modality", "q_modality", "q_m2_modality", "pct_outliers_modality") + colnames(demetra_m)[match( + c( + "qs.test.on.sa", "f.test.on.sa..seasonal.dummies.", + "qs.test.on.i", "f.test.on.i..seasonal.dummies.", + "f.test.on.sa..td.", "f.test.on.i..td.", "independence", "normality" + ), + colnames(demetra_m) + ) + 1] <- paste0(c( + "qs.test.on.sa", "f.test.on.sa..seasonal.dummies.", + "qs.test.on.i", "f.test.on.i..seasonal.dummies.", + "f.test.on.sa..td.", "f.test.on.i..td.", "independence", "normality" + ), "_pvalue") + modalities_variables <- c( + "series", "qs.test.on.sa", "f.test.on.sa..seasonal.dummies.", + "qs.test.on.i", "f.test.on.i..seasonal.dummies.", + "f.test.on.sa..td.", "f.test.on.i..td.", + "independence", "homoskedasticity_modality", + "skewness_modality", "kurtosis_modality", "normality", "oos_mean_modality", + "oos_mse_modality", "m7_modality", "q_modality", "q_m2_modality", "pct_outliers_modality" + ) - values_variables <- c("series", "qs.test.on.sa_pvalue", "f.test.on.sa..seasonal.dummies._pvalue", - "qs.test.on.i_pvalue", "f.test.on.i..seasonal.dummies._pvalue", - "f.test.on.sa..td._pvalue", "f.test.on.i..td._pvalue", - "independence_pvalue", "homoskedasticity_pvalue", - "skewness_pvalue", "kurtosis_pvalue", - "normality_pvalue", "oos_mean_pvalue", - "oos_mse_pvalue", "m7", "q_value", "q_m2_value", "pct_outliers_value", - "frequency", "arima_model") + values_variables <- c( + "series", "qs.test.on.sa_pvalue", "f.test.on.sa..seasonal.dummies._pvalue", + "qs.test.on.i_pvalue", "f.test.on.i..seasonal.dummies._pvalue", + "f.test.on.sa..td._pvalue", "f.test.on.i..td._pvalue", + "independence_pvalue", "homoskedasticity_pvalue", + "skewness_pvalue", "kurtosis_pvalue", + "normality_pvalue", "oos_mean_pvalue", + "oos_mse_pvalue", "m7", "q_value", "q_m2_value", "pct_outliers_value", + "frequency", "arima_model" + ) - if (!all(modalities_variables %in% colnames(demetra_m), - values_variables %in% colnames(demetra_m))) { - missing_variables <- unique(c(modalities_variables[!modalities_variables %in% colnames(demetra_m)], - values_variables[!values_variables %in% colnames(demetra_m)])) + if (!all( + modalities_variables %in% colnames(demetra_m), + values_variables %in% colnames(demetra_m) + )) { + missing_variables <- unique(c( + modalities_variables[!modalities_variables %in% colnames(demetra_m)], + values_variables[!values_variables %in% colnames(demetra_m)] + )) missing_variables <- paste(missing_variables, collapse = "\n") - stop(paste0("The following variables are missing from the diagnostics matrix:\n", - missing_variables, "\nPlease re-compute the export.")) + stop(paste0( + "The following variables are missing from the diagnostics matrix:\n", + missing_variables, "\nPlease re-compute the export." + )) } - names_QR_variables <- c("series", "qs_residual_sa_on_sa", "f_residual_sa_on_sa", - "qs_residual_sa_on_i", "f_residual_sa_on_i", - "f_residual_td_on_sa", "f_residual_td_on_i", - "residuals_independency", "residuals_homoskedasticity", - "residuals_skewness", "residuals_kurtosis", "residuals_normality", - "oos_mean", "oos_mse", "m7", "q", "q_m2", "pct_outliers") + names_QR_variables <- c( + "series", "qs_residual_sa_on_sa", "f_residual_sa_on_sa", + "qs_residual_sa_on_i", "f_residual_sa_on_i", + "f_residual_td_on_sa", "f_residual_td_on_i", + "residuals_independency", "residuals_homoskedasticity", + "residuals_skewness", "residuals_kurtosis", "residuals_normality", + "oos_mean", "oos_mse", "m7", "q", "q_m2", "pct_outliers" + ) QR_modalities <- demetra_m[, modalities_variables] QR_values <- demetra_m[, values_variables] rownames(QR_modalities) <- rownames(QR_values) <- NULL colnames(QR_values)[seq_along(names_QR_variables)] <- colnames(QR_modalities) <- names_QR_variables QR_modalities[, -1] <- lapply(QR_modalities[, -1], factor, - levels = c("Good", "Uncertain", "Bad", "Severe"), ordered = TRUE) + levels = c("Good", "Uncertain", "Bad", "Severe"), ordered = TRUE + ) QR <- QR_matrix(modalities = QR_modalities, values = QR_values) QR } @@ -177,7 +213,6 @@ extractARIMA <- function(demetra_m) { } else { val_q <- val_q[, integer_col[1]] } - } if (length(bp_possibles) > 1) { integer_col <- which(sapply(val_bq, is.integer)) @@ -186,41 +221,54 @@ extractARIMA <- function(demetra_m) { } else { val_bq <- val_bq[, integer_col[1]] } - } - if (!all(is.integer(val_q) || all(is.na(val_q)), - is.integer(val_bq) || all(is.na(val_q)))) + if (!all( + is.integer(val_q) || all(is.na(val_q)), + is.integer(val_bq) || all(is.na(val_q)) + )) { stop("Error in the extraction of the arima order q or bq") - arima <- data.frame(arima_p = demetra_m[, "p"], arima_d = demetra_m[, "d"], arima_q = val_q, - arima_bp = val_bq, arima_bd = demetra_m[, "bd"], arima_bq = demetra_m[, "bq"], - arima_model = demetra_m[, "arima"]) + } + arima <- data.frame( + arima_p = demetra_m[, "p"], arima_d = demetra_m[, "d"], arima_q = val_q, + arima_bp = val_bq, arima_bd = demetra_m[, "bd"], arima_bq = demetra_m[, "bq"], + arima_model = demetra_m[, "arima"] + ) return(arima) } extractNormalityTests <- function(demetra_m) { tests_possibles <- grep("(^skewness$)|(^kurtosis$)|(^lb2$)", colnames(demetra_m)) - if (length(tests_possibles) != 3) + if (length(tests_possibles) != 3) { stop("At least one test is missing, among: skewness, kurtosis, lb2") + } - if (length(grep("^X\\.(\\d){1,}$", - colnames(demetra_m)[rep(tests_possibles, each = 2) + rep(1:2, 3)])) != 6) + if (length(grep( + "^X\\.(\\d){1,}$", + colnames(demetra_m)[rep(tests_possibles, each = 2) + rep(1:2, 3)] + )) != 6) { stop("Re-compute the cruncher export with the options: residuals.skewness:3, residuals.kurtosis:3 and residuals.lb2:3") + } - normality <- data.frame(skewness_pvalue = demetra_m[, tests_possibles[1] + 2], - kurtosis_pvalue = demetra_m[, tests_possibles[2] + 2], - homoskedasticity_pvalue = demetra_m[, tests_possibles[3] + 2]) + normality <- data.frame( + skewness_pvalue = demetra_m[, tests_possibles[1] + 2], + kurtosis_pvalue = demetra_m[, tests_possibles[2] + 2], + homoskedasticity_pvalue = demetra_m[, tests_possibles[3] + 2] + ) normality$skewness_modality <- cut(normality$skewness_pvalue, - breaks = c(0, .01, .1, 1), - labels = c("Bad", "Uncertain", "Good"), - right = FALSE) + breaks = c(0, .01, .1, 1), + labels = c("Bad", "Uncertain", "Good"), + right = FALSE + ) normality$kurtosis_modality <- cut(normality$kurtosis_pvalue, - breaks = c(0, .01, .1, 1), - labels = c("Bad", "Uncertain", "Good"), - right = FALSE) + breaks = c(0, .01, .1, 1), + labels = c("Bad", "Uncertain", "Good"), + right = FALSE + ) normality$homoskedasticity_modality <- cut(normality$homoskedasticity_pvalue, - breaks = c(0, .01, .1, 1), - labels = c("Bad", "Uncertain", "Good"), - right = FALSE) + breaks = c(0, .01, .1, 1), + labels = c("Bad", "Uncertain", "Good"), + right = FALSE + ) return(normality) } extractOOS_test <- function(demetra_m) { @@ -241,15 +289,18 @@ extractOOS_test <- function(demetra_m) { } } col_mse <- match("mse", colnames(demetra_m))[1] - if (!all(is.character(demetra_m[, col_mean]) || all(is.na(demetra_m[, col_mean])), - is.double(demetra_m[, col_mean + 1]) || all(is.na(demetra_m[, col_mean + 1])), - is.character(demetra_m[, col_mse]) || all(is.na(demetra_m[, col_mse])), - is.double(demetra_m[, col_mse + 1]) || all(is.na(demetra_m[, col_mse + 1])) - )) + if (!all( + is.character(demetra_m[, col_mean]) || all(is.na(demetra_m[, col_mean])), + is.double(demetra_m[, col_mean + 1]) || all(is.na(demetra_m[, col_mean + 1])), + is.character(demetra_m[, col_mse]) || all(is.na(demetra_m[, col_mse])), + is.double(demetra_m[, col_mse + 1]) || all(is.na(demetra_m[, col_mse + 1])) + )) { stop("Error in the extraction of the out of sample diagnostics") + } stat_OOS <- data.frame(demetra_m[, col_mean + c(0, 1)], demetra_m[, col_mse + c(0, 1)], - stringsAsFactors = FALSE) + stringsAsFactors = FALSE + ) colnames(stat_OOS) <- c("oos_mean_modality", "oos_mean_pvalue", "oos_mse_modality", "oos_mse_pvalue") return(stat_OOS) } @@ -286,21 +337,26 @@ extractStatQ <- function(demetra_m) { col_q_m2 <- q_m2_possibles[character_cols[1]] } } - if (!all(is.character(demetra_m[, col_q]) || all(is.na(demetra_m[, col_q])), - is.double(demetra_m[, col_q + 1]) || all(is.na(demetra_m[, col_q + 1])), - is.character(demetra_m[, col_q_m2]) || all(is.na(demetra_m[, col_q_m2])), - is.double(demetra_m[, col_q_m2 + 1])) || all(is.na(demetra_m[, col_q_m2 + 1]))) + if (!all( + is.character(demetra_m[, col_q]) || all(is.na(demetra_m[, col_q])), + is.double(demetra_m[, col_q + 1]) || all(is.na(demetra_m[, col_q + 1])), + is.character(demetra_m[, col_q_m2]) || all(is.na(demetra_m[, col_q_m2])), + is.double(demetra_m[, col_q_m2 + 1]) + ) || all(is.na(demetra_m[, col_q_m2 + 1]))) { stop("Error in the extraction of the Q and Q-M2 stats") + } stat_Q <- data.frame(demetra_m[, col_q + c(0, 1)], demetra_m[, col_q_m2 + c(0, 1)], - stringsAsFactors = FALSE) + stringsAsFactors = FALSE + ) colnames(stat_Q) <- c("q_modality", "q_value", "q_m2_modality", "q_m2_value") return(stat_Q) } extractFrequency <- function(demetra_m) { - if (any(is.na(match(c("start", "end", "n"), colnames(demetra_m))))) + if (any(is.na(match(c("start", "end", "n"), colnames(demetra_m))))) { stop("Error in the extraction of the series frequency (missing either the start date, the end date or the number of observations)") + } start <- as.Date(demetra_m$start, format = "%Y-%m-%d") end <- as.Date(demetra_m$end, format = "%Y-%m-%d") n <- demetra_m$n diff --git a/R/onLoad.R b/R/onLoad.R index 5d6ddd6..d8b3e1d 100644 --- a/R/onLoad.R +++ b/R/onLoad.R @@ -1,83 +1,86 @@ .onLoad <- function(libname, pkgname) { - if (is.null(getOption("default_matrix_item"))) - options(default_matrix_item = c("period", "span.start", "span.end", "span.n", "span.missing", - "espan.start", "espan.end", "espan.n", "log", "adjust", "regression.lp", - "regression.ntd", "regression.nmh", "regression.td-derived", - "regression.td-ftest", "regression.easter", "regression.nout", - "regression.noutao", "regression.noutls", "regression.nouttc", - "regression.noutso", "regression.td(*)", "regression.out(*)", - "regression.user(*)", "likelihood.neffectiveobs", "likelihood.np", - "likelihood.logvalue", "likelihood.adjustedlogvalue", "likelihood.ssqerr", - "likelihood.aic", "likelihood.aicc", "likelihood.bic", "likelihood.bicc", - "residuals.ser", "residuals.ser-ml", "residuals.mean", "residuals.skewness:3", - "residuals.kurtosis:3", "residuals.dh", "residuals.lb", "residuals.lb2:3", - "residuals.seaslb", "residuals.bp", "residuals.bp2", "residuals.seasbp", - "residuals.nudruns", "residuals.ludruns", "residuals.nruns", - "residuals.lruns", "arima", "arima.mean", "arima.p", "arima.d", - "arima.q", "arima.bp", "arima.bd", "arima.bq", "arima.phi(*)", - "arima.bphi(*)", "arima.th(*)", "arima.bth(*)", "decomposition.seasonality", - "decomposition.parameters_cutoff", "decomposition.model_changed", - "decomposition.tvar-estimator", "decomposition.tvar-estimate", - "decomposition.tvar-pvalue", "decomposition.savar-estimator", - "decomposition.savar-estimate", "decomposition.savar-pvalue", - "decomposition.svar-estimator", "decomposition.svar-estimate", - "decomposition.svar-pvalue", "decomposition.ivar-estimator", - "decomposition.ivar-estimate", "decomposition.ivar-pvalue", "decomposition.tscorr-estimator", - "decomposition.tscorr-estimate", "decomposition.tscorr-pvalue", - "decomposition.ticorr-estimator", "decomposition.ticorr-estimate", - "decomposition.ticorr-pvalue", "decomposition.sicorr-estimator", - "decomposition.sicorr-estimate", "decomposition.sicorr-pvalue", - "decomposition.ar_root(*)", "decomposition.ma_root(*)", "method", - "variancedecomposition.cycle", "variancedecomposition.seasonality", - "variancedecomposition.irregular", "variancedecomposition.tdh", - "variancedecomposition.others", "variancedecomposition.total", - "diagnostics.logstat", "diagnostics.levelstat", "diagnostics.fcast-insample-mean", - "diagnostics.fcast-outsample-mean", "diagnostics.fcast-outsample-variance", - "diagnostics.seas-lin-f", "diagnostics.seas-lin-qs", "diagnostics.seas-lin-kw", - "diagnostics.seas-lin-friedman", "diagnostics.seas-lin-periodogram", - "diagnostics.seas-lin-spectralpeaks", "diagnostics.seas-si-combined", - "diagnostics.seas-si-evolutive", "diagnostics.seas-si-stable", - "diagnostics.seas-res-f", "diagnostics.seas-res-qs", "diagnostics.seas-res-kw", - "diagnostics.seas-res-friedman", "diagnostics.seas-res-periodogram", - "diagnostics.seas-res-spectralpeaks", "diagnostics.seas-res-combined", - "diagnostics.seas-res-combined3", "diagnostics.seas-res-evolutive", - "diagnostics.seas-res-stable", "diagnostics.seas-i-f", "diagnostics.seas-i-qs", - "diagnostics.seas-i-kw", "diagnostics.seas-i-periodogram", "diagnostics.seas-i-spectralpeaks", - "diagnostics.seas-i-combined", "diagnostics.seas-i-combined3", - "diagnostics.seas-i-evolutive", "diagnostics.seas-i-stable", - "diagnostics.seas-sa-f", "diagnostics.seas-sa-qs", "diagnostics.seas-sa-kw", - "diagnostics.seas-sa-friedman", "diagnostics.seas-sa-periodogram", - "diagnostics.seas-sa-spectralpeaks", "diagnostics.seas-sa-combined", - "diagnostics.seas-sa-combined3", "diagnostics.seas-sa-evolutive", - "diagnostics.seas-sa-stable", "diagnostics.seas-sa-ac1", "diagnostics.td-sa-all", - "diagnostics.td-sa-last", "diagnostics.td-i-all", "diagnostics.td-i-last", - "diagnostics.td-res-all", "diagnostics.td-res-last", "diagnostics.ic-ratio-henderson", - "diagnostics.ic-ratio", "diagnostics.msr-global", "diagnostics.msr(*)", - "decomposition.trendfilter", "decomposition.seasfilter", "m-statistics.m1", - "m-statistics.m2", "m-statistics.m3", "m-statistics.m4", "m-statistics.m5", - "m-statistics.m6", "m-statistics.m7", "m-statistics.m8", "m-statistics.m9", - "m-statistics.m10", "m-statistics.m11", "m-statistics.q", "m-statistics.q-m2", - "diagnostics.basic checks.definition:2", "diagnostics.basic checks.annual totals:2", - "diagnostics.visual spectral analysis.spectral seas peaks", "diagnostics.visual spectral analysis.spectral td peaks", - "diagnostics.regarima residuals.normality:2", "diagnostics.regarima residuals.independence:2", - "diagnostics.regarima residuals.spectral td peaks:2", "diagnostics.regarima residuals.spectral seas peaks:2", - "diagnostics.outliers.number of outliers:2", "diagnostics.out-of-sample.mean:2", - "diagnostics.out-of-sample.mse:2", "diagnostics.m-statistics.q:2", - "diagnostics.m-statistics.q-m2:2", "diagnostics.seats.seas variance:2", - "diagnostics.seats.irregular variance:2", "diagnostics.seats.seas/irr cross-correlation:2", - "diagnostics.residual seasonality tests.qs test on sa:2", "diagnostics.residual seasonality tests.qs test on i:2", - "diagnostics.residual seasonality tests.f-test on sa (seasonal dummies):2", - "diagnostics.residual seasonality tests.f-test on i (seasonal dummies):2", - "diagnostics.combined seasonality test.combined seasonality test on sa:2", - "diagnostics.combined seasonality test.combined seasonality test on sa (last 3 years):2", - "diagnostics.combined seasonality test.combined seasonality test on irregular:2", - "diagnostics.residual trading days tests.f-test on sa (td):2", - "diagnostics.residual trading days tests.f-test on i (td):2", - "diagnostics.quality" + if (is.null(getOption("default_matrix_item"))) { + options(default_matrix_item = c( + "period", "span.start", "span.end", "span.n", "span.missing", + "espan.start", "espan.end", "espan.n", "log", "adjust", "regression.lp", + "regression.ntd", "regression.nmh", "regression.td-derived", + "regression.td-ftest", "regression.easter", "regression.nout", + "regression.noutao", "regression.noutls", "regression.nouttc", + "regression.noutso", "regression.td(*)", "regression.out(*)", + "regression.user(*)", "likelihood.neffectiveobs", "likelihood.np", + "likelihood.logvalue", "likelihood.adjustedlogvalue", "likelihood.ssqerr", + "likelihood.aic", "likelihood.aicc", "likelihood.bic", "likelihood.bicc", + "residuals.ser", "residuals.ser-ml", "residuals.mean", "residuals.skewness:3", + "residuals.kurtosis:3", "residuals.dh", "residuals.lb", "residuals.lb2:3", + "residuals.seaslb", "residuals.bp", "residuals.bp2", "residuals.seasbp", + "residuals.nudruns", "residuals.ludruns", "residuals.nruns", + "residuals.lruns", "arima", "arima.mean", "arima.p", "arima.d", + "arima.q", "arima.bp", "arima.bd", "arima.bq", "arima.phi(*)", + "arima.bphi(*)", "arima.th(*)", "arima.bth(*)", "decomposition.seasonality", + "decomposition.parameters_cutoff", "decomposition.model_changed", + "decomposition.tvar-estimator", "decomposition.tvar-estimate", + "decomposition.tvar-pvalue", "decomposition.savar-estimator", + "decomposition.savar-estimate", "decomposition.savar-pvalue", + "decomposition.svar-estimator", "decomposition.svar-estimate", + "decomposition.svar-pvalue", "decomposition.ivar-estimator", + "decomposition.ivar-estimate", "decomposition.ivar-pvalue", "decomposition.tscorr-estimator", + "decomposition.tscorr-estimate", "decomposition.tscorr-pvalue", + "decomposition.ticorr-estimator", "decomposition.ticorr-estimate", + "decomposition.ticorr-pvalue", "decomposition.sicorr-estimator", + "decomposition.sicorr-estimate", "decomposition.sicorr-pvalue", + "decomposition.ar_root(*)", "decomposition.ma_root(*)", "method", + "variancedecomposition.cycle", "variancedecomposition.seasonality", + "variancedecomposition.irregular", "variancedecomposition.tdh", + "variancedecomposition.others", "variancedecomposition.total", + "diagnostics.logstat", "diagnostics.levelstat", "diagnostics.fcast-insample-mean", + "diagnostics.fcast-outsample-mean", "diagnostics.fcast-outsample-variance", + "diagnostics.seas-lin-f", "diagnostics.seas-lin-qs", "diagnostics.seas-lin-kw", + "diagnostics.seas-lin-friedman", "diagnostics.seas-lin-periodogram", + "diagnostics.seas-lin-spectralpeaks", "diagnostics.seas-si-combined", + "diagnostics.seas-si-evolutive", "diagnostics.seas-si-stable", + "diagnostics.seas-res-f", "diagnostics.seas-res-qs", "diagnostics.seas-res-kw", + "diagnostics.seas-res-friedman", "diagnostics.seas-res-periodogram", + "diagnostics.seas-res-spectralpeaks", "diagnostics.seas-res-combined", + "diagnostics.seas-res-combined3", "diagnostics.seas-res-evolutive", + "diagnostics.seas-res-stable", "diagnostics.seas-i-f", "diagnostics.seas-i-qs", + "diagnostics.seas-i-kw", "diagnostics.seas-i-periodogram", "diagnostics.seas-i-spectralpeaks", + "diagnostics.seas-i-combined", "diagnostics.seas-i-combined3", + "diagnostics.seas-i-evolutive", "diagnostics.seas-i-stable", + "diagnostics.seas-sa-f", "diagnostics.seas-sa-qs", "diagnostics.seas-sa-kw", + "diagnostics.seas-sa-friedman", "diagnostics.seas-sa-periodogram", + "diagnostics.seas-sa-spectralpeaks", "diagnostics.seas-sa-combined", + "diagnostics.seas-sa-combined3", "diagnostics.seas-sa-evolutive", + "diagnostics.seas-sa-stable", "diagnostics.seas-sa-ac1", "diagnostics.td-sa-all", + "diagnostics.td-sa-last", "diagnostics.td-i-all", "diagnostics.td-i-last", + "diagnostics.td-res-all", "diagnostics.td-res-last", "diagnostics.ic-ratio-henderson", + "diagnostics.ic-ratio", "diagnostics.msr-global", "diagnostics.msr(*)", + "decomposition.trendfilter", "decomposition.seasfilter", "m-statistics.m1", + "m-statistics.m2", "m-statistics.m3", "m-statistics.m4", "m-statistics.m5", + "m-statistics.m6", "m-statistics.m7", "m-statistics.m8", "m-statistics.m9", + "m-statistics.m10", "m-statistics.m11", "m-statistics.q", "m-statistics.q-m2", + "diagnostics.basic checks.definition:2", "diagnostics.basic checks.annual totals:2", + "diagnostics.visual spectral analysis.spectral seas peaks", "diagnostics.visual spectral analysis.spectral td peaks", + "diagnostics.regarima residuals.normality:2", "diagnostics.regarima residuals.independence:2", + "diagnostics.regarima residuals.spectral td peaks:2", "diagnostics.regarima residuals.spectral seas peaks:2", + "diagnostics.outliers.number of outliers:2", "diagnostics.out-of-sample.mean:2", + "diagnostics.out-of-sample.mse:2", "diagnostics.m-statistics.q:2", + "diagnostics.m-statistics.q-m2:2", "diagnostics.seats.seas variance:2", + "diagnostics.seats.irregular variance:2", "diagnostics.seats.seas/irr cross-correlation:2", + "diagnostics.residual seasonality tests.qs test on sa:2", "diagnostics.residual seasonality tests.qs test on i:2", + "diagnostics.residual seasonality tests.f-test on sa (seasonal dummies):2", + "diagnostics.residual seasonality tests.f-test on i (seasonal dummies):2", + "diagnostics.combined seasonality test.combined seasonality test on sa:2", + "diagnostics.combined seasonality test.combined seasonality test on sa (last 3 years):2", + "diagnostics.combined seasonality test.combined seasonality test on irregular:2", + "diagnostics.residual trading days tests.f-test on sa (td):2", + "diagnostics.residual trading days tests.f-test on i (td):2", + "diagnostics.quality" )) - if (is.null(getOption("default_tsmatrix_series"))) + } + if (is.null(getOption("default_tsmatrix_series"))) { options(default_tsmatrix_series = c("y", "t", "sa", "s", "i", "ycal")) - if (is.null(getOption("cruncher_bin_directory"))) + } + if (is.null(getOption("cruncher_bin_directory"))) { options(cruncher_bin_directory = "Y:/Logiciels/jwsacruncher-2.2.3/jdemetra-cli-2.2.3/bin") - + } } diff --git a/R/param_file.R b/R/param_file.R index ca89f57..7ef9fad 100644 --- a/R/param_file.R +++ b/R/param_file.R @@ -76,7 +76,9 @@ create_param_file <- function(dir_file_param = getwd(), bundle = 10000, csv_layo paths_path = NULL) { first_line <- "" param_line <- paste("", sep = "\"") + csv_separator, " ndecs=", ndecs, ">", + sep = "\"" + ) policy_line <- paste0(" ", policy, "") output_line <- matrix_lines <- tsmatrix_lines <- path_lines <- NULL @@ -87,26 +89,33 @@ create_param_file <- function(dir_file_param = getwd(), bundle = 10000, csv_layo } if (!is.null(matrix_item)) { - matrix_lines <- c(" ", - paste0(" ", matrix_item, ""), - " ") + matrix_lines <- c( + " ", + paste0(" ", matrix_item, ""), + " " + ) } if (!is.null(tsmatrix_series)) { - tsmatrix_lines <- c(" ", - paste0(" ", tsmatrix_series, ""), - " ") + tsmatrix_lines <- c( + " ", + paste0(" ", tsmatrix_series, ""), + " " + ) } if (!is.null(paths_path)) { - path_lines <- c(" ", - paste0(" ", gsub("/", "\\", paths_path, fixed = TRUE), ""), - " ") + path_lines <- c( + " ", + paste0(" ", gsub("/", "\\", paths_path, fixed = TRUE), ""), + " " + ) } - file_param <- c(first_line, param_line, policy_line, output_line, - matrix_lines, tsmatrix_lines, path_lines, - "" + file_param <- c( + first_line, param_line, policy_line, output_line, + matrix_lines, tsmatrix_lines, path_lines, + "" ) writeLines(file_param, con = paste0(dir_file_param, "/parametres.param")) return(invisible(paste0(dir_file_param, "/parametres.param"))) diff --git a/vignettes/Lancement_cruncher.Rmd b/vignettes/Lancement_cruncher.Rmd index aa7871c..eb00f7a 100644 --- a/vignettes/Lancement_cruncher.Rmd +++ b/vignettes/Lancement_cruncher.Rmd @@ -46,58 +46,73 @@ Les paramètres de la fonction `create_param_file()` sont les mêmes que ceux d 1. `policy` qui est la méthode de rafraîchissement utilisée (voir tableau ci-dessous). ```{r,echo=FALSE} -refresh_policy <- structure(list(`Option sous JDemetra+` = c("Fixed model", -"Estimate regression coefficients", -"Estimate regression coefficients + Arima parameters", -"Estimate regression coefficients + Last outliers", -"Estimate regression coefficients + all outliers", -"Estimate regression coefficients + Arima model", -"Concurrent"), `Option du cruncher` = c("current", "fixedparameters (ou fixed)", -"parameters (paramètre par défaut)", "lastoutliers", "outliers", -"stochastic", "complete ou concurrent"), Signification = c("Le modèle ARIMA, les outliers et les autres paramètres du modèle de régression ne sont ni ré-identifiés ni ré-estimés. Le schéma de décomposition est inchangé.", -"Le modèle ARIMA, les outliers et les autres paramètres du modèle regARIMA ne sont pas ré-identifiés. Les coefficients du modèle ARIMA sont fixés et les autres paramètres du modèle de régression sont ré-estimés. Le schéma de décomposition est inchangé.", -"Le modèle ARIMA, les outliers et les autres paramètres du modèle de régression ne sont pas ré-identifiés mais sont tous ré-estimés. Le schéma de décomposition est inchangé.", -"Le modèle ARIMA, les outliers (sauf ceux de la dernière année) et les autres paramètres du modèle de régression ne sont pas ré-identifiés mais sont tous ré-estimés. Les outliers de la dernière année sont ré-identifiés. Le schéma de décomposition est inchangé.", -"Le modèle ARIMA et les paramètres du modèle regARIMA autres que les outliers ne sont pas ré-identifiés mais ré-estimés. Tous les outliers sont ré-identifiés. Le schéma de décomposition est inchangé.", -"Ré-identification de tous les paramètres du modèle regARIMA hormis les variables calendaires. Le schéma de décomposition est inchangé.", -"Ré-identification de tout le modèle regARIMA.")), .Names = c("Option sous JDemetra+", -"Option du cruncher", "Signification"), class = "data.frame", row.names = c(NA, --7L)) +refresh_policy <- structure(list(`Option sous JDemetra+` = c( + "Fixed model", + "Estimate regression coefficients", + "Estimate regression coefficients + Arima parameters", + "Estimate regression coefficients + Last outliers", + "Estimate regression coefficients + all outliers", + "Estimate regression coefficients + Arima model", + "Concurrent" +), `Option du cruncher` = c( + "current", "fixedparameters (ou fixed)", + "parameters (paramètre par défaut)", "lastoutliers", "outliers", + "stochastic", "complete ou concurrent" +), Signification = c( + "Le modèle ARIMA, les outliers et les autres paramètres du modèle de régression ne sont ni ré-identifiés ni ré-estimés. Le schéma de décomposition est inchangé.", + "Le modèle ARIMA, les outliers et les autres paramètres du modèle regARIMA ne sont pas ré-identifiés. Les coefficients du modèle ARIMA sont fixés et les autres paramètres du modèle de régression sont ré-estimés. Le schéma de décomposition est inchangé.", + "Le modèle ARIMA, les outliers et les autres paramètres du modèle de régression ne sont pas ré-identifiés mais sont tous ré-estimés. Le schéma de décomposition est inchangé.", + "Le modèle ARIMA, les outliers (sauf ceux de la dernière année) et les autres paramètres du modèle de régression ne sont pas ré-identifiés mais sont tous ré-estimés. Les outliers de la dernière année sont ré-identifiés. Le schéma de décomposition est inchangé.", + "Le modèle ARIMA et les paramètres du modèle regARIMA autres que les outliers ne sont pas ré-identifiés mais ré-estimés. Tous les outliers sont ré-identifiés. Le schéma de décomposition est inchangé.", + "Ré-identification de tous les paramètres du modèle regARIMA hormis les variables calendaires. Le schéma de décomposition est inchangé.", + "Ré-identification de tout le modèle regARIMA." +)), .Names = c( + "Option sous JDemetra+", + "Option du cruncher", "Signification" +), class = "data.frame", row.names = c( + NA, + -7L +)) if (opts_knit$get("rmarkdown.pandoc.to") == "latex") { - kable(refresh_policy, caption = "Les différentes politiques de rafraîchissement", - booktabs = TRUE, format = "latex") %>% - kable_styling(full_width = T, - latex_options = "hold_position") %>% - group_rows("Partial concurrent adjustment", 1, 6) %>% - group_rows("Concurrent", 7, 7) %>% - column_spec(1, width = "4cm") %>% + kable(refresh_policy, + caption = "Les différentes politiques de rafraîchissement", + booktabs = TRUE, format = "latex" + ) %>% + kable_styling( + full_width = TRUE, + latex_options = "hold_position" + ) %>% + group_rows("Partial concurrent adjustment", 1, 6) %>% + group_rows("Concurrent", 7, 7) %>% + column_spec(1, width = "4cm") %>% column_spec(2, width = "2.5cm") -}else{ - refresh_policy[1:6, 1] <- paste("Partial concurrent adjustment ->", refresh_policy[1:6, 1]) - kable(refresh_policy, caption = "Les différentes politiques de rafraîchissement", - booktabs = TRUE) +} else { + refresh_policy[1:6, 1] <- paste("Partial concurrent adjustment ->", refresh_policy[1:6, 1]) + kable(refresh_policy, + caption = "Les différentes politiques de rafraîchissement", + booktabs = TRUE + ) } - - - ``` 2. `matrix_item` qui est une chaîne de caractères contenant les noms des paramètres à exporter. Par défaut, ce sont ceux de l'option `default_matrix_item`. On peut donc au choix modifier l'option `default_matrix_item` ou le paramètre `matrix_item` : ```{r, eval = FALSE} library("JDCruncheR") - # Pour afficher les paramètres par défaut : +# Pour afficher les paramètres par défaut : getOption("default_matrix_item") # Pour modifier les paramètres par défaut pour n'exporter par exemple # que les critères d'information : -options(default_matrix_item = c("likelihood.aic", - "likelihood.aicc", - "likelihood.bic", - "likelihood.bicc")) +options(default_matrix_item = c( + "likelihood.aic", + "likelihood.aicc", + "likelihood.bic", + "likelihood.bicc" +)) ``` 3. `tsmatrix_series` qui est une chaîne de caractères contenant les noms des paramètres à exporter. Par défaut, ce sont ceux de l'option `default_tsmatrix_series`. On peut donc au choix modifier l'option `default_tsmatrix_series` ou le paramètre `tsmatrix_series` : ```{r, eval = FALSE} - # Pour afficher les paramètres par défaut : +# Pour afficher les paramètres par défaut : getOption("default_tsmatrix_series") # Pour modifier les paramètres par défaut pour n'exporter par exemple que # la série désaisonnalisée et ses prévisions : @@ -112,17 +127,23 @@ Après cela, il ne reste plus qu'à créer le fichier de paramètres. Ci-dessous ```{r, eval = FALSE} # Un fichier parametres.param sera créé sous D:/ avec la politique de rafraîchissement # "lastoutliers" et les autres paramètres par défaut -create_param_file(dir_file_param = "D:/", - policy = "lastoutliers") +create_param_file( + dir_file_param = "D:/", + policy = "lastoutliers" +) # Si l'on a modifié les options "default_matrix_item" et "default_tsmatrix_series" pour # n'exporter que les critères d'information, la série désaisonnalisée et ses -# prévisions, la commande précédente est équivalent à : -create_param_file(dir_file_param = "D:/", - policy = "lastoutliers", - matrix_item = c("likelihood.aic", "likelihood.aicc", - "likelihood.bic", "likelihood.bicc"), - tsmatrix_series = c("sa", "sa_f")) +# prévisions, la commande précédente est équivalent à : +create_param_file( + dir_file_param = "D:/", + policy = "lastoutliers", + matrix_item = c( + "likelihood.aic", "likelihood.aicc", + "likelihood.bic", "likelihood.bicc" + ), + tsmatrix_series = c("sa", "sa_f") +) ``` @@ -147,25 +168,31 @@ La fonction `cruncher_and_param()` permet de créer un fichier temporaire de par # options de lancement du cruncher sont ceux par défaut de la fonction create_param_file(). # En particulier, les paramètres exportés sont ceux des options "default_matrix_item" # et "default_tsmatrix_series", et les résultats sortent sous D:/Campagne_CVS/Output/. -cruncher_and_param(workspace = "D:/Campagne_CVS/ipi.xml", - rename_multi_documents = FALSE, - policy = "lastoutliers") +cruncher_and_param( + workspace = "D:/Campagne_CVS/ipi.xml", + rename_multi_documents = FALSE, + policy = "lastoutliers" +) # Utilisation du paramètre "output" pour changer le dossier contenant les résultats : -cruncher_and_param(workspace = "D:/Campagne_CVS/ipi.xml", - output = "D:/Resultats campagne/", - rename_multi_documents = FALSE, - policy = "lastoutliers") +cruncher_and_param( + workspace = "D:/Campagne_CVS/ipi.xml", + output = "D:/Resultats campagne/", + rename_multi_documents = FALSE, + policy = "lastoutliers" +) # Pour modifier les noms des dossiers contenant les sorties afin qu'ils soient égaux -# aux noms des multi-documents affichés dans l'application JDemetra+, il suffit +# aux noms des multi-documents affichés dans l'application JDemetra+, il suffit # d'utiliser le paramètre "rename_multi_documents = TRUE" (valeur par défaut). # Le paramètre "delete_existing_file = TRUE" permet, lui, de supprimer les éventuels # dossiers existants portant le même nom qu'un des multi-documents. -cruncher_and_param(workspace = "D:/Campagne_CVS/ipi.xml", - rename_multi_documents = TRUE, - delete_existing_file = TRUE, - policy = "lastoutliers") +cruncher_and_param( + workspace = "D:/Campagne_CVS/ipi.xml", + rename_multi_documents = TRUE, + delete_existing_file = TRUE, + policy = "lastoutliers" +) # Pour voir les autres paramètres de la fonction : ?cruncher_and_param diff --git a/vignettes/Lancement_cruncher_pdf.Rmd b/vignettes/Lancement_cruncher_pdf.Rmd index b77a7f1..0a340c2 100644 --- a/vignettes/Lancement_cruncher_pdf.Rmd +++ b/vignettes/Lancement_cruncher_pdf.Rmd @@ -26,7 +26,7 @@ vignette: > ```{r setup, include = FALSE} knitr::opts_chunk$set( - echo = TRUE, size = "small" + echo = TRUE, size = "small" ) library("JDCruncheR") library("kableExtra") @@ -62,34 +62,46 @@ Les paramètres de la fonction `create_param_file()` sont les mêmes que ceux d 1. `policy` qui est la méthode de rafraîchissement utilisée (voir tableau ci-dessous). ```{r,echo=FALSE, eval=FALSE} -refresh_policy <- structure(list(`Option sous JDemetra+` = c("Fixed model", -"Estimate regression coefficients", -"Estimate regression coefficients + Arima parameters", -"Estimate regression coefficients + Last outliers", -"Estimate regression coefficients + all outliers", -"Estimate regression coefficients + Arima model", -"Concurrent"), `Option du cruncher` = c("current", "fixedparameters (ou fixed)", -"parameters (paramètre par défaut)", "lastoutliers", "outliers", -"stochastic", "complete ou concurrent"), Signification = c("Le modèle ARIMA, les outliers et les autres paramètres du modèle de régression ne sont ni ré-identifiés ni ré-estimés. Le schéma de décomposition est inchangé.", -"Le modèle ARIMA, les outliers et les autres paramètres du modèle regARIMA ne sont pas ré-identifiés. Les coefficients du modèle ARIMA sont fixés et les autres paramètres du modèle de régression sont ré-estimés. Le schéma de décomposition est inchangé.", -"Le modèle ARIMA, les outliers et les autres paramètres du modèle de régression ne sont pas ré-identifiés mais sont tous ré-estimés. Le schéma de décomposition est inchangé.", -"Le modèle ARIMA, les outliers (sauf ceux de la dernière année) et les autres paramètres du modèle de régression ne sont pas ré-identifiés mais sont tous ré-estimés. Les outliers de la dernière année sont ré-identifiés. Le schéma de décomposition est inchangé.", -"Le modèle ARIMA et les paramètres du modèle regARIMA autres que les outliers ne sont pas ré-identifiés mais ré-estimés. Tous les outliers sont ré-identifiés. Le schéma de décomposition est inchangé.", -"Ré-identification de tous les paramètres du modèle regARIMA hormis les variables calendaires. Le schéma de décomposition est inchangé.", -"Ré-identification de tout le modèle regARIMA.")), .Names = c("Option sous JDemetra+", -"Option du cruncher", "Signification"), class = "data.frame", row.names = c(NA, --7L)) - -kable(refresh_policy, caption = "Les différentes politiques de rafraîchissement", - booktabs = TRUE, format = "latex") %>% - kable_styling(full_width = T, - latex_options = "hold_position") %>% - group_rows("Partial concurrent adjustment", 1, 6) %>% - group_rows("Concurrent", 7, 7) %>% - column_spec(1, width = "4cm") %>% +refresh_policy <- structure(list(`Option sous JDemetra+` = c( + "Fixed model", + "Estimate regression coefficients", + "Estimate regression coefficients + Arima parameters", + "Estimate regression coefficients + Last outliers", + "Estimate regression coefficients + all outliers", + "Estimate regression coefficients + Arima model", + "Concurrent" +), `Option du cruncher` = c( + "current", "fixedparameters (ou fixed)", + "parameters (paramètre par défaut)", "lastoutliers", "outliers", + "stochastic", "complete ou concurrent" +), Signification = c( + "Le modèle ARIMA, les outliers et les autres paramètres du modèle de régression ne sont ni ré-identifiés ni ré-estimés. Le schéma de décomposition est inchangé.", + "Le modèle ARIMA, les outliers et les autres paramètres du modèle regARIMA ne sont pas ré-identifiés. Les coefficients du modèle ARIMA sont fixés et les autres paramètres du modèle de régression sont ré-estimés. Le schéma de décomposition est inchangé.", + "Le modèle ARIMA, les outliers et les autres paramètres du modèle de régression ne sont pas ré-identifiés mais sont tous ré-estimés. Le schéma de décomposition est inchangé.", + "Le modèle ARIMA, les outliers (sauf ceux de la dernière année) et les autres paramètres du modèle de régression ne sont pas ré-identifiés mais sont tous ré-estimés. Les outliers de la dernière année sont ré-identifiés. Le schéma de décomposition est inchangé.", + "Le modèle ARIMA et les paramètres du modèle regARIMA autres que les outliers ne sont pas ré-identifiés mais ré-estimés. Tous les outliers sont ré-identifiés. Le schéma de décomposition est inchangé.", + "Ré-identification de tous les paramètres du modèle regARIMA hormis les variables calendaires. Le schéma de décomposition est inchangé.", + "Ré-identification de tout le modèle regARIMA." +)), .Names = c( + "Option sous JDemetra+", + "Option du cruncher", "Signification" +), class = "data.frame", row.names = c( + NA, + -7L +)) + +kable(refresh_policy, + caption = "Les différentes politiques de rafraîchissement", + booktabs = TRUE, format = "latex" +) %>% + kable_styling( + full_width = TRUE, + latex_options = "hold_position" + ) %>% + group_rows("Partial concurrent adjustment", 1, 6) %>% + group_rows("Concurrent", 7, 7) %>% + column_spec(1, width = "4cm") %>% column_spec(2, width = "2.5cm") - - ``` \begin{table}[!h] @@ -118,19 +130,21 @@ Option sous JDemetra+ & Option du cruncher & Signification\\ 2. `matrix_item` qui est une chaîne de caractères contenant les noms des paramètres à exporter. Par défaut ce sont ceux de l'option `default_matrix_item`. On peut donc au choix modifier l'option `default_matrix_item` ou le paramètre `matrix_item` : ```{r, eval = FALSE} library("JDCruncheR") - # Pour afficher les paramètres par défaut : +# Pour afficher les paramètres par défaut : getOption("default_matrix_item") # Pour modifier les paramètres par défaut pour n'exporter par exemple # que les critères d'information : -options(default_matrix_item = c("likelihood.aic", - "likelihood.aicc", - "likelihood.bic", - "likelihood.bicc")) +options(default_matrix_item = c( + "likelihood.aic", + "likelihood.aicc", + "likelihood.bic", + "likelihood.bicc" +)) ``` 3. `tsmatrix_series` qui est une chaîne de caractères contenant les noms des paramètres à exporter. Par défaut ce sont ceux de l'option `default_tsmatrix_series`. On peut donc au choix modifier l'option `default_tsmatrix_series` ou le paramètre `tsmatrix_series` : ```{r, eval = FALSE} - # Pour afficher les paramètres par défaut : +# Pour afficher les paramètres par défaut : getOption("default_tsmatrix_series") # Pour modifier les paramètres par défaut pour n'exporter par exemple que # la série désaisonnalisées et ses prévisions : @@ -145,17 +159,23 @@ Après cela, il ne reste plus qu'à créer le fichier de paramètres. Ci-dessous ```{r, eval = FALSE} # Un fichier parametres.param sera créé sous D:/ avec la politique de rafraîchissement # "lastoutliers" et les autres paramètres par défaut -create_param_file(dir_file_param = "D:/", - policy = "lastoutliers") +create_param_file( + dir_file_param = "D:/", + policy = "lastoutliers" +) # Si l'on a modifié les options "default_matrix_item" et "default_tsmatrix_series" pour # n'exporter que les critères d'information, la série désaisonnalisée et ses -# prévisions, la commande précédente est équivalent à : -create_param_file(dir_file_param = "D:/", - policy = "lastoutliers", - matrix_item = c("likelihood.aic", "likelihood.aicc", - "likelihood.bic", "likelihood.bicc"), - tsmatrix_series = c("sa", "sa_f")) +# prévisions, la commande précédente est équivalent à : +create_param_file( + dir_file_param = "D:/", + policy = "lastoutliers", + matrix_item = c( + "likelihood.aic", "likelihood.aicc", + "likelihood.bic", "likelihood.bicc" + ), + tsmatrix_series = c("sa", "sa_f") +) ``` @@ -180,25 +200,31 @@ La fonction `cruncher_and_param()` permet de créer un fichier temporaire de par # options de lancement du cruncher sont ceux par défaut de la fonction create_param_file(). # En particulier, les paramètres exportés sont ceux des options "default_matrix_item" # et "default_tsmatrix_series", et les résultats sortent sous D:/Campagne_CVS/Output/. -cruncher_and_param(workspace = "D:/Campagne_CVS/ipi.xml", - rename_multi_documents = FALSE, - policy = "lastoutliers") +cruncher_and_param( + workspace = "D:/Campagne_CVS/ipi.xml", + rename_multi_documents = FALSE, + policy = "lastoutliers" +) # Utilisation du paramètre "output" pour changer le dossier contenant les résultats : -cruncher_and_param(workspace = "D:/Campagne_CVS/ipi.xml", - output = "D:/Resultats campagne/", - rename_multi_documents = FALSE, - policy = "lastoutliers") +cruncher_and_param( + workspace = "D:/Campagne_CVS/ipi.xml", + output = "D:/Resultats campagne/", + rename_multi_documents = FALSE, + policy = "lastoutliers" +) # Pour modifier les noms des dossiers contenant les sorties afin qu'ils soient égaux -# aux noms des multi-documents affichés dans l'application JDemetra+ il suffit +# aux noms des multi-documents affichés dans l'application JDemetra+ il suffit # d'utiliser le paramètre "rename_multi_documents = TRUE" (valeur par défaut). # Le paramètre "delete_existing_file = TRUE" permet, lui, de supprimer éventuels # dossiers existants portant le même nom qu'un des multi-documents. -cruncher_and_param(workspace = "D:/Campagne_CVS/ipi.xml", - rename_multi_documents = TRUE, - delete_existing_file = TRUE, - policy = "lastoutliers") +cruncher_and_param( + workspace = "D:/Campagne_CVS/ipi.xml", + rename_multi_documents = TRUE, + delete_existing_file = TRUE, + policy = "lastoutliers" +) # Pour voir les autres paramètres de la fonction : ?cruncher_and_param diff --git a/vignettes/Using_the_cruncher_with_JDCruncheR.Rmd b/vignettes/Using_the_cruncher_with_JDCruncheR.Rmd index 273a5b7..8ce507d 100644 --- a/vignettes/Using_the_cruncher_with_JDCruncheR.Rmd +++ b/vignettes/Using_the_cruncher_with_JDCruncheR.Rmd @@ -46,61 +46,76 @@ The arguments of the function `create_param_file()` are described in the JDemetr 1. `policy`, the refresh policy: ```{r,echo=FALSE} -refresh_policy <- structure(list(`Option in JDemetra+` = c("Current adjustment (AO approach)", -"Fixed model", -"Estimate regression coefficients", -"Estimate regression coefficients + Arima parameters", -"Estimate regression coefficients + Last outliers", -"Estimate regression coefficients + All outliers", -"Estimate regression coefficients + Arima model", -"Concurrent"), -`Cruncher options` = c("current", "fixed", "fixedparameters", "parameters (default policy)", "lastoutliers", "outliers", -"stochastic", "complete or concurrent"), -Description = c("The ARIMA model, outliers and other regression variables are not re-identified, and the values of all associated coefficients are fixed. All new observations are classified as additive outliers and corresponding coefficients are estimated during the regression phase. The transformation type remains unchanged.", -"The ARIMA model, outliers and other regression variables are not re-identified and the values of all coefficients are fixed. The transformation type remains unchanged.", -"The ARIMA model, outliers and other regression variables are not re-identified. The coefficients of the ARIMA model are fixed but the regression variables coefficients are re-estimated. The transformation type remains unchanged.", -"The ARIMA model, outliers and other regression variables are not re-identified. All coefficients of the RegARIMA model are re-estimated, for regression variables and ARIMA parameters. The transformation type remains unchanged.", -"Outliers in the last year of the sample are re-identified. All coefficients of the RegARIMA model, regression variables and ARIMA parameters, are re-estimated. The transformation type remains unchanged.", -"All outliers are re-identified. All coefficients of the RegARIMA model, regression variables and ARIMA parameters, are re-estimated. The transformation type remains unchanged.", -"Re-identification of the ARIMA model, outliers and regression variables, except the calendar variables. The transformation type remains unchanged.", -"Complete re-identification of the whole RegARIMA model, all regression variables and ARIMA model orders.")), -.Names = c("Option in JDemetra+", "Cruncher options", "Description"), class = "data.frame", row.names = c(NA, -8L)) +refresh_policy <- structure( + list( + `Option in JDemetra+` = c( + "Current adjustment (AO approach)", + "Fixed model", + "Estimate regression coefficients", + "Estimate regression coefficients + Arima parameters", + "Estimate regression coefficients + Last outliers", + "Estimate regression coefficients + All outliers", + "Estimate regression coefficients + Arima model", + "Concurrent" + ), + `Cruncher options` = c( + "current", "fixed", "fixedparameters", "parameters (default policy)", "lastoutliers", "outliers", + "stochastic", "complete or concurrent" + ), + Description = c( + "The ARIMA model, outliers and other regression variables are not re-identified, and the values of all associated coefficients are fixed. All new observations are classified as additive outliers and corresponding coefficients are estimated during the regression phase. The transformation type remains unchanged.", + "The ARIMA model, outliers and other regression variables are not re-identified and the values of all coefficients are fixed. The transformation type remains unchanged.", + "The ARIMA model, outliers and other regression variables are not re-identified. The coefficients of the ARIMA model are fixed but the regression variables coefficients are re-estimated. The transformation type remains unchanged.", + "The ARIMA model, outliers and other regression variables are not re-identified. All coefficients of the RegARIMA model are re-estimated, for regression variables and ARIMA parameters. The transformation type remains unchanged.", + "Outliers in the last year of the sample are re-identified. All coefficients of the RegARIMA model, regression variables and ARIMA parameters, are re-estimated. The transformation type remains unchanged.", + "All outliers are re-identified. All coefficients of the RegARIMA model, regression variables and ARIMA parameters, are re-estimated. The transformation type remains unchanged.", + "Re-identification of the ARIMA model, outliers and regression variables, except the calendar variables. The transformation type remains unchanged.", + "Complete re-identification of the whole RegARIMA model, all regression variables and ARIMA model orders." + ) + ), + .Names = c("Option in JDemetra+", "Cruncher options", "Description"), class = "data.frame", row.names = c(NA, -8L) +) if (opts_knit$get("rmarkdown.pandoc.to") == "latex") { - kable(refresh_policy, caption = "The refresh/revision policies", - booktabs = TRUE, format = "latex") %>% - kable_styling(full_width = T, - latex_options = "hold_position") %>% - group_rows("Current adjustment (AO approach)", 1, 1) %>% - group_rows("Partial concurrent adjustment", 2, 7) %>% - group_rows("Concurrent", 8, 8) %>% - column_spec(1, width = "4cm") %>% + kable(refresh_policy, + caption = "The refresh/revision policies", + booktabs = TRUE, format = "latex" + ) %>% + kable_styling( + full_width = TRUE, + latex_options = "hold_position" + ) %>% + group_rows("Current adjustment (AO approach)", 1, 1) %>% + group_rows("Partial concurrent adjustment", 2, 7) %>% + group_rows("Concurrent", 8, 8) %>% + column_spec(1, width = "4cm") %>% column_spec(2, width = "2.5cm") -}else{ - refresh_policy[2:7, 1] <- paste("Partial concurrent adjustment ->", refresh_policy[2:7, 1]) - kable(refresh_policy, caption = "The refresh/revision policies", - booktabs = TRUE) +} else { + refresh_policy[2:7, 1] <- paste("Partial concurrent adjustment ->", refresh_policy[2:7, 1]) + kable(refresh_policy, + caption = "The refresh/revision policies", + booktabs = TRUE + ) } - - - ``` 2. `matrix_item` is a list containing the names of the parameters to export. By default, such names are those contained in the `default_matrix_item` option. Thus, the user can either modify the `default_matrix_item` option or the `matrix_item` option: ```{r, eval = FALSE} library("JDCruncheR") - # To see the default parameters: +# To see the default parameters: getOption("default_matrix_item") # To customise the parameter selection (here, only the information criteria are exported): -options(default_matrix_item = c("likelihood.aic", - "likelihood.aicc", - "likelihood.bic", - "likelihood.bicc")) +options(default_matrix_item = c( + "likelihood.aic", + "likelihood.aicc", + "likelihood.bic", + "likelihood.bicc" +)) ``` 3. `tsmatrix_series` is a list containing the names of the parameters to export. By default, such names are those contained in the `default_tsmatrix_series` option. Thus, the user can either modify the `default_tsmatrix_series` option or the `tsmatrix_series` option: ```{r, eval = FALSE} - # To see the default parameters: +# To see the default parameters: getOption("default_tsmatrix_series") # To customise the parameter selection (here, only the seasonaly adjusted series and its previsions are exported): options(default_tsmatrix_series = c("sa", "sa_f")) @@ -112,18 +127,24 @@ To visualise all parameters that can be used to customise these options, enter ` Here are some use cases for the function `create_param_file()`: ```{r, eval = FALSE} -# A .param parameters file will be created in D:/, containing the "lastoutliers" refresh policy -# and default values for the other parameters -create_param_file(dir_file_param = "D:/", - policy = "lastoutliers") - -# To customise the "default_matrix_item" and "default_tsmatrix_series" options +# A .param parameters file will be created in D:/, containing the "lastoutliers" refresh policy +# and default values for the other parameters +create_param_file( + dir_file_param = "D:/", + policy = "lastoutliers" +) + +# To customise the "default_matrix_item" and "default_tsmatrix_series" options # to only export the information criteria, the adjusted series and its forecast: -create_param_file(dir_file_param = "D:/", - policy = "lastoutliers", - matrix_item = c("likelihood.aic", "likelihood.aicc", - "likelihood.bic", "likelihood.bicc"), - tsmatrix_series = c("sa", "sa_f")) +create_param_file( + dir_file_param = "D:/", + policy = "lastoutliers", + matrix_item = c( + "likelihood.aic", "likelihood.aicc", + "likelihood.bic", "likelihood.bicc" + ), + tsmatrix_series = c("sa", "sa_f") +) ``` @@ -144,25 +165,31 @@ The function `cruncher_and_param()` creates a temporary parameters file by calli ```{r, eval = FALSE} # Code to update the "ipi" workspace stored in D:/seasonal_adjustment/, with the refresh policy "lastoutliers". -# All other create_param_file() parameters are default ones. In particular, the exported parameters are the default +# All other create_param_file() parameters are default ones. In particular, the exported parameters are the default # "default_matrix_item" and "default_tsmatrix_series", and the output folder is D:/seasonal_adjustment/Output/. -cruncher_and_param(workspace = "D:/seasonal_adjustment/ipi.xml", - rename_multi_documents = FALSE, - policy = "lastoutliers") +cruncher_and_param( + workspace = "D:/seasonal_adjustment/ipi.xml", + rename_multi_documents = FALSE, + policy = "lastoutliers" +) # Example of customisation of the parameter "output": -cruncher_and_param(workspace = "D:/seasonal_adjustment/ipi.xml", - output = "D:/cruncher_results/", - rename_multi_documents = FALSE, - policy = "lastoutliers") - -# Here, we explicitely have "rename_multi_documents = TRUE" (which is also the default value) to rename the ouput folders -# after the SAProcessings as displayed in the JDemetra+ interface. +cruncher_and_param( + workspace = "D:/seasonal_adjustment/ipi.xml", + output = "D:/cruncher_results/", + rename_multi_documents = FALSE, + policy = "lastoutliers" +) + +# Here, we explicitely have "rename_multi_documents = TRUE" (which is also the default value) to rename the ouput folders +# after the SAProcessings as displayed in the JDemetra+ interface. # With parameter "delete_existing_file = TRUE", all pre-existing versions of such folders are deleted before the export. -cruncher_and_param(workspace = "D:/Campagne_CVS/ipi.xml", - rename_multi_documents = TRUE, - delete_existing_file = TRUE, - policy = "lastoutliers") +cruncher_and_param( + workspace = "D:/Campagne_CVS/ipi.xml", + rename_multi_documents = TRUE, + delete_existing_file = TRUE, + policy = "lastoutliers" +) # To see all the function parameters: ?cruncher_and_param diff --git a/vignettes/Using_the_cruncher_with_JDCruncheR_pdf.Rmd b/vignettes/Using_the_cruncher_with_JDCruncheR_pdf.Rmd index 047ef11..4d1fc52 100644 --- a/vignettes/Using_the_cruncher_with_JDCruncheR_pdf.Rmd +++ b/vignettes/Using_the_cruncher_with_JDCruncheR_pdf.Rmd @@ -26,7 +26,7 @@ vignette: > ```{r setup, include = FALSE} knitr::opts_chunk$set( - echo = TRUE, size = "small" + echo = TRUE, size = "small" ) library("JDCruncheR") library("kableExtra") @@ -62,37 +62,49 @@ The arguments of the function `create_param_file()` are described in the JDemetr 1. `policy`, the refresh policy: ```{r,echo=FALSE, eval=FALSE} -refresh_policy <- structure(list(`Option in JDemetra+` = c("Current adjustment (AO approach)", -"Fixed model", -"Estimate regression coefficients", -"Estimate regression coefficients + Arima parameters", -"Estimate regression coefficients + Last outliers", -"Estimate regression coefficients + All outliers", -"Estimate regression coefficients + Arima model", -"Concurrent"), -`Cruncher options` = c("current", "fixed", "fixedparameters", "parameters (default policy)", "lastoutliers", "outliers", -"stochastic", "complete or concurrent"), -Description = c("The ARIMA model, outliers and other regression variables are not re-identified, and the values of all associated coefficients are fixed. All new observations are classified as additive outliers and corresponding coefficients are estimated during the regression phase. The transformation type remains unchanged.", -"The ARIMA model, outliers and other regression variables are not re-identified and the values of all coefficients are fixed. The transformation type remains unchanged.", -"The ARIMA model, outliers and other regression variables are not re-identified. The coefficients of the ARIMA model are fixed but the regression variables coefficients are re-estimated. The transformation type remains unchanged.", -"The ARIMA model, outliers and other regression variables are not re-identified. All coefficients of the RegARIMA model are re-estimated, for regression variables and ARIMA parameters. The transformation type remains unchanged.", -"Outliers in the last year of the sample are re-identified. All coefficients of the RegARIMA model, regression variables and ARIMA parameters, are re-estimated. The transformation type remains unchanged.", -"All outliers are re-identified. All coefficients of the RegARIMA model, regression variables and ARIMA parameters, are re-estimated. The transformation type remains unchanged.", -"Re-identification of the ARIMA model, outliers and regression variables, except the calendar variables. The transformation type remains unchanged.", -"Complete re-identification of the whole RegARIMA model, all regression variables and ARIMA model orders.")), -.Names = c("Option in JDemetra+", "Cruncher option", "Description"), class = "data.frame", row.names = c(NA, -7L)) - -kable(refresh_policy, caption = "The refresh/revision policies", - booktabs = TRUE, format = "latex") %>% - kable_styling(full_width = T, - latex_options = "hold_position") %>% - group_rows("Current adjustment (AO approach)", 1, 1) %>% - group_rows("Partial concurrent adjustment", 2, 7) %>% - group_rows("Concurrent", 8, 8) %>% - column_spec(1, width = "4cm") %>% - column_spec(2, width = "2.5cm") - +refresh_policy <- structure( + list( + `Option in JDemetra+` = c( + "Current adjustment (AO approach)", + "Fixed model", + "Estimate regression coefficients", + "Estimate regression coefficients + Arima parameters", + "Estimate regression coefficients + Last outliers", + "Estimate regression coefficients + All outliers", + "Estimate regression coefficients + Arima model", + "Concurrent" + ), + `Cruncher options` = c( + "current", "fixed", "fixedparameters", "parameters (default policy)", "lastoutliers", "outliers", + "stochastic", "complete or concurrent" + ), + Description = c( + "The ARIMA model, outliers and other regression variables are not re-identified, and the values of all associated coefficients are fixed. All new observations are classified as additive outliers and corresponding coefficients are estimated during the regression phase. The transformation type remains unchanged.", + "The ARIMA model, outliers and other regression variables are not re-identified and the values of all coefficients are fixed. The transformation type remains unchanged.", + "The ARIMA model, outliers and other regression variables are not re-identified. The coefficients of the ARIMA model are fixed but the regression variables coefficients are re-estimated. The transformation type remains unchanged.", + "The ARIMA model, outliers and other regression variables are not re-identified. All coefficients of the RegARIMA model are re-estimated, for regression variables and ARIMA parameters. The transformation type remains unchanged.", + "Outliers in the last year of the sample are re-identified. All coefficients of the RegARIMA model, regression variables and ARIMA parameters, are re-estimated. The transformation type remains unchanged.", + "All outliers are re-identified. All coefficients of the RegARIMA model, regression variables and ARIMA parameters, are re-estimated. The transformation type remains unchanged.", + "Re-identification of the ARIMA model, outliers and regression variables, except the calendar variables. The transformation type remains unchanged.", + "Complete re-identification of the whole RegARIMA model, all regression variables and ARIMA model orders." + ) + ), + .Names = c("Option in JDemetra+", "Cruncher option", "Description"), class = "data.frame", row.names = c(NA_integer_, -7L) +) +kable(refresh_policy, + caption = "The refresh/revision policies", + booktabs = TRUE, format = "latex" +) %>% + kable_styling( + full_width = TRUE, + latex_options = "hold_position" + ) %>% + group_rows("Current adjustment (AO approach)", 1, 1) %>% + group_rows("Partial concurrent adjustment", 2, 7) %>% + group_rows("Concurrent", 8, 8) %>% + column_spec(1, width = "4cm") %>% + column_spec(2, width = "2.5cm") ``` \begin{table}[!h] @@ -125,10 +137,12 @@ library("JDCruncheR") # To see the default parameters: getOption("default_matrix_item") # To customise the parameter selection (here, only the information criteria are exported): -options(default_matrix_item = c("likelihood.aic", - "likelihood.aicc", - "likelihood.bic", - "likelihood.bicc")) +options(default_matrix_item = c( + "likelihood.aic", + "likelihood.aicc", + "likelihood.bic", + "likelihood.bicc" +)) ``` 3. `tsmatrix_series`, a list containing the names of the parameters to export. By default, such names are those contained in the `default_tsmatrix_series` option. Thus, the user can either modify the `default_tsmatrix_series` option or the `tsmatrix_series` option: @@ -145,18 +159,24 @@ To visualise all parameters that can be used to customise these options, enter ` Here are some use cases for the function `create_param_file()`: ```{r, eval = FALSE} -# A .param parameters file will be created in D:/, containing the "lastoutliers" refresh policy -# and default values for the other parameters -create_param_file(dir_file_param = "D:/", - policy = "lastoutliers") +# A .param parameters file will be created in D:/, containing the "lastoutliers" refresh policy +# and default values for the other parameters +create_param_file( + dir_file_param = "D:/", + policy = "lastoutliers" +) -# To customise the "default_matrix_item" and "default_tsmatrix_series" options +# To customise the "default_matrix_item" and "default_tsmatrix_series" options # to only export the information criteria, the adjusted series and its forecast: -create_param_file(dir_file_param = "D:/", - policy = "lastoutliers", - matrix_item = c("likelihood.aic", "likelihood.aicc", - "likelihood.bic", "likelihood.bicc"), - tsmatrix_series = c("sa", "sa_f")) +create_param_file( + dir_file_param = "D:/", + policy = "lastoutliers", + matrix_item = c( + "likelihood.aic", "likelihood.aicc", + "likelihood.bic", "likelihood.bicc" + ), + tsmatrix_series = c("sa", "sa_f") +) ``` @@ -177,25 +197,31 @@ The function `cruncher_and_param()` creates a temporary parameters file by calli ```{r, eval = FALSE} # Code to update the "ipi" workspace stored in D:/seasonal_adjustment/, with the refresh policy "lastoutliers". -# All other create_param_file() parameters are default ones. In particular, the exported parameters are the default +# All other create_param_file() parameters are default ones. In particular, the exported parameters are the default # "default_matrix_item" and "default_tsmatrix_series", and the output folder is D:/seasonal_adjustment/Output/. -cruncher_and_param(workspace = "D:/seasonal_adjustment/ipi.xml", - rename_multi_documents = FALSE, - policy = "lastoutliers") +cruncher_and_param( + workspace = "D:/seasonal_adjustment/ipi.xml", + rename_multi_documents = FALSE, + policy = "lastoutliers" +) # Example of customisation of the parameter "output": -cruncher_and_param(workspace = "D:/seasonal_adjustment/ipi.xml", - output = "D:/cruncher_results/", - rename_multi_documents = FALSE, - policy = "lastoutliers") +cruncher_and_param( + workspace = "D:/seasonal_adjustment/ipi.xml", + output = "D:/cruncher_results/", + rename_multi_documents = FALSE, + policy = "lastoutliers" +) -# Here, we explicitely have "rename_multi_documents = TRUE" (which is also the default value) to rename the ouput folders -# after the SAProcessings as displayed in the JDemetra+ interface. +# Here, we explicitely have "rename_multi_documents = TRUE" (which is also the default value) to rename the ouput folders +# after the SAProcessings as displayed in the JDemetra+ interface. # With parameter "delete_existing_file = TRUE", all pre-existing versions of such folders are deleted before the export. -cruncher_and_param(workspace = "D:/Campagne_CVS/ipi.xml", - rename_multi_documents = TRUE, - delete_existing_file = TRUE, - policy = "lastoutliers") +cruncher_and_param( + workspace = "D:/Campagne_CVS/ipi.xml", + rename_multi_documents = TRUE, + delete_existing_file = TRUE, + policy = "lastoutliers" +) # To see all the function parameters: ?cruncher_and_param From 9b3e1e0ddeea24a2bfb80d83a5848e53442ac68e Mon Sep 17 00:00:00 2001 From: Tanguy BARTHELEMY Date: Fri, 26 Jan 2024 10:50:30 +0100 Subject: [PATCH 3/6] add lint workflow --- .github/workflows/lint.yaml | 32 ++++++++++++++++++++++++++++++++ .lintr | 8 ++++++++ 2 files changed, 40 insertions(+) create mode 100644 .github/workflows/lint.yaml create mode 100644 .lintr diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml new file mode 100644 index 0000000..f4c4ef2 --- /dev/null +++ b/.github/workflows/lint.yaml @@ -0,0 +1,32 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master] + pull_request: + branches: [main, master] + +name: lint + +jobs: + lint: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: + - uses: actions/checkout@v3 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::lintr, local::. + needs: lint + + - name: Lint + run: lintr::lint_package() + shell: Rscript {0} + env: + LINTR_ERROR_ON_LINT: true diff --git a/.lintr b/.lintr new file mode 100644 index 0000000..9f643c3 --- /dev/null +++ b/.lintr @@ -0,0 +1,8 @@ +linters: linters_with_defaults( + object_name_linter = NULL, + cyclocomp_linter = NULL, + line_length_linter = NULL, + commented_code_linter = NULL, + indentation_linter(indent = 4L) + ) +encoding: "UTF-8" From 46c04e8e274fd7dcbae3b9290cace4c85e2892d6 Mon Sep 17 00:00:00 2001 From: Tanguy BARTHELEMY Date: Fri, 26 Jan 2024 10:50:47 +0100 Subject: [PATCH 4/6] update R project parameters --- JDCruncheR.Rproj | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/JDCruncheR.Rproj b/JDCruncheR.Rproj index bfa3107..7e81b12 100644 --- a/JDCruncheR.Rproj +++ b/JDCruncheR.Rproj @@ -2,7 +2,7 @@ Version: 1.0 RestoreWorkspace: No SaveWorkspace: No -AlwaysSaveHistory: Default +AlwaysSaveHistory: No EnableCodeIndexing: Yes UseSpacesForTab: Yes @@ -19,3 +19,5 @@ BuildType: Package PackageUseDevtools: Yes PackageInstallArgs: --no-multiarch --with-keep.source PackageRoxygenize: rd,collate,namespace + +UseNativePipeOperator: Yes From 08292dce252539b5d338ef69d1432df893e0addc Mon Sep 17 00:00:00 2001 From: Tanguy BARTHELEMY Date: Fri, 26 Jan 2024 10:51:02 +0100 Subject: [PATCH 5/6] update readme with installation links --- README.Rmd | 64 +++++++++++++++++++++++++++++++++++++++++------------- README.md | 55 +++++++++++++++++++++++++++++++++++++++------- 2 files changed, 96 insertions(+), 23 deletions(-) diff --git a/README.Rmd b/README.Rmd index 9aca716..8914814 100644 --- a/README.Rmd +++ b/README.Rmd @@ -6,16 +6,17 @@ output: github_document ```{r, echo = FALSE} knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>", - fig.path = "README-", - fig.align="center" + collapse = TRUE, + comment = "#>", + fig.align = "center", + fig.path = "README-" ) ``` # `JDCruncheR` [![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/JDCruncheR)](https://cran.r-project.org/package=JDCruncheR) +[![Linting code](https://github.com/InseeFr/JDCruncheR/actions/workflows/lint.yaml/badge.svg)](https://github.com/InseeFr/JDCruncheR/actions/workflows/lint.yaml) ## Français 🇫🇷 @@ -27,19 +28,36 @@ Avec `JDCruncheR`, vous pouvez aussi générer des *bilans qualité* utilisant l ### Installation -Il y a 2 méthodes d'installation du package `JDCruncheR` : - -- utiliser le package `remotes` : +Pour obtenir la version en cours de développement depuis GitHub : + +```{r fr-gh-devel-installation, eval = FALSE} +# Si le package remotes n'est pas installé +# install.packages("remotes") + +# Installer la version en cours de développement depuis GitHub +remotes::install_github("InseeFr/JDCruncheR") +``` + +Pour obtenir la dernière release stable du package, il y a 2 méthodes d'installation du package `JDCruncheR` : -``` r +- directement depuis GitHub : + +```{r fr-gh-stable-installation, eval = FALSE} +# Si le package remotes n'est pas installé # install.packages("remotes") -remotes::install_github("InseeFr/JDCruncheR", build_vignettes = TRUE) + +# Installer la dernière version stable disponible sur GitHub +remotes::install_github("InseeFr/JDCruncheR@*release") + +# Sur les ordinateurs Insee +install.packages("JDCruncheR", repos = "https://nexus.insee.fr/repository/r-public/") ``` - depuis le dossier compressé **.zip** ou **.tar.gz**, qui peuvent être trouvés ici : https://github.com/InseeFr/JDCruncheR/releases. Pour plus d'informations sur l'installation et la configuration du package `JDCruncheR`, vous pouvez visiter la page [wiki](https://github.com/jdemetra/jwsacruncher/wiki) Pour une description plus complète des packages R pour JDemetra+ voir le document de travail Insee [Les packages R pour JDemetra+ : une aide à la désaisonnalisation](https://www.insee.fr/fr/statistiques/5019786) + ## English 🇬🇧 ### Overview @@ -50,15 +68,31 @@ With `JDCruncheR`, you can also generate a *quality report* based on the crunche ### Installation -There are two ways to install the `JDCruncheR` package: - -- using the `remotes` package: +To get the current development version from GitHub: + +```{r en-gh-devel-installation, eval = FALSE} +# If remotes packages is not installed +# install.packages("remotes") + +# Install development version from GitHub +remotes::install_github("InseeFr/JDCruncheR") +``` + +To get the current stable version (from the latest release), there are two ways to install the `JDCruncheR` package: -``` r +- directly from GitHub : + +```{r en-gh-stable-installation, eval = FALSE} +# If remotes packages is not installed # install.packages("remotes") -remotes::install_github("InseeFr/JDCruncheR", build_vignettes = TRUE) + +# Install the last stable release from GitHub +remotes::install_github("InseeFr/JDCruncheR@*release") + +# on Insee computer +install.packages("JDCruncheR", repos = "https://nexus.insee.fr/repository/r-public/") ``` -- from the **.zip** or **.tar.gz** file, that can both be found here: . +- from the **.zip** or **.tar.gz** compressed folder, that can both be found here: : https://github.com/InseeFr/JDCruncheR/releases. For more informations on installing and configuring the `JDCruncheR` package, you can visit the [wiki](https://github.com/jdemetra/jwsacruncher/wiki) page. For a more comprehensive description of the R packages for JDemetra+ check the Insee working paper [R Tools for JDemetra+: Seasonal adjustment made easier](https://www.insee.fr/en/statistiques/5019812) diff --git a/README.md b/README.md index fb90bcd..c7a0362 100644 --- a/README.md +++ b/README.md @@ -4,6 +4,8 @@ # `JDCruncheR` [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/JDCruncheR)](https://cran.r-project.org/package=JDCruncheR) +[![Linting +code](https://github.com/InseeFr/JDCruncheR/actions/workflows/lint.yaml/badge.svg)](https://github.com/InseeFr/JDCruncheR/actions/workflows/lint.yaml) ## Français 🇫🇷 @@ -25,13 +27,30 @@ très utile lorsqu’on a beaucoup de séries à désaisonnaliser. ### Installation -Il y a 2 méthodes d’installation du package `JDCruncheR` : +Pour obtenir la version en cours de développement depuis GitHub : -- utiliser le package `remotes` : +``` r +# Si le package remotes n'est pas installé +# install.packages("remotes") + +# Installer la version en cours de développement depuis GitHub +remotes::install_github("InseeFr/JDCruncheR") +``` + +Pour obtenir la dernière release stable du package, il y a 2 méthodes +d’installation du package `JDCruncheR` : + +- directement depuis GitHub : ``` r +# Si le package remotes n'est pas installé # install.packages("remotes") -remotes::install_github("InseeFr/JDCruncheR", build_vignettes = TRUE) + +# Installer la dernière version stable disponible sur GitHub +remotes::install_github("InseeFr/JDCruncheR@*release") + +# Sur les ordinateurs Insee +install.packages("JDCruncheR", repos = "https://nexus.insee.fr/repository/r-public/") ``` - depuis le dossier compressé **.zip** ou **.tar.gz**, qui peuvent être @@ -64,17 +83,37 @@ This is most useful when dealing with a large number of series. ### Installation -There are two ways to install the `JDCruncheR` package: +To get the current development version from GitHub: -- using the `remotes` package: +``` r +# If remotes packages is not installed +# install.packages("remotes") + +# Install development version from GitHub +remotes::install_github("InseeFr/JDCruncheR") +``` + +To get the current stable version (from the latest release), there are +two ways to install the `JDCruncheR` package: + +- directly from GitHub : ``` r +# If remotes packages is not installed # install.packages("remotes") -remotes::install_github("InseeFr/JDCruncheR", build_vignettes = TRUE) + +# Install the last stable release from GitHub +remotes::install_github("InseeFr/JDCruncheR@*release") + +# on Insee computer +install.packages("JDCruncheR", repos = "https://nexus.insee.fr/repository/r-public/") ``` -- from the **.zip** or **.tar.gz** file, that can both be found here: - . +- from the **.zip** or **.tar.gz** compressed folder, that can both be + found here: : . For + more informations on installing and configuring the `JDCruncheR` + package, you can visit the + [wiki](https://github.com/jdemetra/jwsacruncher/wiki) page. For a more comprehensive description of the R packages for JDemetra+ check the Insee working paper [R Tools for JDemetra+: Seasonal From bba07ce77373cb65885c31235b92784ce17280ef Mon Sep 17 00:00:00 2001 From: Tanguy BARTHELEMY Date: Fri, 26 Jan 2024 10:51:56 +0100 Subject: [PATCH 6/6] update yaml with test R 4.2.3 --- .github/workflows/R-CMD-check.yaml | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index be56c5a..102967c 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -18,7 +18,7 @@ jobs: fail-fast: false matrix: os: [ 'ubuntu-latest', 'windows-latest', 'macOS-latest' ] - r: [ 'devel', 'release', 'oldrel-1', '4.2.1', '4.1.1', '4.1.3', '3.6.1' ] + r: [ 'devel', 'release', 'oldrel-1', '4.2.3', '4.2.1', '4.1.1', '4.1.3', '4.0.5', '3.6.1' ] java: [ '8', '13', '17', '19' ] # java: [ '8', '9', '10', '11', '12', '13', '14', '15', '16', '17', '18', '19' ] include: @@ -33,7 +33,7 @@ jobs: # - {os: ubuntu-latest, r: '3.6.1'} # - {os: ubuntu-latest, r: '4.1.3'} # - {os: ubuntu-latest, r: '4.1.1'} - # - {os: ubuntu-latest, r: '4.2.1'} + # - {os: ubuntu-latest, r: '4.2.1'} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} @@ -43,7 +43,7 @@ jobs: - uses: actions/checkout@v3 - uses: r-lib/actions/setup-pandoc@v2 - + - name: Setup java (x64) uses: actions/setup-java@v3 if: matrix.java != '19' @@ -52,7 +52,7 @@ jobs: java-package: jdk distribution: 'zulu' architecture: x64 - + - name: Setup java (x64) uses: actions/setup-java@v3 if: matrix.java == '19' @@ -61,7 +61,7 @@ jobs: java-package: jdk distribution: 'temurin' architecture: x64 - + - name: Setup java (x86) uses: actions/setup-java@v3 if: runner.os == 'windows' && matrix.java != '19' @@ -70,7 +70,7 @@ jobs: java-package: jdk distribution: 'zulu' architecture: x86 - + - name: Setup java (x86) uses: actions/setup-java@v3 if: runner.os == 'windows' && matrix.java == '19' @@ -79,14 +79,14 @@ jobs: java-package: jdk distribution: 'temurin' architecture: x86 - + - name: Set up R uses: r-lib/actions/setup-r@v2 with: r-version: ${{ matrix.r }} http-user-agent: ${{ matrix.http-user-agent }} use-public-rspm: true - + # Pour macos, qqs installation supplémentaires - name: "[Stage] [macOS] Install libgit2" if: runner.os == 'macOS' @@ -95,7 +95,7 @@ jobs: - name: "[Stage] [macOS] Install system libs for pkgdown" if: runner.os == 'macOS' run: brew install harfbuzz fribidi - + - name: Configure java pour macos if: runner.os == 'macOS' run: R CMD javareconf @@ -105,7 +105,7 @@ jobs: if: ${{ runner.os != 'macOS' }} with: extra-packages: any::rcmdcheck, XML - + # Pour macos, qqs installation supplémentaires - name: Install dependencies uses: r-lib/actions/setup-r-dependencies@v2 @@ -113,19 +113,18 @@ jobs: with: packages: knitr, kableExtra, rmarkdown extra-packages: any::rcmdcheck, XML, XLConnect - + # Pour macos, qqs installation supplémentaires - name: Build site run: install.packages('textshaping') shell: Rscript {0} if: ${{ runner.os == 'macOS' && matrix.r == 'devel' }} - - # Pour macos, qqs installation supplémentaires + - name: Build site run: install.packages('systemfonts') shell: Rscript {0} if: ${{ runner.os == 'macOS' && matrix.r == '3.6.1' }} - + - uses: r-lib/actions/setup-tinytex@v2 - + - uses: r-lib/actions/check-r-package@v2