###########################################################################
###########################################################################

# --- OBLIMIN ---

oblimin <- function(A, Tmat = diag(ncol(A)), gam = 0, normalize = FALSE,
                    randomStarts = 0, ...) {
  # Oblimin oblique rotation. Special cases via gam:
  #   0   - Quartimin
  #   0.5 - Biquartimin
  #
  # Args:
  #   A            : Unrotated factor loading matrix (p x k)
  #   Tmat         : Initial transformation matrix (default: identity)
  #   gam          : Obliqueness parameter (default 0)
  #   normalize    : Kaiser normalization - logical or weight matrix
  #   randomStarts : Number of random starts (0 = use Tmat as-is)

  .GPA_RS_engine(A = A, Tmat = Tmat, method = "oblimin",
                 methodArgs   = list(gam = gam),
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = FALSE, ...)
}

vgQ.oblimin <- function(L, gam = 0) {
  # Oblimin family of oblique rotation criteria.
  # gam controls the degree of obliqueness:
  #   0    - Quartimin
  #   0.5  - Biquartimin
  #
  # Args:
  #   L   : Factor loading matrix
  #   gam : Obliqueness parameter (default 0)
  #
  # Returns:
  #   A list with:
  #     Gq     - gradient matrix
  #     f      - objective function value
  #     Method - method label

  k <- ncol(L)
  X <- L^2 %*% (!diag(TRUE, k))

  if (gam != 0) {
    p <- nrow(L)
    X <- (diag(1, p) - matrix(gam / p, p, p)) %*% X
  }

  method <- if      (gam == 0)   "Oblimin Quartimin"
            else if (gam == 0.5) "Oblimin Biquartimin"
            else                 paste0("Oblimin g=", gam)

  list(
    Gq     = L * X,
    f      = sum(L^2 * X) / 4,
    Method = method
  )
}

# --- QUARTIMIN ---

quartimin <- function(A, Tmat = diag(ncol(A)), normalize = FALSE,
                      randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "quartimin",
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = FALSE, ...)
}

vgQ.quartimin <- function(L) {
  # Quartimin oblique rotation criterion (special case of Oblimin with gam = 0).
  #
  # Args:
  #   L : Factor loading matrix
  #
  # Returns:
  #   A list with:
  #     Gq     - gradient matrix
  #     f      - objective function value
  #     Method - method label

  k  <- ncol(L)
  L2 <- L^2
  X  <- L2 %*% (matrix(1, k, k) - diag(k))

  list(
    Gq     = L * X,
    f      = sum(L2 * X) / 4,
    Method = "Quartimin"
  )
}

# --- CRAWFORD-FERGUSON FAMILY ---

cfT <- function(A, Tmat = diag(ncol(A)), kappa = 0, normalize = FALSE,
                randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "cf",
                 methodArgs   = list(kappa = kappa),
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = TRUE, ...)
}

cfQ <- function(A, Tmat = diag(ncol(A)), kappa = 0, normalize = FALSE,
                randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "cf",
                 methodArgs   = list(kappa = kappa),
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = FALSE, ...)
}

equamax <- function(A, Tmat = diag(ncol(A)),
                    kappa = ncol(A) / (2 * nrow(A)),
                    normalize = FALSE, randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "cf",
                 methodArgs   = list(kappa = kappa),
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = TRUE, ...)
}

parsimax <- function(A, Tmat = diag(ncol(A)),
                     kappa = (ncol(A) - 1) / (ncol(A) + nrow(A) - 2),
                     normalize = FALSE, randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "cf",
                 methodArgs   = list(kappa = kappa),
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = TRUE, ...)
}

