GPForth <- function(A,
                    Tmat       = diag(ncol(A)),
                    normalize  = FALSE,
                    eps        = 1e-05,
                    maxit      = 1000,
                    method     = "varimax",
                    methodArgs = NULL) {
  # Gradient Projection Algorithm for orthogonal rotation (Bernaards & Jennrich, 2005).
  #
  # Args:
  #   A          : Unrotated factor loading matrix (p x k)
  #   Tmat       : Initial rotation matrix (default: identity)
  #   normalize  : Kaiser normalization - logical or weight matrix
  #   eps        : Convergence tolerance on gradient norm (default 1e-5)
  #   maxit      : Maximum iterations (default 1000)
  #   method     : Rotation criterion, e.g. "varimax", "quartimin" (default "varimax")
  #   methodArgs : Additional arguments passed to the vgQ criterion function
  #
  # Returns:
  #   A GPArotation object with:
  #     loadings    - rotated loading matrix
  #     Th          - final rotation matrix
  #     Table       - iteration history (iter, f, log10(gradient norm), alpha)
  #     method      - method label from criterion function
  #     orthogonal  - TRUE (orthogonal rotation)
  #     convergence - TRUE if converged within maxit
  #     Gq          - final gradient matrix

  # --- Kaiser normalization ---
  if ((!is.logical(normalize)) || normalize) {
    W         <- NormalizingWeight(A, normalize = normalize)
    normalize <- TRUE
    A         <- A / W
  }

  if (ncol(A) < 2)
    stop("Rotation does not make sense for single-factor models.")

  # --- Initialization ---
  vgQfun <- paste("vgQ", method, sep = ".")
  alpha  <- 1
  L      <- A %*% Tmat
  VgQ    <- do.call(vgQfun, append(list(L), methodArgs))
  f      <- VgQ$f
  G      <- crossprod(A, VgQ$Gq)
  VgQt   <- do.call(vgQfun, append(list(L), methodArgs))  # guards against exact initial solution
  Table  <- matrix(NA_real_, nrow = maxit + 1, ncol = 4,
                   dimnames = list(NULL, c("iter", "f", "log10(s)", "alpha")))

  # --- Main loop ---
  for (iter in 0:maxit) {

    # Projected gradient onto orthogonal manifold
    M  <- crossprod(Tmat, G)
    S  <- (M + t(M)) / 2
    Gp <- G - Tmat %*% S
    s  <- sqrt(sum(diag(crossprod(Gp))))

    Table[iter + 1, ] <- c(iter, f, log10(s), alpha)

    if (s < eps) break

    # Line search: halve step size until sufficient decrease
    alpha <- 2 * alpha
    for (i in 0:10) {
      X     <- Tmat - alpha * Gp
      UDV   <- svd(X)
      Tmatt <- UDV$u %*% t(UDV$v)
      L     <- A %*% Tmatt
      VgQt  <- do.call(vgQfun, append(list(L), methodArgs))
      if (VgQt$f < (f - 0.5 * s^2 * alpha)) break
      alpha <- alpha / 2
    }

    Tmat <- Tmatt
    f    <- VgQt$f
    G    <- crossprod(A, VgQt$Gq)
  }

  # --- Convergence check ---
  convergence <- (s < eps)
  if (iter == maxit && !convergence)
    warning("Convergence not obtained in GPForth. ", maxit, " iterations used.")

  # --- Trim unused rows from Table ---
  Table <- Table[1:(iter + 1), , drop = FALSE]

  # --- Undo normalization ---
  if (normalize)
    L <- L * W

  dimnames(L) <- dimnames(A)

  # --- Return ---
  r <- list(
    loadings    = L,
    Th          = Tmat,
    Table       = Table,
    method      = VgQ$Method,
    orthogonal  = TRUE,
    convergence = convergence,
    Gq          = VgQt$Gq
  )
  class(r) <- "GPArotation"
  r
}

