### * <HEADER>
###
attach(NULL, name = "CheckExEnv")
assign("nameEx",
       local({
	   s <- "__{must remake R-ex/*.R}__"
           function(new) {
               if(!missing(new)) s <<- new else s
           }
       }),
       pos = "CheckExEnv")
## Add some hooks to label plot pages for base and grid graphics
assign("base_plot_hook",
       function() {
           pp <- par(c("mfg","mfcol","oma","mar"))
           if(all(pp$mfg[1:2] == c(1, pp$mfcol[2]))) {
               outer <- (oma4 <- pp$oma[4]) > 0; mar4 <- pp$mar[4]
               mtext(sprintf("help(\"%s\")", nameEx()), side = 4,
                     line = if(outer)max(1, oma4 - 1) else min(1, mar4 - 1),
               outer = outer, adj = 1, cex = .8, col = "orchid", las=3)
           }
       },
       pos = "CheckExEnv")
assign("grid_plot_hook",
       function() {
           grid::pushViewport(grid::viewport(width=grid::unit(1, "npc") -
                              grid::unit(1, "lines"), x=0, just="left"))
           grid::grid.text(sprintf("help(\"%s\")", nameEx()),
                           x=grid::unit(1, "npc") + grid::unit(0.5, "lines"),
                           y=grid::unit(0.8, "npc"), rot=90,
                           gp=grid::gpar(col="orchid"))
       },
       pos = "CheckExEnv")
setHook("plot.new",     get("base_plot_hook", pos = "CheckExEnv"))
setHook("persp",        get("base_plot_hook", pos = "CheckExEnv"))
setHook("grid.newpage", get("grid_plot_hook", pos = "CheckExEnv"))
assign("cleanEx",
       function(env = .GlobalEnv) {
	   rm(list = ls(envir = env, all.names = TRUE), envir = env)
           RNGkind("default", "default")
	   set.seed(1)
   	   options(warn = 1)
	   .CheckExEnv <- as.environment("CheckExEnv")
	   delayedAssign("T", stop("T used instead of TRUE"),
		  assign.env = .CheckExEnv)
	   delayedAssign("F", stop("F used instead of FALSE"),
		  assign.env = .CheckExEnv)
	   sch <- search()
	   newitems <- sch[! sch %in% .oldSearch]
	   for(item in rev(newitems))
               eval(substitute(detach(item), list(item=item)))
	   missitems <- .oldSearch[! .oldSearch %in% sch]
	   if(length(missitems))
	       warning("items ", paste(missitems, collapse=", "),
		       " have been removed from the search path")
       },
       pos = "CheckExEnv")
assign("ptime", proc.time(), pos = "CheckExEnv")
## at least one package changes these via ps.options(), so do this
## before loading the package.
## Use postscript as incomplete files may be viewable, unlike PDF.
## Choose a size that is close to on-screen devices, fix paper
grDevices::ps.options(width = 7, height = 7, paper = "a4", reset = TRUE)
grDevices::postscript("psych-Ex.ps")

assign("par.postscript", graphics::par(no.readonly = TRUE), pos = "CheckExEnv")
options(contrasts = c(unordered = "contr.treatment", ordered = "contr.poly"))
options(warn = 1)
library('psych')

assign(".oldSearch", search(), pos = 'CheckExEnv')
assign(".oldNS", loadedNamespaces(), pos = 'CheckExEnv')
cleanEx(); nameEx("00.psych-package")
### * 00.psych-package

flush(stderr()); flush(stdout())

### Name: 00.psych
### Title: A package for personality, psychometric, and psychological
###   research
### Aliases: psych psych-package 00.psych-package
### Keywords: package multivariate models cluster

### ** Examples

#See the separate man pages 
test.psych()



cleanEx(); nameEx("Harman")
### * Harman

flush(stderr()); flush(stdout())

### Name: Harman
### Title: Two data sets from Harman (1967). 9 cognitive variables from
###   Holzinger and 8 emotional variables from Burt
### Aliases: Harman Harman.Burt Harman.Holzinger Burt
### Keywords: datasets

### ** Examples

data(Harman)
cor.plot(Harman.Holzinger)
cor.plot(Harman.Burt)  
smc(Harman.Burt)  #note how this produces impossible results



cleanEx(); nameEx("ICC")
### * ICC

flush(stderr()); flush(stdout())

### Name: ICC
### Title: Intraclass Correlations (ICC1, ICC2, ICC3 from Shrout and
###   Fleiss)
### Aliases: ICC
### Keywords: multivariate

### ** Examples

sf <- matrix(c(9,    2,   5,    8,
6,    1,   3,    2,
8,    4,   6,    8,
7,    1,   2,    6,
10,   5,   6,    9,
6,   2,   4,    7),ncol=4,byrow=TRUE)
colnames(sf) <- paste("J",1:4,sep="")
rownames(sf) <- paste("S",1:6,sep="")
sf  #example from Shrout and Fleiss (1979)
ICC(sf)



cleanEx(); nameEx("ICLUST")
### * ICLUST

flush(stderr()); flush(stdout())

### Name: ICLUST
### Title: ICLUST: Item Cluster Analysis - Hierarchical cluster analysis
###   using psychometric principles
### Aliases: ICLUST iclust
### Keywords: multivariate cluster

### ** Examples

test.data <- Harman74.cor$cov
ic.out <- ICLUST(test.data)
summary(ic.out)
ic.out <- ICLUST(test.data,nclusters =4)  #use all defaults and stop at 4 clusters
ic.out1 <- ICLUST(test.data,beta=3,beta.size=3)  #use more stringent criteria
print(ic.out1)
plot(ic.out)    #this shows the spatial representation
ic.no.graph <- ICLUST(test.data,plot=FALSE)
dot.graph <- ICLUST.graph(ic.no.graph,out.file="test.ICLUST.graph.dot")   #use a dot graphics viewer




cleanEx(); nameEx("ICLUST.graph")
### * ICLUST.graph

flush(stderr()); flush(stdout())

### Name: ICLUST.graph
### Title: create control code for ICLUST graphical output
### Aliases: ICLUST.graph
### Keywords: multivariate cluster hplot

### ** Examples

## Not run: 
##D test.data <- Harman74.cor$cov
##D ic.out <- ICLUST(test.data)
##D out.file <- file.choose(new=TRUE)   #create a new file to write the plot commands to 
##D ICLUST.graph(ic.out,out.file)   
##D now go to graphviz (outside of R) and open the out.file you created
##D print(ic.out,digits=2)
## End(Not run)

 
#test.data <- Harman74.cor$cov 
#my.iclust <- ICLUST(test.data)
#ICLUST.graph(my.iclust)
#
#
#digraph ICLUST {
#  rankdir=RL;
#  size="8,8";
#  node [fontname="Helvetica" fontsize=14 shape=box, width=2];
#  edge [fontname="Helvetica" fontsize=12];
# label = "ICLUST";
#       fontsize=20;
#V1  [label = VisualPerception];
#V2  [label = Cubes];
#V3  [label = PaperFormBoard];
#V4  [label = Flags];
#V5  [label = GeneralInformation];
#V6  [label = PargraphComprehension];
#V7  [label = SentenceCompletion];
#V8  [label = WordClassification];
#V9  [label = WordMeaning];
#V10  [label = Addition];
#V11  [label = Code];
#V12  [label = CountingDots];
#V13  [label = StraightCurvedCapitals];
#V14  [label = WordRecognition];
#V15  [label = NumberRecognition];
#V16  [label = FigureRecognition];
#V17  [label = ObjectNumber];
#V18  [label = NumberFigure];
#V19  [label = FigureWord];
#V20  [label = Deduction];
#V21  [label = NumericalPuzzles];
#V22  [label = ProblemReasoning];
#V23  [label = SeriesCompletion];
#V24  [label = ArithmeticProblems];
#node [shape=ellipse, width ="1"];
#C1-> V9 [ label = 0.78 ];
#C1-> V5 [ label = 0.78 ];
#C2-> V12 [ label = 0.66 ];
#C2-> V10 [ label = 0.66 ];
#C3-> V18 [ label = 0.53 ];
#C3-> V17 [ label = 0.53 ];
#C4-> V23 [ label = 0.59 ];
#C4-> V20 [ label = 0.59 ];
#C5-> V13 [ label = 0.61 ];
#C5-> V11 [ label = 0.61 ];
#C6-> V7 [ label = 0.78 ];
#C6-> V6 [ label = 0.78 ];
#C7-> V4 [ label = 0.55 ];
#C7-> V1 [ label = 0.55 ];
#C8-> V16 [ label = 0.5 ];
#C8-> V14 [ label = 0.49 ];
#C9-> C1 [ label = 0.86 ];
#C9-> C6 [ label = 0.86 ];
#C10-> C4 [ label = 0.71 ];
#C10-> V22 [ label = 0.62 ];
#C11-> V21 [ label = 0.56 ];
#C11-> V24 [ label = 0.58 ];
#C12-> C10 [ label = 0.76 ];
#C12-> C11 [ label = 0.67 ];
#C13-> C8 [ label = 0.61 ];
#C13-> V15 [ label = 0.49 ];
#C14-> C2 [ label = 0.74 ];
#C14-> C5 [ label = 0.72 ];
#C15-> V3 [ label = 0.48 ];
#C15-> C7 [ label = 0.65 ];
#C16-> V19 [ label = 0.48 ];
#C16-> C3 [ label = 0.64 ];
#C17-> V8 [ label = 0.62 ];
#C17-> C12 [ label = 0.8 ];
#C18-> C17 [ label = 0.82 ];
#C18-> C15 [ label = 0.68 ];
#C19-> C16 [ label = 0.66 ];
#C19-> C13 [ label = 0.65 ];
#C20-> C19 [ label = 0.72 ];
#C20-> C18 [ label = 0.83 ];
#C21-> C20 [ label = 0.87 ];
#C21-> C9 [ label = 0.76 ];
#C22-> 0 [ label = 0 ];
#C22-> 0 [ label = 0 ];
#C23-> 0 [ label = 0 ];
#C23-> 0 [ label = 0 ];
#C1  [label =   "C1\n  alpha= 0.84\n beta=  0.84\nN= 2"] ;
#C2  [label =   "C2\n  alpha= 0.74\n beta=  0.74\nN= 2"] ;
#C3  [label =   "C3\n  alpha= 0.62\n beta=  0.62\nN= 2"] ;
#C4  [label =   "C4\n  alpha= 0.67\n beta=  0.67\nN= 2"] ;
#C5  [label =   "C5\n  alpha= 0.7\n beta=  0.7\nN= 2"] ;
#C6  [label =   "C6\n  alpha= 0.84\n beta=  0.84\nN= 2"] ;
#C7  [label =   "C7\n  alpha= 0.64\n beta=  0.64\nN= 2"] ;
#C8  [label =   "C8\n  alpha= 0.58\n beta=  0.58\nN= 2"] ;
#C9  [label =   "C9\n  alpha= 0.9\n beta=  0.87\nN= 4"] ;
#C10  [label =   "C10\n  alpha= 0.74\n beta=  0.71\nN= 3"] ;
#C11  [label =   "C11\n  alpha= 0.62\n beta=  0.62\nN= 2"] ;
#C12  [label =   "C12\n  alpha= 0.79\n beta=  0.74\nN= 5"] ;
#C13  [label =   "C13\n  alpha= 0.64\n beta=  0.59\nN= 3"] ;
#C14  [label =   "C14\n  alpha= 0.79\n beta=  0.74\nN= 4"] ;
#C15  [label =   "C15\n  alpha= 0.66\n beta=  0.58\nN= 3"] ;
#C16  [label =   "C16\n  alpha= 0.65\n beta=  0.57\nN= 3"] ;
#C17  [label =   "C17\n  alpha= 0.81\n beta=  0.71\nN= 6"] ;
#C18  [label =   "C18\n  alpha= 0.84\n beta=  0.75\nN= 9"] ;
#C19  [label =   "C19\n  alpha= 0.74\n beta=  0.65\nN= 6"] ;
#C20  [label =   "C20\n  alpha= 0.87\n beta=  0.74\nN= 15"] ;
#C21  [label =   "C21\n  alpha= 0.9\n beta=  0.77\nN= 19"] ;
#C22  [label =   "C22\n  alpha= 0\n beta=  0\nN= 0"] ;
#C23  [label =   "C23\n  alpha= 0\n beta=  0\nN= 0"] ;
#{ rank=same;
#V1;V2;V3;V4;V5;V6;V7;V8;V9;V10;V11;V12;V13;V14;V15;V16;V17;V18;V19;V20;V21;V22;V23;V24;}}
#
#copy the above output to Graphviz and draw it
#see \url{http://personality-project.org/r/r.ICLUST.html} for an example.