vgQ.cf <- function(L, kappa = 0) {
  # Crawford-Ferguson (CF) family of rotation criteria (1970).
  # kappa controls the complexity penalty:
  #   0              - Quartimax / Quartimin
  #   1/p            - Varimax
  #   k/(2*p)        - Equamax
  #   (k-1)/(p+k-2)  - Parsimax
  #   1              - Factor Parsimony
  #
  # Args:
  #   L     : Factor loading matrix (p x k)
  #   kappa : Complexity weight (default 0)
  #
  # Returns:
  #   A list with:
  #     Gq     - gradient matrix
  #     f      - objective function value
  #     Method - method label

  p <- nrow(L)
  k <- ncol(L)

  N  <- matrix(1, k, k) - diag(k)  # k x k off-diagonal matrix
  M  <- matrix(1, p, p) - diag(p)  # p x p off-diagonal matrix
  L2 <- L^2

  f1 <- (1 - kappa) * sum(diag(crossprod(L2, L2 %*% N))) / 4
  f2 <-      kappa  * sum(diag(crossprod(L2, M  %*% L2))) / 4

  method <- if      (kappa == 0)              "Crawford-Ferguson Quartimax/Quartimin"
            else if (kappa == 1/p)            "Crawford-Ferguson Varimax"
            else if (kappa == k/(2*p))        "Equamax"
            else if (kappa == (k-1)/(p+k-2)) "Parsimax"
            else if (kappa == 1)              "Factor Parsimony"
            else                              paste0("Crawford-Ferguson: kappa=", kappa)

  list(
    Gq     = (1 - kappa) * L * (L2 %*% N) + kappa * L * (M %*% L2),
    f      = f1 + f2,
    Method = method
  )
}

# --- TARGET ROTATION ---

targetT <- function(A = NULL, Tmat = diag(ncol(A)), Target = NULL,
                    normalize = FALSE, eps = 1e-5, maxit = 1000,
                    randomStarts = 0, L = NULL, ...) {
  if (is.null(A) && !is.null(L)) A <- L
  if (is.null(A))      stop("Argument 'A' is missing, with no default.")
  if (is.null(Target)) stop("Argument 'Target' must be specified.")

  .GPA_RS_engine(A = A, Tmat = Tmat, normalize = normalize, eps = eps,
                 maxit        = maxit,
                 method       = "target",
                 methodArgs   = list(Target = Target),
                 randomStarts = randomStarts,
                 orthogonal   = TRUE, ...)
}

targetQ <- function(A = NULL, Tmat = diag(ncol(A)), Target = NULL,
                    normalize = FALSE, eps = 1e-5, maxit = 1000,
                    randomStarts = 0, L = NULL, ...) {
  if (is.null(A) && !is.null(L)) A <- L
  if (is.null(A))      stop("Argument 'A' is missing, with no default.")
  if (is.null(Target)) stop("Argument 'Target' must be specified.")

  .GPA_RS_engine(A = A, Tmat = Tmat, normalize = normalize, eps = eps,
                 maxit        = maxit,
                 method       = "target",
                 methodArgs   = list(Target = Target),
                 randomStarts = randomStarts,
                 orthogonal   = FALSE, ...)
}

vgQ.target <- function(L, Target = NULL) {
  # Target rotation criterion.
  # Minimizes the sum of squared deviations from a specified target matrix.
  # NA entries in Target are treated as unspecified (ignored in fit and gradient).
  #
  # Args:
  #   L      : Factor loading matrix
  #   Target : Target matrix (same dimensions as L; NA = unspecified element)
  #
  # Returns:
  #   A list with:
  #     Gq     - gradient matrix (zero where Target is NA)
  #     f      - objective function value
  #     Method - method label

  Gq            <- 2 * (L - Target)
  Gq[is.na(Gq)] <- 0

  list(
    Gq     = Gq,
    f      = sum((L - Target)^2, na.rm = TRUE),
    Method = "Target rotation"
  )
}

# --- PARTIALLY SPECIFIED TARGET ---

pstT <- function(A = NULL, Tmat = diag(ncol(A)), W = NULL, Target = NULL,
                 normalize = FALSE, eps = 1e-5, maxit = 1000,
                 randomStarts = 0, L = NULL, ...) {
  if (is.null(A) && !is.null(L)) A <- L
  if (is.null(A))      stop("Argument 'A' is missing, with no default.")
  if (is.null(W))      stop("Argument 'W' must be specified.")
  if (is.null(Target)) stop("Argument 'Target' must be specified.")

  .GPA_RS_engine(A = A, Tmat = Tmat, normalize = normalize, eps = eps,
                 maxit        = maxit,
                 method       = "pst",
                 methodArgs   = list(W = W, Target = Target),
                 randomStarts = randomStarts,
                 orthogonal   = TRUE, ...)
}

