R-Level PCA Wrappers

Initial Version of R-Level PCA Functionality

Add R-Level PCA functions. The most general of these is SFPCA, but we also provide
special cases for one- and two-way sparse PCA, as well as one- and two-way smooth
PCA. Internally, these are implemented using R6 classes, which will be useful for
caching solutions.

DESCRIPTION

@@ -11,7 +11,7 @@ Authors@R: c(
 Description: Unified approach to modern multivariate analysis providing sparse,
     smooth, and structured versions of PCA, PLS, LDA, and CCA.
 License: GPL (>= 2)
-Imports: Rcpp
+Imports: Rcpp, R6
 Suggests:
     knitr,
     rmarkdown,

R/moma_arguments.R

@@ -1,3 +1,20 @@
+#' Sparsity-inducing penalty in \code{MoMA}
+#' In the package \code{MoMA}, we support the following sparsity-inducing
+#' penalty functions.
+#' \itemize{
+#'   \item{\code{\link{lasso}}} TODO
+#'   \item{\code{\link{mcp}}} TODO
+#'   \item{\code{\link{scad}}} TODO
+#'   \item{\code{\link{slope}}} TODO
+#'   \item{\code{\link{grplasso}}} TODO
+#'   \item{\code{\link{fusedlasso}}} TODO
+#'   \item{\code{\link{l1tf}}} TODO
+#'   \item{\code{\link{spfusedlasso}}} TODO
+#'   \item{\code{\link{cluster}}} TODO
+#' }
+#' @name moma_sparsity
+NULL
+
 # Check whether `x` is a boolean value
 is_logical_scalar <- function(x) {
     return(is.logical(x) && (length(x) == 1) && !is.na(x))
@@ -312,6 +329,21 @@ cluster <- function(..., w = NULL, ADMM = FALSE,
     return(arglist)
 }
 
+
+#' Algorithm settings for solving a penalzied SVD problem
+#'
+#' To find an (approximate) solution to a penalized SVD (Singular Value Decomposition) problem is to solve two
+#' penalized regression problems iteratively (outer loop). Each penalized regression (inner loop)
+#' is solved using one of the three algorithms: ISTA (Iterative Shrinkage-Thresholding Algorithm),
+#' FISTA (Fast Iterative Shrinkage-Thresholding Algorithm) and
+#' One-step ISTA (an approximated version of ISTA).
+#' @param ... to force users to specify arguments by names
+#' @param EPS precision for outer loop
+#' @param MAX_ITER the maximum number of iterations for outer loop
+#' @param EPS_inner precision for inner loop
+#' @param MAX_ITER_inner the maximum number of iterations for inner loop
+#' @param solver a string in \code{c("ista", "fista", "onestepista")}.
+#' @export
 moma_pg_settings <- function(..., EPS = 1e-10, MAX_ITER = 1000,
                              EPS_inner = 1e-10, MAX_ITER_inner = 1e+5,
                              solver = c("ista", "fista", "onestepista")) {

R/moma_expose.R

@@ -28,19 +28,31 @@ add_default_prox_args <- function(sparsity_type) {
     return(modifyList(MOMA_DEFAULT_PROX, sparsity_type))
 }
 
+is.wholenumber <-
+    function(x, tol = .Machine$double.eps^0.5) abs(x - round(x)) < tol
 
 # This function checks the validity of Omega and alpha
 check_omega <- function(Omega, alpha, n) {
+
+    # check if Omega is a matrix
+    if (!is.matrix(Omega) && !is.null(Omega)) {
+        moma_error("Omega_u/v is not a matrix.")
+    }
+
+    # TODO: store them as sparse matrices using the package Matrix
     if (length(alpha) == 1 && alpha == 0) {
         # discard the Omega matrix specified by users
         Omega <- diag(n)
     }
     else if (is.null(Omega)) {
         # The user wants smooth penalty
         # but does not specify Omega matrix
-        Omega <- second_diff_mat(n)
+        Omega <- second_diff_mat(n) # TODO: should not overwrite
     }
     else {
+        # At this point, users have specified an Omega and
+        # non-zero penalty levels explicitly
+
         # Check validity of Omega if users speicify both alpha and Omega
         if (dim(Omega)[1] != dim(Omega)[2]) {
             moma_error(
@@ -55,6 +67,7 @@ check_omega <- function(Omega, alpha, n) {
                 ", but is actually ", dim(Omega)[1], "x", dim(Omega)[1]
             )
         }
+        # TODO: check definiteness and symmetry of Omega
     }
     return(Omega)
 }