cleanEx(); nameEx("ICLUST.rgraph")
### * ICLUST.rgraph

flush(stderr()); flush(stdout())

### Name: ICLUST.rgraph
### Title: Draw an ICLUST graph using the Rgraphviz package
### Aliases: ICLUST.rgraph
### Keywords: multivariate cluster hplot

### ** Examples

test.data <- Harman74.cor$cov

if(require(Rgraphviz) ) {ic.out <- ICLUST(test.data) }  




cleanEx(); nameEx("Promax")
### * Promax

flush(stderr()); flush(stdout())

### Name: Promax
### Title: Perform promax or targeted rotations and return the inter factor
###   angles
### Aliases: Promax target.rot
### Keywords: multivariate models

### ** Examples

jen <- sim.hierarchical()
f3 <- factor.minres(jen,3)
Promax(f3)
target.rot(f3)
m3 <- factanal(covmat=jen,factors=3)
Promax(m3)  #example of taking the output from factanal
#compare this rotation with the solution from a targeted rotation aimed for an independent cluster solution
target.rot(m3)



cleanEx(); nameEx("SD")
### * SD

flush(stderr()); flush(stdout())

### Name: SD
### Title: Find the Standard deviation for a vector, matrix, or data.frame
###   - do not return error if there are no cases
### Aliases: SD
### Keywords: models

### ** Examples

data(attitude)
sd(attitude) #all complete
attitude[,1] <- NA
SD(attitude) #missing a column
describe(attitude)



cleanEx(); nameEx("VSS")
### * VSS

flush(stderr()); flush(stdout())

### Name: VSS
### Title: Apply the Very Simple Structure and MAP criteria to determine
###   the appropriate number of factors.
### Aliases: VSS MAP
### Keywords: multivariate models

### ** Examples


test.data <- Harman74.cor$cov
my.vss <- VSS(test.data,title="VSS of 24 mental tests")      
#print(my.vss[,1:12],digits =2) 
#VSS.plot(my.vss, title="VSS of 24 mental tests")

#now, some simulated data with two factors
VSS(sim.circ(nvar=24),fm="mle" ,title="VSS of 24 circumplex variables")
VSS(sim.item(nvar=24),fm="mle" ,title="VSS of 24 simple structure variables")



cleanEx(); nameEx("VSS.parallel")
### * VSS.parallel

flush(stderr()); flush(stdout())

### Name: VSS.parallel
### Title: Compare real and random VSS solutions
### Aliases: VSS.parallel
### Keywords: models models

### ** Examples

#VSS.plot(VSS.parallel(200,24))



cleanEx(); nameEx("VSS.plot")
### * VSS.plot

flush(stderr()); flush(stdout())

### Name: VSS.plot
### Title: Plot VSS fits
### Aliases: VSS.plot
### Keywords: multivariate models

### ** Examples

test.data <- Harman74.cor$cov
my.vss <- VSS(test.data)         #suggests that 4 factor complexity two solution is optimal
VSS.plot(my.vss,title="VSS of Holzinger-Harmon problem")                 #see the graphics window




cleanEx(); nameEx("VSS.scree")
### * VSS.scree

flush(stderr()); flush(stdout())

### Name: VSS.scree
### Title: Plot a scree test
### Aliases: VSS.scree
### Keywords: multivariate hplot

### ** Examples

#VSS.scree(attitude)
#VSS.scree(cor(attitude)




cleanEx(); nameEx("Yule")
### * Yule

flush(stderr()); flush(stdout())

### Name: Yule
### Title: From a two by two table, find the Yule coefficients of
###   association, convert to phi, or polychoric, recreate table the table
###   to create the Yule coefficient.
### Aliases: Yule Yule.inv Yule2phi Yule2poly
### Keywords: multivariate models

### ** Examples

Nach <- matrix(c(40,10,20,50),ncol=2,byrow=TRUE)
Yule(Nach)
Yule.inv(.81818,c(50,70,60,60))
Yule2phi(.81818,c(50,70,60,60))
if(require(polycor)) Yule2poly(.81818,c(50,70,60,60))
phi(Nach)  #much less



cleanEx(); nameEx("alpha")
### * alpha

flush(stderr()); flush(stdout())

### Name: alpha
### Title: Find two estimates of reliability: Cronbach's alpha and
###   Guttman's Lambda 6.
### Aliases: alpha alpha.scale
### Keywords: models multivariate

### ** Examples

r4 <- sim.congeneric()
alpha(r4)
r9 <- sim.hierarchical()
alpha(r9)
#an example of two independent factors that produce reasonable alphas
#this is a case where alpha is a poor indicator of unidimensionality
two.f <- sim.item(8)
alpha(two.f,keys=c(rep(1,4),rep(-1,4))) 




cleanEx(); nameEx("bfi")
### * bfi

flush(stderr()); flush(stdout())

### Name: bfi
### Title: 25 Personality items representing 5 factors
### Aliases: bfi
### Keywords: datasets

### ** Examples

data(bfi)
describe(bfi)
 data(bfi)
 keys.list <- list(Agree=c(-1,2:5),Conscientious=c(6:8,-9,-10),Extraversion=c(-11,-12,13:15),Neuroticism=c(16:20),Openness = c(21,-22,23,24,-25))
 keys <- make.keys(25,keys.list,item.labels=colnames(bfi))
 scores <- score.items(keys,bfi,short=TRUE)
 scores




cleanEx(); nameEx("bifactor")
### * bifactor

flush(stderr()); flush(stdout())

### Name: bifactor
### Title: Seven data sets showing a bifactor solution.
### Aliases: bifactor Bechtoldt.1 Bechtoldt.2 Bechtoldt Holzinger
###   Holzinger.9 Reise Thurstone Thurstone.33
### Keywords: datasets

### ** Examples

data(bifactor)
holz <- omega(Holzinger,4, title = "14 ability tests from Holzinger-Swineford")
bf <- omega(Reise,5,title="16 health items from Reise") 
omega(Reise,5,labels=colnames(Reise),title="16 health items from Reise")
thur.bf <- omega(Thurstone,title="9 variables from Thurstone")




cleanEx(); nameEx("circ.tests")
### * circ.tests

flush(stderr()); flush(stdout())

### Name: circ.tests
### Title: Apply four tests of circumplex versus simple structure
### Aliases: circ.tests
### Keywords: multivariate models

### ** Examples

circ.data <- circ.sim(24,500)
circ.fa <- factor.pa(circ.data,2)
#plot(circ.fa$loadings)
ct <- circ.tests(circ.fa)
#compare with non-circumplex data
simp.data <- item.sim(24,500)
simp.fa <- factor.pa(simp.data,2)
#plot(simp.fa$loadings)
st <- circ.tests(simp.fa)
print(rbind(ct,st),digits=2)




cleanEx(); nameEx("cities")
### * cities

flush(stderr()); flush(stdout())

### Name: cities
### Title: Distances between 11 US cities
### Aliases: cities city.location
### Keywords: datasets

### ** Examples


data(cities)
city.location[,1] <- -city.location[,1]
if(require(maps)) {map("usa")
title("MultiDimensional Scaling of US cities")
points(city.location)} else {plot(city.location, xlab="Dimension 1", ylab="Dimension 2",main ="multidimensional scaling of US cities")}
city.loc <- cmdscale(cities, k=2) #ask for a 2 dimensional solution  round(city.loc,0) 
city.loc <- -city.loc 
city.loc <- rescale(city.loc,mean(city.location),sd(city.location))
points(city.loc,type="n") 
text(city.loc,labels=names(cities))




cleanEx(); nameEx("cluster.cor")
### * cluster.cor

flush(stderr()); flush(stdout())

