Nothing
# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
#' @title A fast distance algorithm for two matrices written in C++
#' @description Computes distances between two data matrices using
#' "euclid", "cor", "cosine"
#' @usage
#' fast_diss(X, Y, method)
#' @param X a matrix
#' @param Y a matrix
#' @param method a \code{string} with possible values "euclid", "cor", "cosine"
#' @return a distance matrix
#' @keywords internal
#' @noRd
#' @author Antoine Stevens and Leonardo Ramirez-Lopez
fast_diss <- function(X, Y, method) {
.Call(`_resemble_fast_diss`, X, Y, method)
}
#' @title A fast algorithm of (squared) Euclidean cross-distance for vectors written in C++
#' @description A fast (parallel for linux) algorithm of (squared) Euclidean cross-distance for vectors written in C++
#' @usage
#' fast_diss_vector(X)
#' @param X a vector.
#' @return a vector of distance (lower triangle of the distance matrix, stored by column)
#' @details used internally in ortho_projection
#' @author Antoine Stevens
#' @keywords internal
#' @noRd
fast_diss_vector <- function(X) {
.Call(`_resemble_fast_diss_vector`, X)
}
#' @title Symmetric Euclidean Distance Matrix from a Single Matrix
#' @description Computes the symmetric pairwise Euclidean distance matrix
#' from the rows of a single matrix. Only the upper triangle is computed,
#' then mirrored to the lower triangle to reduce redundant operations.
#'
#' Squared distances are calculated first, then square-rooted. Tiny values
#' below 1e-14 are clamped to zero to ensure numerical stability.
#'
#' @param X An `n x p` numeric matrix where each row is a p-dimensional
#' observation.
#'
#' @return An `n x n` symmetric matrix of Euclidean distances.
#'
#' @details
#' This function is designed for efficient in-memory computation of full
#' distance matrices using only the upper triangle to avoid redundant work.
#' It applies the square root only once per distance and avoids unnecessary
#' writes to the diagonal (which is always 0). The implementation leverages
#' memory locality and avoids data duplication.
#'
#' Suitable for moderate to large `n`. If OpenMP is enabled, the upper-triangle
#' loop can optionally be parallelized for additional speedup on multicore systems.
#' Note that the function assumes that the input matrix `X` is not empty and
#' @keywords internal
#' @noRd
fast_self_euclid <- function(X) {
.Call(`_resemble_fast_self_euclid`, X)
}
#' @title Rolling correlation distance between X and Y
#' @param X Numeric matrix m×T
#' @param Y Numeric matrix n×T
#' @param w Window size (odd)
#' @param block_x Tile size for rows of X (default 1024)
#' @param block_y Tile size for rows of Y (default 1024)
#' @return n×m distance matrix (R double matrix)
#' @noRd
#' @keywords internal
moving_cor_diss_xy <- function(X, Y, w, block_x = 1024L, block_y = 1024L) {
.Call(`_resemble_moving_cor_diss_xy`, X, Y, w, block_x, block_y)
}
#' @title Rolling correlation distance within X (upper-triangle, tiled, serial-optimized)
#' @description Mean rolling-window correlation distance among rows of X.
#' Serial only; computes upper-triangle tiles densely and mirrors.
#' @param X Numeric matrix (m x T)
#' @param w Odd window size
#' @param block_rows Tile size in rows (default 1024)
#' @return m x m symmetric distance matrix
#' @keywords internal
#' @noRd
moving_cor_diss_self_f64 <- function(X, w, block_rows = 1024L) {
.Call(`_resemble_moving_cor_diss_self_f64`, X, w, block_rows)
}
#' @title Rolling correlation distance within X (templated, OpenMP; precision)
#' @param X Numeric matrix (m x T)
#' @param w Window size (odd in)
#' @param block_rows Tile size (default 1024)
#' @return m×m distance matrix (double for R)
#' @keywords internal
#' @noRd
moving_cor_diss_self <- function(X, w, block_rows = 1024L) {
.Call(`_resemble_moving_cor_diss_self`, X, w, block_rows)
}
#' @title A function to compute row-wise index of minimum values of a square distance matrix
#' @description For internal use only
#' @usage
#' which_min(X)
#' @param X a square matrix of distances
#' @return a vector of the indices of the minimum value in each row of the input matrix
#' @details Used internally to find the nearest neighbors
#' @keywords internal
#' @noRd
#' @author Antoine Stevens
which_min <- function(X) {
.Call(`_resemble_which_min`, X)
}
#' @title A function to compute indices of minimum values of a distance vector
#' @description For internal use only
#' @usage
#' which_min_vector(X)
#' @param X a vector of distances
#' @return a vector of the indices of the nearest neighbors
#' @details
#' Used internally to find the nearest neighbors.
#' It searches in lower (or upper) triangular matrix. Therefore this must be the format of the
#' input data. The piece of code int \code{len = (sqrt(X.size()*8+1)+1)/2} generated an error in CRAN
#' since \code{sqrt} cannot be applied to integers.
#' @keywords internal
#' @noRd
#' @author Antoine Stevens
which_min_vector <- function(X) {
.Call(`_resemble_which_min_vector`, X)
}
#' @title Top-k Order Indices for Matrix Columns
#' @description
#' Internal helper function. For each column in a numeric matrix,
#' returns the indices of the top-\code{k} smallest values (i.e., closest neighbors).
#'
#' @details
#' This function is implemented in C++ using \code{Rcpp}. It performs a partial sort
#' on each column to retrieve the \code{k} smallest elements efficiently. This is
#' particularly useful when working with large dissimilarity matrices, where
#' performance is critical.
#'
#' @param mat A numeric matrix (e.g., dissimilarity matrix).
#' @param k Integer. Number of top smallest elements to return for each column.
#'
#' @return An integer matrix of dimensions \code{k × ncol(mat)}. Each column contains
#' the 1-based row indices of the top-\code{k} smallest values in the corresponding column of \code{mat}.
#'
#' @keywords internal
#' @noRd
top_k_order <- function(mat, k, skip = as.integer( c())) {
.Call(`_resemble_top_k_order`, mat, k, skip)
}
#' @title Extract Column Elements by Row Indices
#' @description
#' Efficiently extracts specific elements from each column of a numeric matrix
#' based on provided row indices, using Rcpp for performance.
#'
#' @param mat A numeric matrix from which values will be extracted.
#' @param idx An integer matrix of the same number of columns as \code{mat}.
#' Each column of \code{idx} contains the row indices to extract from the
#' corresponding column of \code{mat}.
#'
#' @details
#' For each column \code{j}, this function returns a vector of values
#' \code{mat[idx[, j], j]}. It is implemented in C++ using Rcpp for speed
#' and is suitable for large-scale operations (e.g., tens of thousands of rows).
#'
#' Indices in \code{idx} are assumed to be 1-based (R-style). Internally,
#' they are adjusted for 0-based indexing in C++.
#'
#' @return A numeric matrix of the same dimension as \code{idx}, where each
#' element is extracted from \code{mat} according to the corresponding
#' row and column in \code{idx}.
#'
#' @keywords internal
#' @noRd
extract_by_index <- function(mat, idx) {
.Call(`_resemble_extract_by_index`, mat, idx)
}
#' @title Group Disparity Mask for Nearest Neighbors (C++)
#' @description
#' Internal C++ function that creates a logical matrix indicating whether
#' each neighbor in `kidxmat` belongs to a different group than the sample.
#'
#' @param kidxmat An integer matrix of neighbor indices. Each column
#' corresponds to a sample, and each row to a ranked neighbor.
#' Indices refer to rows in the `group` vector.
#' @param group An integer vector representing the group assignment
#' for each sample. Its length must match the number of rows
#' in the reference data.
#'
#' @return
#' A logical matrix of the same dimensions as `kidxmat`, where each
#' element is `TRUE` if the corresponding neighbor belongs to a
#' different group than the target sample, and `FALSE` otherwise.
#'
#' @details
#' For each column in `kidxmat`, corresponding to a sample,
#' the function:
#' \itemize{
#' \item Extracts the group assignment of the sample.
#' \item Checks whether each neighbor (by index) belongs to the same group.
#' \item Stores `TRUE` if the neighbor is from a different group,
#' `FALSE` otherwise.
#' }
#' The result can be used as a mask to filter out same-group neighbors.
#'
#' @note
#' Parallelized using OpenMP for performance.
#' Assumes 1-based indexing from R (internally adjusted).
#' @noRd
#' @keywords internal
#' @author Leonardo Ramirez-Lopez
not_in_same_group <- function(kidxmat, group) {
.Call(`_resemble_not_in_same_group`, kidxmat, group)
}
#' @title Quantile Statistics from Nearest Neighbors (C++)
#' @description
#' Internal C++ function to compute quantiles of response values
#' among filtered nearest neighbors for each sample.
#'
#' @param kidxmat An integer matrix of nearest neighbor indices.
#' Each column corresponds to one observation (e.g., in Xu),
#' and rows represent the ranks of the neighbors.
#' @param kidxgrop A logical matrix of the same shape as `kidxmat`
#' indicating which neighbors should be retained (`TRUE`)
#' based on group membership.
#' @param Yr A numeric vector of reference response values. The
#' values are indexed by `kidxmat` to compute quantiles.
#' @param k An integer specifying the number of neighbors to use.
#' Either a single value (applied to all observations) or a
#' vector of length `ncol(kidxmat)` (per-observation neighborhood sizes).
#' @param probs A numeric vector of probabilities for which to
#' compute quantiles (e.g., `c(0, 0.05, 0.5, 0.95, 1)`).
#'
#' @return
#' A numeric matrix of size `(length(k) * ncol(kidxmat)) × length(probs)`
#' where each row contains the quantiles for a particular observation
#' and each column corresponds to a probability in `probs`.
#'
#' @details
#' For each observation, the function:
#' \itemize{
#' \item Selects its top-k nearest neighbors.
#' \item Filters neighbors based on the logical group mask.
#' \item Extracts corresponding values from `Yr`.
#' \item Computes requested quantiles.
#' }
#' Missing values in `Yr` are ignored. If no valid neighbors are
#' found for a given sample, all quantiles will be set to `NA`.
#'
#' @note
#' This is an internal function intended for performance-critical
#' applications. It should not be exported to the user.
#' @noRd
#' @keywords internal
#' @author Leonardo Ramirez-Lopez
compute_nn_quantiles <- function(kidxmat, kidxgrop, Yr, k, probs) {
.Call(`_resemble_compute_nn_quantiles`, kidxmat, kidxgrop, Yr, k, probs)
}
#' @title Find Nearest Neighbors by Dissimilarity
#'
#' @description
#' Internal C++ function to identify nearest neighbors from a dissimilarity
#' matrix, with optional thresholding. Uses partial sorting for efficiency
#' when only the top-k neighbors are needed.
#'
#' @param D A numeric matrix of dissimilarities (n × m), where rows are
#' reference observations and columns are query observations.
#' @param k_min Integer. Minimum number of neighbors to return per
#' observation. When \code{threshold} is \code{NULL}, exactly \code{k_min}
#' neighbors are returned. When \code{threshold} is specified, at least
#' \code{k_min} neighbors are returned even if fewer fall below the
#' threshold.
#' @param k_max Integer. Maximum number of neighbors to consider. Only the
#' \code{k_max} nearest neighbors are evaluated against the threshold.
#' Must satisfy \code{k_max >= k_min} and \code{k_max <= nrow(D)}.
#' @param threshold Either \code{NULL} or a numeric scalar. When \code{NULL},
#' exactly \code{k_min} neighbors are returned. When specified, all
#' neighbors among the top \code{k_max} with dissimilarity ≤ \code{threshold}
#' are returned, subject to the \code{k_min} floor.
#'
#' @return A list of length \code{ncol(D)}. Each element is an integer vector
#' of 1-indexed row indices identifying the nearest neighbors for that
#' column, sorted by increasing dissimilarity.
#'
#' @details
#' For each column (query observation), the function:
#' \enumerate{
#' \item Performs a partial sort to identify the \code{k_max} smallest
#' dissimilarities in O(n + k log k) time.
#' \item If \code{threshold} is \code{NULL}, returns the first \code{k_min}
#' indices.
#' \item If \code{threshold} is specified, counts how many of the top
#' \code{k_max} neighbors have dissimilarity ≤ \code{threshold}, then
#' returns \code{max(k_min, n_below)} indices.
#' }
#'
#' @section Parallel execution:
#' The function uses OpenMP for parallel computation across columns.
#' Thread count is controlled by the \code{OMP_NUM_THREADS} environment
#' variable.
#'
#' @note
#' Tie-breaking may differ slightly from R's \code{order()} function, which
#' uses stable sorting. In practice, exact ties in dissimilarity matrices
#' are rare.
#'
#' @keywords internal
#' @noRd
#' @author Leonardo Ramirez-Lopez
top_k_neighbors <- function(D, k_min, k_max, threshold = NULL) {
.Call(`_resemble_top_k_neighbors`, D, k_min, k_max, threshold)
}
#' @title Function for identifiying the column in a matrix with the largest standard deviation
#' @description Identifies the column with the largest standard deviation. For internal use only!
#' @usage get_col_largest_sd(X)
#' @param X a matrix.
#' @return a value indicating the index of the column with the largest standard deviation.
#' @author Leonardo Ramirez-Lopez
#' @keywords internal
#' @noRd
get_col_largest_sd <- function(X) {
.Call(`_resemble_get_col_largest_sd`, X)
}
#' @title Function for computing the standard deviation of each column in a matrix
#' @description Computes the standard deviation of each column in a matrix. For internal use only!
#' @usage get_column_sds(X)
#' @param X a a matrix.
#' @return a vector of standard deviation values.
#' @author Leonardo Ramirez-Lopez
#' @keywords internal
#' @noRd
get_column_sds <- function(X) {
.Call(`_resemble_get_column_sds`, X)
}
#' @title Function for computing the overall variance of a matrix
#' @description Computes the variance of a matrix. For internal use only!
#' @usage overall_var(X)
#' @param X a matrix.
#' @return a vector of standard deviation values.
#' @author Leonardo Ramirez-Lopez
#' @keywords internal
#' @noRd
overall_var <- function(X) {
.Call(`_resemble_overall_var`, X)
}
#' @title Function for computing the mean of each column in a matrix
#' @description Computes the mean of each column in a matrix. For internal use only!
#' @usage get_column_means(X)
#' @param X a a matrix.
#' @return a vector of mean values.
#' @author Leonardo Ramirez-Lopez
#' @keywords internal
#' @noRd
get_column_means <- function(X) {
.Call(`_resemble_get_column_means`, X)
}
#' @title Function for computing the maximum of each column
#' @description Computes the max of each column in a matrix. For internal use only!
#' @usage get_column_maxs(X)
#' @param X a a matrix.
#' @return a vector of mean values.
#' @author Leonardo Ramirez-Lopez
#' @keywords internal
#' @noRd
get_column_maxs <- function(X) {
.Call(`_resemble_get_column_maxs`, X)
}
#' @title Function for computing sum of each column in a matrix
#' @description Computes the sum of each column in a matrix. For internal use only!
#' @usage get_column_sums(X)
#' @param X a matrix.
#' @return a vector of standard deviation values.
#' @author Leonardo Ramirez-Lopez
#' @keywords internal
#' @noRd
get_column_sums <- function(X) {
.Call(`_resemble_get_column_sums`, X)
}
#' @title Computes the weights for pls regressions
#' @description
#' This is an internal function that computes the weights required for obtaining
#' each vector of pls scores. Implementation is done in C++ for improved performance.
#' @param X a numeric matrix of spectral data.
#' @param Y a matrix of one column with the response variable.
#' @param algorithm a character string indicating what method to use. Options are:
#' \code{'pls'} for pls (using covariance between X and Y),
#' \code{'mpls'} for modified pls (using correlation between X and Y as in
#' Shenk and Westerhaus, 1991; Westerhaus 2014) or
#' \code{'xls'} for extended pls (as implemented in BUCHI NIRWise PLUS software).
#' @param xls_min_w an integer indicating the minimum window size for the "xls"
#' method. Only used if \code{algorithm = 'xls'}. Default is 3 (as in BUCHI NIRWise PLUS software).
#' @param xls_max_w an integer indicating the maximum window size for the "xls"
#' method. Only used if \code{algorithm = 'xls'}. Default is 15 (as in BUCHI NIRWise PLUS software).
#' @author Leonardo Ramirez-Lopez and Claudio Orellano
#' @references
#' Shenk, J. S., & Westerhaus, M. O. (1991). Populations structuring of
#' near infrared spectra and modified partial least squares regression.
#' Crop Science, 31(6), 1548-1555.
#'
#' Westerhaus, M. (2014). Eastern Analytical Symposium Award for outstanding
#' Wachievements in near infrared spectroscopy: my contributions to
#' Wnear infrared spectroscopy. NIR news, 25(8), 16-20.
#' @return a `matrix` of one column containing the weights.
#' @keywords internal
#' @noRd
get_weights <- function(X, Y, algorithm = "pls", xls_min_w = 3L, xls_max_w = 15L) {
.Call(`_resemble_get_weights`, X, Y, algorithm, xls_min_w, xls_max_w)
}
#' @title Internal Cpp function for computing the weights of the PLS components
#' necessary for weighted average PLS
#' @description For internal use only!.
#' @usage
#' get_local_pls_weights(projection_mat,
#' xloadings,
#' coefficients,
#' new_x,
#' min_component,
#' max_component,
#' scale,
#' Xcenter,
#' Xscale)
#' @param projection_mat the projection matrix generated either by the \code{opls} function.
#' @param xloadings .
#' @param coefficients the matrix of regression coefficients.
#' @param new_x a matrix of one new spectra to be predicted.
#' @param min_component an integer indicating the minimum number of pls components.
#' @param max_component an integer indicating the maximum number of pls components.
#' @param scale a logical indicating whether the matrix of predictors used to create the regression model was scaled.
#' @param Xcenter a vector with the values that must be used for centering \code{newdata}.
#' @param Xscale if \code{scale = TRUE} a vector with the values that must be used for scaling \code{newdata}.
#' @return a matrix of one row with the weights for each component between the max. and min. specified.
#' @author Leonardo Ramirez-Lopez
#' @noRd
#' @keywords internal
get_local_pls_weights <- function(projection_mat, xloadings, coefficients, new_x, min_component, max_component, scale, Xcenter, Xscale) {
.Call(`_resemble_get_local_pls_weights`, projection_mat, xloadings, coefficients, new_x, min_component, max_component, scale, Xcenter, Xscale)
}
#' @title orthogonal scores algorithn of partial leat squares (opls) projection
#' @description Computes orthogonal socres partial least squares (opls)
#' projection with the NIPALS algorithm. It allows multiple response variables.
#' Although the main use of the function is for projection, it also retrieves
#' regression coefficients. NOTE: For internal use only!
#' @usage
#' opls_for_projection(X, Y, ncomp, scale,
#' maxiter, tol,
#' pcSelmethod = "var",
#' pcSelvalue = 0.01,
#' algorithm = "pls",
#' xls_min_w = 3,
#' xls_max_w = 15)
#' @param X a matrix of predictor variables.
#' @param Y a matrix of either a single or multiple response variables.
#' @param ncomp the number of pls components.
#' @param scale logical indicating whether \code{X} must be scaled.
#' @param maxiter maximum number of iterations.
#' @param tol limit for convergence of the algorithm in the nipals algorithm.
#' @param pcSelmethod if \code{regression = TRUE}, the method for selecting the
#' number of components.
#' Options are: \code{'manual'}, \code{'cumvar'} (for selecting the number of
#' principal components based on a given cumulative amount of explained
#' variance) and \code{'var'} (for selecting the number of principal components
#' based on a given amount of explained variance). Default is \code{'cumvar'}.
#' @param pcSelvalue a numerical value that complements the selected method
#' (\code{pcSelmethod}).
#' If \code{'cumvar'} is chosen (default), \code{pcSelvalue} must be a value
#' (larger than 0 and below 1) indicating the maximum amount of cumulative
#' variance that the retained components should explain. Default is 0.99.
#' If \code{'var'} is chosen, \code{pcSelvalue} must be a value (larger than 0
#' and below 1) indicating that components that explain (individually)
#' a variance lower than this threshold must be excluded. If \code{'manual'}
#' is chosen, \code{pcSelvalue} has no effect and the number of components
#' retrieved are the one specified in \code{ncomp}.
#' @param algorithm (for weights computation) a character string indicating
#' what method to use. Options are:
#' \code{'pls'} for pls (using covariance between X and Y),
#' \code{'mpls'} for modified pls (using correlation between X and Y) or
#' \code{'xls'} for extended pls (as implemented in BUCHI NIRWise PLUS software).
#' @param xls_min_w (for weights computation) an integer indicating the minimum window size for the "xls"
#' method. Only used if \code{algorithm = 'xls'}. Default is 3 (as in BUCHI NIRWise PLUS software).
#' @param xls_max_w (for weights computation) an integer indicating the maximum window size for the "xls"
#' method. Only used if \code{algorithm = 'xls'}. Default is 15 (as in BUCHI NIRWise PLUS software).
#' @return a list containing the following elements:
#' \itemize{
#' \item{\code{coefficients}: the matrix of regression coefficients.}
#' \item{\code{bo}: a matrix of one row containing the intercepts for
#' each component.}
#' \item{\code{scores}: the matrix of scores.}
#' \item{\code{X_loadings}: the matrix of X loadings.}
#' \item{\code{Y_loadings}: the matrix of Y loadings.}
#' \item{\code{projection_mat}: the projection matrix.}
#' \item{\code{Y}: the \code{Y} input.}
#' \item{\code{variance}: a \code{list} conating two objects: \code{x_var}
#' and \code{y_var}.
#' These objects contain information on the explained variance for the \code{X}
#' and \code{Y} matrices respectively.}
#' \item{\code{transf}: a \code{list} conating two objects: \code{Xcenter}
#' and \code{Xscale}}.
#' \item{\code{weights}: the matrix of wheights.}
#' }
#' @author Leonardo Ramirez-Lopez
#' @noRd
#' @keywords internal
opls_for_projection <- function(X, Y, ncomp, scale, maxiter, tol, pcSelmethod = "var", pcSelvalue = 0.01, algorithm = "pls", xls_min_w = 3L, xls_max_w = 15L) {
.Call(`_resemble_opls_for_projection`, X, Y, ncomp, scale, maxiter, tol, pcSelmethod, pcSelvalue, algorithm, xls_min_w, xls_max_w)
}
#' @title orthogonal scores algorithn of partial leat squares (opls_get_all)
#' @description Computes orthogonal socres partial least squares (opls_get_all)
#' regressions with the NIPALS algorithm. It retrives a comprehensive set of
#' pls outputs (e.g. vip and sensivity radius). It allows multiple response
#' variables. NOTE: For internal use only!
#' @usage
#' opls_get_all(X,
#' Y,
#' ncomp,
#' scale,
#' maxiter,
#' tol,
#' algorithm = "pls",
#' xls_min_w = 3,
#' xls_max_w = 15)
#' @param X a matrix of predictor variables.
#' @param Y a matrix of either a single or multiple response variables.
#' @param ncomp the number of pls components.
#' @param scale logical indicating whether \code{X} must be scaled.
#' @param maxiter maximum number of iterations.
#' @param tol limit for convergence of the algorithm in the nipals algorithm.
#' @param algorithm (for weights computation) a character string indicating
#' what method to use. Options are:
#' \code{'pls'} for pls (using covariance between X and Y),
#' \code{'mpls'} for modified pls (using correlation between X and Y) or
#' \code{'xls'} for extended pls (as implemented in BUCHI NIRWise PLUS software).
#' @param xls_min_w (for weights computation) an integer indicating the minimum window size for the "xls"
#' method. Only used if \code{algorithm = 'xls'}. Default is 3 (as in BUCHI NIRWise PLUS software).
#' @param xls_max_w (for weights computation) an integer indicating the maximum window size for the "xls"
#' method. Only used if \code{algorithm = 'xls'}. Default is 15 (as in BUCHI NIRWise PLUS software).
#' @return a list containing the following elements:
#' \itemize{
#' \item{\code{ncomp}: the number of components used.}
#' \item{\code{coefficients}: the matrix of regression coefficients.}
#' \item{\code{bo}: a matrix of one row containing the intercepts for each component.}
#' \item{\code{scores}: the matrix of scores.}
#' \item{\code{X_loadings}: the matrix of X loadings.}
#' \item{\code{Y_loadings}: the matrix of Y loadings.}
#' \item{\code{vip}: the projection matrix.}
#' \item{\code{selectivity_ratio}: the matrix of selectivity ratio (see Rajalahti, Tarja, et al. 2009).}
#' \item{\code{Y}: the \code{Y} input.}
#' \item{\code{variance}: a \code{list} conating two objects: \code{x_var} and \code{y_var}.
#' These objects contain information on the explained variance for the \code{X} and \code{Y} matrices respectively.}
#' \item{\code{transf}: a \code{list} conating two objects: \code{Xcenter} and \code{Xscale}}.
#' \item{\code{weights}: the matrix of wheights.}
#' }
#' @author Leonardo Ramirez-Lopez
#' @keywords internal
#' @noRd
opls_get_all <- function(X, Y, ncomp, scale, maxiter, tol, algorithm = "pls", xls_min_w = 3L, xls_max_w = 15L) {
.Call(`_resemble_opls_get_all`, X, Y, ncomp, scale, maxiter, tol, algorithm, xls_min_w, xls_max_w)
}
#' @title orthogonal scores algorithn of partial leat squares (opls)
#' @description Computes orthogonal socres partial least squares (opls)
#' regressions with the NIPALS algorithm. It allows multiple response variables.
#' It does not return the variance information of the components. NOTE: For
#' internal use only!
#' @usage
#' opls(X,
#' Y,
#' ncomp,
#' scale,
#' maxiter,
#' tol,
#' algorithm = "pls",
#' xls_min_w = 3,
#' xls_max_w = 15)
#'
#' @param X a matrix of predictor variables.
#' @param Y a matrix of either a single or multiple response variables.
#' @param ncomp the number of pls components.
#' @param scale logical indicating whether \code{X} must be scaled.
#' @param maxiter maximum number of iterations.
#' @param tol limit for convergence of the algorithm in the nipals algorithm.
#' @param algorithm (for weights computation) a character string indicating
#' what method to use. Options are:
#' \code{'pls'} for pls (using covariance between X and Y),
#' \code{'mpls'} for modified pls (using correlation between X and Y) or
#' \code{'xls'} for extended pls (as implemented in BUCHI NIRWise PLUS software).
#' @param xls_min_w (for weights computation) an integer indicating the minimum window size for the "xls"
#' method. Only used if \code{algorithm = 'xls'}. Default is 3 (as in BUCHI NIRWise PLUS software).
#' @param xls_max_w (for weights computation) an integer indicating the maximum window size for the "xls"
#' method. Only used if \code{algorithm = 'xls'}. Default is 15 (as in BUCHI NIRWise PLUS software).
#' @return a list containing the following elements:
#' \itemize{
#' \item{\code{coefficients}: the matrix of regression coefficients.}
#' \item{\code{bo}: a matrix of one row containing the intercepts for each component.}
#' \item{\code{scores}: the matrix of scores.}
#' \item{\code{X_loadings}: the matrix of X loadings.}
#' \item{\code{Y_loadings}: the matrix of Y loadings.}
#' \item{\code{projection_mat}: the projection matrix.}
#' \item{\code{Y}: the \code{Y} input.}
#' \item{\code{transf}: a \code{list} conating two objects: \code{Xcenter} and \code{Xscale}}.
#' \item{\code{weights}: the matrix of wheights.}}
#' @author Leonardo Ramirez-Lopez
#' @noRd
#' @keywords internal
opls <- function(X, Y, ncomp, scale, maxiter, tol, algorithm = "pls", xls_min_w = 3L, xls_max_w = 15L) {
.Call(`_resemble_opls`, X, Y, ncomp, scale, maxiter, tol, algorithm, xls_min_w, xls_max_w)
}
#' @title Fast orthogonal scores algorithm of partial least squares (PLS)
#' @description Computes orthogonal scores partial least squares (PLS)
#' regression using either NIPALS or SIMPLS algorithm. Supports multiple
#' response variables. In contrast to \code{opls}, this function omits
#' auxiliary outputs (e.g. scores, explained variance) not required for
#' local regression. For internal use only.
#' @usage
#' opls_get_basics(X, Y, ncomp, scale,
#' maxiter, tol,
#' algorithm = "pls",
#' xls_min_w = 3,
#' xls_max_w = 15)
#' @param X a matrix of predictor variables.
#' @param Y a matrix of either a single or multiple response variables.
#' @param ncomp the number of PLS components.
#' @param scale logical indicating whether \code{X} must be scaled.
#' @param maxiter maximum number of iterations (only used for NIPALS-based
#' algorithms: \code{'pls'}, \code{'mpls'}, \code{'xls'}).
#' @param tol convergence tolerance for the NIPALS algorithm (only used for
#' NIPALS-based algorithms).
#' @param algorithm a character string indicating the PLS algorithm to use:
#' \itemize{
#' \item{\code{'pls'}: standard PLS using covariance between X and Y for
#' weight computation (NIPALS algorithm).}
#' \item{\code{'mpls'}: modified PLS using correlation between X and Y for
#' weight computation (NIPALS algorithm). See Shenk and Westerhaus (1991).}
#' \item{\code{'xls'}: extended PLS as implemented in BUCHI NIRWise PLUS
#' software (NIPALS algorithm).}
#' \item{\code{'simpls'}: SIMPLS algorithm (de Jong, 1993). Computationally
#' faster as it avoids iterative X deflation. Parameters \code{maxiter},
#' \code{tol}, \code{xls_min_w}, and \code{xls_max_w} are ignored.}
#' }
#' @param xls_min_w an integer indicating the minimum window size for the
#' \code{'xls'} method. Only used if \code{algorithm = 'xls'}. Default is 3.
#' @param xls_max_w an integer indicating the maximum window size for the
#' \code{'xls'} method. Only used if \code{algorithm = 'xls'}. Default is 15.
#' @return a list containing:
#' \itemize{
#' \item{\code{ncomp}: the number of PLS components.}
#' \item{\code{coefficients}: the matrix of regression coefficients.}
#' \item{\code{bo}: a matrix containing the intercepts for each component.}
#' \item{\code{X_loadings}: the matrix of X loadings.}
#' \item{\code{Y_loadings}: the matrix of Y loadings.}
#' \item{\code{projection_mat}: the projection matrix for computing scores
#' from new data.}
#' \item{\code{transf}: a list containing:
#' \itemize{
#' \item{\code{Xcenter}: row vector of column means used for centering.}
#' \item{\code{Xscale}: row vector of column standard deviations used
#' for scaling (ones if \code{scale = FALSE}).}
#' }
#' }
#' \item{\code{weights}: the matrix of PLS weights.}
#' }
#' @references
#' de Jong, S. (1993). SIMPLS: An alternative approach to partial least
#' squares regression. Chemometrics and Intelligent Laboratory Systems,
#' 18(3), 251-263.
#'
#' Shenk, J.S., & Westerhaus, M.O. (1991). Populations structuring of near
#' infrared spectra and modified partial least squares regression. Crop
#' Science, 31(6), 1548-1555.
#' @author Leonardo Ramirez-Lopez
#' @keywords internal
#' @noRd
opls_get_basics <- function(X, Y, ncomp, scale, maxiter, tol, algorithm = "pls", xls_min_w = 3L, xls_max_w = 15L) {
.Call(`_resemble_opls_get_basics`, X, Y, ncomp, scale, maxiter, tol, algorithm, xls_min_w, xls_max_w)
}
#' @title Prediction function for the \code{opls} and \code{fopls} functions
#' @description Predicts response values based on a model generated by either by \code{opls} or the \code{fopls} functions.
#' For internal use only!.
#' @usage predict_opls(bo, b, ncomp, newdata, scale, Xscale)
#' @param bo a numeric value indicating the intercept.
#' @param b the matrix of regression coefficients.
#' @param ncomp an integer value indicating how may components must be used in the prediction.
#' @param newdata a matrix containing the predictor variables.
#' @param scale a logical indicating whether the matrix of predictors used to create the regression model was scaled.
#' @param Xscale if \code{scale = TRUE} a matrix of one row with the values that must be used for scaling \code{newdata}.
#' @return a matrix of predicted values.
#' @author Leonardo Ramirez-Lopez
#' @keywords internal
#' @noRd
predict_opls <- function(bo, b, ncomp, newdata, scale, Xscale) {
.Call(`_resemble_predict_opls`, bo, b, ncomp, newdata, scale, Xscale)
}
#' @title Projection function for the \code{opls} function
#' @description Projects new spectra onto a PLS space based on a model generated by either by \code{opls} or the \code{opls2} functions.
#' For internal use only!.
#' @usage project_opls(projection_mat, ncomp, newdata, scale, Xcenter, Xscale)
#' @param projection_mat the projection matrix generated by the \code{opls} function.
#' @param ncomp an integer value indicating how may components must be used in the prediction.
#' @param newdata a matrix containing the predictor variables.
#' @param scale a logical indicating whether the matrix of predictors used to create the regression model was scaled.
#' @param Xscale if \code{scale = TRUE} a matrix of one row with the values that must be used for scaling \code{newdata}.
#' @param Xcenter a matrix of one row with the values that must be used for centering \code{newdata}.
#' @return a matrix corresponding to the new spectra projected onto the PLS space
#' @author Leonardo Ramirez-Lopez
#' @keywords internal
#' @noRd
project_opls <- function(projection_mat, ncomp, newdata, scale, Xcenter, Xscale) {
.Call(`_resemble_project_opls`, projection_mat, ncomp, newdata, scale, Xcenter, Xscale)
}
#' @title Projection to pls and then re-construction
#' @description Projects spectra onto a PLS space and then reconstructs it back.
#' @usage reconstruction_error(x,
#' projection_mat,
#' xloadings,
#' scale,
#' Xcenter,
#' Xscale,
#' scale_back = FALSE)
#' @param x a matrix to project.
#' @param projection_mat the projection matrix generated by the \code{opls_get_basics} function.
#' @param xloadings the loadings matrix generated by the \code{opls_get_basics} function.
#' @param scale logical indicating if scaling is required
#' @param Xcenter a matrix of one row with the centering values
#' @param Xscale a matrix of one row with the scaling values
#' @param scale_back compute the reconstruction error after de-centering the
#' data and de-scaling it.
#' @return a matrix of 1 row and 1 column.
#' @author Leonardo Ramirez-Lopez
#' @keywords internal
#' @noRd
reconstruction_error <- function(x, projection_mat, xloadings, scale, Xcenter, Xscale, scale_back = FALSE) {
.Call(`_resemble_reconstruction_error`, x, projection_mat, xloadings, scale, Xcenter, Xscale, scale_back)
}
#' @title Internal Cpp function for performing leave-group-out cross-validations for pls regression
#' @description For internal use only!.
#' @usage opls_cv_cpp(X, Y, scale, method,
#' mindices, pindices,
#' min_component, ncomp,
#' new_x,
#' maxiter, tol,
#' wapls_grid,
#' algorithm,
#' statistics = TRUE)
#' @param X a matrix of predictor variables.
#' @param Y a matrix of a single response variable.
#' @param scale a logical indicating whether the matrix of predictors
#' (\code{X}) must be scaled.
#' @param method the method used for regression. One of the following options:
#' \code{'pls'} or \code{'wapls'} or \code{'completewapls1p'}.
#' @param mindices a matrix with \code{n} rows and \code{m} columns where
#' \code{m} is equivalent to the number of resampling iterations. The elements
#' of each column indicate the indices of the observations to be used for
#' modeling at each iteration.
#' @param pindices a matrix with \code{k} rows and \code{m} columns where
#' \code{m} is equivalent to the number of
#' resampling iterations. The elements of each column indicate the indices of
#' the observations to be used for predicting at each iteration.
#' @param min_component an integer indicating the number of minimum pls
#' components (if the \code{method = 'pls'}).
#' @param ncomp an integer indicating the number of pls components.
#' @param new_x a matrix of one row corresponding to the observation to be
#' predicted (if the \code{method = 'wapls'}).
#' @param maxiter maximum number of iterations.
#' @param tol limit for convergence of the algorithm in the nipals algorithm.
#' @param wapls_grid the grid on which the search for the best combination of
#' minimum and maximum pls factors of \code{'wapls'} is based on in case
#' \code{method = 'completewapls1p'}.
#' @param algorithm either pls (\code{'pls'}) or modified pls (\code{'mpls'}).
#' See \code{get_weigths} function.
#' @param statistics a logical value indicating whether the precision and
#' accuracy statistics are to be returned, otherwise the predictions for each
#' validation segment are retrieved.
#' @return
#' if \code{statistics = true} a list containing the following one-row matrices:
#' \itemize{
#' \item{\code{rmse_seg}: the RMSEs.}
#' \item{\code{st_rmse_seg}: the standardized RMSEs.}
#' \item{\code{rsq_seg}: the coefficients of determination.}
#' }
#'
#' if \code{statistics = false} a list containing the following one-row matrices:
#' \itemize{
#' \item{\code{predictions}: the predictions of each of the validation
#' segments in \code{pindices}. Each column in \code{pindices} contains the
#' validation indices of a segment.}
#' \item{\code{st_rmse_seg}: the standardized RMSEs.}
#' \item{\code{rsq_seg}: the coefficients of determination.}
#' }
#'
#' If \code{method = "wapls"}, data of the pls weights are output in this
#' list(\code{compweights}).
#'
#' If \code{method = "completewapls1"}, data of all the combination of
#' components passed in \code{wapls_grid} are
#' output in this list(\code{complete_compweights}).
#'
#' @author Leonardo Ramirez-Lopez
#' @keywords internal
#' @noRd
opls_cv_cpp <- function(X, Y, scale, method, mindices, pindices, min_component, ncomp, new_x, maxiter, tol, wapls_grid, algorithm, statistics = TRUE) {
.Call(`_resemble_opls_cv_cpp`, X, Y, scale, method, mindices, pindices, min_component, ncomp, new_x, maxiter, tol, wapls_grid, algorithm, statistics)
}
#' @title Orthogonal scores algorithm of partial least squares for gesearch
#' @description Computes orthogonal scores partial least squares (PLS)
#' regression using either NIPALS or SIMPLS algorithm. This function is
#' optimised for the \code{gesearch} evolutionary search and computes only
#' the outputs required for weakness score evaluation: predictions,
#' reconstruction error, and score-space dissimilarity.
#'
#' NOTE: This function supports only a single response variable (PLS1).
#' For internal use only.
#' @usage
#' opls_gesearch(Xr, Yr, Xu, ncomp, scale,
#' response = FALSE, reconstruction = TRUE,
#' similarity = TRUE, fresponse = TRUE,
#' algorithm = "pls")
#'
#' @param Xr a matrix of predictor variables for the reference/training set.
#' @param Yr a single-column matrix of the response variable for the
#' reference/training set. Only single-response (PLS1) is supported.
#' @param Xu a matrix of predictor variables for the target/test set.
#' @param ncomp the number of PLS components.
#' @param scale logical indicating whether \code{Xr} and \code{Xu} must be
#' scaled. Centering is always applied using parameters derived from
#' \code{Xr}.
#' @param response logical indicating whether to compute predictions for
#' \code{Xu}. Used for the response weakness score (\code{w_r}) in
#' \code{gesearch}. Default is \code{FALSE}.
#' @param reconstruction logical indicating whether to compute the
#' reconstruction error of \code{Xu}. Used for the reconstruction weakness
#' score (\code{w_q}) in \code{gesearch}. Default is \code{TRUE}.
#' @param similarity logical indicating whether to compute the distance
#' between \code{Xr} and \code{Xu} in the PLS score space. Used for the
#' similarity weakness score (\code{w_d}) in \code{gesearch}. Default is
#' \code{TRUE}.
#' @param fresponse logical indicating whether to compute the proportion of
#' response variance not explained by the model. Default is \code{TRUE}.
#' @param algorithm a character string indicating the PLS algorithm to use:
#' \itemize{
#' \item{\code{'pls'}: standard PLS using covariance between X and Y for
#' weight computation (NIPALS algorithm).}
#' \item{\code{'mpls'}: modified PLS using correlation between X and Y for
#' weight computation (NIPALS algorithm). See Shenk and Westerhaus (1991).}
#' \item{\code{'simpls'}: SIMPLS algorithm (de Jong, 1993). Computationally
#' faster as it avoids iterative X deflation.}
#' }
#' @return a list containing:
#' \itemize{
#' \item{\code{ncomp}: the number of components used.}
#' \item{\code{pred_response}: predictions for \code{Xu} (only if
#' \code{response = TRUE}).}
#' \item{\code{rmse_reconstruction}: RMSE of the spectral reconstruction
#' for \code{Xu} (only if \code{reconstruction = TRUE}).}
#' \item{\code{score_dissimilarity}: mean Euclidean distance between
#' \code{Xr} and \code{Xu} scores in Mahalanobis-scaled PLS space
#' (only if \code{similarity = TRUE}).}
#' \item{\code{residual_variance}: proportion of response variance not
#' explained by the model (only if \code{fresponse = TRUE}).}
#' }
#' @details
#' This function is designed for repeated evaluation within the
#' \code{gesearch} evolutionary search algorithm, where it may be called
#' ~10^5 times per run. It computes only the outputs necessary for
#' calculating weakness scores:
#' \itemize{
#' \item{Response weakness (\code{w_r}): prediction RMSE on the target,
#' requires \code{response = TRUE}.}
#' \item{Reconstruction weakness (\code{w_q}): spectral reconstruction
#' error, requires \code{reconstruction = TRUE}.}
#' \item{Similarity weakness (\code{w_d}): Mahalanobis distance in score
#' space, requires \code{similarity = TRUE}.}
#' }
#'
#' Preprocessing applies scaling (if requested) followed by centering,
#' using parameters derived from \code{Xr}. The same transformation is
#' applied to \code{Xu}.
#'
#' The \code{'simpls'} algorithm is faster than NIPALS-based methods
#' (\code{'pls'}, \code{'mpls'}) as it avoids iterative X deflation.
#' However, reconstruction errors and score-space distances differ
#' numerically between algorithms (rankings are typically similar).
#' Do not mix algorithms within a single \code{gesearch} run.
#'
#' @references
#' de Jong, S. (1993). SIMPLS: An alternative approach to partial least
#' squares regression. Chemometrics and Intelligent Laboratory Systems,
#' 18(3), 251-263.
#'
#' Shenk, J.S., & Westerhaus, M.O. (1991). Populations structuring of
#' near infrared spectra and modified partial least squares regression.
#' Crop Science, 31(6), 1548-1555.
#'
#' @author Leonardo Ramirez-Lopez
#' @keywords internal
#' @noRd
opls_gesearch <- function(Xr, Yr, Xu, ncomp, scale, response = FALSE, reconstruction = TRUE, similarity = TRUE, fresponse = TRUE, algorithm = "pls") {
.Call(`_resemble_opls_gesearch`, Xr, Yr, Xu, ncomp, scale, response, reconstruction, similarity, fresponse, algorithm)
}
#' @title Gaussian process regression with linear kernel (gaussian_process)
#' @description Carries out a gaussian process regression with a linear kernel (dot product). For internal use only!
#' @usage gaussian_process(X, Y, noisev, scale)
#' @param X a matrix of predictor variables
#' @param Y a matrix with a single response variable
#' @param noisev a value indicating the variance of the noise for Gaussian process regression. Default is 0.001. a matrix with a single response variable
#' @param scale a logical indicating whether both the predictors
#' and the response variable must be scaled to zero mean and unit variance.
#' @return a list containing the following elements:
#' \itemize{
#' \item{\code{b}: the regression coefficients.}
#' \item{\code{Xz}: the (final transformed) matrix of predictor variables.}
#' \item{\code{alpha}: the alpha matrix.}
#' \item{\code{is.scaled}: logical indicating whether both the predictors and response variable were scaled to zero mean and unit variance.}
#' \item{\code{Xcenter}: if matrix of predictors was scaled, the centering vector used for \code{X}.}
#' \item{\code{Xscale}: if matrix of predictors was scaled, the scaling vector used for \code{X}.}
#' \item{\code{Ycenter}: if matrix of predictors was scaled, the centering vector used for \code{Y}.}
#' \item{\code{Yscale}: if matrix of predictors was scaled, the scaling vector used for \code{Y}.}
#' }
#' @author Leonardo Ramirez-Lopez
#' @keywords internal
#' @noRd
gaussian_process <- function(X, Y, noisev = 0.001, scale = TRUE) {
.Call(`_resemble_gaussian_process`, X, Y, noisev, scale)
}
#' @title Prediction function for the \code{gaussian_process} function (Gaussian process regression with dot product covariance)
#' @description Predicts response values based on a model generated by the \code{gaussian_process} function (Gaussian process regression with dot product covariance). For internal use only!.
#' @usage predict_gaussian_process(Xz, alpha, newdata, scale, Xcenter, Xscale, Ycenter, Yscale)
#' @param newdata a matrix containing the predictor variables
#' @param scale a logical indicating whether the matrix of predictors used to create the regression model
#' (in the \code{gaussian_process} function) was scaled
#' @param Xcenter if \code{center = TRUE} a matrix of one row with the values that must be used for centering \code{newdata}.
#' @param Xscale if \code{scale = TRUE} a matrix of one row with the values that must be used for scaling \code{newdata}.
#' @param Ycenter if \code{center = TRUE} a matrix of one row with the values that must be used for accounting for the centering of the response variable.
#' @param Yscale if \code{scale = TRUE} a matrix of one row with the values that must be used for accounting for the scaling of the response variable.
#' @return a matrix of predicted values
#' @author Leonardo Ramirez-Lopez
#' @keywords internal
#' @noRd
predict_gaussian_process <- function(Xz, alpha, newdata, scale, Xcenter, Xscale, Ycenter, Yscale) {
.Call(`_resemble_predict_gaussian_process`, Xz, alpha, newdata, scale, Xcenter, Xscale, Ycenter, Yscale)
}
#' @title Internal Cpp function for performing leave-group-out cross
#' validations for gaussian process
#' @description For internal use only!.
#' @usage gaussian_process_cv(X, Y, mindices, pindices, noisev = 0.001,
#' scale = TRUE, statistics = TRUE)
#' @param X a matrix of predictor variables.
#' @param Y a matrix of a single response variable.
#' @param mindices a matrix with \code{n} rows and \code{m} columns where \code{m} is equivalent to the number of
#' resampling iterations. The elements of each column indicate the indices of the observations to be used for modeling at each
#' iteration.
#' @param pindices a matrix with \code{k} rows and \code{m} columns where \code{m} is equivalent to the number of
#' resampling iterations. The elements of each column indicate the indices of the observations to be used for predicting at each
#' iteration.
#' @param scale a logical indicating whether both the predictors
#' and the response variable must be scaled to zero mean and unit variance.
#' @param statistics a logical value indicating whether the precision and
#' accuracy statistics are to be returned, otherwise the predictions for each
#' validation segment are retrieved.
#' @return a list containing the following one-row matrices:
#' \itemize{
#' \item{\code{rmse.seg}: the RMSEs.}
#' \item{\code{st.rmse.seg}: the standardized RMSEs.}
#' \item{\code{rsq.seg}: the coefficients of determination.}
#' }
#' @author Leonardo Ramirez-Lopez
#' @keywords internal
#' @noRd
gaussian_process_cv <- function(X, Y, mindices, pindices, noisev = 0.001, scale = TRUE, statistics = TRUE) {
.Call(`_resemble_gaussian_process_cv`, X, Y, mindices, pindices, noisev, scale, statistics)
}
#' @title Principal components based on the non-linear iterative partial least squares (nipals) algorithm
#' @description Computes orthogonal socres partial least squares (opls) regressions with the NIPALS algorithm. It allows multiple response variables.
#' For internal use only!
#' @usage
#' pca_nipals(X, ncomp, center, scale,
#' maxiter, tol,
#' pcSelmethod = "var",
#' pcSelvalue = 0.01)
#' @param X a matrix of predictor variables.
#' @param ncomp the number of pls components.
#' @param scale logical indicating whether \code{X} must be scaled.
#' @param maxiter maximum number of iterations.
#' @param tol limit for convergence of the algorithm in the nipals algorithm.
#' @param pcSelmethod the method for selecting the number of components.
#' Options are: \code{'cumvar'} (for selecting the number of principal components based on a given
#' cumulative amount of explained variance) and \code{"var"} (for selecting the number of principal
#' components based on a given amount of explained variance). Default is \code{'var'}
#' @param pcSelvalue a numerical value that complements the selected method (\code{pcSelmethod}).
#' If \code{"cumvar"} is chosen, it must be a value (larger than 0 and below 1) indicating the maximum
#' amount of cumulative variance that the retained components should explain. If \code{"var"} is chosen,
#' it must be a value (larger than 0 and below 1) indicating that components that explain (individually)
#' a variance lower than this threshold must be excluded. If \code{"manual"} is chosen, it must be a value
#' specifying the desired number of principal components to retain. Default is 0.01.
#' @return a list containing the following elements:
#' \itemize{
#' \item{\code{pc_scores}: a matrix of principal component scores.}
#' \item{\code{pc_loadings}: a matrix of of principal component loadings.}
#' \item{\code{variance}: a matrix of the variance of the principal components.}
#' \item{\code{scale}: a \code{list} conating two objects: \code{center} and \code{scale}, which correspond to the vectors used to center and scale the input matrix.}
#' }
#' @author Leonardo Ramirez-Lopez
#' @keywords internal
#' @noRd
pca_nipals <- function(X, ncomp, center, scale, maxiter, tol, pcSelmethod = "var", pcSelvalue = 0.01) {
.Call(`_resemble_pca_nipals`, X, ncomp, center, scale, maxiter, tol, pcSelmethod, pcSelvalue)
}
#' @title Internal: Fit a local weighted PLS model and predict for a query point
#'
#' @description
#' Fits a local Partial Least Squares (PLS) model using a neighborhood subset
#' and computes a weighted prediction for a target sample. The weighting is
#' done over multiple components using a provided evaluation grid.
#'
#' @param X Numeric matrix of predictors from the local neighborhood
#' (observations in rows, variables in columns).
#' @param Y Numeric matrix (single column) of corresponding response values.
#' @param xval Numeric matrix (single row) representing the query sample to
#' predict.
#' @param emgrid Numeric matrix used to weight component-wise predictions.
#' @param ncomp_max Integer. Maximum number of PLS components to fit.
#' @param ncomp_min Integer. Minimum number of PLS components to use in
#' prediction.
#' @param scale Logical. Whether to scale predictors before PLS fitting.
#' @param max_iter Numeric. Maximum number of iterations for the PLS algorithm.
#' @param tol Numeric. Convergence tolerance for the PLS algorithm.
#' @param algorithm Character. PLS algorithm to use: \code{"mpls"} (default),
#' \code{"pls"} (nipals), or \code{"simpls"}.
#'
#' @return
#' A numeric vector of weighted predictions (length equal to number of rows
#' in \code{emgrid}).
#'
#' @details
#' The function performs the following steps:
#' \enumerate{
#' \item Fits a PLS model on \code{X} and \code{Y} with up to
#' \code{ncomp_max} components.
#' \item Extracts centering and scaling parameters from the fitted model.
#' \item Computes component weights for \code{xval} using
#' \code{get_local_pls_weights()}.
#' \item Predicts component-wise responses using \code{predict_opls()}.
#' \item Applies \code{emgrid} weights scaled by component weights.
#' \item Returns row-normalized weighted average of predictions.
#' }
#'
#' @author Leonardo Ramirez-Lopez
#' @keywords internal
#' @noRd
ith_local_fit <- function(X, Y, xval, emgrid, ncomp_max, ncomp_min, scale, max_iter, tol, algorithm = "mpls") {
.Call(`_resemble_ith_local_fit`, X, Y, xval, emgrid, ncomp_max, ncomp_min, scale, max_iter, tol, algorithm)
}
#' @title Compute Final Local PLS Model Outputs
#' @description
#' This function calculates the final local model coefficients, intercept,
#' scaled variable importance (VIP), and selectivity ratio for a single observation
#' using a weighted combination of PLS components.
#'
#' @param X A matrix of predictor variables used for calibration.
#' @param Y A matrix of response variables used for calibration.
#' @param new_x A single observation (1 x p) of predictor variables to compute weights.
#' @param ncomp_min The minimum number of PLS components to include in the final model.
#' @param ncomp_max The maximum number of PLS components to include in the final model.
#' @param scale Logical indicating whether to scale the data.
#' @param maxiter Maximum number of iterations allowed during the NIPALS algorithm.
#' @param tol Tolerance threshold for convergence in the iterative algorithm.
#' @param algorithm \code{'mpls'} (defalt), \code{'pls'} (nipals), \code{'simpls'}.
#'
#' @return A list with the following elements:
#' \itemize{
#' \item \code{ib0}: Intercept term, computed as a weighted sum of component-specific intercepts.
#' \item \code{ibs}: Weighted regression coefficients.
#' \item \code{ivips}: Weighted variable importance (VIP) scores, scaled by component SDs.
#' \item \code{isratio}: Weighted selectivity ratios, scaled by component SDs.
#' \item \code{Xscale}: Scaling vector used to scale \code{X} (if \code{scale = TRUE}).
#' }
#'
#' @keywords internal
#' @noRd
final_fits_cpp <- function(X, Y, new_x, ncomp_min, ncomp_max, scale, maxiter, tol, algorithm = "mpls") {
.Call(`_resemble_final_fits_cpp`, X, Y, new_x, ncomp_min, ncomp_max, scale, maxiter, tol, algorithm)
}
#' @title Internal: Predict using local PLS coefficients and optional
#' dissimilarities
#'
#' @description
#' Computes predictions for a new observation using local PLS models
#' represented by coefficients (\code{plslib}). The prediction is based on
#' inverse-scaled feature values. If a dissimilarity vector is provided, it is
#' prepended to the input features before inverse scaling.
#'
#' @param plslib A numeric matrix of PLS model coefficients (n_models × p+1).
#' First column is the intercept; remaining columns are coefficients for
#' scaled features.
#' @param xscale A numeric matrix of scaling values (n_models × p), same
#' number of columns as \code{plslib[,-1]}.
#' @param Xu A numeric vector of length p representing the query sample to
#' be predicted.
#' @param dxrxu Optional numeric vector of dissimilarities between \code{Xu}
#' and reference samples. If provided, prepended to \code{Xu} as additional
#' predictive features. Default is \code{R_NilValue} (NULL).
#'
#' @return A numeric vector of length \code{nrow(plslib)} containing the
#' predicted response for \code{Xu} from each local model.
#'
#' @details
#' For each local model (row of \code{plslib}), the function:
#' \enumerate{
#' \item Optionally prepends \code{dxrxu} to \code{Xu}
#' \item Computes inverse-scaled features: \code{Xu / xscale[i,]}
#' \item Computes prediction: \code{intercept + sum(coefficients * scaled_features)}
#' }
#'
#' @note
#' This is an internal function optimised for performance in the prediction
#' loop of \code{predict.liblex}.
#'
#' @keywords internal
#' @noRd
#' @author Leonardo Ramirez-Lopez
ith_pred_cpp <- function(plslib, xscale, Xu, dxrxu = NULL) {
.Call(`_resemble_ith_pred_cpp`, plslib, xscale, Xu, dxrxu)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.