Ejercicio 1

1.- Se colectaron datos sobre la contaminación del aire en cierta ciudad. Suponer normalidad en los datos.

Determinar si el vector de media poblacional es \(\boldsymbol{\mu}_0^{\prime}=(8,74,5,2,10,9,3)\) con un nivel de significancia del \(5 \%\) incluir el p-valor.
Obtener IC simultáneos para las medias de cada componente, con un nivel de confianza global del \(95 \%\).
Obtener IC simultáneos para las diferencias de medias poblacionales (ignorando unidades) con un nivel de confianza global del \(95 \%\).
Obtener IC simultáneos para la media de cada componente, con un nivel de confianza global del \(95 \%\) usando el método de Bonferroni.

Inciso A

#A
D <- read.csv(file = 'C:/Users/Joel Rodarte/Desktop/datostarea4_Clean.csv')

alpha <- .05
n <- 42
p <- 7

#Lo que quiero probar 
miu0 <- matrix(c(8,74,5,2,10,9,3),ncol = 1,byrow = TRUE)

colMeans <- colMeans(D)
miu <- matrix(c(colMeans[1],colMeans[2],colMeans[3],colMeans[4],colMeans[5],colMeans[6],colMeans[7]),ncol = 1,byrow = TRUE)
cov <- cov(D)

#Estadístico de Prueba 
t2 <- n*(t(miu-miu0)) %*% solve(cov)%*% (miu-miu0)
fisher <- 2.28 # =F.INV(1-C6,C5,C4-C5)
crit <- ((n-1)*p)/(n-p)*fisher 
t2 > crit # TRUE, Rechazo H0, las medias son diferentes

##      [,1]
## [1,] TRUE

xpvalor <- ((n-p)*t2)/((n-1)*p)
pvalor <- 0.008404495493 #F.DIST.RT(F6,F5,F4-F5)
#Rechazo Ho

Inciso B

x1 <- sqrt((p*(n-1))/(n*(n-p))*fisher*cov[1,1])
x2 <- sqrt((p*(n-1))/(n*(n-p))*fisher*cov[2,2])
x3 <-  sqrt((p*(n-1))/(n*(n-p))*fisher*cov[3,3])
x4 <- sqrt((p*(n-1))/(n*(n-p))*fisher*cov[4,4])
x5 <-  sqrt((p*(n-1))/(n*(n-p))*fisher*cov[5,5])
x6 <- sqrt((p*(n-1))/(n*(n-p))*fisher*cov[6,6])
x7 <- sqrt((p*(n-1))/(n*(n-p))*fisher*cov[7,7])

ic1 <- cat(miu[1]-x1, "<"  , miu[1] , "<" , miu[1]+x1)

## 6.44508 < 7.5 < 8.55492

ic2 <- cat(miu[2]-x2, "<"  , miu[2] , "<" , miu[2]+x2)

## 62.29114 < 73.85714 < 85.42315

ic3 <- cat(miu[3]-x3, "<"  , miu[3] , "<" , miu[3]+x3)

## 3.724492 < 4.547619 < 5.370746

ic4 <- cat(miu[4]-x4, "<"  , miu[4] , "<" , miu[4]+x4)

## 1.465002 < 2.190476 < 2.91595

ic5 <- cat(miu[5]-x5, "<"  , miu[5] , "<" , miu[5]+x5)

## 7.798532 < 10.04762 < 12.29671

ic6 <- cat(miu[6]-x6, "<"  , miu[6] , "<" , miu[6]+x6)

## 5.691291 < 9.404762 < 13.11823

ic7 <- cat(miu[7]-x7, "<"  , miu[7] , "<" , miu[7]+x7)

## 2.633711 < 3.095238 < 3.556765

Inciso C

