tests/rotations.R

In GPArotateDF: Derivative Free Gradient Projection Factor Rotation

#   Tests here only compare against values computed with GPArotation code,
#   to ensure the regular and DF versions give the same result


 Sys.getenv("R_LIBS")
 library()
 require("GPArotation")
 require("GPArotateDF")
 search()
 Sys.info()

require("stats")  

fuzz <- 1e-6 
all.ok <- TRUE  


  data(ability.cov)
  L <- loadings(factanal(factors = 2, covmat=ability.cov))

# quartimax

LG <- quartimax(L, normalize = FALSE, eps=1e-5)
LGDF <- GPForth.df(L, normalize = FALSE, eps=1e-5, method = "quartimax")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 
LG <- quartimax(L, normalize = TRUE, eps=1e-5)
LGDF <- GPForth.df(L, normalize = TRUE, eps=1e-5, method = "quartimax")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 	  
 
	  
    
# quartimin

LG <- quartimin(L, normalize = FALSE, eps=1e-5)
LGDF <- GPFoblq.df(L, normalize = FALSE, eps=1e-5, method = "quartimin")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 
  if( fuzz < max(abs(unclass(LGDF)$Phi - unclass(LG)$Phi))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$Phi - unclass(LG)$Phi), digits=18)
    all.ok <- FALSE  
    } 
    
LG <- quartimin(L, normalize = TRUE, eps=1e-5)
LGDF <- GPFoblq.df(L, normalize = TRUE, eps=1e-5, method = "quartimin")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 	  
  if( fuzz < max(abs(unclass(LGDF)$Phi - unclass(LG)$Phi))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$Phi - unclass(LG)$Phi), digits=18)
    all.ok <- FALSE  
    } 
      
# oblimax commented out as it is gives problem quite consistently
   
#LG <- oblimax(L, normalize = FALSE, eps=1e-5)
#LGDF <- GPFoblq.df(L, normalize = FALSE, eps=1e-5, method = "oblimax")  
# Oblimax fails for fuzz = 1e-6. But succeeds for 0.01
#  if( 0.01 < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
#    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
#    cat("difference:\n")
#    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
#    all.ok <- FALSE  
#    } 
#  if( fuzz < max(abs(unclass(LGDF)$Phi - unclass(LG)$Phi))) {
#    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
#    cat("difference:\n")
#    print((unclass(LGDF)$Phi - unclass(LG)$Phi), digits=18)
#    all.ok <- FALSE  
#    } 
    
#LG <- oblimax(L, normalize = TRUE, eps=1e-5)
#LGDF <- GPFoblq.df(L, normalize = TRUE, eps=1e-5, method = "oblimax")  
#  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
#    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
#    cat("difference:\n")
#    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
#    all.ok <- FALSE  
#    } 	  
#  if( fuzz < max(abs(unclass(LGDF)$Phi - unclass(LG)$Phi))) {
#    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
#    cat("difference:\n")
#    print((unclass(LGDF)$Phi - unclass(LG)$Phi), digits=18)
#    all.ok <- FALSE  
#    } 
 
 
# entropy

LG <- entropy(L, normalize = FALSE, eps=1e-5)
LGDF <- GPForth.df(L, normalize = FALSE, eps=1e-5, method = "entropy")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 
LG <- entropy(L, normalize = TRUE, eps=1e-5)
LGDF <- GPForth.df(L, normalize = TRUE, eps=1e-5, method = "entropy")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 	  
 
 
 
# simplimax
   
LG <- simplimax(L, normalize = FALSE, eps=1e-5)
LGDF <- GPFoblq.df(L, normalize = FALSE, eps=1e-5, method = "simplimax")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 
  if( fuzz < max(abs(unclass(LGDF)$Phi - unclass(LG)$Phi))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$Phi - unclass(LG)$Phi), digits=18)
    all.ok <- FALSE  
    } 
    
LG <- simplimax(L, normalize = TRUE, eps=1e-5)
LGDF <- GPFoblq.df(L, normalize = TRUE, eps=1e-5, method = "simplimax")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 	  
  if( fuzz < max(abs(unclass(LGDF)$Phi - unclass(LG)$Phi))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$Phi - unclass(LG)$Phi), digits=18)
    all.ok <- FALSE  
    } 
 
 
# bentlerQ
   
