Soluções computacionais do Montgomery

Capítulo 3

Problema 3.5

A resistência à tração do cimento Portland está sendo estudada. Quatro diferentes técnicas de mistura podem ser usadas economicamente. Um experimento completamente aleaóriezado foi conduzido e os seguintes dados foram coletados:

data = read.csv(file = "dados_montgomery_35.csv", sep = ";", dec = ",")

data

##    Technique Tensile.Strength
## 1          1             3129
## 2          1             3000
## 3          1             2865
## 4          1             2890
## 5          2             3200
## 6          2             3300
## 7          2             2975
## 8          2             3150
## 9          3             2800
## 10         3             2900
## 11         3             2985
## 12         3             3050
## 13         4             2600
## 14         4             2700
## 15         4             2600
## 16         4             2765

Teste a hipótese de que a técnica de mistura afeta a tração do cimento. Use \(\alpha = 0.05\)
Construa um gráfico para mostrar conforme descrito na seção 3.5.3 a comparação das médias de tração para as 4 técnicas de mistura. Qual é sua conclusão?
Use o teste de Fisher LSD com \(\alpha = 0.05\) para fazer comparações entre os pares de médias.
Construa um envelope simulado para analisar os resíduos. Quais conclusões você pode tirar sobre a validade da suposição de normalidade?
Plote os resíduos versus os preditos valores da tração. Comente o plot.
Prepare um gráfico de dispersão para os resultados para ajudar na interpretação dos resultados desse experimento.

Item a

model = aov(data$Tensile.Strength ~ as.factor(data$Technique))
anova(model)

## Analysis of Variance Table
## 
## Response: data$Tensile.Strength
##                           Df Sum Sq Mean Sq F value    Pr(>F)    
## as.factor(data$Technique)  3 489740  163247  12.728 0.0004887 ***
## Residuals                 12 153908   12826                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Realizando uma ANOVA para o DIC, observamos que existe significância no efeito de tratamento ao nível de significância estabelecido. Portanto, a técnica de mistura afeta a tração do cimento.

Item b

boxplot(data$Tensile.Strength ~ data$Technique)

Item c

#LSD test (Fisher test)
library(agricolae)
lsd = LSD.test(model, "as.factor(data$Technique)", p.adj = "none"); lsd

## $statistics
##    MSerror Df     Mean       CV  t.value      LSD
##   12825.69 12 2931.812 3.862817 2.178813 174.4798
## 
## $parameters
##         test p.ajusted                    name.t ntr alpha
##   Fisher-LSD      none as.factor(data$Technique)   4  0.05
## 
## $means
##   data$Tensile.Strength       std r      LCL      UCL  Min  Max     Q25
## 1               2971.00 120.55704 4 2847.624 3094.376 2865 3129 2883.75
## 2               3156.25 135.97641 4 3032.874 3279.626 2975 3300 3106.25
## 3               2933.75 108.27242 4 2810.374 3057.126 2800 3050 2875.00
## 4               2666.25  80.97067 4 2542.874 2789.626 2600 2765 2600.00
##      Q50     Q75
## 1 2945.0 3032.25
## 2 3175.0 3225.00
## 3 2942.5 3001.25
## 4 2650.0 2716.25
## 
## $comparison
## NULL
## 
## $groups
##   data$Tensile.Strength groups
## 2               3156.25      a
## 1               2971.00      b
## 3               2933.75      b
## 4               2666.25      c
## 
## attr(,"class")
## [1] "group"

Não existe diferença significativa entre as misturas 1 e 3, porém existe diferença nas demais. Pelo boxplot do item anterior vimos que o cimento 2 apresenta maior tração média, e que a mistura 4 apresenta a menor.

Item d

library(hnp)

## Loading required package: MASS

hnp(model)

## Gaussian model (aov object)

Apesar do envelope simulado parecer indicar uma leve assimetria a esquerda, não parece haver fuga da suposição de normalidade neste caso.

Item e

plot(data$Tensile.Strength ~ data$Technique)
means = tapply(data$Tensile.Strength,data$Technique,mean); means

##       1       2       3       4 
## 2971.00 3156.25 2933.75 2666.25

lines(means, col = "red")

O gráfico de dispersão com a curva das médias dos tratamentos ajuda a compreender e reforçar nossas conclusões a respeito das misturas de cimento, uma vez que de fato, fica mais evidente de que a tração média da mistura 2 é maior que as demais.

Problema 3.6

Refaça o item c do problema 3.5 usando o teste de tukey com \(\alpha = 0.05\). Você obtém as mesmas conclusões?
Explique a diferença entre o teste de tukey e fisher.

Item a

library(laercio)
TukeyHSD(model, "as.factor(data$Technique)", ordered = TRUE)

##   Tukey multiple comparisons of means
##     95% family-wise confidence level
##     factor levels have been ordered
## 
## Fit: aov(formula = data$Tensile.Strength ~ as.factor(data$Technique))
## 
## $`as.factor(data$Technique)`
##       diff        lwr      upr     p adj
## 3-4 267.50   29.74971 505.2503 0.0261838
## 1-4 304.75   66.99971 542.5003 0.0115923
## 2-4 490.00  252.24971 727.7503 0.0002622
## 1-3  37.25 -200.50029 275.0003 0.9652776
## 2-3 222.50  -15.25029 460.2503 0.0693027
## 2-1 185.25  -52.50029 423.0003 0.1493561

LTukey(model, "as.factor(data$Technique)")