x12 <- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[1,1]-cov[1,2]+cov[2,2]))
x13 <- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[1,1]-cov[1,3]+cov[3,3]))
x14<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[1,1]-cov[1,4]+cov[4,4]))
x15<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[1,1]-cov[1,5]+cov[5,5]))
x16<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[1,1]-cov[1,6]+cov[6,6]))
x17<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[1,1]-cov[1,7]+cov[7,7]))
x23<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[2,2]-cov[2,3]+cov[3,3]))
x24<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[2,2]-cov[2,4]+cov[4,4]))
x25<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[2,2]-cov[2,5]+cov[5,5]))
x26<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[2,2]-cov[2,6]+cov[6,6]))
x27<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[2,2]-cov[2,7]+cov[7,7]))
x34<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[3,3]-cov[3,4]+cov[4,4]))
x35<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[3,3]-cov[3,5]+cov[5,5]))
x36<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[3,3]-cov[3,6]+cov[6,6]))
x37<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[3,3]-cov[3,7]+cov[7,7]))
x45<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[4,4]-cov[4,5]+cov[5,5]))
x46<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[4,4]-cov[4,6]+cov[6,6]))
x47<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[4,4]-cov[4,7]+cov[7,7]))
x56<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[5,5]-cov[5,6]+cov[6,6]))
x57<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[5,5]-cov[5,7]+cov[7,7]))
x67<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[6,6]-cov[6,7]+cov[7,7]))


ic12 <- cat((miu[1]- miu[2])- x12, "<"  , miu[1]- miu[2] , "<" , (miu[1]- miu[2])+ x12)

## -78.02432 < -66.35714 < -54.68997

ic13<-  cat((miu[1]- miu[3])- x13, "<"  , miu[1]- miu[3] , "<" , (miu[1]- miu[3])+ x13)

## 1.552852 < 2.952381 < 4.35191

ic15<-  cat((miu[1]- miu[5])- x15, "<"  , miu[1]- miu[5] , "<" , (miu[1]- miu[5])+ x15)

## -5.083723 < -2.547619 < -0.01151512

ic16<-  cat((miu[1]- miu[6])- x16, "<"  , miu[1]- miu[6] , "<" , (miu[1]- miu[6])+ x16)

## -5.891759 < -1.904762 < 2.082236

ic17<-  cat((miu[1]- miu[7])- x17, "<"  , miu[1]- miu[7] , "<" , (miu[1]- miu[7])+ x17)

## 3.286789 < 4.404762 < 5.522735

ic23<-  cat((miu[2]- miu[3])- x23, "<"  , miu[2]- miu[3] , "<" , (miu[2]- miu[3])+ x23)

## 57.78955 < 69.30952 < 80.82949

ic24<-  cat((miu[2]- miu[4])- x24, "<"  , miu[2]- miu[4] , "<" , (miu[2]- miu[4])+ x24)

## 60.05133 < 71.66667 < 83.282

ic25<-  cat((miu[2]- miu[5])- x25, "<"  , miu[2]- miu[5] , "<" , (miu[2]- miu[5])+ x25)

## 52.15533 < 63.80952 < 75.46372

ic26<-  cat((miu[2]- miu[6])- x26, "<"  , miu[2]- miu[6] , "<" , (miu[2]- miu[6])+ x26)

## 52.88277 < 64.45238 < 76.02199

ic27<-  cat((miu[2]- miu[7])- x27, "<"  , miu[2]- miu[7] , "<" , (miu[2]- miu[7])+ x27)

## 59.1987 < 70.7619 < 82.32511

ic34<-  cat((miu[3]- miu[4])- x34, "<"  , miu[3]- miu[4] , "<" , (miu[3]- miu[4])+ x34)

## 1.406361 < 2.357143 < 3.307925

ic35<-  cat((miu[3]- miu[5])- x35, "<"  , miu[3]- miu[5] , "<" , (miu[3]- miu[5])+ x35)

## -7.669225 < -5.5 < -3.330775

ic36<-  cat((miu[3]- miu[6])- x36, "<"  , miu[3]- miu[6] , "<" , (miu[3]- miu[6])+ x36)

## -8.491883 < -4.857143 < -1.222403

ic37<-  cat((miu[3]- miu[7])- x37, "<"  , miu[3]- miu[7] , "<" , (miu[3]- miu[7])+ x37)

