<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML><HEAD>
<META http-equiv=Content-Type content="text/html; charset=utf-8">
<META content="MSHTML 6.00.2900.3429" name=GENERATOR>
<STYLE></STYLE>
</HEAD>
<BODY bgColor=#ffffff>
<DIV><FONT face=Arial color=#0000ff><STRONG>Estava olhando a discussão, tentei
rodar a função e não consegui, como faço?</STRONG></FONT></DIV>
<DIV><FONT face=Arial size=2></FONT> </DIV>
<DIV><FONT face=Arial
size=2>sfericity.test<-function(n,s1,s2=NULL,estsigma=TRUE){<BR>+ ####
Performs a hypothesis test that a covariance matrix is of specified <BR>+ ####
form. Test is of the form H0: S1=sigma^2*S2. n is the number of<BR>+ ####
observations on which the sample covariance matrix is based.<BR>+ #### If the
input parameter estsigma is TRUE: <BR>+ #### Perform test of the hypothesis that
S1=sigma^2 S2, for unknown sigma. <BR>+ #### If S2 not specified, assumed that
S2=I. Reference is Basilevsky, <BR>+ #### Statistical Factor Analysis and
Related Methods, page 191. <BR>+ #### If the input parameter estsigma is FALSE:
<BR>+ #### Perform test of the hypothesis that S1=S2. If S2 not specified, <BR>+
#### assumed that S2=I. Reference is Seber, Multivariate Observations, <BR>+
#### sec 3.5.4 <BR>+ #### Only the lower triangle+diagonal is required at entry,
and the upper <BR>+ #### triangle is ignored. <BR>+ #### DAW July 2000<BR>+
dname <- paste(substitute(s1))<BR>+ p<-nrow(s1)<BR>+ for (i in
1:(p-1)){for (j in ((i+1):p)){<BR>+
s1[i,j]<-s1[j,i]<BR>+ s2[i,j]<-s2[j,i] }}<BR>+ if
(!is.null(s2)){<BR>+
b<-eigen(s2,symmetric=T,only.values=F)<BR>+
r<-b$vectors %*% diag(1/sqrt(b$values))<BR>+
s<-t(r) %*% s1 %*% r }<BR>+ else { s<-s1 }<BR>+ <BR>+
d<-eigen(s,symmetric=T,only.values=T)$values<BR>+ ldet<-sum(log(d))<BR>+
tr<-sum(d)<BR>+ <BR>+ if (estsigma==TRUE){<BR>+
sighat<-tr/p<BR>+
cc<--(n-(2*p^2+p+2)/(6*p))*(ldet-p*log(tr/p))<BR>+
statistic <- cc<BR>+
sighat<-sighat<BR>+ names(statistic) <- "L
statistic"<BR>+ parameter <-
0.5*(p+2)*(p-1)<BR>+ names(parameter) <-
"df"<BR>+
rval<-list(data.name=dname,sighat=sighat,statistic=statistic,parameter=parameter,p.value=1-pchisq(statistic,parameter),method="Sphericity
test") }<BR>+ else {<BR>+
cc<--n*(p+ldet-tr)<BR>+ statistic <-
cc<BR>+ names(statistic) <- "L
statistic"<BR>+ parameter <-
0.5*(p+1)*p<BR>+ names(parameter) <-
"df"<BR>+
rval<-list(data.name="",statistic=statistic,parameter=parameter,p.value=1-pchisq(statistic,parameter),method="Covariance
equality test statistic")<BR>+ }<BR>+ class(rval) <- "htest"<BR>+
return(rval)<BR>+ }<BR>> pw <- function(q,n) {<BR>+ pdf
<- function(w) { 1/2 * (n-2) * w^((n-3)/2) }<BR>+
integrate(pdf,0,q)<BR>+ }<BR>> <BR>> varcomp <-
function(covmat,n) {<BR>+ if (is.list(covmat))
{<BR>+ if (length(covmat) <
2)<BR>+ stop("covmat must be a
list with at least 2 elements")<BR>+ ps <-
as.vector(sapply(covmat,dim))<BR>+ if (sum(ps[1] == ps)
!= length(ps))<BR>+ stop("all
covariance matrices must have the same dimension")<BR>+
p <- ps[1]<BR>+ q <-
length(covmat)<BR>+ if
(length(n) == 1)<BR>+ Ng <-
rep(n,q)<BR>+ else if (length(n) ==
q)<BR>+ Ng <-
n<BR>+
else<BR>+ stop("n must be equal
length(covmat) or 1")<BR>+ <BR>+ DNAME <-
deparse(substitute(covmat))<BR>+ }<BR>+
<BR>+ else<BR>+ stop("covmat must be a
list")<BR>+ <BR>+ ng <- Ng - 1<BR>+
Ag <- lapply(1:length(covmat),function(i,mat,n) { n[i] * mat[[i]]
},mat=covmat,n=ng)<BR>+ A <-
matrix(colSums(matrix(unlist(Ag),ncol=p^2,byrow=T)),ncol=p)<BR>+
detAg <- sapply(Ag,det)<BR>+ detA <-
det(A)<BR>+ V1 <-
prod(detAg^(ng/2))/(detA^(sum(ng)/2))<BR>+ kg <-
ng/sum(ng)<BR>+ l1 <- prod((1/kg)^kg)^(p*sum(ng)/2) *
V1<BR>+ rho <- 1 - (sum(1/ng) -
1/sum(ng))*(2*p^2+3*p-1)/(6*(p+1)*(q-1))<BR>+ w2 <- p*(p+1)
* ((p-1)*(p+2) * (sum(1/ng^2) - 1/(sum(ng)^2)) - 6*(q-1)*(1-rho)^2) /
(48*rho^2)<BR>+ f <- 0.5 *
(q-1)*p*(p+1)<BR>+ STATISTIC <-
-2*rho*log(l1)<BR>+ PVAL <- 1 - (pchisq(STATISTIC,f) +
w2*(pchisq(STATISTIC,f+4) - pchisq(STATISTIC,f)))<BR>+
names(STATISTIC) <- "corrected lambda*"<BR>+ names(f) <-
"df"<BR>+ RVAL <- structure(list(statistic = STATISTIC,
parameter = f,p.value = PVAL, data.name = DNAME, method = "Equality of
Covariances Matrices Test"),class="htest")<BR>+
return(RVAL)<BR>+ }<BR>>
sphericity.test<-function(n,s1,s2=NULL,estsigma=TRUE){</FONT></DIV>
<DIV> </DIV>
<DIV><FONT face=Arial size=2>+ > <BR>> sphericity.test(10,2)<BR>Erro
em 1:(p - 1) : argumento de comprimento zero</FONT></DIV>
<BLOCKQUOTE
style="PADDING-RIGHT: 0px; PADDING-LEFT: 5px; MARGIN-LEFT: 5px; BORDER-LEFT: #000000 2px solid; MARGIN-RIGHT: 0px">
<DIV><FONT face=Arial size=2></FONT><BR></DIV>Michele,
<DIV><FONT face=Arial size=2></FONT><BR></DIV>
<DIV>Acho que você estava se referindo a função sphericiy.test que eu
implementei e fiz referẽncia em um material sobre ANOVA com medidas
repetidas.</DIV>
<DIV><FONT face=Arial size=2></FONT><BR></DIV>
<DIV>Deixei o código disponível aqui: <A
href="http://www.fernandohrosa.com.br/en/P/sphericity-test-for-covariance-matrices-in-r-sphericity-test/">http://www.fernandohrosa.com.br/en/P/sphericity-test-for-covariance-matrices-in-r-sphericity-test/</A></DIV>
<DIV><FONT face=Arial size=2></FONT><BR></DIV>
<DIV>Fernando,<BR><BR>.</DIV></BLOCKQUOTE></BODY></HTML>