Location via proxy:   [ UP ]  
[Report a bug]   [Manage cookies]                

Diseños Grupal1

Descargar como pdf o txt
Descargar como 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.

FACTOR NIVELES (BAJO,ALTO) NIVELES (BAJO,ALTO)


A un punto dos puntos
B fibra incandescente
C 725 850
D girado normal
E brillo normal

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 d=0 e=34 de=0


a=0 ad=0 ae=3 ade=0
b=66 bd=0 be=18 bde=0
ab=7 abd=5 abe=2 abde=0
c=54 cd=25 ce=0 cde=0
ac=1 acd=1 ace=0 acde=0
bc=41 bcd=0 bce=49 bcde=0
abc=0 abcd=0 abce=4 abcde=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)

Df Sum Sq Mean Sq F value Pr(>F)


A 1 4255.03125 4255.03125 18.8797837 0.0005013
B 1 30.03125 30.03125 0.1332501 0.7198660
C 1 132.03125 132.03125 0.5858292 0.4551794
D 1 3894.03125 3894.03125 17.2780089 0.0007429
E 1 1188.28125 1188.28125 5.2724626 0.0355108
A:B 1 101.53125 101.53125 0.4504992 0.5116724
A:C 1 57.78125 57.78125 0.2563783 0.6195248
A:D 1 3423.78125 3423.78125 15.1914864 0.0012802
A:E 1 1069.53125 1069.53125 4.7455630 0.0446736
B:C 1 101.53125 101.53125 0.4504992 0.5116724
B:D 1 3.78125 3.78125 0.0167776 0.8985540
B:E 1 331.53125 331.53125 1.4710205 0.2427886
C:D 1 357.78125 357.78125 1.5874931 0.2257528
C:E 1 101.53125 101.53125 0.4504992 0.5116724
D:E 1 552.78125 552.78125 2.4527177 0.1368835
Residuals 16 3606.00000 225.37500 NA NA

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)
Df Sum Sq Mean Sq F value Pr(>F)
A 1 4255.031 4255.0312 20.577452 0.0001143
D 1 3894.031 3894.0312 18.831646 0.0001920
E 1 1188.281 1188.2812 5.746562 0.0239994
A:D 1 3423.781 3423.7812 16.557503 0.0003903
A:E 1 1069.531 1069.5312 5.172283 0.0314396
Residuals 26 5376.312 206.7812 NA NA

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)

Df Sum Sq Mean Sq F value Pr(>F)


A 1 4255.0312 4255.0312 24.617791 0.0000458
D 1 3894.0312 3894.0312 22.529199 0.0000791
E 1 1188.2812 1188.2812 6.874887 0.0149413
A:D 1 3423.7812 3423.7812 19.808534 0.0001679
A:E 1 1069.5312 1069.5312 6.187850 0.0202064
D:E 1 552.7812 552.7812 3.198156 0.0863542
A:D:E 1 675.2812 675.2812 3.906888 0.0596888
Residuals 24 4148.2500 172.8438 NA NA
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 D E Blocks Y
-1 -1 -1 .1 105
1 -1 -1 .1 0
-1 1 -1 .1 66
1 1 -1 .1 7
-1 -1 1 .1 54
1 -1 1 .1 1
-1 1 1 .1 41
1 1 1 .1 0
-1 -1 -1 .2 0
1 -1 -1 .2 0
-1 1 -1 .2 0
1 1 -1 .2 5
-1 -1 1 .2 25
1 -1 1 .2 1
-1 1 1 .2 0
1 1 1 .2 0
-1 -1 -1 .3 34
1 -1 -1 .3 3
-1 1 -1 .3 18
1 1 -1 .3 2
-1 -1 1 .3 0
1 -1 1 .3 0
-1 1 1 .3 49
1 1 1 .3 4
-1 -1 -1 .4 0
1 -1 -1 .4 0
-1 1 -1 .4 0
1 1 -1 .4 0
-1 -1 1 .4 0
1 -1 1 .4 0
-1 1 1 .4 0
1 1 1 .4 0

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)

Df Sum Sq Mean Sq F value Pr(>F)


A 1 4255.031 4255.0312 20.577452 0.0001143
D 1 3894.031 3894.0312 18.831646 0.0001920
E 1 1188.281 1188.2812 5.746562 0.0239994
A:D 1 3423.781 3423.7812 16.557503 0.0003903
A:E 1 1069.531 1069.5312 5.172283 0.0314396
Residuals 26 5376.312 206.7812 NA NA
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)

Df Sum Sq Mean Sq F value Pr(>F)


