# Case 008: deterministic item-scoring and structure example. Base R.
# 256 equally weighted combinations; no random sampling or ordinal data.
names <- c("f1","f2",paste0("e",1:6))
args <- setNames(rep(list(c(-1,1)),8),names)
dat <- do.call(expand.grid,args)
errors <- as.matrix(dat[paste0("e",1:6)])
one_factor <- errors + dat$f1
two_factor <- errors + cbind(dat$f1,dat$f1,dat$f1,dat$f2,dat$f2,dat$f2)
miskeyed <- two_factor
miskeyed[,1] <- -miskeyed[,1]  # deliberately wrong direction
alpha <- function(items) {
  S <- cov(items)
  k <- ncol(items)
  stopifnot(k>1, sum(S)>0)
  k/(k-1)*(1-sum(diag(S))/sum(S))
}
results <- c(one_factor_6=alpha(one_factor),one_factor_3=alpha(one_factor[,1:3]),
 two_factor_6=alpha(two_factor),wrong_key_6=alpha(miskeyed),
 subscale_1=alpha(two_factor[,1:3]),subscale_2=alpha(two_factor[,4:6]))
print(round(results,6))
print(round(cor(two_factor),3))
corrected <- miskeyed
corrected[,1] <- -corrected[,1]  # known coding error, not data-driven key selection
print(c(after_known_key_correction=alpha(corrected)))
stopifnot(nrow(dat)==256L, max(abs(results-c(6/7,.75,.6,.3,.75,.75)))<1e-10,
 abs(alpha(corrected)-.6)<1e-10)
sessionInfo()