library(readxl)
tortugas <- read_excel("F:/UNAL_MAESTRIA_UNAL/METODOS_MULTIVARIADOS/Trabajo2/datos.xlsx",
sheet = "Carapace_Measurements_ord")
data=data.frame(tortugas)
data_Female=subset(data,data$Genero!="Female")
data_Male=subset(data,data$Genero!="Male")
par(mfrow=c(1,2))
boxplot(data_Female[,1:3],ylab='Medida (mm)',main='Hembras', ylim = c(0, 180))
boxplot(data_Male[,1:3],ylab='Medida (mm)',main='Machos', ylim = c(0, 180))
A partir del grafico se puede sugerir que las medidas del caparazón de las tortugas son diferentes entre machos y hembras.
X1_F=tortugas[tortugas$Genero=="Female",1];X1_F=unlist(X1_F)
X1_M=tortugas[tortugas$Genero=="Male",1];X1_M=unlist(X1_M)
X2_F=tortugas[tortugas$Genero=="Female",2];X2_F=unlist(X2_F)
X2_M=tortugas[tortugas$Genero=="Male",2];X2_M=unlist(X2_M)
X3_F=tortugas[tortugas$Genero=="Female",3];X3_F=unlist(X3_F)
X3_M=tortugas[tortugas$Genero=="Male",3];X3_M=unlist(X3_M)
dX1=X1_F-X1_M
dX2=X2_F-X2_M
dX3=X3_F-X3_M
Prueba \(T^2\) de Hotelling para muestras pareadas.
\[H_0: \begin{bmatrix} \mu_{X1_F} \\\mu_{X2_F} \\ \mu_{X3_F} \end{bmatrix} = \begin{bmatrix} \mu_{X1_M} \\\mu_{X2_M} \\ \mu_{X3_M} \end{bmatrix}\] Diferencias entre variables
df1=data.frame(dX1,dX2,dX3)
df2=t(df1)
colnames(df2)=paste0("obs",1:24)
df2
## obs1 obs2 obs3 obs4 obs5 obs6 obs7 obs8 obs9 obs10 obs11 obs12 obs13 obs14
## dX1 5 9 7 4 7 20 19 27 26 21 21 22 22 21
## dX2 7 6 6 2 3 11 12 16 20 13 12 16 8 9
## dX3 1 3 7 3 6 13 7 12 13 11 8 9 8 10
## obs15 obs16 obs17 obs18 obs19 obs20 obs21 obs22 obs23 obs24
## dX1 24 28 29 33 34 30 31 31 31 42
## dX2 14 15 18 14 20 24 19 23 29 26
## dX3 12 16 15 12 21 15 17 18 15 20
Vector de media de diferencias
d=rowMeans(df2)
d=as.matrix(d);d
## [,1]
## dX1 22.66667
## dX2 14.29167
## dX3 11.33333
\[\bar d = \begin{bmatrix} \bar d_{x1} \\ \bar d_{x2} \\ \bar d_{x3} \end{bmatrix} =\begin{bmatrix} 22.67 \\ 14.29 \\ 11.33 \end{bmatrix}\] Matriz de varianzas y covarianzas de las diferencias medias
s_d=cov(df1);s_d #Matriz de varianzas y covarianzas de diff medias
## dX1 dX2 dX3
## dX1 101.71014 63.49275 49.07246
## dX2 63.49275 51.78080 32.07246
## dX3 49.07246 32.07246 28.49275
\[S_d=\begin{bmatrix} 101.71 & 63.49 & 49.07 \\ 63.49 &51.78 &32.07 \\49.07 & 32.07 &28.49 \end{bmatrix}\]
\(T^2\) Calculado
T2=24*t(d)%*%solve(s_d)%*%d;T2 #calculado
## [,1]
## [1,] 122.0209
\(T^2\) Tabulado
p=3
n=24
ftabla=qf(p = 0.05,df1 = 3,df2 = 21,lower.tail = F)
TT2=((p*(n-1))/(n-p))*ftabla;TT2 #tabulado
## [1] 10.09525
Se rechaza la hipotesis nula si \(T^2\) calculado es menor al \(T^2\) tabulado
ifelse(T2>TT2,"Rechazo Ho","No rechazo Ho")
## [,1]
## [1,] "Rechazo Ho"
De acuerdo con la prueba \(T^2\) y su comparación con \(T^2\) tabulado se rechaza la hipótesis nula. Por tanto, las medidas del caparazón de las tortugas son diferentes según el género.
¿Qué variable influye más en el rechazo de la hipótesis nula?
ICS<-function(d,T2,vari){
li=NULL
ls=NULL
for( i in 1:length(d)){
li[i]=d[i]-sqrt(T2)*sqrt(vari[i,i]/24)
ls[i]=d[i]+sqrt(T2)*sqrt(vari[i,i]/24)
}
return(list(li=li,ls=ls))
}
ICS(d,TT2,s_d)
## $li
## [1] 16.125804 9.624673 7.871389
##
## $ls
## [1] 29.20753 18.95866 14.79528
\[IC_{x1}=[16.13,29.20] \\IC_{x2}=[9.62,18.96]\\IC_{x3}=[7.87,14.79]\] La variable que más influye en el rechazo de la hipótesis es la variable X1. Por tanto, es la medida donde se presentan mayores diferencias entre machos y hembras.
Manova = manova(cbind(data$x1,data$x2,data$x3) ~ data$Genero)
summary(Manova, test = 'Wilks')
## Df Wilks approx F num Df den Df Pr(>F)
## data$Genero 1 0.38857 23.078 3 44 3.967e-09 ***
## Residuals 46
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
De acuerdo al resultado del manova las medidas del caparazón de las tortugas pintadas son diferentes para machos y hembras.
res = Manova$residuals; res
## [,1] [,2] [,3]
## 1 -38.04166667 -21.5833333 -14.0416667
## 2 -33.04166667 -18.5833333 -14.0416667
## 3 -33.04166667 -16.5833333 -10.0416667
## 4 -31.04166667 -16.5833333 -10.0416667
## 5 -27.04166667 -14.5833333 -8.0416667
## 6 -13.04166667 -10.5833333 -2.0416667
## 7 -13.04166667 -7.5833333 -6.0416667
## 8 -3.04166667 -3.5833333 -1.0416667
## 9 -3.04166667 -0.5833333 -1.0416667
## 10 -3.04166667 -0.5833333 -1.0416667
## 11 -2.04166667 -2.5833333 -4.0416667
## 12 -0.04166667 -0.5833333 -3.0416667
## 13 1.95833333 -4.5833333 -1.0416667
## 14 1.95833333 -3.5833333 -1.0416667
## 15 4.95833333 2.4166667 0.9583333
## 16 10.95833333 5.4166667 4.9583333
## 17 12.95833333 4.4166667 2.9583333
## 18 16.95833333 4.4166667 3.9583333
## 19 18.95833333 12.4166667 10.9583333
## 20 18.95833333 14.4166667 7.9583333
## 21 21.95833333 12.4166667 9.9583333
## 22 22.95833333 15.4166667 10.9583333
## 23 25.95833333 21.4166667 8.9583333
## 24 40.95833333 29.4166667 14.9583333
## 25 -20.37500000 -14.2916667 -3.7083333
## 26 -19.37500000 -10.2916667 -5.7083333
## 27 -17.37500000 -8.2916667 -5.7083333
## 28 -12.37500000 -4.2916667 -1.7083333
## 29 -11.37500000 -3.2916667 -2.7083333
## 30 -10.37500000 -7.2916667 -3.7083333
## 31 -9.37500000 -5.2916667 -1.7083333
## 32 -7.37500000 -5.2916667 -1.7083333
## 33 -6.37500000 -6.2916667 -2.7083333
## 34 -1.37500000 0.7083333 -0.7083333
## 35 -0.37500000 -0.2916667 -0.7083333
## 36 0.62500000 -2.2916667 -0.7083333
## 37 2.62500000 1.7083333 2.2916667
## 38 3.62500000 1.7083333 0.2916667
## 39 3.62500000 2.7083333 0.2916667
## 40 5.62500000 4.7083333 0.2916667
## 41 6.62500000 0.7083333 -0.7083333
## 42 6.62500000 4.7083333 3.2916667
## 43 7.62500000 6.7083333 1.2916667
## 44 11.62500000 4.7083333 4.2916667
## 45 13.62500000 7.7083333 4.2916667
## 46 14.62500000 6.7083333 4.2916667
## 47 17.62500000 6.7083333 5.2916667
## 48 21.62500000 17.7083333 6.2916667
royston::royston.test(res)
## $H
## [1] 0.5829341
##
## $p.value
## [1] 0.5588467
##
## $distribution
## [1] "Data analyzed have a normal distribution."
La prueba de normalidad de los residuales indica que siguen una distribución normal.