## 
##  TUKEY TEST TO COMPARE MEANS 
##  
##  Confidence level:  0.95 
##  Dependent variable:  data$Tensile.Strength
##  Variation Coefficient:  3.862817 % 
##  
## Independent variable:  as.factor(data$Technique) 
##   Factors Means     
##   2       3156.25 a 
##   1       2971    a 
##   3       2933.75 a 
##   4       2666.25  b
## 
##

Observando o resultados do teste de tukey, concluiriamos que não existe diferença significativa entre os efeitos de tratamento das mistura 1, 2 e 3. Mas existe uma diferneça entre o tratamento 4 em relação as demais misturas, a conclusão é similar a que obtivemos através do teste de Fisher LSD, com a diferena de que neste caso não indicamos distinção significativa entre a mistura 2 em relação as outras.

#hocedasticity assumption
plot(model$fitted.values,model$residuals)
abline(0,0)

bartlett.test(data$Tensile.Strength ~ data$Technique)

## 
##  Bartlett test of homogeneity of variances
## 
## data:  data$Tensile.Strength by data$Technique
## Bartlett's K-squared = 0.71158, df = 3, p-value = 0.8705

O gráfico não parece indicar violação na suposição de homogeneidade de variâncias, fato esse confirmado com o teste de barttlet.

Item f

Capítulo 4

Este é um solucionário prático para planejamento de experimentos, aqui estou resolvendo as questões do livro: Desing and Analysis of Experiments, 7th edition, Douglas C. Montgomery.

Caso você encontre algum erro, seja de tradução ou na solução dos problemas, me contate em: lucas.araujo.silva1@gmail.com

Problema 4.3

Um químico deseja testar o efeito de quatro agentes químicos na força de um particular tipo de tecido. Como pode haver variabilidade de um rolo para o outro, o químico decide usar um delineamento em blocos ateatórizados, com os rolos de tecido sendo considerados os blocos. Ele seleciona cinco blocos e aplica quatro químicos em ordem aleatoria para cada rolo. Os resultados da força de tensão são registrados. Analise os dados desse experimento (use p = 0.05) e tire conclusões apropriadas.

#Import dataset:
data = read.csv(file = "dados_montgomery_43.csv", sep = ";", dec = ",")

data

##    Chemist Strength Block
## 1        1       73     1
## 2        1       68     2
## 3        1       74     3
## 4        1       71     4
## 5        1       67     5
## 6        2       73     1
## 7        2       67     2
## 8        2       75     3
## 9        2       72     4
## 10       2       70     5
## 11       3       75     1
## 12       3       68     2
## 13       3       78     3
## 14       3       73     4
## 15       3       68     5
## 16       4       73     1
## 17       4       71     2
## 18       4       75     3
## 19       4       75     4
## 20       4       69     5

#fit the model
model = aov(data$Strength ~ as.factor(data$Chemist) + as.factor(data$Block))

summary(model)

##                         Df Sum Sq Mean Sq F value   Pr(>F)    
## as.factor(data$Chemist)  3  12.95    4.32   2.376    0.121    
## as.factor(data$Block)    4 157.00   39.25  21.606 2.06e-05 ***
## Residuals               12  21.80    1.82                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

anova(model)

## Analysis of Variance Table
## 
## Response: data$Strength
##                         Df Sum Sq Mean Sq F value    Pr(>F)    
## as.factor(data$Chemist)  3  12.95   4.317  2.3761    0.1211    
## as.factor(data$Block)    4 157.00  39.250 21.6055 2.059e-05 ***
## Residuals               12  21.80   1.817                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

#boxplot of treatment
boxplot(data$Strength ~ data$Chemist)

#treatment means
plot(data$Strength ~ data$Chemist)
means = tapply(data$Strength,data$Chemist,mean); means

##    1    2    3    4 
## 70.6 71.4 72.4 72.6

lines(means, col = "red")

Conclusões

Não existe efeito de tratamento, todos os agentes químicos produzem efeitos semelhantes.

Problema 4.4

Três diferentes soluções de limpeza estão sendo comparadas para um estudo que compara sua efetividade no retadamento de crescimento de bactérias em cinco galões contendo leite. A análise é feita em laboratório, e apenas três tentativas podem ser conduzidas por dia. Devido à possibilidade dos dias representarem uma fonte de variação em potêncial, o experimentador decide utilizar um delineamento em blocos aleatorizados. Observações são coletadas em quatro dias e os dado são exibidos a seguir. Analise os dados desse experimento (use p = 0.05) e tire conclusões apropriadas.

data = read.csv(file = "dados_montgomery_44.csv", sep = ";", dec = ",")
data

##    Solution Growth Block
## 1         1     13     1
## 2         1     22     2
## 3         1     18     3
## 4         1     39     4
## 5         2     16     1
## 6         2     24     2
## 7         2     17     3
## 8         2     44     4
## 9         3      5     1
## 10        3      4     2
## 11        3      1     3
## 12        3     22     4

#fit the model
model = aov(data$Growth ~ as.factor(data$Solution) + as.factor(data$Block))

summary(model)

##                          Df Sum Sq Mean Sq F value   Pr(>F)    
## as.factor(data$Solution)  2  703.5   351.8   40.72 0.000323 ***
## as.factor(data$Block)     3 1106.9   369.0   42.71 0.000192 ***
## Residuals                 6   51.8     8.6                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

anova(model)

## Analysis of Variance Table
## 
## Response: data$Growth
##                          Df  Sum Sq Mean Sq F value    Pr(>F)    
## as.factor(data$Solution)  2  703.50  351.75  40.717 0.0003232 ***
## as.factor(data$Block)     3 1106.92  368.97  42.711 0.0001925 ***
## Residuals                 6   51.83    8.64                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

#boxplot of treatment
boxplot(data$Growth ~ data$Solution)

