Rename weights as lambda

R/block.R

@@ -48,7 +48,7 @@ new_sparse_block <- function(x, j, sparsity, tol = 1e-08, ...) {
 new_tensor_block <- function(x, j, rank, mode_orth, ..., class = character()) {
   new_block(
     x, j, rank = rank, mode_orth = mode_orth, factors = NULL,
-    weights = NULL, ..., class = c(class, "tensor_block")
+    lambda = NULL, ..., class = c(class, "tensor_block")
   )
 }
 

R/block_init.R

@@ -57,7 +57,7 @@ block_init.tensor_block <- function(x, init = "svd") {
       }
     })
   }
-  x$weights <- rep(1 / sqrt(x$rank), x$rank)
+  x$lambda <- rep(1 / sqrt(x$rank), x$rank)
 
   return(block_project(x))
 }
@@ -79,11 +79,11 @@ block_init.regularized_tensor_block <- function(x, init = "svd") {
   }
   x$M <- x$tau + (1 - x$tau) * x$M / x$N
 
-  # Initialize the factors and weights using the tau = 1 strategy
+  # Initialize the factors and lambda using the tau = 1 strategy
   x <- NextMethod()
 
-  # Change weights to satisfy the constraints
-  x$weights <- x$weights / sqrt(x$M)
+  # Change lambda to satisfy the constraints
+  x$lambda <- x$lambda / sqrt(x$M)
   x$a <- x$a / sqrt(x$M)
   x$Y <- x$Y / sqrt(x$M)
   return(x)
@@ -106,6 +106,6 @@ block_init.separable_regularized_tensor_block <- function(x, init = "svd") {
     x$x <- mode_product(x$x, x$M[[m]], m = m + 1)
   }
 
-  # Initialize the factors and weights using the tau = 1 strategy
+  # Initialize the factors and lambda using the tau = 1 strategy
   NextMethod()
 }

R/block_postprocess.R

@@ -37,6 +37,6 @@ block_postprocess.separable_regularized_tensor_block <- function(x, ctrl) {
   x$factors <- lapply(seq_along(x$factors), function(m) {
     x$M[[m]] %*% x$factors[[m]]
   })
-  x$a <- Reduce(khatri_rao, rev(x$factors)) %*% x$weights
+  x$a <- Reduce(khatri_rao, rev(x$factors)) %*% x$lambda
   NextMethod()
 }

R/block_project.R

@@ -57,7 +57,7 @@ block_project.sparse_block <- function(x) {
 
 #' @export
 block_project.tensor_block <- function(x) {
-  x$a <- Reduce(khatri_rao, rev(x$factors)) %*% x$weights
+  x$a <- Reduce(khatri_rao, rev(x$factors)) %*% x$lambda
   x$Y <- pm(matrix(x$x, nrow = nrow(x$x)), x$a, na.rm = x$na.rm)
   return(x)
 }

R/block_update.R

@@ -31,21 +31,21 @@ block_update.tensor_block <- function(x, grad) {
     )
     if (m == x$mode_orth) {
       SVD <- svd(
-        grad_m %*% diag(x$weights, nrow = x$rank), nu = x$rank, nv = x$rank
+        grad_m %*% diag(x$lambda, nrow = x$rank), nu = x$rank, nv = x$rank
       )
       x$factors[[m]] <- SVD$u %*% t(SVD$v)
     } else {
-      x$factors[[m]] <- grad_m %*% diag(x$weights, nrow = x$rank)
+      x$factors[[m]] <- grad_m %*% diag(x$lambda, nrow = x$rank)
       x$factors[[m]] <- apply(
         x$factors[[m]], 2, function(y) y / norm(y, type = "2")
       )
     }
 
     other_factors <- khatri_rao(x$factors[[m]], other_factors)
   }
-  # Update weights
-  x$weights <- t(other_factors) %*% as.vector(grad)
-  x$weights <- drop(x$weights) / norm(drop(x$weights), type = "2")
+  # Update lambda
+  x$lambda <- t(other_factors) %*% as.vector(grad)
+  x$lambda <- drop(x$lambda) / norm(drop(x$lambda), type = "2")
   return(block_project(x))
 }
 
