.packageName <- "psy"
"ckappa" <-
function(r)
{

r <- na.omit(r)
r1 <- r[,1]
r2 <- r[,2]
n1 <- as.character(r1)
n2 <- as.character(r2)
lev <- levels(as.factor(c(n1,n2)))
p <- length(lev)

tab <- matrix(nrow=p,ncol=p)
dimnames(tab) <- list(levels(as.factor(c(n1,n2))),levels(as.factor(c(n1,n2))))
dim1 <- dimnames(tab)[[1]]
dim2 <- dimnames(tab)[[2]]

tabi <- table(n1,n2)
dimi1 <- dimnames(tabi)[[1]]
dimi2 <- dimnames(tabi)[[2]]

for(i in 1:p)for(j in 1:p)
{
	if((sum(dim1[i]==dimi1)==1)&(sum(dim2[j]==dimi2)==1))
	tab[i,j] <- tabi[dim1[i],dim2[j]]
	else
	tab[i,j] <- 0
}

tsum <- sum(tab)
ttab <- tab/tsum
tm1 <- apply(ttab, 1, sum)
tm2 <- apply(ttab, 2, sum)
agreeP <- sum(diag(ttab))
chanceP <- sum(tm1 * tm2)
kappa2 <- (agreeP - chanceP)/(1 - chanceP)
result <- list("table"=tab,"kappa"=kappa2)
result
}
"cronbach" <-
function(v1)
{
v1 <- na.omit(v1)
nv1 <- ncol(v1)
pv1 <- nrow(v1)
alpha <- (nv1/(nv1-1))*(1 - sum(apply(v1,2,var))/var(apply(v1,1,sum)))
resu <- list("sample.size"=pv1,"number.of.items"=nv1,"alpha"=alpha)
resu
}
"fpca" <-
function(datafile, y, x, cx=0.75, namesvar=attributes(datafile)$names, pvalues="No", partial="Yes", input="data", contraction="No", sample.size=1) 


#**********************************************
#
# datafile is the name of the dataframe that contains the data
# y is the number of the column related to the dependant variable (ex: y = 6)
# x is the vector of the number of the columns related to the independant variables
# (ex: x = c(1,2,3,4,5,7,8,9,10)
#
# option: pvalues is a vector of determined pvalues that will replace the correlations
# to the focus variable (if pvalues != "No" then partial = "No") (pvalues="No" by default)
# 
# q <- 1 (q>1 for a future version)
#
# option: partial is an option to present a focused PCA that is a simple renormalization
# of conventional PCA (partial="Yes" by default)
#
# option: input indicates wether the input correspond to data (default) or to a
# correlation matrix (if input != "data" then partial = "No") (input="data" by default)
#
# option: contraction change the appearance of the figure
# (if contraction="Yes" then pvalues="No") (contraction="No" by default)
#
# option: sample.size, size of the sample when input!="data"
#
#**********************************************

{

if (pvalues[1]!="No") partial <- "No"

#**********************************************
# definitions
#**********************************************

	p <- length(x)
	if (input=="data") n <- dim(datafile)[1] else n <- sample.size
	if (input=="data") mat <- matrix(ncol=p+1, nrow=n)
	names <- matrix(nrow=p+2)
	one2 <- matrix(1, nrow=p)
	load <- matrix(nrow=p, ncol=p)
	norm <- matrix(nrow=p, ncol=p-1)
	loadx <- matrix(nrow=p+2, ncol=p-1)
	loadyp <- matrix(nrow=p+2, ncol=p-1)
	loadym <- matrix(nrow=p+2, ncol=p-1)
	loady <- matrix(nrow=p+2, ncol=p-1)
	q <- 1

if (input=="data")
{
	#***********************************************
	# missing values are NOT omitted
	# input x (independant) and y (dependant variable)
	# x and y are normalized
	# correlations of (x,y)
	#***********************************************
	
	q <- min(q,p-1)
	mat[,1] <- datafile[,y]
	namey <- namesvar[y]
	for(i in 1:p)	
		{
		mat[,i+1] <- datafile[,x[i]]
		names[i] <- namesvar[x[i]]
		}


	mat <- na.omit(mat) #following command used to work for data.frames containing NA, didn't work if no NAs
	
	n <- dim(mat)[1]
	xv <- matrix(ncol=p, nrow=n)
	yv <- matrix(nrow=n)
	un <- matrix(1, ncol=p, nrow=n)
	one <- matrix(1, nrow=n)

	for(i in 1:p)	
		{
		xv[,i] <- (mat[,i+1]-mean(mat[,i+1]))/(sqrt(var(mat[,i+1]))*sqrt(n-1))
		}
	yv <- mat[,1]
	yv <- (yv-mean(yv))/(sqrt(var(yv))*sqrt(n-1))

	matcor <- cor(mat)
}

else

{
	namey <- namesvar[y]
	names[1:p] <- namesvar[x[1:p]]
	matcor <- matrix(nrow=p+1,ncol=1)
	matcor[1] <- 1
	matcor[2:y] <- datafile[1:(y-1),y]
	matcor[(y+1):(p+1)] <- datafile[(y+1):(p+1),y]
	matcorp <- datafile[x,x]
	decomp <- eigen(matcorp, symmetric=TRUE)
	eigenval <- decomp$values
	eigenvect <- decomp$vectors
	eigenval <- pmax(0*one2, eigenval)
	load <- eigenvect*sqrt(kronecker(one2,t(eigenval)))
}

#***********************************************
#traditional FPCA
#***********************************************

if (pvalues[1]=="No")
	{
	if (input=="data")
		{
		if (partial=="Yes")
			{
			#***********************************************
			# xp is x related to y (projection on y orthog)
			#***********************************************	
			scal <- t(t(xv)%*%yv)
			xp <- xv - (un*yv)*kronecker(one,scal)
			}
		else
			{
			xp <- xv	
			}
		#***********************************************
		# decomposition of the covariance matrix of xp
		#***********************************************
		
		#matcorp <- var(xp, na.method="omit")
                matcorp <- var(xp)
		decomp <- eigen(matcorp, symmetric=TRUE)
		eigenval <- decomp$values
		eigenvect <- decomp$vectors
		eigenval <- pmax(0*one2, eigenval)
		load <- eigenvect*sqrt(kronecker(one2,t(eigenval)))
		}
	
	#***********************************************
	# renormalization of the loadings
	#***********************************************
	
	if (contraction=="No")
		{
		for(i in 1:p)
			{
			for(j in 1:p-1)
				{
				norm[i,j] <- sqrt(load[i,1]*load[i,1] + load[i,j+1]*load[i,j+1])
				loadx[i,j] <- load[i,1]*sqrt(2-2*abs(matcor[i+1,1]))/norm[i,j]
				if (matcor[i+1,1] > 0) loadyp[i,j] <- load[i,j+1]*sqrt(2-2*matcor[i+1,1])/norm[i,j] else loadym[i,j] <- load[i,j+1]*sqrt(2+2*matcor[i+1,1])/norm[i,j]
				loady[i,j] <- load[i,j+1]*sqrt(2-2*abs(matcor[i+1,1]))/norm[i,j] - 0.05
				}
			}
		}

	if (contraction!="No")
		{
		for(i in 1:p)
			{
			for(j in 1:p-1)
				{
				norm[i,j] <- sqrt(load[i,1]*load[i,1] + load[i,j+1]*load[i,j+1])
				loadx[i,j] <- 1.5*load[i,1]*(1-abs(matcor[i+1,1]))/norm[i,j]
				if (matcor[i+1,1] > 0) loadyp[i,j] <- 1.5*load[i,j+1]*(1-matcor[i+1,1])/norm[i,j] else loadym[i,j] <- 1.5*load[i,j+1]*(1+matcor[i+1,1])/norm[i,j]
				loady[i,j] <- 1.5*load[i,j+1]*(1-abs(matcor[i+1,1]))/norm[i,j] - 0.05
				}
			}
		}
		

	}
#***********************************************
#pvalued FPCA
#***********************************************

if (pvalues[1]!="No")

	{
	matcorp <- var(xv, na.rm=TRUE)
	decomp <- eigen(matcorp, symmetric=TRUE)
	eigenval <- decomp$values
	eigenvect <- decomp$vectors
	eigenval <- pmax(0*one2, eigenval)
	load <- eigenvect*sqrt(kronecker(one2,t(eigenval)))
	
	#***********************************************
	# renormalization of the loadings (1.5 is for drawing convenience)
	#***********************************************
	
	pnorm <- matrix(nrow=p)
	
	for (i in 1:p) if (pvalues[i]==0) pnorm[i] <- 0 else pnorm[i] <- pvalues[i]^(log(pvalues[i])/-50)
	
	
	for(i in 1:p)
		{
		for(j in 1:p-1)
			{
			norm[i,j] <- sqrt(load[i,1]*load[i,1] + load[i,j+1]*load[i,j+1])
			loadx[i,j] <- 1.5*load[i,1]*pnorm[i]/norm[i,j]
			if (pvalues[i] > 0) loadyp[i,j] <- 1.5*load[i,j+1]*pnorm[i]/norm[i,j] else loadym[i,j] <- 1.5*load[i,j+1]*pnorm[i]/norm[i,j]
			loady[i,j] <- 1.5*load[i,j+1]*pnorm[i]/norm[i,j] - 0.05
			}
		}

	}


#****************************************************************************
#****************************************************************************
# Drawing
#****************************************************************************
#****************************************************************************

#****************** two more points for a non truncated drawing ********

for(j in 1:p-1)
{
loadx[p+1,j] <- 1.5
loady[p+1,j] <- 1.5
loadx[p+2,j] <- -1.5
loady[p+2,j] <- -1.5 
}
names[p+1] <- "."
names[p+2] <- "."

#****************************************************************************
#******************************** q plots here q=1***************************
#****************************************************************************

j <- 1

{

#*************** new axes (centered) ********
par(pty="s")
par(mar=rep(0,4))
plot(x=c(-1.6,1.6),y=c(0,0),type="l",axes=FALSE,frame.plot=FALSE,ann=FALSE,xlim=c(-1.7,1.7),ylim=c(-1.7,1.7),col="grey")
lines(x=c(0,0),y=c(-1.6,1.6),type="l",col="grey")

#********************************************************
#traditionnal FPCA
#********************************************************

if (pvalues[1]=="No")
{

#************** circles (r=0, r=0.2, ...)****************

radius <- matrix(nrow=5)

if (contraction=="No")
{
radius[1] <- 1.414
radius[2] <- 1.265
radius[3] <- 1.095
radius[4] <- 0.894
radius[5] <- 0.632
} 
else
{
radius[1] <- 1.5
radius[2] <- 1.2
radius[3] <- 0.9
radius[4] <- 0.6
radius[5] <- 0.3
}

symbols(x=0, y=0, circles=radius[1], inches=FALSE, add=TRUE, lwd=2)
symbols(x=c(0,0,0,0), y=c(0,0,0,0), circles=radius[2:5], inches=FALSE, add=TRUE, lwd=1,fg="grey")

}

#********************************************************
#pvalued FPCA
#********************************************************

if (pvalues[1]!="No")
{
#************** circles (p=0.1, p=0.05, ...)****************
symbols(x=0, y=0, circles=1.5, inches=FALSE, add=TRUE, lwd=2)
symbols(x=c(0,0,0,0), y=c(0,0,0,0), circles=c(1.35,1.254,1,.557), inches=FALSE, add=TRUE, lwd=1,fg="grey")
}

#************** dependant variable *****************
symbols(x=0, y=0, circles=0.03, bg="black", inches=FALSE, add=TRUE, lwd=1)

#********************************************************
#traditionnal FPCA
#********************************************************

if (pvalues[1]=="No")
{
#************** circle with p = 5% *****************
e <- exp(1.96*2/sqrt(n-3))
if (contraction=="No") rayonsign <- sqrt(2-2*(e-1)/(1+e)) else rayonsign <- (1-(e-1)/(1+e))*1.5
symbols(x=0, y=0, circles=rayonsign, inches=FALSE, add=TRUE, lwd=1, fg="red")

#**************** legends : r=0, r=0.2, ... ****************
text(x=c(rep(0.01,5)),y=radius+.04,
     labels=c("r = 0","r = 0.2","r = 0.4","r = 0.6","r = 0.8"),cex=0.5) 
}

#********************************************************
#pvalued FPCA
#********************************************************

if (pvalues[1]!="No")
{
#**************** legends : p=0, p=0.1, ... ****************
text(x=c(rep(0.01,5)),y=c(.563,.982,1.239,1.335,1.48),
     labels=c("p = 0.001","p = 0.01","p = 0.05","p = 0.1","p = 1"),cex=cx)
}

#****************** plot of positive correlations ***********
symbols(x=loadx[,j], y=loadyp[,j], circles=rep(.03,length(loadyp[,j])), inches=FALSE, add=TRUE,fg="blue",bg="green")

#****************** plot of negative correlations ***********
symbols(x=loadx[,j], y=loadym[,j], circles=rep(.03,length(loadym[,j])), inches=FALSE, add=TRUE,fg="red",bg="yellow")

#***************** names ******************
text(x=-0.18,y=-.12,labels=namey, cex=cx+0.25)#focus variable 
text(x=loadx[,j],y=loady[,j],labels=names,cex=cx)#other variables

#****************** name of factors ***********
annotate <- paste("Factors : 1,", j+1, sep="")
text(x=1,y=1.3,labels=annotate,cex=cx)

#****************************************************************************
#******************************** end of q plots ****************************
#****************************************************************************

}

#******************* end **********************
}
"icc" <-
function(data)
{
score <- as.matrix(na.omit(data))
n <- dim(score)[1]
p <- dim(score)[2]
data2 <- matrix(ncol=3,nrow=p*n)
attr(score,"dim") <- c(p*n,1)
data2[,1] <- score
subject <- as.factor(rep(1:n,p))
rater <- as.factor(rep(1:p,each=n))
data2[,2] <- subject
data2[,3] <- rater
ms <- anova(lm(score~subject+rater))[[3]]
names(ms) <- NULL
v.s <- (ms[1]-ms[3])/p
v.r <- (ms[2]-ms[3])/n
res <- ms[3]
icc.a <- v.s/(v.s+v.r+res)
icc.c <- v.s/(v.s+res)
result <- list("nb.subjects"=n,"nb.raters"=p,"subject.variance"=v.s,"rater.variance"=v.r,"residual"=res,"icc.consistency"=icc.c,"icc.agreement"=icc.a)
result
}
"lkappa" <-
function(r, type="Cohen", weights="squared") 
{
    nrater <- dim(r)[2]
    kappas <- vector(length = nrater * (nrater - 1)/2)
    c <- 0
    for (i in 2:nrater) for (j in 1:(i - 1))
    {
        c <- c + 1
        if (type == "Cohen") kappas[c] <- ckappa(r[, c(i, j)])[[2]]
        else  kappas[c] <- wkappa(r[, c(i, j)], weights=weights)[[3]]
    }
    return(mean(kappas))
}
"mdspca" <-
function(datafile, supvar="no", supsubj="no", namesupvar=colnames(supvar,do.NULL=FALSE), namesupsubj=colnames(supsubj,do.NULL=FALSE), dimx=1, dimy=2, cx=0.75) 