## 0.5427275 < 1.452381 < 2.362034

ic45<-  cat((miu[4]- miu[5])- x45, "<"  , miu[4]- miu[5] , "<" , (miu[4]- miu[5])+ x45)

## -10.11552 < -7.857143 < -5.598765

ic46<-  cat((miu[4]- miu[6])- x46, "<"  , miu[4]- miu[6] , "<" , (miu[4]- miu[6])+ x46)

## -11.04535 < -7.214286 < -3.383222

ic47<-  cat((miu[4]- miu[7])- x47, "<"  , miu[4]- miu[7] , "<" , (miu[4]- miu[7])+ x47)

## -1.717618 < -0.9047619 < -0.09190602

ic56<-  cat((miu[5]- miu[6])- x56, "<"  , miu[5]- miu[6] , "<" , (miu[5]- miu[6])+ x56)

## -3.535238 < 0.6428571 < 4.820952

ic57<-  cat((miu[5]- miu[7])- x57, "<"  , miu[5]- miu[7] , "<" , (miu[5]- miu[7])+ x57)

## 4.759982 < 6.952381 < 9.14478

ic67<-  cat((miu[6]- miu[7])- x67, "<"  , miu[6]- miu[7] , "<" , (miu[6]- miu[7])+ x67)

## 2.603021 < 6.309524 < 10.01603

Inciso D

alpha_prima = alpha/(2*p)
nc <- 1-alpha_prima #Nuevo nivel de confianza 

tval <- 3.091719983 #=TINV(C17,C14-1)

ic1 <- cat(miu[1]-tval*sqrt((cov[1,1]/n)), "<"  , miu[1] , "<" ,miu[1] + tval*sqrt((cov[1,1]/n)))

## 6.745698 < 7.5 < 8.254302

ic2 <- cat(miu[2]-tval*sqrt((cov[2,2]/n)), "<"  , miu[2] , "<" ,miu[2] + tval*sqrt((cov[2,2]/n)))

## 65.58707 < 73.85714 < 82.12721

ic3 <- cat(miu[3]-tval*sqrt((cov[3,3]/n)), "<"  , miu[3] , "<" ,miu[3] + tval*sqrt((cov[3,3]/n)))

## 3.959057 < 4.547619 < 5.136181

ic4 <- cat(miu[4]-tval*sqrt((cov[4,4]/n)), "<"  , miu[4] , "<" ,miu[4] + tval*sqrt((cov[4,4]/n)))

## 1.671738 < 2.190476 < 2.709214

ic5 <- cat(miu[5]-tval*sqrt((cov[5,5]/n)), "<"  , miu[5] , "<" ,miu[5] + tval*sqrt((cov[5,5]/n)))

## 8.439448 < 10.04762 < 11.65579

ic6 <- cat(miu[6]-tval*sqrt((cov[6,6]/n)), "<"  , miu[6] , "<" ,miu[6] + tval*sqrt((cov[6,6]/n)))

## 6.74951 < 9.404762 < 12.06001

ic7 <- cat(miu[7]-tval*sqrt((cov[7,7]/n)), "<"  , miu[7] , "<" ,miu[7] + tval*sqrt((cov[7,7]/n)))

## 2.765232 < 3.095238 < 3.425245

Ejercicio 2

2.- Se colectaron datos de tratamiento de radioterapia en muchos pacientes. El investigador considera que la muestra es muy grande, usar la teoría de muestras muy grandes.

Determinar cuáles vectores \(\boldsymbol{\mu}\) están en la región de confianza del 95%. \(\begin{array}{rrr}\mu 1 & \mu 2 & \mu 3 \\ 3.60 & 3.60 & 3.60 \\ 2.00 & 1.90 & 2.00 \\ 2.10 & 2.10 & 2.10 \\ 2.15 & 2.15 & 2.15 \\ 2.60 & 2.60 & 3.00 \\ 1.30 & 1.30 & 1.30\end{array}\)
Con la teoría de muestras muy grandes obtener IC simultáneos con un nivel de confianza global del \(95 \%\) para la media de cada variable.
Resolver B) con el método de Bonferroni.