LG <- bentlerQ(L, normalize = FALSE, eps=1e-5)
LGDF <- GPFoblq.df(L, normalize = FALSE, eps=1e-5, method = "bentler")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 
  if( fuzz < max(abs(unclass(LGDF)$Phi - unclass(LG)$Phi))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$Phi - unclass(LG)$Phi), digits=18)
    all.ok <- FALSE  
    } 
    
LG <- bentlerQ(L, normalize = TRUE, eps=1e-5)
LGDF <- GPFoblq.df(L, normalize = TRUE, eps=1e-5, method = "bentler")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 	  
  if( fuzz < max(abs(unclass(LGDF)$Phi - unclass(LG)$Phi))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$Phi - unclass(LG)$Phi), digits=18)
    all.ok <- FALSE  
    } 
 

# bentlerT

LG <- bentlerT(L, normalize = FALSE, eps=1e-5)
LGDF <- GPForth.df(L, normalize = FALSE, eps=1e-5, method = "bentler")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 
LG <- bentlerT(L, normalize = TRUE, eps=1e-5)
LGDF <- GPForth.df(L, normalize = TRUE, eps=1e-5, method = "bentler")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 	  
 

# geominQ
   
LG <- geominQ(L, normalize = FALSE, eps=1e-5)
LGDF <- GPFoblq.df(L, normalize = FALSE, eps=1e-5, method = "geomin")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 
  if( fuzz < max(abs(unclass(LGDF)$Phi - unclass(LG)$Phi))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$Phi - unclass(LG)$Phi), digits=18)
    all.ok <- FALSE  
    } 
    
LG <- geominQ(L, normalize = TRUE, eps=1e-5)
LGDF <- GPFoblq.df(L, normalize = TRUE, eps=1e-5, method = "geomin")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 	  
  if( fuzz < max(abs(unclass(LGDF)$Phi - unclass(LG)$Phi))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$Phi - unclass(LG)$Phi), digits=18)
    all.ok <- FALSE  
    } 
 

# geominT

LG <- geominT(L, normalize = FALSE, eps=1e-5)
LGDF <- GPForth.df(L, normalize = FALSE, eps=1e-5, method = "geomin")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 
LG <- geominT(L, normalize = TRUE, eps=1e-5)
LGDF <- GPForth.df(L, normalize = TRUE, eps=1e-5, method = "geomin")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 	  
 

# infomaxQ
   
LG <- infomaxQ(L, normalize = FALSE, eps=1e-5)
LGDF <- GPFoblq.df(L, normalize = FALSE, eps=1e-5, method = "infomax")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 
  if( fuzz < max(abs(unclass(LGDF)$Phi - unclass(LG)$Phi))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$Phi - unclass(LG)$Phi), digits=18)
    all.ok <- FALSE  
    } 
    
    # changed to eps 1e-6 in order to pass the test.
LG <- infomaxQ(L, normalize = TRUE, eps=1e-6)
LGDF <- GPFoblq.df(L, normalize = TRUE, eps=1e-6, method = "infomax")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 	  
  if( fuzz < max(abs(unclass(LGDF)$Phi - unclass(LG)$Phi))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$Phi - unclass(LG)$Phi), digits=18)
    all.ok <- FALSE  
    } 
 

# infomaxT

LG <- infomaxT(L, normalize = FALSE, eps=1e-5)
LGDF <- GPForth.df(L, normalize = FALSE, eps=1e-5, method = "infomax")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 
LG <- infomaxT(L, normalize = TRUE, eps=1e-5)
LGDF <- GPForth.df(L, normalize = TRUE, eps=1e-5, method = "infomax")  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 	  
 

# CF Equamax Q
   
LG <- GPFoblq(L, normalize = FALSE, eps=1e-5,  method = "cf", methodArgs=list(kappa=2/12))
LGDF <- GPFoblq.df(L, normalize = FALSE, eps=1e-5, method = "cf", methodArgs=list(kappa=2/12))  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 
  if( fuzz < max(abs(unclass(LGDF)$Phi - unclass(LG)$Phi))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$Phi - unclass(LG)$Phi), digits=18)
    all.ok <- FALSE  
    } 
    
