\documentclass[12pt]{article}
\usepackage{verbatim, amssymb, amsmath, float, fullpage}
\begin{document}
\title{36-303 Sampling, Surveys \& Society \\ Homework 03 Solutions}
\maketitle
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%  PROB1  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Question 1 (Groves Ch.4 \#8)}
\subsection{(a)}
\begin{eqnarray}
\bar y_{\mbox{uw}} &=& \frac{\sum_h \bar y_h}{3}\\
&=&  \frac{6+5 +8}{3}=6.333
\end{eqnarray}

\subsection{(b)}
\begin{eqnarray}
\bar y_{\mbox{st}} &=& \sum_h W_h \bar y_h\\
&=& 0.4\times 6 + 0.5 \times 5 + 0.1 \times 8 = 5.7
\end{eqnarray}

\subsection{(c)}
\begin{eqnarray}
V[\bar y_{st}] &=& \sum_h W_h^2\left( \frac{1-f_h}{n_h}\right)S_h^2\\
&=& 0.4^2 \left( \frac{1-0.06}{192}\right)5 + 0.5^2 \left( \frac{1-0.06}{240}\right)4 + 0.1^2 \left( \frac{1-0.06}{48}\right)7\\
&=& 0.00920
\end{eqnarray}
A 95\% confidence interval can be constructed as 
\begin{eqnarray}
CI_{95 \%} &=& \bar y_{st} \pm 1.96 \sqrt{V[\bar y_{st}]}\\
&=& 5.7 \pm 1.96\times 0.096\\
&=& 5.7 \pm 0.188\\
&=& [5.5,5.9]
\end{eqnarray}

\section {Question 2 (Groves Ch.6 \#2)}
We evaluate the non-response error as the difference between the statistic that you {\it would have obtained} had everybody answered and the statistic computed from the incomplete (due to non-response) data. Usually this evaluation is not possible because we don't know the answers from the non-respondents, but in this case that information is given to us ``from external sources".\\

Let's compute the expected total number of schools in the {\it original} sample that offer sex ed. 
\begin{itemize}
\item Majority CRG
\begin{eqnarray}
5\% \times 250 + 0\% \times (500-250) = 12.5
\end{eqnarray}
\item Minority CRG
\begin{eqnarray}
50 \% \times 600 + 35\% \times (1000-600) = 440
\end{eqnarray}
\end{itemize}

Therefore the percentage of schools {\it the original sample} offering sex. ed. is $(440 + 12.5)/1500 \times 100\%= 30.2\%$. Comparing with the percentage computed using only the respondents, $36.8\%$, we get a non-response error of $36.8\% - 30.2\% = 6.6\%$.\\

A caution note: The text of the question says that this was a SRS. However, the ``beautiful'' numbers  1000 and 500, that supposedly were obtained by chance alone, should call to suspicion and make the analyst wonder if they are a product of a designed stratified sample. Of course, this is a textbook exercise and we know that the numbers are tweaked so they are nice and round, but in real life we should double check with the data producer or pay closer attention to the survey design documentation.  

\section{Question 3 (Groves Ch.6 \# 9)}
\subsection{(a)}
(These are just examples, any reasonable answer will be considered correct.)
\begin{enumerate}
\item Pre notifications
\item Incentives
\item Reducing the length of the questionnaire

\end{enumerate}

\subsection{(b)}
As an example, the incentives method might not be effective with highly affluent people, whom might evaluate that their opportunity cost is much higher than any reasonable incentive that the survey administrator could offer. 
\section{Question 4 (Groves Ch. 10 \#3)}
Inputing the data into R:
\begin{verbatim}
BW <- c(4.4, 4.2, 2.4, 3, 2, 2.4, 2.6, 3, 3, 1.1, 1.3, 1.2, 1.4, 1.5, 
1.1, 1.4, 1.8, 1.1, 1.1, 1)
Gender <- c(rep('M',6) ,rep('F',14))
Age <- c(24, 37, 66, 57, 23, 26, 28, 32, 39, 40, 41, 47, 43, 48, 53, 
38, 63, 68, 73, 78)
NCC <- c(0, 1, 2, 3, 2, 0, 1, 1, 0, 1, 0, 2, 1, 1, 3, 3, 4, 1, 2, 3)
dat <- data.frame(BW = BW, Gender = factor(Gender), Age= Age, 
     NCC = NCC, Wg = NA, nh =NA, PSW =NA)
n <- 20
\end{verbatim}
\subsection{(a)}
Unweighted mean:
\begin{verbatim}
> mean(dat$NCC)
[1] 1.55
\end{verbatim}

Weighted mean:
\begin{verbatim}
> weighted.mean(dat$NCC, w=dat$BW)
[1] 1.341463
\end{verbatim}
\subsection{b)}
We first input the population proportions for each post stratum
\begin{verbatim}
dat$Wg[dat$Gender=='M' & dat$Age<40] <- 0.22
dat$Wg[dat$Gender=='M' & dat$Age>=40] <- 0.24
dat$Wg[dat$Gender=='F' & dat$Age<40] <- 0.22
dat$Wg[dat$Gender=='F' & dat$Age>=40] <- 0.32
\end{verbatim}

then compute the number of samples in each poststratum
\begin{verbatim}
dat$nh[dat$Gender=='M' & dat$Age<40] <- NROW(dat$nh[dat$Gender=='M' & dat$Age<40])
dat$nh[dat$Gender=='M' & dat$Age>=40] <- NROW(dat$nh[dat$Gender=='M' & dat$Age>=40])
dat$nh[dat$Gender=='F' & dat$Age<40] <- NROW(dat$nh[dat$Gender=='F' & dat$Age<40])
dat$nh[dat$Gender=='F' & dat$Age>=40] <- NROW(dat$nh[dat$Gender=='F' & dat$Age>=40])
\end{verbatim}
And finally compute the post stratification weights:
\begin{verbatim}
dat$PSW <- (dat$Wg) / (dat$nh/n)
\end{verbatim}
The base weights, Post stratification weights and final composite weights are
\begin{verbatim}
> cbind(dat[c('BW', 'PSW')], dat$BW*dat$PSW)
    BW  PSW dat$BW * dat$PSW
1  4.4 1.10            4.840
2  4.2 1.10            4.620
3  2.4 2.40            5.760
4  3.0 2.40            7.200
5  2.0 1.10            2.200
6  2.4 1.10            2.640
7  2.6 1.10            2.860
8  3.0 1.10            3.300
9  3.0 1.10            3.300
10 1.1 0.64            0.704
11 1.3 0.64            0.832
12 1.2 0.64            0.768
13 1.4 0.64            0.896
14 1.5 0.64            0.960
15 1.1 0.64            0.704
16 1.4 1.10            1.540
17 1.8 0.64            1.152
18 1.1 0.64            0.704
19 1.1 0.64            0.704
20 1.0 0.64            0.640
\end{verbatim}

The mean computed with these weights is
\begin{verbatim}
> weighted.mean(dat$NCC, w = dat$BW*dat$PSW)
[1] 1.462913
\end{verbatim}
\end{document}