#treatment means
plot(data$Growth ~ data$Solution)
means = tapply(data$Growth,data$Solution,mean); means

##     1     2     3 
## 23.00 25.25  8.00

lines(means, col = "red")

#tukey test for tretment
TukeyHSD(model, "as.factor(data$Solution)", ordered = TRUE)

##   Tukey multiple comparisons of means
##     95% family-wise confidence level
##     factor levels have been ordered
## 
## Fit: aov(formula = data$Growth ~ as.factor(data$Solution) + as.factor(data$Block))
## 
## $`as.factor(data$Solution)`
##      diff       lwr       upr     p adj
## 1-3 15.00  8.623121 21.376879 0.0008758
## 2-3 17.25 10.873121 23.626879 0.0004067
## 2-1  2.25 -4.126879  8.626879 0.5577862

#plot(TukeyHSD(model, as.factor(data$Solution)))

Concluões

Existe efeito de tratamento e a solução 3 fornece menor crescimento de bactérias em relação as soluções 1 e 2.

Problema 4.5

Plote a média das forças de tensão observadas para cada tipo químico no problema 4.3 e compare elas com o teste t. Que conclusões voçê obtém?

Na realidade já realizamos o plot das médias, mas comparando os tratamentos com o teste t, obtemos:

#Import dataset:
data = read.csv(file = "dados_montgomery_43.csv", sep = ";", dec = ",")
#We hope for all pairs: true difference in means is equal to 0
#2-1 
t.test(data$Strength[1:10]~data$Chemist[1:10])

## 
##  Welch Two Sample t-test
## 
## data:  data$Strength[1:10] by data$Chemist[1:10]
## t = -0.41478, df = 8, p-value = 0.6892
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -5.24766  3.64766
## sample estimates:
## mean in group 1 mean in group 2 
##            70.6            71.4

#3-1  
t.test(data$Strength[c(1:5,11:15)]~data$Chemist[c(1:5,11:15)])

## 
##  Welch Two Sample t-test
## 
## data:  data$Strength[c(1:5, 11:15)] by data$Chemist[c(1:5, 11:15)]
## t = -0.75262, df = 7.1285, p-value = 0.4758
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -7.434758  3.834758
## sample estimates:
## mean in group 1 mean in group 3 
##            70.6            72.4

#4-1
t.test(data$Strength[c(1:5,11:15)]~data$Chemist[1:10])

## 
##  Welch Two Sample t-test
## 
## data:  data$Strength[c(1:5, 11:15)] by data$Chemist[1:10]
## t = -0.75262, df = 7.1285, p-value = 0.4758
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -7.434758  3.834758
## sample estimates:
## mean in group 1 mean in group 2 
##            70.6            72.4

#3-2
t.test(data$Strength[c(6:10,11:15)]~data$Chemist[c(6:10,11:15)])

## 
##  Welch Two Sample t-test
## 
## data:  data$Strength[c(6:10, 11:15)] by data$Chemist[c(6:10, 11:15)]
## t = -0.41812, df = 7.1285, p-value = 0.6882
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -6.634758  4.634758
## sample estimates:
## mean in group 2 mean in group 3 
##            71.4            72.4

#4-2
t.test(data$Strength[c(6:10,16:20)]~data$Chemist[c(6:10,16:20)])

## 
##  Welch Two Sample t-test
## 
## data:  data$Strength[c(6:10, 16:20)] by data$Chemist[c(6:10, 16:20)]
## t = -0.66873, df = 7.8116, p-value = 0.5229
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -5.355408  2.955408
## sample estimates:
## mean in group 2 mean in group 4 
##            71.4            72.6

#4-3  
t.test(data$Strength[11:20]~data$Chemist[11:20])

## 
##  Welch Two Sample t-test
## 
## data:  data$Strength[11:20] by data$Chemist[11:20]
## t = -0.087538, df = 6.5074, p-value = 0.9329
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -5.686554  5.286554
## sample estimates:
## mean in group 3 mean in group 4 
##            72.4            72.6

Conclusões

Nenhum teste t rejeitou a hipótese nula de igualdade das médias ao nível de significância de 0.05, o que confirma a ideia que não existe efeito de tratamento.

Problema 4.6

Plote a média de bactérias para cada solução no problema 4.4 e compare com o teste t. Que conclusões você pode tirar?

Essa questão é idêntica a anterior, não vou encher linguiça, até uma criança já sabe como fazer isso!

Problema 4.7

Considere o experimento que testa a dureza descrito na seção 4.1. Suponha que o experimento foi conduzido conforme foi descrito e os seguintes dados da C-scala de Rockewell (retirados de 40 unidades) foram obtidos.

Analise os dados desse experimento.
Use o método de Fisher LSD para fazer comparações a respeito dos quatro tipos para determinar especificamente qual difere em média nas leituras de dureza.
Faça a análise residual desse experimento.

Item a

data = read.csv(file = "dados_montgomery_47.csv", sep = ";", dec = ",")
data

##    Tip Hardness Block
## 1    1      9.3     1
## 2    1      9.4     2
## 3    1      9.6     3
## 4    1     10.0     4
## 5    2      9.4     1
## 6    2      9.3     2
## 7    2      9.8     3
## 8    2      9.9     4
## 9    3      9.2     1
## 10   3      9.4     2
## 11   3      9.5     3
## 12   3      9.7     4
## 13   4      9.7     1
## 14   4      9.6     2
## 15   4     10.0     3
## 16   4     10.2     4

#fit the model
model = aov(data$Hardness ~ as.factor(data$Tip) + as.factor(data$Block))

summary(model)

