Diseños Grupal

Descargar como docx, pdf o txt
Descargar como docx, pdf o txt
Está en la página 1de 68

TRABAJO GRUPAL DISEÑO DE EXPERIMENTOS

Brayan Lemache,Marco Orozco,Kimberling Valdez,Alex vimos y Michael Ulcuango

07 de julio del 2020

EJERCICIOS GRUPALES
Ejercicio 1
En una fábrica de componentes electrónicos, uno de los principales clientes
reportótener problemas con algunos de los productos (comportamiento eléctrico
intermitente). Mediante el análisis de las muestras retornadas por el cliente, se
identificó que elproblema se relaciona con alambre mal colocado y podía obedecer a
varias causas. Sedecide correr una réplica de un experimento factorial 25, utilizando
los siguientes factores y niveles.

FAC

La respuesta a medir es el número de unidades con alambre mal colocado. Cada


prueba se hizo enla línea de ensamble y consistió en colocar cierta cantidad de
alambres,que lo hace un equipoautomático. La cantidad de alambres a colocar en
cada prueba, bajo cada tratamiento, se determinó de tal forma que tuviera alta
probabilidad de detectar piezas con alambres mal colocados. Los datos son los
siguientes:

(1)=105
a=0
b=66
ab=7
c=54
ac=1
bc=41
abc=0
a)Dibuje el diagrama de Pareto y el gráfico de Daniel considerando todas las
interacciones de alto orden. ¿Cuáles efectos parecen estar activos?
A<-(rep(c(-1,1),16)) #16 * 2 obtengo mis 32 datos
B<-(rep(c(-1,1),each=2,8))
C<-(rep(c(-1,1),each=4,4))
D<-(rep(c(-1,1),each=8,2))
E<-(rep(c(-1,1),each=16))
Y<-c(105, 0, 66, 7, 54, 1, 41, 0,
0, 0, 0, 5, 25, 1, 0, 0,
34, 3, 18, 2, 0, 0, 49, 4,
0, 0, 0, 0, 0, 0, 0, 0)

Lm<-lm(Y~A*B*C*D*E)

Gráfico de Pareto
library(pid)

## Registered S3 method overwritten by 'DoE.base':


## method from
## factorize.factor conf.design

paretoPlot(Lm)
GRáfica de Daniel
library(FrF2)
## Loading required package: DoE.base

## Loading required package: grid

## Loading required package: conf.design

##
## Attaching package: 'DoE.base'

## The following objects are masked from 'package:stats':


##
## aov, lm

## The following object is masked from 'package:graphics':


##
## plot.design

## The following object is masked from 'package:base':


##
## lengths

DanielPlot(Lm)

INTERPRETACIÓN:
Tanto el diagrama de Pareto como el diagrama de Daniel me dice que solo:los efectos A, D, E,
AD y AE son significativos.
b)Determine el mejor análisis de varianza e interprételo.
A<-as.factor(rep(c(-1,1),16))
B<-as.factor(rep(c(-1,1),each=2,8))
C<-as.factor(rep(c(-1,1),each=4,4))
D<-as.factor(rep(c(-1,1),each=8,2))
E<-as.factor(rep(c(-1,1),each=16))
Y<-c(105, 0, 66, 7, 54, 1, 41, 0,
0, 0, 0, 5, 25, 1, 0, 0,
34, 3, 18, 2, 0, 0, 49, 4,
0, 0, 0, 0, 0, 0, 0, 0)

Lm1<-lm(Y~A+B+C+D+E+(A*B)+(A*C)+(A*D)+(A*E)+(B*C)+(B*D)+(B*E)+(C*D)+(C*E)+
(D*E))
anova(Lm1)

A
B
C
D
E
A:B
A:C
A:D
A:E
B:C
B:D
B:E
C:D
C:E
D:E
Residuals

INTERPRETACIÓN:
Efectivamente podemos observar en nuestro ANOVA que solo A, D, E, AD y AE son
significatvios para nuestro modelo, el resto lo descartamos y procedemos a crear un nuevo
ANOVA mejorado solo con los que fueron significativos.
ANOVA MEJORADO solo con los que son significativos: A, D, E, AD y AE
Lm2<-lm(Y~A+D+E+(A*D)+(A*E))
anova(Lm2)
A
D
E
A:D
A:E
Residuals

c) Obtenga las gráficas de los efectos que resultaron importantes en el ANOVA e


interprételas.
A<-as.factor(rep(c(-1,1),16))
B<-as.factor(rep(c(-1,1),each=2,8))
C<-as.factor(rep(c(-1,1),each=4,4))
D<-as.factor(rep(c(-1,1),each=8,2))
E<-as.factor(rep(c(-1,1),each=16))
Y<-c(105, 0, 66, 7, 54, 1, 41, 0,
0, 0, 0, 5, 25, 1, 0, 0,
34, 3, 18, 2, 0, 0, 49, 4,
0, 0, 0, 0, 0, 0, 0, 0)
Lm3<-lm(Y~A*D*E)
anova(Lm3)

A
D
E
A:D
A:E
D:E
A:D:E
Residuals
library(FrF2)
Tabla2<-FrF2(nruns= 8,
nfactors = 3,
factor.names = list(A=c(-1,1),
D=c(-1,1),
E=c(-1,1)),
replications = 4, randomize = FALSE)

## creating full factorial with 8 runs ...

Tabla2<-add.response(design = Tabla2,response = Y)
Tabla2
A
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1

GRáfica de los efectos principales


MEPlot(Tabla2,wd=2)
Interpretación:
Se desea reducir el número de unidades con alambre mal colocado para ello debemos tener el
efecto A (Patron de reconocimiento) en su nivel alto (dos puntos), el efecto D (colocación del
dado) en su nivel alto (normal) y el efecto E (brillo de la oblea) en su nivel alto tambien
(normal).
Gráficas de Interacción
IAPlot(Tabla2,wd=2)
Interpretación:
Se pude ver que las gráficas tando AD y AE parecen que se van a unir, pero es mejor guiarse
con los resultados del ANOVA.
d) Determine el mejor tratamiento.
1. PLANTEO EL MODELO DE REGRESION PARA PREDECIR UTILIZANDO EL ANOVA
MEJORADO
COEFICIENTES:
A<-(rep(c(-1,1),16))
B<-(rep(c(-1,1),each=2,8))
C<-(rep(c(-1,1),each=4,4))
D<-(rep(c(-1,1),each=8,2))
E<-(rep(c(-1,1),each=16))
Y<-c(105, 0, 66, 7, 54, 1, 41, 0,
0, 0, 0, 5, 25, 1, 0, 0,
34, 3, 18, 2, 0, 0, 49, 4,
0, 0, 0, 0, 0, 0, 0, 0)
Lm2<-lm(Y~A+D+E+(A*D)+(A*E))
anova(Lm2)

A
D
E
A:D
A:E
Residuals
Lm2$coefficients

## (Intercept) A D E A:D A:E


## 12.96875 -11.53125 -11.03125 -6.09375 10.34375 5.78125

Ahora procedemos a realizar un diseñ o 23


