Merge pull request #37 from TanguyBarthelemy/master

Requirements for CRAN

.github/workflows/rjava.yaml

@@ -1,10 +1,7 @@
 # Workflow derived from https://github.com/r-lib/actions/tree/master/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]
+on:
+  workflow_dispatch
 
 name: rjava
 
@@ -33,14 +30,14 @@ jobs:
 
     steps:
       - uses: actions/checkout@v4
-    
+
       # Set-up java
       - name: Setup java
         uses: actions/setup-java@v4
         with:
           java-version: ${{ matrix.java }}
           distribution: 'zulu'
-          
+
       # Set up R
       - uses: r-lib/actions/setup-r@v2
         with:

.gitignore

@@ -53,3 +53,9 @@ rsconnect/
 
 # Hidden file from mac-os
 .DS_Store
+
+# produced README.html
+README.html
+
+# produced README.html
+README.html

DESCRIPTION

@@ -2,21 +2,26 @@ Package: rjdworkspace
 Type: Package
 Title: Manipulate 'JDemetra+' Workspaces
 Version: 1.1.7
-Authors@R: 
-    c(person(given = "Alain",
-             family = "Quartier-la-Tente",
-             role = c("aut"),
-             email = "alain.quartier-la-tente@insee.fr"),
-      person(given = "Institut national de la statistique et des études économiques",
-             role = "cph",
-             comment = "https://www.insee.fr/"),
+Authors@R: c(
     person(given = "Tanguy", 
-           family = "Barthelemy", role = c("aut", "cre"),
+           family = "Barthelemy", role = c("aut", "cre", "art"),
            email ="tanguy.barthelemy@insee.fr"),
+    person(given = "Alain",
+           family = "Quartier-la-Tente",
+           role = c("aut"),
+           email = "alain.quartier-la-tente@insee.fr",
+           comment = c(ORCID = "0000-0001-7890-3857")),
+    person(given = "Institut national de la statistique et des études économiques",
+           role = "cph",
+           comment = "https://www.insee.fr/"),
     person(given = "Anna", 
            family = "Smyk", role = c("aut"),
            email ="anna.smyk@insee.fr"))
 Description: Set of tools to manipulate the 'JDemetra+' workspaces.
+    Based on the 'RJDemetra' package (which interfaces with version 2 of the 'JDemetra+' (<https://github.com/jdemetra/jdemetra-app>), the seasonal adjustment software officially
+    recommended to the members of the European Statistical System (ESS) and the European System of Central Banks).
+    This package provides access to additional workspace manipulation functions such as metadata manipulation, raw paths and wrangling of several workspaces simultaneously. 
+    These additional functionalities are useful as part of a CVS data production chain.
 Depends:
     R (>= 3.1.1)
 Imports:

NAMESPACE

@@ -5,6 +5,7 @@ S3method(get_comment,sa_item)
 S3method(get_comment,workspace)
 S3method(set_comment,sa_item)
 export(add_new_sa_item)
+export(copy_ws)
 export(get_comment)
 export(remove_all_sa_item)
 export(remove_sa_item)

R/copy_ws.R

@@ -1,44 +1,74 @@
 #' Copy a WS
 #'
-#' @param path_ws the path to the folder containing the WS
-#' (the XML file + the WS folder)
-#' @param new_path the path to the new folder which will contains the WS
-#' (the XML file + the WS folder)
 #' @param ws_name the name of the WS
+#' @param from the path to the folder containing the WS (the XML file + the WS
+#' folder)
+#' @param to the path to the new folder which will contains the WS (the XML
+#' file + the WS folder)
+#' @param overwrite Overwrite existing file (Defaults to TRUE)
+#' @param verbose A boolean to print indications on the processing status
+#' (optional and TRUE by default)
 #'
-#' @return TRUE
+#' @export
 #'
-#' @examples
+#' @returns the function returns invisibly (with \code{invisible()}) a boolean
+#' specifying if the transfer was done or an error if the specified paths or
+#' workspace don't exists
 #'
+#' @examples
 #' # Déplacement d'un WS dans un environnement temporaire
-#' rjdworkspace:::copy_ws(
+#' destination_dir <- tempdir()
+#'
+#' # Copy of a worspace in a temporary environment
+#' copy_ws(
 #'   ws_name = "ws_output",
-#'   path_ws = file.path(system.file("extdata", package = "rjdworkspace"), "WS")
+#'   from = file.path(system.file("extdata", package = "rjdworkspace"), "WS"),
+#'   to = destination_dir
 #' )
 #'
-copy_ws <- function(ws_name, path_ws, new_path = tempdir()) {
-    path_ws <- normalizePath(path_ws)
-    new_path <- normalizePath(new_path)
+copy_ws <- function(ws_name,
+                    from,
+                    to = tempdir(),
+                    overwrite = TRUE,
+                    verbose = TRUE) {
+
+    from <- normalizePath(from, mustWork = TRUE)
+    to <- normalizePath(to, mustWork = TRUE)
 
-    dir_path <- normalizePath(file.path(path_ws, ws_name))
-    xml_path <- normalizePath(file.path(path_ws, paste0(ws_name, ".xml")))
+    from_ws_dir <- normalizePath(file.path(from, ws_name), mustWork = TRUE)
+    from_ws_xml <- normalizePath(file.path(from, paste0(ws_name, ".xml")), mustWork = TRUE)
 
-    if (!(dir.exists(dir_path) && file.exists(xml_path))) {
-        stop("Le WS n'existe pas.")
+    to_ws_dir <- normalizePath(file.path(to, ws_name), mustWork = FALSE)
+    to_ws_xml <- normalizePath(file.path(to, paste0(ws_name, ".xml")), mustWork = FALSE)
+
+    if ((dir.exists(to_ws_dir) && file.exists(to_ws_xml))) {
+        message("A workspace already exists in the destination folder.")
+        if (overwrite) {
+            unlink(to_ws_dir, recursive = TRUE, force = TRUE)
+            unlink(to_ws_xml, recursive = TRUE, force = TRUE)
+            message("It will be rewritten.")
+        } else {
+            message("it will not be rewritten.")
+            return(invisible(FALSE))
+        }
     }
 
     file.copy(
-        from = dir_path,
-        to = new_path,
+        from = from_ws_dir,
+        to = to,
         recursive = TRUE,
         overwrite = TRUE
     )
     file.copy(
-        from = xml_path,
-        to = new_path,
+        from = from_ws_xml,
+        to = to,
         recursive = TRUE,
         overwrite = TRUE
     )
 
-    return(TRUE)
+    if (verbose) {
+        cat(" Successful copy!\n")
+    }
+
+    return(invisible(TRUE))
 }

R/manip_sa_item.R

@@ -6,6 +6,9 @@
 #' @param pos the index of the `sa_item` to remove or to replace.
 #' @param sa_item `sa_item` object.
 #'
+#' @returns The functions \code{remove_sa_item()}, \code{remove_all_sa_item()} and \code{replace_sa_item()} return invisibly (with \code{invisible()}) \code{TRUE} or an error.
+#' The function \code{add_new_sa_item()} returns invisibly (with \code{invisible()}) the updated `SA-Item`.
+#'
 #' @name manipulate_sa_item
 #' @rdname manipulate_sa_item
 #' @examples

R/metadata.R

@@ -14,6 +14,8 @@
 #' Both functions create and return a new workspace containing
 #' the updated series.
 #'
+#' @returns the updated `workspace`
+#'
 #' @examples
 #'
 #' library("RJDemetra")
@@ -44,8 +46,10 @@
 #' @rdname update_metadata
 #' @export
 update_metadata <- function(ws_from, ws_to) {
+
     # ws1 <- RJDemetra::load_workspace(ws_from)
     # ws2 <- RJDemetra::load_workspace(ws_to)
+
     all_sap_ws_from <- RJDemetra::get_all_objects(ws_from)
     all_sap_ws_from_names <- names(all_sap_ws_from)
 
@@ -55,12 +59,11 @@ update_metadata <- function(ws_from, ws_to) {
         sap_ws_from_i <- which(all_sap_ws_from_names %in% sap_name)
         if (length(sap_ws_from_i) > 0) {
             if (length(sap_ws_from_i) > 1) {
-                warning(paste(
+                warning(
                     "At least 2 SA-Processings called",
                     sap_name,
                     "were found in the ws_from: the first object will be used"
                 )
-                )
             }
 
             sap_ws_from <- all_sap_ws_from[[sap_ws_from_i[1]]]
@@ -215,7 +218,25 @@ set_metadata <- function(sa_from, sa_to) {
 #'
 #' @param x the object from which the comments are retrieved.
 #'
+#' @returns A string or list of string with all the comment contained in a SA-Item, a SA-Processing or a workspace (depending on the argument \code{x}).
 #' @export
+#'
+#' @examples
+#'
+#' library("RJDemetra")
+#' ws_dir <- file.path(system.file("extdata", package = "rjdworkspace"), "WS")
+#'
+#' path_ws_to <- file.path(ws_dir, "ws_output.xml")
+#'
+#' ws_output <- load_workspace(path_ws_to)
+#' print(get_comment(ws_output))
+#'
+#' sap_output <- get_object(ws_output, pos = 3)
+#' print(get_comment(sap_output))
+#'
+#' sa_item <- get_object(sap_output, pos = 3)
+#' print(get_comment(sa_item))
+#'
 get_comment <- function(x) {
     UseMethod("get_comment", x)
 }