##                       Df Sum Sq Mean Sq F value   Pr(>F)    
## as.factor(data$Tip)    3  0.385 0.12833   14.44 0.000871 ***
## as.factor(data$Block)  3  0.825 0.27500   30.94 4.52e-05 ***
## Residuals              9  0.080 0.00889                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

anova(model)

## Analysis of Variance Table
## 
## Response: data$Hardness
##                       Df Sum Sq  Mean Sq F value    Pr(>F)    
## as.factor(data$Tip)    3  0.385 0.128333  14.438 0.0008713 ***
## as.factor(data$Block)  3  0.825 0.275000  30.938 4.523e-05 ***
## Residuals              9  0.080 0.008889                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

#boxplot of treatment
boxplot(data$Hardness ~ data$Tip)

#treatment means
plot(data$Hardness ~ data$Tip)
means = tapply(data$Hardness,data$Tip,mean); means

##     1     2     3     4 
## 9.575 9.600 9.450 9.875

lines(means, col = "red")

#tukey test for tretment
TukeyHSD(model, "as.factor(data$Tip)", ordered = TRUE)

##   Tukey multiple comparisons of means
##     95% family-wise confidence level
##     factor levels have been ordered
## 
## Fit: aov(formula = data$Hardness ~ as.factor(data$Tip) + as.factor(data$Block))
## 
## $`as.factor(data$Tip)`
##      diff         lwr       upr     p adj
## 1-3 0.125 -0.08311992 0.3331199 0.3027563
## 2-3 0.150 -0.05811992 0.3581199 0.1815907
## 4-3 0.425  0.21688008 0.6331199 0.0006061
## 2-1 0.025 -0.18311992 0.2331199 0.9809005
## 4-1 0.300  0.09188008 0.5081199 0.0066583
## 4-2 0.275  0.06688008 0.4831199 0.0113284

#plot(TukeyHSD(model, as.factor(data$Tip)))

Conclusões

Existe efeito de tratamento e o teste de tukey aponta que o tratamento 4 difere dos demais, além disso podemos perceber pelo box-plot que a dureza deste tipo de material é maior que a dos materiais 1, 2 e 3.

Item b

#LSD test (Fisher test)
library(agricolae)
lsd = LSD.test(model, "as.factor(data$Tip)", p.adj = "none"); lsd

## $statistics
##       MSerror Df  Mean        CV  t.value       LSD
##   0.008888889  9 9.625 0.9795419 2.262157 0.1508105
## 
## $parameters
##         test p.ajusted              name.t ntr alpha
##   Fisher-LSD      none as.factor(data$Tip)   4  0.05
## 
## $means
##   data$Hardness       std r      LCL      UCL Min  Max   Q25  Q50    Q75
## 1         9.575 0.3095696 4 9.468361 9.681639 9.3 10.0 9.375 9.50  9.700
## 2         9.600 0.2943920 4 9.493361 9.706639 9.3  9.9 9.375 9.60  9.825
## 3         9.450 0.2081666 4 9.343361 9.556639 9.2  9.7 9.350 9.45  9.550
## 4         9.875 0.2753785 4 9.768361 9.981639 9.6 10.2 9.675 9.85 10.050
## 
## $comparison
## NULL
## 
## $groups
##   data$Hardness groups
## 4         9.875      a
## 2         9.600      b
## 1         9.575      b
## 3         9.450      b
## 
## attr(,"class")
## [1] "group"

Conclusões

Existe efeito de tratamento e o material 4 possui dureza média maior que os demais, fato esse que é indicado tanto no teste de tukey quanto no teste de menor diferença significativa de Fisher.

Item c

#Residual analysis
library(hnp)
hnp(model)

## Gaussian model (aov object)

shapiro.test(model$residuals)

## 
##  Shapiro-Wilk normality test
## 
## data:  model$residuals
## W = 0.93957, p-value = 0.3438

library(nortest)
lillie.test(model$residuals)

## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  model$residuals
## D = 0.13395, p-value = 0.62

#hocedasticity assumption
plot(model$fitted.values,model$residuals)
abline(0,0)

bartlett.test(data$Hardness ~ data$Tip)

## 
##  Bartlett test of homogeneity of variances
## 
## data:  data$Hardness by data$Tip
## Bartlett's K-squared = 0.44773, df = 3, p-value = 0.9302

Conclusões

Não temos motivos para suspeitar de violação na suposição de homogeneidade de variâncias e nem na suposição de normalidade residual tanto pela análise gráfica através do gráfico de resíduos vs. valores ajustados e envelope similado (half-normal plot), bem como pelos testes de bartlett e shapiro-wilk.

Problema 4.8

Uma empresa de bens de consumo depende de marketing através de malas diretas (correspondências) como componente importante de suas campanhas publucitárias. A compania possui três diferentes desings para um novo folder e deseja avaliar sua efetividade, existem diferenças substânciais nos custos entre os três desings. A empresa decide testar os três designs enviando 5000 unidades de cada folder para cada consumidor potêncial em quatro diferentes regiões do país. Até então, sabe-se que existem diferenças regionais do cliente na recepção da publicidade, regiões são consideradas como blocos. O número de respostas para cada correspondência é dado a seguir:

data = read.csv(file = "dados_montgomery_48.csv", sep = ";", dec = ",")
data

##    Design Number.of.Responses Block
## 1       1                 250    NE
## 2       1                 350    NW
## 3       1                 219    SE
## 4       1                 375    SW
## 5       2                 400    NE
## 6       2                 525    NW
## 7       2                 390    SE
## 8       2                 580    SW
## 9       3                 275    NE
## 10      3                 340    NW
## 11      3                 200    SE
## 12      3                 310    SW

