R/extractor.feature.R

Defines functions extractor.feature

Documented in extractor.feature

#'
#' Extracting features for the pre-trained Long Short Term Memory (LSTM) Network
#'
#' @description
#' This function is used to extract the features required by the pre-trained
#' Long Short Term Memory (LSTM) Network.  @seealso \link[LSTMfactors]{LSTM}
#'
#' @param response A required \code{N} × \code{I} matrix or data.frame consisting of the responses of \code{N} individuals
#'          to \code{I} items.
#' @param cor.type A character string indicating which correlation coefficient (or covariance) is to be computed. One of "pearson" (default),
#'          "kendall", or "spearman". @seealso \link[stats]{cor}.
#' @param use An optional character string giving a method for computing covariances in the presence of missing values. This
#'          must be one of the strings "everything", "all.obs", "complete.obs", "na.or.complete", or "pairwise.complete.obs" (default).
#'          @seealso \link[stats]{cor}.
#'
#'
#' @return A matrix (1×20) containing all the features for the LSTM.
#'
#'
#' @details
#' For \code{"LSTM"}, a total of 2 types of features. These features are as follows:
#' \describe{
#'   \item{(1)}{The top 10 largest eigenvalues.}
#'   \item{(2)}{The difference of the top 10 largest eigenvalues to the corresponding reference eigenvalues from
#'              arallel Analysis (PA). @seealso \link[EFAfactors]{PA}}
#' }
#'
#' @seealso \link[LSTMfactors]{LSTM}
#'
#' @author Haijiang Qin <Haijiang133@outlook.com>
#'
#'
#' @examples
#' library(LSTMfactors)
#' set.seed(123)
#'
#' ##Take the data.DAPCS dataset as an example.
#' data(data.DAPCS)
#'
#' response <- as.matrix(data.DAPCS[, 3:22]) ## loading data
#'
#' \donttest{
#' ## Run extractor.feature function
#' features <- extractor.feature(response)
#'
#' print(features)
#' }
#'
#'
#'
#'
#' @export
#'
#' @importFrom stats cor
#' @importFrom EFAfactors EKC PA
#'
extractor.feature <- function(response,
                              cor.type = "pearson",
                              use = "pairwise.complete.obs"){

  if(!any(rep(use, 5) == c("everything", "all.obs", "complete.obs", "na.or.complete", "pairwise.complete.obs")))
    stop("'use' must be one of the strings 'everything', 'all.obs', 'complete.obs', 'na.or.complete', or 'pairwise.complete.obs' !")

  response <- scale(response)

  EKC.obj <- EFAfactors::EKC(response, cor.type=cor.type, use=use, vis = FALSE, plot = FALSE)
  PA.PCA.obj <- EFAfactors::PA(response, fa = "pc", n.iter = 100, cor.type=cor.type, use=use, vis = FALSE, plot = FALSE)
  eigen.PCA <- EKC.obj$eigen.value
  eigen.ref.PA.PCA <- PA.PCA.obj$eigen.ref[1:10]
  features <- c(eigen.PCA[1:10], eigen.PCA[1:10] - eigen.ref.PA.PCA)

  features[which(is.na(features))] <- 0
  features[which(features == -Inf)] <- 0
  features <- t(features)

  class(features) <- "features.LSTM"

  return(features)
}

Try the LSTMfactors package in your browser

Any scripts or data that you put into this service are public.

LSTMfactors documentation built on Aug. 8, 2025, 7:33 p.m.