From 6d8faf2d54f79e164862f93a2db8eee824468130 Mon Sep 17 00:00:00 2001
From: GFabien <fabien.girka@gmail.com>
Date: Fri, 29 Nov 2024 22:42:20 +0100
Subject: [PATCH] Propagate factors

---
 R/rgcca_inner_loop.R |  6 +++++-
 R/rgcca_outer_loop.R | 16 ++++++++++++++--
 2 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/R/rgcca_inner_loop.R b/R/rgcca_inner_loop.R
index c13303be..e04bd70e 100644
--- a/R/rgcca_inner_loop.R
+++ b/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
+  ))
 }
diff --git a/R/rgcca_outer_loop.R b/R/rgcca_outer_loop.R
index 26901107..373d5755 100644
--- a/R/rgcca_outer_loop.R
+++ b/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
   )