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..8bad9c4ab 100644 --- a/R/sits_som.R +++ b/R/sits_som.R @@ -54,9 +54,10 @@ #' @param som_radius Radius of SOM neighborhood. #' @param mode Type of learning algorithm (default = "online"). #' -#' @note The sits package implements the \code{"dtw"} (Dynamic Time Warping) -#' similarity measure. All other similarity measurements are from -#' the \code{\link[kohonen:supersom]{kohonen::supersom (dist.fcts)}} +#' @note The \code{sits} package implements the \code{"dtw"} (Dynamic Time +#' Warping) similarity measure. All other similarity measurements +#' come from the +#' \code{\link[kohonen:supersom]{kohonen::supersom (dist.fcts)}} #' function. #' #' @return @@ -94,6 +95,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/man/sits-package.Rd b/man/sits-package.Rd index 26331e187..c049e7c0d 100644 --- a/man/sits-package.Rd +++ b/man/sits-package.Rd @@ -3,6 +3,7 @@ \docType{package} \name{sits-package} \alias{sits-package} +\alias{_PACKAGE} \alias{sits} \title{sits} \description{ diff --git a/man/sits_som.Rd b/man/sits_som.Rd index e24857323..dac6513be 100644 --- a/man/sits_som.Rd +++ b/man/sits_som.Rd @@ -81,9 +81,10 @@ The user can define which tagged samples will be returned using the "keep" parameter, with the following options: "clean", "analyze", "remove". } \note{ -The sits package implements the \code{"dtw"} (Dynamic Time Warping) - similarity measure. All other similarity measurements are from - the \code{\link[kohonen:supersom]{kohonen::supersom (dist.fcts)}} +The \code{sits} package implements the \code{"dtw"} (Dynamic Time + Warping) similarity measure. All other similarity measurements + come from the + \code{\link[kohonen:supersom]{kohonen::supersom (dist.fcts)}} function. } \examples{ 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/kohonen_dtw.cpp b/src/kohonen_dtw.cpp index ae67975cf..12a565d27 100644 --- a/src/kohonen_dtw.cpp +++ b/src/kohonen_dtw.cpp @@ -1,40 +1,38 @@ #include -#include -#include -#include -#include -#include - #include "./sits_types.h" using namespace Rcpp; /** - * Compute the p-norm distance between two 1D C++ vectors. + * Compute the p-norm between two time-series. * * @description - * The p-norm, also known as the Minkowski norm, is a generalized norm - * calculation that includes several types of distances based on the value of p. + * The `p-norm`, also known as the `Minkowski space`, is a generalized norm + * calculation that includes several types of distances based on the value + * of `p`. * - * Common values of p include: + * Common values of `p` include: * - * - p = 1 for the Manhattan (city block) distance; - * - p = 2 for the Euclidean norm (distance). + * - `p = 1` for the Manhattan (city block) distance; + * - `p = 2` for the Euclidean norm (distance). * * More details about p-norms can be found on Wikipedia: * https://en.wikipedia.org/wiki/Norm_(mathematics)#p-norm * - * @param a A 1D vector representing the first point in an m-dimensional space. - * @param b A 1D vector representing the second point in an m-dimensional space. - * @param p The value of the norm to use, determining the type of distance - * calculated. + * @param a A `std::vector` with time-series values. + * @param b A `std::vector` with time-series values. + * @param p A `double` value of the norm to use, determining the type of + * distance calculated. + * + * @note + * Both vectors `a` and `b` must have the same length. * - * @note Both vectors 'a' and 'b' must have the same number of dimensions. - * @note This function was adapted from the DTW implementation found at: - * https://github.com/cjekel/DTW_cpp + * @note + * The implementation of this DTW distance calculation was adapted from the + * `DTW_cpp` single header library (https://github.com/cjekel/DTW_cpp). * - * @return The p-norm distance between vectors 'a' and 'b'. + * @return The `p-norm` value between vectors `a` and `b`. */ double p_norm(std::vector a, std::vector b, double p) { @@ -51,34 +49,25 @@ double p_norm(std::vector a, std::vector b, double p) } /** - * Compute the Dynamic Time Warping (DTW) distance between two 2D C++ vectors. + * Dynamic Time Warping (DTW) distance. * * @description * This function calculates the Dynamic Time Warping (DTW) distance between - * two sequences that can have a different number of data points but must - * share the same number of dimensions. An exception is thrown if the dimensions - * of the input vectors do not match. + * two time-series. * - * For more information on DTW, visit: - * https://en.wikipedia.org/wiki/Dynamic_time_warping + * @param x A `std::vector>` with time-series values. + * @param y A `std::vector>` with time-series values. * - * @param a A 2D vector representing the first sequence - * @param b A 2D vector representing the second sequence. - * @param p The value of p-norm to use for distance calculation. - * - * @throws std::invalid_argument If the dimensions of 'a' and 'b' do not match. + * @reference + * Giorgino, T. (2009). Computing and Visualizing Dynamic Time Warping + * Alignments in R: The dtw Package. Journal of Statistical Software, 31(7), + * 1–24. https://doi.org/10.18637/jss.v031.i07 * * @note - * Both vectors 'a', and 'b' should be structured as follows: - * - * [number_of_data_points][number_of_dimensions] - * - * allowing the DTW distance computation to adapt to any p-norm value specified. + * The implementation of this DTW distance calculation was adapted from the + * `DTW_cpp` single header library (https://github.com/cjekel/DTW_cpp). * - * @note The implementation of this DTW distance calculation was adapted from: - * https://github.com/cjekel/DTW_cpp - * - * @return The DTW distance between the two input sequences. + * @return DTW distance. */ double distance_dtw_op(std::vector> a, std::vector> b, @@ -87,15 +76,6 @@ double distance_dtw_op(std::vector> a, int n = a.size(); int o = b.size(); - int a_m = a[0].size(); - int b_m = b[0].size(); - - if (a_m != b_m) - { - throw std::invalid_argument( - "a and b must have the same number of dimensions!" - ); - } std::vector> d(n, std::vector(o, 0.0)); d[0][0] = p_norm(a[0], b[0], p); @@ -121,22 +101,27 @@ double distance_dtw_op(std::vector> a, } /** - * Dynamic Time Warping (DTW) distance wrapper. + * Dynamic Time Warping (DTW) distance. * * @description - * This function calculates prepare data from `Kohonen` package and calculate - * the DTW distance between two array of points. + * This function calculates the Dynamic Time Warping (DTW) distance between + * two time-series. * - * @param a A 2D vector representing the first sequence. - * @param b A 2D vector representing the second sequence. - * @param np Number of points in vectors `a` and `b`. - * @param nNA Number of NA values in the vectors `a` and `b`. + * @param x A `double *` Time-series data. + * @param y A `double *` Self-Organizing Maps (SOM) codebook. + * @param np `int` Number of points in arrays `p1` and `p2`. + * @param nNA `int` Number of `NA` values in the arrays `p1` and `p2`. * - * @note The function signature was created following the `Kohonen` R package - * specifications for custom distance functions. + * @reference + * Giorgino, T. (2009). Computing and Visualizing Dynamic Time Warping + * Alignments in R: The dtw Package. Journal of Statistical Software, 31(7), + * 1–24. https://doi.org/10.18637/jss.v031.i07 * + * @note + * The implementation of this DTW distance calculation was adapted from the + * `DTW_cpp` single header library (https://github.com/cjekel/DTW_cpp). * - * @return The DTW distance between the two input sequences. + * @return DTW distance. */ double kohonen_dtw(double *p1, double *p2, int np, int nNA) { 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 + +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); +}