A 1 4255.0312 4255.0312 24.617791 0.0000458
D 1 3894.0312 3894.0312 22.529199 0.0000791
E 1 1188.2812 1188.2812 6.874887 0.0149413
A:D 1 3423.7812 3423.7812 19.808534 0.0001679
A:E 1 1069.5312 1069.5312 6.187850 0.0202064
D:E 1 552.7812 552.7812 3.198156 0.0863542
A:D:E 1 675.2812 675.2812 3.906888 0.0596888
Residuals 24 4148.2500 172.8438 NA NA
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 D E Blocks Y
-1 -1 -1 .1 105
1 -1 -1 .1 0
-1 1 -1 .1 66
1 1 -1 .1 7
-1 -1 1 .1 54
1 -1 1 .1 1
-1 1 1 .1 41
1 1 1 .1 0
-1 -1 -1 .2 0
1 -1 -1 .2 0
-1 1 -1 .2 0
1 1 -1 .2 5
-1 -1 1 .2 25
1 -1 1 .2 1
-1 1 1 .2 0
1 1 1 .2 0
-1 -1 -1 .3 34
1 -1 -1 .3 3
-1 1 -1 .3 18
1 1 -1 .3 2
-1 -1 1 .3 0
1 -1 1 .3 0
-1 1 1 .3 49
1 1 1 .3 4
-1 -1 -1 .4 0
1 -1 -1 .4 0
-1 1 -1 .4 0
1 1 -1 .4 0
-1 -1 1 .4 0
1 -1 1 .4 0
-1 1 1 .4 0
1 1 1 .4 0
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 Nive bajo centro nivel alto


Velocidad baja media alta
temperatura 5 13 21
Tensión 4 8 12
Tipo de etiqueta esmaltada otra mate

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 Velocidad Etiqueta tension No pasan


1 1 1 1 20
-1 1 -1 1 20
1 1 1 -1 19
1 -1 1 -1 9
0 0 0 0 20
1 1 -1 -1 3
1 1 -1 1 20
-1 -1 1 -1 20
-1 1 1 1 20
-1 -1 -1 1 20
-1 -1 -1 -1 20
1 -1 1 1 7
-1 -1 1 1 20
-1 1 -1 -1 20
1 -1 -1 1 0
1 -1 -1 -1 5
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 temperatura velocidad etiqueta tension fallas


1 -1 -1 -1 -1 20
a 1 -1 -1 -1 5
b -1 1 -1 -1 20
ab 1 1 -1 -1 3
c -1 -1 1 -1 20
ac 1 -1 1 -1 9
bc -1 1 1 -1 20
abc 1 1 1 -1 19
d -1 -1 -1 1 20
ad 1 -1 -1 1 0
bd -1 1 -1 1 20
abd 1 1 -1 1 20
cd -1 -1 1 1 20
acd 1 -1 1 1 7
bcd -1 1 1 1 20
abcd 1 1 1 1 20
0 0 0 0 0 20
0 0 0 0 0 20

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)

D
f Sum Sq Mean Sq F value Pr(>F)
temperatura 1 370.562 370.562 18.00000 0.05131
50 50 00 67
velocidad 1 105.062 105.062 5.103390 0.15238
50 50 1 91
etiqueta 1 45.5625 45.5625 2.213189 0.27522
0 0 4 40
tension 1 7.56250 7.56250 0.367346 0.60608
9 07
temperatura:velocidad 1 105.062 105.062 5.103390 0.15238
50 50 1 91
temperatura:etiqueta 1 45.5625 45.5625 2.213189 0.27522
0 0 4 40
velocidad:etiqueta 1 1.56250 1.56250 0.075898 0.80878
1 92
temperatura:tension 1 7.56250 7.56250 0.367346 0.60608
9 07
velocidad:tension 1 39.0625 39.0625 1.897453 0.30225
0 0 2 77
etiqueta:tension 1 10.5625 10.5625 0.513071 0.54815
0 0 3 81
temperatura:velocidad:etiqueta 1 1.56250 1.56250 0.075898 0.80878
1 92
temperatura:velocidad:tension 1 39.0625 39.0625 1.897453 0.30225
0 0 2 77
temperatura:etiqueta:tension 1 10.5625 10.5625 0.513071 0.54815
0 0 3 81
velocidad:etiqueta:tension 1 22.5625 22.5625 1.095969 0.40502
0 0 0 21
temperatura:velocidad:etiqueta:te 1 22.5625 22.5625 1.095969 0.40502
nsion 0 0 0 21
Residuals 2 41.1736 20.5868 NA NA
1 1
modelo2<-lm(fallas~temperatura+velocidad+etiqueta+tension+

(temperatura*velocidad)+(temperatura*etiqueta)+(temperatura*tension)
+(velocidad*etiqueta)+(velocidad*tension)+(etiqueta*tension))
anova(modelo2)

