# 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")