Diseño Completamente al Azar

Numerosos factores contribuyen al funcionamiento suave de un motor eléctrico:

Numerosos factores contribuyen al funcionamiento suave de un motor eléctrico (Increasing Market Share Through Improved Product and Process Design: An Experimental Approach, Quality Engineering, 1991: 361-369). En particular, es deseable mantener el ruido del motor y vibraciones a un mínimo. Para estudiar el efecto que la marca de los cojinetes tiene en la vibración del motor, se examinaron cinco marcas diferentes de cojinetes instalando cada tipo de cojinete en muestras aleatorias distintas de seis motores. Se registró la cantidad de vibración del motor (medida en micrones) cuando cada uno de los 30 motores estaba funcionando. (Anand, 1991)

Unidades Experimentales: 30 motores
Variable Respuesta: vibración del motor (medida en micrones)
Factor de Interés: marca de los cojinetes

Marca 1,2,3,4,5

Diseño Completamente al azar (DCA):

\[Y_{ij}=\mu+\tau_i+\epsilon_{ij}\]

Donde:

\(Y_{ij}\): Vibración del j-ésimo motor con de la i-ésima marca
\(\mu\): promedio global de las vibraciones
\(\tau\): efecto de la i-ésima marca
\(\epsilon\): error aleatorio conocida de la observación \(Y_{ij}\)

Gráfico de Cajas para la Comparación de Medias:

datos1<-read.table("Datos_Disenos.txt",header=T)
attach(datos1)
library(ggplot2)

## Registered S3 methods overwritten by 'ggplot2':
##   method         from 
##   [.quosures     rlang
##   c.quosures     rlang
##   print.quosures rlang

ggplot(data = datos1,aes(Marca,Vibracion,color=Marca))+
    geom_boxplot() + geom_jitter()+theme_bw()

En el gráfico de barras se tiene que observar si las cajas se traslapan, es decir, tienen que estar en el mismo espacio horizontal para que se traslapen y esto indica igualdad de medias lo que no siempre suele ser confiable, pero esto nos da un primer vistaso del comportamiento de los promedios de los tratamientos, luego se hará una prueba estadística para saber si son estadísticamente iguales o al menos uno de ellos es diferente. (Humberto & Vara, 2003)

Media de cada Tratamiento:

Ymed<-tapply(Vibracion,Marca,mean)
Ymed<-as.data.frame(Ymed);Ymed

##            Ymed
## Marca1 13.68333
## Marca2 15.95000
## Marca3 13.66667
## Marca4 14.73333
## Marca5 13.08333

Se halla el promedio de cada tratamiento en este caso de cada Marca de cada cojinete, por ejemplo la Marca del cojinete 1 presenta un promedio de 13,7 micrones.

Media Global:

Yglo<-mean(Vibracion);Yglo

## [1] 14.22333

El promedio de todas las marcas de cojinete es 14,22 micrones lo que se conoce como media global.

Análisis de la Varianza (ANOVA):

fit<-aov(Vibracion~Marca,data = datos1)
fit1<-as.data.frame.list(summary(fit))
knitr::kable(
  fit1, 
  caption = "Tabla 1: ANOVA"
)

Tabla 1: ANOVA
	Df	Sum.Sq	Mean.Sq	F.value	Pr..F.
Marca	4	30.85533	7.7138333	8.443954	0.0001871
Residuals	25	22.83833	0.9135333	NA	NA

Observamos el valor-p o p-value y como es menor que 0,05 que es nuestro nivel de significancia decimos que a un nivel del 95% de confianza, al menos un promedio es diferente de los demás.

Gráfica de Probabilidad Normal para los residuos del modelo (QQ-Plot):

i<-1:30
Residuos<-sort(as.vector(residuals(fit)))
z<-(i-0.5)/30
Zalf<-qnorm(z,mean=0,sd=1,lower.tail =T)
df<-data.frame(Residuos=Residuos,Rango=i,alfa=z,Z=Zalf)
knitr::kable(
  df[1:30, ], 
  caption = "Tabla 2: Tabla para gráficar el QQ-Plot",
  digits = 4
)