A<-as.factor(rep(c(-1,1),16))
B<-as.factor(rep(c(-1,1),each=2,8))
C<-as.factor(rep(c(-1,1),each=4,4))
D<-as.factor(rep(c(-1,1),each=8,2))
E<-as.factor(rep(c(-1,1),each=16))
Y<-c(105, 0, 66, 7, 54, 1, 41, 0,
0, 0, 0, 5, 25, 1, 0, 0,
34, 3, 18, 2, 0, 0, 49, 4,
0, 0, 0, 0, 0, 0, 0, 0)
Lm4<-lm(Y~A*D*E)
anova(Lm4)

A
D
E
A:D
A:E
D:E
A:D:E
Residuals
library(FrF2)
Tabla2<-FrF2(nruns= 8,
nfactors = 3,
factor.names = list(A=c(-1,1),
D=c(-1,1),
E=c(-1,1)),
replications = 4, randomize = FALSE)

## creating full factorial with 8 runs ...

Tabla2<-add.response(design = Tabla2,response = Y)
Tabla2
A
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1

Finalmente realizamos el cubo para ver cual es nuestro mejor tratamiento corremos el
modelo que es sin asfactor.
cubePlot(Y, eff1 = A, eff2 = D, eff3 = E)
Interpretación:
Podemos observar que el valor que reduce el número de unidades de alambre mal colocado es
el 1.5 (es el numero mas pequeño) que corresponde al tratamiento (+,+,-).
Por lo tanto para reducir el numero de unidades de alambre mal colocadas el tratamiengo
GANADOR se necesita tener: El efecto A (Patron de reconocimiento) en su nivel alto (dos
puntos),el efecto D (colocació n del dado) en su nivel alto (normal) y el efecto E (brillo de la
oblea) en su nivel bajo (brillo).
e) Verifique los supuestos del modelo. ¿Qué puede concluir del análisis?
SUPUESTOS
par(mfrow=c(2,2))
plot(Lm2)

## hat values (leverages) are all = 0.1875


## and there are no factor predictors; no plot no. 5
Interpretación
Graficamente parece no existir Normalidad.
Graficamente aparenta existir Homocedasticidad es decir varianza constante
Normalidad
Ho: Los residuales siguen una distribucion normal
H1: Los residuales no sigue una distribució n normal
shapiro.test(residuals(Lm2))

##
## Shapiro-Wilk normality test
##
## data: residuals(Lm2)
## W = 0.85138, p-value = 0.0004446

boxplot(residuals(Lm2))
Interpretación
p-valor = 0.0004446 menor α = 0.05 -> A.H1 .El p-valor obtenido es menor que el nivel de
significancia propuesto de 5% , por lo tanto hay evidencia para decir que los errores no
siguen una distribucion normal.
Homocedasticidad
H0: Los errores tienen varianza constante
H1: Los errores no tienen varianza constante
var.test(Y~A)

##
## F test to compare two variances
##
## data: Y by A
## F = 206.85, num df = 15, denom df = 15, p-value = 2.665e-14
## alternative hypothesis: true ratio of variances is not equal to 1
## 95 percent confidence interval:
## 72.27098 592.01302
## sample estimates:
## ratio of variances
## 206.8462

Interpretación
p-valor menor α = 0.05 -> A.H1. El p-valor obtenido es menor que el nivel de significancia
propuesto de 5% , por lo tanto hay evidencia para decir que los errores no tienen varianza
constante.
var.test(Y~D)

##
## F test to compare two variances
##
## data: Y by D
## F = 24.913, num df = 15, denom df = 15, p-value = 1.328e-07
## alternative hypothesis: true ratio of variances is not equal to 1
## 95 percent confidence interval:
## 8.704455 71.303186
## sample estimates:
## ratio of variances
## 24.91296

Interpretación
p-valor = 0.2156 menor α = 0.05 -> A.H1. El p-valor obtenido es menor que el nivel de
significancia propuesto de 5% , por lo tanto hay evidencia para decir que los errores no tienen
varianza constante.
var.test(Y~E)

##
## F test to compare two variances
##
## data: Y by E
## F = 4.7134, num df = 15, denom df = 15, p-value = 0.004739
## alternative hypothesis: true ratio of variances is not equal to 1
## 95 percent confidence interval:
## 1.646843 13.490234
## sample estimates:
## ratio of variances
## 4.713417

Interpretación
p-valor = 0.004 menor α = 0.05 -> A.H1 .El p-valor obtenido es menor que el nivel de
significancia propuesto de 5% , por lo tanto hay evidencia para decir que los errores no tienen
varianza constante.
Independencia
H0: Los errores estan incorrelados
H1: Los errores estan correlados
library(lmtest)
## Loading required package: zoo

##
## Attaching package: 'zoo'

## The following objects are masked from 'package:base':


##
## as.Date, as.Date.numeric

dwtest(Lm2)

##
## Durbin-Watson test
##
## data: Lm2
## DW = 1.5654, p-value = 0.1353
## alternative hypothesis: true autocorrelation is greater than 0

Interpretación:
p-valor = 0.1353 MAYOR α 0.05 -> A.H0 .El pvalor obtenido es mayor que el nivel de
significancia propuesto de 5% , por lo tanto hay evidencia para decir que los errores estan
incorrelados es decir hay independencia.
f) ¿La forma especial de la gráfica de residuos contra predichos, afecta las
conclusiones a la que llega antes?
Yo creo que de cierto modo si va a afectar porque al realizar la prueba de bartlett.test para
las variables A,D,E ACEPTAMOS H1 es decir que los errores no tienen varianza constante.
g) ¿Es pertinente colapsar este diseño en un factorial 24 con dos réplicas?
Si la respuesta es positiva, há galo.
No es pertinente colapsar este diseñ o en un 24 ya que los unicos efectos que fueron
significativos eran solo 3 entonces mejor es preferible realizar un 23.

h) ¿Se puede colapsar en un 23 con cuatro réplicas?


En el aná lisis del experimento sobre el numero de unidades de alambre mal colocadas una
de la conclusiones fue que no tuvieron ningon efecto los factores B (sistema de luz) y C
(Umbral). Este hecho da pie a colapsar el diseñ o en esas dos direcciones para convertirlo en
un diseñ o factorial 23 con cuatro réplicas. Estas réplicas son mas que sucientes para
obtener un buen estimador del cuadrado medio del error en el ANOVA.

Ejercicio 2
Una de las fallas más importantes en la línea de empaque de un producto es la
calidad de las etiquetas. Un equipo de mejora decide atacar este problema mediante
diseño de experimentos. Para ello eligen una de las impresoras a la cual se le pueden
manipular los factores: velocidad, temperatura, tensión y tipo de etiqueta. Los
niveles utilizados con cada factor fueron:

Factor
Velocidad
temperatura
Tensió n
Tipo de etiqueta

El diseño factorial utilizado fue un 24 con repeticiones al centro. En cada combinación


del experimento se imprimieron 20 etiquetas y se contabiliza como variable de
respuesta en número de impresiones rechazadas. Los resultados observados,
listados en orden aleatorio, fueron los que se muestran en la siguiente tabla.

Temperatura
1
-1
1
1
0
1
1
-1
-1
-1
-1
1
-1
-1
1
1
library(pid)
library(FrF2)
temperatura<-c(rep(c(-1,1),8),rep(0,2))
velocidad<-c(rep(c(-1,1), each=2,4),rep(0,2))
etiqueta<-c(rep(c(-1,1), each=4,2),rep(0,2))
tension<-c(rep(c(-1,1), each=8),rep(0,2))
fallas<-c(20,5,20,3,20,9,20,19,20,0,20,20,20,7,20,20,20,20)

modelo<-lm(fallas~temperatura*velocidad*etiqueta*tension)

tabla con los datos ordenados


df <- data.frame(temperatura, velocidad, etiqueta, tension, fallas)
fix(df)

a) Utilice la notación de Yates y anote en la primera columna de la tabla el código


correspondiente a cada una de las corridas, y asegúrese de que se corrieron todos
los tratamientos correspondientes al diseño empleado.
codigo <- c(1, "a", "b", "ab", "c", "ac", "bc", "abc", "d", "ad", "bd",
"abd", "cd", "acd", "bcd", "abcd", 0, 0)
df2 <- data.frame(Yates = codigo, temperatura, velocidad, etiqueta, tension,
fallas)
df2

Yates
1
a
b
ab
c
ac
bc
abc
d
ad
bd
abd
cd
acd
bcd
abcd
0
0

b) Encuentre el mejor ANOVA para estos datos.


modelo<-lm(fallas~temperatura*velocidad*etiqueta*tension)

Gráfica de Pareto
Para encontrar el mejor ANOVA primero realizamos el diagrama de pareto:
paretoPlot(modelo)
Interpretación:
Se observa que los efectos temperatura (A), velocidad(B) y temperatura X velocidad(AB)
influyen en la variable respuesta.
Gráfica de Daniel
El Diagrama de Daniel no se puede realizar para diseñ os con punto al centro.
ANOVA
anova(modelo)

temperatura
velocidad
etiqueta
tension
temperatura:velocidad
temperatura:etiqueta
velocidad:etiqueta
temperatura:tension
velocidad:tension
etiqueta:tension
temperatura:velocidad:etiqueta
temperatura:velocidad:tension
temperatura:etiqueta:tension
velocidad:etiqueta:tension
temperatura:velocidad:etiqueta:tension
Residuals
modelo2<-lm(fallas~temperatura+velocidad+etiqueta+tension+
(temperatura*velocidad)+(temperatura*etiqueta)+
(temperatura*tension)
+(velocidad*etiqueta)+(velocidad*tension)+(etiqueta*tension))
anova(modelo2)

temperatura
velocidad
etiqueta
tension
temperatura:velocidad
temperatura:etiqueta
temperatura:tension
velocidad:etiqueta
velocidad:tension
etiqueta:tension
Residuals
modelo3<-lm(fallas~temperatura*velocidad+I(temperatura^2)+I(velocidad^2))
anova(modelo3)

temperatura
velocidad
I(temperatura^2)
temperatura:velocidad
Residuals

Interpretación:
Al realizar el anova con los efectos principales y de interaccion doble obtenemos la misma
conclusion que se llego con el diagrama de pareto. Finalmente al ANOVA aumentamos la
curvatuta y concluimos que la curvatura no es significativa.
c) Grafique los efectos significativos e interprételos para determinar el tratamiento
ganador.
datos1<-FrF2(nruns = 16,nfactors = 4,factor.names = list(tempe=c(-1,1),
veloc=c(-1,1),
etique=c(-1,1),
tensi=c(-1,1)),
replications = 1,ncenter = 2, randomize = F)

## creating full factorial with 16 runs ...

datos1<-add.response(design = datos1,response = fallas)


datos1
Gráfica de Efectos principales:
MEPlot(lm(fallas~(tempe*veloc),datos1,subset=iscube(datos1)),points(0,20,lwd=
6,col="red"),points(0,20,lwd=6,col="red"))

Gráfica de Interaccion
IAPlot(lm(fallas~(tempe*veloc),datos1,subset=iscube(datos1)))
Interpretación:
Se puede observar en la grafica de los efectos principales que para minimizar el numero de
fallas se debe tener una temperatura alta (21) y para la velocidad seria una velocidad baja. Y
en la gráfica de interacción se puede comprobar lo anteriormente dicho.
d) Determine el mejor tratamiento y haga la predicción de la eficacia esperada sobre
él.
summary(modelo3)

##
## Call:
## lm.default(formula = fallas ~ temperatura * velocidad + I(temperatura^2) +

## I(velocidad^2))
##
## Residuals:
## Min 1Q Median 3Q Max
## -12.500 0.000 0.000 1.312 4.500
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 20.000 3.124 6.402 2.34e-05 ***
## temperatura -4.813 1.105 -4.357 0.000777 ***
## velocidad 2.563 1.105 2.320 0.037248 *
## I(temperatura^2) -4.813 3.314 -1.452 0.170104
## I(velocidad^2) NA NA NA NA
## temperatura:velocidad 2.563 1.105 2.320 0.037248 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.418 on 13 degrees of freedom
## Multiple R-squared: 0.7102, Adjusted R-squared: 0.621
## F-statistic: 7.965 on 4 and 13 DF, p-value: 0.001791

modelo3$coefficients

## (Intercept) temperatura velocidad


## 20.0000 -4.8125 2.5625
## I(temperatura^2) I(velocidad^2) temperatura:velocidad
## -4.8125 NA 2.5625

modelo3$fitted.values

## 1 2 3 4 5 6 7 8 9 10 11 12
13
## 20.00 5.25 20.00 15.50 20.00 5.25 20.00 15.50 20.00 5.25 20.00 15.50
20.00
## 14 15 16 17 18
## 5.25 20.00 15.50 20.00 20.00

Interpretación:
El valor de R CUADRADO nos salio 0,7102 entonces se puede concluir que el mejor modelo es
bueno para predecir el numero de etiquetas que presenten fallas, la prediccion para el mejor
tratamiento (temperatura alta y velocidad baja) es 5,25 etiquetas rechazadas.
e) Verifique supuestos. ¿Hay algún problema potencial?
Para los modelos 2 K con punto al centro no se pueden realizar la comprobacion de
supuestos.

Ejercicio 3
Se hace un experimento para mejorar el rendimiento de un proceso, controlando
cuatro factores en dos niveles cada uno. Se corre una réplica de un diseño factorial
24, con los factores tiempo (A),concentración (B), presión (C) y temperatura (D), y
los resultados son los siguientes:

A
B

Do 1
D1 1
A<-as.factor(rep(c(-1,1),each=8,1))
A

## [1] -1 -1 -1 -1 -1 -1 -1 -1 1 1 1 1 1 1 1 1
## Levels: -1 1

B<-as.factor(rep(c(-1,1),each=4,2))
B

## [1] -1 -1 -1 -1 1 1 1 1 -1 -1 -1 -1 1 1 1 1
## Levels: -1 1

C<-as.factor( rep(c(-1,1),each=2,4))
C

## [1] -1 -1 1 1 -1 -1 1 1 -1 -1 1 1 -1 -1 1 1
## Levels: -1 1

D<-as.factor(rep(c(-1,1),8))
D

## [1] -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1
## Levels: -1 1

y1<-c(12, 10, 17, 19, 13, 13, 20, 17, 18, 25, 15, 21, 16, 24, 15, 23)

a) Analice estos datos con el uso de todos los criterios existentes para encontrar el
mejor ANOVA. En las figuras considere de entrada los 15 efectos posibles.
lmod1<-lm(y1~A+B+C+D+(A*B)+(A*C)+(B*C)+(A*B*C)+(A*D)+(B*D)+(A*B*D)+(C*D)+
(A*C*D)+(B*C*D)+(A*B*C*D))
lmod1

##
## Call:
## lm.default(formula = y1 ~ A + B + C + D + (A * B) + (A * C) +
## (B * C) + (A * B * C) + (A * D) + (B * D) + (A * B * D) +
## (C * D) + (A * C * D) + (B * C * D) + (A * B * C * D))
##
## Coefficients:
## (Intercept) A1 B1 C1 D1
A1:B1
## 1.200e+01 6.000e+00 1.000e+00 5.000e+00 -2.000e+00
-3.000e+00
## A1:C1 B1:C1 A1:D1 B1:D1 C1:D1
A1:B1:C1
## -8.000e+00 2.000e+00 9.000e+00 2.000e+00 4.000e+00 -4.996e-
15
## A1:B1:D1 A1:C1:D1 B1:C1:D1 A1:B1:C1:D1
## -1.000e+00 -5.000e+00 -7.000e+00 8.000e+00

modelo<-anova(lmod1)
## Warning in anova.lm(lmod1): ANOVA F-tests on an essentially perfect fit
are
## unreliable

modelo

A
B
C
D
A:B
A:C
B:C
A:D
B:D
C:D
A:B:C
A:B:D
A:C:D
B:C:D
A:B:C:D
Residuals

b) ¿Cuáles efectos están activos?


No existen efectos significativos en el diseñ o 24 ya que la suma de cuadrados de los
residuos es cero y no se puede continuar con el calculo del ANOVA.
c) Determine el mejor tratamiento.
No se puede determinar cual es el mejor tratamiento por la explicacion anteriormente
dicha.
d) Compruebe los supuestos del modelo.
RESIDUOS
NORMALIDAD
shapiro.test(y1)

##
## Shapiro-Wilk normality test
##
## data: y1
## W = 0.97299, p-value = 0.8844

Introduccion
Al 95% deconfianza no se rechaza la hipotesis nula es decir que los supuestos cumplen con
normalidad.
HOMOCEDASTICIDAD
bartlett.test(y1~A)

##
## Bartlett test of homogeneity of variances
##
## data: y1 by A
## Bartlett's K-squared = 0.12489, df = 1, p-value = 0.7238

bartlett.test(y1~B)

##
## Bartlett test of homogeneity of variances
##
## data: y1 by B
## Bartlett's K-squared = 0.095367, df = 1, p-value = 0.7575

bartlett.test(y1~C)

##
## Bartlett test of homogeneity of variances
##
## data: y1 by C
## Bartlett's K-squared = 2.6819, df = 1, p-value = 0.1015

bartlett.test(y1~D)

##
## Bartlett test of homogeneity of variances
##
## data: y1 by D
## Bartlett's K-squared = 3.1597, df = 1, p-value = 0.07548

Al 95% de confianza no se rechaza la hipotesis nula en tiempo, concentración, presión y


temperatura; es decir si cumplen homocedasticidad.
INDEPENDENCIA
library(lmtest)

Interpretación
Al 95% deconfianza no se rechaza la hipotesis nula es decir que los supuestos cumplen con
independencia.
e) ¿Puede este diseño colapsarse en uno 23 con dos réplicas? De ser posible, hagalo y
repita los incisos anteriores para este nuevo diseño.
A1<-as.factor(rep(c(-1,1),each=4,2))
A1

## [1] -1 -1 -1 -1 1 1 1 1 -1 -1 -1 -1 1 1 1 1
## Levels: -1 1

B1<-as.factor(rep(c(-1,1),each=2,4))
B1

## [1] -1 -1 1 1 -1 -1 1 1 -1 -1 1 1 -1 -1 1 1
## Levels: -1 1

C1<-as.factor(rep(c(-1,1),8))
C1

## [1] -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1
## Levels: -1 1

y<-c(12, 17, 13, 20, 18, 15, 16, 15, 10, 19, 13, 17, 25, 21, 24, 23)
lmod2<-lm(y~A1*B1*C1)

a) Analice estos datos con el uso de todos los criterios existentes para encontrar el
mejor ANOVA.
anova(lmod2)

A1
B1
C1
A1:B1
A1:C1
B1:C1
A1:B1:C1
Residuals

Con un 95% deconfianza se afirma que el efecto A es significativo, tambien se puede


considerar al efecto AC pero no con tanta fuerza.
b) ¿Cuáles efectos estan activos?
Se puede observar mediante el ANOVA que el factor tiempo es el efectos significativo.
c) Determine el mejor tratamiento.
library(pid)
A2<-rep(c(-1,1),each=4,2)
B2<-rep(c(-1,1),each=2,4)
C2<-rep(c(-1,1),8)
y_2<-c(12, 17, 13, 20, 18, 15, 16, 15, 10, 19, 13, 17, 25, 21, 24, 23)
hh<-lm(y_2~A2*B2*C2)

paretoPlot(hh)
Como se observa en el diagrama de pareto el mejor tratamiento es el tiempo
d) Compruebe los supuestos del modelo.
NORMALIDAD
shapiro.test(residuals(lmod2))

##
## Shapiro-Wilk normality test
##
## data: residuals(lmod2)
## W = 0.93301, p-value = 0.272

boxplot(residuals(lmod2))

Interpretación
Al 95% deconfianza no se rechaza la hipotesis nula es decir que los datos cumplen con
normalidad.
HOMOCEDASTICIDAD
bartlett.test(y~A1)

##
## Bartlett test of homogeneity of variances
##
## data: y by A1
## Bartlett's K-squared = 0.12489, df = 1, p-value = 0.7238

bartlett.test(y~B1)
##
## Bartlett test of homogeneity of variances
##
## data: y by B1
## Bartlett's K-squared = 0.095367, df = 1, p-value = 0.7575

bartlett.test(y~C1)

##
## Bartlett test of homogeneity of variances
##
## data: y by C1
## Bartlett's K-squared = 2.6819, df = 1, p-value = 0.1015

Interpretación
Al 95% de confianza no se rechaza la hipotesis nula en tiempo, concentración, presión y
temperatura es decir si cumple homocedasticidad.
INDEPENDENCIA
library(lmtest)
dwtest(lmod2)

##
## Durbin-Watson test
##
## data: lmod2
## DW = 0.66087, p-value = 0.01731
## alternative hypothesis: true autocorrelation is greater than 0

Interpretación
A un nivel de confianza del 95% se obtuvo un p_valuemayor a cualquier nivel de significancia
por lo que se puede decir que los datos son independientes.

Ejercicio 4
En una empresa del área electrónica se quieren minimizar los problemas generados
en el proceso conocido como “Soldadora de ola”.Los defectos que se quieren reducir
son insuficiencias de soldadura en las tarjetas. Los factores y niveles que
inicialmente se decide estudiar son:

Velocidad
4
7
4
7
4
7
4
7

