# see rotations for more examples	
	
  data(Harman, package = "GPArotation")
  GPFRSorth(Harman8, method = "quartimax")
  quartimax(Harman8)
  GPFRSoblq(Harman8, method = "quartimin", normalize = TRUE)
  loadings( quartimin(Harman8, normalize = TRUE) )
  # using random starts
  data("WansbeekMeijer", package = "GPArotation")
  fa.unrotated  <- factanal(factors = 3, covmat=NetherlandsTV, normalize=TRUE, rotation="none")
  GPFRSoblq(loadings(fa.unrotated), normalize = TRUE, method = "oblimin", randomStarts = 100)
  oblimin(loadings(fa.unrotated), randomStarts=100)
  data(Thurstone, package = "GPArotation")
  geominQ(box26, normalize = TRUE, randomStarts=100)
  
  # displaying results of factor analysis rotation output
  origdigits <- options("digits")
  Abor.unrotated <- factanal(factors = 2, covmat = ability.cov, rotation = "none")
  Abor <- oblimin(loadings(Abor.unrotated), randomStarts = 20)
  Abor
  print(Abor)
  print(Abor, sortLoadings=FALSE) #this matches the output passed to factanal
  print(Abor, Table=TRUE)
  print(Abor, rotateMat=TRUE)
  print(Abor, digits=2)
  # by default provides the structure matrix for oblique rotation
  summary(Abor)
  summary(Abor, Structure=FALSE)
  options(digits = origdigits$digits)
  
  # GPArotation output does sort loadings, but use print to obtain if needed
  set.seed(334)
  xusl <- quartimin(Harman8, normalize = TRUE, randomStarts=100)
  # loadings without ordering (default)
  loadings(xusl)
  max(abs(print(xusl)$loadings - xusl$loadings)) == 0 # FALSE
  # output sorted loadings via print (not default)
  xsl <- print(xusl)
  max(abs(print(xsl)$loadings - xsl$loadings)) == 0 # TRUE
  
  # Kaiser normalization is used when normalize=TRUE
  factanal(factors = 2, covmat = ability.cov, rotation = "oblimin", 
  			control=list(rotate=list(normalize = TRUE)))
  # Cureton-Mulaik normalization can be done by passing values to the rotation
  # may result in convergence problems
  NormalizingWeightCM <- function (L) {
    Dk <- diag(sqrt(diag(L %*% t(L)))^-1) %*% L
    wghts <- rep(0, nrow(L))
    fpls <- Dk[, 1]
    acosi <- acos(ncol(L)^(-1/2))
    for (i in 1:nrow(L)) {
    	num <- (acosi - acos(abs(fpls[i])))
        dem <- (acosi - (function(a, m) ifelse(abs(a) < (m^(-1/2)), pi/2, 0))(fpls[i], ncol(L)))
        wghts[i] <- cos(num/dem * pi/2)^2 + 0.001
    	}
    Dv <- wghts * sqrt(diag(L %*% t(L)))^-1        
    Dv
  }
  quartimin(Harman8, normalize = NormalizingWeightCM(Harman8), randomStarts=100)
  quartimin(Harman8, normalize = TRUE, randomStarts=100)
	
  Run the code above in your browser using DataLab