Analise os dados desse experimento.
Use o método de Fisher LSD para fazer comparações a respeito dos três tipos de publicidade para determinar especificamente qual difere em média nas taxas de resposta.
Faça a análise residual desse experimento.

Item a

#fit the model
model = aov(data$Number.of.Responses ~ as.factor(data$Design) + as.factor(data$Block))

summary(model)

##                        Df Sum Sq Mean Sq F value  Pr(>F)    
## as.factor(data$Design)  2  90755   45378   50.15 0.00018 ***
## as.factor(data$Block)   3  49036   16345   18.07 0.00208 ** 
## Residuals               6   5429     905                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

anova(model)

## Analysis of Variance Table
## 
## Response: data$Number.of.Responses
##                        Df Sum Sq Mean Sq F value    Pr(>F)    
## as.factor(data$Design)  2  90755   45378  50.152 0.0001798 ***
## as.factor(data$Block)   3  49036   16345  18.065 0.0020837 ** 
## Residuals               6   5429     905                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

#boxplot of treatment
boxplot(data$Number.of.Responses ~ data$Design)

#treatment means
plot(data$Number.of.Responses ~ data$Design)
means = tapply(data$Number.of.Responses,data$Design,mean); means

##      1      2      3 
## 298.50 473.75 281.25

lines(means, col = "red")

#tukey test for tretment
TukeyHSD(model, "as.factor(data$Design)", ordered = TRUE)

##   Tukey multiple comparisons of means
##     95% family-wise confidence level
##     factor levels have been ordered
## 
## Fit: aov(formula = data$Number.of.Responses ~ as.factor(data$Design) + as.factor(data$Block))
## 
## $`as.factor(data$Design)`
##       diff       lwr       upr     p adj
## 1-3  17.25 -48.01147  82.51147 0.7104869
## 2-3 192.50 127.23853 257.76147 0.0002508
## 2-1 175.25 109.98853 240.51147 0.0004236

#plot(TukeyHSD(model, as.factor(data$Tip)))

Conclusões

Existe efeito de tratamento e o teste de tukey aponta que o tratamento 2 difere dos demais, além disso podemos perceber pelo box-plot que a taxa de respostas das correspondências do tipo 2 é maior que as demais. O teste de tukey aponta que existe diferença significativa entre a média do tratamento dois em relação aos demais.

Item b

#LSD test (Fisher test)
lsd = LSD.test(model, "as.factor(data$Design)", p.adj = "none"); lsd

## $statistics
##    MSerror Df     Mean       CV  t.value      LSD
##   904.8056  6 351.1667 8.565729 2.446912 52.04523
## 
## $parameters
##         test p.ajusted                 name.t ntr alpha
##   Fisher-LSD      none as.factor(data$Design)   3  0.05
## 
## $means
##   data$Number.of.Responses      std r      LCL      UCL Min Max    Q25
## 1                   298.50 75.66814 4 261.6985 335.3015 219 375 242.25
## 2                   473.75 93.75278 4 436.9485 510.5515 390 580 397.50
## 3                   281.25 60.32896 4 244.4485 318.0515 200 340 256.25
##     Q50    Q75
## 1 300.0 356.25
## 2 462.5 538.75
## 3 292.5 317.50
## 
## $comparison
## NULL
## 
## $groups
##   data$Number.of.Responses groups
## 2                   473.75      a
## 1                   298.50      b
## 3                   281.25      b
## 
## attr(,"class")
## [1] "group"

Conclusões

O teste da menor diferença significatva de Fisher (LSD Fisher) aponta que existe diferença significatiiva entre o tramento 2 em relação aos demais.

Item c

#Residual analysis
hnp(model)

## Gaussian model (aov object)

shapiro.test(model$residuals)

## 
##  Shapiro-Wilk normality test
## 
## data:  model$residuals
## W = 0.88867, p-value = 0.1133

lillie.test(model$residuals)

## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  model$residuals
## D = 0.23267, p-value = 0.07195

#hocedasticity assumption
plot(model$fitted.values,model$residuals)
abline(0,0)

bartlett.test(data$Number.of.Responses ~ data$Design)

## 
##  Bartlett test of homogeneity of variances
## 
## data:  data$Number.of.Responses by data$Design
## Bartlett's K-squared = 0.49796, df = 2, p-value = 0.7796

Conclusões

A análise do envelope simulado aparenta uma violação da suposição de normalidade (provavelmente devido ao número baixo de observações), mas realizando o teste de de shapiro e kolmogorov, não rejeitamos a hipótese nula de normalidade em ambos.

Problema 4.9

O efeito de três óleos lubrificantes diferentes, na economia de combustível em motores de caminhões a dísel está sendo estudada. A economia de combustível é medida usando um o consumo de combustível específico do freio motor após o motor funcionar por 15 minutos. Cinco diferentes motores são testados durante o estudo, e o pesquisador conduz o experimento de acordo com o seguinte delineamento completamente aleatoriezado em blocos.

data = read.csv(file = "dados_montgomery_49.csv", sep = ";", dec = ",")
data

##    Oil Fuel.Consumption Block
## 1    1            0.500     1
## 2    1            0.634     2
## 3    1            0.487     3
## 4    1            0.329     4
## 5    1            0.512     5
## 6    2            0.535     1
## 7    2            0.675     2
## 8    2            0.520     3
## 9    2            0.435     4
## 10   2            0.540     5
## 11   3            0.513     1
## 12   3            0.595     2
## 13   3            0.488     3
## 14   3            0.400     4
## 15   3            0.510     5

Analise os dados desse experimento.
Use o método de Fisher LSD para fazer comparações a respeito dos três tipos de óleos para determinar especificamente qual difere em
Faça a análise residual desse experimento.

