https://github.com/cran/nFactors
Raw File
Tip revision: 592b098fc786911733da1c1953e58c9d1c2e9517 authored by Gilles Raiche on 10 April 2010, 00:00:00 UTC
version 2.3.3
Tip revision: 592b098
nBartlett.r
nBartlett <-
function(x, N, alpha=0.05, cor=TRUE, details=TRUE, correction=TRUE, ...) {
 stopMessage  <- paste("\n These indices are only valid with a principal component solution.\n",
                       " ...................... So, only positive eugenvalues are permitted.\n",
                       sep="")
 x            <- eigenComputes(x, cor=cor, ...)
 if (length(which(x<0)) > 0) {cat(stopMessage);stop()}
 
 n            <- length(x)
 detail       <- NULL
 bartlett.n   <- anderson.n   <- lawley.n                   <- 0
 bartlett     <- bartlett.chi <- bartlett.df <- bartlett.p  <- numeric(n)
 anderson.chi <- anderson.df  <- anderson.p                 <- numeric(n)
 lawley.chi   <- lawley.df    <- lawley.p                   <- numeric(n)
 for (k in 0:(n-1)) {
  i <- k+1
  bartlett[i]     <- prod(x[(k+1):n]) /  (sum(x[(k+1):n])/(n-k))^(n-k) # From Horn et Engstrom (1979)
  bartlett.chi[i] <- -(N - 1 - ((2*n+5)/6) - ((2*k)/3)) * log(bartlett[i])
  bartlett.df[i]  <- .5 * (n-k) * (n-k-1)   # Bartlett without correction, from Horn and Engstrom (1979. p. 291, equation 8)
  if (correction==TRUE & bartlett.n > 0) bartlett.df[i]  <- .5 * (n-k+2) * (n-k-1)  # From Bentler and Yuan (1996, p. 300)
  bartlett.p[i]   <- pchisq(bartlett.chi[i] , bartlett.df[i], lower.tail = FALSE)
  # Conditions to stop when non significant test are obtained
  anderson.chi[i] <- -N * log(bartlett[i])  # From Bentler and Yuan (1996, p. 300, equations 3-4)
  anderson.df[i]  <- .5 * (n-k+2) * (n-k-1) # From Bentler and Yuan (1996, p. 300)
  anderson.p[i]   <- pchisq(anderson.chi[i] , anderson.df[i], lower.tail = FALSE)
  lMean           <- mean(x[(k+1):n])
  lawley.chi[i]   <- -(N - 1 - ((2*n+5)/6) - ((2*k)/3) + sum((lMean^2)/((x[k]+lMean)^2))) * log(bartlett[i]) # From Bentler and Yuan (1996, p. 300, equation 6)
  lawley.df[i]    <- .5 * (n-k) * (n-k-1) # From Horn and Engstrom (1979. p. 291, equation 8)
  lawley.p[i]     <- pchisq(lawley.chi[i] , lawley.df[i], lower.tail = FALSE)
# print(c(bartlett[i], bartlett.chi[i], bartlett.df[i], bartlett.p[i]),2)  ############ TEST #############
  if (i == 1) {
   bartlett.n <- bartlett.n + as.numeric(bartlett.p[i] <= alpha)
   anderson.n <- anderson.n + as.numeric(anderson.p[i] <= alpha)
   lawley.n   <- lawley.n   + as.numeric(lawley.p[i]   <= alpha)
      }
  if (i > 1)  {
   if(bartlett.p[i-1] <= 0.05) bartlett.n <- bartlett.n + as.numeric(bartlett.p[i] <= alpha)
   if(anderson.p[i-1] <= 0.05) anderson.n <- anderson.n + as.numeric(anderson.p[i] <= alpha)
   if(lawley.p[i-1]   <= 0.05) lawley.n   <- lawley.n   + as.numeric(lawley.p[i]   <= alpha)
   }
  }
 if (bartlett.n == 0) bartlett.n <- n # If no test if significant, retain all components
 if (anderson.n == 0) anderson.n <- n
 if (lawley.n   == 0) lawlwy.n   <- n
 if (details == TRUE) detail    <- data.frame(v=(1:(n)),values=x[1:(n)],
                                               bartlett, bartlett.chi, bartlett.df, bartlett.p,
                                               anderson.chi, anderson.df, anderson.p,
                                               lawley.chi,   lawley.df,   lawley.p)
 res        <- list(detail=detail,
                    nFactors=c(bartlett=bartlett.n, anderson=anderson.n, lawley=lawley.n))
 class(res) <- c("nFactors","list")
 return(res)
 }

back to top