tests/legacyVsBB_extra.R

In GPArotation: Gradient Projection Factor Rotation

# Additional legacy vs BB convergence tests using package datasets.
# Verifies that BB+fw10 finds same or better solution than legacy
# across multiple datasets and criteria.

require("GPArotation")

all.ok <- TRUE
fuzz   <- 1e-4   # loose tolerance --- same solution within rounding

data("CCAI",          package = "GPArotation")
data("WansbeekMeijer", package = "GPArotation")
data("GriffithMulaik", package = "GPArotation")
data("Harman",        package = "GPArotation")
data("Thurstone",     package = "GPArotation")

# Helper: check BB finds solution at least as good as legacy
check_bb <- function(label, leg, bb) {
  f.leg <- leg$Table[nrow(leg$Table), "f"]
  f.bb  <-  bb$Table[nrow(bb$Table),  "f"]
  # BB should find same or better (lower) criterion value
  if (f.bb > f.leg + fuzz) {
    cat(label, ": BB found worse solution than legacy\n")
    cat("  legacy f =", f.leg, "  BB f =", f.bb, "\n")
    all.ok <<- FALSE
  }
  # Both should converge
  if (!bb$convergence) {
    cat(label, ": BB did not converge\n")
    all.ok <<- FALSE
  }
}

set.seed(2026)

# --- CCAI 3-factor ---

fa.ccai <- factanal(factors = 3, covmat = CCAI_R,
                    n.obs = 461, rotation = "none")

check_bb("CCAI oblimin",
  oblimin(fa.ccai,   algorithm = "legacy", fwindow = 1, randomStarts = 10),
  oblimin(fa.ccai,   algorithm = "bb",     fwindow = 10, randomStarts = 10))

check_bb("CCAI Varimax",
  Varimax(fa.ccai,   algorithm = "legacy", fwindow = 1, randomStarts = 10),
  Varimax(fa.ccai,   algorithm = "bb",     fwindow = 10, randomStarts = 10))

check_bb("CCAI geominQ",
  geominQ(fa.ccai,   algorithm = "legacy", fwindow = 1, randomStarts = 10),
  geominQ(fa.ccai,   algorithm = "bb",     fwindow = 10, randomStarts = 10))

check_bb("CCAI tandemI",
  tandemI(fa.ccai,   algorithm = "legacy", fwindow = 1, randomStarts = 10),
  tandemI(fa.ccai,   algorithm = "bb",     fwindow = 10, randomStarts = 10))

check_bb("CCAI bentlerQ",
  bentlerQ(fa.ccai,  algorithm = "legacy", fwindow = 1, randomStarts = 10),
  bentlerQ(fa.ccai,  algorithm = "bb",     fwindow = 10, randomStarts = 10))

check_bb("CCAI quartimin",
  quartimin(fa.ccai, algorithm = "legacy", fwindow = 1, randomStarts = 10),
  quartimin(fa.ccai, algorithm = "bb",     fwindow = 10, randomStarts = 10))

# --- NetherlandsTV 2-factor ---

fa.nl <- factanal(factors = 2, covmat = NetherlandsTV,
                  rotation = "none")

check_bb("NetherlandsTV oblimin",
  oblimin(fa.nl,   algorithm = "legacy", fwindow = 1, randomStarts = 10),
  oblimin(fa.nl,   algorithm = "bb",     fwindow = 10, randomStarts = 10))

check_bb("NetherlandsTV Varimax",
  Varimax(fa.nl,   algorithm = "legacy", fwindow = 1, randomStarts = 10),
  Varimax(fa.nl,   algorithm = "bb",     fwindow = 10, randomStarts = 10))

check_bb("NetherlandsTV geominT",
  geominT(fa.nl,   algorithm = "legacy", fwindow = 1, randomStarts = 10),
  geominT(fa.nl,   algorithm = "bb",     fwindow = 10, randomStarts = 10))