### Name: cluster.cor
### Title: Find correlations of composite variables from a larger matrix
### Aliases: cluster.cor
### Keywords: multivariate models

### ** Examples

## Not run: 
##D data(attitude)
##D keys <- matrix(c(1,1,1,0,0,0,0,
##D                  0,0,0,1,1,1,1),ncol=2)
##D colnames(keys) <- c("first","second")
##D r.mat <- cor(attitude)
##D cluster.cor(keys,r.mat)
## End(Not run)
#$cor
#       first second
#first    1.0    0.6
#second   0.6    1.0
#
#$sd
# first second 
#  2.57   3.01 
#
#$corrected
#       first second
#first   0.82   0.77
#second  0.60   0.74
#
#$size
# first second 
#     3      4 




cleanEx(); nameEx("cluster.fit")
### * cluster.fit

flush(stderr()); flush(stdout())

### Name: cluster.fit
### Title: cluster Fit: fit of the cluster model to a correlation matrix
### Aliases: cluster.fit
### Keywords: multivariate cluster

### ** Examples

 r.mat<- Harman74.cor$cov
 iq.clus <- ICLUST(r.mat,nclusters =2)
 fit <- cluster.fit(r.mat,iq.clus$loadings,iq.clus$clusters)
 fit
 




cleanEx(); nameEx("cluster.loadings")
### * cluster.loadings

flush(stderr()); flush(stdout())

### Name: cluster.loadings
### Title: Find item by cluster correlations, corrected for overlap and
###   reliability
### Aliases: cluster.loadings
### Keywords: multivariate cluster

### ** Examples


 r.mat<- Harman74.cor$cov
 clusters <- matrix(c(1,1,1,rep(0,24),1,1,1,1,rep(0,17)),ncol=2)
 cluster.loadings(clusters,r.mat)

 




cleanEx(); nameEx("cluster.plot")
### * cluster.plot

flush(stderr()); flush(stdout())

### Name: cluster.plot
### Title: Plot factor/cluster loadings and assign items to clusters by
###   their highest loading.
### Aliases: cluster.plot factor.plot
### Keywords: multivariate hplot cluster

### ** Examples

circ.data <- circ.sim(24,500)
circ.fa <- factor.pa(circ.data,2)
cluster.plot(circ.fa,cut=.5)



cleanEx(); nameEx("cluster2keys")
### * cluster2keys

flush(stderr()); flush(stdout())

### Name: cluster2keys
### Title: Convert a cluster vector (from e.g., kmeans) to a keys matrix
###   suitable for scoring item clusters.
### Aliases: cluster2keys
### Keywords: multivariate

### ** Examples

test.data <- Harman74.cor$cov
kc <- kmeans(test.data,4)
keys <- cluster2keys(kc)
keys  #these match those found by ICLUST
cluster.cor(keys,test.data)



cleanEx(); nameEx("comorbidity")
### * comorbidity

flush(stderr()); flush(stdout())

### Name: comorbidity
### Title: Convert base rates of two diagnoses and their comorbidity into
###   phi, Yule, and tetrachorics
### Aliases: comorbidity
### Keywords: multivariate

### ** Examples

if(require(polycor)) {comorbidity(.2,.15,.1,c("Anxiety","Depression")) }



cleanEx(); nameEx("cor.plot")
### * cor.plot

flush(stderr()); flush(stdout())

### Name: cor.plot
### Title: Create an image plot for a correlation or factor matrix
### Aliases: cor.plot
### Keywords: multivariate hplot

### ** Examples

data(bifactor)
cor.plot(Thurstone,TRUE, main="9 cognitive variables from Thurstone")
simp <- sim.circ(24)
cor.plot(cor(simp),colors=TRUE,zlim=c(-1,1),main="24 variables in a circumplex")




cleanEx(); nameEx("corr.test")
### * corr.test

flush(stderr()); flush(stdout())

### Name: corr.test
### Title: Find the correlations, sample sizes, and probability values
###   between elements of a matrix or data.frame.
### Aliases: corr.test
### Keywords: multivariate models

### ** Examples

data(sat.act)
corr.test(sat.act)



cleanEx(); nameEx("correct.cor")
### * correct.cor

flush(stderr()); flush(stdout())

### Name: correct.cor
### Title: Find dis-attenuated correlations given correlations and
###   reliabilities
### Aliases: correct.cor
### Keywords: models multivariate

### ** Examples


# attitude from the datasets package
#example 1 is a rather clunky way of doing things

a1 <- attitude[,c(1:3)]
a2 <- attitude[,c(4:7)]
x1 <- rowSums(a1)  #find the sum of the first 3 attitudes
x2 <- rowSums(a2)   #find the sum of the last 4 attitudes
alpha1 <- alpha(a1)
alpha2 <- alpha(a2)
x <- matrix(c(x1,x2),ncol=2)
x.cor <- cor(x)
alpha <- c(alpha1$total$raw_alpha,alpha2$total$raw_alpha)
round(correct.cor(x.cor,alpha),2)
#
#much better - although uses standardized alpha 
clusters <- matrix(c(rep(1,3),rep(0,7),rep(1,4)),ncol=2)
cluster.loadings(clusters,cor(attitude))
# or 
clusters <- matrix(c(rep(1,3),rep(0,7),rep(1,4)),ncol=2)
cluster.cor(clusters,cor(attitude))
#
#best
scores <- score.items(matrix(c(rep(1,3),rep(0,7),rep(1,4)),ncol=2),attitude)
scores$corrected




cleanEx(); nameEx("cortest.bartlett")
### * cortest.bartlett

flush(stderr()); flush(stdout())

### Name: cortest.bartlett
### Title: Bartlett's test that a correlation matrix is an identity matrix
### Aliases: cortest.bartlett
### Keywords: multivariate

### ** Examples

set.seed(42)   
x <- matrix(rnorm(1000),ncol=10)
r <- cor(x)
cortest.bartlett(r)      #random data don't differ from an identity matrix
data(bfi)
cortest.bartlett(bfi)    #not an identity matrix



cleanEx(); nameEx("cortest.mat")
### * cortest.mat

flush(stderr()); flush(stdout())

### Name: cortest.mat
### Title: Chi square tests of whether a single matrix is an identity
###   matrix, or a pair of matrices are equal.
### Aliases: cortest.normal cortest.mat cortest.jennrich cortest
### Keywords: multivariate

### ** Examples

x <- matrix(rnorm(1000),ncol=10)
y <- matrix(rnorm(500),ncol=10)
cortest.normal(x)  #just test if this matrix is an identity
cortest.normal(x,y) #do these two matrices differ?
cortest.mat(x)
cortest.mat(x,y)   #twice the degrees of freedom as the Jennrich
cortest.jennrich(x,y) #




cleanEx(); nameEx("cosinor")
### * cosinor

flush(stderr()); flush(stdout())

### Name: cosinor
### Title: Functions for analysis of circadian or diurnal data
### Aliases: cosinor circadian.mean circadian.cor circadian.linear.cor
### Keywords: multivariate

### ** Examples

time <- seq(1:24)
pure <- matrix(time,24,18)
pure <- cos((pure + col(pure))*pi/12)
matplot(pure,type="l") 
p <- cosinor(time,pure)
set.seed(42)
noisey <- pure + rnorm(24*18)
n <- cosinor(time,noisey) 
small.pure <- pure[c(6:18),]
small.noisey <- noisey[c(6:18),]
sp <- cosinor(time[c(6:18)],small.pure)
spo <- cosinor(time[c(6:18)],small.pure,opti=TRUE)
sn <- cosinor(time[c(6:18)],small.noisey)
sno <- cosinor(time[c(6:18)],small.noisey,opti=TRUE)
sum.df <- data.frame(pure=p,noisey = n, small=sp,small.noise = sn, small.opt=spo,small.noise.opt=sno)
round(sum.df,2)
round(circadian.cor(sum.df[,c(1,3,5,7,9,11)]),2)  #compare alternatives 
round(cor(sum.df[,c(2,4,6,8,10,12)]),2) 



cleanEx(); nameEx("count.pairwise")
### * count.pairwise

flush(stderr()); flush(stdout())

### Name: count.pairwise
### Title: Count number of pairwise cases for a data set with missing (NA)
###   data.
### Aliases: count.pairwise
### Keywords: models multivariate

### ** Examples

## Not run: 
##D x <- matrix(rnorm(1000),ncol=6)
##D y <- matrix(rnorm(500),ncol=3)
##D x[x < 0] <- NA
##D y[y> 1] <- NA
##D 
##D count.pairwise(x)
##D count.pairwise(y)
##D count.pairwise(x,y)
## End(Not run)

    



cleanEx(); nameEx("cta")
### * cta

flush(stderr()); flush(stdout())

### Name: cta
### Title: Simulate the C(ues) T(endency) A(ction) model of motivation
### Aliases: cta
### Keywords: models

### ** Examples

#not run 
#cta()   #default values, running over time 
#cta(type="state") #default values, in a state space  of tendency 1 versus tendency 2



cleanEx(); nameEx("cubits")
### * cubits

flush(stderr()); flush(stdout())

### Name: cubits
### Title: Galton's example of the relationship between height and 'cubit'
###   or forearm length
### Aliases: cubits
### Keywords: datasets

### ** Examples

data(cubits)
cubits
heights <- table2df(cubits,labs <- c("height","cubit"))
ellipses(heights,n=1,main="Galton's co-relation data set")
ellipses(jitter(heights$cubit,3),jitter(heights$height,3),pch=".",main="Galton's co-relation data set") #add in some noise to see the points




cleanEx(); nameEx("describe")
### * describe

flush(stderr()); flush(stdout())

### Name: describe
### Title: Basic descriptive statistics useful for psychometrics
### Aliases: describe
### Keywords: multivariate models univar

### ** Examples

data(sat.act)
describe(sat.act)

describe(sat.act,skew=FALSE)   







cleanEx(); nameEx("describe.by")
### * describe.by

flush(stderr()); flush(stdout())

### Name: describe.by
### Title: Basic summary statistics by group
### Aliases: describe.by
### Keywords: models univar

### ** Examples

