# ==============================================================================
# File: algo_iter.R
# Description: Internal functions for iterative and approximation methods
# (Power Iteration, NIPALS, Arnoldi Iteration, ALS).
# ==============================================================================

# ------------------------------------------------------------------------------
# 4. Power Iteration (Deflation Method)
# ------------------------------------------------------------------------------
.apca_power <- function(X, n_components, max_iter = 1000, tol = 1e-9) {
  cov_matrix <- cov(X)
  p <- ncol(X)

  loadings_matrix <- matrix(0, nrow = p, ncol = n_components)
  eigenvalues <- numeric(n_components)
  A <- cov_matrix

  for (i in 1:n_components) {
    v <- rnorm(p)
    v <- v / sqrt(sum(v^2))

    for (iter in 1:max_iter) {
      v_new <- A %*% v
      v_new <- v_new / sqrt(sum(v_new^2))

      if (sum(abs(v_new - v)) < tol) {
        v <- v_new
        break
      }
      v <- v_new
    }

    eigenvalues[i] <- as.numeric(t(v) %*% A %*% v)
    loadings_matrix[, i] <- v

    # Matrix deflation: remove the variance captured by the current component
    A <- A - eigenvalues[i] * (v %*% t(v))
  }

  scores <- X %*% loadings_matrix
  total_var <- sum(diag(cov_matrix))
  var_explained <- eigenvalues / total_var

  colnames(loadings_matrix) <- paste0("PC", 1:n_components)
  colnames(scores) <- paste0("PC", 1:n_components)

  list(
    scores = scores,
    loadings = loadings_matrix,
    eigenvalues = eigenvalues,
    variance_explained = var_explained
  )
}

# ------------------------------------------------------------------------------
# 5. NIPALS (Non-linear Iterative Partial Least Squares)
# ------------------------------------------------------------------------------
.apca_nipals <- function(X, n_components, max_iter = 1000, tol = 1e-9) {
  n_obs <- nrow(X)
  p <- ncol(X)

  scores_matrix <- matrix(0, nrow = n_obs, ncol = n_components)
  loadings_matrix <- matrix(0, nrow = p, ncol = n_components)
  eigenvalues <- numeric(n_components)

  E <- X

  for (h in 1:n_components) {
    # Initialize t_vec intelligently with the column of E having max variance
    var_E <- apply(E, 2, var)
    t_vec <- E[, which.max(var_E)]

    for (iter in 1:max_iter) {
      p_vec <- t(E) %*% t_vec / as.numeric(t(t_vec) %*% t_vec)
      p_vec <- p_vec / sqrt(sum(p_vec^2))

      t_new <- E %*% p_vec / as.numeric(t(p_vec) %*% p_vec)

      if (sum(abs(t_new - t_vec)) < tol) {
        t_vec <- t_new
        break
      }
      t_vec <- t_new
    }

    scores_matrix[, h] <- t_vec
    loadings_matrix[, h] <- p_vec
    eigenvalues[h] <- sum(t_vec^2) / (n_obs - 1)

    # Deflation
    E <- E - (t_vec %*% t(p_vec))
  }

  total_var <- sum(apply(X, 2, var))
  var_explained <- eigenvalues / total_var

  colnames(loadings_matrix) <- paste0("PC", 1:n_components)
  colnames(scores_matrix) <- paste0("PC", 1:n_components)

  list(
    scores = scores_matrix,
    loadings = loadings_matrix,
    eigenvalues = eigenvalues,
    variance_explained = var_explained
  )
}

# ------------------------------------------------------------------------------
# 6. Arnoldi Iteration (Krylov Subspace Approximation)
# ------------------------------------------------------------------------------
.apca_arnoldi <- function(X, n_components, m = NULL) {
  cov_matrix <- cov(X)
  p <- ncol(X)

  if (is.null(m)) {
    m <- min(max(n_components * 2, 10), p)
  }

  Q <- matrix(0, nrow = p, ncol = m + 1)
  H <- matrix(0, nrow = m + 1, ncol = m)

  q1 <- rnorm(p)
  Q[, 1] <- q1 / sqrt(sum(q1^2))

  for (k in 1:m) {
    v <- cov_matrix %*% Q[, k]

    for (j in 1:k) {
      H[j, k] <- as.numeric(t(Q[, j]) %*% v)
      v <- v - H[j, k] * Q[, j]
    }

    H[k + 1, k] <- sqrt(sum(v^2))

    if (H[k + 1, k] > 1e-12 && k < m) {
      Q[, k + 1] <- v / H[k + 1, k]
    } else if (k < m) {
      break
    }
  }

  H_m <- H[1:m, 1:m]
  eig_H <- eigen(H_m, symmetric = TRUE)

  eigenvectors_approx <- Q[, 1:m] %*% eig_H$vectors

  eigenvalues <- eig_H$values[1:n_components]
  loadings <- eigenvectors_approx[, 1:n_components, drop = FALSE]
  scores <- X %*% loadings

  total_var <- sum(diag(cov_matrix))
  var_explained <- eigenvalues / total_var

  colnames(loadings) <- paste0("PC", 1:n_components)
  colnames(scores) <- paste0("PC", 1:n_components)

  list(
    scores = scores,
    loadings = loadings,
    eigenvalues = eigenvalues,
    variance_explained = var_explained
  )
}

# ------------------------------------------------------------------------------
# 7. Alternating Least Squares (ALS)
# ------------------------------------------------------------------------------
.apca_als <- function(X, n_components, max_iter = 1000, tol = 1e-9) {
  n_obs <- nrow(X)
  p <- ncol(X)

  # Initialize loadings randomly and orthogonalize

  P <- matrix(rnorm(p * n_components), nrow = p, ncol = n_components)
  P <- qr.Q(qr(P))

  T_scores <- matrix(0, nrow = n_obs, ncol = n_components)

  for (iter in 1:max_iter) {
    P_old <- P

    # Step 1: Fix P (Loadings), update T (Scores)
    T_scores <- X %*% P %*% solve(t(P) %*% P)

    # Step 2: Fix T (Scores), update P (Loadings)
    P <- t(X) %*% T_scores %*% solve(t(T_scores) %*% T_scores)

    # Re-orthogonalize Loadings for numerical stability
    P <- qr.Q(qr(P))

    if (max(abs(P - P_old)) < tol) break
  }

  scores <- X %*% P
  eigenvalues <- apply(scores, 2, var)
  total_var <- sum(apply(X, 2, var))
  var_explained <- eigenvalues / total_var

  colnames(P) <- paste0("PC", 1:n_components)
  colnames(scores) <- paste0("PC", 1:n_components)

  list(
    scores = scores,
    loadings = P,
    eigenvalues = eigenvalues,
    variance_explained = var_explained
  )
}