Df Sum Sq Mean Sq F value Pr(>F)


temperatura 1 370.5625 370.56250 18.8669057 0.0033811
velocidad 1 105.0625 105.06250 5.3491767 0.0539615
etiqueta 1 45.5625 45.56250 2.3197798 0.1715562
tension 1 7.5625 7.56250 0.3850389 0.5545754
temperatura:velocidad 1 105.0625 105.06250 5.3491767 0.0539615
temperatura:etiqueta 1 45.5625 45.56250 2.3197798 0.1715562
temperatura:tension 1 7.5625 7.56250 0.3850389 0.5545754
velocidad:etiqueta 1 1.5625 1.56250 0.0795535 0.7860602
velocidad:tension 1 39.0625 39.06250 1.9888373 0.2013165
etiqueta:tension 1 10.5625 10.56250 0.5377816 0.4871808
Residuals 7 137.4861 19.64087 NA NA
modelo3<-lm(fallas~temperatura*velocidad+I(temperatura^2)+I(velocidad^2))
anova(modelo3)

Df Sum Sq Mean Sq F value Pr(>F)


temperatura 1 370.56250 370.56250 18.984483 0.0007767
velocidad 1 105.06250 105.06250 5.382512 0.0372475
I(temperatura^2) 1 41.17361 41.17361 2.109387 0.1701044
temperatura:velocidad 1 105.06250 105.06250 5.382512 0.0372475
Residuals 13 253.75000 19.51923 NA NA

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

tempe veloc etique tensi fallas


-1 -1 -1 -1 20
1 -1 -1 -1 5
-1 1 -1 -1 20
1 1 -1 -1 3
-1 -1 1 -1 20
1 -1 1 -1 9
-1 1 1 -1 20
1 1 1 -1 19
-1 -1 -1 1 20
1 -1 -1 1 0
-1 1 -1 1 20
1 1 -1 1 20
-1 -1 1 1 20
1 -1 1 1 7
-1 1 1 1 20
1 1 1 1 20
0 0 0 0 20
0 0 0 0 20

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𝐾 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:

Ao A1
Bo B1 Bo B1

Co C1 Co C2 Co C2 Co C2

Do 12 17 13 20 18 15 16 15
D1 10 19 13 17 25 21 24 23
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

Df Sum Sq Mean Sq F value Pr(>F)


A 1 81.00 81.00 NaN NaN
B 1 1.00 1.00 NaN NaN
C 1 16.00 16.00 NaN NaN
D 1 42.25 42.25 NaN NaN
A:B 1 2.25 2.25 NaN NaN
A:C 1 72.25 72.25 NaN NaN
B:C 1 0.25 0.25 NaN NaN
A:D 1 64.00 64.00 NaN NaN
B:D 1 0.00 0.00 NaN NaN
C:D 1 0.00 0.00 NaN NaN
A:B:C 1 4.00 4.00 NaN NaN
A:B:D 1 2.25 2.25 NaN NaN
A:C:D 1 0.25 0.25 NaN NaN
B:C:D 1 2.25 2.25 NaN NaN
A:B:C:D 1 4.00 4.00 NaN NaN
Residuals 0 0.00 NaN NA NA

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)

Df Sum Sq Mean Sq F value Pr(>F)


A1 1 81.00 81.000 5.6347826 0.0449810
B1 1 1.00 1.000 0.0695652 0.7986376
C1 1 16.00 16.000 1.1130435 0.3222383
A1:B1 1 2.25 2.250 0.1565217 0.7027203
A1:C1 1 72.25 72.250 5.0260870 0.0552619
B1:C1 1 0.25 0.250 0.0173913 0.8983387
A1:B1:C1 1 4.00 4.000 0.2782609 0.6121556
Residuals 8 115.00 14.375 NA NA

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 Precalentado Soldadura Insuficientes Insuficientes


4 80 470 29 25
7 80 470 110 110
4 120 470 23 27
7 120 470 77 59
4 80 500 12 44
7 80 500 146 162
4 120 500 51 35
7 120 500 42 48

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)

Df Sum Sq Mean Sq F value Pr(>F)


A 1 16129 16129.0 133.8506224 0.0000028
B 1 4761 4761.0 39.5103734 0.0002364
C 1 400 400.0 3.3195021 0.1059353
A:B 1 6724 6724.0 55.8008299 0.0000713
A:C 1 1 1.0 0.0082988 0.9296548
B:C 1 625 625.0 5.1867220 0.0522800
A:B:C 1 1764 1764.0 14.6390041 0.0050458
Residuals 8 964 120.5 NA NA

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 d=42,5 e=32,9 de=54,0
a=16,8 ad=21,0 ae=17,5 ade=21,8
b=29,3 bd=79,1 be=30,0 bde=79,9
ab=12,7 abd=20,0 abe=24,1 abde=31,5
c=27,5 cd=48,6 ce=26,7 cde=47,9
ac=22,9 acd=27,1 ace=11,4 acde=15,6
bc=35,4 bcd=85,2 bce=23,9 bcde=73,8
abc=18,8 abcd=26,1 abce=18,0 abcde=25,4

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