velocidad de conveyor (4 y 7 pies/minuto), temperatura de precalentado (80 y


120°C), y temperatura de soldadura (470 y 500°C). Debido a que el proceso es muy
rápido (se suelda una tarjeta cada 10 a 15 segundos) se decide soldar en cada
condición de prueba 25 tarjetas. La variable de respuesta es la cantidad de
insuficiencias detectadas en los diferentes puntos de soldadura de las 25 tarjetas.
Se hicieron dos réplicas. La matriz de diseño y los datos obtenidos se muestran a
continuación:
A<-as.factor(rep(c(4,7),each= 2,4))
B<-as.factor(rep(c(80,120),each=4,2))
C<-as.factor( rep(c(470,500),each=8))
y1<-c(29, 25, 110, 110, 23 ,27, 77, 59, 12, 44, 146, 162, 51, 35,
42, 48)
modelo<-lm(y1~A*B*C)

a) Haga un análisis completo y determine los efectos más importantes, el ANOVA y el


an?lisis de residuos.
anova(modelo)

A
B
C
A:B
A:C
B:C
A:B:C
Residuals

Los efectos que son mas importantes son:Velocidad, Precalentado, Velocidad con
Precalentado y Velocidad con Precalentado y Soldadura.
RESIDUOS
NORMALIDAD
shapiro.test(residuals(modelo))

##
## Shapiro-Wilk normality test
##
## data: residuals(modelo)
## W = 0.98045, p-value = 0.9671

dev.off()

## null device
## 1

boxplot(residuals(modelo))

Interpretación
Al 95% deconfianza no se rechaza la hipotesis nula es decir que los supuestos cumplen con
normalidad.
HOMOCEDASTICIDAD
bartlett.test(y1~A)

##
## Bartlett test of homogeneity of variances
##
## data: y1 by A
## Bartlett's K-squared = 8.7978, df = 1, p-value = 0.003016

bartlett.test(y1~B)

##
## Bartlett test of homogeneity of variances
##
## data: y1 by B
## Bartlett's K-squared = 7.8427, df = 1, p-value = 0.005103

bartlett.test(y1~C)

##
## Bartlett test of homogeneity of variances
##
## data: y1 by C
## Bartlett's K-squared = 0.91586, df = 1, p-value = 0.3386

Interpretación
Al 95% de confianza se rechaza la hipotesis nula en la velocidad y en el precalentado, esdecir
no cumple homocedasticidad; mietras que la soldadura si cumple homocedasticidad.
INDEPENDENCIA
library(lmtest)
dwtest(modelo)

##
## Durbin-Watson test
##
## data: modelo
## DW = 2.7334, p-value = 0.3443
## alternative hypothesis: true autocorrelation is greater than 0

Interpretación
Al 95% deconfianza no se rechaza la hipotesis nula es decir que los supuestos cumplen con
independencia.
b) Al parecer, la interacción velocidad-precalentado es importante, de ser así realice
una interpretación detallada de tal interacción en términos físicos.
A1<-rep(c(-1,1),8)
B1<-rep(c(-1,1),each=2,4)
C1<- rep(c(-1,1),each=4,2)
y_1<-c(25, 110, 27, 59, 44, 162, 35, 48,
29, 110, 23, 77, 12, 146, 51,42)
hh<-lm(y_1~A1*B1*C1)
paretoPlot(hh)
interaction.plot(A,B,y1)
Interpretación
Como se puede observar en el grafico de pareto y en la grafica de interaccion existe una
relacion significativa entre la velocidad y el precalentado es decir que a mayor temperatura
de precalentado y menor velocidad de conveyor existe menor catidad de insuficiencias.
c) ¿Cuáles serán las condiciones de operación del proceso que podr?an utilizarse
para reducir la cantidad de insuficiencias? Analice las opciones disponibles
Para reducir la cantidad de insuficiencias se recomienda que la temperatura de
precalentado sea de 120°C y la velocidad de conveyor sea 4 pies/minuto.

Ejercicio 5
El tequila es una bebida que está sujeta a una norma oficial mexicana, y conforme a
ésta se debe cumplir con ciertas especificaciones físico-químicas. En un laboratorio
de investigación, mediante un diseño factorial 25 no replicado, se estudio la
influencia de diversos factores sobre la producción de alcoholes superiores en la
etapa de fermentación. Los factores estudiados y los niveles fueron: tipo de cepa,
A(1, 2), temperatura, B(30, 35°C), fuente de nitr?geno, C(NH4)2SO4 y urea-, relación
carbono/nitrógeno, D(62/1, 188/1) y porcentaje de inóculo, E(5 y 10%). En la
siguiente tabla se muestran los resultados obtenidos en cuanto a alcohol isoam?lico
(mg/L), que es parte de los alcoholes superiores.

(1)=21,4
a=16,8
b=29,3
ab=12,7
c=27,5
ac=22,9
bc=35,4
abc=18,8

a) Dibuje el diagrama de Pareto y el gráfico de Daniel considerando todas las


interacciones de alto orden.¿Cuáles efectos parecen estar activos?
A<-(rep(c(-1,1),16))
A

## [1] -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1 1 -1
1 -1
## [26] 1 -1 1 -1 1 -1 1

B<-as.factor(rep(c(-1,1),each=2,8))
B

## [1] -1 -1 1 1 -1 -1 1 1 -1 -1 1 1 -1 -1 1 1 -1 -1 1 1 -1 -1 1
1 -1
## [26] -1 1 1 -1 -1 1 1
## Levels: -1 1

C<-as.factor(rep(c(-1,1),each=4,4))
C

## [1] -1 -1 -1 -1 1 1 1 1 -1 -1 -1 -1 1 1 1 1 -1 -1 -1 -1 1 1 1
1 -1
## [26] -1 -1 -1 1 1 1 1
## Levels: -1 1

D<-as.factor(rep(c(-1,1),each=8,2))
D

## [1] -1 -1 -1 -1 -1 -1 -1 -1 1 1 1 1 1 1 1 1 -1 -1 -1 -1 -1 -1 -1
-1 1
## [26] 1 1 1 1 1 1 1
## Levels: -1 1

E<-as.factor(rep(c(-1,1),each=16))
E

## [1] -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 1 1 1 1 1 1 1
1 1
## [26] 1 1 1 1 1 1 1
## Levels: -1 1
y1<-c(21.4,16.8,29.3,12.7,27.5,22.9,35.4,18.8,42.5,21,79.1,20,48.6,27.1,85.2,

26.1,32.9,17.5,30,24.1,26.7,11.4,23.9,18,54,21.8,79.9,31.5,47.9,15.6,73.8,25.
4
)
library(pid)
lmod2<-lm(y1~A*B*C*D*E)
paretoPlot(lmod2)
DanielPlot(lmod2)
¿Cuáles efectos parecen estar activos?
Los efectos activos son: BD ; D ; ABE ; E ; C ; B ; ABCDE ; ADE ; ACE ; BDE ; BCE ; DE
b) Determine el mejor análisis de varianza e interprételo.
lmod1<-lm(y1~A+B+C+D+E+(A*B)+(A*C)+(A*D)+(A*E)+(B*C)+
(B*D)+(B*E)+(C*D)+(C*E)+(D*E))
modelo<-anova(lmod1)
modelo

A
B
C
D
E
A:B
A:C
A:D
A:E
B:C
B:D
B:E
C:D
C:E
D:E
Residuals
**Interpreta

