% Options for packages loaded elsewhere
\PassOptionsToPackage{unicode}{hyperref}
\PassOptionsToPackage{hyphens}{url}
%
\documentclass[
]{article}
\usepackage{amsmath,amssymb}
\usepackage{lmodern}
\usepackage{iftex}
\ifPDFTeX
  \usepackage[T1]{fontenc}
  \usepackage[utf8]{inputenc}
  \usepackage{textcomp} % provide euro and other symbols
\else % if luatex or xetex
  \usepackage{unicode-math}
  \defaultfontfeatures{Scale=MatchLowercase}
  \defaultfontfeatures[\rmfamily]{Ligatures=TeX,Scale=1}
\fi
% Use upquote if available, for straight quotes in verbatim environments
\IfFileExists{upquote.sty}{\usepackage{upquote}}{}
\IfFileExists{microtype.sty}{% use microtype if available
  \usepackage[]{microtype}
  \UseMicrotypeSet[protrusion]{basicmath} % disable protrusion for tt fonts
}{}
\makeatletter
\@ifundefined{KOMAClassName}{% if non-KOMA class
  \IfFileExists{parskip.sty}{%
    \usepackage{parskip}
  }{% else
    \setlength{\parindent}{0pt}
    \setlength{\parskip}{6pt plus 2pt minus 1pt}}
}{% if KOMA class
  \KOMAoptions{parskip=half}}