LG <- GPFoblq(L, normalize = TRUE, eps=1e-5,  method = "cf", methodArgs=list(kappa=2/12))
LGDF <- GPFoblq.df(L, normalize = TRUE, eps=1e-5, method = "cf", methodArgs=list(kappa=2/12))  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 	  
  if( fuzz < max(abs(unclass(LGDF)$Phi - unclass(LG)$Phi))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$Phi - unclass(LG)$Phi), digits=18)
    all.ok <- FALSE  
    } 
 

# CF equamax T

LG <- GPForth(L, normalize = FALSE, eps=1e-5, method = "cf", methodArgs=list(kappa=2/12))
LGDF <- GPForth.df(L, normalize = FALSE, eps=1e-5, method = "cf", methodArgs=list(kappa=2/12))  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 
LG <- GPForth(L, normalize = TRUE, eps=1e-5, method = "cf", methodArgs=list(kappa=2/12))
LGDF <- GPForth.df(L, normalize = TRUE, eps=1e-5, method = "cf", methodArgs=list(kappa=2/12))  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 
    

# targetQ
LG <- targetQ(L, Target=matrix(c(rep(1,3),rep(0,6),rep(1,3)), 6,2), normalize=FALSE, eps=1e-5)
LGDF <- GPFoblq.df(L, normalize = FALSE, eps=1e-5, method = "target", 
 	methodArgs=list(Target=matrix(c(rep(1,3),rep(0,6),rep(1,3)), 6,2)))  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 
  if( fuzz < max(abs(unclass(LGDF)$Phi - unclass(LG)$Phi))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$Phi - unclass(LG)$Phi), digits=18)
    all.ok <- FALSE  
    } 
    
LG <- targetQ(L, Target=matrix(c(rep(1,3),rep(0,6),rep(1,3)), 6,2), normalize=TRUE, eps=1e-5)
LGDF <- GPFoblq.df(L, normalize = TRUE, eps=1e-5, method = "target", 
 	methodArgs=list(Target=matrix(c(rep(1,3),rep(0,6),rep(1,3)), 6,2)))  

  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 
  if( fuzz < max(abs(unclass(LGDF)$Phi - unclass(LG)$Phi))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$Phi - unclass(LG)$Phi), digits=18)
    all.ok <- FALSE  
    }   	  
 
# targetT

LG <- targetT(L, Target=matrix(c(rep(1,3),rep(0,6),rep(1,3)), 6,2), normalize=FALSE, eps=1e-5)
LGDF <- GPForth.df(L, normalize = FALSE, eps=1e-5, method = "target", 
 	methodArgs=list(Target=matrix(c(rep(1,3),rep(0,6),rep(1,3)), 6,2)))  
  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 

LG <- targetT(L, Target=matrix(c(rep(1,3),rep(0,6),rep(1,3)), 6,2), normalize=TRUE, eps=1e-5)
LGDF <- GPForth.df(L, normalize = TRUE, eps=1e-5, method = "target", 
 	methodArgs=list(Target=matrix(c(rep(1,3),rep(0,6),rep(1,3)), 6,2)))  
  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 
 

A <- matrix(c(0.664, 0.688, 0.492,  0.837,  0.705,  0.82,  0.661, 0.457, 0.765,
              0.322, 0.248, 0.304, -0.291, -0.314, -0.377, 0.397, 0.294, 0.428,
             -0.075, 0.192, 0.224, 0.037, 0.155,  -0.104, 0.077, 0-.488, 0.009),
            ncol = 3)
T0 <- matrix(NA, ncol = 3, nrow = 9)
T0[1, 1] <- T0[2, 1] <- T0[1, 2] <- 0
LG <- targetT(A, Target = T0)
LGDF <- GPForth.df(A, method="target", methodArgs=list(Target = T0))
  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 
 
fuzz <- 1e-2 # Because loadings to zero, lower the bar to same results
LG <- targetQ(A, Target = T0)
LGDF <- GPFoblq.df(A, method="target", methodArgs=list(Target = T0))
  if( fuzz < max(abs(unclass(LGDF)$loadings - unclass(LG)$loadings))) {
    cat("Calculated value is not the same as test value in test rotations 1. Value:\n")
    cat("difference:\n")
    print((unclass(LGDF)$loadings - unclass(LG)$loadings), digits=18)
    all.ok <- FALSE  
    } 
 
# pstT
# This won't converge properly
# No further investigations performed.

 
 
cat("tests completed.\n")



if (! all.ok) stop("some tests FAILED")