pstQ <- function(A = NULL, Tmat = diag(ncol(A)), W = NULL, Target = NULL,
                 normalize = FALSE, eps = 1e-5, maxit = 1000,
                 randomStarts = 0, L = NULL, ...) {
  if (is.null(A) && !is.null(L)) A <- L
  if (is.null(A))      stop("Argument 'A' is missing, with no default.")
  if (is.null(W))      stop("Argument 'W' must be specified.")
  if (is.null(Target)) stop("Argument 'Target' must be specified.")

  .GPA_RS_engine(A = A, Tmat = Tmat, normalize = normalize, eps = eps,
                 maxit        = maxit,
                 method       = "pst",
                 methodArgs   = list(W = W, Target = Target),
                 randomStarts = randomStarts,
                 orthogonal   = FALSE, ...)
}

vgQ.pst <- function(L, W = NULL, Target = NULL) {
  # Partially specified target rotation criterion.
  # Minimizes weighted deviations from a target matrix.
  # W is a binary weight matrix specifying which elements are targeted.
  #
  # Args:
  #   L      : Factor loading matrix
  #   W      : Binary weight matrix (same dimensions as L; 0 = unspecified element)
  #   Target : Target matrix (same dimensions as L)
  #
  # Returns:
  #   A list with:
  #     Gq     - gradient matrix
  #     f      - objective function value
  #     Method - method label

  Btilde <- W * Target

  list(
    Gq     = 2 * (W * L - Btilde),
    f      = sum((W * L - Btilde)^2),
    Method = "Partially specified target"
  )
}

# --- ENTROPY ---

entropy <- function(A, Tmat = diag(ncol(A)), normalize = FALSE,
                    randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "entropy",
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = TRUE, ...)
}

vgQ.entropy <- function(L) {
  # Minimum entropy oblique rotation criterion.
  #
  # Args:
  #   L : Factor loading matrix
  #
  # Returns:
  #   A list with:
  #     Gq     - gradient matrix
  #     f      - objective function value
  #     Method - method label

  L2    <- L^2
  logL2 <- log(L2 + .Machine$double.eps)

  list(
    Gq     = -(L * logL2 + L),
    f      = -sum(L2 * logL2) / 2,
    Method = "Minimum entropy"
  )
}

# --- INFOMAX ---

infomaxT <- function(A, Tmat = diag(ncol(A)), normalize = FALSE,
                     randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "infomax",
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = TRUE, ...)
}

infomaxQ <- function(A, Tmat = diag(ncol(A)), normalize = FALSE,
                     randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "infomax",
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = FALSE, ...)
}

vgQ.infomax <- function(L) {
  # Infomax oblique rotation criterion.
  #
  # Args:
  #   L : Factor loading matrix
  #
  # Returns:
  #   A list with:
  #     Gq     - gradient matrix
  #     f      - objective function value
  #     Method - method label

  k  <- ncol(L)
  p  <- nrow(L)
  S  <- L^2
  s  <- sum(S)

  # Normalized probability distributions
  E  <- S / s
  e1 <- rowSums(S) / s
  e2 <- colSums(S) / s

  # Entropy terms
  Q0 <- -sum(E  * log(E  + .Machine$double.eps))
  Q1 <- -sum(e1 * log(e1 + .Machine$double.eps))
  Q2 <- -sum(e2 * log(e2 + .Machine$double.eps))

  # Gradient components
  H  <- -(log(E  + .Machine$double.eps) + 1)
  h1 <- -(log(e1 + .Machine$double.eps) + 1)
  h2 <- -(log(e2 + .Machine$double.eps) + 1)

  G0 <- H / s  - sum(S * H) / s^2
  G1 <- h1 / s - sum(rowSums(S) * h1) / s^2
  G2 <- rep(h2 / s, each = p) - sum(colSums(S) * h2) / s^2

  list(
    Gq     = 2 * L * (G0 - G1 - G2),
    f      = log(k) + Q0 - Q1 - Q2,
    Method = "Infomax"
  )
}

