% Options for packages loaded elsewhere
\PassOptionsToPackage{unicode}{hyperref}
\PassOptionsToPackage{hyphens}{url}
%
\documentclass[
]{article}
\usepackage{lmodern}
\usepackage{amssymb,amsmath}
\usepackage{ifxetex,ifluatex}
\ifnum 0\ifxetex 1\fi\ifluatex 1\fi=0 % if pdftex
  \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}
\IfFileExists{xurl.sty}{\usepackage{xurl}}{} % add URL line breaks if available
\IfFileExists{bookmark.sty}{\usepackage{bookmark}}{\usepackage{hyperref}}
\hypersetup{
  pdftitle={Homework 08 solutions (draft)},
  hidelinks,
  pdfcreator={LaTeX via pandoc}}
\urlstyle{same} % disable monospaced font for URLs
\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{longtable,booktabs}
% Correct order of tables after \paragraph or \subparagraph
\usepackage{etoolbox}
\makeatletter
\patchcmd\longtable{\par}{\if@noskipsec\mbox{}\fi\par}{}{}
\makeatother
% Allow footnotes in longtable head/foot
\IfFileExists{footnotehyper.sty}{\usepackage{footnotehyper}}{\usepackage{footnote}}
\makesavenoteenv{longtable}
\usepackage{graphicx,grffile}
\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}

\title{Homework 08 solutions (draft)}
\author{}
\date{\vspace{-2.5em}11/6/2020}

\begin{document}
\maketitle

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

\hypertarget{eda-not-required}{%
\subsection{EDA (not required)}\label{eda-not-required}}

