Merge pull request #27 from SticsRPacks/setup-flint-action

Create style.yaml
SticsRPacks · Dec 11, 2024 · ce5f295 · ce5f295
2 parents b784b05 + 2e6411d
commit ce5f295
Show file tree

Hide file tree

Showing 35 changed files with 629 additions and 404 deletions.
diff --git a/.github/workflows/style.yaml b/.github/workflows/style.yaml
@@ -0,0 +1,85 @@
+# 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:
+  pull_request:
+    paths:
+      [
+        "**.[rR]",
+        "**.[qrR]md",
+        "**.[rR]markdown",
+        "**.[rR]nw",
+        "**.[rR]profile",
+      ]
+  workflow_dispatch:
+
+name: style
+
+permissions: read-all
+
+jobs:
+  style:
+    runs-on: ubuntu-latest
+    permissions:
+      contents: write
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+      - name: Checkout repo
+        uses: actions/checkout@v4
+        with:
+          fetch-depth: 0
+
+      - name: Setup R
+        uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - name: Install dependencies
+        uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::styler, any::roxygen2
+          needs: styler
+
+      - name: Enable styler cache
+        run: styler::cache_activate()
+        shell: Rscript {0}
+
+      - name: Determine cache location
+        id: styler-location
+        run: |
+          cat(
+            "location=",
+            styler::cache_info(format = "tabular")$location,
+            "\n",
+            file = Sys.getenv("GITHUB_OUTPUT"),
+            append = TRUE,
+            sep = ""
+          )
+        shell: Rscript {0}
+
+      - name: Cache styler
+        uses: actions/cache@v4
+        with:
+          path: ${{ steps.styler-location.outputs.location }}
+          key: ${{ runner.os }}-styler-${{ github.sha }}
+          restore-keys: |
+            ${{ runner.os }}-styler-
+            ${{ runner.os }}-
+
+      - name: Style
+        run: styler::style_pkg()
+        shell: Rscript {0}
+
+      - name: Commit and push changes
+        run: |
+          if FILES_TO_COMMIT=($(git diff-index --name-only ${{ github.sha }} \
+              | egrep --ignore-case '\.(R|[qR]md|Rmarkdown|Rnw|Rprofile)$'))
+          then
+            git config --local user.name "$GITHUB_ACTOR"
+            git config --local user.email "[email protected]"
+            git commit ${FILES_TO_COMMIT[*]} -m "Style code (GHA)"
+            git pull --ff-only
+            git push origin
+          else
+            echo "No changes to commit."
+          fi
diff --git a/R/FwdRegAgMIP.R b/R/FwdRegAgMIP.R
@@ -47,7 +47,6 @@ select_param_FwdRegAgMIP <- function(oblig_param_list, add_param_list, crt_list,
     return(res)
   } else if (crt_list[length(crt_list)] ==
     add_param_list[length(add_param_list)]) {
-
     # we tested all parameters
     if (crt_info_crit < min(prev_info_crit)) {
       res$selected <- TRUE
@@ -56,7 +55,6 @@ select_param_FwdRegAgMIP <- function(oblig_param_list, add_param_list, crt_list,
     }
     return(res)
   } else if (length(crt_list) == length(oblig_param_list)) {
-
     # we only tested so far the obligatory parameters
     res$selected <- TRUE
     res$next_candidates <- c(oblig_param_list, add_param_list[1])
@@ -69,7 +67,6 @@ select_param_FwdRegAgMIP <- function(oblig_param_list, add_param_list, crt_list,
         add_param_list[which(add_param_list == crt_list[length(crt_list)]) + 1]
       )
     } else {
-
       # Replace the last candidate parameter by the next candidate
       res$selected <- FALSE
       res$next_candidates <- c(
@@ -118,7 +115,8 @@ post_treat_FwdRegAgMIP <- function(optim_results, crit_options, crt_list,
 
   ## Store the results per step
   v_init <- as.vector(
-    t(optim_results$init_values[optim_results$ind_min_crit, ]))
+    t(optim_results$init_values[optim_results$ind_min_crit, ])
+  )
   names(v_init) <- names(optim_results$init_values)
   info_new_step <- setNames(
     tibble::tibble(
@@ -138,7 +136,7 @@ post_treat_FwdRegAgMIP <- function(optim_results, crit_options, crt_list,
       info_crit_func()$name, "Selected step"
     )
   )
-param_selection_steps <- dplyr::bind_rows(param_selection_steps, info_new_step)
+  param_selection_steps <- dplyr::bind_rows(param_selection_steps, info_new_step)
   ind_min_infocrit <- which.min(param_selection_steps[[info_crit_func()$name]])
   param_selection_steps[, "Selected step"] <- ""
   param_selection_steps[ind_min_infocrit, "Selected step"] <- "X"

diff --git a/R/bayesian_functions.R b/R/bayesian_functions.R
@@ -52,7 +52,8 @@ plot_bayesian <- function(optim_options, param_info, optim_results) {
   nb_chains <- length(out$chain)
   nb_iterations <- nrow(optim_results$post_sample) / nb_chains
 
-  tryCatch({
+  tryCatch(
+    {
       grDevices::pdf(
         file = file.path(path_results, "iterAndDensityPlots.pdf"),
         width = 9, height = 9
@@ -81,7 +82,8 @@ plot_bayesian <- function(optim_options, param_info, optim_results) {
     }
   )
 
-  tryCatch({
+  tryCatch(
+    {
       grDevices::pdf(
         file = file.path(path_results, "marginalPlots.pdf"),
         width = 9, height = 9
@@ -110,7 +112,8 @@ plot_bayesian <- function(optim_options, param_info, optim_results) {
   )
 
   if (nb_params >= 2) {
-    tryCatch({
+    tryCatch(
+      {
         grDevices::pdf(
           file = file.path(path_results, "correlationPlots.pdf"),
           width = 9, height = 9
@@ -145,7 +148,8 @@ plot_bayesian <- function(optim_options, param_info, optim_results) {
     # an error
     if (is.null(optim_options$thin)) optim_options$thin <- 1
     if (nb_iterations >= (optim_options$thin + 50)) {
-      tryCatch({
+      tryCatch(
+        {
           grDevices::pdf(
             file = file.path(path_results, "gelmanDiagPlots.pdf"),
             width = 9, height = 9

diff --git a/R/compute_eq_const.R b/R/compute_eq_const.R
@@ -11,47 +11,48 @@
 #' @keywords internal
 #'
 compute_eq_const <- function(forced_param_values, param_values) {
-
   comp_forced_values <- NULL
   is_vector <- is.vector(param_values)
   if (!is.null(forced_param_values)) {
-
     param_values <- tibble::tibble(!!!param_values)
     param_values$situation <- NULL
-    nrows <- max(1,seq_len(nrow(param_values)))
-    comp_forced_values <- matrix(ncol = length(forced_param_values),
-                                                nrow = nrows)
+    nrows <- max(1, seq_len(nrow(param_values)))
+    comp_forced_values <- matrix(
+      ncol = length(forced_param_values),
+      nrow = nrows
+    )
     colnames(comp_forced_values) <- names(forced_param_values)
 
     # Backticks are added here and in the following to handle parameters names
     # including special characters
     expr_ls <-
-      lapply(names(forced_param_values), function(x) paste0("`",x,"`","<-",
-                                                            forced_param_values[[x]]))
+      lapply(names(forced_param_values), function(x) {
+        paste0(
+          "`", x, "`", "<-",
+          forced_param_values[[x]]
+        )
+      })
     names(expr_ls) <- names(forced_param_values)
 
     for (irow in 1:nrows) {
-
       for (par in names(param_values)) {
-        eval(parse(text = paste0("`",par,"`","<-",param_values[[irow, par]])))
+        eval(parse(text = paste0("`", par, "`", "<-", param_values[[irow, par]])))
       }
       for (par in names(forced_param_values)) {
         eval(parse(text = expr_ls[[par]]))
-        eval(parse(text = paste0("comp_forced_values[irow,\"",par,"\"] <- ",
-                                 "`",par,"`")))
+        eval(parse(text = paste0(
+          "comp_forced_values[irow,\"", par, "\"] <- ",
+          "`", par, "`"
+        )))
       }
-
     }
 
     if (is_vector) {
-      comp_forced_values <- comp_forced_values[1,]
+      comp_forced_values <- comp_forced_values[1, ]
     } else {
       comp_forced_values <- tibble::as_tibble(comp_forced_values)
     }
-
   }
 
   return(comp_forced_values)
-
 }
-
diff --git a/R/estim_param.R b/R/estim_param.R
@@ -198,9 +198,8 @@ estim_param <- function(obs_list, crit_function = crit_log_cwss, model_function,
                           CroptimizR::BIC, CroptimizR::AICc,
                           CroptimizR::AIC
                         ),
-                        weight=NULL,
+                        weight = NULL,
                         var_names = lifecycle::deprecated()) {
-
   # Managing parameter names changes between versions:
   if (rlang::has_name(optim_options, "path_results")) {
     lifecycle::deprecate_warn("0.5.0", "estim_param(optim_options = 'is deprecated, use `out_dir` instead of `path_results`')")
@@ -299,12 +298,14 @@ estim_param <- function(obs_list, crit_function = crit_log_cwss, model_function,
         "The following parameters are defined both in forced_param_values and param_info
            arguments of estim_param function while they should not (a parameter cannot
            be both forced and estimated except if it is part of the `candidate` parameters):",
-        paste(tmp,collapse = ","),
+        paste(tmp, collapse = ","),
         "\n They will be removed from forced_param_values."
       )
       forced_param_values <-
-        forced_param_values[setdiff(names(forced_param_values),
-                                    setdiff(param_names, candidate_param))]
+        forced_param_values[setdiff(
+          names(forced_param_values),
+          setdiff(param_names, candidate_param)
+        )]
     }
   }
 
@@ -360,8 +361,8 @@ estim_param <- function(obs_list, crit_function = crit_log_cwss, model_function,
   crt_candidates <- oblig_param_list
   if (length(crt_candidates) == 0) crt_candidates <- candidate_param[[1]] # in case there are only candidates ...
   count <- 1
-  param_selection_steps<-NULL
-  tmp <- optim_switch(optim_method=optim_method,optim_options=optim_options)
+  param_selection_steps <- NULL
+  tmp <- optim_switch(optim_method = optim_method, optim_options = optim_options)
 
   # Parameter selection loop
   while (!is.null(crt_candidates)) {
@@ -422,7 +423,7 @@ estim_param <- function(obs_list, crit_function = crit_log_cwss, model_function,
       forced_param_values = forced_param_values_tmp,
       info_level = info_level,
       info_crit_list = info_crit_list,
-      weight=weight
+      weight = weight
     )
 
     ## Run the estimation
@@ -432,14 +433,13 @@ estim_param <- function(obs_list, crit_function = crit_log_cwss, model_function,
     )
 
     ## In case no results, there was an error during the estimation process => stop
-    if (length(res_tmp)==0) {
+    if (length(res_tmp) == 0) {
       stop("There was an error during the parameter estimation process.
            Please check warnings and messages displayed above and/or by running warnings().")
     }
 
     ## The following is done only if parameter selection is activated
     if (!is.null(candidate_param)) {
-
       ### Update results in param_selection_steps
       param_selection_steps <- post_treat_FwdRegAgMIP(
         res_tmp, crit_options,
@@ -465,8 +465,10 @@ estim_param <- function(obs_list, crit_function = crit_log_cwss, model_function,
 
   # Print and store results of parameter estimation steps if parameter selection was activated
   if (!is.null(candidate_param)) {
-    summary_FwdRegAgMIP(param_selection_steps, info_crit_list, path_results_ORI,
-                        res)
+    summary_FwdRegAgMIP(
+      param_selection_steps, info_crit_list, path_results_ORI,
+      res
+    )
     save_results_FwdRegAgMIP(param_selection_steps, path_results_ORI)
     res$param_selection_steps <- param_selection_steps
   }

diff --git a/R/filter_obs.R b/R/filter_obs.R
@@ -41,7 +41,6 @@
 filter_obs <- function(obs_list, var = NULL, situation = NULL, dates = NULL,
                        include = FALSE, var_names = lifecycle::deprecated(),
                        sit_names = lifecycle::deprecated()) {
-
   # Managing parameter names changes between versions:
   if (lifecycle::is_present(sit_names)) {
     lifecycle::deprecate_warn("0.5.0", "filter_obs(sit_names)", "filter_obs(situation)")