@@ -63,7 +63,7 @@ block_update.regularized_tensor_block <- function(x, grad) {
     )
     grad_m <- grad_m %*% khatri_rao(
       Reduce(khatri_rao, rev(x$factors[-seq_len(m)])), other_factors
-    ) %*% diag(x$weights, nrow = x$rank)
+    ) %*% diag(x$lambda, nrow = x$rank)
     if (m == x$mode_orth) {
       SVD <- svd(grad_m, nu = x$rank, nv = x$rank)
       x$factors[[m]] <- SVD$u %*% t(SVD$v)
@@ -73,7 +73,7 @@ block_update.regularized_tensor_block <- function(x, grad) {
 
     other_factors <- khatri_rao(x$factors[[m]], other_factors)
   }
-  # Update weights
+  # Update lambda
   u <- drop(t(other_factors) %*% as.vector(grad))
 
   w_ref <- drop(ginv(
@@ -85,25 +85,25 @@ block_update.regularized_tensor_block <- function(x, grad) {
 
   w_opt <- u / (norm(u, type = "2") * sqrt(x$M))
 
-  eps <- 0.5 * drop(t(u) %*% (x$weights + w_opt))
+  eps <- 0.5 * drop(t(u) %*% (x$lambda + w_opt))
 
   # If w_ref is satisfying, keep w_ref, otherwise find a point that
   # increases the criterion and satisfies the constraints between
   # w_ref and w_opt
   if (all(w_ref_norm == w_opt)) {
-    x$weights <- w_ref_norm
+    x$lambda <- w_ref_norm
   }
   else if (t(u) %*% w_ref_norm >= eps) {
-    x$weights <- w_ref_norm
+    x$lambda <- w_ref_norm
   } else {
     if (1 / x$M - eps^2 / crossprod(u) > .Machine$double.eps) {
       Pu <- diag(x$rank) - tcrossprod(u / norm(u, type = "2"))
       mu <- norm(Pu %*% w_ref, type = "2") / drop(sqrt(
         1 / x$M - eps^2 / crossprod(u)
       ))
-      x$weights <- eps / drop(crossprod(u)) * u + drop(Pu %*% w_ref) / mu
+      x$lambda <- eps / drop(crossprod(u)) * u + drop(Pu %*% w_ref) / mu
     } else { # collinearity between u and w_ref
-      x$weights <- w_opt
+      x$lambda <- w_opt
     }
   }
   return(block_project(x))

R/rgcca_inner_loop.R

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

R/rgcca_outer_loop.R

@@ -50,7 +50,7 @@ rgcca_outer_loop <- function(blocks, connection = 1 - diag(length(blocks)),
   crit <- list()
   R <- blocks
 
-  a <- Y <- weights <- lapply(seq(J), function(b) c())
+  a <- Y <- lambda <- lapply(seq(J), function(b) c())
   factors <- lapply(seq(J), function(b) {
     lapply(seq_along(dim(R[[b]])[-1]), function(m) NULL)
   })
@@ -112,16 +112,16 @@ rgcca_outer_loop <- function(blocks, connection = 1 - diag(length(blocks)),
     computed_tau[n, ] <- gcca_result$tau
     crit[[n]] <- gcca_result$crit
 
-    # Store Y, a, factors and weights
+    # Store Y, a, factors and lambda
     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]])
+    lambda <- lapply(
+      seq(J), function(b) cbind(lambda[[b]], gcca_result$lambda[[b]])
     )
 
     # Deflation procedure
@@ -133,7 +133,7 @@ rgcca_outer_loop <- function(blocks, connection = 1 - diag(length(blocks)),
   }
 
   # If there is a superblock and weight vectors are orthogonal, it is possible
-  # to have non meaningful weights associated to blocks that have been set to
+  # to have non meaningful lambda associated to blocks that have been set to
   # zero by the deflation
   if (superblock && !comp_orth) {
     a <- lapply(a, function(x) {
@@ -159,7 +159,7 @@ rgcca_outer_loop <- function(blocks, connection = 1 - diag(length(blocks)),
     a = a,
     astar = astar,
     factors = factors,
-    weights = weights,
+    lambda = lambda,
     tau = computed_tau,
     crit = crit, primal_dual = primal_dual
   )