data(sat.act)
describe.by(sat.act,sat.act$gender) #just one grouping variable 
#describe.by(sat.act,list(sat.act$gender,sat.act$education))  #two grouping variables
#des.mat <- describe.by(sat.act$age,sat.act$education,mat=TRUE) #matrix output 
#des.mat <- describe.by(sat.act$age,list(sat.act$education,sat.act$gender),mat=TRUE) 




cleanEx(); nameEx("eigen.loadings")
### * eigen.loadings

flush(stderr()); flush(stdout())

### Name: eigen.loadings
### Title: Convert eigen vectors and eigen values to the more normal (for
###   psychologists) component loadings
### Aliases: eigen.loadings
### Keywords: models multivariate

### ** Examples

x <- eigen(Harman74.cor$cov)
x$vectors[1:8,1:4]  #as they appear from eigen
y <- princomp(covmat=Harman74.cor$cov) 
y$loadings[1:8,1:4] #as they appear from princomp
eigen.loadings(x)[1:8,1:4] # rescaled by the eigen values



cleanEx(); nameEx("ellipses")
### * ellipses

flush(stderr()); flush(stdout())

### Name: ellipses
### Title: Plot data and 1 and 2 sigma correlation ellipses
### Aliases: ellipses
### Keywords: multivariate hplot

### ** Examples

data(galton)
ellipses(galton,lm=TRUE)
ellipses(galton$parent,galton$child,xlab="Mid Parent Height",ylab="Child Height") #input are two vectors
data(sat.act)
ellipses(sat.act)  #shows the pairs.panels ellipses



cleanEx(); nameEx("epi.bfi")
### * epi.bfi

flush(stderr()); flush(stdout())

### Name: epi.bfi
### Title: 13 personality scales from the Eysenck Personality Inventory and
###   Big 5 inventory
### Aliases: epi.bfi
### Keywords: datasets

### ** Examples

data(epi.bfi)
pairs.panels(epi.bfi[,1:5])
describe(epi.bfi)



cleanEx(); nameEx("error.bars")
### * error.bars

flush(stderr()); flush(stdout())

### Name: error.bars
### Title: Plot means and confidence intervals
### Aliases: error.bars
### Keywords: multivariate hplot

### ** Examples

x <- replicate(20,rnorm(50))
boxplot(x,notch=TRUE,main="Notched boxplot with error bars")
error.bars(x,add=TRUE)
abline(h=0)

error.bars(attitude,alpha=.5,main="50 percent confidence limits") #another example
error.bars(attitude,bar=TRUE)  #show the use of bar graphs

#combine with a strip chart
stripchart(attitude,vertical=TRUE,method="jitter",main="Stripchart with 95 percent confidence limits")
error.bars(attitude,add=TRUE,arrow.len=.2)




cleanEx(); nameEx("error.bars.by")
### * error.bars.by

flush(stderr()); flush(stdout())

### Name: error.bars.by
### Title: Plot means and confidence intervals for multiple groups
### Aliases: error.bars.by
### Keywords: multivariate hplot

### ** Examples


data(sat.act)
error.bars.by(sat.act[1:4],sat.act$gender)
error.bars.by(sat.act[5:6],sat.act$gender,bars=TRUE,labels=c("male","female"),main="SAT V and SAT Q by gender")  #draw a barplot

error.bars.by(sat.act[5:6],sat.act$education,bars=TRUE,xlab="Education",main="95 percent confidence limits of Sat V and Sat Q") 

error.bars.by(sat.act[5:6],sat.act$education,TRUE, xlab="Education")  #plot SAT V and SAT Q by education




cleanEx(); nameEx("error.crosses")
### * error.crosses

flush(stderr()); flush(stdout())

### Name: error.crosses
### Title: Plot x and y error bars
### Aliases: error.crosses
### Keywords: multivariate hplot

### ** Examples


desc <- describe(attitude)
x <- desc[1,]
y <- desc[2,]
plot(x$mean,y$mean,xlab=rownames(x),ylab=rownames(y))   #in graphics window
error.crosses(x,y)    #in graphics window
#now for a bit more complicated plotting 
desc <- describe.by(attitude,(attitude[,7]>41)) #select a high and low group
g1 <- desc$'FALSE'
g2 <- desc$'TRUE'
plot(g1$mean,g2$mean,xlab = "Low Advance",ylab="High Advance",xlim=c(30,80),ylim=c(50,80))
error.crosses(g1,g2,labels=rownames(g1),pos=rep(1,7))
title("Attitudes grouped by high and low scores on Advance")




cleanEx(); nameEx("fa")
### * fa

flush(stderr()); flush(stdout())

### Name: fa
### Title: Factor analysis by Principal Axis, MinRes (minimum residual),
###   Weighted Least Squares or Maximum Likelihood
### Aliases: fa factor.pa factor.minres factor.wls
### Keywords: multivariate models

### ** Examples

#using the Harman 24 mental tests, compare a principal factor with a principal components solution
pc <- principal(Harman74.cor$cov,4,rotate="varimax")
pa <- fa(Harman74.cor$cov,4,fm="pa" ,rotate="varimax")
uls <- fa(Harman74.cor$cov,4,rotate="varimax")
wls <- fa(Harman74.cor$cov,4,fm="wls")

#to show the loadings sorted by absolute value
print(uls,sort=TRUE)

#then compare with a maximum likelihood solution using factanal
mle <- factanal(covmat=Harman74.cor$cov,factors=4)
factor.congruence(list(mle,pa,pc,uls,wls))
#note that the order of factors and the sign of some of factors differ 

#finally, compare the unrotated factor, ml, uls, and  wls solutions
wls <- factor.wls(Harman74.cor$cov,4,rotate="none")
pa <- factor.pa(Harman74.cor$cov,4,rotate="none")
mle <-  factanal(factors=4,covmat=Harman74.cor$cov,rotation="none")
uls <- factor.minres(Harman74.cor$cov,4,rotate="none")

factor.congruence(list(mle,pa,uls,wls))
#note that the order of factors and the sign of some of factors differ 


#an example of where the ML and PA and MR models differ is found in Thurstone.33.
#compare the first two factors with the 3 factor solution 
data(bifactor)
Thurstone.33 <- as.matrix(Thurstone.33)
mle2 <- factanal(covmat=Thurstone.33,factors=2,rotation="none")
mle3 <- factanal(covmat=Thurstone.33,factors=3 ,rotation="none")
pa2 <- factor.pa(Thurstone.33,2,rotate="none")
pa3 <- factor.pa(Thurstone.33,3,rotate="none")
mr2 <- fa(Thurstone.33,2,rotate="none")
mr3 <- fa(Thurstone.33,3,rotate="none")
factor.congruence(list(mle2,mle3,pa2,pa3,mr2,mr3))



cleanEx(); nameEx("fa.graph")
### * fa.graph

flush(stderr()); flush(stdout())

### Name: fa.graph
### Title: Graph factor loading matrices
### Aliases: fa.graph
### Keywords: multivariate hplot

### ** Examples


test.simple <- factor.pa(item.sim(16),2)
if(require(Rgraphviz)) {fa.graph(test.simple) }




cleanEx(); nameEx("fa.parallel")
### * fa.parallel

flush(stderr()); flush(stdout())

### Name: fa.parallel
### Title: Scree plots of data or correlation matrix compared to random
###   ``parallel" matrices
### Aliases: fa.parallel
### Keywords: multivariate

### ** Examples


test.data <- Harman74.cor$cov 
fa.parallel(test.data,n.obs=200)

fa.parallel(attitude) 
#




cleanEx(); nameEx("factor.congruence")
### * factor.congruence

flush(stderr()); flush(stdout())

### Name: factor.congruence
### Title: Coefficient of factor congruence
### Aliases: factor.congruence
### Keywords: multivariate models

### ** Examples

#fa <- factanal(x,4,covmat=Harman74.cor$cov)
#pc <- principal(Harman74.cor$cov,4)
#pa <- factor.pa(Harman74.cov$cor,4)
#factor.congruence(fa,pc)
#
#    Factor1 Factor2 Factor3 Factor4
#PC1    1.00    0.60    0.45    0.55
#PC2    0.44    0.49    1.00    0.56
#PC3    0.54    0.99    0.44    0.55
#PC4    0.47    0.52    0.48    0.99

# pa <- factor.pa(Harman74.cor$cov,4)
# factor.congruence(fa,pa)
#         PA1  PA3  PA2  PA4
#Factor1 1.00 0.61 0.46 0.55
#Factor2 0.61 1.00 0.50 0.60
#Factor3 0.46 0.50 1.00 0.57
#Factor4 0.56 0.62 0.58 1.00

#compare with 
#round(cor(fa$loading,pc$loading),2)




cleanEx(); nameEx("factor.fit")
### * factor.fit

flush(stderr()); flush(stdout())

### Name: factor.fit
### Title: How well does the factor model fit a correlation matrix. Part of
###   the VSS package
### Aliases: factor.fit
### Keywords: models models

### ** Examples

## Not run: 
##D #compare the fit of 4 to 3 factors for the Harman 24 variables
##D fa4 <- factanal(x,4,covmat=Harman74.cor$cov)
##D round(factor.fit(Harman74.cor$cov,fa4$loading),2)
##D #[1] 0.9
##D fa3 <- factanal(x,3,covmat=Harman74.cor$cov)
##D round(factor.fit(Harman74.cor$cov,fa3$loading),2)
##D #[1] 0.88
##D 
## End(Not run)




cleanEx(); nameEx("factor.model")
### * factor.model

flush(stderr()); flush(stdout())

### Name: factor.model
### Title: Find R = F F' + U2 is the basic factor model
### Aliases: factor.model
### Keywords: multivariate models

### ** Examples


f2 <- matrix(c(.9,.8,.7,rep(0,6),.6,.7,.8),ncol=2)
mod <- factor.model(f2)
round(mod,2)



cleanEx(); nameEx("factor.residuals")
### * factor.residuals

flush(stderr()); flush(stdout())

### Name: factor.residuals
### Title: R* = R- F F'
### Aliases: factor.residuals
### Keywords: multivariate models

### ** Examples

fa2 <- factor.pa(Harman74.cor$cov,2,rotate=TRUE)
 fa2resid <- factor.residuals(Harman74.cor$cov,fa2)
 fa2resid[1:4,1:4] #residuals with two factors extracted
 fa4 <- factor.pa(Harman74.cor$cov,4,rotate=TRUE)
 fa4resid <- factor.residuals(Harman74.cor$cov,fa4)
 fa4resid[1:4,1:4] #residuals with 4 factors extracted