The below EDA shows us few things, but the plot visualization is
clearest relative to future exploration we will be doing. We can observe
the neither the rows nor the columns inform the viewer of the full
relationship between such class structure and the number of breaks of
the wool. Specifically note that Wool A appears to break more with loose
(L) tension (compared to Wool B), but that this structure (that Wool A
breaks more than Wool B) isn't observed / as strong across all levels of
tension.

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{library}\NormalTok{(tidyverse)}
\CommentTok{#table(warpbreaks$wool, warpbreaks$tension) # all 9 values}
\KeywordTok{xtabs}\NormalTok{(breaks }\OperatorTok{~}\StringTok{ }\NormalTok{wool }\OperatorTok{+}\StringTok{ }\NormalTok{tension, }\DataTypeTok{data =}\NormalTok{ warpbreaks)}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
##     tension
## wool   L   M   H
##    A 401 216 221
##    B 254 259 169
\end{verbatim}

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{warpbreaks }\OperatorTok{%>%}\StringTok{ }\NormalTok{head}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
##   breaks wool tension
## 1     26    A       L
## 2     30    A       L
## 3     54    A       L
## 4     25    A       L
## 5     70    A       L
## 6     52    A       L
\end{verbatim}

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{warpbreaks }\OperatorTok{%>%}\StringTok{ }
\StringTok{  }\KeywordTok{ggplot}\NormalTok{() }\OperatorTok{+}
\StringTok{  }\KeywordTok{geom_histogram}\NormalTok{(}\KeywordTok{aes}\NormalTok{(}\DataTypeTok{x =}\NormalTok{ breaks)) }\OperatorTok{+}
\StringTok{  }\KeywordTok{facet_wrap}\NormalTok{(wool }\OperatorTok{~}\StringTok{ }\NormalTok{tension)}
\end{Highlighting}
\end{Shaded}

\includegraphics{hw08_solution_draft_files/figure-latex/unnamed-chunk-1-1.pdf}

\hypertarget{a}{%
\subsection{(a)}\label{a}}

\hypertarget{a-no-interaction-term}{%
\subsubsection{(a) No interaction term}\label{a-no-interaction-term}}

Our anova model without an interaction term between wool and tension in
predicting number of breaks doesn't fit the data to well. Although this
anova model only provides us with (at most) 6 different fitted values
for 54 observations, we can see that the lack of interaction terms
impacts the our residual vs fitted plot, where we find that the true
average value for each of the Wool + tension combinations does not
exactly equal the predicted average (this can be seen by the smoothed
regression line of the residual vs fitted not being 0 for all fitted
values). For this anova, it's probably not the best to
\emph{over-interpret} the standard summary plots (due to the 6 fitted
values). A similar observation relative to the residuals vs fitted can
be seen in marginal plot, where the fitted curve doesn't match the raw
average of the number of breaks verse predicted number of breaks. Note
that the x-axis values are of the log(breaks) scale, whereas the y-axis
is on the breaks scale.

Our ``DHARMa'' residual plots present a different way to see that our
residuals still relationships with our predicted values (aka the 6
classes between Wool and tension), suggesting that the model that we fit
doesn't create / simulate residuals similar to the truely observed
value. The over-dispersion seen in the QQ plot of the ranks of the
residuals makes sense and it suggests that the true residuals are more
variable than the simulation model would expect (which does make sense
relative to our observation that the model doesn't well capture the mean
of each group).

It should be noted that I did not use the binned residual plot as it
would show almost the same information as the regular residual vs fitted
plot (relative to 6 bins). The binned residual plot may have captured
the information in the \texttt{summary}'s residual vs fitted and
absolute residual vs fitted plots. We include the code to do so below
just in case that would be useful - just commented out.

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{p_glm1 <-}\StringTok{ }\KeywordTok{glm}\NormalTok{(breaks}\OperatorTok{~}\NormalTok{wool}\OperatorTok{+}\NormalTok{tension, }\DataTypeTok{data =}\NormalTok{ warpbreaks,}
              \DataTypeTok{family =}\NormalTok{ poisson)}

\KeywordTok{summary}\NormalTok{(p_glm1)}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
## 
## Call:
## glm(formula = breaks ~ wool + tension, family = poisson, data = warpbreaks)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.6871  -1.6503  -0.4269   1.1902   4.2616  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  3.69196    0.04541  81.302  < 2e-16 ***
## woolB       -0.20599    0.05157  -3.994 6.49e-05 ***
## tensionM    -0.32132    0.06027  -5.332 9.73e-08 ***
## tensionH    -0.51849    0.06396  -8.107 5.21e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##     Null deviance: 297.37  on 53  degrees of freedom
## Residual deviance: 210.39  on 50  degrees of freedom
## AIC: 493.06
## 
## Number of Fisher Scoring iterations: 4
\end{verbatim}

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{par}\NormalTok{(}\DataTypeTok{mfrow =} \KeywordTok{c}\NormalTok{(}\DecValTok{2}\NormalTok{,}\DecValTok{2}\NormalTok{))}
\KeywordTok{plot}\NormalTok{(p_glm1)}
\end{Highlighting}
\end{Shaded}

\includegraphics{hw08_solution_draft_files/figure-latex/unnamed-chunk-3-1.pdf}

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{library}\NormalTok{(DHARMa)}
\KeywordTok{library}\NormalTok{(arm)}
\KeywordTok{library}\NormalTok{(marginalmodelplots)}
\end{Highlighting}
\end{Shaded}

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{mmplot}\NormalTok{(p_glm1, }\DataTypeTok{locfit.control=}\KeywordTok{list}\NormalTok{(}\DataTypeTok{nn =} \StringTok{"gcv"}\NormalTok{)) }
\end{Highlighting}
\end{Shaded}

\includegraphics{hw08_solution_draft_files/figure-latex/unnamed-chunk-5-1.pdf}

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{sim_resid1 <-}\StringTok{ }\KeywordTok{simulateResiduals}\NormalTok{(p_glm1, }\DataTypeTok{plot =}\NormalTok{ F)}
\KeywordTok{plot}\NormalTok{(sim_resid1)}
\end{Highlighting}
\end{Shaded}

\includegraphics{hw08_solution_draft_files/figure-latex/unnamed-chunk-6-1.pdf}

\begin{Shaded}
\begin{Highlighting}[]
\CommentTok{# library(arm)}
\CommentTok{# binnedplot(predict(p_glm1), resid(p_glm1))}
\end{Highlighting}
\end{Shaded}

\hypertarget{a-interaction-term}{%
\subsubsection{(a) Interaction term}\label{a-interaction-term}}

For the model with an interaction term (who's diagnostic plots are
below), we find the model is able to capture all the different groupings
of wool an tensions mean (but design). This is seen in the residual vs
fitted and the fact that both smoothed fitted and true lines are very
close to each other in overall marginal plot. Although this TA would
discourage from interpreting the standard summary plots too much, we can
observe that distribution of errors for the wool + tension group with
average log(breaks) of 3.8 has a log-based residuals that are larger
than other wool + tension groups (as seen in the residual vs fitted and
absolute residual vs fitted plots). The difference between the
variability of the residuals per each wool + tension group also seems to
lead to overdispersion of the residuals relative to simulations draw
from out fitted models (visualized in the ``DHARMa'' plots).

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{p_glm2 <-}\StringTok{ }\KeywordTok{glm}\NormalTok{(breaks}\OperatorTok{~}\NormalTok{wool}\OperatorTok{*}\NormalTok{tension, }\DataTypeTok{data =}\NormalTok{ warpbreaks,}
              \DataTypeTok{family =}\NormalTok{ poisson)}
\end{Highlighting}
\end{Shaded}

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{summary}\NormalTok{(p_glm2)}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
## 
## Call:
## glm(formula = breaks ~ wool * tension, family = poisson, data = warpbreaks)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.3383  -1.4844  -0.1291   1.1725   3.5153  
## 
## Coefficients:
##                Estimate Std. Error z value Pr(>|z|)    
## (Intercept)     3.79674    0.04994  76.030  < 2e-16 ***
## woolB          -0.45663    0.08019  -5.694 1.24e-08 ***
## tensionM       -0.61868    0.08440  -7.330 2.30e-13 ***
## tensionH       -0.59580    0.08378  -7.112 1.15e-12 ***
## woolB:tensionM  0.63818    0.12215   5.224 1.75e-07 ***
## woolB:tensionH  0.18836    0.12990   1.450    0.147    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##     Null deviance: 297.37  on 53  degrees of freedom
## Residual deviance: 182.31  on 48  degrees of freedom
## AIC: 468.97
## 
## Number of Fisher Scoring iterations: 4
\end{verbatim}

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{anova}\NormalTok{(p_glm1, p_glm2)}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
## Analysis of Deviance Table
## 
## Model 1: breaks ~ wool + tension
## Model 2: breaks ~ wool * tension
##   Resid. Df Resid. Dev Df Deviance
## 1        50     210.39            
## 2        48     182.31  2   28.087
\end{verbatim}

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{par}\NormalTok{(}\DataTypeTok{mfrow =} \KeywordTok{c}\NormalTok{(}\DecValTok{2}\NormalTok{,}\DecValTok{2}\NormalTok{))}
\KeywordTok{plot}\NormalTok{(p_glm2)}
\end{Highlighting}
\end{Shaded}

\includegraphics{hw08_solution_draft_files/figure-latex/unnamed-chunk-10-1.pdf}

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{mmplot}\NormalTok{(p_glm2)}
\end{Highlighting}
\end{Shaded}

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

\begin{Shaded}
\begin{Highlighting}[]
\CommentTok{#library(arm)}
\CommentTok{#binnedplot(predict(p_glm2), resid(p_glm2))}
\end{Highlighting}
\end{Shaded}

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{simulateResiduals}\NormalTok{(p_glm2, }\DataTypeTok{plot =}\NormalTok{ T)}
\end{Highlighting}
\end{Shaded}

\includegraphics{hw08_solution_draft_files/figure-latex/unnamed-chunk-13-1.pdf}

\begin{verbatim}
## Object of Class DHARMa with simulated residuals based on 250 simulations with refit = FALSE . See ?DHARMa::simulateResiduals for help. 
##  
## Scaled residual values: 0 0.005054066 0.9226526 0 1 0.8865403 0.8222991 0 0.9974159 0.1130634 0.205633 0.8650704 0.0437755 0.004 0.1330076 0.9818622 0.8970931 0.9903393 0.9863919 0.2014831 ...
\end{verbatim}

\hypertarget{b}{%
\subsection{(b)}\label{b}}

\hypertarget{i}{%
\subsubsection{(i)}\label{i}}

As can be seen in the below table, the second poisson model with
interaction terms has a lower AIC and BIC than the first model. If we
remember that both of these score functions look like \[
-2 \cdot \text{(log likelihood)} + \text{constant}\cdot \text{(number of parameters)}
\] then we can conclude the both AIC and BIC recommend going with the
poisson model \textbf{with} interaction terms (aka lower AIC/BIC is
better).

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{df_aic_info <-}\StringTok{ }\KeywordTok{data.frame}\NormalTok{(}\DataTypeTok{AIC =} \KeywordTok{c}\NormalTok{(}\KeywordTok{AIC}\NormalTok{(p_glm1), }\KeywordTok{AIC}\NormalTok{(p_glm2)),}
                          \DataTypeTok{BIC =} \KeywordTok{c}\NormalTok{(}\KeywordTok{BIC}\NormalTok{(p_glm1), }\KeywordTok{BIC}\NormalTok{(p_glm2))) }\OperatorTok{%>%}\StringTok{ }\KeywordTok{t}\NormalTok{()}
\KeywordTok{colnames}\NormalTok{(df_aic_info) <-}\StringTok{ }\KeywordTok{c}\NormalTok{(}\StringTok{"poisson model, no interaction"}\NormalTok{,}
                           \StringTok{"poisson model, interaction"}\NormalTok{)}

\NormalTok{knitr}\OperatorTok{::}\KeywordTok{kable}\NormalTok{(df_aic_info)}
\end{Highlighting}
\end{Shaded}

\begin{longtable}[]{@{}lrr@{}}
\toprule
& poisson model, no interaction & poisson model,
interaction\tabularnewline
\midrule
\endhead
AIC & 493.0560 & 468.9692\tabularnewline
BIC & 501.0119 & 480.9031\tabularnewline
\bottomrule
\end{longtable}

\hypertarget{ii}{%
\subsubsection{(ii)}\label{ii}}

The LRT also suggests we should reject the null hypothesis that the
model with an interaction only explains as much information as the the
model without the interaction term. This would lead us to select the
second model like AIC and BIC did.

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{diff_log_like <-}\StringTok{ }\DecValTok{-2} \OperatorTok{*}\StringTok{ }\NormalTok{(}\KeywordTok{logLik}\NormalTok{(p_glm1) }\OperatorTok{-}\StringTok{ }\KeywordTok{logLik}\NormalTok{(p_glm2))}
\DecValTok{1}\OperatorTok{-}\KeywordTok{pchisq}\NormalTok{(diff_log_like, }\DataTypeTok{df =} \DecValTok{4}\NormalTok{)}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
## 'log Lik.' 1.197798e-05 (df=4)
\end{verbatim}

\hypertarget{c}{%
\subsection{(c)}\label{c}}

The below p-values suggest that the residuals in model 2 are
over-dispersed and match the simulation test from DHARMa.

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{n <-}\StringTok{ }\KeywordTok{nrow}\NormalTok{(warpbreaks)}

\NormalTok{pp2 <-}\StringTok{ }\KeywordTok{length}\NormalTok{(}\KeywordTok{coef}\NormalTok{(p_glm2))}

\NormalTok{e_y_}\DecValTok{2}\NormalTok{ <-}\StringTok{ }\KeywordTok{predict}\NormalTok{(p_glm2, }\DataTypeTok{type =} \StringTok{"response"}\NormalTok{)}
\NormalTok{z_}\DecValTok{2}\NormalTok{ <-}\StringTok{ }\NormalTok{(warpbreaks}\OperatorTok{$}\NormalTok{breaks }\OperatorTok{-}\StringTok{ }\NormalTok{e_y_}\DecValTok{2}\NormalTok{)}\OperatorTok{/}\StringTok{ }\KeywordTok{sqrt}\NormalTok{(e_y_}\DecValTok{2}\NormalTok{)}
\NormalTok{test_stat_}\DecValTok{2}\NormalTok{ <-}\StringTok{ }\KeywordTok{sum}\NormalTok{(z_}\DecValTok{2}\OperatorTok{^}\DecValTok{2}\NormalTok{)}

\KeywordTok{pchisq}\NormalTok{(test_stat_}\DecValTok{2}\NormalTok{, n}\OperatorTok{-}\NormalTok{pp2, }\DataTypeTok{lower.tail =}\NormalTok{ F)}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
## [1] 2.926195e-17
\end{verbatim}

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{testDispersion}\NormalTok{(p_glm2, }\DataTypeTok{alternative =} \StringTok{"greater"}\NormalTok{)}
\end{Highlighting}
\end{Shaded}

\includegraphics{hw08_solution_draft_files/figure-latex/unnamed-chunk-17-1.pdf}

\begin{verbatim}
## 
##  DHARMa nonparametric dispersion test via sd of residuals fitted vs.
##  simulated
## 
## data:  simulationOutput
## ratioObsSim = 1.9846, p-value < 2.2e-16
## alternative hypothesis: greater
\end{verbatim}

\hypertarget{d}{%
\subsection{(d)}\label{d}}

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{p_glm2d <-}\StringTok{ }\KeywordTok{glm}\NormalTok{(breaks}\OperatorTok{~}\NormalTok{wool}\OperatorTok{*}\NormalTok{tension, }\DataTypeTok{data =}\NormalTok{ warpbreaks,}
              \DataTypeTok{family =}\NormalTok{ quasipoisson)}
\end{Highlighting}
\end{Shaded}

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{summary}\NormalTok{(p_glm2d)}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
## 
## Call:
## glm(formula = breaks ~ wool * tension, family = quasipoisson, 
##     data = warpbreaks)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.3383  -1.4844  -0.1291   1.1725   3.5153  
## 
## Coefficients:
##                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     3.79674    0.09688  39.189  < 2e-16 ***
## woolB          -0.45663    0.15558  -2.935 0.005105 ** 
## tensionM       -0.61868    0.16374  -3.778 0.000436 ***
## tensionH       -0.59580    0.16253  -3.666 0.000616 ***
## woolB:tensionM  0.63818    0.23699   2.693 0.009727 ** 
## woolB:tensionH  0.18836    0.25201   0.747 0.458436    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for quasipoisson family taken to be 3.76389)
## 
##     Null deviance: 297.37  on 53  degrees of freedom
## Residual deviance: 182.31  on 48  degrees of freedom
## AIC: NA
## 
## Number of Fisher Scoring iterations: 4
\end{verbatim}

Fitting the second model using quasipoisson allows us to have a
disperison parameter that is not 1. The new model's dispersion paramter
is now 3.7639, which is much larger than 1 - which does suggest that we
had a problem with residuals being overdispersed in the original model.

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

\hypertarget{a-1}{%
\subsection{(a)}\label{a-1}}

Nothing is required to be turned in here.

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{library}\NormalTok{(tidyverse)}
\KeywordTok{library}\NormalTok{(foreign)}
\NormalTok{nes_all <-}\StringTok{ }\KeywordTok{read.dta}\NormalTok{(}\StringTok{"../nes5200_processed_voters_realideo.dta"}\NormalTok{)}
\CommentTok{#attr(nes_all, "var.labels")}

\NormalTok{nes_}\DecValTok{1976}\NormalTok{ <-}\StringTok{ }\NormalTok{nes_all }\OperatorTok{%>%}\StringTok{ }\KeywordTok{filter}\NormalTok{(year }\OperatorTok{==}\StringTok{ "1976"}\NormalTok{) }\OperatorTok{%>%}
\StringTok{  }\NormalTok{dplyr}\OperatorTok{::}\KeywordTok{select}\NormalTok{(ideo7, black, female,}
\NormalTok{                          rep_pres_intent,}
\NormalTok{                          presapprov, age,}
\NormalTok{                          educ1, urban, income, union,}
\NormalTok{                          perfin1)}
\CommentTok{#summary(nes)}
\end{Highlighting}
\end{Shaded}

\hypertarget{b-1}{%
\subsection{(b)}\label{b-1}}

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{l_glm_}\DecValTok{1976}\NormalTok{ <-}\StringTok{ }\KeywordTok{glm}\NormalTok{(rep_pres_intent }\OperatorTok{~}\StringTok{ }\NormalTok{., }\DataTypeTok{data =}\NormalTok{ nes_}\DecValTok{1976}\NormalTok{, }\DataTypeTok{family =} \StringTok{"binomial"}\NormalTok{)}
\end{Highlighting}
\end{Shaded}

\hypertarget{b-fit-assessment}{%
\subsubsection{(b) Fit assessment}\label{b-fit-assessment}}

For standard logistic regression, where the data are assumed to be
\textbf{Bernoulli} random variables (aka 0/1), the standard summary
plots are not very helpful in letting us understand the fit. The summary
does suggest that the model captures some of the variability that we
see. Interestly, the binned residual plot we see that the average logit
predicted value is less extreme than it should be at either end the
spectrum (extremely likely to vote Democrat or Republican). At the same
time, the DHARMa residual diagnostics suggest that the ranking and
ranking conditional on model predictions fit simulation expectations
well.

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{binnedplot}\NormalTok{(}\KeywordTok{predict}\NormalTok{(l_glm_}\DecValTok{1976}\NormalTok{), }\KeywordTok{resid}\NormalTok{(l_glm_}\DecValTok{1976}\NormalTok{))}
\end{Highlighting}
\end{Shaded}

\includegraphics{hw08_solution_draft_files/figure-latex/unnamed-chunk-22-1.pdf}

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{library}\NormalTok{(DHARMa)}
\KeywordTok{plot}\NormalTok{(}\KeywordTok{simulateResiduals}\NormalTok{(l_glm_}\DecValTok{1976}\NormalTok{))}
\end{Highlighting}
\end{Shaded}

\includegraphics{hw08_solution_draft_files/figure-latex/unnamed-chunk-23-1.pdf}

\hypertarget{b-model-interpretation}{%
\subsubsection{(b) model interpretation}\label{b-model-interpretation}}

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{summary}\NormalTok{(l_glm_}\DecValTok{1976}\NormalTok{)}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
## 
## Call:
## glm(formula = rep_pres_intent ~ ., family = "binomial", data = nes_1976)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.9003  -0.2796   0.2682   0.5318   2.6967  
## 
## Coefficients:
##                                                Estimate Std. Error z value
## (Intercept)                                    0.830985   1.026176   0.810
## ideo72. liberal                               -2.327337   0.845434  -2.753
## ideo73. slightly liberal                      -2.886738   0.811851  -3.556
## ideo74. moderate, middle of the road          -1.833549   0.772496  -2.374
## ideo75. slightly conservative                 -0.531175   0.777492  -0.683
## ideo76. conservative                           0.023279   0.791822   0.029
## ideo77. extremely conservative                 0.892863   1.171559   0.762
## black                                         -2.021512   0.692902  -2.917
## female                                         0.343980   0.215341   1.597
## presapprov2. disapprove                       -3.940278   0.295717 -13.324
## age                                            0.004966   0.007755   0.640
## educ12. high school (12 grades or fewer, incl  1.019021   0.435615   2.339
## educ13. some college(13 grades or more,but no  1.077248   0.471817   2.283
## educ14. college or advanced degree (no cases   1.288787   0.485539   2.654
## urban2. suburban areas                         0.500890   0.273666   1.830
## urban3. rural, small towns, outlying and adja  0.074872   0.284912   0.263
## income2. 17 to 33 percentile                   0.253838   0.534507   0.475
## income3. 34 to 67 percentile                  -0.113254   0.497111  -0.228
## income4. 68 to 95 percentile                   0.027157   0.495444   0.055
## income5. 96 to 100 percentile                  0.354393   0.603023   0.588
## union2. no, no one in the household belongs t  0.602304   0.248466   2.424
## perfin12. same                                -0.075231   0.271044  -0.278
## perfin13. worse now                           -0.314517   0.262847  -1.197
##                                               Pr(>|z|)    
## (Intercept)                                   0.418062    
## ideo72. liberal                               0.005908 ** 
## ideo73. slightly liberal                      0.000377 ***
## ideo74. moderate, middle of the road          0.017619 *  
## ideo75. slightly conservative                 0.494487    
## ideo76. conservative                          0.976546    
## ideo77. extremely conservative                0.445991    
## black                                         0.003529 ** 
## female                                        0.110182    
## presapprov2. disapprove                        < 2e-16 ***
## age                                           0.521980    
## educ12. high school (12 grades or fewer, incl 0.019322 *  
## educ13. some college(13 grades or more,but no 0.022419 *  
## educ14. college or advanced degree (no cases  0.007946 ** 
## urban2. suburban areas                        0.067205 .  
## urban3. rural, small towns, outlying and adja 0.792714    
## income2. 17 to 33 percentile                  0.634858    
## income3. 34 to 67 percentile                  0.819783    
## income4. 68 to 95 percentile                  0.956287    
## income5. 96 to 100 percentile                 0.556738    
## union2. no, no one in the household belongs t 0.015347 *  
## perfin12. same                                0.781350    
## perfin13. worse now                           0.231471    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1245.55  on 908  degrees of freedom
## Residual deviance:  597.62  on 886  degrees of freedom
##   (903 observations deleted due to missingness)
## AIC: 643.62
## 
## Number of Fisher Scoring iterations: 6
\end{verbatim}

To predict if a voter with vote for a Republican (or Democrat) we see
some interesting trends. First, holding all other features equal, if an
individual is \textbf{black} (not white), we should expect
\(e^{\beta_\text{black}}\) (0.132455) multiplicative decrease in the
odds ratio of voting for a Republican over a Democrat. Similarly, but in
reverse, \textbf{not having any household member being in a union}
(instead of the reverse) is observed as increasing the odds ratio of
voting for a Republican over a Democrat by 1.8263209. Not surprisingly,
given that the current president is a Republican, if \textbf{one
disapproves of the current president} (as opposed to approving of the
current president), would lead to a multiplicative decrease in the odds
ratio of voting for a Republican over a Democrat by multiplication by
0.0194428.

There are also some non-binary variable that were significant, but they
more nuanced interpretations. For different \textbf{ideological} views
we see impacts on whether the individual will vote Republican or
Democrat. In this case, the base case is ``extremely liberal'' and
interestedly we see that if one is moves from ``extremely liberal to
``liberal or ``slightly liberal'' we'd expect a multiplicative decrease
in the odds ratio of voting for a Republican over a Democrat by
0.0975551 or 0.0557578 respectively. We don't observe significant
differences (holding all other variables equal) between the odds ratio
between ``extremely liberal'' vs any time of conservative. In context
this is surprising, but one could hypothesis that this may be related to
the fact that certain differences between ``extremely liberal'' and
``conservatives'' are already captured in other variables. Another
significant categorical variable is \textbf{maximum education level
attained}, where the base case is only some grade school (0-8 grades).
Compared with this base level we do see that as we increase education
levels the estimated coefficient for voting Republican over Democrat
increases. We can't directly use the p-values of the higher education
levels to test if a high school education vs college education
significantly impacts a voter's likelihood of voting for a Republican,
but looking at the difference of the coefficients and the standard error
we might guess (without directly doing the test) that they are not given
the standard error for each \(\beta\) value is larger than the
difference between the \(\beta\) values.

\hypertarget{c-1}{%
\subsection{(c)}\label{c-1}}

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{nes_}\DecValTok{1976}\NormalTok{_numeric <-}\StringTok{ }\NormalTok{nes_}\DecValTok{1976} \OperatorTok{%>%}\StringTok{ }\KeywordTok{sapply}\NormalTok{(as.numeric) }\OperatorTok{%>%}\StringTok{ }\NormalTok{data.frame}
\NormalTok{l_glm_}\DecValTok{1976}\NormalTok{_numeric <-}\StringTok{ }\KeywordTok{glm}\NormalTok{(rep_pres_intent }\OperatorTok{~}\StringTok{ }\NormalTok{ideo7 }\OperatorTok{+}\StringTok{ }\NormalTok{black }\OperatorTok{+}\StringTok{ }\NormalTok{female }\OperatorTok{+}\StringTok{ }\NormalTok{presapprov }\OperatorTok{+}\StringTok{ }\NormalTok{age }\OperatorTok{+}\StringTok{ }
\StringTok{                }\NormalTok{educ1 }\OperatorTok{+}\StringTok{ }\NormalTok{urban }\OperatorTok{+}\StringTok{ }\NormalTok{income }\OperatorTok{+}\StringTok{ }\NormalTok{union }\OperatorTok{+}\StringTok{ }\NormalTok{perfin1, }
              \DataTypeTok{data =}\NormalTok{ nes_}\DecValTok{1976}\NormalTok{_numeric, }\DataTypeTok{family=}\NormalTok{binomial)}
\end{Highlighting}
\end{Shaded}

\hypertarget{c-fit-assessment}{%
\subsubsection{(c) Fit assessment}\label{c-fit-assessment}}

The fit of the above model is worse (in terms of shrinking the residual
deviance). From the marginal plot, this may be related to the less
optimal fit relative to ideology and age. Other than that - it does look
like a similar fit to the factor based model.

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{binnedplot}\NormalTok{(}\KeywordTok{predict}\NormalTok{(l_glm_}\DecValTok{1976}\NormalTok{_numeric), }\KeywordTok{resid}\NormalTok{(l_glm_}\DecValTok{1976}\NormalTok{_numeric))}
\end{Highlighting}
\end{Shaded}

\includegraphics{hw08_solution_draft_files/figure-latex/unnamed-chunk-26-1.pdf}

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{plot}\NormalTok{(}\KeywordTok{simulateResiduals}\NormalTok{(l_glm_}\DecValTok{1976}\NormalTok{_numeric))}
\end{Highlighting}
\end{Shaded}

\includegraphics{hw08_solution_draft_files/figure-latex/unnamed-chunk-26-2.pdf}

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{mmplot}\NormalTok{(l_glm_}\DecValTok{1976}\NormalTok{_numeric,}\DataTypeTok{exclude =} \KeywordTok{c}\NormalTok{(}\DecValTok{2}\NormalTok{,}\DecValTok{3}\NormalTok{,}\DecValTok{4}\NormalTok{,}\DecValTok{7}\NormalTok{,}\DecValTok{9}\NormalTok{,}\DecValTok{10}\NormalTok{))}
\end{Highlighting}
\end{Shaded}

\includegraphics{hw08_solution_draft_files/figure-latex/unnamed-chunk-26-3.pdf}

\hypertarget{c-model-interpretation}{%
\subsubsection{(c) model interpretation}\label{c-model-interpretation}}

This numerical model suggests similar parameters are useful. A similar
interpretation of \textbf{black} (vs white), \textbf{not having any
household member being in a union} (instead of the reverse) and
presidental approval exists for this model as the last. Specifically,
holding all other features equal, if an individual is \textbf{black}
(not white), we should expect \(e^{\beta_\text{black}}\) (0.1258773)
multiplicative decrease in the odds ratio of voting for a Republican
over a Democrat, \textbf{not having any household member being in a
union} (instead of the reverse) is observed as increasing the odds ratio
of voting for a Republican over a Democrat by a multiplication of
1.814176, and if \textbf{one disapproves of the current president} (as
opposed to approving of the current president), would lead to a decrease
in the odds ratio of voting for a Republican over a Democrat by a
multiplication of0.0268055.

We now can only fit a linear trend (that ranges from ``extremely
liberal'' to ``extremely conservative''), but it is significant, a one
``unit'' increase (between the levels) of ideology towards conservatism,
we should expect \(e^{\beta_\text{ideo7}}\) (2.0066553) multiplicative
decrease in the odds ratio of voting for a Republican over a Democrat.
Education attainment is no longer a significant variable.

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{summary}\NormalTok{(l_glm_}\DecValTok{1976}\NormalTok{_numeric)}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
## 
## Call:
## glm(formula = rep_pres_intent ~ ideo7 + black + female + presapprov + 
##     age + educ1 + urban + income + union + perfin1, family = binomial, 
##     data = nes_1976_numeric)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.5791  -0.3257   0.3169   0.5721   3.1081  
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  2.239570   1.281720   1.747  0.08058 .  
## ideo7        0.696469   0.094070   7.404 1.32e-13 ***
## black       -2.072448   0.669428  -3.096  0.00196 ** 
## female       0.288426   0.206065   1.400  0.16161    
## presapprov  -3.619149   0.267075 -13.551  < 2e-16 ***
## age          0.005650   0.006706   0.842  0.39952    
## educ1        0.239311   0.123796   1.933  0.05322 .  
## urban       -0.067092   0.138109  -0.486  0.62712    
## income       0.072922   0.110340   0.661  0.50868    
## union        0.595631   0.236410   2.519  0.01175 *  
## perfin1     -0.103289   0.127397  -0.811  0.41750    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1245.55  on 908  degrees of freedom
## Residual deviance:  630.72  on 898  degrees of freedom
##   (903 observations deleted due to missingness)
## AIC: 652.72
## 
## Number of Fisher Scoring iterations: 6
\end{verbatim}

\hypertarget{d-1}{%
\subsection{(d)}\label{d-1}}

Both models contain similar information, and, in terms of significant
variables, all variables that are significant in the first model (except
education) are significant in the second model as well. Naturally, the
``linearizing'' of the ordered factor variables reduced the
interpretability of the model. Additionally, although not significant,
the interpretation of the linearization of the levels of income is
probably a worse assumption. Requiring any of these ordered factors to
be linear requires (1) a strictly increasing or decreasing trend, and
(2) that the change between levels should be the same. In the
interpretation of the first model we saw (1) violated with ideological
levels and (2) violated with education levels. As such I wouldn't
recommend converting all the variables to numeric in this case.

\hypertarget{e}{%
\subsection{(e)}\label{e}}

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{nes_}\DecValTok{2000}\NormalTok{ <-}\StringTok{ }\NormalTok{nes_all }\OperatorTok{%>%}\StringTok{ }\KeywordTok{filter}\NormalTok{(year }\OperatorTok{==}\StringTok{ "2000"}\NormalTok{) }\OperatorTok{%>%}
\StringTok{  }\NormalTok{dplyr}\OperatorTok{::}\KeywordTok{select}\NormalTok{(ideo7, black, female,}
\NormalTok{                          rep_pres_intent,}
\NormalTok{                          presapprov, age,}
\NormalTok{                          educ1, urban, income, union,}
\NormalTok{                          perfin1)}
\end{Highlighting}
\end{Shaded}

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{l_glm_}\DecValTok{2000}\NormalTok{ <-}\StringTok{ }\KeywordTok{glm}\NormalTok{(rep_pres_intent }\OperatorTok{~}\StringTok{ }\NormalTok{., }\DataTypeTok{data =}\NormalTok{ nes_}\DecValTok{2000}\NormalTok{, }\DataTypeTok{family =} \StringTok{"binomial"}\NormalTok{)}
\end{Highlighting}
\end{Shaded}

\hypertarget{e-fitted-assessment}{%
\subsubsection{(e) Fitted assessment}\label{e-fitted-assessment}}

Interestingly, this model (relative to the model for 1976) seems a bit
better fitted. Most of the binned residuals still fit in the expected
variablity range, with much fewer bins (still at the extremes) that are
under-estimated in the extremes. Some of this may actually just be
related to the fact that the 2000 sample has 1458 individuals whereas
the 1976 sample had more (1812).

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{binnedplot}\NormalTok{(}\KeywordTok{predict}\NormalTok{(l_glm_}\DecValTok{2000}\NormalTok{), }\KeywordTok{resid}\NormalTok{(l_glm_}\DecValTok{2000}\NormalTok{))}
\end{Highlighting}
\end{Shaded}

\includegraphics{hw08_solution_draft_files/figure-latex/unnamed-chunk-30-1.pdf}

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{plot}\NormalTok{(}\KeywordTok{simulateResiduals}\NormalTok{(l_glm_}\DecValTok{2000}\NormalTok{))}
\end{Highlighting}
\end{Shaded}

\includegraphics{hw08_solution_draft_files/figure-latex/unnamed-chunk-31-1.pdf}

\hypertarget{e-model-interpretation}{%
\subsubsection{(e) model interpretation}\label{e-model-interpretation}}

Some similarities exist between the two models (in terms of which
variables are important), yet we see new trends emerging and some
naturally being reverse based on intuition.

For binary variables, \textbf{black} and \textbf{previous president
disapproval} still is significant (though the impact of previous
president disapproval is not the reverse - favoring a vote for a
Republican over a Democrat)\footnote{This makes sense become the
  previous president is now a Democrat, while in 1976 it was a
  Republican.}. Specifically, holding all other features equal, if an
individual is \textbf{black} (not white), we should expect
\(e^{\beta_\text{black}}\) (0.2491609) multiplicative decrease in the
odds ratio of voting for a Republican over a Democrat, and if
\textbf{one disapproves of the current president} (as opposed to
approving of the current president), would lead to an increase in the
odds ratio of voting for a Republican over a Democrat by a
multiplication of 13.0170957.

We see that ideology and education level is not longer a significant
variable (and unlikely and comparison due to the very high standard
errors estimated for each \(\beta\) value). On the other hand,
\textbf{suburban} (vs urban) looks to cause a significant to a 2.5716781
multiplicative decline in the odds ratio of voting for a Republican over
a Democrat. We also find the age is now a significant variable (with a 1
year increase in age) related to a 0.9697891 multiplicative decrease in
the odds ratio of voting for a Republican over a Democrat.

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{summary}\NormalTok{(l_glm_}\DecValTok{2000}\NormalTok{)}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
## 
## Call:
## glm(formula = rep_pres_intent ~ ., family = "binomial", data = nes_2000)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.1156  -0.6513  -0.2218   0.5124   2.4382  
## 
## Coefficients:
##                                                 Estimate Std. Error z value
## (Intercept)                                    -34.48395 2621.43463  -0.013
## ideo72. liberal                                 15.01763 2248.12503   0.007
## ideo73. slightly liberal                        14.66998 2248.12506   0.007
## ideo74. moderate, middle of the road            16.12093 2248.12497   0.007
## ideo75. slightly conservative                   16.20928 2248.12500   0.007
## ideo76. conservative                            17.36908 2248.12497   0.008
## ideo77. extremely conservative                  17.46256 2248.12535   0.008
## black                                           -1.38966    0.68005  -2.043
## female                                          -0.31696    0.38111  -0.832
## presapprov2. disapprove                          2.56626    0.43950   5.839
## age                                             -0.03068    0.01223  -2.509
## educ12. high school (12 grades or fewer, incl   16.58022 1348.27773   0.012
## educ13. some college(13 grades or more,but no   16.97609 1348.27775   0.013
## educ14. college or advanced degree (no cases    16.80642 1348.27776   0.012
## urban2. suburban areas                           0.94456    0.46955   2.012
## urban3. rural, small towns, outlying and adja    0.82538    0.50495   1.635
## income2. 17 to 33 percentile                    -0.05480    0.65949  -0.083
## income3. 34 to 67 percentile                     0.04054    0.60877   0.067
## income4. 68 to 95 percentile                     0.44415    0.64855   0.685
## income5. 96 to 100 percentile                    0.36119    0.97648   0.370
## union2. no, no one in the household belongs t    0.79305    0.54209   1.463
## perfin12. same                                   1.11384    0.41241   2.701
## perfin13. worse now                              0.51878    0.64879   0.800
##                                               Pr(>|z|)    
## (Intercept)                                    0.98950    
## ideo72. liberal                                0.99467    
## ideo73. slightly liberal                       0.99479    
## ideo74. moderate, middle of the road           0.99428    
## ideo75. slightly conservative                  0.99425    
## ideo76. conservative                           0.99384    
## ideo77. extremely conservative                 0.99380    
## black                                          0.04101 *  
## female                                         0.40559    
## presapprov2. disapprove                       5.25e-09 ***
## age                                            0.01211 *  
## educ12. high school (12 grades or fewer, incl  0.99019    
## educ13. some college(13 grades or more,but no  0.98995    
## educ14. college or advanced degree (no cases   0.99005    
## urban2. suburban areas                         0.04426 *  
## urban3. rural, small towns, outlying and adja  0.10214    
## income2. 17 to 33 percentile                   0.93378    
## income3. 34 to 67 percentile                   0.94691    
## income4. 68 to 95 percentile                   0.49345    
## income5. 96 to 100 percentile                  0.71146    
## union2. no, no one in the household belongs t  0.14348    
## perfin12. same                                 0.00692 ** 
## perfin13. worse now                            0.42394    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 350.34  on 256  degrees of freedom
## Residual deviance: 210.09  on 234  degrees of freedom
##   (1201 observations deleted due to missingness)
## AIC: 256.09
## 
## Number of Fisher Scoring iterations: 16
\end{verbatim}

\hypertarget{e-numeric}{%
\subsubsection{(e) numeric}\label{e-numeric}}

\begin{Shaded}
\begin{Highlighting}[]
\NormalTok{nes_}\DecValTok{2000}\NormalTok{_numeric <-}\StringTok{ }\NormalTok{nes_}\DecValTok{2000} \OperatorTok{%>%}\StringTok{ }\KeywordTok{sapply}\NormalTok{(as.numeric) }\OperatorTok{%>%}\StringTok{ }\NormalTok{data.frame}
\NormalTok{l_glm_}\DecValTok{2000}\NormalTok{_numeric <-}\StringTok{ }\KeywordTok{glm}\NormalTok{(rep_pres_intent }\OperatorTok{~}\StringTok{ }\NormalTok{ideo7 }\OperatorTok{+}\StringTok{ }\NormalTok{black }\OperatorTok{+}\StringTok{ }\NormalTok{female }\OperatorTok{+}\StringTok{ }\NormalTok{presapprov }\OperatorTok{+}\StringTok{ }\NormalTok{age }\OperatorTok{+}\StringTok{ }
\StringTok{                }\NormalTok{educ1 }\OperatorTok{+}\StringTok{ }\NormalTok{urban }\OperatorTok{+}\StringTok{ }\NormalTok{income }\OperatorTok{+}\StringTok{ }\NormalTok{union }\OperatorTok{+}\StringTok{ }\NormalTok{perfin1, }
              \DataTypeTok{data =}\NormalTok{ nes_}\DecValTok{2000}\NormalTok{_numeric, }\DataTypeTok{family=}\NormalTok{binomial)}
\end{Highlighting}
\end{Shaded}

\hypertarget{e-numeric-fitted-assessment}{%
\paragraph{(e) numeric, fitted
assessment}\label{e-numeric-fitted-assessment}}

Again, this model looks a bit worse than the non-linear transformation
of factor variables. We see at differences in education levels are not
well captured, and maybe a bit suboptial fit in the linearized
ideological variable (via the marginal plot). Interestly, the binned
residuals look like a better fit (with only the most extreme bin for
Republican voting to be highly underestimated).

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{binnedplot}\NormalTok{(}\KeywordTok{predict}\NormalTok{(l_glm_}\DecValTok{2000}\NormalTok{_numeric), }\KeywordTok{resid}\NormalTok{(l_glm_}\DecValTok{2000}\NormalTok{_numeric))}
\end{Highlighting}
\end{Shaded}

\includegraphics{hw08_solution_draft_files/figure-latex/unnamed-chunk-34-1.pdf}

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{plot}\NormalTok{(}\KeywordTok{simulateResiduals}\NormalTok{(l_glm_}\DecValTok{2000}\NormalTok{_numeric))}
\end{Highlighting}
\end{Shaded}

\includegraphics{hw08_solution_draft_files/figure-latex/unnamed-chunk-34-2.pdf}

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{mmplot}\NormalTok{(l_glm_}\DecValTok{2000}\NormalTok{_numeric,}\DataTypeTok{exclude =} \KeywordTok{c}\NormalTok{(}\DecValTok{2}\NormalTok{,}\DecValTok{3}\NormalTok{,}\DecValTok{4}\NormalTok{,}\DecValTok{7}\NormalTok{,}\DecValTok{9}\NormalTok{,}\DecValTok{10}\NormalTok{))}
\end{Highlighting}
\end{Shaded}

\includegraphics{hw08_solution_draft_files/figure-latex/unnamed-chunk-34-3.pdf}

\hypertarget{e-numeric-model-interpretation}{%
\paragraph{(e) numeric, model
interpretation}\label{e-numeric-model-interpretation}}

The TA leaves this up to the student to interpret, but we note that
ideology of the individual is now significant, and urban is no longer
significant. Additionally similar comments as in (d) relate to the
linearized and factor based models.

\begin{Shaded}
\begin{Highlighting}[]
\KeywordTok{summary}\NormalTok{(l_glm_}\DecValTok{2000}\NormalTok{_numeric)}
\end{Highlighting}
\end{Shaded}

\begin{verbatim}
## 
## Call:
## glm(formula = rep_pres_intent ~ ideo7 + black + female + presapprov + 
##     age + educ1 + urban + income + union + perfin1, family = binomial, 
##     data = nes_2000_numeric)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.2661  -0.6780  -0.3307   0.5783   2.3440  
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -11.96238    2.55218  -4.687 2.77e-06 ***
## ideo7         0.56281    0.13832   4.069 4.72e-05 ***
## black        -1.28042    0.63813  -2.007  0.04480 *  
## female       -0.43189    0.35270  -1.225  0.22075    
## presapprov    2.42242    0.39637   6.112 9.87e-10 ***
## age          -0.02921    0.01088  -2.684  0.00727 ** 
## educ1         0.14627    0.22337   0.655  0.51258    
## urban         0.39483    0.23649   1.670  0.09501 .  
## income        0.11936    0.18156   0.657  0.51092    
## union         0.45653    0.49674   0.919  0.35807    
## perfin1       0.43815    0.27943   1.568  0.11688    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 350.34  on 256  degrees of freedom
## Residual deviance: 223.97  on 246  degrees of freedom
##   (1201 observations deleted due to missingness)
## AIC: 245.97
## 
## Number of Fisher Scoring iterations: 5
\end{verbatim}

\hypertarget{f}{%
\subsection{(f)}\label{f}}

This exercise suggests that different voter characteristics effected
voter decisions across the years (although some like previous president
approval\footnote{With the party in power flip.} and race seem pretty
constant). Additionally, ideology seems to have some impact (but maybe
not linear in all cases). Interestingly, the model fit on the 2000 data
seems to better conform with the linear model assumptions. The
differences between the models fit on the different years relate to the
impact of education level (significant for 1976 but not 2000) and urban
vs suburban (significant for 2000 but not 1976). As captured in the
discussion about interested 1976 trend for ideology, we should make sure
\textbf{not} to claim causal structure related for voter preferences.

\end{document}
