n <- 3
p <- 2
Datos <- matrix(c(6,9,10,6,8,3),nrow=3,byrow=T)
Datos
## [,1] [,2]
## [1,] 6 9
## [2,] 10 6
## [3,] 8 3
S <- cov(Datos)
S
## [,1] [,2]
## [1,] 4 -3
## [2,] -3 9
# Matriz de covarianza fija
Sigma0 <- matrix(c(4,0,0,9),ncol=2)
Sigma0
## [,1] [,2]
## [1,] 4 0
## [2,] 0 9
# Calculamos el estadístico de prueba
Propios <- eigen(S%*%solve(Sigma0))
val_prop <- Propios$values
val_prop
## [1] 1.5 0.5
lambda_0 <- -(n-1)*sum(log(val_prop))
lambda_0
## [1] 0.5753641
a <- 0.01
gl <- (1/2)*p*(p-1)
lambda_c <- qchisq(1-a,gl)
lambda_c
## [1] 6.634897
Conclusion
NO rechazamos hipotesis, por lo que en efecto, confirmamos con un 99% de confianza que las variables son independiente
n2 <- 4
p2 <- 2
Datos2 <- matrix(c(2,12,8,9,6,9,8,10),nrow=4,byro=T)
Datos2
## [,1] [,2]
## [1,] 2 12
## [2,] 8 9
## [3,] 6 9
## [4,] 8 10
S2 <- cov(Datos2)
S2
## [,1] [,2]
## [1,] 8.000000 -3.333333
## [2,] -3.333333 2.000000
sigma_est2 <- sum(diag(S2))/p2
lambda_02 <- (n2-1)*(log(sigma_est2)-log(det(S2)))
lambda_02
## [1] 0.06741857
a2 <- 0.03
gl2 <- (1/2)*(p2+2)*(p2-1)
lambda_c2 <- qchisq(1-a2,gl2)
lambda_c2
## [1] 7.013116
Conclusion
NO rechazamos hipotesis, con un 97% de confianza confirmamos que las variables son independientes con igual matriz de covarianza (Esfericidad).
p3 <- 3; q3 <- 2
na <- 10; nb <- 10; N <- na+nb
v1 <- na-1; v2 <- nb-1; v <- N-q3
Datos3a <- matrix(c(3.7,48.5,9.3,5.7,65.1,8,3.8,47.2,10.9,3.2,53.2,12,3.1,55.5,9.7,4.6,36.1,7.9,2.4, 24.8,14,7.2,33.1,7.6,6.7,47.4,8.5,5.4,54.1,11.3),nrow=10,byrow=T)
Datos3a
## [,1] [,2] [,3]
## [1,] 3.7 48.5 9.3
## [2,] 5.7 65.1 8.0
## [3,] 3.8 47.2 10.9
## [4,] 3.2 53.2 12.0
## [5,] 3.1 55.5 9.7
## [6,] 4.6 36.1 7.9
## [7,] 2.4 24.8 14.0
## [8,] 7.2 33.1 7.6
## [9,] 6.7 47.4 8.5
## [10,] 5.4 54.1 11.3
Datos3b <- matrix(c(6.9,66.9,6.7,6.5,58.8,5.3,7.5, 47.8,3.8,8.5,40.2,2.4,9.5,43.5,3.1,8.5,56.4,7.1,6.5,71.6,5.2,6.5,72.8,3.9,7.1,64.1,4.2,9.5,40.9,3.4),nrow=10,byrow=T)
Datos3b
## [,1] [,2] [,3]
## [1,] 6.9 66.9 6.7
## [2,] 6.5 58.8 5.3
## [3,] 7.5 47.8 3.8
## [4,] 8.5 40.2 2.4
## [5,] 9.5 43.5 3.1
## [6,] 8.5 56.4 7.1
## [7,] 6.5 71.6 5.2
## [8,] 6.5 72.8 3.9
## [9,] 7.1 64.1 4.2
## [10,] 9.5 40.9 3.4
Sa <- cov(Datos3a)
Sa
## [,1] [,2] [,3]
## [1,] 2.612889 1.787778 -2.422889
## [2,] 1.787778 143.724444 -5.726667
## [3,] -2.422889 -5.726667 4.381778
Sb <- cov(Datos3b)
Sb
## [,1] [,2] [,3]
## [1,] 1.4577778 -12.90889 -0.7355556
## [2,] -12.9088889 157.58444 10.9633333
## [3,] -0.7355556 10.96333 2.3610000
Sp <- (1/v)*(v1*Sa+v2*Sb)
Sp
## [,1] [,2] [,3]
## [1,] 2.035333 -5.560556 -1.579222
## [2,] -5.560556 150.654444 2.618333
## [3,] -1.579222 2.618333 3.371389
lambda3 <- v*log(det(Sp))-(v1*log(det(Sa))+v2*log(det(Sb)))
round(lambda3,2)
## [1] 13.97
rho <- 1-((2*p3^2+3*p3-1)/(6*(p3+1)))*(((1/v1)+(1/v2))-(1/v))
round
## function (x, digits = 0) .Primitive("round")
rho
## [1] 0.8194444
phi_0 <- lambda3*rho
round(phi_0,2)
## [1] 11.45
a3 <- 0.01
gl3 <- (1/2)*p3*(p3+1)*(q3-1)
phi_c3 <- qchisq(1-a3,gl3)
round(phi_c3,2)
## [1] 16.81
Conclusion
No rechazamos hipotesis nula, afirmamos con un 99% de confianza que la matriz de covarianza de ambas poblaciones, hombres y mujeres es similar.