🔖Version 0.4.1

.github/workflows/check_on_branch.yml

@@ -14,10 +14,13 @@ jobs:
       CODECOV_TOKEN: ${{ secrets.CODECOV_TOKEN }}
       GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
       N2KBUCKET: ${{ secrets.N2KBUCKET }}
-      AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
-      AWS_DEFAULT_REGION: ${{ secrets.AWS_DEFAULT_REGION }}
-      AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
     permissions:
+      id-token: write
       contents: read
     steps:
-      - uses: inbo/actions/[email protected]
+      - name: Configure AWS credentials
+        uses: aws-actions/configure-aws-credentials@v4
+        with:
+          role-to-assume: arn:aws:iam::347082780157:role/inbo-n2kmonitoring-shared-infra-eu-west-1-unittest-role
+          aws-region: eu-west-1
+      - uses: inbo/actions/check_pkg@main

.github/workflows/check_on_different_r_os.yml

@@ -30,11 +30,12 @@ jobs:
       _R_CHECK_SYSTEM_CLOCK_: false
       RSPM: ${{ matrix.config.rspm }}
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
-      AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
-      AWS_DEFAULT_REGION: ${{ secrets.AWS_DEFAULT_REGION }}
-      AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
       N2KBUCKET: ${{ secrets.N2KBUCKET }}
 
+    permissions:
+      id-token: write
+      contents: read
+
     steps:
       - uses: actions/checkout@v3
 
@@ -50,6 +51,12 @@ jobs:
           extra-packages: any::rcmdcheck
           needs: check
 
+      - name: Configure AWS credentials
+        uses: aws-actions/configure-aws-credentials@v4
+        with:
+          role-to-assume: arn:aws:iam::347082780157:role/inbo-n2kmonitoring-shared-infra-eu-west-1-unittest-role
+          aws-region: eu-west-1
+
       - uses: r-lib/actions/check-r-package@v2
         with:
           error-on: '"error"'

.github/workflows/check_on_main.yml

@@ -20,4 +20,4 @@ jobs:
       AWS_DEFAULT_REGION: ${{ secrets.AWS_DEFAULT_REGION }}
       AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
     steps:
-      - uses: inbo/actions/check_pkg@checklist-0.4.1
+      - uses: inbo/actions/check_pkg@main

.zenodo.json

@@ -1,6 +1,6 @@
 {
   "title": "n2kanalysis: Generic Functions to Analyse Data from the 'Natura 2000' Monitoring",
-  "version": "0.4.0",
+  "version": "0.4.1",
   "license": "GPL-3.0",
   "upload_type": "software",
   "description": "<p>All generic functions and classes for the analysis for the ‘Natura 2000’ monitoring. The classes contain all required data and definitions to fit the model without the need to access other sources. Potentially they might need access to one or more parent objects. An aggregation object might for example need the result of an imputation object. The actual definition of the analysis, using these generic function and classes, is defined in dedictated analysis R packages for every monitoring scheme. For example ‘abvanalysis’ and ‘watervogelanalysis’.<\/p>",

CITATION.cff

@@ -29,4 +29,4 @@ identifiers:
   value: 10.5281/zenodo.3576047
 - type: url
   value: https://inbo.github.io/n2kanalysis/
-version: 0.4.0
+version: 0.4.1

DESCRIPTION

@@ -1,10 +1,11 @@
 Package: n2kanalysis
 Title: Generic Functions to Analyse Data from the 'Natura 2000' Monitoring
-Version: 0.4.0
+Version: 0.4.1
 Authors@R: c(
     person("Thierry", "Onkelinx", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0001-8804-4216", affiliation = "Research Institute for Nature and Forest (INBO)")),
-    person("Research Institute for Nature and Forest (INBO)", , , "[email protected]", role = c("cph", "fnd"))
+    person("Research Institute for Nature and Forest (INBO)", , , "[email protected]", role = c("cph", "fnd"),
+           comment = c(ROR = "https://ror.org/00j54wy13"))
   )
 Description: All generic functions and classes for the analysis for the
     'Natura 2000' monitoring. The classes contain all required data and
@@ -72,6 +73,7 @@ Collate:
     'n2k_analysis_metadata_class.R'
     'n2k_result_class.R'
     'combine_result.R'
+    'connect_inbo_s3.R'
     'import_s3_classes.R'
     'delete_model.R'
     'display.R'
@@ -169,3 +171,4 @@ Collate:
     'store_model.R'
     'union.R'
     'valid_object.R'
+    'write_s3_fun.R'

NAMESPACE

@@ -3,6 +3,7 @@
 S3method(sha1,aggregatedImputed)
 S3method(sha1,inla)
 S3method(sha1,rawImputed)
+export(connect_inbo_s3)
 export(display)
 export(fit_every_model)
 export(get_datafield_id)
@@ -13,7 +14,7 @@ export(moving_average)
 export(moving_difference)
 export(moving_trend)
 export(order_manifest)
-export(select_factor_count_strictly_positive)
+export(select_factor_count_non_zero)
 export(select_factor_threshold)
 export(select_observed_range)
 export(sha1)
@@ -143,6 +144,7 @@ importFrom(fs,file_delete)
 importFrom(fs,file_exists)
 importFrom(fs,path)
 importFrom(fs,path_abs)
+importFrom(fs,path_home)
 importFrom(git2rdata,is_git2rmeta)
 importFrom(git2rdata,update_metadata)
 importFrom(git2rdata,verify_vc)

NEWS.md

@@ -1,3 +1,7 @@
+# `n2kanalysis` 0.4.1
+
+* Improve `get_result()`
+
 # `n2kanalysis` 0.4.0
 
 * Handle INLA models with an SPDE element.

R/combine.R

@@ -46,15 +46,19 @@ setMethod(
     ))
     r_package <- r_package[order(r_package$description, r_package$version), ]
     analysis_version_r_package <- lapply(
-      dots, slot, "AnalysisVersionRPackage"
+      dots,
+      slot,
+      "AnalysisVersionRPackage"
     ) %>%
       bind_rows() %>%
       distinct()
     analysis_version_r_package <- analysis_version_r_package %>%
       arrange(.data$analysis_version, .data$r_package)
     new(
-      "n2kAnalysisVersion", AnalysisVersion = analysis_version,
-      RPackage = r_package, AnalysisVersionRPackage = analysis_version_r_package
+      "n2kAnalysisVersion",
+      AnalysisVersion = analysis_version,
+      RPackage = r_package,
+      AnalysisVersionRPackage = analysis_version_r_package
     )
   }
 )