Los efectos que son significativos son A ; B ; D ; AB ; AD ; BD ; CE


c) Obtenga las gráficas de los efectos que resultaron importantes en el ANOVA, e
interprételas con detalle.
tabla2<-FrF2(nruns = 8,
nfactors = 3,
factor.names=list(A=c(-1,1),
B=c(-1,1),
C=c(-1,1)),
# por que en c tenmos 4 -1 y 4 1
replications=4,randomize=FALSE

## creating full factorial with 8 runs ...

tabla2<-add.response(design = tabla2,response = y1)


tabla2

A
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
-1
1
MEPlot(tabla2,lwd=2)
IAPlot(tabla2,lwd=2)

d) Determine los tratamientos que minimizan y maximizan la variable de respuesta.


mejor<-lm(y1~A+B+D+(A*B)+(A*D)+(B*D)+(C*E))
mejor

##
## Call:
## lm.default(formula = y1 ~ A + B + D + (A * B) + (A * D) + (B *
## D) + (C * E))
##
## Coefficients:
## (Intercept) A B1 D1 C1
E1
## 19.087 -1.787 1.888 12.675 6.100
6.113
## A:B1 A:D1 B1:D1 C1:E1
## -7.038 -14.850 15.925 -12.225

cubePlot(y1,eff1 = A,eff2 = B,eff3 = C)

Interpretación
PARA MAXIMIZAR SE VE LOS PUNTOS EN CADA ESQUINA DEL CUBO
La maximizacion en el cubo indica que es en 54.575
La minimizacion en el cubo indica que es en 19.25
e) Verifique los supuestos del modelo. ¿Qué puede concluir del análisis de residuos?
COMPROBACION DE SUPUESTOS
par(mfrow=c(2,2))
plot(mejor)

NORMALIDAD
shapiro.test(residuals(mejor))

##
## Shapiro-Wilk normality test
##
## data: residuals(mejor)
## W = 0.84286, p-value = 0.0002917

boxplot(residuals(mejor))
Interpretación
Rechazo la hipotesis nula y se indica que no son normales los datos se nota que existe un dato
atípico y es necesario realizar una corrección de este dato
ver datos atipicos que afecten el modelo
library(tseries)

## Warning: package 'tseries' was built under R version 4.0.2

## Registered S3 method overwritten by 'quantmod':


## method from
## as.zoo.data.frame zoo

jarque.bera.test(residuals(mejor))

##
## Jarque Bera Test
##
## data: residuals(mejor)
## X-squared = 1.417, df = 2, p-value = 0.4924

Interpretación
Acepto h1 y digo q los datos influyen en la normalidad del proceso
H0= datos no influyen en la normalidad del proceso
H1= Los datos influyen en la normalidad del proceso
library(car)

## Warning: package 'car' was built under R version 4.0.2

## Loading required package: carData

outlierTest(mejor)

## No Studentized residuals with Bonferroni p < 0.05


## Largest |rstudent|:
## rstudent unadjusted p-value Bonferroni p
## 17 1.45138 0.16145 NA

interpretación
el dato de la posicion 17 es atipico estos datos atipicos afectan a la normalidad
homocedasticidad
bartlett.test(y1~A)

##
## Bartlett test of homogeneity of variances
##
## data: y1 by A
## Bartlett's K-squared = 22.296, df = 1, p-value = 2.337e-06

Interpretación
No rechazo la hipotesis nula lo que indica que siguen homocedasticidad el efect A
bartlett.test(y1~B)

##
## Bartlett test of homogeneity of variances
##
## data: y1 by B
## Bartlett's K-squared = 5.9236, df = 1, p-value = 0.01494

Interpretación
Rechazo la hipotesis nula lo que indica que siguen homocedasticidad el efect B
bartlett.test(y1~C)

##
## Bartlett test of homogeneity of variances
##
## data: y1 by C
## Bartlett's K-squared = 1.1695e-06, df = 1, p-value = 0.9991

Interpretación
No rechazo la hipotesis nula lo que indica que siguen homocedasticidad el efect A
bartlett.test(y1~D)

##
## Bartlett test of homogeneity of variances
##
## data: y1 by D
## Bartlett's K-squared = 18.252, df = 1, p-value = 1.936e-05

Interpretación
No rechazo la hipotesis nula lo que indica que siguen homocedasticidad el efect A
bartlett.test(y1~E)

##
## Bartlett test of homogeneity of variances
##
## data: y1 by E
## Bartlett's K-squared = 0.029758, df = 1, p-value = 0.863

interpretación
No rechazo la hipotesis nula lo que indica que siguen homocedasticidad el efect A
independencia
library(lmtest)
dwtest(mejor)

##
## Durbin-Watson test
##
## data: mejor
## DW = 2.3976, p-value = 0.7477
## alternative hypothesis: true autocorrelation is greater than 0

Interpretación
No rechazo la hipotesis nula lo que indica que los datos si son independientes
f) ¿Es pertinente colapsar este diseño en un factorial 24 con dos réplicas? Si la
respuesta es positiva, hágalo.
No es pertinente colapsar este diseñ o en un factorial 24 ya que tenemos 5 efecto y seria casi
imposible realizar predicciones aun menos realizar las dos replicas ya que esto nos
generara un gasto y pasantia de tiempo muy extremandamente extenso lo mejor es correjir
el dato atipico que se tiene y realizar las modificaciones necesarias.
Ejemplo 6
Se desea investigar de qué manera afecta el tiempo de curado y el tipo del acelerante
a la resistencia de caucho vulcanizado. Se realiza un experimento y se obtienen los
siguientes datos:

Tiempo de cura a 14°c(minutos)

40
60
80

a) Señale el nombre del diseño de experimento utilizado y su modelo estadístico.


Diseñ o factorial mixto: AxB, 3x3, n=2
Y=μ+α+ β i+(α*β ¿i j+ Ei j k
efectoA<-as.factor(rep(c(-1,0,1),each=3,2))
efectoA

## [1] -1 -1 -1 0 0 0 1 1 1 -1 -1 -1 0 0 0 1 1 1
## Levels: -1 0 1

efectoB<-as.factor(rep(c(-1,0,1),6))
efectoB

## [1] -1 0 1 -1 0 1 -1 0 1 -1 0 1 -1 0 1 -1 0 1
## Levels: -1 0 1

pegamento<-c(3900, 4300, 3700,


4100,4200,3900,
4000, 4300, 3600,
3600, 3700, 4100,
3500, 3900, 4000,
3800, 3600,3800)

lmod2<-lm(pegamento~efectoA*efectoB)

lmod2

##
## Call:
## lm.default(formula = pegamento ~ efectoA * efectoB)
##
## Coefficients:
## (Intercept) efectoA0 efectoA1 efectoB0
## 3.750e+03 5.000e+01 1.500e+02 2.500e+02

## efectoB1 efectoA0:efectoB0 efectoA1:efectoB0 efectoA0:efectoB1

## 1.500e+02 -6.029e-14 -2.000e+02 -2.089e-13

## efectoA1:efectoB1
## -3.500e+02

b) Formule claramente todas las hipótesis que se pueden probar.


