Se presentan los ejericios propuestos durante el curso de Métodos Multivariados del primer semestre de 2020.
Los ejercicios desarrollados pertencen a los siguientes temas:
Punto 1
#a
install.packages("plot3D")
## Installing package into '/home/rstudio-user/R/x86_64-pc-linux-gnu-library/3.6'
## (as 'lib' is unspecified)
library("plot3D")
xt=c(5, 1, 3)
yt=c(-1, 3, 1)
m <- cbind(xt, yt)
arrows3D(x0 = c(0,0), y0 = c(0,0), z0 = c(0,0), x1 =m[1,], y1 = m[2,], z1 = m[3,], col = c("green", "blue"), lwd = 2, d = 3, main = "Vectors 3D", bty ="g", ticktype = "detailed")
text3D(m[1,], m[2,], m[3,], c("xt", "yt"), col = c("black", "black"), add=TRUE, colkey = FALSE)
#b
x <- t(xt)
y <- t(yt)
l <- sqrt(sum(x*x)); norm(x, type = "2")
## [1] 5.91608
l <- sqrt(sum(y*y)); norm(x, type = "2")
## [1] 5.91608
angulo = function(u, v){
prod.punto=t(u)%*%v; prod.punto
norma.u <- norm(u, type = "2"); norma.u
norma.v <- norm(v, type = "2"); norma.v
phi <- acos(prod.punto / (norma.u * norma.v)); phi
}
angulo(xt,yt)
## [,1]
## [1,] 1.51981
#c
x1 <- x-3
y1 <- y-1
m1 <- rbind(x1, y1)
arrows3D(x0 = c(0,0), y0 = c(0,0), z0 = c(0,0), x1 =m1[,1], y1 = m1[,2], z1 = m1[,3], col = c("green", "blue"), lwd = 2, d = 3, main = "Vectors 3D", bty ="g", ticktype = "detailed")
text3D(m[1,], m[2,], m[3,], c("x1", "y1"), col = c("black", "black"), add=TRUE, colkey = FALSE)
2. t de Student y T de hotelling
El esparrago es un cultivo perenne que puede producir hasta por 15 años y su establecimiento es costoso. Dada la extensión del sistema radicular, la profundidad del suelo es fundamental, considerándose indispensable contar con un promedio mínimo de 80 centímetros de sustrato permeable. Se realizan 14 determinaciones de la profundidad del sustrato permeable (en cm) en puntos tomados al azar en dos campos (A y B).
\[Ho: \bar{x} - 80 cm = 0 \\ Ha: \bar{x} - 80 cm > 0\]
A <- c(72,78,86,78,90,104,76,70,83,75,90,81,85,72)
B <- c(86,90,76,76,82,89,93,81,83,97,108,98,90,83)
muestra <- gl(14, 1, 14, labels = paste0("m", 1:14))
dfAB <- data.frame(muestra, A, B)
summary(dfAB)
## muestra A B
## m1 :1 Min. : 70.00 Min. : 76.00
## m2 :1 1st Qu.: 75.25 1st Qu.: 82.25
## m3 :1 Median : 79.50 Median : 87.50
## m4 :1 Mean : 81.43 Mean : 88.00
## m5 :1 3rd Qu.: 85.75 3rd Qu.: 92.25
## m6 :1 Max. :104.00 Max. :108.00
## (Other):8
ptA <- t.test(x = A, mu = 0, alternative = 'g',conf.level = 0.95)
ptB <- t.test(x = B, mu = 0, alternative = 'g',conf.level = 0.95)
ptA$p.value
## [1] 2.965171e-14
ifelse(ptA$p.value<0.05,
'Rechazo Ho. Se tiene profundidad mayor a 80 cm en el campo A',
'No rechazo Ho, Se tiene profundidad menor a 80 cm en el campo A')
## [1] "Rechazo Ho. Se tiene profundidad mayor a 80 cm en el campo A"
ptB$p.value
## [1] 7.914533e-15
ifelse(ptB$p.value<0.05,
'Rechazo Ho. Se tiene profundidad mayor a 80 cm en el campo B',
'No rechazo Ho. Se tiene profundidad menor a 80 cm en el campo B')
## [1] "Rechazo Ho. Se tiene profundidad mayor a 80 cm en el campo B"
Al comparar dos muestras primero comparamos si se tiene varianzas iguales o varianzas desiguales.
\[H_o: \sigma^2_{A} = \sigma^2_{B} \\H_a: \sigma^2_{A} \ne \sigma^2_{B}\]
# ratio = 1, coceinte de varianzas == 1 (iguales)
pvar = var.test(x = dfAB$A, y = dfAB$B, ratio = 1, alternative = 't', conf.level = 0.95)
ifelse(pvar$p.value < 0.05,
'Rechazo Ho: var desiguales',
'No rechazo Ho: var iguales')
## [1] "No rechazo Ho: var iguales"
ptAB <- t.test(x = A, y= B, mu = 0, alternative = 't',conf.level = 0.95, var.equal = TRUE)
ptAB$p.value
## [1] 0.06621465
ifelse(ptAB$p.value<0.05,
'Rechazo Ho: Las medias no son oguales',
'No rechazo Ho: medias iguales')
## [1] "No rechazo Ho: medias iguales"
boxplot(A,B,names=c("Campo A","Campo B"))
medias <- c(mean(A),mean(B))
points(medias,pch=18,col="red")
Conclusión: