knitr::opts_chunk$set(echo = TRUE)
if(!require("tidyverse")) {install.packages("tidyverse"); library("tidyverse")}
if(!require("DescTools")) {install.packages("DescTools"); library("DescTools")}
if(!require("car")) {install.packages("car"); library("car")}
if(!require("lsr")) {install.packages("lsr"); library("lsr")}
if(!require("Hmisc")) {install.packages("Hmisc"); library("Hmisc")}
if(!require("sjlabelled")) {install.packages("sjlabelled"); library("sjlabelled")}
if(!require("forcats")) {install.packages("forcats"); library("forcats")}
# clean up working environment
rm(list = ls())
# Generate data
mydatc3c <- data.frame(Placement = rep(c("Candy_section","Special_placement", "Cash_register"),
each = 5),
SM = c(paste0("SM", 1:15)),
Box = c(47,39,40,46,45,68,65,63,59,67,59,50,51,48,53),
Paper = c(40,39,35,36,37,59,57,54,56,53,53,47,48,50,51))
# Reorder factor levels as desired
mydatc3c$Placement <- forcats::fct_relevel(mydatc3c$Placement, "Candy_section","Special_placement", "Cash_register")
# Display generated data for verification; # Structure of the generated data
head(mydatc3c, 15); str(mydatc3c)
## Placement SM Box Paper
## 1 Candy_section SM1 47 40
## 2 Candy_section SM2 39 39
## 3 Candy_section SM3 40 35
## 4 Candy_section SM4 46 36
## 5 Candy_section SM5 45 37
## 6 Special_placement SM6 68 59
## 7 Special_placement SM7 65 57
## 8 Special_placement SM8 63 54
## 9 Special_placement SM9 59 56
## 10 Special_placement SM10 67 53
## 11 Cash_register SM11 59 53
## 12 Cash_register SM12 50 47
## 13 Cash_register SM13 51 48
## 14 Cash_register SM14 48 50
## 15 Cash_register SM15 53 51
## 'data.frame': 15 obs. of 4 variables:
## $ Placement: Factor w/ 3 levels "Candy_section",..: 1 1 1 1 1 2 2 2 2 2 ...
## $ SM : Factor w/ 15 levels "SM1","SM10","SM11",..: 1 8 9 10 11 12 13 14 15 2 ...
## $ Box : num 47 39 40 46 45 68 65 63 59 67 ...
## $ Paper : num 40 39 35 36 37 59 57 54 56 53 ...
# Prepare data (long format for two-factor ANOVA)
mydatc3d <- mydatc3c %>%
gather(.,Packaging, Sales_volume, Box:Paper)
# Reorder factor levels as desired
mydatc3d$Placement <- forcats::fct_relevel(mydatc3d$Placement, "Candy_section","Special_placement", "Cash_register")
# Show data in long-format
print(mydatc3d)
## Placement SM Packaging Sales_volume
## 1 Candy_section SM1 Box 47
## 2 Candy_section SM2 Box 39
## 3 Candy_section SM3 Box 40
## 4 Candy_section SM4 Box 46
## 5 Candy_section SM5 Box 45
## 6 Special_placement SM6 Box 68
## 7 Special_placement SM7 Box 65
## 8 Special_placement SM8 Box 63
## 9 Special_placement SM9 Box 59
## 10 Special_placement SM10 Box 67
## 11 Cash_register SM11 Box 59
## 12 Cash_register SM12 Box 50
## 13 Cash_register SM13 Box 51
## 14 Cash_register SM14 Box 48
## 15 Cash_register SM15 Box 53
## 16 Candy_section SM1 Paper 40
## 17 Candy_section SM2 Paper 39
## 18 Candy_section SM3 Paper 35
## 19 Candy_section SM4 Paper 36
## 20 Candy_section SM5 Paper 37
## 21 Special_placement SM6 Paper 59
## 22 Special_placement SM7 Paper 57
## 23 Special_placement SM8 Paper 54
## 24 Special_placement SM9 Paper 56
## 25 Special_placement SM10 Paper 53
## 26 Cash_register SM11 Paper 53
## 27 Cash_register SM12 Paper 47
## 28 Cash_register SM13 Paper 48
## 29 Cash_register SM14 Paper 50
## 30 Cash_register SM15 Paper 51
# Result of the Levene test for variance homogeneity
car::leveneTest(mydatc3d$Sales_volume ~ mydatc3d$Placement*mydatc3d$Packaging, center = mean)
## Levene's Test for Homogeneity of Variance (center = mean)
## Df F value Pr(>F)
## group 5 0.8962 0.4994
## 24
# Descriptive statistics by group(s): Placement*Packaging
mydatc3d %>%
group_by(Placement, Packaging) %>%
summarise(mean(Sales_volume),
sd(Sales_volume),
n())
## `summarise()` has grouped output by 'Placement'. You can override using the `.groups` argument.
## # A tibble: 6 x 5
## # Groups: Placement [3]
## Placement Packaging `mean(Sales_volume)` `sd(Sales_volume)` `n()`
## <fct> <chr> <dbl> <dbl> <int>
## 1 Candy_section Box 43.4 3.65 5
## 2 Candy_section Paper 37.4 2.07 5
## 3 Special_placement Box 64.4 3.58 5
## 4 Special_placement Paper 55.8 2.39 5
## 5 Cash_register Box 52.2 4.21 5
## 6 Cash_register Paper 49.8 2.39 5
# Descriptive statistics by Placement
mydatc3d %>%
group_by(Placement) %>%
summarise(mean(Sales_volume),
sd(Sales_volume),
n())
## # A tibble: 3 x 4
## Placement `mean(Sales_volume)` `sd(Sales_volume)` `n()`
## <fct> <dbl> <dbl> <int>
## 1 Candy_section 40.4 4.22 10
## 2 Special_placement 60.1 5.36 10
## 3 Cash_register 51 3.46 10
# Descriptive statistics by Packaging
mydatc3d %>%
group_by(Packaging) %>%
summarise(mean(Sales_volume),
sd(Sales_volume),
n())
## # A tibble: 2 x 4
## Packaging `mean(Sales_volume)` `sd(Sales_volume)` `n()`
## <chr> <dbl> <dbl> <int>
## 1 Box 53.3 9.59 15
## 2 Paper 47.7 8.21 15
# Descriptive statistics Total
mydatc3d %>%
summarise(mean(Sales_volume),
sd(Sales_volume),
n())
## mean(Sales_volume) sd(Sales_volume) n()
## 1 50.5 9.231692 30
# ANOVA Results; # Results Partial Eta Squares
summary(aov(mydatc3d$Sales_volume ~ mydatc3d$Placement*mydatc3d$Packaging)); DescTools::EtaSq(aov(mydatc3d$Sales_volume ~ mydatc3d$Placement*mydatc3d$Packaging))
## Df Sum Sq Mean Sq F value Pr(>F)
## mydatc3d$Placement 2 1944.2 972.1 98.027 2.83e-12 ***
## mydatc3d$Packaging 1 240.8 240.8 24.286 4.99e-05 ***
## mydatc3d$Placement:mydatc3d$Packaging 2 48.5 24.2 2.444 0.108
## Residuals 24 238.0 9.9
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## eta.sq eta.sq.part
## mydatc3d$Placement 0.78664778 0.8909358
## mydatc3d$Packaging 0.09744420 0.5029586
## mydatc3d$Placement:mydatc3d$Packaging 0.01961022 0.1691878
# Interaction plot
interaction.plot(x.factor = mydatc3d$Placement,
trace.factor = mydatc3d$Packaging,
response = mydatc3d$Sales_volume,
fun = mean,
type = "b",
col = c("black","red","green"), ### Colors for levels of trace variable
pch = c(19, 17, 15), ### Symbols for levels of trace variable
fixed = TRUE, ### Order by factor order in data
leg.bty = "o",
xlab = "Placement",
ylab = "Estimated Marginal Means",
main = "Estimates Marginal Means of Sales volume",
trace.label = "Packaging",
cex.main = 1,
cex.lab = 1,
cex.axis = 1)
# Scheffé test
DescTools::ScheffeTest(aov(mydatc3d$Sales_volume ~ mydatc3d$Placement*mydatc3d$Packaging))
##
## Posthoc multiple comparisons of means: Scheffe Test
## 95% family-wise confidence level
##
## $`mydatc3d$Placement`
## diff lwr.ci upr.ci pval
## Special_placement-Candy_section 19.7 14.602142 24.797858 8.9e-11 ***
## Cash_register-Candy_section 10.6 5.502142 15.697858 1.1e-05 ***
## Cash_register-Special_placement -9.1 -14.197858 -4.002142 0.00011 ***
##
## $`mydatc3d$Packaging`
## diff lwr.ci upr.ci pval
## Paper-Box -5.666667 -9.82905 -1.504283 0.0033 **
##
## $`mydatc3d$Placement:mydatc3d$Packaging`
## diff lwr.ci upr.ci
## Special_placement:Box-Candy_section:Box 21.0 13.7905404 28.20946
## Cash_register:Box-Candy_section:Box 8.8 1.5905404 16.00946
## Candy_section:Paper-Candy_section:Box -6.0 -13.2094596 1.20946
## Special_placement:Paper-Candy_section:Box 12.4 5.1905404 19.60946
## Cash_register:Paper-Candy_section:Box 6.4 -0.8094596 13.60946
## Cash_register:Box-Special_placement:Box -12.2 -19.4094596 -4.99054
## Candy_section:Paper-Special_placement:Box -27.0 -34.2094596 -19.79054
## Special_placement:Paper-Special_placement:Box -8.6 -15.8094596 -1.39054
## Cash_register:Paper-Special_placement:Box -14.6 -21.8094596 -7.39054
## Candy_section:Paper-Cash_register:Box -14.8 -22.0094596 -7.59054
## Special_placement:Paper-Cash_register:Box 3.6 -3.6094596 10.80946
## Cash_register:Paper-Cash_register:Box -2.4 -9.6094596 4.80946
## Special_placement:Paper-Candy_section:Paper 18.4 11.1905404 25.60946
## Cash_register:Paper-Candy_section:Paper 12.4 5.1905404 19.60946
## Cash_register:Paper-Special_placement:Paper -6.0 -13.2094596 1.20946
## pval
## Special_placement:Box-Candy_section:Box 2.7e-08 ***
## Cash_register:Box-Candy_section:Box 0.00989 **
## Candy_section:Paper-Candy_section:Box 0.14789
## Special_placement:Paper-Candy_section:Box 0.00018 ***
## Cash_register:Paper-Candy_section:Box 0.10526
## Cash_register:Box-Special_placement:Box 0.00023 ***
## Candy_section:Paper-Special_placement:Box 1.7e-10 ***
## Special_placement:Paper-Special_placement:Box 0.01222 *
## Cash_register:Paper-Special_placement:Box 1.6e-05 ***
## Candy_section:Paper-Cash_register:Box 1.3e-05 ***
## Special_placement:Paper-Cash_register:Box 0.66178
## Cash_register:Paper-Cash_register:Box 0.91358
## Special_placement:Paper-Candy_section:Paper 3.2e-07 ***
## Cash_register:Paper-Candy_section:Paper 0.00018 ***
## Cash_register:Paper-Special_placement:Paper 0.14789
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Bonferroni test
DescTools::PostHocTest(aov(mydatc3d$Sales_volume ~ mydatc3d$Placement*mydatc3d$Packaging), method = "bonferroni")
##
## Posthoc multiple comparisons of means : Bonferroni
## 95% family-wise confidence level
##
## $`mydatc3d$Placement`
## diff lwr.ci upr.ci pval
## Special_placement-Candy_section 19.7 16.075519 23.324481 1.5e-12 ***
## Cash_register-Candy_section 10.6 6.975519 14.224481 2.7e-07 ***
## Cash_register-Special_placement -9.1 -12.724481 -5.475519 3.3e-06 ***
##
## $`mydatc3d$Packaging`
## diff lwr.ci upr.ci pval
## Paper-Box -5.666667 -8.039901 -3.293433 5e-05 ***
##
## $`mydatc3d$Placement:mydatc3d$Packaging`
## diff lwr.ci upr.ci
## Special_placement:Box-Candy_section:Box 21.0 14.51044658 27.4895534
## Cash_register:Box-Candy_section:Box 8.8 2.31044658 15.2895534
## Candy_section:Paper-Candy_section:Box -6.0 -12.48955342 0.4895534
## Special_placement:Paper-Candy_section:Box 12.4 5.91044658 18.8895534
## Cash_register:Paper-Candy_section:Box 6.4 -0.08955342 12.8895534
## Cash_register:Box-Special_placement:Box -12.2 -18.68955342 -5.7104466
## Candy_section:Paper-Special_placement:Box -27.0 -33.48955342 -20.5104466
## Special_placement:Paper-Special_placement:Box -8.6 -15.08955342 -2.1104466
## Cash_register:Paper-Special_placement:Box -14.6 -21.08955342 -8.1104466
## Candy_section:Paper-Cash_register:Box -14.8 -21.28955342 -8.3104466
## Special_placement:Paper-Cash_register:Box 3.6 -2.88955342 10.0895534
## Cash_register:Paper-Cash_register:Box -2.4 -8.88955342 4.0895534
## Special_placement:Paper-Candy_section:Paper 18.4 11.91044658 24.8895534
## Cash_register:Paper-Candy_section:Paper 12.4 5.91044658 18.8895534
## Cash_register:Paper-Special_placement:Paper -6.0 -12.48955342 0.4895534
## pval
## Special_placement:Box-Candy_section:Box 2.6e-09 ***
## Cash_register:Box-Candy_section:Box 0.0027 **
## Candy_section:Paper-Candy_section:Box 0.0903 .
## Special_placement:Paper-Candy_section:Box 2.9e-05 ***
## Cash_register:Paper-Candy_section:Box 0.0558 .
## Cash_register:Box-Special_placement:Box 3.8e-05 ***
## Candy_section:Paper-Special_placement:Box 1.4e-11 ***
## Special_placement:Paper-Special_placement:Box 0.0035 **
## Cash_register:Paper-Special_placement:Box 2.1e-06 ***
## Candy_section:Paper-Cash_register:Box 1.7e-06 ***
## Special_placement:Paper-Cash_register:Box 1.0000
## Cash_register:Paper-Cash_register:Box 1.0000
## Special_placement:Paper-Candy_section:Paper 3.4e-08 ***
## Cash_register:Paper-Candy_section:Paper 2.9e-05 ***
## Cash_register:Paper-Special_placement:Paper 0.0903 .
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Turkey-HSD test
DescTools::PostHocTest(aov(mydatc3d$Sales_volume ~ mydatc3d$Placement*mydatc3d$Packaging), method = "hsd")
##
## Posthoc multiple comparisons of means : Tukey HSD
## 95% family-wise confidence level
##
## $`mydatc3d$Placement`
## diff lwr.ci upr.ci pval
## Special_placement-Candy_section 19.7 16.183049 23.216951 1.5e-12 ***
## Cash_register-Candy_section 10.6 7.083049 14.116951 2.7e-07 ***
## Cash_register-Special_placement -9.1 -12.616951 -5.583049 3.2e-06 ***
##
## $`mydatc3d$Packaging`
## diff lwr.ci upr.ci pval
## Paper-Box -5.666667 -8.039901 -3.293433 5e-05 ***
##
## $`mydatc3d$Placement:mydatc3d$Packaging`
## diff lwr.ci upr.ci
## Special_placement:Box-Candy_section:Box 21.0 14.8419579 27.1580421
## Cash_register:Box-Candy_section:Box 8.8 2.6419579 14.9580421
## Candy_section:Paper-Candy_section:Box -6.0 -12.1580421 0.1580421
## Special_placement:Paper-Candy_section:Box 12.4 6.2419579 18.5580421
## Cash_register:Paper-Candy_section:Box 6.4 0.2419579 12.5580421
## Cash_register:Box-Special_placement:Box -12.2 -18.3580421 -6.0419579
## Candy_section:Paper-Special_placement:Box -27.0 -33.1580421 -20.8419579
## Special_placement:Paper-Special_placement:Box -8.6 -14.7580421 -2.4419579
## Cash_register:Paper-Special_placement:Box -14.6 -20.7580421 -8.4419579
## Candy_section:Paper-Cash_register:Box -14.8 -20.9580421 -8.6419579
## Special_placement:Paper-Cash_register:Box 3.6 -2.5580421 9.7580421
## Cash_register:Paper-Cash_register:Box -2.4 -8.5580421 3.7580421
## Special_placement:Paper-Candy_section:Paper 18.4 12.2419579 24.5580421
## Cash_register:Paper-Candy_section:Paper 12.4 6.2419579 18.5580421
## Cash_register:Paper-Special_placement:Paper -6.0 -12.1580421 0.1580421
## pval
## Special_placement:Box-Candy_section:Box 2.5e-09 ***
## Cash_register:Box-Candy_section:Box 0.0022 **
## Candy_section:Paper-Candy_section:Box 0.0592 .
## Special_placement:Paper-Candy_section:Box 2.6e-05 ***
## Cash_register:Paper-Candy_section:Box 0.0384 *
## Cash_register:Box-Special_placement:Box 3.4e-05 ***
## Candy_section:Paper-Special_placement:Box 1.4e-11 ***
## Special_placement:Paper-Special_placement:Box 0.0029 **
## Cash_register:Paper-Special_placement:Box 2.0e-06 ***
## Candy_section:Paper-Cash_register:Box 1.6e-06 ***
## Special_placement:Paper-Cash_register:Box 0.4798
## Cash_register:Paper-Cash_register:Box 0.8301
## Special_placement:Paper-Candy_section:Paper 3.2e-08 ***
## Cash_register:Paper-Candy_section:Paper 2.6e-05 ***
## Cash_register:Paper-Special_placement:Paper 0.0592 .
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Run contrast analysis
levels(mydatc3d$Placement)
## [1] "Candy_section" "Special_placement" "Cash_register"
contrasts(mydatc3d$Placement) <- c(0.5, -1, 0.5)
mycontranova <- aov(Sales_volume ~ Placement, data = mydatc3d)
summary(mycontranova); DescTools::ScheffeTest(mycontranova, contrasts = contrasts(mydatc3d$Placement))
## Df Sum Sq Mean Sq F value Pr(>F)
## Placement 2 1944.2 972.1 49.78 8.77e-10 ***
## Residuals 27 527.3 19.5
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Posthoc multiple comparisons of means: Scheffe Test
## 95% family-wise confidence level
##
## $Placement
## diff lwr.ci upr.ci
## Candy_section,Cash_register-Special_placement -14.400000 -18.832999 -9.967001
## Cash_register-Candy_section,Special_placement 7.495332 3.875803 11.114860
## pval
## Candy_section,Cash_register-Special_placement 2.8e-08 ***
## Cash_register-Candy_section,Special_placement 5.6e-05 ***
##
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Generate data ("Box")
mydatc3e.1 <- data.frame(Placement = rep(c("Candy_section","Special_placement", "Cash_register"),
each = 5),
SM = c(paste0("SM", 1:15)),
Packaging = c("Box"),
Sales = c(47,39,40,46,45,68,65,63,59,67,59,50,51,48,53),
Price = c(1.89,1.89,1.89,1.84,1.84,2.09,2.09,1.99,1.99,1.99,1.99,1.98,1.98,1.89,1.89),
Temp = c(16,21,19,24,25,18,19,21,21,19,20,21,23,24,20))
# Generate data ("Paper")
mydatc3e.2 <- data.frame(Placement = rep(c("Candy_section","Special_placement", "Cash_register"),
each = 5),
SM = c(paste0("SM", 1:15)),
Packaging = c("Paper"),
Sales = c(40,39,35,36,37,59,57,54,56,53,53,47,48,50,51),
Price = c(2.13,2.13,2.13,2.09,2.09,2.09,1.99,1.99,2.09,2.09,2.19,2.19,2.19,2.13,2.13),
Temp = c(22,24,21,21,20,18,19,18,18,18,19,20,17,18,18))
# Join datasets tp generate Table 3.16 (Data matrix with covariates)
mydatc3e.3 <- full_join(mydatc3e.1, mydatc3e.2, by = c("Placement","SM","Packaging","Sales","Price","Temp"))
# Display generated data for verification
head(mydatc3e.3);tail(mydatc3e.3)
## Placement SM Packaging Sales Price Temp
## 1 Candy_section SM1 Box 47 1.89 16
## 2 Candy_section SM2 Box 39 1.89 21
## 3 Candy_section SM3 Box 40 1.89 19
## 4 Candy_section SM4 Box 46 1.84 24
## 5 Candy_section SM5 Box 45 1.84 25
## 6 Special_placement SM6 Box 68 2.09 18
## Placement SM Packaging Sales Price Temp
## 25 Special_placement SM10 Paper 53 2.09 18
## 26 Cash_register SM11 Paper 53 2.19 19
## 27 Cash_register SM12 Paper 47 2.19 20
## 28 Cash_register SM13 Paper 48 2.19 17
## 29 Cash_register SM14 Paper 50 2.13 18
## 30 Cash_register SM15 Paper 51 2.13 18
myanocva <- aov(Sales ~ Placement*Packaging + Price + Temp, data = mydatc3e.3)
# ANCOVA Results with Type III Error
res.myanocva <- car::Anova(myanocva, type = "III")
# Display ANOCOVA results including partial Eta-squared effect sizes
res.myanocva; lsr::etaSquared(myanocva)
## Anova Table (Type III tests)
##
## Response: Sales
## Sum Sq Df F value Pr(>F)
## (Intercept) 7.20 1 0.7069 0.40952
## Placement 364.08 2 17.8796 2.448e-05 ***
## Packaging 37.97 1 3.7290 0.06646 .
## Price 5.01 1 0.4920 0.49038
## Temp 4.88 1 0.4797 0.49581
## Placement:Packaging 13.22 2 0.6492 0.53218
## Residuals 223.99 22
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## eta.sq eta.sq.part
## Placement 0.499683182 0.84647329
## Packaging 0.086632453 0.48872800
## Price 0.002026931 0.02187598
## Temp 0.001976023 0.02133827
## Placement:Packaging 0.005348779 0.05572956