Hipótesis
Tiempo de curado
Ho: El tiempo de curado no interviene en la resistencia del caucho vulcanizado.
H1: El tiempo de curado interviene en la resistencia del caucho vulcanizado.
Acelerante
Ho: El acelerante no afecta en la resistencia del caucho vulcanizado.
H1: El acelerante afecta en la resistencia del caucho vulcanizado.
Interacción
Ho: El efecto del tiempo de curado no depende del acelerante.
H1: El efecto del tiempo de curdo depende del acelerante.
c) Realice el análisis estadístico apropiado para probar las hipótesis que formuló.
efectoA<-as.factor(rep(c(-1,0,1),each=3,2))
efectoA

## [1] -1 -1 -1 0 0 0 1 1 1 -1 -1 -1 0 0 0 1 1 1
## Levels: -1 0 1

efectoB<-as.factor(rep(c(-1,0,1),6))
efectoB

## [1] -1 0 1 -1 0 1 -1 0 1 -1 0 1 -1 0 1 -1 0 1
## Levels: -1 0 1

pegamento<-c(3900, 4300, 3700,


4100,4200,3900,
4000, 4300, 3600,
3600, 3700, 4100,
3500, 3900, 4000,
3800, 3600,3800)

lmod2<-lm(pegamento~efectoA*efectoB)
anova(lmod2)

efectoA
efectoB
efectoA:efectoB
Residuals

Interpretacion
Al 95% de confianza se obtuvo que ninguno de los tratamientos es significativo al modelo y
por lo tanto el tiempo de curado a 40, 60 y 80 min no afecta al resistencia del caucho .Así
como el tipo de acelerante A, B, C tampoco afecta a la resistencia del caucho.
d)En caso de haberlo, señale el tiempo de cura que es mejor para aumentar la
resistencia.e)Señale el acelerante que es mejor (si es que lo hay), para aumentar la
resistencia.f)¿Hay alguna combinación de tiempo y acelerante que sea mejor? Diga
cuál es, si lahay.g)Verifique que se cumplan los supuestos. En caso de que no se
cumpliera el supuesto de igual varianza para tiempo de cura, ¿qué significaría eso?
boxplot(pegamento ~efectoA,horizontal=T,col=c("red","blue","pink","green"))

tapply(pegamento,efectoA,mean)
## -1 0 1
## 3883.333 3933.333 3850.000

library(gplots)

## Warning: package 'gplots' was built under R version 4.0.2

##
## Attaching package: 'gplots'

## The following object is masked from 'package:stats':


##
## lowess

plotmeans(pegamento~efectoA)

Interpretación
Como podemos observar en la gráfica los tres tiempos de cura serian iguales ya que ay un
excelente traslape entre los tres tiempos.
e)Señale el acelerante que es mejor (si es que lo hay), para aumentar la resistencia.
boxplot(pegamento ~ efectoB,horizontal=T,col=c("red","blue","pink","green"))
tapply(pegamento,efectoB,mean)

## -1 0 1
## 3816.667 4000.000 3850.000

library(gplots)

plotmeans(pegamento~efectoB)
Interpretación
Los tres tipos de acelerantés son iguales al existir un excelente traslape entre ellos como se
puede observar en la gráfica.
f)¿Hay alguna combinación de tiempo y acelerante que sea mejor? Diga cuál es, si la
hay.
Tratamiento ganador
EFECTO DE INTERACCION AB
interaction.plot(efectoA,efectoB,pegamento)
Interpretación
La mejor resistencia al caucho seria a un tiempo de 60 min con el acelerarte del tipo B
g)Verifique que se cumplan los supuestos. En caso de que no se cumpliera el
supuesto de igual varianza para tiempo de cura, ¿qué significaría eso?
Supuestos del modelo
INDEPENDENCIA
Ho los errores estan incorrelados
H1 los errores estan correlados
require(lmtest)
FF<-data.frame(efectoA,efectoB,pegamento)
dwtest(pegamento~efectoA*efectoB,data=FF)

##
## Durbin-Watson test
##
## data: pegamento ~ efectoA * efectoB
## DW = 2.1311, p-value = 0.6543
## alternative hypothesis: true autocorrelation is greater than 0

Interpretación
El valor p de la prueba de durvin watson es mayor a cualquier valor de significancia y se
acepta ho y se dice que hay independencia de los datos
NORMALIDAD
Ho los errores son normales
H1 los errores no siguen una distribucion normal
Lmod<-lm(pegamento~efectoB*efectoA)
shapiro.test(residuals(Lmod))

##
## Shapiro-Wilk normality test
##
## data: residuals(Lmod)
## W = 0.95118, p-value = 0.4438

Interpretación
Al haber realizado la prueba de shapiro al 95% de confianza se Obtiene un p-value del 0,449
que es superior al p teorico de 0,05por lo cualno se rechaza la hipotesis nula y por ende se
puede concluir que los datos siguen una distribucion normal
HOMOCEDASTICIDAD
Ho tienen varianza constante
H1 no tienen varianza constante
bartlett.test(pegamento~interaction(efectoA,efectoB))

##
## Bartlett test of homogeneity of variances
##
## data: pegamento by interaction(efectoA, efectoB)
## Bartlett's K-squared = 3.7401, df = 8, p-value = 0.8798

bartlett.test(residuals(Lmod)~interaction(efectoA,efectoB))

##
## Bartlett test of homogeneity of variances
##
## data: residuals(Lmod) by interaction(efectoA, efectoB)
## Bartlett's K-squared = 3.7401, df = 8, p-value = 0.8798

Interpretacion
Despues de haber realizado el test de bartlett al 95% de confienza se obtuvo un p-value del
0,058 que es mayor al 0,05 por lo cual se acepta la hipotesis nula y se puede concluir que los
datos tiene varianza constante.
boxplot(residuals(Lmod)~efectoA*efectoB)
boxplot(pegamento~efectoA)

boxplot(pegamento~efectoB)
Interpretacion
Debe de existir mucha dspersión en los datos por lo cual puede ocurrir que la varianza no sea
igual entre los distintos tratamientos o a su vez existe un factor que esta afectando a los
mismo por lo cual este esta generando este efecto y tambien pueda deberse a la existencia de
datos atipicos.

Ejercicio 7
Se aplican pinturas tapaporos para aeronaves en superficies de aluminio, con dos
métodos: inmersión y rociado. La finalidad del tapaporos es mejorar la adhesión de
la pintura, y puede aplicarse en algunas partes utilizando cualquier método. El grupo
de ingeniería de procesos responsable de esta operación está interesado en saber si
existen diferencias entre tres tapaporos diferentes en cuanto a sus propiedades de
adhesión. Para investigar el efecto que tienen el tipo de pintura tapaporos y el
método de aplicación sobre la adhesión de la pintura, se realiza un diseño factorial.
Para ello, se pintan tres muestras con cada tapaporo utilizando cada método de
aplicació, después se aplica una capa final de pintura y a continuación se mide la
fuerza de adhesión. Los datos son los siguientes:

Impresió n
1 4
2 5,6
3 3,8
library(gplots)
library(ggplot2)
library(lmtest)
Tapaporos <- factor(rep(c(1, 2, 3), each = 3, 2))
Metodo <- factor(rep(c(-1, 1), each = 9))
fuerza <- c(4, 4.5, 4.3,
5.6, 4.9, 5.4,
3.8, 3.7, 4,
5.4, 4.9, 5.6,
5.8, 6.1, 6.3,
5.5, 5, 5)
df <- data.frame(Tapaporos, Metodo, fuerza)
fix(df)