cleanEx(); nameEx("factor.rotate")
### * factor.rotate

flush(stderr()); flush(stdout())

### Name: factor.rotate
### Title: ``Hand" rotate a factor loading matrix
### Aliases: factor.rotate
### Keywords: multivariate models

### ** Examples

#using the Harman 24 mental tests, rotate the 2nd and 3rd factors 45 degrees
pc <- principal(Harman74.cor$cov,4,rotate=TRUE)
pcr45 <- factor.rotate(pc,45,2,3)
pcr90 <- factor.rotate(pcr45,45,2,3)
print(factor.congruence(pc,pcr45),digits=3) #poor congruence with original
print(factor.congruence(pc,pcr90),digits=3) #factor 2 and 3 have been exchanged and 3 flipped



cleanEx(); nameEx("factor.stats")
### * factor.stats

flush(stderr()); flush(stdout())

### Name: factor.stats
### Title: Find various goodness of fit statistics for factor analysis and
###   principal components
### Aliases: factor.stats factor.scores
### Keywords: multivariate models

### ** Examples

v9 <- sim.hierarchical()
f3 <- factor.minres(v9,3)
factor.stats(v9,f3,n.obs=500)
f3o <- factor.pa(v9,3,rotate="Promax")
factor.stats(v9,f3o,n.obs=500)




cleanEx(); nameEx("factor2cluster")
### * factor2cluster

flush(stderr()); flush(stdout())

### Name: factor2cluster
### Title: Extract cluster definitions from factor loadings
### Aliases: factor2cluster
### Keywords: multivariate models

### ** Examples


## Not run: 
##D f  <- factanal(x,4,covmat=Harman74.cor$cov)
##D factor2cluster(f) 
## End(Not run)
#                       Factor1 Factor2 Factor3 Factor4
#VisualPerception             0       1       0       0
#Cubes                        0       1       0       0
#PaperFormBoard               0       1       0       0
#Flags                        0       1       0       0
#GeneralInformation           1       0       0       0
#PargraphComprehension        1       0       0       0
#SentenceCompletion           1       0       0       0
#WordClassification           1       0       0       0
#WordMeaning                  1       0       0       0
#Addition                     0       0       1       0
#Code                         0       0       1       0
#CountingDots                 0       0       1       0
#StraightCurvedCapitals       0       0       1       0
#WordRecognition              0       0       0       1
#NumberRecognition            0       0       0       1
#FigureRecognition            0       0       0       1
#ObjectNumber                 0       0       0       1
#NumberFigure                 0       0       0       1
#FigureWord                   0       0       0       1
#Deduction                    0       1       0       0
#NumericalPuzzles             0       0       1       0
#ProblemReasoning             0       1       0       0
#SeriesCompletion             0       1       0       0
#ArithmeticProblems           0       0       1       0






cleanEx(); nameEx("fisherz")
### * fisherz

flush(stderr()); flush(stdout())

### Name: fisherz
### Title: Fisher r to z and z to r and confidence intervals
### Aliases: fisherz fisherz2r r.con r2t
### Keywords: multivariate models

### ** Examples


cors <- seq(-.9,.9,.1)
zs <- fisherz(cors)
rs <- fisherz2r(zs)
round(zs,2)
 n <- 30
 r <- seq(0,.9,.1)
 rc <- matrix(r.con(r,n),ncol=2)
t <- r*sqrt(n-2)/sqrt(1-r^2)
 p <- (1-pt(t,n-2))/2
 r.rc <- r.rc <- data.frame(r=r,z=fisherz(r),lower=rc[,1],upper=rc[,2],t=t,p=p)
 round(r.rc,2)




cleanEx(); nameEx("galton")
### * galton

flush(stderr()); flush(stdout())

### Name: galton
### Title: Galton's Mid parent child height data
### Aliases: galton
### Keywords: datasets

### ** Examples

data(galton)
describe(galton)
pairs.panels(galton,lm=TRUE)



cleanEx(); nameEx("geometric.mean")
### * geometric.mean

flush(stderr()); flush(stdout())

### Name: geometric.mean
### Title: Find the geometric mean of a vector or columns of a data.frame.
### Aliases: geometric.mean
### Keywords: multivariate

### ** Examples


x <- seq(1,5)
x2 <- x^2
geometric.mean(x)
geometric.mean(x2)




cleanEx(); nameEx("guttman")
### * guttman

flush(stderr()); flush(stdout())

### Name: guttman
### Title: Alternative estimates of test reliabiity
### Aliases: tenberge glb guttman
### Keywords: multivariate

### ** Examples

data(attitude)
glb(attitude)
guttman(attitude)




cleanEx(); nameEx("harmonic.mean")
### * harmonic.mean

flush(stderr()); flush(stdout())

### Name: harmonic.mean
### Title: Find the harmonic mean of a vector, matrix, or columns of a
###   data.frame
### Aliases: harmonic.mean
### Keywords: multivariate

### ** Examples

x <- seq(1,5)
x2 <- x^2
harmonic.mean(x)
harmonic.mean(x2)




cleanEx(); nameEx("headtail")
### * headtail

flush(stderr()); flush(stdout())

### Name: headtail
### Title: Combine calls to head and tail
### Aliases: headtail
### Keywords: multivariate

### ** Examples

x <- matrix(sample(10,1000,TRUE),ncol=5)
headtail(x,4,8)




cleanEx(); nameEx("heights")
### * heights

flush(stderr()); flush(stdout())

### Name: heights
### Title: A data.frame of the Galton (1888) height and cubit data set.
### Aliases: heights
### Keywords: datasets

### ** Examples

data(heights)
ellipses(heights,n=1,main="Galton's co-relation data set")




cleanEx(); nameEx("interp.median")
### * interp.median

flush(stderr()); flush(stdout())

### Name: interp.median
### Title: Find the interpolated sample median, quartiles, or specific
###   quantiles for a vector, matrix, or data frame
### Aliases: interp.median interp.quantiles interp.quartiles interp.boxplot
###   interp.values interp.qplot.by interp.q interp.quart
### Keywords: univar

### ** Examples

interp.median(c(1,2,3,3,3))  # compare with median = 3
interp.median(c(1,2,2,5))
interp.quantiles(c(1,2,2,5),.25)
x <- sample(10,100,TRUE)
interp.quartiles(x)
#
x <-  c(1,1,2,2,2,3,3,3,3,4,5,1,1,1,2,2,3,3,3,3,4,5,1,1,1,2,2,3,3,3,3,4,2)
y <-  c(1,2,3,3,3,3,4,4,4,5,5,1,2,3,3,3,3,4,4,5,5,5,1,5,3,3,3,3,4,4,4,5,5)
x <-  x[order(x)]   #sort the data by ascending order to make it clearer
y <- y[order(y)]
xv <- interp.values(x)
yv <- interp.values(y)
barplot(x,space=0,xlab="ordinal position",ylab="value")
lines(1:length(x)-.5,xv)
points(c(length(x)/4,length(x)/2,3*length(x)/4),interp.quartiles(x))
barplot(y,space=0,xlab="ordinal position",ylab="value")
lines(1:length(y)-.5,yv)
points(c(length(y)/4,length(y)/2,3*length(y)/4),interp.quartiles(y))
data(galton)
interp.median(galton)
interp.qplot.by(galton$child,galton$parent,ylab="child height"
,xlab="Mid parent height") 




cleanEx(); nameEx("iqitems")
### * iqitems

flush(stderr()); flush(stdout())

### Name: iqitems
### Title: 14 multiple choice IQ items
### Aliases: iqitems
### Keywords: datasets

### ** Examples

data(iqitems)
iq.keys <- c(4,4,3,1,4,3,2,3,1,4,1,3,4,3)
score.multiple.choice(iq.keys,iqitems)



cleanEx(); nameEx("kappa")
### * kappa

flush(stderr()); flush(stdout())

### Name: wkappa
### Title: Find Cohen's kappa and weighted kappa coefficients for
###   correlation of two raters
### Aliases: wkappa
### Keywords: multivariate

### ** Examples


cohen <- matrix(c(
0.44, 0.05, 0.01,
0.07, 0.20, 0.03,
0.09, 0.05, 0.06),ncol=3)

wkappa(cohen)

fleiss <- matrix(c(
 0.53, 0.05, 0.02,
 0.11, 0.14, 0.05,
 0.01, 0.06, 0.03),ncol=3)

weights <- matrix(c(
 1.0000, 0.0000, 0.4444,
 0.0000, 1.0000, 0.6666,
 0.4444, 0.6666, 1.0000),ncol=3)
 
 wkappa(fleiss,weights)



cleanEx(); nameEx("make.keys")
### * make.keys

flush(stderr()); flush(stdout())

### Name: make.keys
### Title: Create a keys matrix for use by score.items or cluster.cor
### Aliases: make.keys
### Keywords: multivariate models

### ** Examples

data(attitude)
 key.list <- list(all=c(1,2,3,4,-5,6,7),
                  first=c(1,2,3),
                  last=c(4,5,6,7))
 keys <- make.keys(7,key.list,item.labels = colnames(attitude))
 keys
 
 scores <- score.items(keys,attitude,short=TRUE)
 scores
 
 data(bfi)
 keys.list <- list(agree=c(-1,2:5),conscientious=c(6:8,-9,-10),extraversion=c(-11,-12,13:15),neuroticism=c(16:20),openness = c(21,-22,23,24,-25))
 keys <- make.keys(25,keys.list,item.labels=colnames(bfi))
 scores <- score.items(keys,bfi,short=TRUE)
 scores




cleanEx(); nameEx("mat.regress")
### * mat.regress

flush(stderr()); flush(stdout())

### Name: mat.regress
### Title: Multiple Regression from matrix input
### Aliases: mat.regress
### Keywords: models multivariate

### ** Examples


