Exercício Aula 23.11

Experimento Industrial: Um engenheiro está fazendo o design de uma bateria para uso em um instrumento que estará sujeito a fortes variações de temperatura. O único parâmetro de design que ele pode selecionar nesta fase é o material da lâmina da bateria, sendo que ele tem 3 opções de materiais. O engenheiro decide testar todos os 3 materiais em três níveis de temperatura. 4 baterias são testadas para cada combinação de lâminas e temperaturas e todos os 36 testes são executados em ordem aleatória. O experimento e os dados observados da vida da bateria (em horas) são mostrados na tabela a seguir.

Perguntas

1. Design de Produto Robusto

2. Quais os efeitos do tipo de material e da temperatura sobre a vida da bateria?

3. Há um tipo de material que produz uma vida uniformemente longa independentemente da temperatura?

4. Este é um exemplo da aplicação do Delineamento Estatístico de Experimentos para o design de produtos robustos.

library(agricolae)
library(ggplot2)
library(ggalt)
## Registered S3 methods overwritten by 'ggalt':
##   method                  from   
##   grid.draw.absoluteGrob  ggplot2
##   grobHeight.absoluteGrob ggplot2
##   grobWidth.absoluteGrob  ggplot2
##   grobX.absoluteGrob      ggplot2
##   grobY.absoluteGrob      ggplot2
library(asbio) # Teste Tukey de Aditividade
## Loading required package: tcltk
library(WRS2)
library(effects)
## Loading required package: carData
## lattice theme set by effectsTheme()
## See ?effectsTheme for details.
# Importanto Dados
bateria <- read.table("bateria.txt", header = T)
str(bateria)
## 'data.frame':    36 obs. of  4 variables:
##  $ mat : int  1 1 1 1 2 2 2 2 3 3 ...
##  $ temp: int  15 15 15 15 15 15 15 15 15 15 ...
##  $ y   : int  130 155 74 180 150 188 159 126 138 110 ...
##  $ tr  : int  2 3 1 3 2 3 3 2 2 2 ...
summary(bateria)
##       mat         temp           y               tr       
##  Min.   :1   Min.   : 15   Min.   : 20.0   Min.   :0.000  
##  1st Qu.:1   1st Qu.: 15   1st Qu.: 70.0   1st Qu.:1.000  
##  Median :2   Median : 70   Median :108.0   Median :2.000  
##  Mean   :2   Mean   : 70   Mean   :105.5   Mean   :1.611  
##  3rd Qu.:3   3rd Qu.:125   3rd Qu.:141.8   3rd Qu.:2.000  
##  Max.   :3   Max.   :125   Max.   :188.0   Max.   :3.000

Análise exploratória dos Dados

# Grafico de Pontos 1
ggplot(bateria, aes(x = mat, y=y, fill=mat)) + geom_point(aes(col=temp)) + geom_smooth(method = "loess", se=T) 
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : pseudoinverse used at 0.99
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : neighborhood radius 2.01
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : reciprocal condition number 2.581e-016
## Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
## parametric, : There are other near singularities as well. 4.0401
## Warning in predLoess(object$y, object$x, newx = if
## (is.null(newdata)) object$x else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used
## at 0.99
## Warning in predLoess(object$y, object$x, newx = if
## (is.null(newdata)) object$x else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
## 2.01
## Warning in predLoess(object$y, object$x, newx = if
## (is.null(newdata)) object$x else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : reciprocal
## condition number 2.581e-016
## Warning in predLoess(object$y, object$x, newx = if
## (is.null(newdata)) object$x else if (is.data.frame(newdata))
## as.matrix(model.frame(delete.response(terms(object)), : There are other
## near singularities as well. 4.0401

# Grafico de Pontos 2
ggplot(data=bateria, aes(x = mat, y = y, colour = tr, size = y, fill = tr, group = TRUE)) + geom_point() + xlab ("materiais") + ylab("horas de vida") + xlim (c(1,3)) + ylim(c(0,200))