Item a

#fit the model
model = aov(data$Fuel.Consumption ~ as.factor(data$Oil) + as.factor(data$Block))

summary(model)

##                       Df  Sum Sq  Mean Sq F value   Pr(>F)    
## as.factor(data$Oil)    2 0.00671 0.003353   6.353   0.0223 *  
## as.factor(data$Block)  4 0.09210 0.023025  43.626 1.78e-05 ***
## Residuals              8 0.00422 0.000528                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

anova(model)

## Analysis of Variance Table
## 
## Response: data$Fuel.Consumption
##                       Df   Sum Sq   Mean Sq F value    Pr(>F)    
## as.factor(data$Oil)    2 0.006706 0.0033529  6.3527   0.02229 *  
## as.factor(data$Block)  4 0.092100 0.0230249 43.6257 1.781e-05 ***
## Residuals              8 0.004222 0.0005278                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

#boxplot of treatment
boxplot(data$Fuel.Consumption ~ data$Oil)

#treatment means
plot(data$Fuel.Consumption ~ data$Oil)
means = tapply(data$Fuel.Consumption,data$Oil,mean); means

##      1      2      3 
## 0.4924 0.5410 0.5012

lines(means, col = "red")

#tukey test for tretment
TukeyHSD(model, "as.factor(data$Oil)", ordered = TRUE)

##   Tukey multiple comparisons of means
##     95% family-wise confidence level
##     factor levels have been ordered
## 
## Fit: aov(formula = data$Fuel.Consumption ~ as.factor(data$Oil) + as.factor(data$Block))
## 
## $`as.factor(data$Oil)`
##       diff          lwr        upr     p adj
## 3-1 0.0088 -0.032717922 0.05031792 0.8210970
## 2-1 0.0486  0.007082078 0.09011792 0.0245809
## 2-3 0.0398 -0.001717922 0.08131792 0.0594979

#plot(TukeyHSD(model, as.factor(data$Tip)))

Conclusões

Podemos suspeitar pelo box-plot que o consumo médio de combustível aparenta ser maior que os demais. Existe efeito de tratamento e o teste de tukey aponta que o tratamento 2 difere do tratamento 1, mas não do 3.

Item b

#LSD test (Fisher test)
lsd = LSD.test(model, "as.factor(data$Oil)", p.adj = "none"); lsd

## $statistics
##        MSerror Df      Mean       CV  t.value        LSD
##   0.0005277833  8 0.5115333 4.491112 2.306004 0.03350564
## 
## $parameters
##         test p.ajusted              name.t ntr alpha
##   Fisher-LSD      none as.factor(data$Oil)   3  0.05
## 
## $means
##   data$Fuel.Consumption        std r       LCL       UCL   Min   Max   Q25
## 1                0.4924 0.10865220 5 0.4687079 0.5160921 0.329 0.634 0.487
## 2                0.5410 0.08612491 5 0.5173079 0.5646921 0.435 0.675 0.520
## 3                0.5012 0.06969720 5 0.4775079 0.5248921 0.400 0.595 0.488
##     Q50   Q75
## 1 0.500 0.512
## 2 0.535 0.540
## 3 0.510 0.513
## 
## $comparison
## NULL
## 
## $groups
##   data$Fuel.Consumption groups
## 2                0.5410      a
## 3                0.5012      b
## 1                0.4924      b
## 
## attr(,"class")
## [1] "group"

Conclusões

O teste da menor diferença significatva de Fisher (LSD Fisher) aponta que existe diferença significatiiva entre o tramento 2 em relação aos demais.

Item c

#Residual analysis
hnp(model)

## Gaussian model (aov object)

shapiro.test(model$residuals)

## 
##  Shapiro-Wilk normality test
## 
## data:  model$residuals
## W = 0.91855, p-value = 0.183

lillie.test(model$residuals)

## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  model$residuals
## D = 0.15901, p-value = 0.3893

#hocedasticity assumption
plot(model$fitted.values,model$residuals)
abline(0,0)

bartlett.test(data$Fuel.Consumption ~ data$Oil)

## 
##  Bartlett test of homogeneity of variances
## 
## data:  data$Fuel.Consumption by data$Oil
## Bartlett's K-squared = 0.70349, df = 2, p-value = 0.7035

Conclusões

A análise do envelope simulado aparenta violação da suposição de normalidade, mas realizando o teste de de shapiro e kolmogorov, não rejeitamos a hipótese nula de normalidade em ambos. O teste de bartlett também não rejeita a hipótese nula de homogeneidade de variâncias.

Problema 4.10

Um artigo do Fire Safety Journal (“The Effect of Nozzle Design on the Stability and Performance of Turbulent Water Jets,” Vol. 4, August 1981) descreve um experimento em que o fator de forma é determinado por diferentes projetos de bicos em seis níveis de velocidade de fluxo de jatos. O interesse é focado nas diferenças entre os designs dos bicos, em que a velocidade é considerada uma variável de incômodo. Os dados são exibidos a seguir:

data = read.csv(file = "dados_montgomery_410.csv", sep = ";", dec = ",")
data

##    Nozzle.Design Shape Block
## 1              1  0.78     1
## 2              1  0.80     2
## 3              1  0.81     3
## 4              1  0.75     4
## 5              1  0.77     5
## 6              1  0.78     6
## 7              2  0.85     1
## 8              2  0.85     2
## 9              2  0.92     3
## 10             2  0.86     4
## 11             2  0.81     5
## 12             2  0.83     6
## 13             3  0.93     1
## 14             3  0.92     2
## 15             3  0.95     3
## 16             3  0.89     4
## 17             3  0.89     5
## 18             3  0.83     6
## 19             4  1.14     1
## 20             4  0.97     2
## 21             4  0.98     3
## 22             4  0.88     4
## 23             4  0.86     5
## 24             4  0.83     6
## 25             5  0.97     1
## 26             5  0.86     2
## 27             5  0.78     3
## 28             5  0.76     4
## 29             5  0.76     5
## 30             5  0.75     6