## Not run: 
##D test.data <- Harman74.cor$cov     #24 mental variables
##D #choose 3 of them to regress against another 4 -- arbitrary choice of variables
##D print(mat.regress(test.data,c(1,2,3),c(4,5,10,12)),digits=2)
## End(Not run)
#gives this output
#print(mat.regress(test.data,c(1,2,3),c(4,5,10,12)),digits=2)
#$beta
#                 Flags GeneralInformation Addition CountingDots
#VisualPerception  0.40               0.22     0.16         0.30
#Cubes             0.06               0.18     0.06         0.05
#PaperFormBoard    0.12               0.10    -0.16         0.00
#
#$R
#             Flags GeneralInformation           Addition       CountingDots 
#             0.49               0.38               0.18               0.32 
#
#$R2
#             Flags GeneralInformation           Addition       CountingDots 
#              0.24               0.15               0.03               0.10 
#
#
data(attitude)
mat.regress(attitude,c(1:3),c(4:7)) #standardized regression from raw data



cleanEx(); nameEx("mat.sort")
### * mat.sort

flush(stderr()); flush(stdout())

### Name: mat.sort
### Title: Sort the elements of a correlation matrix to reflect factor
###   loadings
### Aliases: mat.sort
### Keywords: multivariate models

### ** Examples
data(bifactor)
sorted <- mat.sort(Bechtoldt.1,fa(Bechtoldt.1,5))
cor.plot(sorted)



cleanEx(); nameEx("matrix.addition")
### * matrix.addition

flush(stderr()); flush(stdout())

### Name: matrix.addition
### Title: A function to add two vectors or matrices
### Aliases: matrix.addition %+%
### Keywords: multivariate

### ** Examples


x <- seq(1,4)
z <- x %+% -t(x)
x
z
#compare with outer(x,-x,FUN="+")
x <- matrix(seq(1,6),ncol=2)
y <- matrix(seq(1,10),nrow=2)
z <- x %+% y
x
y
z
#but compare this with outer(x ,y,FUN="+") 



cleanEx(); nameEx("msq")
### * msq

flush(stderr()); flush(stdout())

### Name: msq
### Title: 75 mood items from the Motivational State Questionnaire for 3896
###   participants
### Aliases: msq
### Keywords: datasets

### ** Examples

data(msq)
describe(msq)



cleanEx(); nameEx("multi.hist")
### * multi.hist

flush(stderr()); flush(stdout())

### Name: multi.hist
### Title: Multiple histograms with density and normal fits on one page
### Aliases: multi.hist histo.density
### Keywords: multivariate hplot

### ** Examples

#multi.hist(attitude[-1]) 



cleanEx(); nameEx("neo")
### * neo

flush(stderr()); flush(stdout())

### Name: neo
### Title: NEO correlation matrix from the NEO_PI_R manual
### Aliases: neo
### Keywords: datasets

### ** Examples

data(neo)
n5 <- factor.minres(neo,5)
neo.keys <- make.keys(30,list(N=c(1:6),E=c(7:12),O=c(13:18),A=c(19:24),C=c(25:30)))
n5p <- target.rot(n5,neo.keys) #show a targeted rotation for simple structure
n5p




cleanEx(); nameEx("omega")
### * omega

flush(stderr()); flush(stdout())

### Name: omega
### Title: Calculate McDonald's omega estimates of general and total factor
###   saturation
### Aliases: omega
### Keywords: multivariate models

### ** Examples

## Not run: 
##D test.data <- Harman74.cor$cov
##D my.omega <- omega(test.data,3)       
##D print(my.omega,digits=2)
##D #
##D          
## End(Not run)
#create 9 variables with a hierarchical structure
jen.data <- sim.hierarchical()
#with correlations of
jen.data
#find omega 
if(require(Rgraphviz)) {jen.omega <- omega(jen.data,digits=2)} else {jen.omega <- omega(jen.data,digits=2,plot=FALSE)}
jen.omega

#create 8 items with a two factor solution, showing the use of the flip option
sim2 <- item.sim(8)
omega(sim2)   #an example of misidentification-- remember to look at the loadings matrices.
omega(sim2,2)  #this shows that in fact there is no general factor
omega(sim2,2,option="first") #but, if we define one of the two group factors as a general factor, we get a falsely high omega 
#apply omega to analyze 6 mental ability tests 
data(ability.cov)   #has a covariance matrix
if(require(Rgraphviz)) {omega(ability.cov$cov)} else {omega(ability.cov$cov,plot=FALSE)} 



cleanEx(); nameEx("omega.graph")
### * omega.graph

flush(stderr()); flush(stdout())

### Name: omega.graph
### Title: Graph hierarchical factor structures
### Aliases: omega.graph omega.sem
### Keywords: multivariate

### ** Examples

#24 mental tests from Holzinger-Swineford-Harman
if(require(GPArotation) ) {om24 <- omega(Harman74.cor$cov,4) } #run omega
if(require(Rgraphviz) ){om24pn <- omega.graph(om24,sl=FALSE)} #show the structure
#
#example hierarchical structure from Jensen and Weng
if(require(GPArotation) ) {jen.omega <- omega(make.hierarchical())}
if(require(Rgraphviz) ) {om.jen <- omega.graph(jen.omega,sl=FALSE) }




cleanEx(); nameEx("p.rep")
### * p.rep

flush(stderr()); flush(stdout())

### Name: p.rep
### Title: Find the probability of replication for an F, t, or r and
###   estimate effect size
### Aliases: p.rep p.rep.f p.rep.t p.rep.r
### Keywords: models univar

### ** Examples


p.rep(.05)  #probability of replicating a result if the original study had a  p = .05
p.rep.f(9.0,98)  #probability of replicating  a result with F = 9.0 with 98 df
p.rep.r(.4,50)    #probability of replicating a result if r =.4 with n = 50
p.rep.t(3,98)   #probability of replicating a result if t = 3 with df =98
p.rep.t(2.14,84,14) #effect of equal sample sizes (see Rosnow et al.)




cleanEx(); nameEx("paired.r")
### * paired.r

flush(stderr()); flush(stdout())

### Name: paired.r
### Title: Test the difference between (un)paired correlations
### Aliases: paired.r
### Keywords: multivariate models

### ** Examples

paired.r(.5,.3, .4, 100) #dependent correlations
paired.r(.5,.3,NULL,100) #independent correlations same sample size
paired.r(.5,.3,NULL, 100, 64) # independent correlations, different sample sizes



cleanEx(); nameEx("pairs.panels")
### * pairs.panels

flush(stderr()); flush(stdout())

### Name: pairs.panels
### Title: SPLOM, histograms and correlations for a data matrix
### Aliases: pairs.panels panel.cor panel.cor.scale panel.hist panel.lm
###   panel.lm.ellipse panel.hist.density panel.ellipse p.ellipse
###   panel.smoothie
### Keywords: multivariate hplot

### ** Examples


pairs.panels(attitude)   #see the graphics window
data(peas)
pairs.panels(peas,lm=TRUE,xlim=c(14,22),ylim=c(14,22))




cleanEx(); nameEx("partial.r")
### * partial.r

flush(stderr()); flush(stdout())

### Name: partial.r
### Title: Find the partial correlations for a set (x) of variables with
###   set (y) removed.
### Aliases: partial.r
### Keywords: multivariate

### ** Examples

jen <- make.hierarchical()    #make up a correlation matrix 
round(jen[1:5,1:5],2)
par.r <- partial.r(jen,c(1,3,5),c(2,4))
par.r



cleanEx(); nameEx("peas")
### * peas

flush(stderr()); flush(stdout())

### Name: peas
### Title: Galton`s Peas
### Aliases: peas
### Keywords: datasets

### ** Examples

data(peas)
pairs.panels(peas,lm=TRUE,xlim=c(14,22),ylim=c(14,22))
describe(peas)
pairs.panels(peas)



cleanEx(); nameEx("phi")
### * phi

flush(stderr()); flush(stdout())

### Name: phi
### Title: Find the phi coefficient of correlation between two dichotomous
###   variables
### Aliases: phi
### Keywords: multivariate models

### ** Examples

phi(c(30,20,20,30))
phi(c(40,10,10,40))
x <- matrix(c(40,5,20,20),ncol=2)
phi(x)




cleanEx(); nameEx("phi.demo")
### * phi.demo

flush(stderr()); flush(stdout())

### Name: phi.demo
### Title: A simple demonstration of the Pearson, phi, and polychoric
###   corelation
### Aliases: phi.demo
### Keywords: multivariate models

### ** Examples

if(require(polycor)) {demo <- phi.demo() #compare the phi (lower off diagonal and polychoric correlations (upper off diagonal)
#show the result from poly.mat
round(demo$tetrachoric,2)
#show the result from phi2poly
#tetrachorics above the diagonal, phi below the diagonal 
round(demo$phis,2) }



cleanEx(); nameEx("phi2poly")
### * phi2poly

flush(stderr()); flush(stdout())

### Name: phi2poly
### Title: Convert a phi coefficient to a polychoric correlation
### Aliases: phi2poly
### Keywords: models models

### ** Examples

#phi2poly(.3,.5,.5)
#phi2poly(.3,.3,.7)



cleanEx(); nameEx("plot.psych")
### * plot.psych

flush(stderr()); flush(stdout())

### Name: plot.psych
### Title: Plotting functions for the psych package of class ``psych"
### Aliases: plot.psych
### Keywords: multivariate

### ** Examples

test.data <- Harman74.cor$cov
f4 <- factor.pa(test.data,4)
plot(f4)



cleanEx(); nameEx("polar")
### * polar

flush(stderr()); flush(stdout())

### Name: polar
### Title: Convert Cartesian factor loadings into polar coordinates
### Aliases: polar
### Keywords: multivariate

### ** Examples


circ.data <- circ.sim(24,500)
circ.fa <- factor.pa(circ.data,2)
circ.polar <- round(polar(circ.fa),2)
circ.polar
#compare to the graphic
cluster.plot(circ.fa)



cleanEx(); nameEx("poly.mat")
### * poly.mat

flush(stderr()); flush(stdout())

### Name: poly.mat
### Title: Find polychoric correlations of item data
### Aliases: poly.mat
### Keywords: multivariate

### ** Examples

if(require(polycor)) {demo <- phi.demo()
round(demo$tetrachoric,2) #these should actually be all 1s but won't be
round(demo$phis,2)    #compare the phi (lower off diagonal and polychoric correlations (upper off diagonal)
} else {print("I am sorry, this demo requires the polycor package")}



