O gerente de marketing de um banco suspeita de que o número de vendas de um determinado produto é influenciado pela estratégia de venda utilizada e pela taxa de juros associada a esse produto. Ele selecionou três taxas de juros – 10%, 15% e 20%– e três tipos de estratégia (A, B e C). Ao longo de 4 dias foram computadas quantas vendas foram realizadas desse produto utilizando-se cada uma das combinações de estratégia e taxa de juros. Como os diferentes dias podem acarretar em uma variabilidade adicional, os mesmos foram adicionados ao experimento como blocos. Os dados estão descritos abaixo:
dados <- read.csv("tarefa4.csv")
attach(dados)
dados$Dias <- as.factor(dados$Dias)
dados$Estrategia <- as.factor(dados$Estrategia)
kable(dados)| Dias | Estrategia | Juros | Vendas |
|---|---|---|---|
| 1 | A | 10 | 130 |
| 1 | A | 15 | 34 |
| 1 | A | 20 | 20 |
| 1 | B | 10 | 150 |
| 1 | B | 15 | 136 |
| 1 | B | 20 | 25 |
| 1 | C | 10 | 138 |
| 1 | C | 15 | 174 |
| 1 | C | 20 | 96 |
| 2 | A | 10 | 155 |
| 2 | A | 15 | 40 |
| 2 | A | 20 | 70 |
| 2 | B | 10 | 188 |
| 2 | B | 15 | 122 |
| 2 | B | 20 | 70 |
| 2 | C | 10 | 110 |
| 2 | C | 15 | 120 |
| 2 | C | 20 | 104 |
| 3 | A | 10 | 74 |
| 3 | A | 15 | 80 |
| 3 | A | 20 | 82 |
| 3 | B | 10 | 159 |
| 3 | B | 15 | 106 |
| 3 | B | 20 | 58 |
| 3 | C | 10 | 168 |
| 3 | C | 15 | 150 |
| 3 | C | 20 | 82 |
| 4 | A | 10 | 180 |
| 4 | A | 15 | 75 |
| 4 | A | 20 | 58 |
| 4 | B | 10 | 126 |
| 4 | B | 15 | 115 |
| 4 | B | 20 | 45 |
| 4 | C | 10 | 160 |
| 4 | C | 15 | 139 |
| 4 | C | 20 | 60 |
(a) Descreva o experimento (delineamento, fatores de tratamentos e seus níveis, repetições):
Este experimento fatorial cruzado possui um delineamento de blocos casualizados. O primeiro fator de tratamento é a Estratégia (níveis: A, B e C), o segundo é a Taxa de Juros (níveis: 10%, 15% e 20%) e o terceiro é o Dia/Bloco (níveis: 1, 2, 3 e 4). São 4 repetições de cada combinação entre cada Estratégia com cada Taxa de Juros.
(b) Apresente e teste as hipóteses apropriadas, usando a análise de variância com \(\alpha\) = 5%.
A partir da descrição anterior, temos o modelo: \[y_{ijk} = \mu + \alpha_i + \beta_j + \alpha\beta_{ij} + R_k + \epsilon_{ijk}\]
Temos as seguintes hipóteses nulas:
\(H_0\): a mudança da Estratégia gera o mesmo efeito sobre a mudança dos três diferentes níveis da Taxa , assim como a mudança na Taxa gera o mesmo efeito sobre a mudança dos três níveis diferentes da Estratégia;
\(H_0\): a quantidade média de produtos vendidos esperada não muda conforme a mudança de nível da Estratégia;
\(H_0\): a quantidade média de produtos vendidos esperada não muda conforme a mudança de nível da Taxa.
Em outras palavras:
\(H_0\): \(\alpha\beta_{ij} = 0\) ;
\(H_0\): \(\alpha_i = 0\) ;
\(H_0\): \(\beta_j = 0\)
Vamos utilizar a ANOVA para fazer estes testes.
anova <- aov(Vendas ~ as.factor(Dias) + (Estrategia)*as.factor(Juros))
summary(anova)## Df Sum Sq Mean Sq F value Pr(>F)
## as.factor(Dias) 3 355 118 0.159 0.92292
## Estrategia 2 10684 5342 7.172 0.00362 **
## as.factor(Juros) 2 39119 19559 26.260 9.06e-07 ***
## Estrategia:as.factor(Juros) 4 9614 2403 3.227 0.02971 *
## Residuals 24 17876 745
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Podemos observar pelo resultado da ANOVA que temos um p-valor significativo considerando um \(\alpha = 0.05\) para as variáveis Estratégia e Taxa de Juros e também para a sua interação. Os blocos não são significativos.
(c) Analise graficamente a interação.
par(mfrow=c(1, 2))
par(mar = c(4, 3, 4, 3))
interaction.plot(Estrategia, Juros, Vendas, col = c("red", "darkblue", "gray30"), lty = 5)
interaction.plot(Juros, Estrategia, Vendas, col = c("red", "darkblue", "gray30"), lty = 5)
Fazendo uma análise gráfica, percebemos que, no primeiro gráfico, os traçados de cada Taxa não estão paralelos, o que leva a crer que o efeito da Estratégia depende dos Juros. Podemos afirmar que há um efeito acentuado em 15%.
Já no segundo gráfico, observamos que, assim como antes, os traçados de cada Estratégia não estão paralelos, e dessa forma entendemos que o efeito dos Juros depende de Estratégia. Percebemos que a quantidade de vendas, no geral, diminui conforme os Juros aumentam, sendo a queda mais acentuada na Estratégia B.
Quanto à interação, percebemos que os traçados se cruzam em ambos os gráficos, o que indica, de fato, a interação.
(d) Analise os resíduos deste experimento e suas pressuposições.
par(mfrow=c(1,2))
par(mar = c(4, 3, 4, 3))
plot(anova, which = c(1, 2))
Observamos pelo primeiro gráfico que temos a homocedasticidade da variância dos resíduos, já que os pontos estão dispersos de forma a não apresentar um padrão. Podemos confirmar pelo teste de Breusch-Pagan:
bptest(anova)##
## studentized Breusch-Pagan test
##
## data: anova
## BP = 10.63, df = 11, p-value = 0.4748O segundo gráfico mostra a normalidade dos resíduos já que os pontos estão próximos da linha. Podemos confirmar pelo teste de Shapiro-Wilk:
shapiro.test(anova$residuals)##
## Shapiro-Wilk normality test
##
## data: anova$residuals
## W = 0.97468, p-value = 0.5664(e) Faça as devidas complementações da análise e conclua.
Agora vamos decompor os fatores.
Primeiramente, para Estratégia dentro de Juros:
decomp1 <- aov(Vendas ~ as.factor(Dias) + as.factor(Juros)/Estrategia)
lista_juros <- list("10%" = seq(1, by = 3, length.out = 2),
"15%" = seq(2, by = 3, length.out = 2),
"20%" = seq(3, by = 3, length.out = 2))
summary(decomp1, split = list("as.factor(Juros):Estrategia" = lista_juros))## Df Sum Sq Mean Sq F value Pr(>F)
## as.factor(Dias) 3 355 118 0.159 0.922923
## as.factor(Juros) 2 39119 19559 26.260 9.06e-07 ***
## as.factor(Juros):Estrategia 6 20298 3383 4.542 0.003273 **
## as.factor(Juros):Estrategia: 10% 2 886 443 0.595 0.559558
## as.factor(Juros):Estrategia: 15% 2 16553 8276 11.112 0.000384 ***
## as.factor(Juros):Estrategia: 20% 2 2859 1429 1.919 0.168605
## Residuals 24 17876 745
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Decompondo os Juros, temos que apenas o nível de 15% é significativo. Ou seja, só há uma diferença significativa entre as Estratégias com os Juros em 15%.
lsmeans(anova, pairwise ~ Estrategia|as.factor(Juros))## $lsmeans
## Juros = 10:
## Estrategia lsmean SE df lower.CL upper.CL
## A 134.8 13.6 24 106.6 162.9
## B 155.8 13.6 24 127.6 183.9
## C 144.0 13.6 24 115.8 172.2
##
## Juros = 15:
## Estrategia lsmean SE df lower.CL upper.CL
## A 57.2 13.6 24 29.1 85.4
## B 119.8 13.6 24 91.6 147.9
## C 145.8 13.6 24 117.6 173.9
##
## Juros = 20:
## Estrategia lsmean SE df lower.CL upper.CL
## A 57.5 13.6 24 29.3 85.7
## B 49.5 13.6 24 21.3 77.7
## C 85.5 13.6 24 57.3 113.7
##
## Results are averaged over the levels of: Dias
## Confidence level used: 0.95
##
## $contrasts
## Juros = 10:
## contrast estimate SE df t.ratio p.value
## A - B -21.00 19.3 24 -1.088 0.5304
## A - C -9.25 19.3 24 -0.479 0.8817
## B - C 11.75 19.3 24 0.609 0.8167
##
## Juros = 15:
## contrast estimate SE df t.ratio p.value
## A - B -62.50 19.3 24 -3.239 0.0094
## A - C -88.50 19.3 24 -4.586 0.0003
## B - C -26.00 19.3 24 -1.347 0.3838
##
## Juros = 20:
## contrast estimate SE df t.ratio p.value
## A - B 8.00 19.3 24 0.415 0.9100
## A - C -28.00 19.3 24 -1.451 0.3317
## B - C -36.00 19.3 24 -1.865 0.1705
##
## Results are averaged over the levels of: Dias
## P value adjustment: tukey method for comparing a family of 3 estimatesEntre as comparações de Estratégias para cada Juro (lembrando que apenas o nível de 15% é significativo), temos como significativa apenas a comparação de A e B, além de A e C. Isso se dá por causa dos baixos valores de vendas na Estratégia A, como podemos ver na coluna lsmeans.
E agora, vamos decompor Juros dentro da Estratégia:
decomp2 <- aov(Vendas ~ as.factor(Dias) + Estrategia/as.factor(Juros))
lista_estrategia <- list("A" = seq(1, by = 3, length.out = 2),
"B" = seq(2, by = 3, length.out = 2),
"C" = seq(3, by = 3, length.out = 2))
summary(decomp2, split = list("Estrategia:as.factor(Juros)" = lista_estrategia))## Df Sum Sq Mean Sq F value Pr(>F)
## as.factor(Dias) 3 355 118 0.159 0.922923
## Estrategia 2 10684 5342 7.172 0.003616 **
## Estrategia:as.factor(Juros) 6 48732 8122 10.905 7.19e-06 ***
## Estrategia:as.factor(Juros): A 2 15965 7983 10.717 0.000472 ***
## Estrategia:as.factor(Juros): B 2 23360 11680 15.682 4.40e-05 ***
## Estrategia:as.factor(Juros): C 2 9407 4704 6.315 0.006259 **
## Residuals 24 17876 745
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Decompondo a Estratégia, temos que os seus 3 níveis são significativos. Ou seja, há uma diferença significativa entre os Juros para qualquer que seja a Estratégia.
lsmeans(anova, list(poly ~ as.factor(Juros)|Estrategia))## $`lsmeans of Juros | Estrategia`
## Estrategia = A:
## Juros lsmean SE df lower.CL upper.CL
## 10 134.8 13.6 24 106.6 162.9
## 15 57.2 13.6 24 29.1 85.4
## 20 57.5 13.6 24 29.3 85.7
##
## Estrategia = B:
## Juros lsmean SE df lower.CL upper.CL
## 10 155.8 13.6 24 127.6 183.9
## 15 119.8 13.6 24 91.6 147.9
## 20 49.5 13.6 24 21.3 77.7
##
## Estrategia = C:
## Juros lsmean SE df lower.CL upper.CL
## 10 144.0 13.6 24 115.8 172.2
## 15 145.8 13.6 24 117.6 173.9
## 20 85.5 13.6 24 57.3 113.7
##
## Results are averaged over the levels of: Dias
## Confidence level used: 0.95
##
## $`polynomial contrasts of Juros | Estrategia`
## Estrategia = A:
## 2 estimate SE df t.ratio p.value
## linear -77.2 19.3 24 -4.003 0.0005
## quadratic 77.8 33.4 24 2.326 0.0288
##
## Estrategia = B:
## 2 estimate SE df t.ratio p.value
## linear -106.2 19.3 24 -5.506 <.0001
## quadratic -34.2 33.4 24 -1.025 0.3157
##
## Estrategia = C:
## 2 estimate SE df t.ratio p.value
## linear -58.5 19.3 24 -3.031 0.0058
## quadratic -62.0 33.4 24 -1.855 0.0759
##
## Results are averaged over the levels of: DiasAgora testamos os efeitos lineares ou quadráticos possíveis para cada Estratégia. Nesse caso, os efeitos significativos foram lineares para B e C e quadrático para A.
par(mfrow=c(1,3))
par(mar = c(4, 3, 4, 3))
#########
modelo_1 <- print(lm(Vendas ~ Juros + I(Juros^2), data = subset(dados, dados$Estrategia == "A")))##
## Call:
## lm(formula = Vendas ~ Juros + I(Juros^2), data = subset(dados,
## dados$Estrategia == "A"))
##
## Coefficients:
## (Intercept) Juros I(Juros^2)
## 523.000 -54.375 1.555plot(dados$Juros, dados$Vendas, pch = 16, col = "blue", xlab = "Juros", ylab = "Vendas", main = "Ajuste da Regressão - A")
curve(predict(modelo_1, newdata = data.frame(Juros = x)), from = 10, to = 20, col = "red", add = TRUE, lwd = 2)
#########
modelo_2 <- print(lm(Vendas ~ Juros, data = subset(dados, dados$Estrategia == "B")))##
## Call:
## lm(formula = Vendas ~ Juros, data = subset(dados, dados$Estrategia ==
## "B"))
##
## Coefficients:
## (Intercept) Juros
## 267.71 -10.63plot(dados$Juros, dados$Vendas, pch = 16, col = "blue", xlab = "Juros", ylab = "Vendas", main = "Ajuste da Regressão - B")
abline(modelo_2, col = "red", lwd = 2)
#########
modelo_3 <- print(lm(Vendas ~ Juros, data = subset(dados, dados$Estrategia == "C")))##
## Call:
## lm(formula = Vendas ~ Juros, data = subset(dados, dados$Estrategia ==
## "C"))
##
## Coefficients:
## (Intercept) Juros
## 212.83 -5.85plot(dados$Juros, dados$Vendas, pch = 16, col = "blue", xlab = "Juros", ylab = "Vendas", main = "Ajuste da Regressão - C")
abline(modelo_3, col = "red", lwd = 2)
Evidentemente, como temos coeficientes negativos para o \(\beta_1\) dos modelos lineares, temos uma reta inclinada indicando que conforme aumentamos os Juros, diminuímos as vendas. Para a regressão do efeito quadrático, temos essa parábola mostrando que a quantidade maior de vendas foi com Juros iguais a 10%.
Concluindo, temos que, como a Taxa de Juros de 10% é melhor, então bastaria escolher qual das três Estratégias é melhor, ainda que não haja uma diferença significativa entre elas com esses Juros, mas, comparando estes últimos três gráficos, para maximizar suas vendas, escolheríamos a Estratégia B.