O design do bico afeta o fator de forma? Compare os bicos com um scatter plot e com uma analise de variância, use \(\alpha = 0.05\).
Faça a análise residual desse experimento.
Qual designs de bico são diferentes com respeito ao fator forma? Faça um gráfico da média do fator forma para cada tipo de bico. Compare as conclusoes que você tirou da análise gráfica com o teste de comparação múltipla de Duncan.

Item a

#fit the model
model = aov(data$Shape ~ as.factor(data$Nozzle.Design) + as.factor(data$Block))

summary(model)

##                               Df  Sum Sq  Mean Sq F value   Pr(>F)    
## as.factor(data$Nozzle.Design)  4 0.10218 0.025545   8.916 0.000266 ***
## as.factor(data$Block)          5 0.06287 0.012573   4.389 0.007364 ** 
## Residuals                     20 0.05730 0.002865                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

anova(model)

## Analysis of Variance Table
## 
## Response: data$Shape
##                               Df   Sum Sq  Mean Sq F value    Pr(>F)    
## as.factor(data$Nozzle.Design)  4 0.102180 0.025545  8.9162 0.0002655 ***
## as.factor(data$Block)          5 0.062867 0.012573  4.3886 0.0073642 ** 
## Residuals                     20 0.057300 0.002865                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

#Scatter-plot
v = rep(c(11.73,14.37,16.59,20.43,23.46,28.74),5)
data = cbind(data,v)
plot(data$Shape ~ data$v)

#boxplot of treatment
boxplot(data$Shape ~ data$Nozzle.Design)

Conclusões

Podemos suspeitar pelo gráfico de dispersão quanto maior a velocidade menor é o fator formato, o box-plot indica que o fator forma do bico 4 e 3 são maiores que os demais.

Item b

#Residual analysis
hnp(model)

## Gaussian model (aov object)

shapiro.test(model$residuals)

## 
##  Shapiro-Wilk normality test
## 
## data:  model$residuals
## W = 0.96992, p-value = 0.5369

lillie.test(model$residuals)

## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  model$residuals
## D = 0.10049, p-value = 0.6142

#hocedasticity assumption
plot(model$fitted.values,model$residuals)
abline(0,0)

bartlett.test(data$Shape ~ as.factor(data$Nozzle.Design))

## 
##  Bartlett test of homogeneity of variances
## 
## data:  data$Shape by as.factor(data$Nozzle.Design)
## Bartlett's K-squared = 14.623, df = 4, p-value = 0.00555

Conclusões

A análise do envelope simulado não indica violação da suposição de normalidade, realizando o teste de de shapiro e kolmogorov, não rejeitamos a hipótese nula de normalidade em ambos. O gráfico dos resíduos pelos valores ajustados não indica violação na suposição de homogeneidade de variâncias, o teste de bartlett entretanto rejeita a hipótese nula de homogeneidade de variâncias.

Item c

#treatment means
plot(data$Shape ~ data$Nozzle.Design)
means = tapply(data$Shape,data$Nozzle.Design,mean); means

##         1         2         3         4         5 
## 0.7816667 0.8533333 0.9016667 0.9433333 0.8133333

lines(means, col = "red")

#duncan test
D = duncan.test(model, "as.factor(data$Nozzle.Design)"); D

## $statistics
##    MSerror Df      Mean       CV
##   0.002865 20 0.8586667 6.233582
## 
## $parameters
##     test                        name.t ntr alpha
##   Duncan as.factor(data$Nozzle.Design)   5  0.05
## 
## $duncan
##      Table CriticalRange
## 2 2.949998    0.06446268
## 3 3.096506    0.06766416
## 4 3.189616    0.06969876
## 5 3.254648    0.07111983
## 
## $means
##   data$Shape        std r  Min  Max    Q25   Q50    Q75
## 1  0.7816667 0.02136976 6 0.75 0.81 0.7725 0.780 0.7950
## 2  0.8533333 0.03723797 6 0.81 0.92 0.8350 0.850 0.8575
## 3  0.9016667 0.04215052 6 0.83 0.95 0.8900 0.905 0.9275
## 4  0.9433333 0.11360751 6 0.83 1.14 0.8650 0.925 0.9775
## 5  0.8133333 0.08664102 6 0.75 0.97 0.7600 0.770 0.8400
## 
## $comparison
## NULL
## 
## $groups
##   data$Shape groups
## 4  0.9433333      a
## 3  0.9016667     ab
## 2  0.8533333     bc
## 5  0.8133333     cd
## 1  0.7816667      d
## 
## attr(,"class")
## [1] "group"

Conclusões

O teste de comparação múltipla de duncan indica que não existe diferença significativa entre os tratamentos 3 e 4, e não existe diferença significativa entre 3 e 2, apesar de existir entre 4 e 2. Também não existe diferença significativa entre os tratamentos 2 e 5, o tratamento 1 é diferente dos demais. O gráfico de médias parece concordar com o teste de duncan. Se o fator forma é o que torna o bico melhor, então o pesquisador poderia optar pelo design de bico 3 ou 4.

Problema 4.11

