Split Plot - Marshmallow Shooters

On this page

• Background
• Interpretation

library(mosaic)
library(DT)
library(pander)
library(car)
library(tidyverse)
library(lattice)
library(dplyr)
library(ggplot2)
library(knitr)
library(swirl)

# Record your data from your own mini experiment in Excel.
# Save the data as a .csv file in the Data folder of the Statistics-Notebook.


mm <- read_csv("../../data/MarshmallowSplitPlot.csv")

mm$angle <- as.factor(mm$angle)

mm$person <- as.factor(mm$person)

mm$marshmallow <- as.factor(mm$marshmallow)

Background

Introduction & Methods

We randomized our data via the excel and r. We labeled 10 different marshmallows (our blocking factor) and randomized each one to one of our between factor and each marshmallow received our within factor. Our between blocks factor is Cali vs Stephanie shooting the marshmallows off of a spoon and our within blocks if if they shot the mashmallows sitting or standing. We taped a target to the floor and measured how close the marshmallow landed to the center of the target (measured in centimeters).

Stephanie got marshmallows 1, 2, 4, 5, & 7. Cali got marshmallows 3, 6, 8, 9, & 10.

We randomized the order of which marshmallow would be shot off first either sitting and standing, ensuring that each marshmallow was shot off both sitting and standing angles.

marshmallow is nested within person.

Data

library(dplyr)

mm <- mm %>%
  select(person, marshmallow, angle, cm, order)

datatable(mm, options=list(lengthMenu = c(5,10,20)))

Analysis

Hypotheses

EFFECT HYPOTHESES

H_0: \text{Person} (\alpha_\text{i}) = 0 \text{ for all } i

H_a: \text{Person} (\alpha_\text{i}) \ne 0 \text{ for some } i

H_0: \text{Angle}(\gamma_\text{k}) = 0 \text{ for all } k

H_a: \text{Angle}(\gamma_\text{k}) \ne 0 \text{ for some } k

H_0: \text{Person x Angle}(\alpha\gamma)_\text{ik} = 0 \text{ for all } ik

H_a: \text{Person x Angle}(\alpha\gamma)_\text{ik} \ne 0 \text{ for some } ik

---

Split Plot Mathematical Model

y_{ijk} = \mu + \alpha_i + \beta_{ij} + \gamma_k + (\alpha \gamma)_{ik} + \epsilon_{ijk} \tag{1}

Significance level is

\alpha = 0.1 (Alpha is set to 0.1 because the data was weird and I expect a lot of variation). ————————————————————————

ANOVA (Split Plot)

mm.aov <- aov(cm ~ person + Error(marshmallow) + angle +
                person:angle, data = mm)
summary(mm.aov) %>% 
  pander()

	Df	Sum Sq	Mean Sq	F value	Pr(>F)
person	1	484.1	484.1	0.4888	0.5043
Residuals	8	7924	990.5	NA	NA
angle	1	2473	2473	3.781	0.08775
person:angle	1	250.6	250.6	0.3831	0.5531
Residuals	8	5233	654.2	NA	NA

We are seeing that only the angle is significant with a 0.1 alpha 0.09 < \alpha. Let’s take a closer look with graphs and numeric summaries.

---

Graphs

Person Graph

## lets go a ggplot that's real sexy like

library(ggplot2)
library(dplyr)

ggplot(mm, aes(x=person, y=cm)) +
  geom_boxplot(aes(fill = person)) +
  theme_bw() +
  scale_fill_manual(values = c("cadetblue1", "seagreen", "gray")) +
  labs(title = "Distance to Target Achieved by Stephanie and Cali",
       fill = "Person",
       x = "Person",
       y = "Distance from Center of Target (cm)")

The averages are very close as depicted in this graph and there are is not too much variation either.

Person Numerical Summary

mm %>%
  group_by(person) %>%
  summarise(
    Average = mean(cm, na.rm = TRUE),
    Min = min(cm, na.rm = TRUE), 
    Med = median(cm, na.rm = TRUE), 
    Max = max(cm, na.rm = TRUE),
    StDev = sd(cm, na.rm = TRUE), 
    SampleSize = n()
  ) %>%
  pander()

person	Average	Min	Med	Max	StDev	SampleSize
Cali	61.38	12.2	68.25	107.8	29.73	10
Stephanie	71.22	15.3	73.2	107.6	29.67	10

Not significant.

---

Angle Graph

## lets go a ggplot that's real sexy like

library(ggplot2)
library(dplyr)

ggplot(mm, aes(x=angle, y=cm)) +
  geom_boxplot(aes(fill = angle)) +
  theme_bw() +
  scale_fill_manual(values = c("firebrick", "goldenrod")) +
  labs(title = "Angle Affecting Distance to Target",
       fill = "Angle",
       x = "Angle",
       y = "Distance from Center (cm)")

Stand has so much variance, the marshmallow shot off while standing had so much variance from the target whereas sitting led to closer standard deviation as depicted in the numerical summary below.

Angle Numerical Summary

mm %>%
  group_by(angle) %>%
  summarise(
    Average = mean(cm, na.rm = TRUE),
    Min = min(cm, na.rm = TRUE), 
    Med = median(cm, na.rm = TRUE), 
    Max = max(cm, na.rm = TRUE),
    StDev = sd(cm, na.rm = TRUE), 
    SampleSize = n()
  ) %>%
  pander()

angle	Average	Min	Med	Max	StDev	SampleSize
sit	77.42	46.8	78.1	107.8	19.09	10
stand	55.18	12.2	65.45	107.6	34.34	10

These averages look very different, and from the anova test we see that it is significant.

---

Interaction Graph

xyplot(cm ~ angle, data = mm, groups=person, type=c("p","a"), auto.key=TRUE, 
        main="How Angle by Person Affects Accuracy to Target", 
        ylab="Distance from Center (cm)", 
        xlab="Angle")

Stand has the closest to the target over sit with Cali having the marshmallow that got the closest to the target.

Interaction Numerical Summary

mm %>%
  group_by(person, angle) %>%
  summarise(
    Average = mean(cm, na.rm = TRUE),
    Min = min(cm, na.rm = TRUE), 
    Med = median(cm, na.rm = TRUE), 
    Max = max(cm, na.rm = TRUE),
    StDev = sd(cm, na.rm = TRUE), 
    SampleSize = n()
  ) %>%
  pander()

person	angle	Average	Min	Med	Max	StDev	SampleSize
Cali	sit	76.04	46.8	79.2	107.8	22.67	5
Cali	stand	46.72	12.2	61.5	72.6	30.63	5
Stephanie	sit	78.8	59.8	77	104.3	17.35	5
Stephanie	stand	63.64	15.3	69.4	107.6	39.2	5

The standard deviation on standing angle is crazy, but the averages appear much lower than sitting angle.

---

Diagnostics

library(car)

par(mfrow=c(1,3))
qqPlot(mm.aov$marshmallow$residuals, main="Block - Normality", id=FALSE)
plot(mm.aov$marshmallow$fitted.values, mm.aov$marshmallow$residuals, main="Block - Constant Variance", pch=16)
plot(mm.aov$marshmallow$residuals, main="Block - Independece", id=FALSE)

It looks like for the blocks, nearly every assumption has been violated. Normality has not been met, constant variance shows a megaphone type pattern, and the independence plot doesn’t look randomized, there may be trends.

library(car)

par(mfrow=c(1,3))

qqPlot(mm.aov$Within$residuals,  main="Residuals - Normality", id=FALSE)

plot(mm.aov$Within$fitted.values, mm.aov$Within$residuals, main="Residuals - Constant Variance",pch=16)

plot(mm.aov$Within$residuals, main="Residuals - Constant Variance", id=FALSE)

These QQ plot shows the normality of the data within the bounds so we can assume that normality assumptions are met.

There is not a megaphone pattern in the residuals vs fitted plot, there is constant variance.

The 3rd plot depicts independence, there are no obvious trends in the data so we can conclude that independence requirements have been met.

We can conclude that all requirements have been met and that we can continue with the interpretation and post hoc tests of the experiment.

---

Post Hoc Tests

Grouping Comparions

Interaction Groupings

library(emmeans)

mm.means <- emmeans(mm.aov, ~ person * angle, infer = c(TRUE, TRUE))

myContrasts <- contrast(
  mm.means,
  list(
    CaliSitvsOthers = c(1, -0.3, -0.3, -0.3),
    CaliStandvsOthers   = c(-0.3, 1, -0.3, -0.3),
    StephanieSitvsOthers = c(-0.3, -0.3, 1, -0.3),
    StephanieStandvsOthers = c(-0.3, -0.3, -0.3, 1)
  ),
  adjust = "scheffe"
)

myContrasts

 contrast               estimate SE   df t.ratio p.value
 CaliSitvsOthers           19.29 14 15.7   1.382  0.7516
 CaliStandvsOthers         22.88 14 15.7   1.640  0.6211
 StephanieSitvsOthers     -18.82 14 15.7  -1.349  0.7675
 StephanieStandvsOthers     3.17 14 15.7   0.227  0.9996

P value adjustment: scheffe method with rank 4 

Again like the statistical analysis the anova shows that none are significant. These post hocs are unnecessary, but I wanted to see just in case.

library(agricolae)

mm$Group <- with(mm, interaction(person, angle))
mm.aov2 <- aov(cm ~ Group, data = mm)
scheffe.test(mm.aov2, "Group", console = TRUE)

Study: mm.aov2 ~ "Group"

Scheffe Test for cm 

Mean Square Error  : 822.312 

Group,  means

                   cm      std r       se  Min   Max  Q25  Q50  Q75
Cali.sit        76.04 22.66833 5 12.82429 46.8 107.8 64.1 79.2 82.3
Cali.stand      46.72 30.62608 5 12.82429 12.2  72.6 14.9 61.5 72.4
Stephanie.sit   78.80 17.35036 5 12.82429 59.8 104.3 67.0 77.0 85.9
Stephanie.stand 63.64 39.19698 5 12.82429 15.3 107.6 32.6 69.4 93.3

Alpha: 0.05 ; DF Error: 16 
Critical Value of F: 3.238872 

Minimum Significant Difference: 56.53349 

Means with the same letter are not significantly different.

                   cm groups
Stephanie.sit   78.80      a
Cali.sit        76.04      a
Stephanie.stand 63.64      a
Cali.stand      46.72      a

This scheffé test shows that each of these groups are not different for each other.

---

Interpretation

All in all I think this experiment was very silly and it didn’t lead to much significant results. This wasn’t my favorite or best design and I feel that if we had more blocks, more marshmallows we might have been able to see just more results that ultimately could have been significant.

---

: )