Show the code
library(mosaic)
library(DT)
library(pander)
library(car)
library(tidyverse)
library(lattice)
library(dplyr)
library(ggplot2)
library(knitr)
fingerfootball <- read_csv("../../data/fingerfootballdata.csv")
Background
We decided to run data on finger football. The treatment factor is the tape used on the identical paper footballs. We made one with clear tape, duct tape, and masking tape. Our blocking factors were Me, Cali, Stephanie, and Shaylee. We wanted to see if the distance we could flick the football would be different across the tape factors. We measure the distance past the goal post in inches.
We randomized the treatment and block using the randomization tool.
Show the code
library(dplyr)
finfoot.aov <- na.omit(fingerfootball) %>%
select(inches, block, tape)Show the code
datatable(finfoot.aov, options=list(lengthMenu = c(4, 6, 12, 18)))Analysis
H_0: FingerFootball(\beta_j) = 0 \text{ for all tapes}(j)
H_a: FingerFootball(\beta_j) \ne 0 \text{ for some tapes}(j)
We hypothesize that there will be a difference in the 3 different finger footballs. We used 4 people as out blocking measure to flick the 3 differently taped finger footballs. We will use an \alpha = 0.5 in our tests to measure significance.
Mathematical Model
y_{ij} = \mu + \text{PersonBlock}(\alpha_i) + \text{TapeFingerFootball}\beta_j + \epsilon_{ij} \tag{1}
Alpha is our blocking factor (person), Beta is our treatment factor (finger football).
Significance level is
\alpha = 0.05
Show the code
finfoot.aov <- aov(inches ~ block + tape, data=na.omit(fingerfootball))
summary(finfoot.aov) Df Sum Sq Mean Sq F value Pr(>F)
block 3 21583 7194 24.648 0.000898 ***
tape 2 977 489 1.674 0.264442
Residuals 6 1751 292
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1The Anova test shows that the tapes are not significantly different from each other so I will run a few post hocs to see which groups are more significant to each other
Block (person) Numerical Summary
Show the code
fingerfootball %>%
group_by(block) %>%
summarise(
Average = mean(inches, na.rm = TRUE),
Min = min(inches, na.rm = TRUE),
Med = median(inches, na.rm = TRUE),
Max = max(inches, na.rm = TRUE),
StDev = sd(inches, na.rm = TRUE),
SampleSize = n()
) %>%
pander()| block | Average | Min | Med | Max | StDev | SampleSize |
|---|---|---|---|---|---|---|
| Cali (1) | 79.5 | 67 | 76.5 | 95 | 14.24 | 3 |
| Lexi (2) | 169.7 | 142.5 | 176.5 | 190 | 24.48 | 3 |
| Shaylee (4) | 79.33 | 56.75 | 89 | 92.25 | 19.63 | 3 |
| Stephanie (3) | 158 | 144 | 159.5 | 170.5 | 13.31 | 3 |
| NA | NA | Inf | NA | -Inf | NA | 6 |
From this numerical summary we can see that the smallest standard deviation was from Stephanie and her average was the 2nds highest. Her shots were more consistent across the 3 tapes.
Lexi had the highest average because she had the highest shot which was the duct tape football. She also had the greatest standard deviation, meaning less consistency.
Cali and Shaylee had the same average but difference of 5 inches in the standard deviation. Shaylee had the lowest distance.
These averages are clearly very different, at least comparing Cali and Shaylee to Lexi and Stephanie.
Factor (tape) Numerical Summary
Show the code
fingerfootball %>%
group_by(tape) %>%
summarise(
Average = mean(inches, na.rm = TRUE),
Min = min(inches, na.rm = TRUE),
Med = median(inches, na.rm = TRUE),
Max = max(inches, na.rm = TRUE),
StDev = sd(inches, na.rm = TRUE),
SampleSize = n()
) %>%
pander()| tape | Average | Min | Med | Max | StDev | SampleSize |
|---|---|---|---|---|---|---|
| clear | 120.1 | 56.75 | 123.5 | 176.5 | 62.28 | 4 |
| duct | 133.4 | 89 | 127.2 | 190 | 49.43 | 4 |
| masking | 111.4 | 67 | 117.4 | 144 | 38.16 | 4 |
| NA | NA | Inf | NA | -Inf | NA | 6 |
Over the 3 duct tapes with the 4 people shooting each one one time we see that the highest variability came from the clear with a 62.28 inch standard deviation.
The duct tape had the highest average with a stdev of 49.43, I believe this one the most.
Masking had the lowest average and the lowest standard deviation.
Our ANOVA says that the differences in these finger footballs are not significant. Maybe our post-hocs will tell us some variation.
Person Graph
Show the code
library(ggplot2)
library(dplyr)
ggplot(fingerfootball, aes(x=block, y=inches)) +
geom_boxplot(aes(fill = block)) +
theme_bw() +
scale_fill_manual(values = c("cadetblue1", "seagreen", "gray", "ivory")) +
labs(title = "Person's Shooting of Finger Football",
fill = "Person Blocking Factor",
x = "Person",
y = "Distance Football Was Shot (in)")
We can see from this graph the drastic appearance of difference between Cali and Shaylee (who appear almost the same on the low end of the graph) and Lexi and Stephanie who appear to have gone the distance and a;sp seem to be close enough that their averages seem similar.
Tape Graph
Show the code
library(ggplot2)
library(dplyr)
ggplot(fingerfootball, aes(x=tape, y=inches)) +
geom_boxplot(aes(fill = tape)) +
theme_bw() +
scale_fill_manual(values = c("pink", "skyblue2", "black")) +
labs(title = "Taped Finger Football Distance",
fill = "Football Type",
x = "Tape Football",
y = "Distance Football Was Shot (in)")
We can see the most variation in the clear one, least appears to be masking, and the averages all seem close together.
Show the code
library(car)
par(mfrow=c(1,3))
qqPlot(finfoot.aov$residuals, id=FALSE)
plot(finfoot.aov$fitted.values, finfoot.aov$residuals, pch=16)
plot(finfoot.aov$residuals, id=FALSE)
The 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, but it is close, I believe it is good enough to say 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.
Grouping Comparions
Show the code
library(emmeans)
ff.means <- emmeans(finfoot.aov, "tape", infer=c(TRUE,TRUE))
myContrasts <- contrast(ff.means, list(`ductvsothers`=c(1,-0.5, -0.5),
`clearvsothers` =c(-0.5, 1, -0.5),
`maskingvsothers` =c(-0.5, -0.5, 1)),adjust="scheffe")
myContrasts contrast estimate SE df t.ratio p.value
ductvsothers -2.34 10.5 6 -0.224 0.9753
clearvsothers 17.62 10.5 6 1.685 0.3129
maskingvsothers -15.28 10.5 6 -1.461 0.4015
Results are averaged over the levels of: block
P value adjustment: scheffe method with rank 2 This grouping comparisons shows that each is not significantly different than the other, with duct being the most not different. Let’s run some more post hocs for fun.
Tukey
Show the code
tukey.aov.finfoot <- TukeyHSD(finfoot.aov, "tape")
par(mar=c(4,8,3,1))
plot(tukey.aov.finfoot, las=1)
They all cross over the 0 line signifying that there is no difference in the tape that accounted for the distance after the goal line.
TAPE Fisher’s LSD
Show the code
ff.fish <- pairwise.t.test(fingerfootball$inches, fingerfootball$tape, "none")
ff.fish
Pairwise comparisons using t tests with pooled SD
data: fingerfootball$inches and fingerfootball$tape
clear duct
duct 0.72 -
masking 0.82 0.56
P value adjustment method: none Masking and duct are the most almost different but still not significant. I do want to take a closer look at the blocks since they were found to be significant in our aov although we don’t care about it.
BLOCK Fisher’s LSD
Show the code
ff.fish2 <- pairwise.t.test(fingerfootball$inches, fingerfootball$block, "none")
ff.fish2
Pairwise comparisons using t tests with pooled SD
data: fingerfootball$inches and fingerfootball$block
Cali (1) Lexi (2) Shaylee (4)
Lexi (2) 0.00033 - -
Shaylee (4) 0.99145 0.00033 -
Stephanie (3) 0.00082 0.46135 0.00081
P value adjustment method: none This shows that Cali was not different than
TAPE Scheffé
Show the code
library(agricolae)
scheffe.test(finfoot.aov, "tape", console=TRUE)
Study: finfoot.aov ~ "tape"
Scheffe Test for inches
Mean Square Error : 291.8837
tape, means
inches std r se Min Max Q25 Q50 Q75
clear 120.0625 62.27706 4 8.542302 56.75 176.5 71.5625 123.500 172.000
duct 133.3750 49.43240 4 8.542302 89.00 190.0 93.5000 127.250 167.125
masking 111.4375 38.15777 4 8.542302 67.00 144.0 85.9375 117.375 142.875
Alpha: 0.05 ; DF Error: 6
Critical Value of F: 5.143253
Minimum Significant Difference: 38.74573
Means with the same letter are not significantly different.
inches groups
duct 133.3750 a
clear 120.0625 a
masking 111.4375 aYep, these were not found to be significant, all are the same group.
BLOCK Scheffé
Show the code
library(agricolae)
scheffe.test(finfoot.aov, "block", console=TRUE)
Study: finfoot.aov ~ "block"
Scheffe Test for inches
Mean Square Error : 291.8837
block, means
inches std r se Min Max Q25 Q50 Q75
Cali (1) 79.50000 14.23903 3 9.8638 67.00 95.00 71.750 76.5 85.750
Lexi (2) 169.66667 24.47618 3 9.8638 142.50 190.00 159.500 176.5 183.250
Shaylee (4) 79.33333 19.62513 3 9.8638 56.75 92.25 72.875 89.0 90.625
Stephanie (3) 158.00000 13.31353 3 9.8638 144.00 170.50 151.750 159.5 165.000
Alpha: 0.05 ; DF Error: 6
Critical Value of F: 4.757063
Minimum Significant Difference: 52.69742
Means with the same letter are not significantly different.
inches groups
Lexi (2) 169.66667 a
Stephanie (3) 158.00000 a
Cali (1) 79.50000 b
Shaylee (4) 79.33333 bBoth Shaylee and Cali were just over 79 inches average between the 3 finger footballs but Stephanie and I were double or more than that. (We ran a few practice flicks) but this shows that Stephanie and I were sending those finger footballs whereas Shaylee and Cali struggled a little bit.
Interpretation
The results of the experiment were insignificant. I’m not totally surprised, if we were able to run replications I believe we would have found more significant data between the 3 footballs. I think the experiment was fun but this was probably not the right way to test this data. Although we really don’t care about the human performance in this it was still interesting to see if there was a competition who would reign supreme ;)
: )