Inciso A

D <- read.csv(file = 'C:/Users/Joel Rodarte/Desktop/datostarea4_Clean_p3.csv')
alpha <- .05
n <- 98
p <- 6

#Lo que quiero probar 
miu1 <- matrix(c(3.60,2,2.10,2.15,2.60,1.30),ncol = 1,byrow = TRUE)
miu2 <- matrix(c(3.60,1.90,2.10,2.15,2.60,1.30),ncol = 1,byrow = TRUE)
miu3 <- matrix(c(3.60,2,2.10,2.15,3,1.30),ncol = 1,byrow = TRUE)



colMeans <- colMeans(D)
miu <- matrix(c(colMeans[1],colMeans[2],colMeans[3],colMeans[4],colMeans[5],colMeans[6]),ncol = 1,byrow = TRUE)
cov <- cov(D)

crit <- 12.59158724 # =CHISQ.INV.RT(D24,D25)

#Si T2 <= a chi entonces SI pertenece al intervalo de confianza. 

t2 <- n*(t(miu-miu1)) %*% solve(cov)%*% (miu-miu1)
# 18.96815
t2 > crit #No pertenece a region de confianza

##      [,1]
## [1,] TRUE

t2 <- n*(t(miu-miu2)) %*% solve(cov)%*% (miu-miu2)
#11.10784
t2 > crit #False, pertenece a region de confianza

##       [,1]
## [1,] FALSE

t2 <- n*(t(miu-miu3)) %*% solve(cov)%*% (miu-miu3)
# 89.89236
t2 > crit #True, No pertenece a region de confianza

##      [,1]
## [1,] TRUE

Inciso B

x1 <- sqrt(crit*(cov[1,1]/n))
x2 <- sqrt(crit*(cov[2,2]/n))
x3 <- sqrt(crit*(cov[3,3]/n))
x4 <- sqrt(crit*(cov[4,4]/n))
x5 <- sqrt(crit*(cov[5,5]/n))
x6 <- sqrt(crit*(cov[6,6]/n))


ic1 <- cat(miu[1]-x1, "<"  , miu[1] , "<" , miu[1]+x1)

## 2.768998 < 3.542347 < 4.315696

ic2 <- cat(miu[2]-x2, "<"  , miu[2] , "<" , miu[2]+x2)

## 1.528753 < 1.809357 < 2.089961

ic3 <- cat(miu[3]-x3, "<"  , miu[3] , "<" , miu[3]+x3)

## 1.86664 < 2.137602 < 2.408564

ic4 <- cat(miu[4]-x4, "<"  , miu[4] , "<" , miu[4]+x4)

## 2.089895 < 2.209 < 2.328105

ic5 <- cat(miu[5]-x5, "<"  , miu[5] , "<" , miu[5]+x5)

## 2.241995 < 2.574827 < 2.907658

ic6 <- cat(miu[6]-x6, "<"  , miu[6] , "<" , miu[6]+x6)

## 0.9428172 < 1.27551 < 1.608203

Inciso C

alpha_prima = alpha/(2*p)
nc <- 1-alpha_prima #Nuevo nivel de confianza 

tval <- 2.934791705 #=TINV(C17,C14-1)

ic1 <- cat(miu[1]-tval*sqrt((cov[1,1]/n)), "<"  , miu[1] , "<" ,miu[1] + tval*sqrt((cov[1,1]/n)))

## 2.902741 < 3.542347 < 4.181953

ic2 <- cat(miu[2]-tval*sqrt((cov[2,2]/n)), "<"  , miu[2] , "<" ,miu[2] + tval*sqrt((cov[2,2]/n)))

## 1.577281 < 1.809357 < 2.041434

ic3 <- cat(miu[3]-tval*sqrt((cov[3,3]/n)), "<"  , miu[3] , "<" ,miu[3] + tval*sqrt((cov[3,3]/n)))

## 1.9135 < 2.137602 < 2.361704

