\documentclass[a4paper]{article}
\usepackage{hyperref, graphicx, color, alltt, a4wide}
\usepackage{Sweave}
\usepackage[round]{natbib}
\definecolor{Red}{rgb}{0.7,0,0}
\definecolor{Blue}{rgb}{0,0,0.8}
\definecolor{hellgrau}{rgb}{0.55,0.55,0.55}
\newcommand{\pkg}[1]{{\normalfont\fontseries{b}\selectfont #1}}
\newcommand{\code}[1]{\texttt{#1}}
\newcommand{\class}[1]{\textsf{#1}}
\newenvironment{smallexample}{\begin{alltt}}{\end{alltt}}
\newcommand{\var}[1]{\textit{\texttt{#1}}}
\newcommand{\email}[1]{\href{mailto:#1}{\normalfont\texttt{#1}}}
\newcommand{\data}[1]{`\texttt{#1}'}

%% \code without `-' ligatures
\def\nohyphenation{\hyphenchar\font=-1 \aftergroup\restorehyphenation}
\def\restorehyphenation{\hyphenchar\font=`-}
{\catcode`\-=\active%
  \global\def\code{\bgroup%
    \catcode`\-=\active \let-\codedash%
    \Rd@code}}
\def\codedash{-\discretionary{}{}{}}
\def\Rd@code#1{\texttt{\nohyphenation#1}\egroup}

\newcommand{\codefun}[1]{\code{#1()}}

\begin{document}

%\VignetteIndexEntry{Colors and Residual-based Shadings in the Strucplot Framework}
%\VignetteDepends{vcd}
%\VignetteKeywords{graphics, categorical data}
%\VignettePackage{vcd}

\SweaveOpts{engine=R,eps=TRUE,height=6,width=7,results=hide,fig=FALSE,echo=TRUE}
\setkeys{Gin}{width=0.7\textwidth}

<<preliminaries,echo=FALSE,results=hide>>=
options(width=90)
set.seed(1071)
library(vcd)
data(Titanic)
@

\title{Colors and Residual-based Shadings in the Strucplot Framework}
\author{by David Meyer, Achim Zeileis, and Kurt Hornik}
\date{}
\maketitle
\sloppy

\section{Introduction}

Unlike other graphics functions in base {\sf R}, the strucplot framework 
allows almost full control over the graphical parameters of all plot elements. In
particular, in association plots, mosaic plots, and sieve plots, 
the user can modify the graphical appearance of each tile individually. 
Built on top of this functionality, the
framework supplies a set of shading functions choosing colors
appropriate for the visualization of log-linear models.
The tiles' graphical parameters are set using the \code{gp} argument
of the functions of the strucplot framework. This argument basically expects an object
of class \class{gpar} whose components are arrays of the same shape 
(length and dimensionality) as the data table (see Section \ref{sec:gp}). 
For convenience, however, the user can also
supply a specialized graphical appearance control (``grapcon'') 
function that computes such an object given a vector of
residuals, or, alternatively, a generating function that takes
certain arguments and returns such a grapcon function (see Section
\ref{sec:shading}). We provide several shading functions, including
support for both HSV and HCL colors, and the
visualization of significance tests (see Section \ref{sec:overview}).

\section{Specifying graphical parameters of strucplot displays}
\label{sec:gp}

As an example, consider the \data{UCBAdmissions} data. 
In the table aggregated over departments, we
would like to highlight the (incidentally wrong) impression that there
were too many male students accepted compared to the presumably
discriminated female students (see Figure \ref{fig:ucb}):

<<ucb,results=verbatim>>=
(ucb <- margin.table(UCBAdmissions, 1:2))

(fill_colors <- matrix(c("dark cyan","gray","gray","dark magenta"), ncol = 2))

mosaic(ucb, gp = gpar(fill = fill_colors, col = 0))
@

\begin{figure}[h]
\begin{center}
<<ucbfig,fig=TRUE,echo=FALSE>>=
<<ucb>>
@

\caption{Mosaic plot for the \data{UCBAdmissions} data with highlighted cells.}
\label{fig:ucb}
\end{center}
\end{figure}

\noindent As the example shows, we create a fourfold table 
with appropriate colors (dark cyan for admitted male students and dark
magenta for rejected female students) and supply them to the \code{fill} component 
of the \class{gpar} object passed to the \code{gp} argument of \codefun{mosaic}. 
For visual clarity, we additionally hide the tiles' borders by setting the \code{col} 
component to 0 (white).

If the parameters specified in the \class{gpar} object are ``incomplete'',
they will be recycled along the last splitting
dimension. In the following example based on the \data{Titanic} data, 
we will highlight all cells corresponding to survived
passengers (see Figure \ref{fig:recycling}):

<<recycling>>=
mosaic(Titanic, gp = gpar(fill = c("gray","dark magenta")), 
                spacing = spacing_highlighting,
                labeling_args = list(abbreviate = c(Age = 3), rep = c(Survived = FALSE))
      )
@

\noindent Note that \codefun{spacing\_highlighting} sets the spaces
between tiles in the last dimension to 0. The \code{labeling\_args} 
argument ensures that labels do not overlap (see the separate
vignette: ``Labeling in the Strucplot Framework'' for more information).


\begin{figure}[h]
\begin{center}
<<recyclingfig,fig=TRUE,echo=FALSE>>=
<<recycling>>
@
\caption{Recycling of parameters, used for highlighting the survived
  passengers in the \data{Titanic} data.}
\label{fig:recycling}
\end{center}
\end{figure}

\section{Customizing residual-based shadings}
\label{sec:shading}

This flexible way of specifying graphical parameters is the basis for a suite of
shading functions that modify the tiles' appearance with respect to a vector of 
residuals, resulting from deviations of observed from expected
values under a given log-linear model. 
The idea is to visualize at least sign and absolute size of the residuals, but some
shadings, additionally, indicate overall significance. One particular
shading, the maximum shading, even allows to identify those cells that
cause the rejection of the null hypothesis.

Conceptually, the strucplot framework offers three alternatives to
add residual-based shading to plots:

\begin{enumerate}
\item Precomputing the graphical parameters (e.g., fill colors),
  encapsulating them into an object of class
  \class{gpar} as demonstrated in the previous section, and
  passing this object to the \code{gp} argument.
\item Providing a grapcon function to the \code{gp} argument that 
  takes residuals as input and returns an object as described in
  alternative 1.
 \item Providing a grapcon \emph{generating} function (`grapcon generator') 
  taking parameters and returning a function as described in alternative~2.
\end{enumerate}

\noindent For each of these approaches, we will demonstrate the
necessary steps to obtain a binary shading that visualizes the sign of
the residuals by a corresponding 
fill color (for simplicity, we will treat 0 as positive).

\subsubsection*{Alternative 1: Precomputed \class{gpar} object}

The first method is precomputing the graphical parameters ``by
hand''. We will use `light blue' color for positive and `light salmon'
color for negative residuals (see Figure \ref{fig:binary}):

<<shading1,results=verbatim>>=
expected <- independence_table(ucb)
(residuals <- (ucb - expected)  / sqrt(expected))

(shading1_obj <- ifelse(residuals > 0, "lightblue", "lightsalmon"))

mosaic(ucb, gp = gpar(fill = shading1_obj))
@ 

\begin{figure}[h]
\begin{center}
<<shading1fig,fig=TRUE,echo=FALSE>>=
<<shading1>>
@ 
\caption{Binary shading visualizing the sign of the residuals.}
\label{fig:binary}
\end{center}
\end{figure}

\subsubsection*{Alternative 2: Grapcon function}

For implementing alternative 2, we need to create a `shading function'
that computes \class{gpar} objects from
residuals. For that, we can just reuse the code from the previous step:

<<shading2>>=
shading2_fun <- function(res) gpar(fill = ifelse(res > 0, "lightblue", "lightsalmon"))
@ 

\noindent To create a mosaic display with binary shading, 
it now suffices to specify the data table along with
\codefun{shading2\_fun}:

<<shading3>>=
mosaic(ucb, gp = shading2_fun)
@ 

\noindent \codefun{mosaic} internally calls
\codefun{strucplot} which computes the residuals from the specified
independence model (total independence by default), passes them to
\codefun{shading2\_fun}, and uses the \class{gpar} object returned 
to finally create the plot.

Our \codefun{shading2\_fun} function might be useful, 
but can still be improved: the hard-wired colors should be
customizable. We cannot
simply extend the argument list to include, e.g., 
a \code{fill = c("lightblue", "lightsalmon")} argument because
\codefun{strucplot} will neither know how to handle it, nor let us
change the defaults. In fact, the interface of shading functions is fixed,
they are expected to take exactly one argument: a table of residuals. 
This is where generating functions (alternative 3) come
into play. 

\subsubsection*{Alternative 3: Grapcon generator}

We simply wrap our grapcon shading function in another 
function that takes all additional arguments it needs to use, possibly
preprocesses them, and returns the actual shading function. This returned
function will have access to the parameters since in {\sf R}, nested
functions are lexically scoped. Thus, the grapcon generator
returns (`creates') a `parameterized' shading function with the minimal standard interface
\codefun{strucplot} requires. The following example shows the necessary
extensions for our running example:

<<shading3>>=
shading3a_fun <- function(col = c("lightblue", "lightsalmon")) {
  if (length(col) != 2) stop("Need exactly two colors!")
  function(res) gpar(fill = ifelse(res > 0, col[1], col[2]))  
}
@ 

\noindent In the call to \codefun{mosaic}, using the new
\codefun{shading3a\_fun} function, we can now simply change the colors:

<<shading4>>=
mosaic(ucb, gp = shading3a_fun(c("red","blue")))
@ 

\noindent (figure not shown).  The procedure described so far is a
rather general concept, applicable to a wide family of user-level
\pkg{grid} graphics. Indeed, the customization of other components of
the strucplot framework (labeling, spacing, legend, and core functions)
follows the same idea.  Now for the shading functions, more
customization is needed. Note that \codefun{shading3a\_fun} needs to be
evaluated by the user, even if the defaults are to be used. It is a
better idea to let \codefun{strucplot} call the generating function,
which, in particular, allows the passing of arguments that are computed
by \codefun{strucplot}. Since shading functions can be used for
visualizing significance (see Section \ref{sec:overview}), it makes
sense for generating functions to have access to the model, i.e.,
observed and expected values, residuals, and degrees of freedom. For
example, the \codefun{shading\_max} generating function computes a
permutation distribution of the maximum statistic and $p$ values for
specified significance levels based on the observed table to create
data-driven cut-off points. If this was done in the shading function
itself, the permutation statistic would be recomputed every time the
shading function is called, resulting in possibly severe performance
loss and numerical inconsistencies. Therefore, generating functions for
shadings are required to take at least the parameters \code{observed},
\code{expected}, \code{residuals}, and \code{df} (these are provided by
the strucplot framework), followed by other parameters controlling the
shading appearance (to be specified by the user):

<<shading4>>=
shading3b_fun <- function(observed = NULL, residuals = NULL, expected = NULL, 
    df = NULL, col = c("lightblue", "lightsalmon")) {
  if (length(col) != 2) stop("Need exactly two colors!")
  function(res) gpar(fill = ifelse(res > 0, col[1], col[2]))  
}
class(shading3b_fun) <- "grapcon_generator"
@ 

In some sense, generating
functions for shadings are parameterized both by the user and the
strucplot framework. For shading functions that require model
information, the user-specified parameters are 
to be passed to the \code{gp\_args} argument instead, and for this to
work, the generating function needs a class attribute to be distinguishable from
the ``normal'' shading functions. For others
(like our simple \codefun{shading3b\_fun}) this is optional, but
recommended for consistency:

<<shading5>>=
mosaic(ucb, gp = shading3b_fun, gp_args = list(col = c("red","blue")))
@

\noindent The final \codefun{shading3b\_fun} pretty much resembles 
\codefun{shading\_binary}, one of the standard shading
functions provided by the \pkg{vcd} package.

\section{An overview of the shading functions in \pkg{vcd}}
\label{sec:overview}

\cite{vcd:Friendly:1994}
suggested a residual-based shading for the mosaic tiles that can also be applied
to the rectangles in association plots \citep{vcd:Meyer+Zeileis+Hornik:2003}.
Apart from \codefun{shading\_binary}, there are currently two basic
shadings available in \pkg{vcd}:
\codefun{shading\_hcl} and \codefun{shading\_hsv}, as well
as two derived functions: \codefun{shading\_Friendly} building upon
\codefun{shading\_hsv}, and \codefun{shading\_max} building upon \codefun{shading\_hcl}.
\codefun{shading\_hsv} and \codefun{shading\_hcl} provide
the same conceptual tools, but use different color spaces: the
Hue-Saturation-Value (HSV) and the Hue-Chroma-Luminance (HCL) scheme,
respectively. We will first expose the basic concept of these shading
functions using the HSV space, and
then briefly explain the differences to the HCL space \citep[a detailed
discussion can be found in][]{vcd:Zeileis+Meyer+Hornik:2005}. 
The HCL space is trickier
to use, but preferable to the HSV space from a perceptual point of view.

In the HSV space, colors are specified in three dimensions: Hue,
Saturation (`colorfulness'), and Value (`lightness', amount of gray). 
These three dimensions are used by \codefun{shading\_hsv} to visualize information 
about the residuals and the underlying independence model. The hue 
indicates the residuals' sign: by default, blue for positive, and red
for negative residuals. The saturation of a residual 
is set according to its size: high saturation for large, and low
saturation for small residuals. 
Finally, the overall lightness is used to indicate the significance of
a test statistic: light colors for significant, 
and dark colors for non-significant results. 

As an example, we will visualize the association of hair and eye
color in the \data{HairEyeColor} data set (see Figure \ref{fig:haireye})

<<haireye>>=
haireye <- margin.table(HairEyeColor, 1:2)
mosaic(haireye, gp = shading_hsv)
@

\begin{figure}[h]
\begin{center}
<<haireyefig,fig=TRUE,echo=FALSE,width=7,height=7>>=
<<haireye>>
@
\caption{Shaded residuals in the \data{HairEyeColor} data set---two cut-off points.}
\label{fig:haireye}
\end{center}
\end{figure}

\noindent Large positive residuals (greater than $4$) can be found for
brown eyes/black hair and blue eyes/blond hair, and are colored in saturated blue. 
On the other hand, there is a large negative residual
(less than $-4$) for brown eyes/blond hair, colored deep red. There are also three
medium-sized positive (negative) residuals between 2 and 4 ($-2$ and
$-4$): the colors for them are less saturated. Residuals between $-2$ and $2$ 
are shaded in white.
The heuristic for choosing the cut-off points $2$ and $4$ is that the Pearson residuals
are approximately standard normal which implies that the highlighted cells are those with
residuals \emph{individually} significant at approximately the $\alpha
= 0.05$ and $\alpha = 0.0001$ levels, respectively. These default cut-off points can
be changed to alternative values using the \code{interpolate}
argument (see Figure \ref{fig:interpolate}):

<<interpolate>>=
mosaic(haireye, gp = shading_hsv, gp_args = list(interpolate = 1:4))
@

\begin{figure}[h]
\begin{center}
<<interpolatefig,fig=TRUE,echo=FALSE,width=7,height=7>>=
<<interpolate>>
@
\caption{Shaded residuals in the \data{HairEyeColor} data set---four cut-off points.}
\label{fig:interpolate}
\end{center}
\end{figure}

\noindent The elements of the numeric vector passed to
\code{interpolate} define the knots of an interpolating step function
used to map the absolute residuals to saturation levels. 
The \code{interpolate} argument also accepts a user-defined function,
which then is called with the absolute residuals to get a vector of
cut-off points. Thus, it is possible to automatically choose the cut-off points 
in a data-driven way. For example,
one might think that the extension from four cut-off points 
to a continuous shading---visualizing the whole range of 
residuals---could be useful. We simply need a one-to-one
mapping from the residuals to the saturation values: 

<<continuous1>>=
ipol <- function(x) pmin(x/4, 1)
@

\noindent Note that this \codefun{ipol} 
function maps residuals greater than 4 to a saturation
level of 1. However, the resulting plot (Figure \ref{fig:continuous}) is 
deceiving: 

<<continuous2>>=
mosaic(HairEyeColor, gp = shading_hsv, gp_args = list(interpolate = ipol),
labeling_args = list(abbreviate = c(Sex = TRUE)))
@

\begin{figure}[p]
\begin{center}
<<continuousfig,fig=TRUE,echo=FALSE>>=
<<continuous2>>
@
\caption{The \data{HairEyeColor} data with continuous shading.}
\label{fig:continuous}
\end{center}
\end{figure} 

\noindent Too much color makes it difficult to interpret the image, and the subtle color
differences are hard to catch. Therefore, we only included shadings
with discrete cut-off points.

The third remaining dimension, the value, is used for
visualizing the significance of a test statistic. The user can either
directly specify the $p$ value, or, alternatively, a function that
computes it, to the \code{p.value} argument. Such a function must take
observed and expected values, residuals, and degrees of freedom (used
by the independence model) as arguments. 
If nothing is specified, the $p$ value is computed from 
a $\chi^2$ distribution with \code{df} degrees of
freedom. The \code{level} argument is used to specify the confidence
level:  if \code{p.value} is smaller than \code{1 - level}, light colors are used, 
otherwise dark colors are employed. 
The following example using the \data{Bundesliga} data 
shows the relationship of home goals and away
goals of Germany's premier soccer league in 1995: although there are two
``larger'' residuals (one greater than 2, one less then $-2$), the
$\chi^2$ test does not reject the null hypothesis of
independence. Consequently, the colors appear dark (see Figure \ref{fig:bundesliga}):

<<bundesliga>>=
bl <- xtabs(~ HomeGoals + AwayGoals, data = Bundesliga, subset = Year == 1995)
mosaic(bl, gp = shading_hsv)
@

\begin{figure}[p]
\begin{center}
<<bundesligafig,fig=TRUE,echo=FALSE>>=
<<bundesliga>>
@
\caption{Non-significant $\chi^2$ test using part of the \data{Bundesliga} data.}
\label{fig:bundesliga}
\end{center}
\end{figure}

A shading function building upon \codefun{shading\_hsv} is \codefun{shading\_Friendly},
implementing the shading introduced by \cite{vcd:Friendly:1994}. In addition
to the defaults of the HSV shading, it uses the border color and line type to 
redundantly code the residuals' sign. The following example again uses 
the \data{Bundesliga} data from above, this time using the Friendly 
scheme and, in addition, an alternative legend (see Figure \ref{fig:friendly}):

<<friendly>>=
mosaic(bl, gp = shading_Friendly, legend = legend_fixed, zero_size = 0)
@

\begin{figure}[h]
\begin{center}
<<friendlyfig,fig=TRUE,echo=FALSE>>=
<<friendly>>
@
\caption{The \data{Bundesliga} data for 1995 using the Friendly
  shading and a legend with fixed bins.}
\label{fig:friendly}
\end{center}
\end{figure}

\noindent (The \code{zero\_size = 0} argument removes the bullets indicating zero 
observed values. This feature is not provided
in the original {\sf SAS} implementation of the Friendly mosaic plots.)

As introduced before, the default shading scheme is not
\codefun{shading\_hsv} but \codefun{shading\_hcl} due to the better
perceptual characteristics of the HCL color space.
Figure \ref{fig:shadingHSVHCL} depicts 
the HSV space in the upper panel and the HCL space in the lower panel.
On the left (right) side, we see the color scales for red (blue)
hue, respectively. The $x$-axis represents the colorfulness, and the
$y$-axis the brightness.
The boxes represent the diverging color palettes used for the shadings.
For the HSV space, we can see that the effect of changing the 
level of brightness (`value') is not the same for different levels of 
saturation, and again not the same for the two different hues.
In fact, in the HSV space all dimensions are confounded, which 
obviously is problematic for coding information. In contrast, the HCL color
space offers perceptually uniform colors: as can be seen from the lower panel, 
the chroma is homogeneous for different levels of luminance. 
Unfortunately, this comes at the 
price of the space being irregularly shaped, making it difficult to automatically select 
diverging color palettes. The following example again 
illustrates the \data{HairEyeColor} data, this time with HCL colors 
(Figure \ref{fig:hclshading1} depicts the default palette, 
and Figure \ref{fig:hclshading2} an alternative setting):

<<auxiliary_functions,echo=FALSE,results=hide>>=
hue.slice <- function(hue, grid.n = 101, type = c("HCL", "HSV"), plot = TRUE, fixup = FALSE)
{
  type <- match.arg(type)
  if(type == "HCL") {
    chroma = seq(0, 100, length = grid.n)
    luminance = seq(0, 100, length = grid.n)
    nc <- length(chroma)
    nl <- length(luminance)
    color.slice <- outer(chroma, luminance, function(y, x) hcl(hue, x, y, fixup = fixup))
    xlab <- "chroma"
    ylab <- "luminance"
    main <- paste("hue =", round(hue, digits = 0))
  } else {
    chroma = seq(0, 1, length = grid.n)
    luminance = seq(0, 1, length = grid.n)
    nc <- length(chroma)
    nl <- length(luminance)
    color.slice <- outer(chroma, luminance, function(y, x) hsv(hue, x, y))
    xlab <- "saturation"
    ylab <- "value"
    main <- paste("hue =", round(hue, digits = 3))
  }
  if(plot) {
    plot(0.5, 0.5, xlim = range(chroma), ylim = range(luminance), type = "n", axes = FALSE,
         xlab = xlab, ylab = ylab, yaxs = "i", xaxs = "i", main = main)
    for(i in 1:(nc-1)) {
      rect(chroma[i], luminance[-nl], chroma[i] + 100/(nc-1), luminance[-1], border = color.slice[,i+1], col = color.slice[,i+1])
    }
    axis(1)
    axis(2)
    box()
  }
  colnames(color.slice) <- chroma
  rownames(color.slice) <- luminance
  attr(color.slice, "type") <- type
  class(color.slice) <- "slice"
  invisible(color.slice)
}
@

\setkeys{Gin}{width=.8\textwidth}
\begin{figure}[p]
\begin{center}
<<shading_HSV,fig=TRUE,echo=FALSE,height=7,width=8>>=
## generate colors
hue23 <- hue.slice(2/3, grid.n = 101, plot = FALSE, type = "HSV")
hue0 <- hue.slice(0, grid.n = 101, plot = FALSE, type = "HSV")
saturation <- as.numeric(colnames(hue23))
value <- as.numeric(rownames(hue23))

## select those with value >= 0.5
hue23 <- hue23[value >= .5, ]
hue0 <- hue0[value >= .5, ]
value <- value[value >= .5]
nl <- nrow(hue23)
nc <- ncol(hue23)

## plot 2 slides from HSV space
plot(0.5, 0.5, xlim = c(-1, 1), ylim = c(0, 1), type = "n", axes = FALSE,
       xlab = "", ylab = "", yaxs = "i", xaxs = "i", main = "")
for(i in 1:(nc-1)) {
  rect(saturation[i], value[-nl], saturation[i] + 1/(nc-1), value[-1], border = hue23[,i+1], col = hue23[,i+1])
}
for(i in 1:(nc-1)) {
  rect(-saturation[i], value[-nl], -(saturation[i] + 1/(nc-1)), value[-1], border = hue0[,i+1], col = hue0[,i+1])
}
axis(2, at = c(50, 75, 100)/100, labels = c(0.5, 0.75, 1))
axis(4, at = c(50, 75, 100)/100, labels = c(0.5, 0.75, 1))
axis(3, at = -4:4*.25, labels=c(4:0*.25, 1:4*.25))
mtext(c("hue = 0", "hue = 2/3"), side = 3, at = c(-.5, .5), line = 3, cex = 1.2)
mtext("saturation", side = 3, at = 0, line = 2)
mtext("value", side = 2, at = .75, line = 2)
mtext("value", side = 4, at = .75, line = 2)
lines(c(-1, 1), c(.5, .5))

## significant colors
rect(-1, 0.95, -.90, 1, col = hsv(0, 1, 1))
rect(-0.45, 0.95, -.55, 1, col = hsv(0, 0.5, 1))
rect(-.05, .95, .05, 1, col = hsv(2/3, 0, 1))
rect(0.45, 0.95, .55, 1, col = hsv(2/3, 0.5, 1))
rect(.90, .95, 1, 1, col = hsv(2/3, 1, 1))

text(-1, .33, "significant", pos = 4, cex = 1.2)
rect(-1, .20, -.80, .30, col = hsv(0, 1, 1))
rect(-.40, .20, -0.6, .30, col = hsv(0, 0.5, 1))
rect(-.20, .20, 0, .30, col = hsv(0, 0, 1))
rect(0, .20, .20, .30, col = hsv(2/3, 0, 1))
rect(0.4, .20, .60, .30, col = hsv(2/3, .5, 1))
rect(.80, .20, 1, .30, col = hsv(2/3, 1, 1))

lines(c(-.9, -.55), c(0.975, .975), lty = 2)
lines(c(-.45, -.05), c(0.975, .975), lty = 2)
lines(c(.45, .05), c(0.975, .975), lty = 2)
lines(c(.9, .55), c(0.975, .975), lty = 2)

## non-significant colors
rect(-1, 0.5, -.90, 0.55, col = hsv(0, 1, 0.5))
rect(-0.45, 0.5, -.55, 0.55, col = hsv(0, 0.5, 0.5))
rect(-.05, .5, .05, 0.55, col = hsv(2/3, 0, 0.5))
rect(0.45, 0.5, .55, 0.55, col = hsv(2/3, 0.5, 0.5))
rect(.90, .5, 1, 0.55, col = hsv(2/3, 1, 0.5))

text(-1, .13, "non-significant", pos = 4, cex = 1.2)
rect(-1, 0, -.80, .10, col = hsv(0, 1, 0.5))
rect(-.60, 0, -.4, .10, col = hsv(0, 0.5, 0.5))
rect(-.20, 0, 0, .10, col = hsv(0, 0, 0.5))
rect(0, 0, .20, .10, col = hsv(2/3, 0, 0.5))
rect(0.4, 0, .60, .1, col = hsv(2/3, .5, 0.5))
rect(.80, 0, 1, .10, col = hsv(2/3, 1, 0.5))

lines(c(-.9, -.55), c(0.525, .525), lty = 2)
lines(c(-.45, -.05), c(0.525, .525), lty = 2)
lines(c(.45, .05), c(0.525, .525), lty = 2)
lines(c(.9, .55), c(0.525, .525), lty = 2)
@ 

<<shading_HCL,fig=TRUE,echo=FALSE,height=7,width=8>>=
## generate colors
hue260 <- hue.slice(260, grid.n = 101, plot = FALSE)
hue360 <- hue.slice(360, grid.n = 101, plot = FALSE)
mychroma <- as.numeric(colnames(hue260))
luminance <- as.numeric(rownames(hue260))

## select those with lumincance >= 50
hue260 <- hue260[luminance >= 50, ]
hue360 <- hue360[luminance >= 50, ]
luminance <- luminance[luminance >= 50]
nc <- ncol(hue260)
nl <- nrow(hue260)

## plot 2 slides from HCL space
plot(0.5, 0.5, xlim = c(-100, 100), ylim = c(0, 100), type = "n", axes = FALSE,
       xlab = "", ylab = "", yaxs = "i", xaxs = "i", main = "")
for(i in 1:(nc-1)) {
  rect(mychroma[i], luminance[-nl], mychroma[i] + 100/(nc-1), luminance[-1], border = hue260[,i+1], col = hue260[,i+1])
}
for(i in 1:(nc-1)) {
  rect(-mychroma[i], luminance[-nl], -(mychroma[i] + 100/(nc-1)), luminance[-1], border = hue360[,i+1], col = hue360[,i+1])
}
axis(2, at = c(50, 70, 90, 100), labels = c(50, 70, 90, 100))
axis(4, at = c(50, 70, 90, 100), labels = c(50, 70, 90, 100))
axis(3, at = -4:4*25, labels=c(4:0*25, 1:4*25))
mtext(c("hue = 0", "hue = 260"), side = 3, at = c(-50, 50), line = 3, cex = 1.2)
mtext("chroma", side = 3, at = 0, line = 2)
mtext("luminance", side = 2, at = 75, line = 2)
mtext("luminance", side = 4, at = 75, line = 2)
lines(c(-100, 100), c(50, 50))

## significant colors
rect(-100, 47.5, -90, 52.5, col = hcl(0, 100, 50))
rect(-55, 67.5, -45, 72.5, col = hcl(0, 50, 70))
rect(-5, 95, 5, 100, col = hcl(260, 0, 100))       ## grey vs. white
rect(-5, 87.5, 5, 92.5, col = hcl(260, 0, 90))     ## grey vs. white
rect(45, 67.5, 55, 72.5, col = hcl(260, 50, 70))
rect(90, 47.5, 100, 52.5, col = hcl(260, 100, 50))

text(-100, 33, "significant", pos = 4, cex = 1.2)
rect(-100, 20, -80, 30, col = hcl(0, 100, 50))
rect(-60, 20, -40, 30, col = hcl(0, 50, 70))
rect(-20, 20, 0, 30, col = hcl(0, 0, 90))       
rect(0, 20, 20, 30, col = hcl(260, 0, 90))
#white# rect(-20, 20, 0, 30, col = hcl(0, 0, 100))
#white# rect(0, 20, 20, 30, col = hcl(260, 0, 100))
rect(40, 20, 60, 30, col = hcl(260, 50, 70))
rect(80, 20, 100, 30, col = hcl(260, 100, 50))

lines(c(-45, -5), c(72.5, 87.5), lty = 2)
lines(c(45, 5), c(72.5, 87.5), lty = 2)
lines(c(-95, -55), c(52.5, 67.5), lty = 2)
lines(c(95, 55), c(52.5, 67.5), lty = 2)

## non-significant colors
rect(-25, 47.5, -15, 52.5, col = hcl(0, 20, 50))
rect(-15, 67.5, -5, 72.5, col = hcl(0, 10, 70))
rect(5, 67.5, 15, 72.5, col = hcl(260, 10, 70))
rect(25, 47.5, 15, 52.5, col = hcl(260, 20, 50))


text(-100, 13, "non-significant", pos = 4, cex = 1.2)
rect(-60, 0, -40, 10, col = hcl(0, 20, 50))
rect(-40, 0, -20, 10, col = hcl(0, 10, 70))
rect(-20, 0, 0, 10, col = hcl(0, 0, 90))
rect(0, 0, 20, 10, col = hcl(260, 0, 90))
rect(20, 0, 40, 10, col = hcl(260, 10, 70))
rect(40, 0, 60, 10, col = hcl(260, 20, 50))

lines(c(-18.75, -11.25), c(52.5, 67.5), lty = 2)
lines(c(-8.75, -1.25), c(72.5, 87.5), lty = 2)
lines(c(18.75, 11.75), c(52.5, 67.5), lty = 2)
lines(c(8.75, 1.25), c(72.5, 87.5), lty = 2)
@ 
\caption{Residual-based shadings in HSV (upper) and HCL space (lower).}
\label{fig:shadingHSVHCL}
\end{center}
\end{figure}


<<hclshading1>>=
mosaic(haireye, gp = shading_hcl)
@ 
<<hclshading2>>=
mosaic(haireye, gp = shading_hcl, gp_args = list(h = c(130, 43), c = 100, l = c(90, 70)))
@ 

\setkeys{Gin}{width=0.7\textwidth}
\begin{figure}[p]
\begin{center}
<<hclshading1fig,fig=TRUE,echo=FALSE>>=
<<hclshading1>>
@
\caption{The \data{HairEyeColor} data, using default HCL color palette.}
\label{fig:hclshading1}
\end{center}
\end{figure}

\begin{figure}[p]
\begin{center}
<<hclshading2fig,fig=TRUE,echo=FALSE>>=
<<hclshading2>>
@
\caption{The \data{HairEyeColor} data, using a custom HCL color palette.}
\label{fig:hclshading2}
\end{center}
\end{figure}

A more `advanced' function building upon \codefun{shading\_hcl} 
is \codefun{shading\_max}, using the
maximum statistic both to conduct the independence test and to 
visualize significant \emph{cells} causing the
rejection of the independence hypothesis \citep{vcd:Meyer+Zeileis+Hornik:2003}. The
\code{level} argument of \codefun{shading\_max} 
then can be used to specify several confidence
levels from which the corresponding cut-off points are computed. 
By default, two cut-off points are computed corresponding 
to confidence levels of $90\%$ and $99\%$, respectively.
In the following example, we investigate the effect of a new treatment
for rheumatoid arthritis on a group of female patients using the
maximum shading (see Figure \ref{fig:maximum}):

<<arthritis>>=
mosaic(~ Treatment + Improved, data = Arthritis, subset = Sex == "Female",
       gp = shading_max)
@

\begin{figure}[h]
\begin{center}
<<arthritisfig,fig=TRUE,echo=FALSE>>=
<<arthritis>>
@
\caption{Significant maximum test on female patients of the \data{Arthritis}
  data.}
\label{fig:maximum}
\end{center}
\end{figure}

\noindent The maximum test is significant although the residuals are
all in the $\left[-2,2\right]$ interval.
The \codefun{shading\_hcl} function with default cut-off points would
not have shown any color. In addition, since the test statistic is the
maximum of the absolute Pearson residuals, \emph{each} colored
residual violates the null hypotheses of independence, and thus, the
`culprits' can immediately be identified.

\bibliographystyle{jss}
\bibliography{vcd}

\end{document}