@@ -75,7 +79,8 @@ setMethod(
       bind_rows() %>%
       distinct()
     new(
-      "n2kParameter", Parameter = parameter,
+      "n2kParameter",
+      Parameter = parameter,
       ParameterEstimate = parameter_estimate
     )
   }

R/combine_result.R

@@ -31,7 +31,9 @@ setMethod(
       arrange(.data$fingerprint)
 
     analysis_version_r_package <- lapply(
-      dots, slot, name = "AnalysisVersionRPackage"
+      dots,
+      slot,
+      name = "AnalysisVersionRPackage"
     ) %>%
       do.call(what = rbind) %>%
       distinct() %>%

R/connect_inbo_s3.R

@@ -0,0 +1,37 @@
+#' Set environment variables for INBO S3 bucket
+#'
+#' Before running this function you must have an `.aws` folder in your home
+#' directory with a `credentials` file containing the credentials for the INBO
+#' shared infrastructure.
+#' Run the `aws assume role` command to get the credentials for the INBO shared
+#' infrastructure before running this function.
+#'
+#' @export
+#' @importFrom fs dir_exists path path_home
+#' @importFrom stats setNames
+#' @importFrom utils head tail
+connect_inbo_s3 <- function() {
+  c(unix = ".aws", windows = "../.aws")[.Platform$OS.type] |>
+    path_home() -> aws_dir
+  stopifnot("no `.aws` folder found" = dir_exists(aws_dir))
+  # Read the credentials file
+  path(aws_dir, "credentials") |>
+    readLines() -> creds
+  # keep credentials related to the role
+  role <- grep("\\[inbo-shared-infra", creds)
+  stopifnot("no role found" = length(role) == 1)
+  tail(creds, -role) -> creds
+  grep("\\[", creds) |>
+    c(length(creds) + 1) |>
+    min() -> other
+  head(creds, other - 1) -> creds
+  # set environment variables
+  gsub("(.*) = (.*)", "\\1", creds) |>
+    toupper() |>
+    setNames(object = creds) |>
+    gsub(pattern = "(.*) = (.*)", replacement = "\\2", x = _) |>
+    c(AWS_DEFAULT_REGION = "eu-west-1") |>
+    as.list() |>
+    do.call(what = Sys.setenv)
+  return(invisible(NULL))
+}

R/fit_model_character.R

@@ -21,7 +21,13 @@ setMethod(
   f = "fit_model",
   signature = signature(x = "character"),
   definition = function(
-    x, base, project, status = c("new", "waiting"), verbose = TRUE, ..., bucket
+    x,
+    base,
+    project,
+    status = c("new", "waiting"),
+    verbose = TRUE,
+    ...,
+    bucket
   ) {
     assert_that(is.string(x))
     display(verbose, x)
@@ -50,59 +56,84 @@ setMethod(
     }
     dots <- list(...)
     if (
-      !has_name(dots, "local") || is.null(dots$local) ||
-      !inherits(base, "s3_bucket")
+      !has_name(dots, "local") ||
+        is.null(dots$local) ||
+        !inherits(base, "s3_bucket")
     ) {
       analysis <- read_model(hash, base = base, project = project)
       display(verbose, paste(status(analysis), "-> "), FALSE)
       analysis <- fit_model(
-        x = analysis, status = status, base = base, project = project, ...
+        x = analysis,
+        status = status,
+        base = base,
+        project = project,
+        ...
       )
       display(verbose, status(analysis))
       store_model(analysis, base = base, project = project)
       result <- data.frame(
-        fingerprint = get_file_fingerprint(analysis), status = status(analysis)
+        fingerprint = get_file_fingerprint(analysis),
+        status = status(analysis)
       )
       rm(analysis)
       gc(verbose = FALSE)
       return(invisible(result))
     }
     dots <- list(...)
     to_do <- object_status(
-      base = base, project = project, status = status, hash = x
+      base = base,
+      project = project,
+      status = status,
+      hash = x
     )
     if (length(to_do) == 0) {
       display(verbose, "skipping")
       gc(verbose = FALSE)
       result <- data.frame(
-        fingerprint = hash, status = "converged"
+        fingerprint = hash,
+        status = "converged"
       )
       return(invisible(result))
     }
     download_model(
-      hash = hash, base = base, local = dots$local, project = project,
+      hash = hash,
+      base = base,
+      local = dots$local,
+      project = project,
       verbose = verbose
     )
     analysis <- read_model(hash, base = dots$local, project = project)
     display(verbose, paste(status(analysis), "-> "), FALSE)
     slot(analysis, "AnalysisRelation") |>
       mutate(
         downloaded = map(
-          .data$parent_analysis, download_model, base = base,
-          local = dots$local, project = project, verbose = verbose
+          .data$parent_analysis,
+          download_model,
+          base = base,
+          local = dots$local,
+          project = project,
+          verbose = verbose
         )
       )
     analysis <- fit_model(
-      x = analysis, status = status, base = dots$local, project = project, ...
+      x = analysis,
+      status = status,
+      base = dots$local,
+      project = project,
+      ...
     )
     display(verbose, status(analysis))
     store_model(analysis, base = dots$local, project = project)
     download_model(
-      hash = hash, local = base, base = dots$local, project = project,
+      hash = hash,
+      local = base,
+      base = dots$local,
+      project = project,
       verbose = verbose
     )
     result <- data.frame(
-      fingerprint = get_file_fingerprint(analysis), status = status(analysis)
+      fingerprint = get_file_fingerprint(analysis),
+      status = status(analysis)
     )
     rm(analysis)
     gc(verbose = FALSE)

R/fit_model_n2k_aggregate.R

@@ -43,10 +43,13 @@ setMethod(
           setNames("Data") |>
           c(
             list(
-              Class = "rawImputed", Response = "Count", Minimum = "",
+              Class = "rawImputed",
+              Response = "Count",
+              Minimum = "",
               Imputation = parent@AggregatedImputed@Imputation,
               Extra = cbind(
-                parent@AggregatedImputed@Covariate[0, ], Count = integer(0)
+                parent@AggregatedImputed@Covariate[0, ],
+                Count = integer(0)
               )
             )
           ) |>

R/fit_model_n2k_composite.R

@@ -25,14 +25,22 @@ setMethod(
         filter(!is.na(.data$estimate), !is.na(.data$variance)) |>
         group_by(.data$value) |>
         summarise(
-          estimate = mean(.data$estimate), se = sqrt(sum(.data$variance)) / n()
+          estimate = mean(.data$estimate),
+          se = sqrt(sum(.data$variance)) / n()
         ) |>
         transmute(
-          .data$value, .data$estimate,
-          lower_confidence_limit =
-            qnorm(0.025, mean = .data$estimate, sd = .data$se),
-          upper_confidence_limit =
-            qnorm(0.975, mean = .data$estimate, sd = .data$se)
+          .data$value,
+          .data$estimate,
+          lower_confidence_limit = qnorm(
+            0.025,
+            mean = .data$estimate,
+            sd = .data$se
+          ),
+          upper_confidence_limit = qnorm(
+            0.975,
+            mean = .data$estimate,
+            sd = .data$se
+          )
         ) |>
         as.data.frame() -> x@Index
       status(x) <- "converged"
@@ -52,12 +60,14 @@ setMethod(
       )
       if (inherits(model, "try-error")) {
         parent_status[
-          parent_status$parent_analysis == this_parent, "parent_status"
+          parent_status$parent_analysis == this_parent,
+          "parent_status"
         ] <- "error"
         next
       }
       parent_status[
-        parent_status$parent_analysis == this_parent, "parent_status"
+        parent_status$parent_analysis == this_parent,
+        "parent_status"
       ] <- status(model)
       parent_status[
         parent_status$parent_analysis == this_parent,