Improve Regularized SVD Design

- Add support for mixed BIC / exhaustive solvers
- Add support for multi-rank solvers (Hotelling PCA deflation only)
- Various minor clean-ups

R/moma_5Dlist_extractor.R

@@ -0,0 +1,37 @@
+get_5Dlist_elem <- function(x, alpha_u_i, lambda_u_i, alpha_v_i, lambda_v_i, rank_i = 1) {
+    if (!inherits(x, "MoMA_5D_list")) {
+        moma_error(sQuote("x"), " should be a ", sQuote("MoMA_5D_list"), " object.")
+    }
+    n_alpha_u <- dim(x)[1]
+    n_lambda_u <- dim(x)[2]
+    n_alpha_v <- dim(x)[3]
+    n_lambda_v <- dim(x)[4]
+    n_rank <- dim(x)[5]
+
+    # NOTE: R index starts from 1
+    if (
+        alpha_u_i <= 0 || alpha_u_i > n_alpha_u ||
+            lambda_u_i <= 0 || lambda_u_i > n_lambda_u ||
+            alpha_v_i <= 0 || alpha_v_i > n_alpha_v ||
+            lambda_v_i <= 0 || lambda_v_i > n_lambda_v ||
+            rank_i <= 0 || rank_i > n_rank
+    ) {
+        moma_error(
+            "Invalid index (", alpha_u_i, ",", lambda_u_i,
+            ",", alpha_v_i, ",", lambda_v_i, ",", rank_i, "), dim = ",
+            dim(x)
+        )
+    }
+
+    return(x[
+        rank_i + n_rank * (
+            lambda_v_i - 1 + n_lambda_v * (
+                alpha_v_i - 1 + n_alpha_v * (
+                    lambda_u_i - 1 + n_lambda_u * (
+                        alpha_u_i - 1
+                    )
+                )
+            )
+        )
+    ])
+}

R/moma_svd.R → R/moma_expose.R

@@ -105,18 +105,6 @@ moma_svd <- function(
     lambda_u <- as.vector(lambda_u)
     lambda_v <- as.vector(lambda_v)
 
-    # update argument lists
-    # GP loop argument
-    algo_settings_list <- list(
-        X = X,
-        lambda_u = lambda_u,
-        lambda_v = lambda_v,
-        # smoothness
-        alpha_u = alpha_u,
-        alpha_v = alpha_v,
-        k = k
-    )
-
     if (!is.matrix(X)) {
         moma_error("X must be a matrix.")
     }
@@ -161,7 +149,16 @@ moma_svd <- function(
     # Pack all argument into a list
     # First we check the smoothness term argument.
     algo_settings_list <- c(
-        algo_settings_list,
+        list(
+            X = X,
+            lambda_u = lambda_u,
+            lambda_v = lambda_v,
+            # smoothness
+            alpha_u = alpha_u,
+            alpha_v = alpha_v,
+            rank = k
+        ),
+        # Penalties
         list(
             Omega_u = check_omega(Omega_u, alpha_u, n),
             Omega_v = check_omega(Omega_v, alpha_v, p),
@@ -173,12 +170,12 @@ moma_svd <- function(
 
     if (is_multiple_para) {
         if (select == "gridsearch") {
-            a <- do.call("cpp_sfpca_grid", algo_settings_list)
+            a <- do.call("cpp_moma_grid_search", algo_settings_list)
             class(a) <- "moma_svd_grid"
             return(a)
         }
         else if (select == "nestedBIC") {
-            a <- do.call("cpp_sfpca_nestedBIC", algo_settings_list)
+            a <- do.call("cpp_moma_criterion_search", algo_settings_list)
             class(a) <- "moma_svd_nestedBIC"
             return(a)
         }
@@ -187,6 +184,6 @@ moma_svd <- function(
         }
     }
     else {
-        return(do.call("cpp_sfpca", algo_settings_list))
+        return(do.call("cpp_moma_multi_rank", algo_settings_list))
     }
 }

R/sfpca.R

@@ -88,7 +88,7 @@ sfpca <- function(X,
         nonneg = nonneg_v,
         group = group_v
     )
-    return(cpp_sfpca(
+    return(cpp_moma_multi_rank(
         X = X,
         alpha_u = alpha_u, alpha_v = alpha_v,
         Omega_u = Omega_u, Omega_v = Omega_v,
@@ -98,6 +98,6 @@ sfpca <- function(X,
         EPS = EPS, MAX_ITER = MAX_ITER,
         EPS_inner = EPS_inner, MAX_ITER_inner = MAX_ITER_inner,
         solver = solver,
-        k = k
+        rank = k
     ))
 }