Testing MythBusters' Yawn Contagiousness Data

O.K., here's a question about correlation coefficients in general.

Say you somehow repeated this same experiment 50 times, and 45 out of 50 times the percentages came out with a correlation coefficient of something below the .10 needed for a weak correlation, but at the same time in favor of the yawns being contagious. In other words the correlation coefficient of whether each experiment's results were majority or minority would show a high correlation. What would this say about yawn contagiousness then?

Or is this considered statistically impossible to actually happen, given the CC's obtained from the first experiment?

This article is being challenged on Slashdot.

You do NOT use descriptive statistics to study a sample, you need a completely different way of approaching things, namely, statistical analysis.

What you really need to do is Hypothesis testing (http://en.wikipedia.org/wiki/Statistical_hypothesis_testing), and test whether the hypothesis that more people yawn when seeded than when not seeded.

Your analysis is completely flawed, ask any statistician.

Well, it is flawed, but not totally wrong. I coded the data set that was used on the web page and ran it through a chi-square/McNemar+Risk Estimate test (appropriate tests for dichotomous treatment variables + dichotomous outcome variables). No significant difference alpha=.744. But shame on you for using a straight up correlation. --chris

I received a number of emails concerning the statistical method I used (Pearson's correlation coefficient), which provided some insight but does not sufficiently address the issue of causation in the results. Personally, I don't understand how there can be so obviously not a correlation between two variables and there still be a chance there is causation involved, but with the aim of statistical appropriateness, I have included a number of alternative statistical methods below.

Association Test

An association test such as Fisher's Exact Test is appropriate. This method is specifically for determining any non-random association between two categorical (discrete) variables - which is exactly what we have in this instance. Its use, then, removes any issues there may have been in the Pearson analysis having to do with the data set not being continuous.

For those interested, the calculations are described in the link above. The results are easy to come by, however, using online tools such as this calculator at Matforsk.com. Inserting the MythBuster's data results in the following:

TABLE = [ 4 , 10 , 12 , 24 ]
Left   : p-value = 0.5127817757319189
Right  : p-value = 0.7416878304307283
2-Tail : p-value = 1

This corresponds to there being 4 non-seeded subjects who yawned, 10 seeded who yawned, 12 non-seeded to didn't yawn, and 24 seeded who didn't yawn. The resulting p-values are all well above the commonly accepted limit of .05 for significance.

Confidence Interval for the Difference in Rates

This method was recommended via email by Max Kuhn, a "Ph.D. statistician who works in industry." Max provided a very thorough and helpful analysis of the data, which I've included below:

          p1 <- 10/34
          p2 <- 4/16
          n1 <- 34
          n2 <- 16
          q1 <- 1-p1
          q2 <- 1-p2
          p1 - p2
          [1] 0.04411765
          
          sqrt((p1*q1/n1) + (p2*q2/n2))
          [1] 0.1335103
          
          p1 - p2 + (qnorm(0.05) * sqrt((p1*q1/n1) + (p2*q2/n2)))
          [1] -0.1754872

          testStat <- function(index, data)
          {
             bootSample <- data[index,]
             p1 <- mean(bootSample[bootSample$group == "withSeed", "outcome"] == "yawn")
             p2 <- mean(bootSample[bootSample$group == "noSeed", "outcome"] == "yawn")
             p1 - p2
          }
 
          noSeed <- rep(c("yawn", "none"), times = c(4, 12))
          withSeed <- rep(c("yawn", "none"), times = c(10, 24))
 
          mythBusters <- data.frame(
             outcome = factor(c(noSeed, withSeed), levels = c("yawn", "none")),
             group = factor(rep(c("noSeed", "withSeed"), times = c(16, 34))))
 
          testStat(1:50, mythBusters)
 
          library(bootstrap)
          set.seed(1)
          results <- boott(1:50, theta = testStat, nboott = 5000, data = mythBusters, perc = 0.05)

Linear Regression to Show Sample Size Needed for Significance

I received yet another very friendly and helpful email from Zinj Boisei who pointed out I was too hasty in dismissing the use of an increased sample size. By using a more appropriate analysis, linear regression in this case, Zinj confirmed there was little significance at the sample size of 50 - and even went on to find out large a sample size of the same makeup would need to be for the results to be significant:

Conclusion Addendum

While the statistical method used in the article was sufficient to show the yawn seed was responsible for a negligible amount of the variance, methods such as association tests, confidence interval analysis and linear regression provide more appropriate insight into the causation involved. In this case, all tests lend credence to the original conclusion: the results of the MythBuster's yawn experiment did not support their conclusion.