Obs.: Pode-se observar nos materiais 2 e 3 que, de acordo com os Gráficos de Pontos, a medida que o tr (tempo de resistência) aumenta, a hora de vida da bateria também aumenta. Observa-se também que vários resultados encontram-se fora do intervalo de confiança, apresentado na área sombreada do Grafico de Pontos 1.
interaction.plot(bateria$mat, bateria$temp, bateria$y, fixed = TRUE)

Obs.: Observa-se que existe semelhança entre os materiais 2 e 3 na temperatura de 70 e 125 mas nao existe similaridade entre as baterias feita com o material 1 na temperatura de 15 graus.
ggplot(data=bateria, aes(x = mat, y = y, colour = tr, size = y, fill = tr, group = TRUE)) + geom_boxplot() + xlab ("materiais") + ylab("horas de vida") + xlim (c(1,3)) + ylim(c(0,200))

Interação

# Verificando de há interação
asbio::tukey.add.test(bateria$y, bateria$mat, bateria$temp)
## 
## Tukey's one df test for additivity 
## F = 0.0260641   Denom df = 30    p-value = 0.8728263
obs.: Conforme resultado p-value (0.8728) o resultado ficou acima de 0.05, ou seja, H0 pode ser aceito. Contudo, nao existe interação entre as relações de tempo x material.

Estimação modelo ANAVA

# Estimação do Modelo com 1 Fator
mdic <- aov(y ~ mat, data = bateria)

# Estimação do modelo com blocagem dos dias
mdbca <- aov(y ~ mat + temp, data = bateria)

summary(mdbca)
##             Df Sum Sq Mean Sq F value    Pr(>F)    
## mat          1  10542   10542   12.40   0.00128 ** 
## temp         1  39043   39043   45.91 0.0000001 ***
## Residuals   33  28062     850                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(mdic)
##             Df Sum Sq Mean Sq F value Pr(>F)  
## mat          1  10542   10542   5.341  0.027 *
## Residuals   34  67105    1974                 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Obs: A informação na Tabela de Estimação do Modelo ANAVA é importante para se confirmar o valor Pr(F) do mat (material) que é o meu fator de interesse. O valor de P para temperatura, neste momento, nao é tão interessante avaliar. Contudo, esta análise visa obter a certeza de que foi retirado um fator que poderia alterar o resultado, melhorando assim, o poder do teste.

CV do pacote Agricolae

cv.model(mdic)
## [1] 42.09892
cv.model(mdbca)
## [1] 27.63361

Análise gráfica dos resíduos - Linearidade

# Linearidade
plot(mdbca, which = 1)

obs.: o gráfico “Residual x valores previstos”, indica que os resíduos não encontram-se distruibuidos próximos de zero, ocorrendo alguns ocialações. Inclusive, pode-se notar também a presença de outliers, que são valores relativamente altos e que encontram-se distantes dos valores previstos.
# Análise Gráfica da Normalidade 
plot(mdbca, which = 2) # grafico qqplot

Obs.: O gráfico Normal Q-Q demonstra o quanto o resíduo está ou não próximo de uma distribuição normal, ou seja, é considerado uma Distruibuição Normal quanto mais próximos os resíduos estiverem da linha pontilhada.

Testes Formais dos Resíduos

Teste de Shapiro

# Teste Shapiro para formalizar os dados obtidos em gráfico.
shapiro.test(mdbca$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  mdbca$residuals
## W = 0.97894, p-value = 0.7094
Obs: O resultado de p-value no Shapiro Test resultou em 0.7094 concluindo que o H0 deve ser aceito, pois o valor obtido é > que 0.05.

Teste de Tukey

teste_tukey <- agricolae::HSD.test(mdbca,"material", group = FALSE)
print(teste_tukey$comparison)
## NULL
O Teste de Tukey, o qual avalia se exite ou não interação entre os blocos do gráfico boxplot, apresentou resultado Nulo.

Eficiência

qmr.di = 1974
qmr.db = 850
qmr.di/qmr.db
## [1] 2.322353