ic4 <- cat(miu[4]-tval*sqrt((cov[4,4]/n)), "<"  , miu[4] , "<" ,miu[4] + tval*sqrt((cov[4,4]/n)))

## 2.110493 < 2.209 < 2.307507

ic5 <- cat(miu[5]-tval*sqrt((cov[5,5]/n)), "<"  , miu[5] , "<" ,miu[5] + tval*sqrt((cov[5,5]/n)))

## 2.299555 < 2.574827 < 2.850098

ic6 <- cat(miu[6]-tval*sqrt((cov[6,6]/n)), "<"  , miu[6] , "<" ,miu[6] + tval*sqrt((cov[6,6]/n)))

## 1.000353 < 1.27551 < 1.550667

Ejercicio 3

3.- Se tiene una muestra aleatoria de datos sobre minerales contenidos en los huesos. A) Determinar si \(\boldsymbol{\mu}_0^{\prime}=(0.85,0.79,1.80,1.70,0.70,0.70)\) con un nivel de significancia del \(5 \%\). B) Obtener IC simultáneos para las diferencias de medias con un nivel de confianza global del \(95 \%\). C) Validar los supuestos para que los resultados anteriores sean válidos.

Inciso A

#Datos 
D <- read.csv(file = 'C:/Users/Joel Rodarte/Desktop/datostarea4_Clean_p2.csv')

#A
alpha <- .05
n <- 25
p <- 6

#Lo que quiero probar 
miu0 <- matrix(c(.85,.79,1.80,1.7,.7,.7),ncol = 1,byrow = TRUE)

colMeans <- colMeans(D)
miu <- matrix(c(colMeans[1],colMeans[2],colMeans[3],colMeans[4],colMeans[5],colMeans[6]),ncol = 1,byrow = TRUE)
cov <- cov(D)

#Estadístico de Prueba 
t2 <- n*(t(miu-miu0)) %*% solve(cov)%*% (miu-miu0)
fisher <- 2.628318038 # =F.INV(1-C6,C5,C4-C5)
crit <- ((n-1)*p)/(n-p)*fisher 
t2 > crit # False, No Rechazo H0, las medias son iguales

##       [,1]
## [1,] FALSE

xpvalor <- ((n-p)*t2)/((n-1)*p)
pvalor <- 0.1099192391#F.DIST.RT(F6,F5,F4-F5)
#Rechazo Ho

Inciso B

x12 <- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[1,1]-cov[1,2]+cov[2,2]))
x13 <- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[1,1]-cov[1,3]+cov[3,3]))
x14<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[1,1]-cov[1,4]+cov[4,4]))
x15<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[1,1]-cov[1,5]+cov[5,5]))
x16<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[1,1]-cov[1,6]+cov[6,6]))
x23<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[2,2]-cov[2,3]+cov[3,3]))
x24<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[2,2]-cov[2,4]+cov[4,4]))
x25<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[2,2]-cov[2,5]+cov[5,5]))
x26<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[2,2]-cov[2,6]+cov[6,6]))
x34<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[3,3]-cov[3,4]+cov[4,4]))
x35<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[3,3]-cov[3,5]+cov[5,5]))
x36<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[3,3]-cov[3,6]+cov[6,6]))
x45<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[4,4]-cov[4,5]+cov[5,5]))
x46<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[4,4]-cov[4,6]+cov[6,6]))
x56<- sqrt((p*(n-1))/(n*(n-p))*fisher*(cov[5,5]-cov[5,6]+cov[6,6]))


ic12 <- cat((miu[1]- miu[2])- x12, "<"  , miu[1]- miu[2] , "<" , (miu[1]- miu[2])+ x12)

## -0.08029255 < 0.02548 < 0.1312525

ic13<-  cat((miu[1]- miu[3])- x13, "<"  , miu[1]- miu[3] , "<" , (miu[1]- miu[3])+ x13)

## -1.186744 < -0.94888 < -0.7110155

ic15<-  cat((miu[1]- miu[5])- x15, "<"  , miu[1]- miu[5] , "<" , (miu[1]- miu[5])+ x15)