GPFoblq <- function(A,
                    Tmat       = diag(ncol(A)),
                    normalize  = FALSE,
                    eps        = 1e-05,
                    maxit      = 1000,
                    method     = "quartimin",
                    methodArgs = NULL) {
  # Gradient Projection Algorithm for oblique rotation (Bernaards & Jennrich, 2005).
  #
  # Args:
  #   A          : Unrotated factor loading matrix (p x k)
  #   Tmat       : Initial transformation matrix (default: identity)
  #   normalize  : Kaiser normalization - logical or weight matrix
  #   eps        : Convergence tolerance on gradient norm (default 1e-5)
  #   maxit      : Maximum iterations (default 1000)
  #   method     : Rotation criterion, e.g. "quartimin" (default "quartimin")
  #   methodArgs : Additional arguments passed to the vgQ criterion function
  #
  # Returns:
  #   A GPArotation object with:
  #     loadings    - rotated loading matrix
  #     Phi         - factor correlation matrix (t(Tmat) %*% Tmat)
  #     Th          - final transformation matrix
  #     Table       - iteration history (iter, f, log10(gradient norm), alpha)
  #     method      - method label from criterion function
  #     orthogonal  - FALSE (oblique rotation)
  #     convergence - TRUE if converged within maxit
  #     Gq          - final gradient matrix

  if (ncol(A) < 2)
    stop("Rotation does not make sense for single-factor models.")

  # --- Kaiser normalization ---
  if ((!is.logical(normalize)) || normalize) {
    W         <- NormalizingWeight(A, normalize = normalize)
    normalize <- TRUE
    A         <- A / W
  }

  # --- Initialization ---
  vgQfun <- paste("vgQ", method, sep = ".")
  alpha  <- 1
  L      <- A %*% t(solve(Tmat))
  VgQ    <- do.call(vgQfun, append(list(L), methodArgs))
  f      <- VgQ$f
  G      <- -t(t(L) %*% VgQ$Gq %*% solve(Tmat))
  VgQt   <- do.call(vgQfun, append(list(L), methodArgs))  # guards against exact initial solution
  Table  <- matrix(NA_real_, nrow = maxit + 1, ncol = 4,
                   dimnames = list(NULL, c("iter", "f", "log10(s)", "alpha")))

  # --- Main loop ---
  for (iter in 0:maxit) {

    # Projected gradient onto oblique manifold
    Gp <- G - Tmat %*% diag(c(rep(1, nrow(G)) %*% (Tmat * G)))
    s  <- sqrt(sum(diag(crossprod(Gp))))

    Table[iter + 1, ] <- c(iter, f, log10(s), alpha)

    if (s < eps) break

    # Line search: halve step size until sufficient decrease
    alpha <- 2 * alpha
    for (i in 0:10) {
      X     <- Tmat - alpha * Gp
      v     <- 1 / sqrt(c(rep(1, nrow(X)) %*% X^2))
      Tmatt <- X %*% diag(v)
      L     <- A %*% t(solve(Tmatt))
      VgQt  <- do.call(vgQfun, append(list(L), methodArgs))
      if ((f - VgQt$f) > 0.5 * s^2 * alpha) break
      alpha <- alpha / 2
    }

    Tmat <- Tmatt
    f    <- VgQt$f
    G    <- -t(t(L) %*% VgQt$Gq %*% solve(Tmatt))
  }

  # --- Convergence check ---
  convergence <- (s < eps)
  if (iter == maxit && !convergence)
    warning("Convergence not obtained in GPFoblq. ", maxit, " iterations used.")

  # --- Trim unused rows from Table ---
  Table <- Table[1:(iter + 1), , drop = FALSE]

  # --- Undo normalization ---
  if (normalize)
    L <- L * W

  dimnames(L) <- dimnames(A)

  # --- Return ---
  # N.B. renaming Lh to loadings in specific rotations
  #      relies on loadings being the first element of the list
  r <- list(
    loadings    = L,
    Phi         = t(Tmat) %*% Tmat,
    Th          = Tmat,
    Table       = Table,
    method      = VgQ$Method,
    orthogonal  = FALSE,
    convergence = convergence,
    Gq          = VgQt$Gq
  )
  class(r) <- "GPArotation"
  r
}

###########################################################################
# Legacy functions - retained for historical reference and reproducibility.
# Original implementations from Bernaards & Jennrich (2005).
# Superseded by the updated GPForth and GPFoblq above (GPArotation 2026.4-1).
# Note: commented-out lines are preserved intentionally as part of the
# original development history.
###########################################################################