check_bb("NetherlandsTV targetT",
  targetT(fa.nl,
          Target = matrix(c(1,1,0,0,1,0,0,0,1,1,0,1,0,1), 7, 2),
          algorithm = "legacy", fwindow = 1, randomStarts = 10),
  targetT(fa.nl,
          Target = matrix(c(1,1,0,0,1,0,0,0,1,1,0,1,0,1), 7, 2),
          algorithm = "bb",     fwindow = 10, randomStarts = 10))

# --- GriffithMulaik 6-factor ---

fa.gm <- factanal(factors = 6, covmat = GriffithMulaik,
                  n.obs = 523, rotation = "none")

check_bb("GriffithMulaik oblimin",
  oblimin(fa.gm,   algorithm = "legacy", fwindow = 1, randomStarts = 10),
  oblimin(fa.gm,   algorithm = "bb",     fwindow = 10, randomStarts = 10))

check_bb("GriffithMulaik geominQ",
  geominQ(fa.gm,   algorithm = "legacy", fwindow = 1, randomStarts = 10),
  geominQ(fa.gm,   algorithm = "bb",     fwindow = 10, randomStarts = 10))

check_bb("GriffithMulaik Varimax",
  Varimax(fa.gm,   algorithm = "legacy", fwindow = 1, randomStarts = 10),
  Varimax(fa.gm,   algorithm = "bb",     fwindow = 10, randomStarts = 10))

# --- Harman8 2-factor ---

check_bb("Harman8 quartimax",
  quartimax(Harman8, algorithm = "legacy", fwindow = 1, randomStarts = 10),
  quartimax(Harman8, algorithm = "bb",     fwindow = 10, randomStarts = 10))

check_bb("Harman8 bentlerT",
  bentlerT(Harman8,  algorithm = "legacy", fwindow = 1, randomStarts = 10),
  bentlerT(Harman8,  algorithm = "bb",     fwindow = 10, randomStarts = 10))

check_bb("Harman8 geominT",
  geominT(Harman8,   algorithm = "legacy", fwindow = 1, randomStarts = 10),
  geominT(Harman8,   algorithm = "bb",     fwindow = 10, randomStarts = 10))

# --- box26 3-factor ---

check_bb("box26 oblimin",
  oblimin(box26,   algorithm = "legacy", fwindow = 1, randomStarts = 10),
  oblimin(box26,   algorithm = "bb",     fwindow = 10, randomStarts = 10))

check_bb("box26 equamax",
  equamax(box26,   algorithm = "legacy", fwindow = 1, randomStarts = 10),
  equamax(box26,   algorithm = "bb",     fwindow = 10, randomStarts = 10))

check_bb("box26 parsimax",
  parsimax(box26,  algorithm = "legacy", fwindow = 1, randomStarts = 10),
  parsimax(box26,  algorithm = "bb",     fwindow = 10, randomStarts = 10))

check_bb("box26 geominQ",
  geominQ(box26,   algorithm = "legacy", fwindow = 1, randomStarts = 10),
  geominQ(box26,   algorithm = "bb",     fwindow = 10, randomStarts = 10))

# --- Cayley vs legacy (orthogonal only) ---

check_bb("Harman8 Varimax cayley",
  Varimax(Harman8,   algorithm = "legacy", fwindow = 1, randomStarts = 10),
  Varimax(Harman8,   algorithm = "cayley", fwindow = 10, randomStarts = 10))

check_bb("Harman8 quartimax cayley",
  quartimax(Harman8, algorithm = "legacy", fwindow = 1, randomStarts = 10),
  quartimax(Harman8, algorithm = "cayley", fwindow = 10, randomStarts = 10))

check_bb("box26 Varimax cayley",
  Varimax(box26,     algorithm = "legacy", fwindow = 1, randomStarts = 10),
  Varimax(box26,     algorithm = "cayley", fwindow = 10, randomStarts = 10))


cat("legacyVsBB extra tests completed.\n")
if (!all.ok) stop("some tests FAILED")