## 0.0284499 < 0.1394 < 0.2503501

ic16<-  cat((miu[1]- miu[6])- x16, "<"  , miu[1]- miu[6] , "<" , (miu[1]- miu[6])+ x16)

## 0.03831693 < 0.14996 < 0.2616031

ic23<-  cat((miu[2]- miu[3])- x23, "<"  , miu[2]- miu[3] , "<" , (miu[2]- miu[3])+ x23)

## -1.215932 < -0.97436 < -0.7327876

ic24<-  cat((miu[2]- miu[4])- x24, "<"  , miu[2]- miu[4] , "<" , (miu[2]- miu[4])+ x24)

## -1.13481 < -0.91652 < -0.6982297

ic25<-  cat((miu[2]- miu[5])- x25, "<"  , miu[2]- miu[5] , "<" , (miu[2]- miu[5])+ x25)

## 0.006593892 < 0.11392 < 0.2212461

ic26<-  cat((miu[2]- miu[6])- x26, "<"  , miu[2]- miu[6] , "<" , (miu[2]- miu[6])+ x26)

## 0.02228015 < 0.12448 < 0.2266798

ic34<-  cat((miu[3]- miu[4])- x34, "<"  , miu[3]- miu[4] , "<" , (miu[3]- miu[4])+ x34)

## -0.1994268 < 0.05784 < 0.3151068

ic35<-  cat((miu[3]- miu[5])- x35, "<"  , miu[3]- miu[5] , "<" , (miu[3]- miu[5])+ x35)

## 0.8436776 < 1.08828 < 1.332882

ic36<-  cat((miu[3]- miu[6])- x36, "<"  , miu[3]- miu[6] , "<" , (miu[3]- miu[6])+ x36)

## 0.8493662 < 1.09884 < 1.348314

ic45<-  cat((miu[4]- miu[5])- x45, "<"  , miu[4]- miu[5] , "<" , (miu[4]- miu[5])+ x45)

## 0.805827 < 1.03044 < 1.255053

ic46<-  cat((miu[4]- miu[6])- x46, "<"  , miu[4]- miu[6] , "<" , (miu[4]- miu[6])+ x46)

## 0.8164356 < 1.041 < 1.265564

ic56<-  cat((miu[5]- miu[6])- x56, "<"  , miu[5]- miu[6] , "<" , (miu[5]- miu[6])+ x56)

## -0.0954209 < 0.01056 < 0.1165409

Inciso C

library(MVN)

## Warning: package 'MVN' was built under R version 4.2.2

mvn(D,mvnTest = "hz",univariateTest = "SW",univariatePlot="histogram",multivariatePlot = "qq")

## $multivariateNormality
##            Test        HZ   p value MVN
## 1 Henze-Zirkler 0.8945989 0.2009671 YES
## 
## $univariateNormality
##           Test         Variable Statistic   p value Normality
## 1 Shapiro-Wilk Dominant.radius     0.9224    0.0580    YES   
## 2 Shapiro-Wilk      radius         0.9550    0.3231    YES   
## 3 Shapiro-Wilk Dominant.humerus    0.9739    0.7442    YES   
## 4 Shapiro-Wilk     humerus         0.9737    0.7385    YES   
## 5 Shapiro-Wilk  Dominant.ulna      0.9500    0.2511    YES   
## 6 Shapiro-Wilk       ulna          0.9826    0.9321    YES   
## 
## $Descriptives
##                   n    Mean   Std.Dev Median   Min   Max  25th  75th
## Dominant.radius  25 0.84380 0.1140245  0.856 0.493 1.103 0.792 0.921
## radius           25 0.81832 0.1068545  0.838 0.532 1.052 0.752 0.876
## Dominant.humerus 25 1.79268 0.2834735  1.786 1.037 2.334 1.650 1.954
## humerus          25 1.73484 0.2635991  1.759 1.268 2.238 1.547 1.869
## Dominant.ulna    25 0.70440 0.1075566  0.706 0.533 0.873 0.618 0.782
## ulna             25 0.69384 0.1029521  0.682 0.482 0.872 0.615 0.765
##                         Skew   Kurtosis
## Dominant.radius  -0.74609623  1.9606156
## radius           -0.51080519  0.7451241
## Dominant.humerus -0.38252989  0.2915122
## humerus           0.10302550 -0.8011618
## Dominant.ulna    -0.02096438 -1.3453926
## ulna             -0.12554257 -0.8587968

