Propagate factors

R/rgcca_inner_loop.R

@@ -88,6 +88,10 @@ rgcca_inner_loop <- function(A, C, g, dg, tau = rep(1, length(A)),
   block_objects <- lapply(block_objects, block_postprocess, ctrl)
   a <- lapply(block_objects, "[[", "a")
   Y <- do.call(cbind, lapply(block_objects, "[[", "Y"))
+  factors <- lapply(block_objects, "[[", "factors")
+  weights <- lapply(block_objects, "[[", "weights")
 
-  return(list(Y = Y, a = a, crit = crit, tau = tau))
+  return(list(
+    Y = Y, a = a, factors = factors, weights = weights, crit = crit, tau = tau
+  ))
 }

R/rgcca_outer_loop.R

@@ -50,8 +50,10 @@ rgcca_outer_loop <- function(blocks, connection = 1 - diag(length(blocks)),
   crit <- list()
   R <- blocks
 
-  a <- lapply(seq(J), function(b) c())
-  Y <- lapply(seq(J), function(b) c())
+  a <- Y <- weights <- lapply(seq(J), function(b) c())
+  factors <- lapply(seq(J), function(b) {
+    lapply(seq_along(dim(R[[b]])[-1]), function(m) NULL)
+  })
 
   if (superblock && comp_orth) {
     P <- c()
@@ -113,6 +115,14 @@ rgcca_outer_loop <- function(blocks, connection = 1 - diag(length(blocks)),
     # Store Y, a, factors and weights
     a <- lapply(seq(J), function(b) cbind(a[[b]], gcca_result$a[[b]]))
     Y <- lapply(seq(J), function(b) cbind(Y[[b]], gcca_result$Y[, b]))
+    factors <- lapply(seq(J), function(b) {
+      lapply(seq_along(factors[[b]]), function(m) {
+        cbind(factors[[b]][[m]], gcca_result$factors[[b]][[m]])
+      })
+    })
+    weights <- lapply(
+      seq(J), function(b) cbind(weights[[b]], gcca_result$weights[[b]])
+    )
 
     # Deflation procedure
     if (n == N + 1) break
@@ -148,6 +158,8 @@ rgcca_outer_loop <- function(blocks, connection = 1 - diag(length(blocks)),
     Y = Y,
     a = a,
     astar = astar,
+    factors = factors,
+    weights = weights,
     tau = computed_tau,
     crit = crit, primal_dual = primal_dual
   )