\documentclass[12pt]{article}

%\VignettePackage{doBy}
%\VignetteIndexEntry{doBy: LSmeans and other linear estimates}
%\VignetteIndexEntry{LSMEANS}
%\VignetteIndexEntry{contrasts}
%\VignetteIndexEntry{estimable functions}

\usepackage{hyperref}

\usepackage{url,a4}
\usepackage{boxedminipage,color}
\usepackage[utf8]{inputenc}

\usepackage[inline,nomargin,draft]{fixme}
\newcommand\FXInline[2]{\textbf{\color{blue}#1}:
  \emph{\color{blue} - #2}}

\usepackage[cm]{fullpage}

\usepackage[authoryear,round]{natbib}
\bibliographystyle{plainnat}

\RequirePackage{color,fancyvrb,amsmath,amsfonts}

\usepackage{framed}
\usepackage{comment}
\definecolor{shadecolor}{gray}{0.91}

\def\R{\texttt{R}}
\def\pkg#1{{\bf #1}}
\def\doby{\pkg{doBy}}

\def\code#1{\texttt{#1}}
\def\cc#1{\texttt{#1}}

\def\esticon{\code{esticon()}}
\def\lsmeans{\code{LSmeans}}
\def\linmat{\code{LSmatrix()}}
\def\linest{\code{linest()}}


\DeclareMathOperator{\EE}{\mathbb{E}}
\DeclareMathOperator{\var}{\mathbb{V}ar}
\DeclareMathOperator{\cov}{\mathbb{C}ov}
\DeclareMathOperator{\norm}{N}
\DeclareMathOperator{\spanx}{span}
\DeclareMathOperator{\corr}{Corr}
\DeclareMathOperator{\deter}{det}
\DeclareMathOperator{\trace}{tr}
\def\inv{^{-1}}
\newcommand{\transp}{^{\top}}

<<echo=FALSE,print=FALSE>>=
require( doBy )
prettyVersion <- packageDescription("doBy")$Version
prettyDate <- format(Sys.Date())
@

\SweaveOpts{keep.source=T,prefix.string=figures/LSmeans}

\title{LS--means (least--squares means) and other linear estimates}
\author{S{\o}ren H{\o}jsgaard and Ulrich Halekoh}
\date{\pkg{doBy} version \Sexpr{prettyVersion} as of \Sexpr{prettyDate}}

\begin{document}

\definecolor{darkred}{rgb}{.7,0,0}
\definecolor{midnightblue}{rgb}{0.098,0.098,0.439}

\DefineVerbatimEnvironment{Sinput}{Verbatim}{
  fontfamily=tt,
  %%fontseries=b,
  %% xleftmargin=2em,
  formatcom={\color{midnightblue}}
}
\DefineVerbatimEnvironment{Soutput}{Verbatim}{
  fontfamily=tt,
  %%fontseries=b,
  %% xleftmargin=2em,
  formatcom={\color{blue}}
}
\DefineVerbatimEnvironment{Scode}{Verbatim}{
  fontfamily=tt,
  %%fontseries=b,
  %% xleftmargin=2em,
  formatcom={\color{blue}}
}

\fvset{listparameters={\setlength{\topsep}{-2pt}}}
\renewenvironment{Schunk}{\linespread{.90}}{}

%%\renewenvironment{Schunk}{\begin{shaded}\small}{\end{shaded}}
@
<<echo=F>>=
options("width"=90, "digits"=3)
@ %def

\maketitle
\hrule
\tableofcontents

\parindent0pt
\parskip5pt

@
<<echo=FALSE>>=
dir.create("figures")
oopt <- options()
options("digits"=4, "width"=80, "prompt"="> ", "continue"="  ")
##options(useFancyQuotes="UTF-8")
@ %def


%\tableofcontents
\setkeys{Gin}{height=3.5in, width=3.5in}



%% \begin{quote}
%%   This is a draft; please feel free to suggest improvements.
%% \end{quote}

\section{Introduction}
\label{sec:introduction}


\subsection{Linear functions of parameters, contrasts}
\label{sec:line-funct-param}


A linear function of a $p$--dimensional parameter vector $\beta$ has
the form
\begin{displaymath}
  C=K\beta
\end{displaymath}
where $K$ is a $q\times p$ matrix. The corresponding
linear estimate is $\hat C = K \hat \beta$.
A linear hypothesis has the form
$H_0: K\beta=m$ for some $q$ dimensional vector $m$.

\subsection{Least-squares means (LS--means)}
\label{sec:least-squares-means}


A special type of linear estimates is the so called least--squares
means (or LS--means). Other names for these estimates include
population means and marginal means. Consider an imaginary field
experiment analyzed with model of the form
@
<<eval=F>>=
lm( y ~ treat + block + year)
@ %def
where \cc{treat} is a treatment factor, \cc{block} is a blocking
factor and \cc{year} is the year (a factor) where the experiment is
repeated over several years. This model specifies the conditional mean
$\EE(Y|\cc{treat}, \cc{block},\cc{year})$. One may be interested in
predictions of the
form $\EE(Y|\cc{treat})$. This quantity can not formally be found from the
model. However, it is tempting to average the fitted values of
$\EE(Y|\cc{treat}, \cc{block},\cc{year})$ across the levels of
\cc{block} and \cc{year} and think of this average as
$\EE(Y|\cc{treat})$. This average is precisely what is called the
LS--means. If the experiment is balanced then this average is
identical to the average of the observations when stratified according
to \cc{treat}.

An alternative is to think of \cc{block} and \cc{year} as random
effects, for example:
@
<<eval=F>>=
library(lme4)
lmer( y ~ treat + (1|block) + (1|year))
@ %def

In this case one would directly obtain $\EE(Y|\cc{treat})$ from the
model. However, there are at least two reasons why one may be hesitant
to consider such a random effects model.
\begin{itemize}
\item Suppose there are three
blocks and the experiment is repeated over three consecutive
years. This means that the random effects are likely to be estimated
with a large uncertainty (the estimates will have only two degrees of
freedom).
\item Furthermore, treating \cc{block} and \cc{year} as random
effects means they should in principle come from a large population of
possible blocks and years. This may or may not be reasonable for the
blocks, but it is certainly a dubious assumption for the years.
\end{itemize}

Below we describe \lsmeans\ as implemented in
the \doby\ package. Notice that the \pkg{lsmeans} package
\cite{Lenth:2013} also provides computations of LS--means, see
\url{http://cran.r-project.org/web/packages/lsmeans/}.





\section{LS--means for linear models}
\label{sec:linear-model}


\subsection{LS--means -- a first example}
\label{sec:ls-means-population}

@
<<echo=F>>=
simdat<-structure(list(treat = structure(c(1L, 1L, 1L, 2L, 1L, 2L, 2L, 2L
), .Label = c("t1", "t2"), class = "factor"), year = structure(c(1L,
1L, 1L, 1L, 2L, 2L, 2L, 2L), .Label = c("1", "2"), class = "factor"),
    y = c(0.5, 1, 1.5, 3, 3, 4.5, 5, 5.5)), .Names = c("treat", "year",
"y"), row.names = c(NA, -8L), class = "data.frame")
@ %def
@

Consider these simulated data
<<>>=
simdat
@ %def
shown in the figure below.
@
<<simdat-fig,fig=T,include=F,height=3, width=6>>=
library(ggplot2)
qplot(treat, y, data=simdat, color=year, size=I(3))
@ %def
\includegraphics[height=6cm,width=12cm]{figures/LSmeans-simdat-fig}

The LS--means under an additive model for the factor \cc{treat} is
@
<<>>=
msim <- lm(y ~ treat + year, data=simdat)
LSmeans( msim, effect="treat")
@ %def
whereas the population means are
@
<<>>=
summaryBy(y~treat, data=simdat)
@ %def
Had data been balanced (same number of observations for each
combination of \cc{treat} and \cc{year}) the results would have been the
same. An argument in favor of the LS--means is that these figures
better represent what one would expect on in an ``average year''.


\subsection{Example: Warpbreaks}
\label{sec:example:-warpbreaks}

@
<<>>=
summary( warpbreaks )
head( warpbreaks, 4 )
ftable(xtabs( ~ wool + tension, data=warpbreaks))
@ %def

@
<<fig=T, echo=F>>=
 opar <- par(mfrow = c(1, 2), oma = c(0, 0, 1.1, 0))
     plot(breaks ~ tension, data = warpbreaks, col = "lightgray",
          varwidth = TRUE, subset = wool == "A", main = "Wool A")
     plot(breaks ~ tension, data = warpbreaks, col = "lightgray",
          varwidth = TRUE, subset = wool == "B", main = "Wool B")
     mtext("warpbreaks data", side = 3, outer = TRUE)
     par(opar)
@ %def

@
<<>>=
(warp.lm <- lm(breaks ~ wool + tension, data=warpbreaks))
@ %def

The fitted values are:
@
<<>>=
uni <- unique(warpbreaks[,2:3])
prd <- cbind(breaks=predict(warp.lm, newdata=uni), uni); prd
@ %def

\subsection{The LS--means}
\label{sec:lsmeans}

We may be interested in making predictions of the number of breaks for
each level of \cc{tension} for \emph{any} type or an \emph{average}
type of \code{wool}.  The idea behind LS--means is
to average the predictions above over the two
wool types. These quantities are the \lsmeans\ for the effect
\cc{tension}.

This is done with:
@
<<>>=
LSmeans(warp.lm, effect="tension")
@ %def

The term \lsmeans\ comes from that these quantities are the same as
the least squares main effects of \cc{tension} when data is balanced:
@
<<>>=
doBy::summaryBy(breaks ~ tension, data=warpbreaks)
@ %def
When data is not balanced these quantities are in general not the same.




\subsection{LS--means for models with interactions}
\label{sec:models-with-inter}

Consider a model with interaction:
@
<<>>=
warp.lm2 <- update(warp.lm, .~.+wool:tension)
coef( summary( warp.lm2 ))
@ %def

In this case the contrast matrix becomes:
@
<<>>=
K2 <- LSmatrix(warp.lm2, effect="tension"); K2
linest(warp.lm2, K=K2)
@ %def













\section{Using the \code{at=} argument}
\label{sec:example:-chickweight}


@
<<chick-fig,fig=T,include=F,height=3,width=6>>=
library(ggplot2)
ChickWeight$Diet <- factor(ChickWeight$Diet)
qplot(Time, weight, data=ChickWeight, colour=Chick, facets=~Diet,
      geom=c("point","line"))
@ %def
\includegraphics[height=6cm,width=12cm]{figures/LSmeans-chick-fig}

Consider random regression model:
@
<<>>=
library(lme4)
rr <- lmer(weight~Time*Diet + (0+Time|Chick), data=ChickWeight)
coef(summary(rr))
@ %def


The contrast matrix for \cc{Diet} becomes:
@
<<>>=
LSmatrix(rr, effect="Diet")
@ %def

The value of \cc{Time} is by default taken to be the average of that
variable. Hence the \lsmeans\ is the predicted weight for each diet at
that specific point of time. We can consider other points of time with
@
<<>>=
K1 <- LSmatrix(rr, effect="Diet", at=list(Time=1)); K1
@ %def

The \lsmeans\ for the intercepts is the predictions at
\cc{Time=0}. The \lsmeans\ for the slopes becomes
@
<<>>=
K0 <- LSmatrix(rr, effect="Diet", at=list(Time=0))
K1-K0
LSmeans(rr, K=K1-K0)
@ %def

We can cook up our own function for comparing trends:
@
<<>>=
LSmeans_trend <- function(object, effect, trend){

    K<-LSmatrix(object, effect=effect, at=as.list(setNames(1, trend))) -
        LSmatrix(object, effect=effect, at=as.list(setNames(0, trend)))
    LSmeans(object, K=K)
}
LSmeans_trend(rr, effect="Diet", trend="Time")
@ %def

\section{Using (transformed) covariates}
\label{sec:using-covariates}

Consider the following subset of the \code{CO2} dataset:
@
<<>>=
data(CO2)
CO2 <- transform(CO2, Treat=Treatment, Treatment=NULL)
levels(CO2$Treat) <- c("nchil","chil")
levels(CO2$Type) <- c("Que","Mis")
ftable(xtabs( ~ Plant + Type + Treat, data=CO2), col.vars=2:3)
@ %def

@
<<co2-fig,fig=T,include=F, height=3,width=6>>=
qplot(x=log(conc), y=uptake, data=CO2, color=Treat, facets=~Type, size=I(3))
@ %def
\includegraphics[height=6cm,width=12cm]{figures/LSmeans-co2-fig}

Below, the covariate \code{conc} is fixed at the average value:
@
<<>>=
co2.lm1 <- lm(uptake ~ conc + Type + Treat, data=CO2)
LSmeans(co2.lm1, effect="Treat")
@ %def

If we use \code{log(conc)} instead we will get an error when
calculating LS--means:
@
<<eval=F>>=
co2.lm <- lm(uptake ~ log(conc) + Type + Treat, data=CO2)
LSmeans(co2.lm, effect="Treat")
@ %def

In this case one can do
@
<<>>=
co2.lm2 <- lm(uptake ~ log.conc + Type + Treat,
             data=transform(CO2, log.conc=log(conc)))
LSmeans(co2.lm2, effect="Treat")
@ %def
This also highlights what is computed: The average of the log of
\code{conc}; not the log of the average of \code{conc}.

In a similar spirit consider
@
<<>>=
co2.lm3 <- lm(uptake ~ conc + I(conc^2) + Type + Treat, data=CO2)
LSmeans(co2.lm3, effect="Treat")
@ %def

Above \verb'I(conc^2)' is the average of the squared values of
\code{conc}; not the  square of the average of
\code{conc}, cfr.\ the following.

@
<<>>=
co2.lm4 <- lm(uptake ~ conc + conc2 + Type + Treat, data=
              transform(CO2, conc2=conc^2))
LSmeans(co2.lm4, effect="Treat")
@ %def

If we want to evaluate the LS--means at \code{conc=10} then we can do:
@
<<>>=
LSmeans(co2.lm4, effect="Treat", at=list(conc=10, conc2=100))
@ %def




\section{Alternative models}
\label{sec:alternative-models}

\subsection{Generalized linear models}
\label{sec:gener-line-models}

We can calculate LS--means for e.g.\ a Poisson or a gamma model. Default is that
the calculation is calculated on the scale of the linear
predictor. However, if
we think of LS--means as a prediction on the linear scale one may
argue that it can also make sense to transform this prediction to
the response scale:
@
<<>>=
warp.poi <- glm(breaks ~ wool + tension, family=poisson, data=warpbreaks)
LSmeans(warp.poi, effect="tension", type="link")
LSmeans(warp.poi, effect="tension", type="response")
@ %def

%% SANITY CHECK
%% @
%% <<>>=
%% K <- LSmatrix(warp.poi, effect="tension")
%% doBy::esticon(warp.poi, K)
%% @ %def

@
<<>>=
warp.qpoi <- glm(breaks ~ wool + tension, family=quasipoisson, data=warpbreaks)
LSmeans(warp.qpoi, effect="tension", type="link")
LSmeans(warp.qpoi, effect="tension", type="response")
@ %def


For comparison with the linear model, we use identity link
@
<<echo=F,results=hide>>=
warp.poi2 <- glm(breaks ~ wool + tension, family=poisson(link=identity),
                 data=warpbreaks)
LSmeans(warp.poi2, effect="tension", type="link")
@ %def



%% SANITY CHECK
%% @
%% <<>>=
%% K <- LSmatrix(warp.poi2, effect="tension")
%% doBy::esticon(warp.poi2, K)
%% @ %def


@
<<>>=
warp.gam <- glm(breaks ~ wool + tension, family=Gamma(link=identity),
                 data=warpbreaks)
LSmeans(warp.gam, effect="tension", type="link")
@ %def

%% SANITY CHECK
%% @
%% <<>>=
%% K <- LSmatrix(warp.gam, effect="tension")
%% doBy::esticon(warp.gam, K)
%% @ %def




Notice that the linear estimates are practically the same as for the
linear model, but the standard errors are smaller and hence the
confidence intervals are narrower.

An alternative is to fit a quasi Poisson ``model''

@
<<>>=
warp.poi3 <- glm(breaks ~ wool + tension, family=quasipoisson(link=identity),
                 data=warpbreaks)
LSmeans(warp.poi3, effect="tension")
@ def

\subsection{Linear mixed effects model}
\label{sec:linear-mixed-effects}

For the sake of illustration we treat \cc{wool} as a random effect:
@
<<>>=
library(lme4)
warp.mm <- lmer(breaks ~ tension + (1|wool), data=warpbreaks)
LSmeans(warp.mm, effect="tension")
@ %def

Notice here that the estimates themselves are very similar to those
above but the standard errors are much larger. This comes from that
there that \code{wool} is treated as a random effect.

@
<<>>=
VarCorr(warp.mm)
@ %def

Notice that the degrees of freedom by default are adjusted using a
Kenward--Roger approximation (provided that \pkg{pbkrtest} is
installed). Unadjusted degrees of freedom are obtained with
@
<<>>=
LSmeans(warp.mm, effect="tension", adjust.df=FALSE)
@ %def

\subsection{Generalized estimating equations}
\label{sec:gener-estim-equat}

Lastly, for gee-type ``models'' we get
@
<<>>=
library(geepack)
warp.gee <- geeglm(breaks ~ tension, id=wool, family=poisson, data=warpbreaks)
LSmeans(warp.gee, effect="tension")
LSmeans(warp.gee, effect="tension", type="response")
@ %def

\section{Miscellaneous}
\label{sec:miscellaneous}

\subsection{Under the hood}
\label{sec:under-hood}

Under the hood, \cc{LSmeans()} generates a contrast matrix
@
<<>>=
K <- LSmatrix(warp.lm, effect="tension"); K
@ %def
and passes this matrix onto \linest:
@
<<>>=
linest( warp.lm, K=K )
@ %def

\subsection{Example: Non--estimable contrasts}
\label{sec:exampl-non-estim}

@
<<echo=FALSE>>=
## Make balanced dataset
dat.bal <- expand.grid(list(AA=factor(1:2), BB=factor(1:3), CC=factor(1:3)))
dat.bal$y <- rnorm(nrow(dat.bal))

## Make unbalanced dataset:  'BB' is nested within 'CC' so BB=1
## is only found when CC=1 and BB=2,3 are found in each CC=2,3,4
dat.nst <- dat.bal
dat.nst$CC <-factor(c(1,1,2,2,2,2,1,1,3,3,3,3,1,1,4,4,4,4))
@ %def


Consider this highly unbalanced simulated dataset:
@
<<>>=
head(dat.nst)
ftable(xtabs( ~ AA + BB + CC, data=dat.nst))
@ %def

We have
@
<<>>=
mod.nst  <- lm(y ~ AA + BB : CC, data=dat.nst)
coef( mod.nst )
@ %def


In this case some of the \lsmeans\ values are not estimable (see
Section~\ref{sec:handl-non-estim} for details):
@
<<>>=
LSmeans(mod.nst, effect=c("BB", "CC"))
@ %def


\subsection{Handling non--estimability}
\label{sec:handl-non-estim}

The model matrix for the model in Section~\ref{sec:exampl-non-estim}
does not have full column rank and therefore not all values are
calculated by \cc{LSmeans()}.

@
<<>>=
X <- model.matrix( mod.nst ); as(X,"Matrix")
@ %def

We consider a linear normal model, i.e.\
an $n$ dimensional random vector $y=(y_i)$ for which
$\EE(y)=\mu=X\beta$ and $\cov(y)=\sigma^2I$ where $X$ does not have
full column rank
We are
interested in linear functions of $\beta$, say
\begin{displaymath}
  c=k\transp\beta= \sum_j k_j \beta_j .
\end{displaymath}

@
<<>>=
K <- LSmatrix(mod.nst, effect="BB", at=list(CC=2));K
LSmeans(mod.nst, K=K)
@ %def

A least squares estimate of $\beta$ is
\begin{displaymath}
  \hat \beta = G X\transp y
\end{displaymath}
where $G$ is a generalized inverse of $X\transp  X$. Since the
generalized inverse is not unique then neither is the estimate
$\hat\beta$. One least squares estimate of $\beta$ is
@
<<>>=
XtXinv <- MASS::ginv(t(X)%*%X)
bhat <- as.numeric(XtXinv %*% t(X) %*% dat.nst$y)
zapsmall(bhat)
@ %def

Hence $\hat c = k\transp\hat \beta$ is in general not
unique.
@
<<>>=
K %*% bhat
@ %def

However, for some values of $k$, the estimate $\hat c$ is
unique (i.e.\ it does not depend on the choice of generalized
inverse). Such linear functions are said to be estimable and can be
described as follows:

All we specify with $\mu=X\beta$ is that $\mu$ is a vector in the
linear subspace $L=C(X)$ where $C(X)$ denotes the column space of
$X$.
We can only learn about $\beta$ through $X\beta$ so the only thing we can
say something about is linear combinations $\rho\transp X\beta$. Hence
we can only say something about $k\transp\beta$ if there exists
$\rho$ such that $k\transp\beta=\rho\transp X \beta$, i.e., if
$k=X\transp\rho$, that is, if $k$ is in the column space
$C(X\transp)$ of $X\transp$. That is, if $k$ is perpendicular to
all vectors in the null space $N(X)$ of $X$. To check
this, we find a basis $B$ for $N(X)$. This can be done in many ways,
for example via a singular value decomposition of $X$, i.e.\
\begin{displaymath}
  X = U D V\transp
\end{displaymath}
A basis for $N(X)$ is given by those columns of $V$ that corresponds
to zeros on the diagonal of $D$.

@
<<>>=
S<-svd(X)
names(S)
@ %def

@
<<>>=
B<-S$v[, S$d<1e-10, drop=FALSE ]; zapsmall(B) ## Basis for N(X)
zapsmall( rowSums(K%*%B) )
@ %def



\subsection{Pairwise comparisons}
\label{sec:pairwise-comparisons}

We will just mention that for certain other linear estimates, the
matrix $K$ can be generated automatically using \cc{glht()} from the
\pkg{multcomp} package. For example, pairwise comparisons of all
levels of \code{tension} can be obtained with

@
<<>>=
library("multcomp")
g1 <- glht(warp.lm, mcp(tension="Tukey"))
summary( g1 )
@ %def

The $K$ matrix generated in this case is:
@
<<>>=
K1 <- g1$linfct; K1
@ %def


\bibliography{doBy}


\end{document}