#Se confirma normalidad, entonces los resultados anteriores son validos.

Ejercicio 4

4.- Se colectaron datos sobre el puntaje de exámenes en estudiantes universitarios. A) Determinar que vectores de medias están en la región de confianza del 95%. \(\begin{array}{rrr}\mu 1 & \mu 2 & \mu 3 \\ 527 & 523 & 525 \\ 53 & 55 & 53 \\ 25 & 26 & 26\end{array}\) B) Obtener IC simultáneos para diferencias de medias con un nivel de confianza global del \(95 \%\). C) Mencionar los supuestos para que los resultados anteriores sean válidos.

Inciso A

D <- read.csv(file = 'C:/Users/Joel Rodarte/Desktop/datostarea4_Clean_p4.csv')
alpha <- .05
n <- 87
p <- 3

#Lo que quiero probar 
miu1 <- matrix(c(527,53,25),ncol = 1,byrow = TRUE)
miu2 <- matrix(c(523,55,26),ncol = 1,byrow = TRUE)
miu3 <- matrix(c(525,53,26),ncol = 1,byrow = TRUE)


colMeans <- colMeans(D)
miu <- matrix(c(colMeans[1],colMeans[2],colMeans[3]),ncol = 1,byrow = TRUE)
cov <- cov(D)

crit <- 7.814727903 # =CHISQ.INV.RT(D24,D25)


#Si T2 <= a chi entonces SI pertenece al intervalo de confianza. 

t2 <- n*(t(miu-miu1)) %*% solve(cov)%*% (miu-miu1)
# 4.14
t2 > crit #pertenece a region de confianza

##       [,1]
## [1,] FALSE

t2 <- n*(t(miu-miu2)) %*% solve(cov)%*% (miu-miu2)
#6.82612
t2 > crit #FALSE,pertenece a region de confianza

##       [,1]
## [1,] FALSE

t2 <- n*(t(miu-miu3)) %*% solve(cov)%*% (miu-miu3)
# 8.514551
t2 > crit #True, No pertenece a region de confianza

##      [,1]
## [1,] TRUE

Inciso B

x12 <- sqrt(crit*((cov[1,1]-2*cov[1,2]+cov[2,2])/n))
x13 <- sqrt(crit*((cov[1,1]-2*cov[1,3]+cov[3,3])/n))
x23 <- sqrt(crit*((cov[2,2]-2*cov[2,3]+cov[3,3])/n))


ic12 <- cat((miu[1]- miu[2])- x12, "<"  , miu[1]- miu[2] , "<" , (miu[1]- miu[2])+ x12)

## 451.2658 < 471.8966 < 492.5273

ic13 <- cat((miu[1]- miu[3])- x13, "<"  , miu[1]- miu[3] , "<" , (miu[1]- miu[3])+ x13)

## 479.4622 < 501.4598 < 523.4574

ic23 <- cat((miu[2]- miu[3])- x23, "<"  , miu[2]- miu[3] , "<" , (miu[2]- miu[3])+ x23)

## 26.53057 < 29.56322 < 32.59587

Inciso C

#Para que lo anterior tenga validez se asume que la distribucion es normal multivariada y que se tiene una muestra grande siendo grande n-p > 40

Tarea04_JARR_MEMV_IntervalosDeConfianza

Joel Alejandro Rodarte Rivera

2023-01-22

Ejercicio 1

Inciso A

Inciso B

Inciso C

Inciso D

Ejercicio 2

Inciso A

Inciso B

Inciso C

Ejercicio 3

Inciso A

Inciso B

Inciso C

Ejercicio 4

Inciso A

Inciso B

Inciso C