# --- McCAMMON ---

mccammon <- function(A, Tmat = diag(ncol(A)), normalize = FALSE,
                     randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "mccammon",
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = TRUE, ...)
}

vgQ.mccammon <- function(L) {
  k  <- ncol(L)
  p  <- nrow(L)
  S  <- L^2
  M  <- matrix(1, p, p)
  s2 <- colSums(S)
  P  <- S / matrix(rep(s2, p), ncol = k, byrow = TRUE)
  Q1 <- -sum(P * log(P))
  H  <- -(log(P) + 1)
  R  <- M %*% S
  G1 <- H/R - M %*% (S * H/R^2)
  s  <- sum(S)
  p2 <- s2/s
  Q2 <- -sum(p2 * log(p2))
  h  <- -(log(p2) + 1)
  alpha <- h %*% p2
  G2 <- rep(1, p) %*% t(h)/s - as.vector(alpha) * matrix(1, p, k)
  Gq <- 2 * L * (G1/Q1 - G2/Q2)
  f  <- log(Q1) - log(Q2)
  list(f      = f,
       Gq     = Gq,
       Method = "McCammon entropy")
}

# --- GEOMIN ---

geominT <- function(A, Tmat = diag(ncol(A)), delta = 0.01, normalize = FALSE,
                    randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "geomin",
                 methodArgs   = list(delta = delta),
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = TRUE, ...)
}

geominQ <- function(A, Tmat = diag(ncol(A)), delta = 0.01, normalize = FALSE,
                    randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "geomin",
                 methodArgs   = list(delta = delta),
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = FALSE, ...)
}

vgQ.geomin <- function(L, delta = 0.01) {
  # Geomin oblique rotation criterion.
  # delta is a small constant added for numerical stability (default 0.01).
  #
  # Args:
  #   L     : Factor loading matrix
  #   delta : Stabilizing constant (default 0.01)
  #
  # Returns:
  #   A list with:
  #     Gq     - gradient matrix
  #     f      - objective function value
  #     Method - method label

  k   <- ncol(L)
  L2  <- L^2 + delta
  pro <- exp(rowMeans(log(L2)))

  list(
    Gq     = (2 / k) * (L / L2) * pro,
    f      = sum(pro),
    Method = "Geomin"
  )
}

# --- SIMPLIMAX ---

simplimax <- function(A, Tmat = diag(ncol(A)), k = nrow(A), normalize = FALSE,
                      randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "simplimax",
                 methodArgs   = list(k = k),
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = FALSE, ...)
}

vgQ.simplimax <- function(L, k = nrow(L)) {
  # Simplimax oblique rotation criterion (Kiers, 1994).
  # Minimizes the k smallest squared loadings, targeting a simple structure
  # with k near-zero loadings per solution.
  #
  # Args:
  #   L : Factor loading matrix
  #   k : Number of near-zero loadings to target (default: nrow(L))
  #
  # Returns:
  #   A list with:
  #     Gq     - gradient matrix
  #     f      - objective function value
  #     Method - method label

  L2        <- L^2
  threshold <- sort(L2, partial = k)[k]
  Imat      <- L2 <= threshold

  list(
    Gq     = 2 * Imat * L,
    f      = sum(L2[Imat]),
    Method = paste0("Simplimax (k=", k, ")")
  )
}

# --- BIFACTOR ---

bifactorT <- function(A, Tmat = diag(ncol(A)), normalize = FALSE,
                      randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "bifactor",
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = TRUE, ...)
}

bifactorQ <- function(A, Tmat = diag(ncol(A)), normalize = FALSE,
                      randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "bifactor",
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = FALSE, ...)
}

vgQ.bifactor <- function(L) {
  # Bifactor Biquartimin oblique rotation criterion.
  # Treats the first column as a general factor (unconstrained)
  # and rotates the remaining group factor columns.
  #
  # Args:
  #   L : Factor loading matrix (first column = general factor)
  #
  # Returns:
  #   A list with:
  #     Gq     - gradient matrix (zero gradient for general factor column)
  #     f      - objective function value
  #     Method - method label

  Lt2  <- L[, -1, drop = FALSE]^2
  rowS <- rowSums(Lt2)
  Gt   <- 4 * L[, -1, drop = FALSE] * (rowS - Lt2)

  list(
    Gq     = cbind(0, Gt),
    f      = sum(rowS^2) - sum(Lt2^2),
    Method = "Bifactor Biquartimin"
  )
}