Considere um experimento com um algoritmo de controle de proporção da seção 3.8. O experimento foi conduzido baseado em um delineamento de blocos aleatoriezados, onde os blocos são seis períodos, e todos os quatro algoritmos são testados em cada período de tempo. A voltagem média das celulas e o desvio padrão das voltagens para cada célula são exibidas a seguir:

data = read.csv(file = "dados_montgomery_411.csv", sep = ";", dec = ",")
data

##    Algorithm Average StDev Block
## 1          1    4.93  0.05     1
## 2          1    4.86  0.04     2
## 3          1    4.75  0.05     3
## 4          1    4.95  0.06     4
## 5          1    4.79  0.03     5
## 6          1    4.88  0.05     6
## 7          2    4.85  0.04     1
## 8          2    4.91  0.02     2
## 9          2    4.79  0.03     3
## 10         2    4.85  0.05     4
## 11         2    4.75  0.03     5
## 12         2    4.85  0.02     6
## 13         3    4.83  0.09     1
## 14         3    4.88  0.13     2
## 15         3    4.90  0.11     3
## 16         3    4.75  0.15     4
## 17         3    4.82  0.08     5
## 18         3    4.90  0.12     6
## 19         4    4.89  0.03     1
## 20         4    4.77  0.04     2
## 21         4    4.94  0.05     3
## 22         4    4.86  0.05     4
## 23         4    4.79  0.03     5
## 24         4    4.76  0.02     6

Analise os dados de voltagem média das células use \(\alpha = 0.05\). Qual algoritmo afeta a voltagem média das células?
Faça uma analise apropriada do desvios padrões da voltagem. Lembre-se que chamamos isso de pote de ruído, a escolha do algorimo afeta o pote de ruído?
Conduza uma análise resídual que você considere apropriada.
Qual algoritmo você escolheria se o seu objetivo é reduzir ambas as voltagens nas células e o pote de ruído.

Item a

#fit the model
model = aov(data$Average ~ as.factor(data$Algorithm) + as.factor(data$Block))

anova(model)

## Analysis of Variance Table
## 
## Response: data$Average
##                           Df   Sum Sq   Mean Sq F value Pr(>F)
## as.factor(data$Algorithm)  3 0.002746 0.0009153  0.1902 0.9014
## as.factor(data$Block)      5 0.017438 0.0034875  0.7248 0.6154
## Residuals                 15 0.072179 0.0048119

#boxplot of treatment
boxplot(data$Average ~ data$Algorithm)

#treatment means
plot(data$Average ~ data$Algorithm)
means = tapply(data$Average,data$Algorithm,mean); means

##        1        2        3        4 
## 4.860000 4.833333 4.846667 4.835000

lines(means, col = "red")

Conclusões

Os gráficos, tando de box-plot quanto de médias não parecem indicar uma diferença significativa nas médias dos tratamentos. Observando a ANOVA, verificamso que não existe efeito de tratamento.

Item b

Para isso, consideraremos como variável resposta o pote de ruído.

#fit the model
model = aov(data$StDev ~ as.factor(data$Algorithm) + as.factor(data$Block))

anova(model)

## Analysis of Variance Table
## 
## Response: data$StDev
##                           Df    Sum Sq   Mean Sq F value    Pr(>F)    
## as.factor(data$Algorithm)  3 0.0260125 0.0086708 50.7561 4.345e-08 ***
## as.factor(data$Block)      5 0.0027208 0.0005442  3.1854   0.03711 *  
## Residuals                 15 0.0025625 0.0001708                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

#boxplot of treatment
boxplot(data$StDev ~ data$Algorithm)

#treatment means
plot(data$StDev ~ data$Algorithm)
means = tapply(data$StDev,data$Algorithm,mean); means

##          1          2          3          4 
## 0.04666667 0.03166667 0.11333333 0.03666667

lines(means, col = "red")

Conclusões

Neste caso tanto o box-plot quando o gráfico de médias parecem indicar que o tratamento 3 possui pote de ruído superior aos demais, pela ANOVA verificamos que existe efeito de tratamento.

Item c

#Residual analysis
hnp(model)

## Gaussian model (aov object)

shapiro.test(model$residuals)

## 
##  Shapiro-Wilk normality test
## 
## data:  model$residuals
## W = 0.94608, p-value = 0.2225

lillie.test(model$residuals)

## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  model$residuals
## D = 0.14838, p-value = 0.1871

#hocedasticity assumption
plot(model$fitted.values,model$residuals)
abline(0,0)

bartlett.test(data$StDev ~ as.factor(data$Algorithm))

## 
##  Bartlett test of homogeneity of variances
## 
## data:  data$StDev by as.factor(data$Algorithm)
## Bartlett's K-squared = 5.6705, df = 3, p-value = 0.1288

Conclusões

Nem o teste de shapiro nem o de lilliefors rejeitaram a hipótese nula de normalidade, o teste de bartlett não rejeitou a hipótese nula de homogeneidade de variâncias.

Soluções computacionais do Montgomery

Lucas Araújo da Silva

11 de setembro de 2018

Capítulo 3

Problema 3.5

Item a

Item b

Item c

Item d

Item e

Problema 3.6

Item a

Item f

Capítulo 4

Problema 4.3

Conclusões

Problema 4.4

Concluões

Problema 4.5

Conclusões

Problema 4.6

Problema 4.7

Item a

Conclusões

Item b

Conclusões

Item c

Conclusões

Problema 4.8

Item a

Conclusões

Item b

Conclusões

Item c

Conclusões

Problema 4.9

Item a

Conclusões

Item b

Conclusões

Item c

Conclusões

Problema 4.10

Item a

Conclusões

Item b

Conclusões

Item c

Conclusões

Problema 4.11

Item a

Conclusões

Item b

Conclusões

Item c

Conclusões