R/weighted_significance.R

In plsRglm: Partial Least Squares Regression for Generalized Linear Models

#' Compute cross-validation weighted significance scores
#'
#' This function combines the empirical distribution of selected component
#' counts with a matrix of bootstrap significance indicators. Rows in
#' \code{matind} are matched to component counts using names such as
#' \code{"YT1"}, \code{"YT2"}, and so on.
#'
#' @param cv_counts named vector or table of cross-validation component counts.
#' @param matind matrix-like object whose rows are named by model/component
#'   labels and whose columns are predictors. Values are typically logical
#'   significance indicators returned by \code{\link{confints2signifind}} and
#'   combined with \code{\link[base]{rbind}}.
#' @return Named numeric vector containing weighted significance scores for
#'   each predictor. When no row of \code{matind} matches \code{cv_counts}, the
#'   function returns a named vector of \code{NA_real_} values.
#' @author Frédéric Bertrand\cr
#' \email{frederic.bertrand@@lecnam.net}\cr
#' \url{https://fbertran.github.io/homepage/}
#' @seealso \code{\link{confints2signifind}}, \code{\link{cvtable}}, and
#'   \code{\link{signpred}}.
#' @keywords regression models
#' @examples
#'
#' cv_counts <- c("1" = 87, "2" = 13)
#' matind <- rbind(
#'   YT1 = c(X1 = TRUE, X2 = TRUE),
#'   YT2 = c(X1 = TRUE, X2 = FALSE)
#' )
#' weighted_significance(cv_counts, matind)
#'
#' @export weighted_significance
weighted_significance <- function(cv_counts, matind) {
  counts <- prop.table(cv_counts)
  row_keys <- paste0("YT", names(counts))
  keep <- row_keys %in% rownames(matind)

  if (!any(keep)) {
    out <- rep(NA_real_, ncol(matind))
    names(out) <- colnames(matind)
    return(out)
  }

  weights <- as.numeric(prop.table(counts[keep]))
  indicator <- as.matrix(matind[row_keys[keep], , drop = FALSE])
  out <- as.numeric(weights %*% indicator)
  names(out) <- colnames(matind)
  out
}