GPForth.legacy <- function(A,
                           Tmat       = diag(ncol(A)),
                           normalize  = FALSE,
                           eps        = 1e-05,
                           maxit      = 1000,
                           method     = "varimax",
                           methodArgs = NULL) {
  # Legacy implementation of GPForth (Bernaards & Jennrich, 2005).
  # Retained for historical reference and reproducibility.
  # Superseded by GPForth in GPArotation 2026.4-1.
  if((!is.logical(normalize)) || normalize) {
     W <- NormalizingWeight(A, normalize=normalize)
     normalize <- TRUE
     A <- A/W
     }
 if(1 >= ncol(A)) stop("rotation does not make sense for single factor models.")
 al <- 1
 L <- A %*% Tmat
 #Method <- get(paste("vgQ",method,sep="."))
 #VgQ <- Method(L, ...)
 Method <- paste("vgQ",method,sep=".")
 VgQ <- do.call(Method, append(list(L), methodArgs))
 G <- crossprod(A,VgQ$Gq)
 f <- VgQ$f
 Table <- NULL
 #set initial value for the unusual case of an exact initial solution 
 VgQt <- do.call(Method, append(list(L), methodArgs))   
 for (iter in 0:maxit){
   M <- crossprod(Tmat,G)
   S <- (M + t(M))/2
   Gp <- G - Tmat %*% S
   s <- sqrt(sum(diag(crossprod(Gp))))
   Table <- rbind(Table, c(iter, f, log10(s), al))
   if (s < eps)  break
   al <- 2*al
   for (i in 0:10){
     X <- Tmat - al * Gp
     UDV <- svd(X)
     Tmatt <- UDV$u %*% t(UDV$v)
     L <- A %*% Tmatt
     #VgQt <- Method(L, ...)
     VgQt <- do.call(Method, append(list(L), methodArgs))
     if (VgQt$f < (f - 0.5*s^2*al)) break
     al <- al/2
     }
   Tmat <- Tmatt
   f <- VgQt$f
   G <- crossprod(A,VgQt$Gq)
   }
 convergence <- (s < eps)
 if ((iter == maxit) & !convergence)
     warning("convergence not obtained in GPForth. ", maxit, " iterations used.")
 if(normalize) L <- L * W
 dimnames(L) <- dimnames(A)
 r <- list(loadings=L, Th=Tmat, Table=Table, 
        method=VgQ$Method, orthogonal=TRUE, convergence=convergence, Gq=VgQt$Gq)
 class(r) <- "GPArotation"
 r
}

GPFoblq.legacy <- function(A,
                           Tmat       = diag(ncol(A)),
                           normalize  = FALSE,
                           eps        = 1e-05,
                           maxit      = 1000,
                           method     = "quartimin",
                           methodArgs = NULL) {
  # Legacy implementation of GPFoblq (Bernaards & Jennrich, 2005).
  # Retained for historical reference and reproducibility.
  # Superseded by GPFoblq in GPArotation 2026.4-1.
  
 if(1 >= ncol(A)) stop("rotation does not make sense for single factor models.")
 if((!is.logical(normalize)) || normalize) {
     W <- NormalizingWeight(A, normalize=normalize)
     normalize <- TRUE
     A <- A/W
     }
 al <- 1
 L <- A %*% t(solve(Tmat))
 #Method <- get(paste("vgQ",method,sep="."))
 #VgQ <- Method(L, ...)
 Method <- paste("vgQ",method,sep=".")
 VgQ <- do.call(Method, append(list(L), methodArgs))
 G <- -t(t(L) %*% VgQ$Gq %*% solve(Tmat))
 f <- VgQ$f
 Table <- NULL
 #Table <- c(-1,f,log10(sqrt(sum(diag(crossprod(G))))),al)
 #set initial value for the unusual case of an exact initial solution 
 VgQt <- do.call(Method, append(list(L), methodArgs))   
 for (iter in 0:maxit){
   Gp <- G - Tmat %*% diag(c(rep(1,nrow(G)) %*% (Tmat*G)))
   s <- sqrt(sum(diag(crossprod(Gp))))
   Table <- rbind(Table,c(iter,f,log10(s),al))
   if (s < eps) break
   al <- 2*al
   for (i in 0:10){
     X <- Tmat - al*Gp
     v <- 1/sqrt(c(rep(1,nrow(X)) %*% X^2))
     Tmatt <- X %*% diag(v)
     L <- A %*% t(solve(Tmatt))
     #VgQt <- Method(L, ...)
     VgQt <- do.call(Method, append(list(L), methodArgs))
     improvement <- f - VgQt$f 
     if (improvement >  0.5*s^2*al) break
     al <- al/2
     }
   Tmat <- Tmatt
   f <- VgQt$f
   G <- -t(t(L) %*% VgQt$Gq %*% solve(Tmatt))
   }
 convergence <- (s < eps)
 if ((iter == maxit) & !convergence)
     warning("convergence not obtained in GPFoblq. ", maxit, " iterations used.")
 if(normalize) L <- L * W
 dimnames(L) <- dimnames(A)
 # N.B. renaming Lh to loadings in specificific rotations 
 #   uses fact that  Lh is first.
 r <- list(loadings=L, Phi=t(Tmat) %*% Tmat, Th=Tmat, Table=Table,
      method=VgQ$Method, orthogonal=FALSE, convergence=convergence, Gq=VgQt$Gq)
 class(r) <- "GPArotation"
 r
}