cleanEx(); nameEx("polychor.matrix")
### * polychor.matrix

flush(stderr()); flush(stdout())

### Name: polychor.matrix
### Title: Phi or Yule coefficient matrix to polychoric coefficient matrix
### Aliases: polychor.matrix Yule2poly.matrix phi2poly.matrix
###   Yule2phi.matrix
### Keywords: models multivariate

### ** Examples

demo <- phi.demo()
round(demo$tetrachoric,2) #these should actually be all 1s but won't be
round(demo$phis,2)    #compare the phi (lower off diagonal and polychoric correlations (upper off diagonal)




cleanEx(); nameEx("principal")
### * principal

flush(stderr()); flush(stdout())

### Name: principal
### Title: Principal components analysis
### Aliases: principal
### Keywords: multivariate models

### ** Examples

#Four principal components of the Harmon 24 variable problem
#compare to a four factor principal axes solution using factor.congruence
pc <- principal(Harman74.cor$cov,4,rotate="varimax")
pa <- factor.pa(Harman74.cor$cov,4,rotate="varimax")
round(factor.congruence(pc,pa),2)




cleanEx(); nameEx("print.psych")
### * print.psych

flush(stderr()); flush(stdout())

### Name: print.psych
### Title: Print and summary functions for the psych class
### Aliases: print.psych summary.psych
### Keywords: multivariate

### ** Examples

data(bfi)
 keys.list <- list(agree=c(-1,2:5),conscientious=c(6:8,-9,-10),extraversion=c(-11,-12,13:15),neuroticism=c(16:20),openness = c(21,-22,23,24,-25))
 keys <- make.keys(25,keys.list,item.labels=colnames(bfi))
 scores <- score.items(keys,bfi,short=TRUE)
 scores
 summary(scores)



cleanEx(); nameEx("r.test")
### * r.test

flush(stderr()); flush(stdout())

### Name: r.test
### Title: Tests of significance for correlations
### Aliases: r.test
### Keywords: multivariate models

### ** Examples


n <- 30 
r <- seq(0,.9,.1) 
rc <- matrix(r.con(r,n),ncol=2) 
test <- r.test(n,r)
r.rc <- data.frame(r=r,z=fisherz(r),lower=rc[,1],upper=rc[,2],t=test$t,p=test$p) 
round(r.rc,2) 

r.test(50,r)
r.test(30,.4,.6)       #test the difference between two independent correlations
r.test(103,.4,.5,.1)   #Steiger case A
r.test(103,.5,.6,.7,.5,.5,.8)  #steiger Case B 




cleanEx(); nameEx("read.clipboard")
### * read.clipboard

flush(stderr()); flush(stdout())

### Name: read.clipboard
### Title: shortcut for reading from the clipboard
### Aliases: read.clipboard read.clipboard.csv read.clipboard.tab
###   read.clipboard.lower read.clipboard.upper
### Keywords: multivariate models

### ** Examples

#my.data <- read.clipboad()
#my.data <- read.clipboard.csv()
#my.data <- read.clipboad(header=FALSE)



cleanEx(); nameEx("rescale")
### * rescale

flush(stderr()); flush(stdout())

### Name: rescale
### Title: Function to convert scores to ``conventional " metrics
### Aliases: rescale
### Keywords: multivariate models univar

### ** Examples

T <- rescale(attitude,50,10) #all put on same scale
describe(T)
T1 <- rescale(attitude,seq(0,300,50),seq(10,70,10)) #different means and sigmas
describe(T1)



cleanEx(); nameEx("sat.act")
### * sat.act

flush(stderr()); flush(stdout())

### Name: sat.act
### Title: 3 Measures of ability: SATV, SATQ, ACT
### Aliases: sat.act
### Keywords: datasets

### ** Examples

data(sat.act)
describe(sat.act)
pairs.panels(sat.act)



cleanEx(); nameEx("schmid")
### * schmid

flush(stderr()); flush(stdout())

### Name: schmid
### Title: Apply the Schmid Leiman transformation to a correlation matrix
### Aliases: schmid
### Keywords: multivariate models

### ** Examples

jen <- sim.hierarchical()  #create a hierarchical demo
o.jen <- schmid(jen,digits=2)  #use the oblimin rotation
p.jen <- schmid(jen,rotate="promax") #use the promax rotation



cleanEx(); nameEx("score.alpha")
### * score.alpha

flush(stderr()); flush(stdout())

### Name: score.alpha
### Title: Score scales and find Cronbach's alpha as well as associated
###   statistics
### Aliases: score.alpha
### Keywords: multivariate models

### ** Examples


y <- attitude     #from the datasets package
keys <- matrix(c(rep(1,7),rep(1,4),rep(0,7),rep(-1,3)),ncol=3)
labels <- c("first","second","third")
x <- score.alpha(keys,y,labels)




cleanEx(); nameEx("score.items")
### * score.items

flush(stderr()); flush(stdout())

### Name: score.items
### Title: Score item composite scales and find Cronbach's alpha, Guttman
###   lambda 6 and item whole correlations
### Aliases: score.items
### Keywords: multivariate models

### ** Examples


#see  the example including the bfi data set
data(bfi)
 keys.list <- list(agree=c(-1,2:5),conscientious=c(6:8,-9,-10),extraversion=c(-11,-12,13:15),neuroticism=c(16:20),openness = c(21,-22,23,24,-25))
 keys <- make.keys(25,keys.list,item.labels=colnames(bfi))
 scores <- score.items(keys,bfi)
 scores




cleanEx(); nameEx("score.multiple.choice")
### * score.multiple.choice

flush(stderr()); flush(stdout())

### Name: score.multiple.choice
### Title: Score multiple choice items and provide basic test statistics
### Aliases: score.multiple.choice
### Keywords: multivariate models

### ** Examples

data(iqitems)
iq.keys <- c(4,4,3,1,4,3,2,3,1,4,1,3,4,3)
score.multiple.choice(iq.keys,iqitems)
#just convert the items to true or false 
iq.tf <- score.multiple.choice(iq.keys,iqitems,score=FALSE)
describe(iq.tf)  #compare to previous results




cleanEx(); nameEx("sim")
### * sim

flush(stderr()); flush(stdout())

### Name: sim
### Title: Functions to simulate psychological/psychometric data.
### Aliases: sim sim.simplex
### Keywords: multivariate datagen

### ** Examples

simplex <- sim()
round(simplex$model,2)

congeneric <- sim.congeneric()
round(congeneric,2)
R <- sim.hierarchical()
R
fx <- matrix(c(.9,.8,.7,rep(0,6),c(.8,.7,.6)),ncol=2)
fy <- c(.6,.5,.4)
Phi <- matrix(c(1,0,.5,0,1,.4,0,0,0),ncol=3)
print(sim.structure(fx,Phi,fy,),digits=2)  
cor.plot(R) #show it graphically

simp <- sim.simplex()
#show the simplex structure using cor.plot
cor.plot(simp)



cleanEx(); nameEx("sim.VSS")
### * sim.VSS

flush(stderr()); flush(stdout())

### Name: sim.VSS
### Title: create VSS like data
### Aliases: sim.VSS VSS.simulate VSS.sim
### Keywords: multivariate models datagen

### ** Examples

## Not run: 
##D simulated <- sim.VSS(1000,20,4,.6)
##D vss <- VSS(simulated,rotate="varimax")
##D VSS.plot(vss)
## End(Not run)




cleanEx(); nameEx("sim.anova")
### * sim.anova

flush(stderr()); flush(stdout())

### Name: sim.anova
### Title: Simulate a 3 way balanced ANOVA or linear model, with or without
###   repeated measures.
### Aliases: sim.anova
### Keywords: models multivariate

### ** Examples

set.seed(42)
data.df <- sim.anova(es1=1,es2=.5,es13=1)  # one main effect and one interaction
describe(data.df)
pairs.panels(data.df)   #show how the design variables are orthogonal
#
summary(lm(DV~IV1*IV2*IV3,data=data.df))
summary(aov(DV~IV1*IV2*IV3,data=data.df))
set.seed(42)
data.df <- sim.anova(es1=1,es2=.5,es13=1,center=FALSE)  # demonstrate the effect of not centering the data on the regression
describe(data.df)
#
summary(lm(DV~IV1*IV2*IV3,data=data.df)) #this one is incorrect, because the IVs are not centered
summary(aov(DV~IV1*IV2*IV3,data=data.df)) #compare with the lm model
#now examine multiple levels and quadratic terms
set.seed(42)
data.df <- sim.anova(es1=1,es13=1,n2=3,n3=4,es22=1)
summary(lm(DV~IV1*IV2*IV3,data=data.df))
summary(aov(DV~IV1*IV2*IV3,data=data.df))
pairs.panels(data.df)
#
data.df <- sim.anova(es1=1,es2=-.5,within=c(-1,0,1),n=10)
pairs.panels(data.df)




cleanEx(); nameEx("sim.congeneric")
### * sim.congeneric

flush(stderr()); flush(stdout())

### Name: sim.congeneric
### Title: Simulate a congeneric data set
### Aliases: congeneric.sim sim.congeneric make.congeneric
### Keywords: multivariate datagen

### ** Examples

test <- sim.congeneric(c(.9,.8,.7,.6))   #just the population matrix
test <- sim.congeneric(c(.9,.8,.7,.6),N=100)   # a sample correlation matrix
test <- sim.congeneric(short=FALSE, N=100)
round(cor(test$observed),2) # show  a congeneric correlation matrix
f1=factor.pa(test$observed,1,scores=TRUE)
round(cor(f1$scores,test$latent),2)  #factor score estimates are correlated with but not equal to the factor scores





cleanEx(); nameEx("sim.hierarchical")
### * sim.hierarchical

flush(stderr()); flush(stdout())

### Name: sim.hierarchical
### Title: Create a population or sample correlation matrix, perhaps with
###   hierarchical structure.
### Aliases: sim.hierarchical make.hierarchical
### Keywords: multivariate models datagen

### ** Examples