# --- BI-GEOMIN ---

bigeominT <- function(A, Tmat = diag(ncol(A)), delta = 0.01, normalize = FALSE,
                      randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "bigeomin",
                 methodArgs   = list(delta = delta),
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = TRUE, ...)
}

bigeominQ <- function(A, Tmat = diag(ncol(A)), delta = 0.01, normalize = FALSE,
                      randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "bigeomin",
                 methodArgs   = list(delta = delta),
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = FALSE, ...)
}

vgQ.bigeomin <- function(L, delta = 0.01) {
  # Bi-Geomin oblique rotation criterion.
  # Treats the first column as a general factor (unconstrained)
  # and applies Geomin rotation to the remaining group factor columns.
  #
  # Args:
  #   L     : Factor loading matrix (first column = general factor)
  #   delta : Stabilizing constant passed to vgQ.geomin (default 0.01)
  #
  # Returns:
  #   A list with:
  #     Gq     - gradient matrix (zero gradient for general factor column)
  #     f      - objective function value
  #     Method - method label

  out <- vgQ.geomin(L[, -1, drop = FALSE], delta = delta)

  list(
    Gq     = cbind(0, out$Gq),
    f      = out$f,
    Method = "Bi-Geomin"
  )
}

# --- TANDEM CRITERIA ---

tandemI <- function(A, Tmat = diag(ncol(A)), normalize = FALSE,
                    randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "tandemI",
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = TRUE, ...)
}

vgQ.tandemI <- function(L) {
  # Tandem Criterion I (Comrey, 1967)
  # Seeks factors that share high loadings on the same variables.
  #
  # Args:
  #   L : Factor loading matrix
  #
  # Returns:
  #   A list with:
  #     Gq     - gradient matrix
  #     f      - objective function value (negated for minimization)
  #     Method - method label

  L2  <- L^2
  LL  <- L %*% t(L)
  LL2 <- LL^2

  # Gradient components
  Gq1 <- 4 * L  * (LL2 %*% L2)
  Gq2 <- 4 * (LL * (L2 %*% t(L2))) %*% L

  # Negate because optimizer minimizes
  Gq <- -(Gq1 + Gq2)

  list(
    Gq     = Gq,
    f      = -sum(diag(crossprod(L2, LL2 %*% L2))),
    Method = "Tandem I"
  )
}

tandemII <- function(A, Tmat = diag(ncol(A)), normalize = FALSE,
                     randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "tandemII",
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = TRUE, ...)
}

vgQ.tandemII <- function(L) {
  # Tandem Criterion II (Comrey, 1967)
  # Seeks factors that do NOT share high loadings on the same variables
  # (used as a second-stage refinement after Tandem I).
  #
  # Args:
  #   L : Factor loading matrix
  #
  # Returns:
  #   A list with:
  #     Gq     - gradient matrix
  #     f      - objective function value
  #     Method - method label

  L2   <- L^2
  LL   <- L %*% t(L)
  LL2  <- LL^2
  ILL2 <- 1 - LL2   # Complement of squared outer product

  # Gradient components
  Gq1 <- 4 * L * (ILL2 %*% L2)
  Gq2 <- 4 * (LL * (L2 %*% t(L2))) %*% L

  Gq <- Gq1 - Gq2

  list(
    Gq     = Gq,
    f      = sum(diag(crossprod(L2, ILL2 %*% L2))),
    Method = "Tandem II"
  )
}

# --- OBLIMAX ---

oblimax <- function(A, Tmat = diag(ncol(A)), normalize = FALSE,
                    randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "oblimax",
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = FALSE, ...)
}

