\documentclass[11pt]{article}
\usepackage[margin=1in,bottom=.5in,includehead,includefoot]{geometry}
\usepackage{hyperref}
\usepackage{language}
\usepackage{alltt}
\usepackage{fancyhdr}
\pagestyle{fancy}
\fancyhf{}
%% Now begin customising things. See the fancyhdr docs for more info.
\chead{}
\lhead[\sf \thepage]{\sf \leftmark}
\rhead[\sf \leftmark]{\sf \thepage}
\lfoot{}
\cfoot{Statistical Sleuth in R: Chapter 1}
\rfoot{}
\newcounter{myenumi}
\newcommand{\saveenumi}{\setcounter{myenumi}{\value{enumi}}}
\newcommand{\reuseenumi}{\setcounter{enumi}{\value{myenumi}}}
\pagestyle{fancy}
\def\R{{\sf R}}
\def\Rstudio{{\sf RStudio}}
\def\RStudio{{\sf RStudio}}
\def\term#1{\textbf{#1}}
\def\tab#1{{\sf #1}}
\usepackage{relsize}
\newlength{\tempfmlength}
\newsavebox{\fmbox}
\newenvironment{fmpage}[1]
{
\medskip
\setlength{\tempfmlength}{#1}
\begin{lrbox}{\fmbox}
\begin{minipage}{#1}
\vspace*{.02\tempfmlength}
\hfill
\begin{minipage}{.95 \tempfmlength}}
{\end{minipage}\hfill
\vspace*{.015\tempfmlength}
\end{minipage}\end{lrbox}\fbox{\usebox{\fmbox}}
\medskip
}
\newenvironment{boxedText}[1][.98\textwidth]%
{%
\begin{center}
\begin{fmpage}{#1}
}%
{%
\end{fmpage}
\end{center}
}
\newenvironment{boxedTable}[2][tbp]%
{%
\begin{table}[#1]
\refstepcounter{table}
\begin{center}
\begin{fmpage}{.98\textwidth}
\begin{center}
\sf \large Box~\expandafter\thetable. #2
\end{center}
\medskip
}%
{%
\end{fmpage}
\end{center}
\end{table} % need to do something about exercises that follow boxedTable
}
\newcommand{\cran}{\href{http://www.R-project.org/}{CRAN}}
\title{The Statistical Sleuth in R: \\
Chapter 1}
\author{
Ruobing Zhang \and Kate Aloisio \and Nicholas J. Horton\thanks{Department of Mathematics, Amherst College, nhorton@amherst.edu}
}
\date{\today}
\begin{document}
\maketitle
\tableofcontents
%\parindent=0pt
<>=
opts_chunk$set(
dev="pdf",
fig.path="figures/",
fig.height=3,
fig.width=4,
out.width=".47\\textwidth",
fig.keep="high",
fig.show="hold",
fig.align="center",
prompt=TRUE, # show the prompts; but perhaps we should not do this
comment=NA # turn off commenting of ouput (but perhaps we should not do this either
)
@
<>=
print.pval = function(pval) {
threshold = 0.0001
return(ifelse(pval < threshold, paste("p<", sprintf("%.4f", threshold), sep=""),
ifelse(pval > 0.1, paste("p=",round(pval, 2), sep=""),
paste("p=", round(pval, 3), sep=""))))
}
@
<>=
require(mosaic)
require(Sleuth2)
trellis.par.set(theme=col.mosaic()) # get a better color scheme for lattice
set.seed(123)
# this allows for code formatting inline. Use \Sexpr{'function(x,y)'}, for exmaple.
knit_hooks$set(inline = function(x) {
if (is.numeric(x)) return(knitr:::format_sci(x, 'latex'))
x = as.character(x)
h = knitr:::hilight_source(x, 'latex', list(prompt=FALSE, size='normalsize'))
h = gsub("([_#$%&])", "\\\\\\1", h)
h = gsub('(["\'])', '\\1{}', h)
gsub('^\\\\begin\\{alltt\\}\\s*|\\\\end\\{alltt\\}\\s*$', '', h)
})
showOriginal=FALSE
showNew=TRUE
@
\section{Introduction}
This document is intended to help describe how to undertake analyses introduced as examples in the Second Edition of the \emph{Statistical Sleuth} (2002) by Fred Ramsey and Dan Schafer.
More information about the book can be found at \url{http://www.proaxis.com/~panorama/home.htm}. This
file as well as the associated \pkg{knitr} reproducible analysis source file can be found at
\url{http://www.amherst.edu/~nhorton/sleuth}.
This work leverages initiatives undertaken by Project MOSAIC (\url{http://www.mosaic-web.org}), an NSF-funded effort to improve the teaching of statistics, calculus, science and computing in the undergraduate curriculum. In particular, we utilize the
\pkg{mosaic} package, which was written to simplify the use of R for introductory statistics courses. A short summary of the R needed to teach introductory statistics can be found in the mosaic package vignette (\url{http://cran.r-project.org/web/packages/mosaic/vignettes/MinimalR.pdf}).
To use a package within R, it must be installed (one time), and loaded (each session). The package can be installed using the following command:
<>=
install.packages('mosaic') # note the quotation marks
@
Once this is installed, it can be loaded by running the command:
<>=
require(mosaic)
@
This
needs to be done once per session.
In addition the data files for the \emph{Sleuth} case studies can be accessed by installing the \pkg{Sleuth2} package.
<>=
install.packages('Sleuth2') # note the quotation marks
@
<>=
require(Sleuth2)
@
We also set some options to improve legibility of graphs and output.
<>=
trellis.par.set(theme=col.mosaic()) # get a better color scheme for lattice
options(digits=3)
@
The specific goal of this document is to demonstrate how to calculate the quantities described in Chapter 1: Drawing Statistical Conclusions using R.
\section{Motivation and Creativity}
For Case Study 1: Motivation and Creativity, the following questions are posed: Do grading systems promote creativity in students? Do ranking systems and incentive awards increase productivity among employees? Do rewards and praise stimulate children to learn? Do rewards and praise stimulate children to learn?
The data for Case Study 1 was collected by psychologist Teresa Amabile in an experiment concerning the effects of intrinsic and extrinsic motivation on creativity (page 2 of the \emph{Sleuth}).
\subsection{Statistical summary and graphical display}
We begin by reading the data and summarizing the variables.
<<>>=
summary(case0101)
@
A total of \Sexpr{nrow(case0101)} subjects with considerable experience in creative writing were randomly assigned to one of two treatment groups: \Sexpr{nrow(subset(case0101, Treatment=="Extrinsic"))} were placed into the ``extrinsic" treatment group and \Sexpr{nrow(subset(case0101, Treatment=="Intrinsic"))} were placed into the ``intrinsic" treatment group. As summarized in Display 1.1 (\emph{Sleuth}, page 2)
<>=
favstats(Score ~ Treatment, data=case0101)
histogram(~ Score | Treatment, data=case0101)
@
<<>>=
with(subset(case0101, Treatment=="Extrinsic"), stem(Score, scale=5))
with(subset(case0101, Treatment=="Intrinsic"), stem(Score, scale=5))
@
Similar output can be generated using the following code:
<>=
maggregate(Score ~ Treatment, FUN=stem, data=case0101)
@
The extrinsic group (n=\Sexpr{nrow(subset(case0101, Treatment=="Extrinsic"))}) has an average creativity score that is \Sexpr{round(diff(mean(Score ~ Treatment, data=case0101)), 1)} points less than the intrinsic group (n=\Sexpr{nrow(subset(case0101, Treatment=="Intrinsic"))}). The extrinsic group has relatively larger spread than the intrinsic group (sd=\Sexpr{round(sd(Score, data=subset(case0101, Treatment=="Extrinsic")),2)} for extrinsic group and sd=\Sexpr{round(sd(Score, data=subset(case0101, Treatment=="Intrinsic")), 2)} for intrinsic group). Both distributions are approximately normally distributed.
\subsection{Inferential procedures (two-sample t-test)}
<>=
t.test(Score ~ Treatment, alternative="two.sided", data=case0101)
@
The two-sample $t$-test shows strong evidence that a subject would receive a lower creativity score for a poem written after the extrinsic motivation questionnaire than for one written after the intrinsic motivation questionnaire. The two-sided $p$-value is \Sexpr{pval(t.test(Score~Treatment, alternative="two.sided", data=case0101), digits=4)}, which is small enough to reject the null hypothesis.
Thus, we can conclude that there is a difference between the population mean in extrinsic group and the population mean for the intrinsic group; the estimated difference between these two scores is \Sexpr{round(diff(mean(Score ~ Treatment, data=case0101)), 1)} points on the 0-40 point scale. A 95\% confidence interval for the decrease in score due to having extrinsic motivation rather than intrinsic motivation is between \Sexpr{round(t.test(Score~Treatment, alternative="two.sided", data=case0101)$conf.int[2], 2)} and \Sexpr{round(t.test(Score~Treatment, alternative="two.sided", data=case0101)$conf.int[1], 2)} points (\emph{Sleuth}, page 3).
<>=
summary(lm(Score ~ Treatment, data=case0101))
@
In the creativity study, the question that whether there is a treatment effect becomes a question about whether the parameter has a nonzero value. The value of the test statistic for the creativity scores is \Sexpr{round(diff(mean(Score ~ Treatment, data=case0101)), 2)}.
\subsection{Permutation test}
<>=
diffmeans = diff(mean(Score ~ Treatment, data=case0101))
diffmeans # observed difference
numsim = 1000 # set to a sufficient number
nulldist = do(numsim)*diff(mean(Score~shuffle(Treatment), data=case0101))
confint(nulldist)
# Display 1.8 Sleuth
histogram(~ Intrinsic, nint=50, data=nulldist, v=c(-4.14,4.14))
@
As described in the Sleuth on page 12, if the group assignment changes, we will get different results. First, the test statistics will be just as likely to be negative as positive. Second, the majority of values fall in the range from -3.0 to +3.0. Third, only few of the 1,000 randomization produced test statistics as large as 4.14. This last point indicates that 4.14 is a value corresponding to an unusually uneven randomization outcome, if the null hypothesis is correct.
\section{Gender Discrimination}
For Case Study 2: Gender Discrimination the following questions are posed: Did a bank discriminatorily pay higher starting salaries to men than to women? Display 1.3 (page 4 of the \emph{Sleuth}) displays the beginning salaries for male and female skilled entry level clerical employees hired between 1969 and 1977.
\subsection{Statistical summary and graphical display}
We begin by reading the data and summarizing the variables.
<>=
summary(case0102) # Display 1.3 Sleuth p4
@
<>=
favstats(Salary ~ Sex, data=case0102)
bwplot(Salary ~ Sex, data=case0102)
densityplot(~ Salary, groups=Sex, auto.key=TRUE, data=case0102)
@
The \Sexpr{nrow(subset(case0102, Sex=="MALE"))} men have an average starting salary that is \$\Sexpr{round(diff(mean(Salary ~ Sex, data=case0102)), 1)} more than the \Sexpr{nrow(subset(case0102, Sex=="Female"))} women (\$\Sexpr{round(mean(Salary, data=subset(case0102, Sex=="Male")),0)} vs \$\Sexpr{round(mean(Salary, data=subset(case0102, Sex=="Female")),0)}). Both distributions have similar spread (sd=\$\Sexpr{round(sd(Salary, data=subset(case0102, Sex=="Female")), 2)} for women and sd=\$\Sexpr{round(sd(Salary, data=subset(case0102, Sex=="Male")), 2)} for men) and distributions that are approximately normally distributed (see density plot). The key difference between the groups is the shift (as indicated by the parallel boxplots).
To show Display 1.13
<<>>=
x = rnorm(1000)
histogram(~ x) # Normal
x = rexp(1000)
histogram(~ x) # Long-tailed
x = runif(1000)
histogram(~ x) # Short-tailed
x = rchisq(1000, df=15)
histogram(~ x) # Skewed
@
\subsection{Inferential procedures (two-sample t-test)}
The $t$-test on page 4 of Sleuth can be replicated using the following commands (note that the equal-variance t-test is specified by {\tt var.equal=TRUE} which is not the default).
<>=
t.test(Salary ~ Sex, var.equal=TRUE, data=case0102)
@
\subsection{Permutation test}
We undertake a permutation test to assess whether the differences in the center of these samples that we are observing are due to chance, if the distributions are actually equivalent back in the populations of male and female possible clerical hires. We start by calculating our test statistic (the difference in means) for the observed data, then simulate from the null distribution (where the labels can be interchanged) and calculate our $p$-value.
<>=
obsdiff = diff(mean(Salary ~ Sex, data=case0102)); obsdiff
numsim = 1000
res = do(numsim) * diff(mean(Salary~shuffle(Sex), data=case0102))
densityplot(~ Male, data=res)
confint(res)
favstats(~ Male, data=res)
p = sum(abs(res$Male) >= abs(obsdiff))/numsim; p
@
Through the permutation test, we observe that the mean starting salary for males is estimated to be \$\Sexpr{as.numeric(round(confint(res)["lower"]+obsdiff, 2))} to \$\Sexpr{as.numeric(round(confint(res)["upper"]+obsdiff, 2))} larger than the mean starting salary for females (95\% confidence interval). We never see a permuted difference in means close to our observed value. Therefore, we reject the null hypothesis ($p<0.001$) and conclude that the salaries of the men are significantly higher than that of the women.
<<>>=
t.test(Salary ~ Sex, alternative="less", data=case0102)
@
The $p$-value ($<0.001$) from the two-sample t-test shows that the large difference between estimated salaries for males and females is unlikely to be due to chance.
\end{document}