Df Sum Sq Mean Sq F value Pr(>F)


A 1 5186.71125 5186.71125 148.7925664 0.0000000
B 1 776.18000 776.18000 22.2664823 0.0002318
C 1 0.00125 0.00125 0.0000359 0.9952961
D 1 3407.25125 3407.25125 97.7447237 0.0000000
E 1 0.00000 0.00000 0.0000000 1.0000000
A:B 1 396.21125 396.21125 11.3662176 0.0038880
A:C 1 0.00000 0.00000 0.0000000 1.0000000
A:D 1 1764.18000 1764.18000 50.6095013 0.0000025
A:E 1 0.00125 0.00125 0.0000359 0.9952961
B:C 1 0.00125 0.00125 0.0000359 0.9952961
B:D 1 507.21125 507.21125 14.5505042 0.0015253
B:E 1 0.00000 0.00000 0.0000000 1.0000000
C:D 1 0.00000 0.00000 0.0000000 1.0000000
C:E 1 298.90125 298.90125 8.5746597 0.0098459
D:E 1 0.01125 0.01125 0.0003227 0.9858891
Residuals 16 557.73875 34.85867 NA NA
**Interpreta ción* *

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 B C Blocks y1
-1 -1 -1 .1 21.4
1 -1 -1 .1 16.8
-1 1 -1 .1 29.3
1 1 -1 .1 12.7
-1 -1 1 .1 27.5
1 -1 1 .1 22.9
-1 1 1 .1 35.4
1 1 1 .1 18.8
-1 -1 -1 .2 42.5
1 -1 -1 .2 21.0
-1 1 -1 .2 79.1
1 1 -1 .2 20.0
-1 -1 1 .2 48.6
1 -1 1 .2 27.1
-1 1 1 .2 85.2
1 1 1 .2 26.1
-1 -1 -1 .3 32.9
1 -1 -1 .3 17.5
-1 1 -1 .3 30.0
1 1 -1 .3 24.1
-1 -1 1 .3 26.7
1 -1 1 .3 11.4
-1 1 1 .3 23.9
1 1 1 .3 18.0
-1 -1 -1 .4 54.0
1 -1 -1 .4 21.8
-1 1 -1 .4 79.9
1 1 -1 .4 31.5
-1 -1 1 .4 47.9
1 -1 1 .4 15.6
-1 1 1 .4 73.8
1 1 1 .4 25.4
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) acelerantes


A B C

40 3900 3600 4300 3700 3700 4100


60 4100 3500 4200 3900 3900 4000
80 4000 3800 4300 3600 3600 3800

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=𝜇+𝛼+𝛽𝑖 +(𝛼*𝛽)𝑖𝑗 +𝐸𝑖𝑗𝑘
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)

Df Sum Sq Mean Sq F value Pr(>F)


efectoA 2 21111.11 10555.56 0.1158537 0.8919123
efectoB 2 114444.44 57222.22 0.6280488 0.5554841
efectoA:efectoB 4 82222.22 20555.56 0.2256098 0.9172780
Residuals 9 820000.00 91111.11 NA NA

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 Impresión Impresión Rociado Rociado Rociado


1 4 4,5 4,3 5,4 4,9 5,6
2 5,6 4,9 5,4 5,8 6,1 6,3
3 3,8 3,7 4 5,5 5 5
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)

Df Sum Sq Mean Sq F value Pr(>F)


Tapaporos 2 4.5811111 2.2905556 27.858108 0.0000310
Metodo 1 4.9088889 4.9088889 59.702703 0.0000054
Tapaporos:Metodo 2 0.2411111 0.1205556 1.466216 0.2693420
Residuals 12 0.9866667 0.0822222 NA NA

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)

Df Sum Sq Mean Sq F value Pr(>F)


I(Tapaporos) 1 0.2408333 0.2408333 2.9290541 0.1126981
I(Tapaporos^2) 1 4.3402778 4.3402778 52.7871622 0.0000099
I(Metodo) 1 4.9088889 4.9088889 59.7027027 0.0000054
I(Tapaporos * Metodo) 1 0.0675000 0.0675000 0.8209459 0.3827364
I((Tapaporos^2) * Metodo) 1 0.1736111 0.1736111 2.1114865 0.1718429
Residuals 12 0.9866667 0.0822222 NA NA

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