From f5cf45bfc97c986bde8b2ccf5215845ed9bdf90b Mon Sep 17 00:00:00 2001
From: Felipe Carlos <efelipecarlos@gmail.com>
Date: Sun, 3 Mar 2024 20:47:16 +0000
Subject: [PATCH] fix dtw export

---
 R/RcppExports.R     |  8 ++++++++
 R/api_som.R         | 22 ++++++++++++++++++++++
 R/sits_som.R        |  2 ++
 src/RcppExports.cpp | 22 ++++++++++++++++++++++
 src/rlang.cpp       | 20 ++++++++++++++++++++
 5 files changed, 74 insertions(+)
 create mode 100644 src/rlang.cpp

diff --git a/R/RcppExports.R b/R/RcppExports.R
index cb420c783..2601c088a 100644
--- a/R/RcppExports.R
+++ b/R/RcppExports.R
@@ -145,6 +145,14 @@ C_temp_iqr <- function(mtx) {
     .Call(`_sits_C_temp_iqr`, mtx)
 }
 
+rlang_env_unlock <- function(env) {
+    invisible(.Call(`_sits_rlang_env_unlock`, env))
+}
+
+rlang_env_lock <- function(env) {
+    invisible(.Call(`_sits_rlang_env_lock`, env))
+}
+
 sample_points_inclusion <- function(polymatrix, n_sam_pol) {
     .Call(`_sits_sample_points_inclusion`, polymatrix, n_sam_pol)
 }
diff --git a/R/api_som.R b/R/api_som.R
index 274048a0b..764ce7ce9 100644
--- a/R/api_som.R
+++ b/R/api_som.R
@@ -1,3 +1,25 @@
+#' @title Register custom distances in the `kohonen` package environment.
+#' @name .som_register_custom_distances
+#' @keywords internal
+#' @noRd
+#' @author Felipe Carlos, \email{efelipecarlos@@gmail.com}
+#'
+#' @description This function injects custom distance functions in the
+#' environment of the `kohonen` package.
+#'
+.som_register_custom_distances <- function() {
+    kohonen_namespace <- base::asNamespace("kohonen")
+
+    # unlock the environment
+    rlang_env_unlock(kohonen_namespace)
+
+    # include custom distances in the environment
+    base::assign("dtw", dtw, envir = kohonen_namespace)
+
+    # lock the environment
+    rlang_env_lock(kohonen_namespace)
+}
+
 #' @title Label neurons
 #' @name .som_label_neurons
 #' @keywords internal
diff --git a/R/sits_som.R b/R/sits_som.R
index 61733d9c5..560bbc480 100644
--- a/R/sits_som.R
+++ b/R/sits_som.R
@@ -94,6 +94,8 @@ sits_som_map <- function(data,
                          distance = "euclidean",
                          som_radius = 2,
                          mode = "online") {
+    # register custom distances
+    .som_register_custom_distances()
     # set caller to show in errors
     .check_set_caller("sits_som_map")
     # verifies if kohonen package is installed
diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
index 60ffa7bf8..7f360ca5d 100644
--- a/src/RcppExports.cpp
+++ b/src/RcppExports.cpp
@@ -447,6 +447,26 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// rlang_env_unlock
+void rlang_env_unlock(SEXPREC* env);
+RcppExport SEXP _sits_rlang_env_unlock(SEXP envSEXP) {
+BEGIN_RCPP
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< SEXPREC* >::type env(envSEXP);
+    rlang_env_unlock(env);
+    return R_NilValue;
+END_RCPP
+}
+// rlang_env_lock
+void rlang_env_lock(SEXPREC* env);
+RcppExport SEXP _sits_rlang_env_lock(SEXP envSEXP) {
+BEGIN_RCPP
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< SEXPREC* >::type env(envSEXP);
+    rlang_env_lock(env);
+    return R_NilValue;
+END_RCPP
+}
 // sample_points_inclusion
 NumericMatrix sample_points_inclusion(const NumericMatrix& polymatrix, const int n_sam_pol);
 RcppExport SEXP _sits_sample_points_inclusion(SEXP polymatrixSEXP, SEXP n_sam_polSEXP) {
@@ -669,6 +689,8 @@ static const R_CallMethodDef CallEntries[] = {
     {"_sits_C_temp_sqr", (DL_FUNC) &_sits_C_temp_sqr, 1},
     {"_sits_C_temp_tqr", (DL_FUNC) &_sits_C_temp_tqr, 1},
     {"_sits_C_temp_iqr", (DL_FUNC) &_sits_C_temp_iqr, 1},
+    {"_sits_rlang_env_unlock", (DL_FUNC) &_sits_rlang_env_unlock, 1},
+    {"_sits_rlang_env_lock", (DL_FUNC) &_sits_rlang_env_lock, 1},
     {"_sits_sample_points_inclusion", (DL_FUNC) &_sits_sample_points_inclusion, 2},
     {"_sits_sample_points_crossings", (DL_FUNC) &_sits_sample_points_crossings, 2},
     {"_sits_sample_points_bin", (DL_FUNC) &_sits_sample_points_bin, 2},
diff --git a/src/rlang.cpp b/src/rlang.cpp
new file mode 100644
index 000000000..9ddca4b70
--- /dev/null
+++ b/src/rlang.cpp
@@ -0,0 +1,20 @@
+#include <Rcpp.h>
+
+using namespace Rcpp;
+
+/*
+ * These functions were extracted from the `rlang` package to avoid extra
+ * dependencies.
+ */
+#define FRAME_LOCK_MASK (1 << 14)
+#define UNLOCK_FRAME(e) SET_ENVFLAGS(e, ENVFLAGS(e) & (~FRAME_LOCK_MASK))
+
+// [[Rcpp::export]]
+void rlang_env_unlock(SEXPREC* env) {
+    UNLOCK_FRAME(env);
+}
+
+// [[Rcpp::export]]
+void rlang_env_lock(SEXPREC* env) {
+    UNLOCK_FRAME(env);
+}