\makeatother
\usepackage{xcolor}
\usepackage[margin=1in]{geometry}
\usepackage{color}
\usepackage{fancyvrb}
\newcommand{\VerbBar}{|}
\newcommand{\VERB}{\Verb[commandchars=\\\{\}]}
\DefineVerbatimEnvironment{Highlighting}{Verbatim}{commandchars=\\\{\}}
% Add ',fontsize=\small' for more characters per line
\usepackage{framed}
\definecolor{shadecolor}{RGB}{248,248,248}
\newenvironment{Shaded}{\begin{snugshade}}{\end{snugshade}}
\newcommand{\AlertTok}[1]{\textcolor[rgb]{0.94,0.16,0.16}{#1}}
\newcommand{\AnnotationTok}[1]{\textcolor[rgb]{0.56,0.35,0.01}{\textbf{\textit{#1}}}}
\newcommand{\AttributeTok}[1]{\textcolor[rgb]{0.77,0.63,0.00}{#1}}
\newcommand{\BaseNTok}[1]{\textcolor[rgb]{0.00,0.00,0.81}{#1}}
\newcommand{\BuiltInTok}[1]{#1}
\newcommand{\CharTok}[1]{\textcolor[rgb]{0.31,0.60,0.02}{#1}}
\newcommand{\CommentTok}[1]{\textcolor[rgb]{0.56,0.35,0.01}{\textit{#1}}}
\newcommand{\CommentVarTok}[1]{\textcolor[rgb]{0.56,0.35,0.01}{\textbf{\textit{#1}}}}
\newcommand{\ConstantTok}[1]{\textcolor[rgb]{0.00,0.00,0.00}{#1}}
\newcommand{\ControlFlowTok}[1]{\textcolor[rgb]{0.13,0.29,0.53}{\textbf{#1}}}
\newcommand{\DataTypeTok}[1]{\textcolor[rgb]{0.13,0.29,0.53}{#1}}
\newcommand{\DecValTok}[1]{\textcolor[rgb]{0.00,0.00,0.81}{#1}}
\newcommand{\DocumentationTok}[1]{\textcolor[rgb]{0.56,0.35,0.01}{\textbf{\textit{#1}}}}
\newcommand{\ErrorTok}[1]{\textcolor[rgb]{0.64,0.00,0.00}{\textbf{#1}}}
\newcommand{\ExtensionTok}[1]{#1}
\newcommand{\FloatTok}[1]{\textcolor[rgb]{0.00,0.00,0.81}{#1}}
\newcommand{\FunctionTok}[1]{\textcolor[rgb]{0.00,0.00,0.00}{#1}}
\newcommand{\ImportTok}[1]{#1}
\newcommand{\InformationTok}[1]{\textcolor[rgb]{0.56,0.35,0.01}{\textbf{\textit{#1}}}}
\newcommand{\KeywordTok}[1]{\textcolor[rgb]{0.13,0.29,0.53}{\textbf{#1}}}
\newcommand{\NormalTok}[1]{#1}
\newcommand{\OperatorTok}[1]{\textcolor[rgb]{0.81,0.36,0.00}{\textbf{#1}}}
\newcommand{\OtherTok}[1]{\textcolor[rgb]{0.56,0.35,0.01}{#1}}
\newcommand{\PreprocessorTok}[1]{\textcolor[rgb]{0.56,0.35,0.01}{\textit{#1}}}
\newcommand{\RegionMarkerTok}[1]{#1}
\newcommand{\SpecialCharTok}[1]{\textcolor[rgb]{0.00,0.00,0.00}{#1}}
\newcommand{\SpecialStringTok}[1]{\textcolor[rgb]{0.31,0.60,0.02}{#1}}
\newcommand{\StringTok}[1]{\textcolor[rgb]{0.31,0.60,0.02}{#1}}
\newcommand{\VariableTok}[1]{\textcolor[rgb]{0.00,0.00,0.00}{#1}}
\newcommand{\VerbatimStringTok}[1]{\textcolor[rgb]{0.31,0.60,0.02}{#1}}
\newcommand{\WarningTok}[1]{\textcolor[rgb]{0.56,0.35,0.01}{\textbf{\textit{#1}}}}
\usepackage{graphicx}
\makeatletter
\def\maxwidth{\ifdim\Gin@nat@width>\linewidth\linewidth\else\Gin@nat@width\fi}
\def\maxheight{\ifdim\Gin@nat@height>\textheight\textheight\else\Gin@nat@height\fi}
\makeatother
% Scale images if necessary, so that they will not overflow the page
% margins by default, and it is still possible to overwrite the defaults
% using explicit options in \includegraphics[width, height, ...]{}
\setkeys{Gin}{width=\maxwidth,height=\maxheight,keepaspectratio}
% Set default figure placement to htbp
\makeatletter
\def\fps@figure{htbp}
\makeatother
\setlength{\emergencystretch}{3em} % prevent overfull lines
\providecommand{\tightlist}{%
  \setlength{\itemsep}{0pt}\setlength{\parskip}{0pt}}
\setcounter{secnumdepth}{-\maxdimen} % remove section numbering
\usepackage{amsmath}
\usepackage{amsthm}
\DeclareMathOperator{\Cov}{Cov}
\DeclareMathOperator{\Corr}{Corr}
\DeclareMathOperator{\Var}{Var}
\DeclareMathOperator{\upmodels}{\perp \!\!\! \perp}
\ifLuaTeX
  \usepackage{selnolig}  % disable illegal ligatures
\fi
\IfFileExists{bookmark.sty}{\usepackage{bookmark}}{\usepackage{hyperref}}
\IfFileExists{xurl.sty}{\usepackage{xurl}}{} % add URL line breaks if available
\urlstyle{same} % disable monospaced font for URLs
\hypersetup{
  pdftitle={Homework 07 Solutions},
  hidelinks,
  pdfcreator={LaTeX via pandoc}}

\title{Homework 07 Solutions}
\author{}
\date{\vspace{-2.5em}2022-11-04}

\begin{document}
\maketitle

\begin{Shaded}
\begin{Highlighting}[]
\FunctionTok{library}\NormalTok{(lme4)}
\FunctionTok{library}\NormalTok{(ggplot2)}
\end{Highlighting}
\end{Shaded}

\hypertarget{problem-1.}{%
\section{Problem 1.}\label{problem-1.}}

\hypertarget{problem-1a.}{%
\subsection{Problem 1a.}\label{problem-1a.}}

On July 23, 2006, the Houston Chronicle published an article entitled
``Reading: First-grade standard too tough for many''. The article
claimed in part that ``more students (across Texas) are having to repeat
first grade. Experts attribute the increase partially to an increase in
poverty.'' The data in the file \texttt{houston.txt} is derived from
this study. Here is a quick look:

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{houston }\OtherTok{\textless{}{-}} \FunctionTok{read.table}\NormalTok{(}\StringTok{"houston.txt"}\NormalTok{,}\AttributeTok{header=}\NormalTok{T)}

\FunctionTok{attach}\NormalTok{(houston)}
\NormalTok{houston}\SpecialCharTok{$}\NormalTok{y }\OtherTok{\textless{}{-}}\NormalTok{ Pct.Repeating}\FloatTok{.1}\NormalTok{st.Grade}
\NormalTok{houston}\SpecialCharTok{$}\NormalTok{x }\OtherTok{\textless{}{-}}\NormalTok{ Pct.Low.income.students}
\NormalTok{houston}\SpecialCharTok{$}\NormalTok{Year }\OtherTok{\textless{}{-}} \FunctionTok{factor}\NormalTok{(Year)}
\FunctionTok{detach}\NormalTok{()}

\FunctionTok{summary}\NormalTok{(houston)}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
##    District         Pct.Repeating.1st.Grade Pct.Low.income.students   Year   
##  Length:122         Min.   : 0.000          Min.   : 3.20           1994:61  
##  Class :character   1st Qu.: 2.825          1st Qu.:27.15           2004:61  
##  Mode  :character   Median : 5.050          Median :41.35                    
##                     Mean   : 5.993          Mean   :41.88                    
##                     3rd Qu.: 8.475          3rd Qu.:53.02                    
##                     Max.   :17.800          Max.   :98.10                    
##     County                y                x        
##  Length:122         Min.   : 0.000   Min.   : 3.20  
##  Class :character   1st Qu.: 2.825   1st Qu.:27.15  
##  Mode  :character   Median : 5.050   Median :41.35  
##                     Mean   : 5.993   Mean   :41.88  
##                     3rd Qu.: 8.475   3rd Qu.:53.02  
##                     Max.   :17.800   Max.   :98.10
\end{verbatim}

\textit{Here, I use ordinary linear models to this data with}
\texttt{lm()}
\textit{to answer each question.  There is code below to make plots, but they are not very informative, so I commented them out to save space.  Basically the residuals for each of the models are a bit right-skewed, but not enough to motivate me to make a transformation and complicate interpretation of the models.}

\hypertarget{problem-1a.-1}{%
\subsection{Problem 1a.}\label{problem-1a.-1}}

Is an increase in the percentage of low income students associated with
an increase in the percentage of students repeating first grade?

\textit{We just have to regress} \texttt{y} \textit{on} \texttt{x}
\textit{and see if the coefficient on} \texttt{x}
\textit{is significantly different from zero.}

\begin{Shaded}
\begin{Highlighting}[]
\FunctionTok{summary}\NormalTok{(lm}\FloatTok{.1} \OtherTok{\textless{}{-}} \FunctionTok{lm}\NormalTok{(y }\SpecialCharTok{\textasciitilde{}}\NormalTok{ x, }\AttributeTok{data=}\NormalTok{houston))}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
## 
## Call:
## lm(formula = y ~ x, data = houston)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -7.6458 -2.5077 -0.5413  1.7291 11.1484 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  2.99929    0.85959   3.489 0.000678 ***
## x            0.07147    0.01870   3.823 0.000211 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.918 on 120 degrees of freedom
## Multiple R-squared:  0.1086, Adjusted R-squared:  0.1011 
## F-statistic: 14.61 on 1 and 120 DF,  p-value: 0.0002106
\end{verbatim}

\begin{Shaded}
\begin{Highlighting}[]
\DocumentationTok{\#\# par(mfrow=c(2,2))}
\DocumentationTok{\#\# plot(lm.1)}
\end{Highlighting}
\end{Shaded}

\textit{From the summary we see that the coefficient on $x$ is significantly different from zero, which suggests that there is an association between the percentage of low income students and the percentage of students repeating first grade.}

\hypertarget{problem-1b.}{%
\subsection{Problem 1b.}\label{problem-1b.}}

Has there been an increase in the percentage of students repeating first
grade between 1994--1995 and 2004---2005?

\textit{Similar to part (a), we regress on the categorical variable}
\texttt{Year} \textit{and check for a significant coefficient.}

\begin{Shaded}
\begin{Highlighting}[]
\FunctionTok{summary}\NormalTok{(lm}\FloatTok{.2} \OtherTok{\textless{}{-}} \FunctionTok{lm}\NormalTok{(y }\SpecialCharTok{\textasciitilde{}}\NormalTok{ Year, }\AttributeTok{data=}\NormalTok{houston))}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
## 
## Call:
## lm(formula = y ~ Year, data = houston)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -6.608 -3.108 -0.377  2.390 11.823 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   5.3770     0.5253  10.236   <2e-16 ***
## Year2004      1.2311     0.7429   1.657      0.1    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4.103 on 120 degrees of freedom
## Multiple R-squared:  0.02238,    Adjusted R-squared:  0.01423 
## F-statistic: 2.747 on 1 and 120 DF,  p-value: 0.1001
\end{verbatim}

\begin{Shaded}
\begin{Highlighting}[]
\DocumentationTok{\#\# par(mfrow=c(2,2))}
\DocumentationTok{\#\# plot(lm.2)}
\end{Highlighting}
\end{Shaded}

\textit{The coefficient on the} \texttt{Year2004}
\textit{dummy variable is not significantly different from zero, so it does not look like there is a real increase in the percentage of students repeating first grade
between 1994--1995 and 2004–-2005.}

\hypertarget{problem-1c.}{%
\subsection{Problem 1c.}\label{problem-1c.}}

Is the association (if any) between the percentage of students repeating
first grade and the percentage of low-income students different between
1994--1995 and 2004--2005?

\textit{The association is quantified by the slope of the regression line between}
\texttt{y} \textit{and}
\texttt{x}\textit{.  To see if the association changes, we should see if there is a significant difference in the slopes of the regression lines for the two years. We can do this by putting an interaction between}
\texttt{Year} \textit{and} \texttt{x}
\textit{in the model, and checking to see if the coefficient on the interaction is significantly different from zero (since that coefficient will be the difference in slopes between the two years.)}

\begin{Shaded}
\begin{Highlighting}[]
\FunctionTok{summary}\NormalTok{(lm}\FloatTok{.3} \OtherTok{\textless{}{-}} \FunctionTok{lm}\NormalTok{(y }\SpecialCharTok{\textasciitilde{}}\NormalTok{ x}\SpecialCharTok{*}\NormalTok{Year, }\AttributeTok{data=}\NormalTok{houston))}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
## 
## Call:
## lm(formula = y ~ x * Year, data = houston)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -7.7671 -2.4825 -0.4808  1.7034 11.0178 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)  
## (Intercept)  3.27778    1.25429   2.613   0.0101 *
## x            0.05797    0.03171   1.828   0.0700 .
## Year2004    -0.19035    1.80545  -0.105   0.9162  
## x:Year2004   0.01607    0.04048   0.397   0.6921  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.942 on 118 degrees of freedom
## Multiple R-squared:  0.1126, Adjusted R-squared:  0.09006 
## F-statistic: 4.992 on 3 and 118 DF,  p-value: 0.002698
\end{verbatim}

\begin{Shaded}
\begin{Highlighting}[]
\DocumentationTok{\#\# par(mfrow=c(2,2))}
\DocumentationTok{\#\# plot(lm.3)}
\end{Highlighting}
\end{Shaded}

\textit{We can see from the summary that the coefficient for the interaction is not significantly different from zero, so the slope doesn't change significantly from 1994 to 2004.  Actually the main effect for}
\texttt{Year2004}
\textit{is not significant either, so it doesn't even look like the intercept changes between years.}

\hypertarget{problem-2}{%
\section{Problem 2}\label{problem-2}}

In the data for problem 1, it is plausible that there would be some
variation among Counties in percentage of students repeating first
grade. We will use a multilevel model to explore the variation across
counties, \textit{using the 2004 data \underline{\textbf{only}}}.

\hypertarget{problem-2a.}{%
\subsection{Problem 2a.}\label{problem-2a.}}

Extract from the file \texttt{houston.txt} a data frame containing just
the data from 2004. Report the following for the extracted data frame:

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{houston04 }\OtherTok{\textless{}{-}}\NormalTok{ houston[houston}\SpecialCharTok{$}\NormalTok{Year}\SpecialCharTok{==}\DecValTok{2004}\NormalTok{,]}

\FunctionTok{attach}\NormalTok{(houston04)}
\end{Highlighting}
\end{Shaded}

\begin{itemize}
\tightlist
\item
  Number of groups, \(J\). (Each County is a group.)
\end{itemize}

\begin{Shaded}
\begin{Highlighting}[]
\FunctionTok{cat}\NormalTok{(}\StringTok{"J ="}\NormalTok{,J }\OtherTok{\textless{}{-}} \FunctionTok{length}\NormalTok{(}\FunctionTok{unique}\NormalTok{(County)))}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
## J = 8
\end{verbatim}

\begin{itemize}
\tightlist
\item
  For each group \(j\), number of observations \(n_j\).
\end{itemize}

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{nj }\OtherTok{\textless{}{-}} \FunctionTok{c}\NormalTok{(}\FunctionTok{table}\NormalTok{(County))}
\FunctionTok{cat}\NormalTok{(}\StringTok{"nj =}\SpecialCharTok{\textbackslash{}n}\StringTok{"}\NormalTok{)}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
## nj =
\end{verbatim}

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{nj}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
##   Brazoria   Chambers   FortBend  Galveston     Harris    Liberty Montgomery 
##          8          3          5          9         20          7          6 
##     Waller 
##          3
\end{verbatim}

\begin{itemize}
\tightlist
\item
  Total number of observations, \(n\). (Each District is an
  observation.)
\end{itemize}

\begin{Shaded}
\begin{Highlighting}[]
\FunctionTok{cat}\NormalTok{(}\StringTok{"n ="}\NormalTok{,n }\OtherTok{\textless{}{-}} \FunctionTok{sum}\NormalTok{(nj))}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
## n = 61
\end{verbatim}

\begin{Shaded}
\begin{Highlighting}[]
\FunctionTok{detach}\NormalTok{()}
\end{Highlighting}
\end{Shaded}

Use only data from this data frame in the rest of this problem.

\hypertarget{problem-2b.}{%
\subsection{Problem 2b.}\label{problem-2b.}}

Use \texttt{lmer()} from \texttt{library(lme4)} to fit the multilevel
model \begin{equation}
        \left.
        \begin{array}{rcl}
    y_i & = & \alpha_{j[i]} + \epsilon_i, 
        ~\epsilon_i \stackrel{iid}{\sim} N(0,\sigma^2)\\
            \alpha_j & = & \beta_0 + \eta_j, 
        ~\eta_j \stackrel{iid}{\sim} N(0,\tau^2)
        \end{array}
        \right\}
\end{equation} where \(i\) indexes Districts, \(j\) indexes Counties,
and \(y_i\) is the percentage of students repeating first grade in the
\(i^{th}\) District. Provide: a \texttt{summary()} of your model, and
report the following quantities from your summary:

\begin{Shaded}
\begin{Highlighting}[]
\FunctionTok{summary}\NormalTok{(lmer}\FloatTok{.1} \OtherTok{\textless{}{-}} \FunctionTok{lmer}\NormalTok{(y }\SpecialCharTok{\textasciitilde{}} \DecValTok{1} \SpecialCharTok{+}\NormalTok{ (}\DecValTok{1}\SpecialCharTok{|}\NormalTok{County), }\AttributeTok{data=}\NormalTok{houston04))}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
## Linear mixed model fit by REML ['lmerMod']
## Formula: y ~ 1 + (1 | County)
##    Data: houston04
## 
## REML criterion at convergence: 335.8
## 
## Scaled residuals: 
##      Min       1Q   Median       3Q      Max 
## -1.68743 -0.69475 -0.07737  0.48252  2.72625 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  County   (Intercept)  1.028   1.014   
##  Residual             14.068   3.751   
## Number of obs: 61, groups:  County, 8
## 
## Fixed effects:
##             Estimate Std. Error t value
## (Intercept)   6.7283     0.6252   10.76
\end{verbatim}

\textit{We can read these values off the summary:}

\begin{itemize}
\item
  \(\hat\sigma^2=14.068\);
\item
  \(\hat\tau^2=1.028\);
\item
  \(\hat\beta_0=6.7283\).
\end{itemize}

\hypertarget{problem-2c.}{%
\subsection{Problem 2c.}\label{problem-2c.}}

Use \texttt{library(ggplot2)} (or another R package if you prefer) to
make a facet plot of \(y\)=Pct.Repeating.1st.Grade vs
\(x\)=Pct.Low.income.students, with a different facet for each County.
Add to the facets

\begin{itemize}
\tightlist
\item
  A black horizontal line indicating the average of \(y\) in the whole
  data set (ignoring groups)
\item
  A red horizontal line indicating the average of \(y\) in each County
\item
  A green horizontal line indicating the ``random effect'' estimates
  \(\hat\alpha_j = \hat\eta_j + \hat\beta_0\) for each County, as
  indicated in equation (1).
\end{itemize}

and submit your plot. (Does your plot illustrate the ``shrinkage''
phenomenon of MLM's?)

\textit{Here's the code to make the plot...}

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{params }\OtherTok{\textless{}{-}} \FunctionTok{with}\NormalTok{(houston04,}
                 \FunctionTok{data.frame}\NormalTok{(}
                    \FunctionTok{sort}\NormalTok{(}\FunctionTok{unique}\NormalTok{(County)),}
                    \FunctionTok{rep}\NormalTok{(}\FunctionTok{mean}\NormalTok{(y),J),}
                    \DecValTok{0}\NormalTok{,}
                    \FunctionTok{sapply}\NormalTok{(}\FunctionTok{split}\NormalTok{(y,County),mean),}
                    \DecValTok{0}\NormalTok{,}
                    \FunctionTok{coef}\NormalTok{(lmer}\FloatTok{.1}\NormalTok{)}\SpecialCharTok{$}\NormalTok{County[,}\DecValTok{1}\NormalTok{], }\DocumentationTok{\#\# gives \textbackslash{}beta\_0 + \textbackslash{}eta\_j}
                    \DecValTok{0}
\NormalTok{                 )}
\NormalTok{          )}
\FunctionTok{names}\NormalTok{(params) }\OtherTok{=} \FunctionTok{c}\NormalTok{(}\StringTok{"County"}\NormalTok{,}\StringTok{"int0"}\NormalTok{,}\StringTok{"slo0"}\NormalTok{,}\StringTok{"int1"}\NormalTok{,}\StringTok{"slo1"}\NormalTok{,}\StringTok{"int2"}\NormalTok{,}\StringTok{"slo2"}\NormalTok{)}

\NormalTok{g }\OtherTok{\textless{}{-}} \FunctionTok{ggplot}\NormalTok{(houston04,}\FunctionTok{aes}\NormalTok{(}\AttributeTok{x=}\NormalTok{x,}\AttributeTok{y=}\NormalTok{y)) }\SpecialCharTok{+} 
  \FunctionTok{facet\_wrap}\NormalTok{( }\SpecialCharTok{\textasciitilde{}}\NormalTok{ County) }\SpecialCharTok{+} 
  \FunctionTok{geom\_point}\NormalTok{()}

\NormalTok{g }\SpecialCharTok{+} \FunctionTok{geom\_abline}\NormalTok{(}\AttributeTok{data=}\NormalTok{params,}\FunctionTok{aes}\NormalTok{(}\AttributeTok{intercept=}\NormalTok{int0,}\AttributeTok{slope=}\NormalTok{slo0),}\AttributeTok{color=}\StringTok{"black"}\NormalTok{) }\SpecialCharTok{+}
  \FunctionTok{geom\_abline}\NormalTok{(}\AttributeTok{data=}\NormalTok{params,}\FunctionTok{aes}\NormalTok{(}\AttributeTok{intercept=}\NormalTok{int1,}\AttributeTok{slope=}\NormalTok{slo1),}\AttributeTok{color=}\StringTok{"red"}\NormalTok{) }\SpecialCharTok{+}
  \FunctionTok{geom\_abline}\NormalTok{(}\AttributeTok{data=}\NormalTok{params,}\FunctionTok{aes}\NormalTok{(}\AttributeTok{intercept=}\NormalTok{int2,}\AttributeTok{slope=}\NormalTok{slo2),}\AttributeTok{color=}\StringTok{"green"}\NormalTok{) }
\end{Highlighting}
\end{Shaded}

\includegraphics{hw07-solutions_files/figure-latex/unnamed-chunk-11-1.pdf}

\textit{The facet plot does indeed show the "shrinkage" phenomenon: The fitted county means from the MLM (the green lines) are between the grand mean (the black lines) that would be estimated from}
\texttt{lm(y\ \textasciitilde{}\ 1)}
\textit{and the raw county means (the red lines) that would be estimated from}
\texttt{lm(y\ \textasciitilde{}\ County)}.

\hypertarget{problem-2d.}{%
\subsection{Problem 2d.}\label{problem-2d.}}

Fit the ordinary linear model \texttt{lm(y\ \textasciitilde{}\ County)},
where the coefficients on the County dummy variables are constrained to
sum to zero. Provide the \texttt{summary()} of your model, and decide
from the output whether we need to keep the \texttt{County} variable in
the model (this is also an informal way to decide whether to keep the
multilevel model that you fitted in part (a)).

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{cty }\OtherTok{\textless{}{-}} \FunctionTok{as.factor}\NormalTok{(houston04}\SpecialCharTok{$}\NormalTok{County)}
\FunctionTok{contrasts}\NormalTok{(cty) }\OtherTok{\textless{}{-}} \FunctionTok{contr.sum}\NormalTok{(J)}

\FunctionTok{summary}\NormalTok{(lm.}\FloatTok{1.04} \OtherTok{\textless{}{-}} \FunctionTok{lm}\NormalTok{(y }\SpecialCharTok{\textasciitilde{}}\NormalTok{ cty,}\AttributeTok{data=}\NormalTok{houston04))}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
## 
## Call:
## lm(formula = y ~ cty, data = houston04)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -5.722 -2.529 -0.260  1.875  8.571 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  6.66656    0.56261  11.849   <2e-16 ***
## cty1        -0.04156    1.27094  -0.033   0.9740    
## cty2        -0.09989    1.94419  -0.051   0.9592    
## cty3         1.99344    1.54743   1.288   0.2033    
## cty4        -0.94434    1.21284  -0.779   0.4397    
## cty5        -0.98656    0.91435  -1.079   0.2855    
## cty6         2.56201    1.34195   1.909   0.0617 .  
## cty7         1.61678    1.43116   1.130   0.2637    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 3.722 on 53 degrees of freedom
## Multiple R-squared:  0.1782, Adjusted R-squared:  0.06971 
## F-statistic: 1.642 on 7 and 53 DF,  p-value: 0.1439
\end{verbatim}

\textit{Only one of the} \texttt{County}
\textit{coefficients is even close to significantly different from zero.}

\textit{The F statistic, 1.642 on 7 and 53 df, tests the fitted model against the intercept-only model}
\texttt{lm(y\ \textasciitilde{}\ 1)}
\textit{The p-value is  0.1439, which suggests there is not enough evidence in the data to reject the intercept-only model and keep}
\texttt{County} \textit{in the model.}

\textit{We would get exactly the same result comparing the models directly with the}
\texttt{anova()} \textit{function:}

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{lm.}\FloatTok{0.04} \OtherTok{\textless{}{-}} \FunctionTok{lm}\NormalTok{(y }\SpecialCharTok{\textasciitilde{}} \DecValTok{1}\NormalTok{, }\AttributeTok{data=}\NormalTok{houston04)}
\FunctionTok{anova}\NormalTok{(lm.}\FloatTok{0.04}\NormalTok{,lm.}\FloatTok{1.04}\NormalTok{)}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
## Analysis of Variance Table
## 
## Model 1: y ~ 1
## Model 2: y ~ cty
##   Res.Df    RSS Df Sum of Sq      F Pr(>F)
## 1     60 893.49                           
## 2     53 734.23  7    159.25 1.6423 0.1439
\end{verbatim}

\hypertarget{problem-3.}{%
\section{Problem 3.}\label{problem-3.}}

\it

In the multilevel model \((*)\) for data \(y_i\), \(i=1,\ldots, n\),
arranged into \(J\) groups, \(j=1,\ldots, J\), where each group \(j\)
has \(n_j\) observations, \[
        \left.
        \begin{array}{rcl}
    y_i & = & \alpha_{j[i]} + \epsilon_i, 
        ~\epsilon_i \stackrel{iid}{\sim} N(0,\sigma^2)\\
            \alpha_j & = & \beta_0 + \eta_j, 
        ~\eta_j \stackrel{iid}{\sim} N(0,\tau^2)
        \end{array}
        \right\}~,
        \tag{*}
\] we also assume that the \(\epsilon\)'s and \(\eta\)'s are independent
of each other.

\hypertarget{problem-3a.}{%
\subsection{Problem 3a.}\label{problem-3a.}}

We calculate \begin{align}
  \mathop{\mathrm{Cov}}(y_i, y_{i'}) &= \mathop{\mathrm{Cov}}(\beta_0 + \eta_{j[i]} + \epsilon_i, \beta_0 + \eta_{j[i']} + \epsilon_{i'}) \\
  &= \mathop{\mathrm{Cov}}(\eta_{j[i]} + \epsilon_i,  \eta_{j[i']} + \epsilon_{i'}) 
  \label{e:no-betas} \\                
  &= \mathop{\mathrm{Cov}}(\eta_{j[i]}, \eta_{j[i']}) + \mathop{\mathrm{Cov}}(\eta_{j[i]}, \epsilon_{i'}) + \mathop{\mathrm{Cov}}(\epsilon_i, \eta_{j[i']}) + \mathop{\mathrm{Cov}}(\epsilon_i, \epsilon_{i'}) \label{eq:1a} \\
  &= \mathop{\mathrm{Cov}}(\eta_{j[i]}, \eta_{j[i']}) + 0 + 0 + 0 \label{e:zeros}
\end{align}\\
where \eqref{e:no-betas} follows because adding the constant \(\beta_0\)
does not change the covariance, and \eqref{e:zeros} follows because the
\(\epsilon\)'s are independent of each other and the \(\eta\)'s are
independent of the \(\epsilon\)'s.

If \(j[i]\neq j[i']\) then
\(\mathop{\mathrm{Cov}}(\eta_{j[i]}, \eta_{j[i']})=0\) too, because
different \(\eta\)'s are also independent of each other, and so
\(\mathop{\mathrm{Corr}}(\eta_{j[i]}, \eta_{j[i']})=0\) also.

\hypertarget{problem-3b.}{%
\subsection{Problem 3b.}\label{problem-3b.}}

If \(j[i]=j[i']\) in \eqref{eq:1a}, then the \(\eta\)'s in
\eqref{e:zeros} are the same and so \begin{align}
  \mathop{\mathrm{Cov}}(\eta_{j[i]}, \eta_{j[i']}) + 0 + 0 + 0 
  &= \mathop{\mathrm{Var}}(\eta_{j[i]}) + 0 + 0 + 0 \\
  &= \tau^2\label{eq:1b}
\end{align}

Finally, when \(j[i]=j[i']\), \begin{align}
  \mathop{\mathrm{Corr}}(y_i, y_{i'}) 
  &= \frac{\mathop{\mathrm{Cov}}(y_i, y_{i'})}{\sqrt{\sigma^2_{y_i}\sigma^2_{y_{i'}}}} \\
  &= \frac{\tau^2}{\sqrt{(\sigma^2 + \tau^2)(\sigma^2 + \tau^2)}} \label{e:almost} \\
  &= \frac{\tau^2}{\sigma^2 + \tau^2}
\end{align} where the numerator in \eqref{e:almost} comes from
\eqref{eq:1b} and the terms in the denominator follows from
\begin{align}
   \mathop{\mathrm{Var}}(y_i) &= \mathop{\mathrm{Var}}(\beta_0 + \eta_j[i] + \epsilon_i) \\
   &= 0 + \tau^2 + \sigma^2
\end{align}

\hypertarget{problem-3c.}{%
\subsection{Problem 3c.}\label{problem-3c.}}

\def\i{_{\{i:j[i]=j\}}}

\begin{align}
  \frac{1}{n_j}\sum_{\{i:j[i]=j\}}Y_i &= \frac{1}{n_j}\left[\sum_{\{i:j[i]=j\}}\beta_0 + \sum_{\{i:j[i]=j\}}\eta_j + \sum_{\{i:j[i]=j\}}\epsilon_i\right] \\
                        &= \beta_0 + \eta_j + \frac{1}{n_j}\sum_{\{i:j[i]=j\}}\epsilon_i 
\end{align} which means \begin{align}
   \mathop{\mathrm{Var}}(\bar{y}_j) &= \mathop{\mathrm{Var}}(\eta_j) + \frac{1}{n_j^2}\sum_{\{i:j[i]=j\}}\mathop{\mathrm{Var}}(\epsilon_i) \\
          &= \tau^2 + \frac{\sigma^2}{n_j} \label{e:bar-var}
\end{align}

\hypertarget{problem-3d.}{%
\subsection{Problem 3d.}\label{problem-3d.}}

Using the same kinds of ideas as above, we can calculate \begin{align}
  \mathop{\mathrm{Var}}(\bar{y}_j) &= \tau^2 + \frac{\sigma^2}{n_j} \mbox{~~(from \eqref{e:bar-var})} \\
  \mathop{\mathrm{Var}}(\bar{y}_j^*) &= \tau^2 + \frac{\sigma^2}{n_j} \mbox{~~(from \eqref{e:bar-var} again)} \\
  \mathop{\mathrm{Cov}}(\bar{y}_j,\bar{y}_j^*) &= \mathop{\mathrm{Cov}}\left(\beta_0 + \eta_j + \frac{1}{n_j}\sum_{\{i:j[i]=j\}}\epsilon_i, \beta_0 + \eta_j + \frac{1}{n_j}\sum_{\{i:j[i]=j\}}\epsilon_i^*\right) \\
  &=\tau^2 \mbox{~~(similarly to \eqref{eq:1b})}
\end{align} and therefore \begin{align}
\mathop{\mathrm{Corr}}(\bar{y}_j,\bar{y}_j^*) &=  \frac{\mathop{\mathrm{Cov}}(\bar{y}_j,\bar{y}_j^*)}{\sqrt{\mathop{\mathrm{Var}}(\bar{y}_j)\mathop{\mathrm{Var}}(\bar{y}_j^*)}} \\
  &= \frac{\tau^2}{\sqrt{(\tau^2 + \sigma^2/n_j)(\tau^2 + \sigma^2/n_j)}}\\
  &= \frac{\tau^2}{\tau^2 + \sigma^2/n_j}
\end{align}

\rm

\end{document}
