Guess the Professors’ Ages!

f2017 <- read.delim("BIOS621 Fall 2017 fun survey #1 - guess the professors' ages (Responses) - Form Responses 1.tsv", sep="\t")
f2017 <- f2017[order(f2017[, 3]), -1]

par(cex=1.5)
plot(x=f2017[, 2], y=1:nrow(f2017), xlab="Age (years)", ylab="Guesser ID",
     main="Point estimates and CIs for Prof Waldron's age",
     xlim=c(min(f2017[, 2:6]), max(f2017[, 2:6])), ylim=c(0, nrow(f2017)+2))
segments(x0=f2017[, 5], x1=f2017[, 6], y0=1:nrow(f2017), y1=1:nrow(f2017), lw=3)  #95% CI

segments(x0=f2017[, 3], x1=f2017[, 4], y0=1:nrow(f2017)+0.1, y1=1:nrow(f2017)+0.1, col="red", lty=3, lw=3) #50% CI
legend("bottomright", legend=c("50% CI", "95% CI"), lty=c(3,1), col=c("red", "black"), lw=3, bty = "n")

CI95 <- t.test(f2017[, 2], conf.level=0.95)$conf.int
CI50 <- t.test(f2017[, 2], conf.level=0.5)$conf.int
segments(x0=CI95[1], x1=CI95[2], y0=nrow(f2017)+1.5, y1=nrow(f2017)+1.5, col="black", lw=5)
segments(x0=CI50[1], x1=CI50[2], y0=nrow(f2017)+1.7, y1=nrow(f2017)+1.7, col="red", lw=5, lty=1)

points(x=mean(f2017[, 2]), y=nrow(f2017)+1.5, col="blue", cex=2)
text(x=CI95[2], y=nrow(f2017)+1.7, pos=4, labels="Calculated from point estimates")

Ratio of 95% CI to 50% CI

What is the ratio of students’ 95% interval sizes to 50% interval sizes, compared to the “correct” ratio calculated from a t distribution?

par(cex=1.5)
hist((abs(f2017[, 6] - f2017[, 5]) / (f2017[, 4] - f2017[, 3])),
     breaks="FD", main="Ratio of 95% CI width / 50% CI width", xlab="Ratio")
abline(v=(qt(0.975, df=nrow(f2017)-1) / qt(0.75, df=nrow(f2017)-1)), col="red", lw=3)

legend("topright", lty=1, col="red", lw=3, legend="Correct ratio")

One-sample t-test against null hypothesis that I look my age:

colnames(f2017)[1] <- "devito"
colnames(f2017)[2] <- "waldron"
t.test(f2017$waldron, mu=(43 + 11/12))

    One Sample t-test

data:  f2017$waldron
t = -3.0342, df = 16, p-value = 0.007895
alternative hypothesis: true mean is not equal to 43.91667
95 percent confidence interval:
 37.16362 42.71873
sample estimates:
mean of x 
 39.94118 

Dependent (paired) t-test against null hypothesis that students guess Tony and I are the same age:

t.test(f2017$devito - f2017$waldron)

    One Sample t-test

data:  f2017$devito - f2017$waldron
t = 13.343, df = 16, p-value = 4.36e-10
alternative hypothesis: true mean is not equal to 0
95 percent confidence interval:
 16.03083 22.08682
sample estimates:
mean of x 
 19.05882 

Independent 2-sample t-test against null hypothesis that students guess Tony and I are the same age:

t.test(f2017$devito, f2017$waldron)

    Welch Two Sample t-test

data:  f2017$devito and f2017$waldron
t = 9.7612, df = 31.687, p-value = 4.524e-11
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
 15.08016 23.03749
sample estimates:
mean of x mean of y 
 59.00000  39.94118 

Comparing age guesses for Prof Waldron between 2015 and 2017

f2015 <- read.delim("PH751 Fall 2015 fun survey #1 - guess the professors' ages (Responses) - Form Responses 1.tsv", sep="\t", as.is=TRUE)
f2015 <- f2015[order(f2015[, 2]), -1]
colnames(f2015)[1] <- "waldron"
colnames(f2015)[ncol(f2015)] <- "devito"

par(cex=1.5)
boxplot(f2015$waldron, f2017$waldron, col="grey", varwidth=TRUE, names=c(2015, 2017), xlab="Year", ylab="Age")

Are the professors immortal?

Independent two-sample t-tests against the null hypothesis that Profs Waldron and Devito do not look any different in age between 2015 and 2017.

First for Professor Waldron:

t.test(f2015$waldron, f2017$waldron, var.equal = TRUE)

    Two Sample t-test

data:  f2015$waldron and f2017$waldron
t = -0.77266, df = 41, p-value = 0.4442
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
 -4.235111  1.891219
sample estimates:
mean of x mean of y 
 38.76923  39.94118 

t.test(f2015$devito, f2017$devito, var.equal = TRUE)

    Two Sample t-test

data:  f2015$devito and f2017$devito
t = -0.32941, df = 41, p-value = 0.7435
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
 -4.936742  3.552127
sample estimates:
mean of x mean of y 
 58.30769  59.00000 

And for Professor DeVito:

t.test(f2015$devito, f2017$devito, var.equal = TRUE)