Tabla 2: Tabla para gráficar el QQ-Plot
Residuos	Rango	alfa	Z
-2.0833	1	0.0167	-2.1280
-1.5500	2	0.0500	-1.6449
-1.2667	3	0.0833	-1.3830
-1.0500	4	0.1167	-1.1918
-1.0333	5	0.1500	-1.0364
-0.8333	6	0.1833	-0.9027
-0.7833	7	0.2167	-0.7835
-0.5833	8	0.2500	-0.6745
-0.3833	9	0.2833	-0.5730
-0.3667	10	0.3167	-0.4770
-0.3333	11	0.3500	-0.3853
-0.2500	12	0.3833	-0.2967
-0.0333	13	0.4167	-0.2104
0.0333	14	0.4500	-0.1257
0.1167	15	0.4833	-0.0418
0.1333	16	0.5167	0.0418
0.2333	17	0.5500	0.1257
0.3167	18	0.5833	0.2104
0.3167	19	0.6167	0.2967
0.3167	20	0.6500	0.3853
0.3167	21	0.6833	0.4770
0.3500	22	0.7167	0.5730
0.4167	23	0.7500	0.6745
0.7167	24	0.7833	0.7835
0.9667	25	0.8167	0.9027
1.2333	26	0.8500	1.0364
1.2500	27	0.8833	1.1918
1.2500	28	0.9167	1.3830
1.2667	29	0.9500	1.6449
1.3167	30	0.9833	2.1280

ggplot(data =df, aes(sample=df$Residuos))+stat_qq(col="blue")+ stat_qq_line(col="red",lty=2)+ggtitle("QQ-Plot")

Con el Gráfico de probabilidad Normal se observa si los puntos se ajustan a la linea de valores teóricos para compararlos con los valores observados. Se puede apreciar que hay algunos puntos fuera de la linea por lo que podría no seguir una distribución normal pero se realiza una prueba estadística para estar mas seguros.

Prueba de Shapiro-Wilks para Normalidad:

\[ \left\{ \begin{array}{ll} H_{0}: & La\ variable\ sigue\ distribución\ Normal\\ H_{1}: & La\ variable\ no\ sigue\ distribución\ Normal \end{array} \right. \]

Resac<-sort(as.vector(residuals(fit)),decreasing = F)
Resdec<-sort(as.vector(residuals(fit)),decreasing = T)
ain<-c(0.4254, 0.2944, 0.2487, 0.2148, 0.1870, 0.1630, 0.1415, 0.1219, 0.1036, 0.0862, 0.0697,0.0537, 0.0381, 0.0227 ,0.0076)
Xn<-Resac-Resdec
delta<-ain[1:30]*Xn
desv<-(Resac-mean(Resac))^2
b<-sum(delta,na.rm = T);b1<-sum(desv);b2<-b^2;W<-b2/b1
tab<-data.frame("Residuos_acsendentes"=Resac,"Residuos_decsendentes"=Resdec,
                "Coeficientes_ain"=ain,"wH"=desv)
knitr::kable(
  tab[1:30, ], 
  caption = "Tabla 3: Tabla para calcular el valor del estadístico WH",
  digits = 5
)

Tabla 3: Tabla para calcular el valor del estadístico WH
Residuos_acsendentes	Residuos_decsendentes	Coeficientes_ain	wH
-2.08333	1.31667	0.4254	4.34028
-1.55000	1.26667	0.2944	2.40250
-1.26667	1.25000	0.2487	1.60444
-1.05000	1.25000	0.2148	1.10250
-1.03333	1.23333	0.1870	1.06778
-0.83333	0.96667	0.1630	0.69444
-0.78333	0.71667	0.1415	0.61361
-0.58333	0.41667	0.1219	0.34028
-0.38333	0.35000	0.1036	0.14694
-0.36667	0.31667	0.0862	0.13444
-0.33333	0.31667	0.0697	0.11111
-0.25000	0.31667	0.0537	0.06250
-0.03333	0.31667	0.0381	0.00111
0.03333	0.23333	0.0227	0.00111
0.11667	0.13333	0.0076	0.01361
0.13333	0.11667	0.4254	0.01778
0.23333	0.03333	0.2944	0.05444
0.31667	-0.03333	0.2487	0.10028
0.31667	-0.25000	0.2148	0.10028
0.31667	-0.33333	0.1870	0.10028
0.31667	-0.36667	0.1630	0.10028
0.35000	-0.38333	0.1415	0.12250
0.41667	-0.58333	0.1219	0.17361
0.71667	-0.78333	0.1036	0.51361
0.96667	-0.83333	0.0862	0.93444
1.23333	-1.03333	0.0697	1.52111
1.25000	-1.05000	0.0537	1.56250
1.25000	-1.26667	0.0381	1.56250
1.26667	-1.55000	0.0227	1.60444
1.31667	-2.08333	0.0076	1.73361

\[ \left\{ \begin{array}{ll} w_H: & 0.957197 \\ w_{\alpha-1}: & 0.985\\ Región\ de\ Rechazo: & (0.985;\ +\infty) \end{array} \right. \]

Conclusión:

El valor de \(w_H\) no se encuentra en el intervalo de la Región de Rechazo, por lo que no se rechaza \(H_0\) y se confirma el supuesto de Normalidad para los residuos del Modelo.

Prueba de Barlet para el supuesto de Homocedasticidad:

Otro de lo supuestos que debe cumplir el modelo es el de varianza constante.

#Prueba de Homocedasticidad
#H0:Varianzas Homogeneas
#H1:Varianzas no Homogeneas
bartlett.test(Vibracion~Marca, data=datos1)

## 
##  Bartlett test of homogeneity of variances
## 
## data:  Vibracion by Marca
## Bartlett's K-squared = 4.0967, df = 4, p-value = 0.3931

Como el valor-p es mayor que 0,05 que es nuestro nivel de significancia, no se rechaza la hipótesis nula, por lo tanto se cumple el supuesto de varianzas homogeneas.

Prueba de Ljung-Box para el supuesto de Independencia:

Residuos<-residuals(fit)
#H0: Los residuos son independientes
#H1: Los residuos no son independientes
Box.test(Residuos,type = "Ljung-Box")

## 
##  Box-Ljung test
## 
## data:  Residuos
## X-squared = 2.8741, df = 1, p-value = 0.09001

Suponiendo que el orden de corrida es el mismo en el que está distribuido los datos se puede aplicar el test de Ljung Box para determinar la independencia, el valor-p es mayor que 0.05 que es el nivel de significancia, no se rechaza H0 por lo que los residuos son independeintes.

Prueba LSD para comparación entre pares de medias:

library("agricolae")
Grupos<- LSD.test(y = fit, trt = "Marca", group = F, console = T)

## 
## Study: fit ~ "Marca"
## 
## LSD t Test for Vibracion 
## 
## Mean Square Error:  0.9135333 
## 
## Marca,  means and individual ( 95 %) CI
## 
##        Vibracion       std r      LCL      UCL  Min  Max
## Marca1  13.68333 1.1940128 6 12.87970 14.48696 11.6 15.0
## Marca2  15.95000 1.1674759 6 15.14637 16.75363 14.4 17.2
## Marca3  13.66667 0.8164966 6 12.86304 14.47030 12.4 14.9
## Marca4  14.73333 0.9395034 6 13.92970 15.53696 13.7 16.0
## Marca5  13.08333 0.4792355 6 12.27970 13.88696 12.3 13.5
## 
## Alpha: 0.05 ; DF Error: 25
## Critical Value of t: 2.059539 
## 
## Comparison between treatments means
## 
##                  difference pvalue signif.         LCL         UCL
## Marca1 - Marca2 -2.26666667 0.0004     *** -3.40317205 -1.13016128
## Marca1 - Marca3  0.01666667 0.9761         -1.11983872  1.15317205
## Marca1 - Marca4 -1.05000000 0.0686       . -2.18650539  0.08650539
## Marca1 - Marca5  0.60000000 0.2873         -0.53650539  1.73650539
## Marca2 - Marca3  2.28333333 0.0003     ***  1.14682795  3.41983872
## Marca2 - Marca4  1.21666667 0.0369       *  0.08016128  2.35317205
## Marca2 - Marca5  2.86666667 0.0000     ***  1.73016128  4.00317205
## Marca3 - Marca4 -1.06666667 0.0646       . -2.20317205  0.06983872
## Marca3 - Marca5  0.58333333 0.3006         -0.55317205  1.71983872
## Marca4 - Marca5  1.65000000 0.0062      **  0.51349461  2.78650539

Los resultados indican que existen diferencias estadísticamente significativas entre las medias de la marca 2 con el resto, además, la marca 2 es la que en promedio produce mayor vibración, mientras que la que produce menor vibración promedio es la marca 5, sin embargo, esta marca es estadisticamente igual a la marca 3 y a la marca 1, pero diferente de la marca 4.

Como se desea que se mantenga la marca de cojinetes a un mínimo se eligiría la marca 5 que es la que menor promedio presentó, pero teniendo en cuenta que es estadísticamente igual a la marca 1 y 3 por lo que también se podría elegir uno de estos.