# Tests here only compare against values computed previously with this code, # to ensure there was no accidental change. It would be better to have # comparisons with known correct values. # Test for oblimax is commented out as it appears to be unstable. Sys.getenv("R_LIBS") library() require("GPArotation") search() Sys.info() require("stats") require("GPArotation") fuzz <- 1e-6 all.ok <- TRUE data(ability.cov) L <- loadings(factanal(factors = 2, covmat=ability.cov)) if( 0.001 < max(abs(varimax(L, normalize=FALSE)$loadings - Varimax(L, normalize=FALSE)$loadings))) { cat("Calculated difference exceeds tolerance\n") cat("difference:\n") print(varimax(L, normalize=FALSE)$loadings - Varimax(L, normalize=FALSE)$loadings, digits=18) all.ok <- FALSE } if( 0.01 < max(abs(varimax(L, normalize=TRUE)$loadings - Varimax(L, normalize=TRUE, eps=1e-5)$loadings))) { cat("Calculated difference exceeds tolerance\n") cat("difference:\n") print(varimax(L, normalize=TRUE)$loadings - Varimax(L, normalize=TRUE, eps=1e-5)$loadings, digits=18) all.ok <- FALSE } v <- oblimin(L, eps=1e-8)$loadings tst <- t(matrix(c( 0.3863615904740822504, 0.4745127741495974161, -0.0110059418769087539, 0.6458720769633764514, -0.0262926272350604423, 0.8961141105684561348, -0.0180200526810754824, 0.4882928281695405048, 0.9900944939102318543, -0.0370718282544326011, 0.7905657274265397438, 0.0526109550054999417 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 1. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- quartimin(L, eps=1e-8)$loadings tst <- t(matrix(c( 0.3863615904740822504, 0.4745127741495974161, -0.0110059418769087539, 0.6458720769633764514, -0.0262926272350604423, 0.8961141105684561348, -0.0180200526810754824, 0.4882928281695405048, 0.9900944939102318543, -0.0370718282544326011, 0.7905657274265397438, 0.0526109550054999417 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 2. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- targetT(L, Target=matrix(c(rep(1,3),rep(0,6),rep(1,3)), 6,2), eps=1e-5)$loadings tst <- t(matrix(c( 0.551529228817982942, 0.4905002767031292898, 0.217748645523411000, 0.6027046291262584399, 0.291173432863349457, 0.8348885228488550636, 0.154994397662456290, 0.4544843569140373241, 0.969702339393929247, 0.0850652965070581996, 0.803390575440818822, 0.1448091121037717866 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 3. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- targetQ(L, Target=matrix(c(rep(1,3),rep(0,6),rep(1,3)), 6,2), eps=1e-5)$loadings tst <- t(matrix(c( 0.735795682866631218, 0.565351705145453853, 0.433590223819374398, 0.664644550038417159, 0.589924557708411568, 0.920006940799857786, 0.317543426981046928, 0.500590650032113116, 1.021758247914384077, 0.155121528590726393, 0.872521244896209747, 0.208735706420634437 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 4. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } # Does not converge even with maxit=10000, but the loadings matrix is not # changing. Possibly the gradient is extremely large even very close to opt. v <- pstT(L, W = matrix(c(rep(.4,6),rep(.6,6)), 6,2), Target= matrix(c(rep(1,3),rep(0,6),rep(1,3)), 6,2), maxit=1000, eps=1e-5)$loadings tst <- t(matrix(c( 0.37067889993474656407, 0.638257130653133720, 0.01855112570739854416, 0.640564749523800270, 0.01576132191496706567, 0.884065831441111172, 0.00524531003824213384, 0.480158078874985073, 0.89458633399812259590, 0.383762977265515448, 0.71793428958051475064, 0.388556883222951677 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 5. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } # Does not converge even with maxit=10000, but the loadings matrix is not # changing. Possibly the gradient is extremely large even very close to opt. v <- pstQ(L, W = matrix(c(rep(.4,6),rep(.6,6)), 6,2), Target= matrix(c(rep(1,3),rep(0,6),rep(1,3)), 6,2), maxit=1000, eps=1e-5)$loadings tst <- t(matrix(c( 0.573125161748393785, 0.700868331877288475, 0.214899397066479453, 0.681727425525818886, 0.286558275327103040, 0.940272379393286339, 0.152257795885557295, 0.510481967637567036, 1.029289798076480578, 0.462598702071116141, 0.850691132520651205, 0.456859727346562328 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 6. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } # oblimax # this is test value on one computer # tst <- t(matrix(c( # -8111059.94622692652, 8111060.62253121007, # 1495036.43465861562, -1495035.79614594672, # 2331634.63904705830, -2331633.75893370388, # 1356735.91680212389, -1356735.43916810025, # -23187491.19758165255, 23187491.68068471923, # -18357040.58573083207, 18357041.05348757654 # ), 2, 6)) # # this is test value on another computer # tst <- t(matrix(c( # 2694770.06630349346, -2694769.38999920478, # -496701.45733913727, 496702.09585180727, # -774647.63529061736, 774648.51540397422, # -450753.43529273639, 450753.91292676108, # 7703672.48495316971, -7703672.00185009185, # 6098832.71036116872, -6098832.24260441773 # ), 2, 6)) # # this does not converge on all platforms and has large differences possible a mistake ??? # v <- oblimax(L, eps=1e-5)$loadings # if( fuzz < max(abs(v - tst))) { # cat("Calculated value is not the same as test value in test rotations 7. Value:\n") # print(v, digits=18) # cat("difference:\n") # print(v - tst, digits=18) # all.ok <- FALSE # } v <- entropy(L, maxit=3000, eps=1e-5)$loadings tst <- t(matrix(c( 0.528292107548243184, 0.515443945340967824, 0.189686511729033253, 0.612116304198454975, 0.252311894464850861, 0.847442931117894815, 0.133843268148035738, 0.461156452364903380, 0.964740133927989407, 0.129750551769587635, 0.795847094000000532, 0.181751199795689433 ), 2, 6)) if( 0.01 < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 8. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- quartimax(L, eps=1e-5)$loadings tst <- t(matrix(c( 0.534714740804540178, 0.508778102568043678, 0.197348140750149392, 0.609689309353509956, 0.262919828098457153, 0.844212045390758559, 0.139616102327241837, 0.459441658926639795, 0.966291466215733252, 0.117641548844535412, 0.798063848020893585, 0.171756193883937508 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 9. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- Varimax(L, eps=1e-8)$loadings tst <- t(matrix(c( 0.515866523962843160, 0.527879475961036904, 0.175054634278874244, 0.616460231981747930, 0.232057748479543163, 0.853211588623112749, 0.122822468397975171, 0.464213243286899446, 0.961376376417989453, 0.152689863976982837, 0.791292800869773050, 0.200653429940987366 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 10. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- simplimax(L, eps=1e-5)$loadings tst <- t(matrix(c( 0.3384175759313114429, 0.508414890494446547464, -0.0654601124161610648, 0.670992229004664153535, -0.1016231721735353366, 0.930535379393095940515, -0.0589933707274080121, 0.506904360351960181497, 0.9733094402675376289, 0.000234046050254643859, 0.7702037184085044341, 0.085651123319384916965 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 11. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- bentlerT(L, eps=1e-8)$loadings tst <- t(matrix(c( 0.523583611303327312, 0.520226117818945788, 0.184113022124463677, 0.613815719643687197, 0.244596116053327067, 0.849702038129718673, 0.129644684715025493, 0.462354355134084738, 0.963520501269179652, 0.138517057902201340, 0.794161628656258278, 0.188979901644201559 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 12. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- bentlerQ(L, eps=1e-8)$loadings tst <- t(matrix(c( 0.3801726240258240241, 0.4741208368044214638, -0.0223632969057368826, 0.6514196922540864687, -0.0421105927111659756, 0.9039359851665277334, -0.0266594447192576613, 0.4925968005718689424, 0.9961524457620027917, -0.0485973498906049697, 0.7939648477384558811, 0.0440983921679098251 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 13. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- tandemI(L, eps=1e-5)$loadings tst <- t(matrix(c( 0.615424480780047745, 0.4074649925368262759, 0.300894306348887419, 0.5658002819054848143, 0.406455233467338028, 0.7852483408305571677, 0.217785179074990981, 0.4279590047675180808, 0.971977129465111611, -0.0530960591067626969, 0.815800376450207976, 0.0295946184147908228 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 14. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- tandemII(L, eps=1e-5)$loadings tst <- t(matrix(c( 0.512160139332842212, 0.531476249107136312, 0.170736763115044710, 0.617670057812827134, 0.226081850628144149, 0.854814488884392154, 0.119571200821562001, 0.465061309851099225, 0.960284416460420398, 0.159413208985883820, 0.789869387186175276, 0.206185467095899383 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 15. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- geominT(L, eps=1e-5)$loadings tst <- t(matrix(c( 0.572197044101002361, 0.4662247895688098054, 0.243573415560656120, 0.5927388411683653935, 0.326956608263186954, 0.8215352639437966120, 0.174476792179181994, 0.4473668997335142894, 0.972471249855535680, 0.0431091626026945812, 0.808894688433769660, 0.1099794466209375043 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 16. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- geominQ(L, eps=1e-5)$loadings tst <- t(matrix(c( 0.39672053553904490508, 0.4713295988080449250, 0.00424452688463150020, 0.6389466007374070555, -0.00510976786312981532, 0.8864521406378518265, -0.00646959173137159373, 0.4830101828530461994, 0.98709860078485589518, -0.0318959930081098297, 0.79011178369962709045, 0.0558689642678330683 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 17. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- cfT(L, eps=1e-8)$loadings tst <- t(matrix(c( 0.534721263659975854, 0.508771247100584523, 0.197355957387199576, 0.609686779159006154, 0.262930651479430233, 0.844208674501022327, 0.139621992686633722, 0.459439868910532512, 0.966292974385164483, 0.117629160286744874, 0.798066049992627313, 0.171745962120156664 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 18. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- cfQ(L, eps=1e-8)$loadings tst <- t(matrix(c( 0.3863615904740822504, 0.4745127741495974161, -0.0110059418769087539, 0.6458720769633764514, -0.0262926272350604423, 0.8961141105684561348, -0.0180200526810754824, 0.4882928281695405048, 0.9900944939102318543, -0.0370718282544326011, 0.7905657274265397438, 0.0526109550054999417 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 19. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- infomaxT(L, eps=1e-5)$loadings tst <- t(matrix(c( 0.495330443338021176, 0.547195361446864537, 0.151384273205308784, 0.622695868320644275, 0.199304253086364791, 0.861451466010626055, 0.105004533733904976, 0.468565194910632365, 0.954843809781045660, 0.189293503899924942, 0.783052579543945471, 0.230726576980168713 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 20. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- infomaxQ(L, eps=1e-5)$loadings tst <- t(matrix(c( 0.39327554287862442894, 0.4693137508305071925, -0.00319802321222481794, 0.6422985517185823001, -0.01549245038490981718, 0.8912279460026399924, -0.01214605901641467763, 0.4856544522916727002, 0.99260028929193111491, -0.0433225495465055510, 0.79356458059567791530, 0.0471559021503157039 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 21. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- mccammon(L, eps=1e-5)$loadings tst <- t(matrix(c( 0.4293472299617892007, 0.600363196582340275, 0.0790140496845253004, 0.635943490060206229, 0.0992523811009183854, 0.878618107277518656, 0.0506062164774049028, 0.477512622702450096, 0.9268544198491108776, 0.297488850382792269, 0.7514463663627769519, 0.318958389348199534 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 22. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } ###### ADDED IN NOVEMBER 2022 FOR EQUAMAX, PARSIMAX, VARIMIN, OBLIMAX data(Thurstone) v <- equamax(box26, eps=1e-5)$loadings tst <- t(matrix(c( 0.511813618717971597, 0.1252460667724786814, 0.835031881099661200, 0.211275278125612587, 0.9469860693462274215, 0.024701038786419674, 0.923671387190205140, 0.1861505968810791833, -0.278366886980007111, 0.414270797796799317, 0.7243752493532077397, 0.530526346393166759, 0.927099794400001564, 0.1710560637343615797, 0.314400690653154735, 0.685509679739711331, 0.6873945075387188908, -0.212674093365320949, 0.500975325417812756, 0.4985944480056956341, 0.693100497576226382, 0.350251174602310256, 0.8631423492204841619, 0.303299191676876356, 0.809196181501955492, 0.1468111894018074293, 0.540855816747015439, 1.051940508364259674, 0.2023337382785123650, 0.126016765617061266, 0.528246625368315792, 0.8145581663496035407, -0.154555803579673606, 0.791784749686200273, 0.5353191515116044741, -0.254010464723911089, 0.283760830721282831, -0.7132278971933163625, 0.633221728633476699, -0.283760830721282831, 0.7132278971933163625, -0.633221728633476699, -0.351981708826951678, 0.0145585781278812498, 0.920862598031950474, 0.351981708826951678, -0.0145585781278812498, -0.920862598031950474, -0.641238077659381234, 0.7340358583767647715, 0.211813801195267382, 0.641238077659381234, -0.7340358583767647715, -0.211813801195267382, 0.370916272566192251, 0.7781992933002486179, 0.457012011497068604, 0.943267697340363864, 0.1458935486092693412, 0.269085717994103968, 0.683769139477491628, 0.6932804480935084168, -0.193612975261152009, 0.375506314902942506, 0.7683789003013250518, 0.444462454027040654, 0.921697465732450816, 0.1542330203892136042, 0.244709944799956780, 0.664806997738585315, 0.6918110118942031317, -0.165931249557543792, 0.748952844572093657, 0.5985308972371030656, 0.239842451746804020, 0.716556890444816297, 0.6343221919993241587, 0.139425892477791219 ), 3, 26)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 22. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } ### SAME FOR CRAWFORD FERGUSON WITH KAPPA = m / (2 * p) = 3 / (2 * 26) v <- cfT(box26, kappa = (3 / (2 * 26)), eps=1e-5)$loadings if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 22. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- parsimax(box26, eps=1e-5)$loadings tst <- t(matrix(c( 0.7201835790622810318, -0.2820790149262949464, 0.6137467244615277817, -0.0679423851913938670, 0.6010788795762025405, 0.7590243822315081434, 0.6707172136894012926, 0.7174085874409354968, -0.0277909684381195121, 0.3564975652920873705, 0.2169149780725644350, 0.8964682806594965747, 0.8905375652375422391, 0.2961288407436278303, 0.3269136806262873951, 0.3419238671745732927, 0.8395902605853544642, 0.4072361273101923196, 0.5551801796495600128, 0.0181442676741417341, 0.8193941381745735164, 0.1791815177720131602, 0.4232257028261393605, 0.8651329309165379788, 0.8735154515073240145, 0.0707778916688399651, 0.4481498031114935499, 0.9254209439635597834, 0.5018907196720771013, 0.2347334274887991901, 0.1871266535649374341, 0.7975561080494565358, 0.5434380093797205324, 0.4642991413806251688, 0.8329607560592182658, 0.2619421428072832847, 0.6793187635833454197, -0.7070938474525871875, -0.1694942722875707464, -0.6793187635833454197, 0.7070938474525871875, 0.1694942722875707464, 0.0126413340577520572, -0.7959999181796318934, 0.5816488003350992475, -0.0126413340577520572, 0.7959999181796318934, -0.5816488003350992475, -0.7005089039174136056, -0.0349340740508546910, 0.7091733821870598309, 0.7005089039174136056, 0.0349340740508546910, -0.7091733821870598309, 0.2764675266718980007, 0.2782887989292237019, 0.8933946782281918519, 0.8957285854821546156, 0.3212930506383097073, 0.2790825626255922787, 0.3455615085575033385, 0.8287155760723180498, 0.4236528505493507568, 0.2788032457489866833, 0.2837361452757249936, 0.8779069142135194070, 0.8654448252950356357, 0.3331277242202841382, 0.2706070467039994321, 0.3390107603224090660, 0.7999236919074760310, 0.4396564471388281214, 0.5855440811683275681, 0.5029973433114328651, 0.6171108503586539840, 0.5106729412991620753, 0.5782224406112924653, 0.5832066153589001711 ), 3, 26)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 22. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } ### SAME FOR CRAWFORD FERGUSON WITH KAPPA = (m - 1) / (p + m - 2) = (3 -1) / (26 + 3 - 2) v <- cfT(box26, kappa=( (3-1)/(26+3-2) ), eps=1e-5)$loadings if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 22. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } data(Harman, package= "GPArotation") v <- varimin(Harman8, eps=1e-5)$loadings tst <- t(matrix(c( 0.800626657046876855, -0.452452158825595752, 0.783606930490612252, -0.524447498313301397, 0.742635936060292656, -0.522609669324872517, 0.768357486963803682, -0.455227165519225097, 0.818696625686402668, 0.444445536696790211, 0.702064973637186673, 0.410429985249392060, 0.623283524595303340, 0.401857745935120247, 0.668480210595655877, 0.287458184858228272 ), 2, 8)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 22. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- oblimax(Harman8, eps=1e-5)$loadings tst <- t(matrix(c( 0.93395421734409445058, -0.0302013026726007383, 0.99243032312927881300, -0.1121899246869615951, 0.96509469978483286567, -0.1322258547171115683, 0.91647702431117861188, -0.0502569243958834178, 0.08441855308346873921, 0.8875309317276611765, 0.04427084251510177149, 0.7907585046311147448, 0.00332736511424391868, 0.7399752420126202157, 0.14133359391312094733, 0.6483050831171799366 ), 2, 8)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 22. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } cat("tests completed.\n") if (! all.ok) stop("some tests FAILED")