gload <-  gload<-matrix(c(.9,.8,.7),nrow=3)    # a higher order factor matrix
fload <-matrix(c(                    #a lower order (oblique) factor matrix
           .8,0,0,
           .7,0,.0,
           .6,0,.0,
            0,.7,.0,
            0,.6,.0,
            0,.5,0,
            0,0,.6,
            0,0,.5,
            0,0,.4),   ncol=3,byrow=TRUE)
            
jensen <- sim.hierarchical(gload,fload)    #the test set used by omega
round(jensen,2)     

fload <- matrix(c(c(c(.9,.8,.7,.6),rep(0,20)),c(c(.9,.8,.7,.6),rep(0,20)),c(c(.9,.8,.7,.6),rep(0,20)),c(c(c(.9,.8,.7,.6),rep(0,20)),c(.9,.8,.7,.6))),ncol=5)
gload <- matrix(rep(0,5))
five.factor <- sim.hierarchical(gload,fload,500,TRUE) #create sample data set




cleanEx(); nameEx("sim.item")
### * sim.item

flush(stderr()); flush(stdout())

### Name: sim.item
### Title: Generate simulated data structures for circumplex or simple
###   structure
### Aliases: item.sim sim.item sim.dichot item.dichot sim.circ circ.sim
### Keywords: multivariate datagen

### ** Examples


round(cor(circ.sim(nvar=8,nsub=200)),2)
plot(factor.pa(circ.sim(16,500),2)$loadings,main="Circumplex Structure") #circumplex structure
#
#
plot(factor.pa(item.sim(16,500),2)$loadings,main="Simple Structure") #simple structure
#
cluster.plot(factor.pa(item.dichot(16,low=0,high=1),2))



cleanEx(); nameEx("sim.structural")
### * sim.structural

flush(stderr()); flush(stdout())

### Name: sim.structure
### Title: Create correlation matrices or data matrices with a particular
###   measurement and structural model
### Aliases: make.structural sim.structure sim.structural
### Keywords: multivariate datagen

### ** Examples

fx <-matrix(c( .9,.8,.6,rep(0,4),.6,.8,-.7),ncol=2)              
fy <- c(.6,.5,.4)
Phi <-matrix( c(1,0,.7,.0,1,.7,.7,.7,1),ncol=3)
gre.gpa <- sim.structural(fx,Phi,fy)
print(gre.gpa,2)  
round(correct.cor(gre.gpa$model,gre.gpa$reliability),2)  #correct for attenuation to see structure

congeneric <- sim.structural(f=c(.9,.8,.7,.6)) # a congeneric model 
congeneric 




cleanEx(); nameEx("simulation.circ")
### * simulation.circ

flush(stderr()); flush(stdout())

### Name: simulation.circ
### Title: Simulations of circumplex and simple structure
### Aliases: simulation.circ circ.simulation simulation.circ circ.sim.plot
### Keywords: multivariate datagen

### ** Examples


demo <- simulation.circ()
 boxplot(demo[3:14])
 title("4 tests of Circumplex Structure",sub="Circumplex, Ellipsoid, Simple Structure")
circ.sim.plot(demo[3:14])  #compare these results to real data




cleanEx(); nameEx("skew")
### * skew

flush(stderr()); flush(stdout())

### Name: skew
### Title: Calculate skew or kurtosis for a vector, matrix, or data.frame
### Aliases: skew kurtosi
### Keywords: multivariate models

### ** Examples

round(skew(attitude),2)
round(kurtosi(attitude),2)




cleanEx(); nameEx("smc")
### * smc

flush(stderr()); flush(stdout())

### Name: smc
### Title: Find the Squared Multiple Correlation (SMC) of each variable
###   with the remaining variables in a matrix
### Aliases: smc SMC
### Keywords: multivariate

### ** Examples

R <- make.hierarchical()
round(smc(R),2)
 


cleanEx(); nameEx("structure.graph")
### * structure.graph

flush(stderr()); flush(stdout())

### Name: structure.graph
### Title: Draw a structural equation model specified by two measurement
###   models and a structural model
### Aliases: structure.graph structure.sem
### Keywords: multivariate hplot

### ** Examples

fx <- matrix(c(.9,.8,.6,rep(0,4),.6,.8,-.7),ncol=2)
fy <- matrix(c(.6,.5,.4),ncol=1)
Phi <- matrix(c(1,0,0,0,1,0,.7,.7,1),ncol=3,byrow=TRUE)
if(require(Rgraphviz)) { f1 <- structure.graph(fx,Phi,fy)  } else {f1 <- structure.sem(fx,Phi,fy)}

#symbolic input
X2 <- matrix(c("a",0,0,"b","e1",0,0,"e2"),ncol=4)
colnames(X2) <- c("X1","X2","E1","E2")
phi2 <- diag(1,4,4)
phi2[2,1] <- phi2[1,2] <- "r"
if(require(Rgraphviz)) { f2 <- structure.graph(X2,Phi=phi2,errors=FALSE)  } else {f2 <- structure.sem(X2,Phi=phi2,errors=FALSE) }

#symbolic input with error 
X2 <- matrix(c("a",0,0,"b"),ncol=2)
colnames(X2) <- c("X1","X2")
phi2 <- diag(1,2,2)
phi2[2,1] <- phi2[1,2] <- "r"
if(require(Rgraphviz)) { f3 <- structure.graph(X2,Phi=phi2)  } else {f3 <- structure.sem(X2,Phi=phi2)}

#and yet another one
X6 <- matrix(c("a","b","c",rep(0,6),"d","e","f"),nrow=6)
colnames(X6) <- c("L1","L2")
rownames(X6) <- c("x1","x2","x3","x4","x5","x6")
Y3 <- matrix(c("u","w","z"),ncol=1)
colnames(Y3) <- "Y"
rownames(Y3) <- c("y1","y2","y3")
phi21 <- matrix(c(1,0,"r1",0,1,"r2",0,0,1),ncol=3)
colnames(phi21) <- rownames(phi21) <-  c("L1","L2","Y")
if(require(Rgraphviz)) {f4 <- structure.graph(X6,phi21,Y3,title="Structural model")} else {f4 <- structure.sem(X6,phi21,Y3)}

# and finally, a regression model
X7 <- matrix(c("a","b","c","d","e","f"),nrow=6)
if(require(Rgraphviz)) {f5 <- structure.graph(X7,regression=TRUE)}

#and a really messy regession model
x8 <- c("b1","b2","b3")
r8 <- matrix(c(1,"r12","r13","r12",1,"r23","r13","r23",1),ncol=3)
if(require(Rgraphviz)) {f6<- structure.graph(x8,Phi=r8,regression=TRUE)}



cleanEx(); nameEx("structure.list")
### * structure.list

flush(stderr()); flush(stdout())

### Name: structure.list
### Title: Create factor model matrices from an input list
### Aliases: structure.list phi.list
### Keywords: multivariate models

### ** Examples

fx <- structure.list(9,list(F1=c(1,2,3),F2=c(4,5,6),F3=c(7,8,9)))
fy <- structure.list(3,list(Y=c(1,2,3)),"Y")
phi <- phi.list(4,list(F1=c(4),F2=c(1,4),F3=c(2),F4=c(1,2,3)))
fx
phi
fy




cleanEx(); nameEx("super.matrix")
### * super.matrix

flush(stderr()); flush(stdout())

### Name: super.matrix
### Title: Form a super matrix from two sub matrices.
### Aliases: super.matrix
### Keywords: multivariate

### ** Examples

mx <- matrix(c(.9,.8,.7,rep(0,4),.8,.7,.6),ncol=2)
my <- matrix(c(.6,.5,.4))
colnames(mx) <- paste("X",1:dim(mx)[2],sep="")
rownames(mx) <- paste("Xv",1:dim(mx)[1],sep="")
colnames(my) <- "Y"
rownames(my) <- paste("Yv",1:3,sep="")
super.matrix(mx,my)



cleanEx(); nameEx("table2matrix")
### * table2matrix

flush(stderr()); flush(stdout())

### Name: table2matrix
### Title: Convert a table with counts to a matrix or data.frame
###   representing those counts.
### Aliases: table2matrix table2df
### Keywords: models

### ** Examples

data(cubits)
cubit <- table2matrix(cubits,labs=c("height","cubit"))
describe(cubit)
ellipses(cubit,n=1)



cleanEx(); nameEx("test.psych")
### * test.psych

flush(stderr()); flush(stdout())

### Name: test.psych
### Title: Testing of functions in the psych package
### Aliases: test.psych
### Keywords: multivariate

### ** Examples

test <- test.psych()




cleanEx(); nameEx("thurstone")
### * thurstone

flush(stderr()); flush(stdout())

### Name: thurstone
### Title: Thurstone Case V scaling
### Aliases: thurstone
### Keywords: models

### ** Examples

data(vegetables)
thurstone(veg)



cleanEx(); nameEx("tr")
### * tr

flush(stderr()); flush(stdout())

### Name: tr
### Title: Find the trace of a square matrix
### Aliases: tr
### Keywords: multivariate

### ** Examples

 m <- matrix(1:16,ncol=4)
 m
 tr(m)
 



cleanEx(); nameEx("vegetables")
### * vegetables

flush(stderr()); flush(stdout())

### Name: vegetables
### Title: Paired comparison of preferences for 9 vegetables
### Aliases: vegetables veg
### Keywords: datasets

### ** Examples

data(vegetables)
thurstone(veg)



cleanEx(); nameEx("winsor")
### * winsor

flush(stderr()); flush(stdout())

### Name: winsor
### Title: Find the Winsorized scores or means for a vector, matrix, or
###   data.frame
### Aliases: winsor winsor.means
### Keywords: univar

### ** Examples

data(sat.act)
winsor.means(sat.act) #compare with the means of the winsorized scores
y <- winsor(sat.act)
describe(y)
xy <- data.frame(sat.act,y)
pairs.panels(xy) #to see the effect of winsorizing 
x <- matrix(1:100,ncol=5)
winsor(x)
winsor.means(x)
y <- 1:11
winsor(y,trim=.5)



### * <FOOTER>
###
cat("Time elapsed: ", proc.time() - get("ptime", pos = 'CheckExEnv'),"\n")
grDevices::dev.off()
###
### Local variables: ***
### mode: outline-minor ***
### outline-regexp: "\\(> \\)?### [*]+" ***
### End: ***
quit('no')