a) Formule el modelo estadistico


Diseñ o factorial mixto con 2 factores con diferentes niveles
b) Obtenga el ANOVA sin desglosar, obtenga concluiones
Hipotesis para el factor Tapaporos
H0: El efecto del factor A, Tapaporos es = 0
H1: El efecto del factor A, Tapaporos es ≠ 0
Hipotesis para el factor Metodo
H0: El efecto del factor B, Metodo es = 0
H1: El efecto del factor B, Metodo es ≠ 0
Hipotesis para el efecto de interaccion Tapaporos x Metodo
H0: El efecto del factor A, Tapaporos es = 0
H1: El efecto del factor B, Metodo es ≠ 0
Nivel de significancia
α =0.05
Analisis de varianza ANOVA
ml1 <- lm(fuerza ~ Tapaporos * Metodo, data = df)
anova(ml1)

Tapaporos
Metodo
Tapaporos:Metodo
Residuals

Interpretación
a un nivel de significancia del 5% y a cualquier nivel de significancia, el efecto del factor
Tapaporos y el efecto del factor Metodo son estadisticamente altamente significativos, es
decir, tienen un efecto sobre la variable respuesta fuerza de adhesion, mientras que, el efecto
de la interacion AB, estadisticamente no es significativo, no tiene ningun efecto sobre la
variable respuesta.
c) Realice la gráfica de efectos principales y de interaccion, destaque los aspectos
más relevantes. ¿Cuál es el mejor tratamiento?
Efecto principal del factor Tapaporos
plotmeans(fuerza ~ Tapaporos, bars = F)

Factor_A <- tapply(fuerza, Tapaporos, mean)


Factor_A <- data.frame(Promedios = Factor_A, Niveles = factor(c(1, 2, 3)))

theme_update(plot.title = element_text(hjust = 0.5))


ggplot(Factor_A, aes(Niveles, Promedios, group = 1, color = Niveles)) +
geom_point() + geom_line(color = "blue") +
ggtitle("Efectos principales del Factor Tapaporos") +
xlab("Tipos de Tapaporos") + ylab("Fuerza de ahesi?n")
Efecto pricipal del factor Metodo
plotmeans(fuerza ~ Metodo, bars = F)
Factor_B <- tapply(fuerza, Metodo, mean)
Factor_B <- data.frame(Promedios = Factor_B, Niveles = factor(c("Inmersi?n",
"Rociado")))

ggplot(Factor_B, aes(Niveles, Promedios, group = 1)) +


geom_point() + geom_line(color = "blue") +
ggtitle("Efectos principales del Factor Metodo") +
xlab("Tipos de Metodo") + ylab("Fuerza de ahesi?n")

Efecto de interaccion AxB


interaction.plot(Tapaporos, Metodo, fuerza)
Intepretación
Los graficos de los efectos principales muestran que graficamente existe una clara curvatura
en el factor “Tapaporos” mientras que en el factor “Metodo” al haber solo dos niveles se
aprecia una linealidad exacta, de esto tambien destaca, que con el objetivo de obtenr una
mayor fuerza promedio de adhesion con el factos “Tapaporos” es mejor utilizar en su nivel 2
mientras que con el factor “Metodo”, se genera un mayor promedio de fuerza de adhesion con
el metodo de Rociado.
El ANOVA mostro que no existe el efecto de la interaccion de los factores en estudio, eso se
evidencia graficamente en la cual las lineas son paralelas indicando la ausencia del efecto de
interaccion.
d) De la gráfica de efectos principales para el factor TAPAPOROS, ¿hay algun tipo de
evidencia de que el no sea lineal? Argumente se respuesta.
ggplot(Factor_A, aes(Niveles, Promedios, group = 1, color = Niveles)) +
geom_point() + geom_line(color = "blue") +
ggtitle("Efectos principales del Factor Tapaporos") +
xlab("Tipos de Tapaporos") + ylab("Fuerza de ahesi?n")
Interpretación
Graficamente se observa que la linealidad no existe, se aprecia una clara curvatura el nivel 2
del factor A ocaciona que la linealidad desaparesca.
e) Verifique supuestos del modelo, incumple alguno?
Normalidad
H0: Los residuos siguen una ley normal
H1: Los residuos no siguen una ley normal
shapiro.test(ml1$residuals)

##
## Shapiro-Wilk normality test
##
## data: ml1$residuals
## W = 0.93702, p-value = 0.2575

plot(ml1, which = 2)
Interpretación
Por medio del test de shapiro, se comprueba que a un nivel de signifiacnia del 5% no se
rechaza H0 y se concluye que los residuos siguen una ley normal.
Homocedasticidad
H0: los residuos tienen varianzas cosntantes
H1: Los residuos no tienen varianzas constantes
bartlett.test(ml1$residuals ~ Tapaporos)

##
## Bartlett test of homogeneity of variances
##
## data: ml1$residuals by Tapaporos
## Bartlett's K-squared = 0.50133, df = 2, p-value = 0.7783

bartlett.test(ml1$residuals ~ Metodo)

##
## Bartlett test of homogeneity of variances
##
## data: ml1$residuals by Metodo
## Bartlett's K-squared = 0.11221, df = 1, p-value = 0.7376

Interpretación
A un nivel de significancia del 5% o cualquier nivel de significancia no se rechaza H0 y los
residuos tienen varianzas cosntantes.
Independencia
H0: Los residuos estan incorrelados
H1: Los residuos no estan incorrelados
dwtest(ml1$residuals ~ Tapaporos + Metodo)

##
## Durbin-Watson test
##
## data: ml1$residuals ~ Tapaporos + Metodo
## DW = 2.7106, p-value = 0.8284
## alternative hypothesis: true autocorrelation is greater than 0

plot(1:length(ml1$residuals) , ml1$residuals)

Interpretación
Graficamente y por medio del test se comprueba que los residuos estan incorrelados
f) Obtenga el anova desglosado. Comente lo obtenido
Tapaporos <- rep(c(-1, 0, 1), each = 3, 2)
Metodo <- rep(c(-1, 1), each = 9)
fuerza <- c(4, 4.5, 4.3,
5.6, 4.9, 5.4,
3.8, 3.7, 4,
5.4, 4.9, 5.6,
5.8, 6.1, 6.3,
5.5, 5, 5)

ml1 <- lm(fuerza ~ I(Tapaporos) + I(Tapaporos^2) + I(Metodo) + I(Tapaporos *


Metodo) + I((Tapaporos^2) * Metodo))
anova(ml1)

I(Tapaporos)
I(Tapaporos^2)
I(Metodo)
I(Tapaporos * Metodo)
I((Tapaporos^2) * Metodo)
Residuals

Interpretación
El anova desglosado confirma lo obtenido en la grafica de efectos principales del factor
Tapaporos a un nivel de significnacia del 5% y en general a cualquier nivel de significancia, la
curvatura es altamente significativa, existe una clara curvatura que tiene efecto dobre la
variable respuesta y por lo contrario el factor Metodo al tener solo dos niveles solo posee un
linealidad exacta por lo este factor esta activo linealmente.

También podría gustarte