vgQ.oblimax <- function(L) {
  # Oblimax oblique rotation criterion.
  #
  # Args:
  #   L : Factor loading matrix
  #
  # Returns:
  #   A list with:
  #     Gq     - gradient matrix
  #     f      - objective function value (negated for minimization)
  #     Method - method label

  s2 <- sum(L^2)
  s4 <- sum(L^4)

  list(
    Gq     = -(4 * L^3 / s4 - 4 * L / s2),
    f      = -(log(s4) - 2 * log(s2)),
    Method = "Oblimax"
  )
}

# --- BENTLER ---

bentlerT <- function(A, Tmat = diag(ncol(A)), normalize = FALSE,
                     randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "bentler",
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = TRUE, ...)
}

bentlerQ <- function(A, Tmat = diag(ncol(A)), normalize = FALSE,
                     randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "bentler",
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = FALSE, ...)
}

vgQ.bentler <- function(L) {
  # Bentler's invariant pattern simplicity oblique rotation criterion.
  #
  # Args:
  #   L : Factor loading matrix
  #
  # Returns:
  #   A list with:
  #     Gq     - gradient matrix (negated for minimization)
  #     f      - objective function value (negated for minimization)
  #     Method - method label

  L2    <- L^2
  M     <- crossprod(L2)
  D_inv <- diag(1 / diag(M))

  list(
    Gq     = -L * (L2 %*% (solve(M) - D_inv)),
    f      = -(log(det(M)) - log(det(diag(diag(M))))) / 4,
    Method = "Bentler"
  )
}

# --- QUARTIMAX ---

quartimax <- function(A, Tmat = diag(ncol(A)), normalize = FALSE,
                      randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "quartimax",
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = TRUE, ...)
}

vgQ.quartimax <- function(L) {
  # Quartimax orthogonal rotation criterion.
  #
  # Args:
  #   L : Factor loading matrix
  #
  # Returns:
  #   A list with:
  #     Gq     - gradient matrix (negated for minimization)
  #     f      - objective function value (negated for minimization)
  #     Method - method label

  list(
    Gq     = -L^3,
    f      = -sum(L^4) / 4,
    Method = "Quartimax"
  )
}

# --- VARIMAX ---

Varimax <- function(A, Tmat = diag(ncol(A)), normalize = FALSE,
                    randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "varimax",
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = TRUE, ...)
}

vgQ.varimax <- function(L) {
  # Varimax orthogonal rotation criterion (Kaiser, 1958).
  #
  # Args:
  #   L : Factor loading matrix
  #
  # Returns:
  #   A list with:
  #     Gq     - gradient matrix (negated for minimization)
  #     f      - objective function value (negated for minimization)
  #     Method - method label

  QL <- L^2 - rep(colMeans(L^2), each = nrow(L))

  list(
    Gq     = -L * QL,
    f      = -sum(QL^2) / 4,
    Method = "Varimax"
  )
}

# --- VARIMIN ---

varimin <- function(A, Tmat = diag(ncol(A)), normalize = FALSE,
                    randomStarts = 0, ...) {
  .GPA_RS_engine(A = A, Tmat = Tmat, method = "varimin",
                 normalize    = normalize,
                 randomStarts = randomStarts,
                 orthogonal   = TRUE, ...)
}

vgQ.varimin <- function(L) {
  # Varimin orthogonal rotation criterion.
  # Minimizes the variance of squared loadings within factors - 
  # the complement of Varimax.
  #
  # Args:
  #   L : Factor loading matrix
  #
  # Returns:
  #   A list with:
  #     Gq     - gradient matrix
  #     f      - objective function value
  #     Method - method label

  QL <- L^2 - rep(colMeans(L^2), each = nrow(L))

  list(
    Gq     = L * QL,
    f      = sum(QL^2) / 4,
    Method = "Varimin"
  )
}

# --- LP WLS ---

vgQ.lp.wls <- function(L, W) {
  # Weighted least squares criterion for Lp rotation.
  #
  # Args:
  #   L : Factor loading matrix
  #   W : Weight matrix (same dimensions as L)
  #
  # Returns:
  #   A list with:
  #     Gq     - gradient matrix
  #     f      - objective function value
  #     Method - method label

  p <- nrow(L)

  list(
    Gq     = 2 * W * L / p,
    f      = sum(W * L^2) / p,
    Method = "Weighted least squares for Lp rotation"
  )
}