{


#***********************************************
# missing values are omitted, normalization of var and supvar
#***********************************************

if ((is.na(supvar) || (supvar!="no")) && (!is.na(supsubj) && (supsubj=="no")))
{
svar <- 1
ssubj <- 0
p <- dim(datafile)[2]
supvar <- as.matrix(supvar)
pp <- dim(supvar)[2]
interm <- cbind(datafile,supvar)
interm <- na.omit(interm)
mat <- as.matrix(interm[,1:p])
matp <- as.matrix(interm[,(p+1):(p+pp)])
n <- dim(mat)[1]
for(i in 1:p) mat[,i] <- (mat[,i]-mean(mat[,i]))/(sqrt(n-1)*sd(mat[,i]))
for(i in 1:pp) matp[,i] <- (matp[,i]-mean(matp[,i]))/(sqrt(n-1)*sd(matp[,i]))
}

if ((is.na(supvar) || (supvar!="no")) && (is.na(supsubj) || (supsubj!="no")))
{
svar <- 1
ssubj <- 1
p <- dim(datafile)[2]
supvar <- as.matrix(supvar)
pp <- dim(supvar)[2]
supsubj <- as.matrix(supsubj)
ppp <- dim(supsubj)[2]
interm <- cbind(datafile,supvar,supsubj)
interm <- na.omit(interm)
mat <- as.matrix(interm[,1:p])
matp <- as.matrix(interm[,(p+1):(p+pp)])
supsubj <- as.matrix(interm[,(p+pp+1):(p+pp+ppp)])
n <- dim(mat)[1]
for(i in 1:p) mat[,i] <- (mat[,i]-mean(mat[,i]))/(sqrt(n-1)*sd(mat[,i]))
for(i in 1:pp) matp[,i] <- (matp[,i]-mean(matp[,i]))/(sqrt(n-1)*sd(matp[,i]))
}

if ((!is.na(supvar) && (supvar=="no")) && (is.na(supsubj) || (supsubj!="no")))
{
svar <- 0
ssubj <- 1
p <- dim(datafile)[2]
supsubj <- as.matrix(supsubj)
ppp <- dim(supsubj)[2]
interm <- cbind(datafile,supsubj)
interm <- na.omit(interm)
mat <- as.matrix(interm[,1:p])
supsubj <- as.matrix(interm[,(p+1):(p+ppp)])
n <- dim(mat)[1]
for(i in 1:p) mat[,i] <- (mat[,i]-mean(mat[,i]))/(sqrt(n-1)*sd(mat[,i]))
}

if ((!is.na(supvar) && (supvar=="no")) && (!is.na(supsubj) && (supsubj=="no")))
{
svar <- 0
ssubj <- 0
p <- dim(datafile)[2]
mat <- as.matrix(na.omit(datafile))
n <- dim(mat)[1]
for(i in 1:p) mat[,i] <- (mat[,i]-mean(mat[,i]))/(sqrt(n-1)*sd(mat[,i]))
}

#**********************************************
# definitions
#**********************************************

n <- dim(mat)[1]

names <- matrix(nrow=p+2)
one2 <- matrix(1, nrow=p)
load <- matrix(nrow=p, ncol=p)
loady <- matrix(nrow=p+2, ncol=p)

#***********************************************
# correlations and loadings
#***********************************************

names[1:p] <- attributes(datafile)$names
un <- matrix(1, ncol=p, nrow=n)
one <- matrix(1, nrow=n)

matcorp <- cor(mat)
decomp <- eigen(matcorp, symmetric=TRUE)
eigenval <- decomp$values
eigenvect <- decomp$vectors
eigenval <- pmax(0.00001*one2, eigenval)
load <- eigenvect*sqrt(kronecker(one2,t(eigenval)))

loady[1:p,] <- load[1:p,1:p]

#***********************************************
# supplementary variables
#***********************************************

if(svar==1)
{
one3 <- matrix(1,nrow=pp)
namesp <- matrix(nrow=pp)
namesp[1:pp] <- namesupvar
loadp <- matrix(nrow=pp, ncol=p)
loadyp <- matrix(nrow=pp, ncol=p)
loadp <- (t(matp)%*%mat%*%eigenvect)*kronecker(one3,t(1/sqrt(eigenval)))

loadyp[1:pp,] <- loadp[1:pp,1:p]
}


#***********************************************
# supplementary subjects
#***********************************************


if(ssubj==1)
{

nn <- ppp

mod <- matrix(nrow=nn)
for(i in 1:nn)
{
	factsub <- as.factor(supsubj[,i])
	mod[i] <- nlevels(factsub)
}
nmod <- sum(mod)

names2 <- matrix(nrow=nmod)
mat2 <- matrix(nrow=nmod, ncol=p)
load2 <- matrix(nrow=nmod, ncol=p)
loady2 <- matrix(nrow=nmod, ncol=p)

compt <- 0
mat <- as.data.frame(mat)
for(i in 1:nn) for(j in 1:mod[i])
{
	compt <- compt+1
	factsub <- as.factor(supsubj[,i])
	names2[compt] <- paste(namesupsubj[i],levels(factsub)[j])
	mat2[compt,] <- sapply(split(mat,factsub)[[j]],mean)
}

load2 <- (mat2%*%eigenvect)*sqrt(n/p)
loady2[1:nmod,] <- load2[1:nmod,1:p]



}


#****************************************************************************
#****************************************************************************
# Drawing
#****************************************************************************
#****************************************************************************

#****************** two more points for a non truncated drawing ********

loady[p+1,] <- 1.5
loady[p+2,] <- -1.5	
names[p+1] <- "."
names[p+2] <- "."

#****************************************************************************
#********************************  plots ***********************************
#****************************************************************************


par(pty="s")
if (is.na(supsubj) || (supsubj!="no"))
{
par(mfrow=c(1,2))
par(oma=c(0,0,0,0))
par(mar=c(0,0,0,0))
dimmax <- max(abs(loady2[,dimx])+0.2,abs(loady2[,dimy])+0.2,1.2)
#*************** new axes (centered) ********
par(mar=rep(0,4))
plot(x=c(-1*dimmax+0.1,dimmax-0.1),y=c(0,0),type="l",axes=FALSE,frame.plot=FALSE,ann=FALSE,xlim=c(-1*dimmax,dimmax),ylim=c(-1*dimmax,dimmax),col="grey")
lines(x=c(0,0),y=c(-1*dimmax+0.1,dimmax-0.1),type="l",col="grey")

#****************** plot of correlations ***********
symbols(x=loady2[,dimx], y=loady2[,dimy], squares=rep(.03,length(loady2[,dimy])), inches=FALSE, add=TRUE,fg="blue",bg="blue")

#***************** name plot *****************
text(x=loady2[,dimx],y=loady2[,dimy]-0.05,labels=names2,cex=cx)

}


#*************** new axes (centered) ********
if (!is.na(supsubj) && (supsubj=="no")) {par(mar=rep(0,4))}
plot(x=c(-1.1,1.1),y=c(0,0),type="l",axes=FALSE,frame.plot=FALSE,ann=FALSE,xlim=c(-1.2,1.2),ylim=c(-1.2,1.2),col="grey")
lines(x=c(0,0),y=c(-1.1,1.1),type="l",col="grey")

#************** circle (r=1)****************
symbols(x=0, y=0, circles=1, inches=FALSE, add=TRUE, lwd=2)

#****************** plot of correlations ***********
symbols(x=loady[,dimx], y=loady[,dimy], circles=rep(.01*cx*2,length(loady[,dimy])), inches=FALSE, add=TRUE,fg="grey",bg="red")

#***************** name plot *****************
text(x=loady[,dimx],y=loady[,dimy]-0.05,labels=names,cex=cx)



if (is.na(supvar) || (supvar!="no"))
{
#****************** plot of correlations sup var ***********
symbols(x=loadyp[,dimx], y=loadyp[,dimy], circles=rep(.01*cx*2,length(loadyp[,dimy])), inches=FALSE, add=TRUE,fg="grey",bg="green")

#***************** name plot *****************
text(x=loadyp[,dimx],y=loadyp[,dimy]-0.05,labels=namesp,cex=cx)
}

#****************** name of factors ***********
pf1 <- floor(100*eigenval[dimx]/sum(eigenval))
pf2 <- floor(100*eigenval[dimy]/sum(eigenval))
annotate1 <- paste("x = F",dimx," : ",pf1,"% var", sep="")
annotate2 <- paste("y = F",dimy," : ",pf2,"% var", sep="")
text(x=1,y=1,labels=annotate1,cex=cx)
text(x=1,y=1-0.05*cx*2,labels=annotate2,cex=cx)

par(mfrow=c(1,1))

#****************************************************************************
#******************************** end of plots ****************************
#****************************************************************************

}
"scree.plot" <-
function(namefile, title="Scree Plot", type="R", use="complete.obs", simu="F")
{

mat <- namefile
if (use=="complete.obs") mat <- na.omit(namefile)

if (type=="R") eigenval <- eigen(cor(mat,use="pairwise.complete.obs"), symmetric=TRUE)$values
if (type=="V") eigenval <- eigen(cov(mat,use="pairwise.complete.obs"), symmetric=TRUE)$values
if (type=="E") eigenval <- namefile
if (type=="M") eigenval <- eigen(namefile, symmetric=TRUE)$values


plot(eigenval, type = "b", pch = 16, bty = "n", main = title, xlab = "", ylab = "")	

if (is.numeric(simu) && (type=="R"))
{
n <- dim(mat)[1]
p <- dim(mat)[2]

matsimu <- matrix(nrow=n,ncol=p)
int <- rep(1,n*p)
attr(int,"dim") <- c(n,p)
mat <- pmax(as.matrix(mat),int)

for(i in 1:simu)
	{
	matnorm <- rnorm(n*p)
	attr(matnorm,"dim") <- c(n,p)
	matsimu <- (mat/mat)*matnorm
	eigenval <- eigen(cor(matsimu,use="pairwise.complete.obs"))$values
	points(eigenval,type="l")
	}
}
}
"sphpca" <-
function(datafile, h=0, v=0, f=0, cx=0.75, nbsphere=2, back=FALSE)
{

p <- dim(datafile)[2]
mat <- as.matrix(na.omit(datafile))
n <- dim(mat)[1]

one <- matrix(1, nrow=p)
load <- matrix(nrow=p, ncol=3)
names <- attributes(datafile)$names

matcorp <- cor(mat)
decomp <- eigen(matcorp, symmetric=TRUE)
eigenval <- decomp$values
eigenvect <- decomp$vectors
eigenval <- pmax(0.00001*one, eigenval)
load <- eigenvect*sqrt(kronecker(one,t(eigenval)))
load <- load[,1:3]
for(i in 1:p) load[i,] <- load[i,]/sqrt(sum(load[i,]^2))

pi <- 3.1415926
v <- v*pi/180
h <- h*pi/180
f <- f*pi/180
rotv <- matrix(c(cos(v),sin(v),0,-sin(v),cos(v),0,0,0,1),ncol=3)
roth <- matrix(c(cos(h),0,sin(h),0,1,0,-sin(h),0,cos(h)),ncol=3)
rotf <- matrix(c(1,0,0,0,cos(f),sin(f),0,-sin(f),cos(f)),ncol=3)
rot <- rotv%*%roth%*%rotf

load <- load%*%rot

if (nbsphere==2)
{
par(mfrow=c(1,2))
par(pty="s")
par(oma=c(0,0,0,0))
par(mar=c(0,0,0,0))
plot(cos((1:201)*pi/100),sin((1:201)*pi/100),type="l",axes=FALSE,frame.plot=FALSE,ann=FALSE,xlim=c(-1,1),ylim=c(-1,1))


mp1m <- rbind(c(-0.3644843,-0.9310856),
c(-0.3852566,-0.922069),
c(-0.4045085,-0.912571),
c(-0.422164,-0.9026292),
c(-0.4381533,-0.8922827),
c(-0.4524135,-0.8815725),
c(-0.4648882,-0.8705407),
c(-0.4755283,-0.859231),
c(-0.4842916,-0.8476879),
c(-0.4911436,-0.835957),
c(-0.4960574,-0.8240846),
c(-0.4990134,-0.8121176),
c(-0.5,-0.8001032),
c(-0.4990134,-0.7880887),
c(-0.4960574,-0.7761217),
c(-0.4911436,-0.7642493),
c(-0.4842916,-0.7525184),
c(-0.4755283,-0.7409753),
c(-0.4648883,-0.7296656),
c(-0.4524136,-0.7186338),
c(-0.4381534,-0.7079236),
c(-0.422164,-0.6975771),
c(-0.4045085,-0.6876353),
c(-0.3852567,-0.6781374),
c(-0.3644844,-0.6691207),
c(-0.3422736,-0.660621),
c(-0.318712,-0.6526718),
c(-0.2938927,-0.6453044),
c(-0.2679134,-0.638548),
c(-0.2408769,-0.6324291),
c(-0.2128897,-0.626972),
c(-0.1840623,-0.6221981),
c(-0.1545086,-0.6181264),
c(-0.124345,-0.6147728),
c(-0.09369071,-0.6121506),
c(-0.06266667,-0.6102702),
c(-0.03139531,-0.609139),
c(-5.35898e-08,-0.6087614),
c(0.03139521,-0.609139),
c(0.06266656,-0.6102702),
c(0.0936906,-0.6121506),
c(0.1243449,-0.6147728),
c(0.1545084,-0.6181263),
c(0.1840622,-0.6221981),
c(0.2128896,-0.626972),
c(0.2408768,-0.6324291),
c(0.2679134,-0.638548),
c(0.2938926,-0.6453044),
c(0.318712,-0.6526718),
c(0.3422735,-0.660621),
c(0.3644843,-0.6691207),
c(0.3852566,-0.6781373),
c(0.4045085,-0.6876353),
c(0.4221639,-0.6975771),
c(0.4381533,-0.7079235),
c(0.4524135,-0.7186338),
c(0.4648882,-0.7296655),
c(0.4755283,-0.7409753),
c(0.4842916,-0.7525184),
c(0.4911436,-0.7642493),
c(0.4960574,-0.7761216),
c(0.4990134,-0.7880887),
c(0.5,-0.8001031),
c(0.4990134,-0.8121176),
c(0.4960574,-0.8240846),
c(0.4911437,-0.835957),
c(0.4842916,-0.8476879),
c(0.4755283,-0.859231),
c(0.4648883,-0.8705407),
c(0.4524136,-0.8815725),
c(0.4381534,-0.8922827),
c(0.422164,-0.9026291),
c(0.4045086,-0.912571),
c(0.3852567,-0.922069),
c(0.3644844,-0.9310855))
mp1p <- rbind(c(0.3422736,-0.9395852),
c(0.318712,-0.9475345),
c(0.2938927,-0.9549018),
c(0.2679134,-0.9616583),
c(0.2408769,-0.9677772),
c(0.2128897,-0.9732343),
c(0.1840623,-0.9780082),
c(0.1545085,-0.98208),
c(0.124345,-0.9854335),
c(0.09369068,-0.9880557),
c(0.06266664,-0.989936),
c(0.03139529,-0.9910673),
c(2.67949e-08,-0.9914449),
c(-0.03139523,-0.9910673),
c(-0.06266659,-0.989936),
c(-0.09369063,-0.9880557),
c(-0.1243449,-0.9854335),
c(-0.1545085,-0.98208),
c(-0.1840623,-0.9780082),
c(-0.2128896,-0.9732343),
c(-0.2408768,-0.9677772),
c(-0.2679134,-0.9616583),
c(-0.2938926,-0.9549018),
c(-0.318712,-0.9475345),
c(-0.3422735,-0.9395853))
mp2m <- rbind(c(-0.8506857,-0.5240405),
c(-0.8591965,-0.5034769),
c(-0.8643165,-0.4827494),
c(-0.8660254,-0.4619398),
c(-0.8643165,-0.4411302),
c(-0.8591965,-0.4204027),
c(-0.8506857,-0.3998391),
c(-0.8388176,-0.3795206),
c(-0.8236391,-0.3595274),
c(-0.8052101,-0.3399383),
c(-0.7836032,-0.3208308),
c(-0.7589039,-0.3022801),
c(-0.7312095,-0.2843595),
c(-0.7006293,-0.2671398),
c(-0.6672841,-0.2506888),
c(-0.6313054,-0.2350716),
c(-0.5928352,-0.2203497),
c(-0.5520254,-0.2065812),
c(-0.509037,-0.1938206),
c(-0.4640397,-0.182118),
c(-0.417211,-0.1715199),
c(-0.3687358,-0.1620678),
c(-0.3188053,-0.1537992),
c(-0.2676167,-0.1467467),
c(-0.2153718,-0.1409382),
c(-0.1622771,-0.1363964),
c(-0.1085419,-0.1331395),
c(-0.05437828,-0.1311802),
c(-9.282025e-08,-0.1305262),
c(0.05437818,-0.1311802),
c(0.1085418,-0.1331395),
c(0.162277,-0.1363964),
c(0.2153718,-0.1409382),
c(0.2676166,-0.1467467),
c(0.3188052,-0.1537992),
c(0.3687357,-0.1620678),
c(0.4172109,-0.1715198),
c(0.4640396,-0.182118),
c(0.509037,-0.1938205),
c(0.5520254,-0.2065812),
c(0.5928352,-0.2203497),
c(0.6313053,-0.2350716),
c(0.667284,-0.2506888),
c(0.7006293,-0.2671397),
c(0.7312094,-0.2843595),
c(0.7589038,-0.30228),
c(0.7836032,-0.3208307),
c(0.80521,-0.3399383),
c(0.8236391,-0.3595273),
c(0.8388176,-0.3795205),
c(0.8506857,-0.399839),
c(0.8591965,-0.4204026),
c(0.8643165,-0.4411301),
c(0.8660254,-0.4619398),
c(0.8643165,-0.4827494),
c(0.8591965,-0.5034769),
c(0.8506857,-0.5240405))
mp2p <- rbind(c(0.8388176,-0.544359),
c(0.8236391,-0.5643522),
c(0.80521,-0.5839412),
c(0.7836032,-0.6030488),
c(0.7589039,-0.6215995),
c(0.7312095,-0.63952),
c(0.7006293,-0.6567398),
c(0.6672841,-0.6731907),
c(0.6313054,-0.688808),
c(0.5928352,-0.7035298),
c(0.5520254,-0.7172983),
c(0.509037,-0.730059),
c(0.4640397,-0.7417615),
c(0.417211,-0.7523597),
c(0.3687357,-0.7618117),
c(0.3188053,-0.7700803),
c(0.2676166,-0.7771328),
c(0.2153718,-0.7829414),
c(0.162277,-0.7874831),
c(0.1085418,-0.79074),
c(0.05437823,-0.7926994),
c(4.641012e-08,-0.7933533),
c(-0.05437814,-0.7926994),
c(-0.1085417,-0.79074),
c(-0.1622769,-0.7874831),
c(-0.2153717,-0.7829414),
c(-0.2676165,-0.7771328),
c(-0.3188052,-0.7700803),
c(-0.3687356,-0.7618117),
c(-0.4172109,-0.7523597),
c(-0.4640396,-0.7417615),
c(-0.5090369,-0.730059),
c(-0.5520253,-0.7172983),
c(-0.5928351,-0.7035299),
c(-0.6313053,-0.688808),
c(-0.667284,-0.6731907),
c(-0.7006292,-0.6567398),
c(-0.7312094,-0.63952),
c(-0.7589038,-0.6215995),
c(-0.7836032,-0.6030488),
c(-0.80521,-0.5839413),
c(-0.8236391,-0.5643522),
c(-0.8388176,-0.544359))
mp3m <- rbind(c(-0.9980267,0.02402886),
c(-0.9921147,0.04796292),
c(-0.9822873,0.07170769),
c(-0.9685832,0.09516947),
c(-0.9510565,0.1182557),
c(-0.9297765,0.1408751),
c(-0.904827,0.1629386),
c(-0.8763067,0.1843591),
c(-0.844328,0.205052),
c(-0.809017,0.2249356),
c(-0.7705133,0.2439316),
c(-0.7289687,0.2619648),
c(-0.6845472,0.2789642),
c(-0.637424,0.2948626),
c(-0.5877853,0.3095974),
c(-0.5358269,0.3231103),
c(-0.4817538,0.335348),
c(-0.4257794,0.3462623),
c(-0.3681246,0.35581),
c(-0.3090171,0.3639536),
c(-0.24869,0.3706607),
c(-0.1873814,0.375905),
c(-0.1253333,0.3796658),
c(-0.06279063,0.3819283),
c(-1.071796e-07,0.3826834),
c(0.06279052,0.3819283),
c(0.1253332,0.3796659),
c(0.1873813,0.3759051),
c(0.2486899,0.3706607),
c(0.309017,0.3639536),
c(0.3681245,0.3558101),
c(0.4257793,0.3462623),
c(0.4817537,0.335348),
c(0.5358268,0.3231103),
c(0.5877852,0.3095974),
c(0.637424,0.2948627),
c(0.6845471,0.2789642),
c(0.7289686,0.2619648),
c(0.7705132,0.2439316),
c(0.809017,0.2249357),
c(0.844328,0.205052),
c(0.8763067,0.1843592),
c(0.904827,0.1629387),
c(0.9297765,0.1408752),
c(0.9510565,0.1182557),
c(0.9685832,0.0951695),
c(0.9822872,0.07170773),
c(0.9921147,0.04796296),
c(0.9980267,0.0240289),
c(1,1.025396e-08))
mp3p <- rbind(c(0.9980267,-0.02402888),
c(0.9921147,-0.04796294),
c(0.9822873,-0.07170771),
c(0.9685832,-0.09516949),
c(0.9510565,-0.1182557),
c(0.9297765,-0.1408752),
c(0.904827,-0.1629387),
c(0.8763067,-0.1843591),
c(0.844328,-0.205052),
c(0.809017,-0.2249357),
c(0.7705133,-0.2439316),
c(0.7289687,-0.2619648),
c(0.6845471,-0.2789642),
c(0.637424,-0.2948626),
c(0.5877853,-0.3095974),
c(0.5358268,-0.3231103),
c(0.4817537,-0.335348),
c(0.4257793,-0.3462623),
c(0.3681246,-0.35581),
c(0.309017,-0.3639536),
c(0.2486899,-0.3706607),
c(0.1873814,-0.375905),
c(0.1253333,-0.3796659),
c(0.06279057,-0.3819283),
c(5.358979e-08,-0.3826834),
c(-0.06279046,-0.3819283),
c(-0.1253332,-0.3796659),
c(-0.1873813,-0.3759051),
c(-0.2486898,-0.3706607),
c(-0.3090169,-0.3639536),
c(-0.3681245,-0.3558101),
c(-0.4257792,-0.3462623),
c(-0.4817536,-0.3353481),
c(-0.5358267,-0.3231103),
c(-0.5877852,-0.3095974),
c(-0.637424,-0.2948627),
c(-0.684547,-0.2789642),
c(-0.7289686,-0.2619649),
c(-0.7705132,-0.2439316),
c(-0.809017,-0.2249357),
c(-0.8443279,-0.2050521),
c(-0.8763066,-0.1843592),
c(-0.904827,-0.1629387),
c(-0.9297765,-0.1408752),
c(-0.9510565,-0.1182557),
c(-0.9685831,-0.09516953),
c(-0.9822872,-0.07170775),
c(-0.9921147,-0.04796298),
c(-0.9980267,-0.02402892),
c(-1,-3.076189e-08))
mp4m <- rbind(c(-0.8388176,0.5443589),
c(-0.8236391,0.5643522),
c(-0.8052101,0.5839412),
c(-0.7836032,0.6030488),
c(-0.7589039,0.6215994),
c(-0.7312095,0.63952),
c(-0.7006293,0.6567397),
c(-0.6672841,0.6731907),
c(-0.6313054,0.688808),
c(-0.5928352,0.7035298),
c(-0.5520254,0.7172983),
c(-0.509037,0.730059),
c(-0.4640397,0.7417615),
c(-0.417211,0.7523597),
c(-0.3687358,0.7618117),
c(-0.3188053,0.7700803),
c(-0.2676167,0.7771328),
c(-0.2153718,0.7829414),
c(-0.1622771,0.7874831),
c(-0.1085419,0.79074),
c(-0.05437828,0.7926994),
c(-9.282025e-08,0.7933533),
c(0.05437818,0.7926994),
c(0.1085418,0.79074),
c(0.162277,0.7874831),
c(0.2153718,0.7829414),
c(0.2676166,0.7771328),
c(0.3188052,0.7700803),
c(0.3687357,0.7618117),
c(0.4172109,0.7523597),
c(0.4640396,0.7417615),
c(0.509037,0.730059),
c(0.5520254,0.7172983),
c(0.5928352,0.7035299),
c(0.6313053,0.688808),
c(0.667284,0.6731907),
c(0.7006293,0.6567398),
c(0.7312094,0.63952),
c(0.7589038,0.6215995),
c(0.7836032,0.6030488),
c(0.80521,0.5839412),
c(0.8236391,0.5643522),
c(0.8388176,0.544359))
mp4p <- rbind(c(0.8506857,0.5240405),
c(0.8591965,0.5034769),
c(0.8643165,0.4827494),
c(0.8660254,0.4619398),
c(0.8643165,0.4411301),
c(0.8591965,0.4204026),
c(0.8506857,0.3998391),
c(0.8388176,0.3795206),
c(0.8236391,0.3595273),
c(0.80521,0.3399383),
c(0.7836032,0.3208307),
c(0.7589039,0.3022801),
c(0.7312095,0.2843595),
c(0.7006293,0.2671398),
c(0.6672841,0.2506888),
c(0.6313054,0.2350716),
c(0.5928352,0.2203497),
c(0.5520254,0.2065812),
c(0.509037,0.1938206),
c(0.4640397,0.182118),
c(0.417211,0.1715198),
c(0.3687357,0.1620678),
c(0.3188053,0.1537992),
c(0.2676166,0.1467467),
c(0.2153718,0.1409382),
c(0.162277,0.1363964),
c(0.1085418,0.1331395),
c(0.05437823,0.1311802),
c(4.641012e-08,0.1305262),
c(-0.05437814,0.1311802),
c(-0.1085417,0.1331395),
c(-0.1622769,0.1363964),
c(-0.2153717,0.1409382),
c(-0.2676165,0.1467467),
c(-0.3188052,0.1537992),
c(-0.3687356,0.1620678),
c(-0.4172109,0.1715198),
c(-0.4640396,0.182118),
c(-0.5090369,0.1938205),
c(-0.5520253,0.2065812),
c(-0.5928351,0.2203496),
c(-0.6313053,0.2350715),
c(-0.667284,0.2506888),
c(-0.7006292,0.2671397),
c(-0.7312094,0.2843595),
c(-0.7589038,0.30228),
c(-0.7836032,0.3208307),
c(-0.80521,0.3399383),
c(-0.8236391,0.3595273),
c(-0.8388176,0.3795205),
c(-0.8506857,0.399839),
c(-0.8591965,0.4204026),
c(-0.8643165,0.4411301),
c(-0.8660254,0.4619397),
c(-0.8643165,0.4827494),
c(-0.8591965,0.5034769),
c(-0.8506857,0.5240404))
mp5m <- rbind(c(-0.3422736,0.9395852),
c(-0.318712,0.9475345),
c(-0.2938927,0.9549018),
c(-0.2679134,0.9616583),
c(-0.2408769,0.9677772),
c(-0.2128897,0.9732343),
c(-0.1840623,0.9780082),
c(-0.1545086,0.98208),
c(-0.124345,0.9854335),
c(-0.09369071,0.9880557),
c(-0.06266667,0.989936),
c(-0.03139531,0.9910673),
c(-5.35898e-08,0.9914449),
c(0.03139526,0.9910673),
c(0.06266662,0.989936),
c(0.09369066,0.9880557),
c(0.1243449,0.9854335),
c(0.1545085,0.98208),
c(0.1840623,0.9780082),
c(0.2128896,0.9732343),
c(0.2408768,0.9677772),
c(0.2679134,0.9616583),
c(0.2938926,0.9549018),
c(0.318712,0.9475345),
c(0.3422736,0.9395853))
mp5p <- rbind(c(0.3644843,0.9310856),
c(0.3852566,0.922069),
c(0.4045085,0.912571),
c(0.422164,0.9026292),
c(0.4381533,0.8922827),
c(0.4524135,0.8815725),
c(0.4648883,0.8705407),
c(0.4755283,0.859231),
c(0.4842916,0.8476879),
c(0.4911436,0.835957),
c(0.4960574,0.8240846),
c(0.4990134,0.8121176),
c(0.5,0.8001031),
c(0.4990134,0.7880887),
c(0.4960574,0.7761217),
c(0.4911436,0.7642493),
c(0.4842916,0.7525184),
c(0.4755283,0.7409753),
c(0.4648883,0.7296656),
c(0.4524135,0.7186338),
c(0.4381534,0.7079236),
c(0.422164,0.6975771),
c(0.4045085,0.6876353),
c(0.3852566,0.6781373),
c(0.3644843,0.6691207),
c(0.3422736,0.660621),
c(0.318712,0.6526718),
c(0.2938927,0.6453044),
c(0.2679134,0.638548),
c(0.2408769,0.6324291),
c(0.2128897,0.626972),
c(0.1840623,0.6221981),
c(0.1545085,0.6181264),
c(0.124345,0.6147728),
c(0.09369068,0.6121506),
c(0.06266664,0.6102702),
c(0.03139529,0.609139),
c(2.67949e-08,0.6087614),
c(-0.03139523,0.609139),
c(-0.06266659,0.6102702),
c(-0.09369063,0.6121506),
c(-0.1243449,0.6147728),
c(-0.1545085,0.6181263),
c(-0.1840623,0.6221981),
c(-0.2128896,0.626972),
c(-0.2408768,0.6324291),
c(-0.2679134,0.638548),
c(-0.2938926,0.6453044),
c(-0.318712,0.6526718),
c(-0.3422735,0.660621),
c(-0.3644843,0.6691207),
c(-0.3852566,0.6781373),
c(-0.4045085,0.6876353),
c(-0.422164,0.6975771),
c(-0.4381533,0.7079236),
c(-0.4524135,0.7186338),
c(-0.4648882,0.7296655),
c(-0.4755283,0.7409753),
c(-0.4842916,0.7525184),
c(-0.4911436,0.7642493),
c(-0.4960574,0.7761216),
c(-0.4990134,0.7880887),
c(-0.5,0.8001031),
c(-0.4990134,0.8121176),
c(-0.4960574,0.8240846),
c(-0.4911436,0.835957),
c(-0.4842916,0.8476879),
c(-0.4755283,0.859231),
c(-0.4648883,0.8705407),
c(-0.4524136,0.8815725),
c(-0.4381534,0.8922827),
c(-0.422164,0.9026291),
c(-0.4045085,0.912571),
c(-0.3852567,0.922069),
c(-0.3644844,0.9310855))
mq1m <- rbind(c(-0.08933569,-0.9959537),
c(-0.07561703,-0.9946018),
c(-0.06159996,-0.9893246),
c(-0.04733977,-0.980143),
c(-0.03289276,-0.9670934),
c(-0.01831593,-0.950227),
c(-0.003666819,-0.9296104),
c(0.01099676,-0.9053252),
c(0.02561695,-0.877467),
c(0.04013603,-0.8461459),
c(0.05449672,-0.8114854),
c(0.06864233,-0.7736224),
c(0.08251704,-0.7327062),
c(0.0960661,-0.6888984),
c(0.109236,-0.6423718),
c(0.1219748,-0.59331),
c(0.1342323,-0.5419067),
c(0.14596,-0.4883648),
c(0.1571116,-0.4328955),
c(0.1676432,-0.3757178),
c(0.1775132,-0.3170573),
c(0.1866827,-0.2571455),
c(0.1951153,-0.1962189),
c(0.202778,-0.1345179),
c(0.2096404,-0.07228599),
c(0.2156754,-0.009768815),
c(0.2208592,0.05278702),
c(0.2251715,0.1151344),
c(0.228595,0.1770274),
c(0.2311164,0.2382218),
c(0.2327257,0.298476),
c(0.2334166,0.3575523),
c(0.2331862,0.4152174),
c(0.2320356,0.4712439),
c(0.2299692,0.5254107),
c(0.2269952,0.5775038),
c(0.2231254,0.6273178),
c(0.2183751,0.6746561),
c(0.2127629,0.7193318),
c(0.206311,0.7611687),
c(0.1990449,0.8000015),
c(0.1909933,0.8356772),
c(0.1821879,0.8680547),
c(0.1726634,0.8970065),
c(0.1624576,0.9224182),
c(0.1516106,0.9441895),
c(0.1401653,0.9622346),
c(0.1281668,0.9764821),
c(0.1156625,0.986876),
c(0.1027018,0.993375))
mq1p <- rbind(c(0.08933568,0.9959537),
c(0.07561702,0.9946018),
c(0.06159994,0.9893246),
c(0.04733976,0.980143),
c(0.03289274,0.9670933),
c(0.01831592,0.950227),
c(0.003666807,0.9296104),
c(-0.01099678,0.9053252),
c(-0.02561696,0.877467),
c(-0.04013604,0.8461458),
c(-0.05449673,0.8114854),
c(-0.06864234,0.7736223),
c(-0.08251705,0.7327061),
c(-0.09606611,0.6888983),
c(-0.109236,0.6423717),
c(-0.1219749,0.59331),
c(-0.1342323,0.5419067),
c(-0.14596,0.4883648),
c(-0.1571116,0.4328955),
c(-0.1676432,0.3757178),
c(-0.1775132,0.3170572),
c(-0.1866827,0.2571455),
c(-0.1951153,0.1962188),
c(-0.202778,0.1345178),
c(-0.2096404,0.07228593),
c(-0.2156754,0.009768761),
c(-0.2208592,-0.05278696),
c(-0.2251715,-0.1151344),
c(-0.228595,-0.1770274),
c(-0.2311164,-0.2382217),
c(-0.2327257,-0.298476),
c(-0.2334166,-0.3575522),
c(-0.2331862,-0.4152174),
c(-0.2320356,-0.4712439),
c(-0.2299692,-0.5254106),
c(-0.2269952,-0.5775038),
c(-0.2231254,-0.6273178),
c(-0.2183751,-0.6746561),
c(-0.2127629,-0.7193318),
c(-0.206311,-0.7611686),
c(-0.1990449,-0.8000015),
c(-0.1909933,-0.8356771),
c(-0.1821879,-0.8680547),
c(-0.1726635,-0.8970065),
c(-0.1624576,-0.9224182),
c(-0.1516106,-0.9441895),
c(-0.1401653,-0.9622346),
c(-0.1281668,-0.9764821),
c(-0.1156625,-0.986876),
c(-0.1027018,-0.993375))
mq2m <- rbind(c(-0.2585898,-0.9658733),
c(-0.2249357,-0.9720312),
c(-0.1903939,-0.9743529),
c(-0.1551007,-0.9728293),
c(-0.1191954,-0.9674663),
c(-0.08281971,-0.9582853),
c(-0.04611715,-0.9453223),
c(-0.009232576,-0.9286285),
c(0.02768843,-0.9082699),
c(0.06450016,-0.8843268),
c(0.1010573,-0.8568936),
c(0.1372157,-0.8260786),
c(0.1728325,-0.7920035),
c(0.2077672,-0.7548028),
c(0.241882,-0.7146231),
c(0.2750422,-0.6716232),
c(0.3071169,-0.6259727),
c(0.3379796,-0.5778517),
c(0.3675084,-0.5274503),
c(0.3955868,-0.4749672),
c(0.422104,-0.4206096),
c(0.4469554,-0.3645921),
c(0.4700428,-0.3071358),
c(0.4912752,-0.2484673),
c(0.5105688,-0.1888182),
c(0.5278473,-0.1284239),
c(0.5430427,-0.06752279),
c(0.556095,-0.006355103),
c(0.5669526,0.05483756),
c(0.5755727,0.1158138),
c(0.5819213,0.176333),
c(0.5859733,0.2361563),
c(0.5877127,0.2950475),
c(0.5871327,0.3527744),
c(0.5842356,0.409109),
c(0.5790327,0.4638291),
c(0.5715447,0.5167186),
c(0.561801,0.5675689),
c(0.5498402,0.6161792),
c(0.5357094,0.6623578),
c(0.5194644,0.7059223),
c(0.5011693,0.7467009),
c(0.4808963,0.7845326),
c(0.4587255,0.8192681),
c(0.4347442,0.8507703),
c(0.4090473,0.878915),
c(0.381736,0.903591),
c(0.3529182,0.9247008),
c(0.3227075,0.9421613),
c(0.2912233,0.9559036))
mq2p <- rbind(c(0.2585898,0.9658733),
c(0.2249357,0.9720312),
c(0.1903939,0.9743529),
c(0.1551007,0.9728293),
c(0.1191954,0.9674663),
c(0.08281968,0.9582853),
c(0.04611711,0.9453223),
c(0.009232545,0.9286285),
c(-0.02768846,0.9082699),
c(-0.06450019,0.8843267),
c(-0.1010574,0.8568936),
c(-0.1372157,0.8260786),
c(-0.1728325,0.7920035),
c(-0.2077673,0.7548027),
c(-0.241882,0.7146231),
c(-0.2750422,0.6716232),
c(-0.3071169,0.6259726),
c(-0.3379796,0.5778517),
c(-0.3675084,0.5274502),
c(-0.3955868,0.4749671),
c(-0.422104,0.4206096),
c(-0.4469554,0.3645921),
c(-0.4700428,0.3071357),
c(-0.4912752,0.2484672),
c(-0.5105688,0.1888181),
c(-0.5278473,0.1284238),
c(-0.5430427,0.06752274),
c(-0.556095,0.006355155),
c(-0.5669526,-0.05483751),
c(-0.5755727,-0.1158138),
c(-0.5819213,-0.1763329),
c(-0.5859733,-0.2361562),
c(-0.5877127,-0.2950475),
c(-0.5871327,-0.3527743),
c(-0.5842356,-0.409109),
c(-0.5790327,-0.463829),
c(-0.5715447,-0.5167185),
c(-0.561801,-0.5675688),
c(-0.5498402,-0.6161792),
c(-0.5357094,-0.6623577),
c(-0.5194644,-0.7059223),
c(-0.5011693,-0.7467009),
c(-0.4808964,-0.7845326),
c(-0.4587255,-0.8192681),
c(-0.4347443,-0.8507703),
c(-0.4090473,-0.878915),
c(-0.381736,-0.903591),
c(-0.3529182,-0.9247008),
c(-0.3227075,-0.9421613),
c(-0.2912233,-0.9559036))
mq3m <- rbind(c(-0.5119424,-0.8588672),
c(-0.468119,-0.8819633),
c(-0.422448,-0.9015786),
c(-0.3751099,-0.9176358),
c(-0.3262913,-0.9300715),
c(-0.2761851,-0.9388367),
c(-0.2249888,-0.9438967),
c(-0.1729047,-0.9452315),
c(-0.1201381,-0.942836),
c(-0.06689744,-0.9367196),
c(-0.01339276,-0.9269063),
c(0.04016478,-0.913435),
c(0.09356381,-0.8963587),
c(0.1465936,-0.8757449),
c(0.1990448,-0.851675),
c(0.2507105,-0.8242438),
c(0.3013868,-0.7935598),
c(0.3508736,-0.759744),
c(0.3989757,-0.7229297),
c(0.4455032,-0.6832625),
c(0.4902725,-0.6408987),
c(0.5331069,-0.5960055),
c(0.5738374,-0.5487602),
c(0.6123033,-0.4993492),
c(0.6483526,-0.4479675),
c(0.6818432,-0.3948179),
c(0.7126429,-0.3401101),
c(0.74063,-0.28406),
c(0.7656943,-0.2268889),
c(0.7877368,-0.1688223),
c(0.8066704,-0.1100894),
c(0.8224204,-0.05092216),
c(0.8349247,0.008446087),
c(0.844134,0.067781),
c(0.8500118,0.1268484),
c(0.852535,0.1854152),
c(0.8516936,0.2432503),
c(0.847491,0.3001253),
c(0.8399438,0.3558159),
c(0.8290816,0.4101023),
c(0.8149475,0.4627701),
c(0.7975971,0.5136117),
c(0.777099,0.5624262),
c(0.753534,0.6090211),
c(0.7269952,0.6532124),
c(0.6975873,0.6948259),
c(0.6654263,0.7336972),
c(0.6306392,0.7696729),
c(0.5933632,0.802611),
c(0.5537455,0.8323816))
mq3p <- rbind(c(0.5119424,0.8588672),
c(0.4681189,0.8819633),
c(0.422448,0.9015786),
c(0.3751098,0.9176358),
c(0.3262913,0.9300715),
c(0.276185,0.9388367),
c(0.2249888,0.9438967),
c(0.1729046,0.9452315),
c(0.1201381,0.942836),
c(0.0668974,0.9367195),
c(0.01339271,0.9269063),
c(-0.04016483,0.913435),
c(-0.09356386,0.8963586),
c(-0.1465936,0.8757449),
c(-0.1990449,0.851675),
c(-0.2507106,0.8242438),
c(-0.3013868,0.7935598),
c(-0.3508736,0.7597439),
c(-0.3989757,0.7229297),
c(-0.4455032,0.6832624),
c(-0.4902725,0.6408986),
c(-0.533107,0.5960055),
c(-0.5738375,0.5487602),
c(-0.6123033,0.4993492),
c(-0.6483526,0.4479674),
c(-0.6818432,0.3948178),
c(-0.7126429,0.34011),
c(-0.7406301,0.2840599),
c(-0.7656944,0.2268888),
c(-0.7877368,0.1688223),
c(-0.8066704,0.1100895),
c(-0.8224204,0.05092221),
c(-0.8349247,-0.008446036),
c(-0.844134,-0.06778095),
c(-0.8500117,-0.1268484),
c(-0.852535,-0.1854152),
c(-0.8516936,-0.2432502),
c(-0.847491,-0.3001253),
c(-0.8399438,-0.3558159),
c(-0.8290817,-0.4101022),
c(-0.8149475,-0.4627701),
c(-0.7975972,-0.5136116),
c(-0.777099,-0.5624261),
c(-0.7535341,-0.609021),
c(-0.7269953,-0.6532124),
c(-0.6975873,-0.6948258),
c(-0.6654263,-0.7336971),
c(-0.6306392,-0.7696728),
c(-0.5933632,-0.802611),
c(-0.5537455,-0.8323816))
mq4m <- rbind(c(-0.8388176,0.5443589),
c(-0.8236391,0.5643522),
c(-0.8052101,0.5839412),
c(-0.7836032,0.6030488),
c(-0.7589039,0.6215994),
c(-0.7312095,0.63952),
c(-0.7006293,0.6567397),
c(-0.6672841,0.6731907),
c(-0.6313054,0.688808),
c(-0.5928352,0.7035298),
c(-0.5520254,0.7172983),
c(-0.509037,0.730059),
c(-0.4640397,0.7417615),
c(-0.417211,0.7523597),
c(-0.3687358,0.7618117),
c(-0.3188053,0.7700803),
c(-0.2676167,0.7771328),
c(-0.2153718,0.7829414),
c(-0.1622771,0.7874831),
c(-0.1085419,0.79074),
c(-0.05437828,0.7926994),
c(-9.282025e-08,0.7933533),
c(0.05437818,0.7926994),
c(0.1085418,0.79074),
c(0.162277,0.7874831),
c(0.2153718,0.7829414),
c(0.2676166,0.7771328),
c(0.3188052,0.7700803),
c(0.3687357,0.7618117),
c(0.4172109,0.7523597),
c(0.4640396,0.7417615),
c(0.509037,0.730059),
c(0.5520254,0.7172983),
c(0.5928352,0.7035299),
c(0.6313053,0.688808),
c(0.667284,0.6731907),
c(0.7006293,0.6567398),
c(0.7312094,0.63952),
c(0.7589038,0.6215995),
c(0.7836032,0.6030488),
c(0.80521,0.5839412),
c(0.8236391,0.5643522),
c(0.8388176,0.544359))
mq4p <- rbind(c(0.8506857,0.5240405),
c(0.8591965,0.5034769),
c(0.8643165,0.4827494),
c(0.8660254,0.4619398),
c(0.8643165,0.4411301),
c(0.8591965,0.4204026),
c(0.8506857,0.3998391),
c(0.8388176,0.3795206),
c(0.8236391,0.3595273),
c(0.80521,0.3399383),
c(0.7836032,0.3208307),
c(0.7589039,0.3022801),
c(0.7312095,0.2843595),
c(0.7006293,0.2671398),
c(0.6672841,0.2506888),
c(0.6313054,0.2350716),
c(0.5928352,0.2203497),
c(0.5520254,0.2065812),
c(0.509037,0.1938206),
c(0.4640397,0.182118),
c(0.417211,0.1715198),
c(0.3687357,0.1620678),
c(0.3188053,0.1537992),
c(0.2676166,0.1467467),
c(0.2153718,0.1409382),
c(0.162277,0.1363964),
c(0.1085418,0.1331395),
c(0.05437823,0.1311802),
c(4.641012e-08,0.1305262),
c(-0.05437814,0.1311802),
c(-0.1085417,0.1331395),
c(-0.1622769,0.1363964),
c(-0.2153717,0.1409382),
c(-0.2676165,0.1467467),
c(-0.3188052,0.1537992),
c(-0.3687356,0.1620678),
c(-0.4172109,0.1715198),
c(-0.4640396,0.182118),
c(-0.5090369,0.1938205),
c(-0.5520253,0.2065812),
c(-0.5928351,0.2203496),
c(-0.6313053,0.2350715),
c(-0.667284,0.2506888),
c(-0.7006292,0.2671397),
c(-0.7312094,0.2843595),
c(-0.7589038,0.30228),
c(-0.7836032,0.3208307),
c(-0.80521,0.3399383),
c(-0.8236391,0.3595273),
c(-0.8388176,0.3795205),
c(-0.8506857,0.399839),
c(-0.8591965,0.4204026),
c(-0.8643165,0.4411301),
c(-0.8660254,0.4619397),
c(-0.8643165,0.4827494),
c(-0.8591965,0.5034769),
c(-0.8506857,0.5240404))
mq5m <- rbind(c(-0.873215,0.4866767),
c(-0.8983527,0.4360888),
c(-0.919945,0.3837799),
c(-0.9379066,0.3299563),
c(-0.9521668,0.2748306),
c(-0.9626692,0.2186202),
c(-0.9693724,0.1615471),
c(-0.97225,0.1038364),
c(-0.9712905,0.04571585),
c(-0.9664977,-0.01258507),
c(-0.9578907,-0.07083633),
c(-0.9455033,-0.128808),
c(-0.9293844,-0.1862714),
c(-0.9095977,-0.2429996),
c(-0.8862212,-0.2987688),
c(-0.8593471,-0.3533589),
c(-0.8290817,-0.4065545),
c(-0.7955442,-0.4581456),
c(-0.7588671,-0.5079286),
c(-0.7191951,-0.555707),
c(-0.6766847,-0.6012923),
c(-0.6315038,-0.6445046),
c(-0.5838306,-0.6851733),
c(-0.5338533,-0.723138),
c(-0.4817692,-0.7582487),
c(-0.4277837,-0.790367),
c(-0.3721099,-0.8193661),
c(-0.3149676,-0.8451315),
c(-0.2565823,-0.8675616),
c(-0.1971843,-0.8865678),
c(-0.1370082,-0.902075),
c(-0.07629134,-0.9140223),
c(-0.0152734,-0.9223623),
c(0.04580482,-0.9270622),
c(0.1067023,-0.9281034),
c(0.1671786,-0.9254818),
c(0.2269952,-0.9192077),
c(0.2859159,-0.9093059),
c(0.3437082,-0.8958155),
c(0.4001441,-0.8787898),
c(0.4550008,-0.8582958),
c(0.5080618,-0.8344146),
c(0.5591177,-0.8072403),
c(0.6079671,-0.7768802),
c(0.654417,-0.7434541),
c(0.6982844,-0.707094),
c(0.7393958,-0.6679432),
c(0.7775893,-0.6261564),
c(0.8127139,-0.5818984),
c(0.8446311,-0.535344))
mq5p <- rbind(c(0.873215,-0.4866768),
c(0.8983526,-0.4360889),
c(0.919945,-0.3837798),
c(0.9379066,-0.3299563),
c(0.9521668,-0.2748305),
c(0.9626692,-0.2186202),
c(0.9693724,-0.161547),
c(0.97225,-0.1038363),
c(0.9712905,-0.0457158),
c(0.9664977,0.01258512),
c(0.9578907,0.07083638),
c(0.9455033,0.1288081),
c(0.9293844,0.1862714),
c(0.9095976,0.2429997),
c(0.8862211,0.2987689),
c(0.8593471,0.353359),
c(0.8290817,0.4065546),
c(0.7955442,0.4581456),
c(0.758867,0.5079286),
c(0.719195,0.555707),
c(0.6766847,0.6012924),
c(0.6315038,0.6445046),
c(0.5838306,0.6851733),
c(0.5338533,0.723138),
c(0.4817691,0.7582487),
c(0.4277836,0.790367),
c(0.3721099,0.8193661),
c(0.3149676,0.8451315),
c(0.2565822,0.8675616),
c(0.1971843,0.8865678),
c(0.1370081,0.902075),
c(0.07629129,0.9140223),
c(0.01527335,0.9223623),
c(-0.04580487,0.9270622),
c(-0.1067023,0.9281034),
c(-0.1671787,0.9254817),
c(-0.2269952,0.9192077),
c(-0.2859159,0.9093059),
c(-0.3437083,0.8958155),
c(-0.4001442,0.8787898),
c(-0.4550008,0.8582958),
c(-0.5080619,0.8344146),
c(-0.5591178,0.8072403),
c(-0.6079671,0.7768802),
c(-0.6544171,0.743454),
c(-0.6982844,0.7070939),
c(-0.7393959,0.6679432),
c(-0.7775893,0.6261563),
c(-0.812714,0.5818984),
c(-0.8446311,0.5353439))
mq6m <- rbind(c(-0.5058319,0.861663),
c(-0.5444786,0.8347146),
c(-0.5809764,0.8044718),
c(-0.6151813,0.7710542),
c(-0.6469585,0.7345936),
c(-0.6761824,0.6952339),
c(-0.7027377,0.6531304),
c(-0.7265196,0.6084493),
c(-0.7474342,0.5613669),
c(-0.7653991,0.512069),
c(-0.7803434,0.4607503),
c(-0.7922079,0.4076132),
c(-0.800946,0.3528674),
c(-0.8065231,0.2967291),
c(-0.8089172,0.2394196),
c(-0.8081189,0.1811653),
c(-0.8041313,0.122196),
c(-0.7969702,0.0627445),
c(-0.7866638,0.003045333),
c(-0.7732528,-0.05666585),
c(-0.7567902,-0.1161534),
c(-0.7373408,-0.1751825),
c(-0.7149815,-0.2335203),
c(-0.6898004,-0.2909365),
c(-0.6618971,-0.3472045),
c(-0.6313815,-0.4021022),
c(-0.5983742,-0.455413),
c(-0.5630053,-0.5069265),
c(-0.5254146,-0.5564394),
c(-0.4857502,-0.6037563),
c(-0.4441688,-0.6486905),
c(-0.4008345,-0.6910645),
c(-0.3559183,-0.7307112),
c(-0.3095975,-0.7674742),
c(-0.2620548,-0.8012083),
c(-0.2134778,-0.8317804),
c(-0.1640584,-0.8590698),
c(-0.1139916,-0.8829689),
c(-0.06347481,-0.9033833),
c(-0.01270755,-0.9202324),
c(0.03810985,-0.9334498),
c(0.08877686,-0.9429833),
c(0.1390935,-0.9487953),
c(0.1888612,-0.9508629),
c(0.2378836,-0.9491778),
c(0.2859671,-0.9437467),
c(0.3329221,-0.9345911),
c(0.3785631,-0.9217471),
c(0.4227102,-0.9052654),
c(0.465189,-0.885211))
mq6p <- rbind(c(0.5058319,-0.8616631),
c(0.5444785,-0.8347146),
c(0.5809763,-0.8044719),
c(0.6151813,-0.7710542),
c(0.6469584,-0.7345936),
c(0.6761823,-0.6952339),
c(0.7027376,-0.6531304),
c(0.7265196,-0.6084493),
c(0.7474342,-0.5613669),
c(0.7653992,-0.512069),
c(0.7803434,-0.4607503),
c(0.7922079,-0.4076132),
c(0.800946,-0.3528674),
c(0.8065231,-0.296729),
c(0.8089172,-0.2394196),
c(0.8081189,-0.1811653),
c(0.8041313,-0.122196),
c(0.7969702,-0.06274444),
c(0.7866638,-0.003045282),
c(0.7732528,0.0566659),
c(0.7567901,0.1161534),
c(0.7373408,0.1751826),
c(0.7149814,0.2335204),
c(0.6898004,0.2909365),
c(0.661897,0.3472045),
c(0.6313815,0.4021023),
c(0.5983741,0.4554131),
c(0.5630053,0.5069266),
c(0.5254145,0.5564395),
c(0.4857502,0.6037564),
c(0.4441688,0.6486905),
c(0.4008345,0.6910645),
c(0.3559183,0.7307113),
c(0.3095974,0.7674742),
c(0.2620547,0.8012083),
c(0.2134778,0.8317804),
c(0.1640584,0.8590698),
c(0.1139915,0.8829689),
c(0.06347476,0.9033833),
c(0.01270751,0.9202324),
c(-0.0381099,0.9334498),
c(-0.0887769,0.9429833),
c(-0.1390935,0.9487953),
c(-0.1888612,0.9508629),
c(-0.2378836,0.9491778),
c(-0.2859671,0.9437467),
c(-0.3329221,0.9345911),
c(-0.3785632,0.921747),
c(-0.4227102,0.9052654),
c(-0.465189,0.885211))
mq7m <- rbind(c(-0.2444927,0.9691744),
c(-0.2730048,0.9582235),
c(-0.3004394,0.943491),
c(-0.3266884,0.9250349),
c(-0.3516481,0.9029281),
c(-0.37522,0.877258),
c(-0.397311,0.8481256),
c(-0.4178341,0.8156461),
c(-0.4367082,0.7799476),
c(-0.4538587,0.741171),
c(-0.4692181,0.6994694),
c(-0.4827258,0.6550072),
c(-0.4943283,0.6079601),
c(-0.5039799,0.5585136),
c(-0.5116425,0.5068629),
c(-0.517286,0.4532119),
c(-0.5208879,0.3977722),
c(-0.5224341,0.3407627),
c(-0.5219186,0.2824084),
c(-0.5193432,0.2229395),
c(-0.5147183,0.1625908),
c(-0.5080619,0.1016005),
c(-0.4994005,0.04020912),
c(-0.4887682,-0.02134091),
c(-0.476207,-0.08280672),
c(-0.4617663,-0.1439457),
c(-0.4455033,-0.2045166),
c(-0.4274821,-0.2642804),
c(-0.4077738,-0.3230012),
c(-0.3864562,-0.3804473),
c(-0.3636135,-0.4363919),
c(-0.3393357,-0.4906142),
c(-0.3137188,-0.5429004),
c(-0.2868637,-0.5930439),
c(-0.2588765,-0.640847),
c(-0.2298676,-0.686121),
c(-0.1999516,-0.7286871),
c(-0.1692464,-0.7683774),
c(-0.1378733,-0.8050353),
c(-0.1059561,-0.8385162),
c(-0.07362074,-0.8686877),
c(-0.04099481,-0.895431),
c(-0.008207093,-0.9186404),
c(0.02461301,-0.9382243),
c(0.05733598,-0.9541055),
c(0.08983267,-0.9662213),
c(0.1219748,-0.9745238),
c(0.1536356,-0.9789804),
c(0.1846901,-0.9795733),
c(0.2150156,-0.9763004))
mq7p <- rbind(c(0.2444926,-0.9691744),
c(0.2730047,-0.9582235),
c(0.3004394,-0.943491),
c(0.3266884,-0.925035),
c(0.3516481,-0.9029282),
c(0.37522,-0.877258),
c(0.397311,-0.8481256),
c(0.4178341,-0.8156461),
c(0.4367082,-0.7799476),
c(0.4538587,-0.741171),
c(0.4692181,-0.6994694),
c(0.4827257,-0.6550073),
c(0.4943283,-0.60796),
c(0.5039799,-0.5585136),
c(0.5116426,-0.5068629),
c(0.517286,-0.4532118),
c(0.5208879,-0.3977722),
c(0.5224341,-0.3407627),
c(0.5219186,-0.2824083),
c(0.5193432,-0.2229395),
c(0.5147182,-0.1625908),
c(0.5080619,-0.1016004),
c(0.4994005,-0.04020906),
c(0.4887682,0.02134097),
c(0.4762069,0.08280677),
c(0.4617663,0.1439458),
c(0.4455033,0.2045167),
c(0.4274821,0.2642805),
c(0.4077738,0.3230013),
c(0.3864562,0.3804473),
c(0.3636135,0.4363919),
c(0.3393357,0.4906143),
c(0.3137187,0.5429004),
c(0.2868637,0.593044),
c(0.2588765,0.640847),
c(0.2298676,0.686121),
c(0.1999516,0.7286871),
c(0.1692464,0.7683775),
c(0.1378733,0.8050354),
c(0.1059561,0.8385162),
c(0.07362071,0.8686877),
c(0.04099478,0.895431),
c(0.008207065,0.9186404),
c(-0.02461304,0.9382243),
c(-0.05733601,0.9541055),
c(-0.0898327,0.9662213),
c(-0.1219749,0.9745238),
c(-0.1536356,0.9789804),
c(-0.1846901,0.9795733),
c(-0.2150157,0.9763004))
mq8m <- rbind(c(-0.06437504,0.9975677),
c(-0.07320037,0.9933573),
c(-0.0817368,0.9852266),
c(-0.08995066,0.9732076),
c(-0.09780953,0.9573479),
c(-0.1052824,0.9377099),
c(-0.1123397,0.9143712),
c(-0.1189537,0.8874239),
c(-0.1250983,0.8569744),
c(-0.1307491,0.8231427),
c(-0.1358839,0.7860625),
c(-0.1404825,0.74588),
c(-0.1445266,0.702754),
c(-0.1480004,0.6568544),
c(-0.1508901,0.6083626),
c(-0.1531842,0.5574698),
c(-0.1548739,0.504377),
c(-0.1559523,0.4492936),
c(-0.1564152,0.392437),
c(-0.1562609,0.3340317),
c(-0.1554898,0.2743081),
c(-0.1541051,0.213502),
c(-0.1521122,0.1518532),
c(-0.149519,0.08960517),
c(-0.1463357,0.02700349),
c(-0.1425749,-0.03570476),
c(-0.1382515,-0.0982721),
c(-0.1333824,-0.1604516),
c(-0.1279869,-0.2219979),
c(-0.1220863,-0.282668),
c(-0.1157038,-0.3422226),
c(-0.1088648,-0.4004266),
c(-0.1015961,-0.4570503),
c(-0.09392646,-0.5118702),
c(-0.08588613,-0.56467),
c(-0.07750685,-0.6152413),
c(-0.06882168,-0.6633846),
c(-0.05986491,-0.7089097),
c(-0.05067188,-0.7516372),
c(-0.04127886,-0.7913982),
c(-0.03172294,-0.828036),
c(-0.02204183,-0.8614058),
c(-0.01227372,-0.8913761),
c(-0.002457179,-0.9178286),
c(0.007369062,-0.9406588),
c(0.01716622,-0.9597767),
c(0.02689563,-0.9751067),
c(0.0365189,-0.9865885),
c(0.04599804,-0.9941766),
c(0.05529565,-0.9978412))
mq8p <- rbind(c(0.06437504,-0.9975677),
c(0.07320036,-0.9933573),
c(0.0817368,-0.9852266),
c(0.08995066,-0.9732077),
c(0.09780952,-0.9573479),
c(0.1052824,-0.93771),
c(0.1123397,-0.9143712),
c(0.1189537,-0.887424),
c(0.1250983,-0.8569744),
c(0.1307491,-0.8231427),
c(0.1358839,-0.7860625),
c(0.1404825,-0.7458801),
c(0.1445266,-0.702754),
c(0.1480004,-0.6568544),
c(0.1508901,-0.6083626),
c(0.1531842,-0.5574698),
c(0.1548739,-0.5043769),
c(0.1559523,-0.4492935),
c(0.1564152,-0.392437),
c(0.1562609,-0.3340317),
c(0.1554898,-0.2743081),
c(0.1541051,-0.2135019),
c(0.1521122,-0.1518532),
c(0.149519,-0.08960512),
c(0.1463357,-0.02700344),
c(0.1425749,0.03570481),
c(0.1382514,0.09827215),
c(0.1333824,0.1604517),
c(0.1279869,0.2219979),
c(0.1220863,0.2826681),
c(0.1157038,0.3422227),
c(0.1088648,0.4004267),
c(0.1015961,0.4570503),
c(0.09392645,0.5118703),
c(0.08588612,0.5646701),
c(0.07750684,0.6152414),
c(0.06882167,0.6633846),
c(0.0598649,0.7089098),
c(0.05067187,0.7516372),
c(0.04127886,0.7913982),
c(0.03172294,0.828036),
c(0.02204182,0.8614059),
c(0.01227371,0.8913762),
c(0.002457171,0.9178286),
c(-0.00736907,0.9406588),
c(-0.01716623,0.9597767),
c(-0.02689564,0.9751067),
c(-0.03651891,0.9865885),
c(-0.04599805,0.9941766),
c(-0.05529566,0.9978412))


lines(mp1p[,1],mp1p[,2])
lines(mp2p[,1],mp2p[,2])
lines(mp3p[,1],mp3p[,2])
lines(mp4p[,1],mp4p[,2])
lines(mp5p[,1],mp5p[,2])
lines(mq1p[,1],mq1p[,2])
lines(mq2p[,1],mq2p[,2])
lines(mq3p[,1],mq3p[,2])
lines(mq4p[,1],mq4p[,2])
lines(mq5p[,1],mq5p[,2])
lines(mq6p[,1],mq6p[,2])
lines(mq7p[,1],mq7p[,2])
lines(mq8p[,1],mq8p[,2])
for(i in 1:p) {if (load[i,1]>=0) symbols(x=load[i,2], y=load[i,3], circles=0.015, inches=FALSE, add=TRUE,fg="red",bg="red")}
for(i in 1:p) {if (load[i,1]>=0) text(x=load[i,2],y=load[i,3]-0.05,labels=names[i],cex=cx)}
plot(cos((1:201)*pi/100),sin((1:201)*pi/100),type="l",axes=FALSE,frame.plot=FALSE,ann=FALSE,xlim=c(-1,1),ylim=c(-1,1))
lines(mp1m[,1],mp1m[,2])
lines(mp2m[,1],mp2m[,2])
lines(mp3m[,1],mp3m[,2])
lines(mp4m[,1],mp4m[,2])
lines(mp5m[,1],mp5m[,2])
lines(-mq1m[,1],mq1m[,2])
lines(-mq2m[,1],mq2m[,2])
lines(-mq3m[,1],mq3m[,2])
lines(-mq4m[,1],mq4m[,2])
lines(-mq5m[,1],mq5m[,2])
lines(-mq6m[,1],mq6m[,2])
lines(-mq7m[,1],mq7m[,2])
lines(-mq8m[,1],mq8m[,2])
for(i in 1:p) {if (load[i,1]<=0) symbols(x=load[i,2], y=load[i,3], circles=0.015, inches=FALSE, add=TRUE,fg="red",bg="red")}
for(i in 1:p) {if (load[i,1]<=0) text(x=load[i,2],y=load[i,3]-0.05,labels=names[i],cex=cx)}
}

if ((nbsphere!=2) & (back==TRUE))
{
par(mfrow=c(1,1))
par(pty="s")
par(oma=c(0,0,0,0))
par(mar=c(0,0,0,0))
plot(cos((1:201)*pi/100),sin((1:201)*pi/100),type="l",axes=FALSE,frame.plot=FALSE,ann=FALSE,xlim=c(-1,1),ylim=c(-1,1))
lines(mp1p[,1],mp1p[,2])
lines(mp2p[,1],mp2p[,2])
lines(mp3p[,1],mp3p[,2])
lines(mp4p[,1],mp4p[,2])
lines(mp5p[,1],mp5p[,2])
lines(mq1p[,1],mq1p[,2])
lines(mq2p[,1],mq2p[,2])
lines(mq3p[,1],mq3p[,2])
lines(mq4p[,1],mq4p[,2])
lines(mq5p[,1],mq5p[,2])
lines(mq6p[,1],mq6p[,2])
lines(mq7p[,1],mq7p[,2])
lines(mq8p[,1],mq8p[,2])
lines(mp1m[,1],mp1m[,2],lty=3)
lines(mp2m[,1],mp2m[,2],lty=3)
lines(mp3m[,1],mp3m[,2],lty=3)
lines(mp4m[,1],mp4m[,2],lty=3)
lines(mp5m[,1],mp5m[,2],lty=3)
lines(-mq1m[,1],mq1m[,2],lty=3)
lines(-mq2m[,1],mq2m[,2],lty=3)
lines(-mq3m[,1],mq3m[,2],lty=3)
lines(-mq4m[,1],mq4m[,2],lty=3)
lines(-mq5m[,1],mq5m[,2],lty=3)
lines(-mq6m[,1],mq6m[,2],lty=3)
lines(-mq7m[,1],mq7m[,2],lty=3)
lines(-mq8m[,1],mq8m[,2],lty=3)
for(i in 1:p) {if (load[i,1]>=0) symbols(x=load[i,2], y=load[i,3], circles=0.015, inches=FALSE, add=TRUE,fg="red",bg="red")}
for(i in 1:p) {if (load[i,1]>=0) text(x=load[i,2],y=load[i,3]-0.05,labels=names[i],cex=cx)}
for(i in 1:p) {if (load[i,1]<=0) symbols(x=load[i,2], y=load[i,3], circles=0.015, inches=FALSE, add=TRUE,fg="blue",bg="white")}
for(i in 1:p) {if (load[i,1]<=0) text(x=load[i,2],y=load[i,3]-0.05,labels=names[i],cex=cx)}
}

if ((nbsphere!=2) & (back==FALSE))
{
par(mfrow=c(1,1))
par(pty="s")
par(oma=c(0,0,0,0))
par(mar=c(0,0,0,0))
plot(cos((1:201)*pi/100),sin((1:201)*pi/100),type="l",axes=FALSE,frame.plot=FALSE,ann=FALSE,xlim=c(-1,1),ylim=c(-1,1))
lines(mp1p[,1],mp1p[,2])
lines(mp2p[,1],mp2p[,2])
lines(mp3p[,1],mp3p[,2])
lines(mp4p[,1],mp4p[,2])
lines(mp5p[,1],mp5p[,2])
lines(mq1p[,1],mq1p[,2])
lines(mq2p[,1],mq2p[,2])
lines(mq3p[,1],mq3p[,2])
lines(mq4p[,1],mq4p[,2])
lines(mq5p[,1],mq5p[,2])
lines(mq6p[,1],mq6p[,2])
lines(mq7p[,1],mq7p[,2])
lines(mq8p[,1],mq8p[,2])
for(i in 1:p) {if (load[i,1]>=0) symbols(x=load[i,2], y=load[i,3], circles=0.015, inches=FALSE, add=TRUE,fg="red",bg="red")}
for(i in 1:p) {if (load[i,1]>=0) text(x=load[i,2],y=load[i,3]-0.05,labels=names[i],cex=cx)}
for(i in 1:p) {if (load[i,1]<=0) symbols(x=load[i,2], y=load[i,3], circles=0.015, inches=FALSE, add=TRUE,fg="blue",bg="white")}
for(i in 1:p) {if (load[i,1]<=0) text(x=load[i,2],y=load[i,3]-0.05,labels=names[i],cex=cx)}
}
}
"wkappa" <-
function(r,weights="squared") 
{
    r <- na.omit(r)
    r1 <- r[, 1]
    r2 <- r[, 2]
    n1 <- as.character(r1)
    n2 <- as.character(r2)
    lev <- levels(as.factor(c(n1, n2)))
    p <- length(lev)
    if (weights != "squared") weights <- "absolute"
    tab <- matrix(nrow = p, ncol = p)
    weight <- matrix(nrow = p, ncol = p)	
    dimnames(tab) <- list(levels(as.factor(c(n1, n2))), levels(as.factor(c(n1, n2))))
    dim1 <- dimnames(tab)[[1]]
    dim2 <- dimnames(tab)[[2]]
    tabi <- table(n1, n2)
    dimi1 <- dimnames(tabi)[[1]]
    dimi2 <- dimnames(tabi)[[2]]
    for (i in 1:p) for (j in 1:p)
    {
        if ((sum(dim1[i] == dimi1) == 1) & (sum(dim2[j] == dimi2) == 1)) tab[i, j] <- tabi[dim1[i], dim2[j]]
        else tab[i, j] <- 0
	if (weights == "squared") weight[i,j] <- 1 - (i - j)^2/(p - 1)^2
        else weight[i,j] <- 1 - abs(i - j)/abs(p - 1)
    }
    tsum <- sum(tab)
    ttab <- tab/tsum
    agreeP <- sum(ttab*weight)
    tm1 <- apply(ttab, 1, sum)
    tm2 <- apply(ttab, 2, sum)
    ttabchance <- tm1%*%t(tm2)
    chanceP <- sum(ttabchance*weight)
    kappa2 <- (agreeP - chanceP)/(1 - chanceP)
    result <- list(table = tab, weights=weights, kappa = kappa2)
    result
}
