Los datos son tomados del libro Diseño y análisis de experimentos de Douglas Montgomery. Página 232.
A<-c(-1,-1,1,1,-1,-1,1,1,-1,-1,1,1,-1,-1,1,1)
B<-c(-1,-1,-1,-1,1,1,1,1,-1,-1,-1,-1,1,1,1,1)
C<-c(-1,-1,-1,-1,-1,-1,-1,-1,1,1,1,1,1,1,1,1)
altura<-c(-3,-1,0,1,-1,0,2,3,-1,0,2,1,1,1,6,5)
datos<-data.frame(A,B,C,altura)
interaction.plot(A,B,altura,legend=TRUE)
interaction.plot(A,C,altura,legend=TRUE)
interaction.plot(B,C,altura,legend=TRUE)
cubePlot(obj = altura, eff1 = A, eff2 = B, eff3 = C,
main = " Gráfico de interacción")
redos<-lm(altura~A+B+C+A*B+A*C+B*C+A*B*C)
summary(redos)
##
## Call:
## lm.default(formula = altura ~ A + B + C + A * B + A * C + B *
## C + A * B * C)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.0 -0.5 0.0 0.5 1.0
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.0000 0.1976 5.060 0.000977 ***
## A 1.5000 0.1976 7.589 6.37e-05 ***
## B 1.1250 0.1976 5.692 0.000459 ***
## C 0.8750 0.1976 4.427 0.002205 **
## A:B 0.3750 0.1976 1.897 0.094350 .
## A:C 0.1250 0.1976 0.632 0.544737
## B:C 0.2500 0.1976 1.265 0.241504
## A:B:C 0.2500 0.1976 1.265 0.241504
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7906 on 8 degrees of freedom
## Multiple R-squared: 0.9359, Adjusted R-squared: 0.8798
## F-statistic: 16.69 on 7 and 8 DF, p-value: 0.0003474
coe<-coefficients(redos)
efectos<-2*coefficients(redos)
EF<-efectos[-1]
EF
## A B C A:B A:C B:C A:B:C
## 3.00 2.25 1.75 0.75 0.25 0.50 0.50
anova<-aov(altura~A+B+C+A*B+A*C+B*C+A*B*C)
summary(anova)
## Df Sum Sq Mean Sq F value Pr(>F)
## A 1 36.00 36.00 57.6 6.37e-05 ***
## B 1 20.25 20.25 32.4 0.000459 ***
## C 1 12.25 12.25 19.6 0.002205 **
## A:B 1 2.25 2.25 3.6 0.094350 .
## A:C 1 0.25 0.25 0.4 0.544737
## B:C 1 1.00 1.00 1.6 0.241504
## A:B:C 1 1.00 1.00 1.6 0.241504
## Residuals 8 5.00 0.63
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
pre<-predict(redos);pre
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
## -2.0 -2.0 0.5 0.5 -0.5 -0.5 2.5 2.5 -0.5 -0.5 1.5 1.5 1.0 1.0 5.5 5.5
resi<-resid(redos);resi
## 1 2 3 4 5
## -1.000000e+00 1.000000e+00 -5.000000e-01 5.000000e-01 -5.000000e-01
## 6 7 8 9 10
## 5.000000e-01 -5.000000e-01 5.000000e-01 -5.000000e-01 5.000000e-01
## 11 12 13 14 15
## 5.000000e-01 -5.000000e-01 2.775558e-17 2.775558e-17 5.000000e-01
## 16
## -5.000000e-01
qqnorm(resi)
qqline(resi)
plot(pre,resi)
abline(h=0)
x<-seq(-1,1,length=50)
y<-x
f<-function(x,y){
f<-coe[1]+coe[2]*x+coe[3]*y+coe[4]*x*y
}
z<-outer(x,y,f)
persp(x,y,z,theta=45,phi=45)
contour(x,y,z)
efe<-EF
efecto<-abs(efe)
names(efecto)<-c("A","B","C","AB","AC","BC","ABC" )
pareto.chart(efecto, cumperc = seq(0, 100, by = 5), ylab2 = "A finer tickmarks grid")
##
## Pareto chart analysis for efecto
## Frequency Cum.Freq. Percentage Cum.Percent.
## A 3.000000 3.000000 33.333333 33.333333
## B 2.250000 5.250000 25.000000 58.333333
## C 1.750000 7.000000 19.444444 77.777778
## AB 0.750000 7.750000 8.333333 86.111111
## ABC 0.500000 8.250000 5.555556 91.666667
## BC 0.500000 8.750000 5.555556 97.222222
## AC 0.250000 9.000000 2.777778 100.000000
DanielPlot(redos, half = TRUE, main = "Half-Normal Plot")
LenthPlot(redos,main="Length Plot")
## alpha PSE ME SME
## 0.050000 0.937500 3.528865 8.445288