R Under development (unstable) (2023-11-11 r85510 ucrt) -- "Unsuffered Consequences" Copyright (C) 2023 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > # tests using normalization > # All tests below use Kaiser normalization > # A few other tests also use normalization when comparing varimax and Varimax > > # Following examples are from SPSS > # See https://psych.unl.edu/psycrs/statpage/pc_rot.pdf > > Sys.getenv("R_LIBS") [1] "D:\\temp\\Rtmps9R4jg\\RLIBS_b9d44bfa7056" > library() > require("GPArotation") Loading required package: GPArotation > search() [1] ".GlobalEnv" "package:GPArotation" "package:stats" [4] "package:graphics" "package:grDevices" "package:utils" [7] "package:datasets" "package:methods" "Autoloads" [10] "package:base" > Sys.info() sysname release version nodename machine "Windows" "Server x64" "build 20348" "CRANWIN3" "x86-64" login user effective_user "CRAN" "CRAN" "CRAN" > > require("stats") > require("GPArotation") > > fuzz <- 1e-3 #less strict; differences in 4rd decimal compared to SPSS > all.ok <- TRUE > > # unrotated matrix > L <- matrix(c(.758, .413, 1.164E-03, .693, .489, -.199, .362, .656, -.204, + .826, 6.589E-02, .235, .540, -.510, .441, .654, -.335, .507, + -.349, .539, .669, -.580, .450, .551), byrow=T, ncol=3) > > # quartimax, Kaiser normalization > # uses the print command to get the right order of factors > v <- print(quartimax(L, normalize = TRUE, eps = 1e-6))$loadings Orthogonal rotation method Quartimax converged. Loadings: [,1] [,2] [,3] [1,] 0.8134 0.2848 -0.0496 [2,] 0.8566 0.0828 -0.1355 [3,] 0.7459 -0.2036 0.0724 [4,] 0.5762 0.6342 -0.0875 [5,] -0.0613 0.8498 -0.1423 [6,] 0.1287 0.8826 -0.0385 [7,] 0.0204 -0.0415 0.9261 [8,] -0.1811 -0.2196 0.8726 [,1] [,2] [,3] SS loadings 2.337 2.083 1.675 Proportion Var 0.292 0.260 0.209 Cumulative Var 0.292 0.552 0.762 > > tst <- matrix(c(.814, .285, -4.99E-02, .856, 8.321E-02, -.135, + .746, -.203, 7.244E-02, .576, .634, -8.73E-02, + -6.10E-02, .850, -.142, .129, .882, -3.86E-02, + 2.063E-02, -4.15E-02, .927, -.181, -.220, .873), byrow=T, ncol=3) > > 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 + } > > # oblimin, Kaiser normalization > # Pattern Matrix > vw <- print(oblimin(L, normalize = TRUE, eps = 1e-7)) Oblique rotation method Oblimin Quartimin converged. Loadings: [,1] [,2] [,3] [1,] 0.7875 0.2396 -0.0133 [2,] 0.8484 0.0165 -0.1185 [3,] 0.7785 -0.2410 0.0683 [4,] 0.5085 0.6071 -0.0253 [5,] -0.1610 0.8569 -0.0728 [6,] 0.0327 0.8953 0.0397 [7,] 0.0740 0.0938 0.9481 [8,] -0.1130 -0.0860 0.8744 [,1] [,2] [,3] SS loadings 2.297 2.087 1.710 Proportion Var 0.287 0.261 0.214 Cumulative Var 0.287 0.548 0.762 Phi: [,1] [,2] [,3] [1,] 1.0000 0.169 -0.0955 [2,] 0.1691 1.000 -0.2371 [3,] -0.0955 -0.237 1.0000 > v <- vw$loadings > > tst <- matrix(c(.241, .787, -1.36E-02, 1.783E-02, .848, -.119, + -.240, .779, 6.824E-02, .608, .507, -2.52E-02, + .858, -.163, -7.26E-02, .896, 3.050E-02, 3.954E-02, + 9.405E-02, 7.397E-02, .949, -8.61E-02, -.113, .875), byrow=T, ncol=3) > tst <- tst %*% matrix(c(0,1,0,1,0,0,0,0,1), 3) # Needed to line up factors correctly > > fuzz <- 3e-3 #less strict; differences in 4th decimal compared to SPSS; 0.003 or smaller diff > > 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 + } > > # oblimin, Kaiser normalization > # Structure Matrix > v <- vw$loadings %*% vw$Phi > > tst <- matrix(c(.379, .829, -.146, .191, .862, -.203, + -.123, .731, .051, .701, .613, -.218, .847, -.010, -.261, + .891, .180, -.176, -.118, .000, .919, -.313, -.211, .906), byrow=T, ncol=3) > tst <- tst %*% matrix(c(0,1,0,1,0,0,0,0,1), 3) # Needed to line up factors correctly > > fuzz <- 4e-3 #less strict; differences in 4th decimal compared to SPSS; 0.004 or smaller diff > > 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 + } > > ################################################################# > # > # Confirmation that a row of zeroes will not break the normalization function > # Normalizing with a column of zeroes was not affected > # based on example from Kim-Laura Speck (25 October 2023) > # Only affects Normalize=TRUE settings > > fuzz <- 1e-6 > > D <- matrix(c(0,0,0, 1,2,3, 2,3,4, 5,2,5, 1,2,1, 3,4,5),ncol=3,byrow=T) > set.seed(1000) #set seed becasuse some variance is observed in converged values > v <- geominQ(D, normalize = TRUE, maxit = 10000)$loadings > > tst <- matrix(c( + 0.00000000, 0.00000000, 0.00000000, + -0.36979732, -0.13603325, 3.99622380, + 0.03102554, 0.76678245, 4.68896063, + 3.28926158, 0.01317821, 5.35447764, + -0.02755956, 2.40311582, 0.06247234, + 0.43184841, 1.66959816, 5.38169746), ncol = 3, byrow = TRUE) > > 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 + } > > > proc.time() user system elapsed 0.48 0.04 0.53