vcd/0000755000175100001440000000000012547236615011057 5ustar hornikusersvcd/inst/0000755000175100001440000000000012547003107012020 5ustar hornikusersvcd/inst/CITATION0000755000175100001440000000473712214061371013171 0ustar hornikuserscitHeader("To cite package vcd in publications use:") ## R >= 2.8.0 passes package metadata to citation(). if(!exists("meta") || is.null(meta)) meta <- packageDescription("vcd") year <- sub(".*(2[[:digit:]]{3})-.*", "\\1", meta$Date) vers <- paste("R package version", meta$Version) citEntry(entry="Manual", title = "vcd: Visualizing Categorical Data", author = personList(as.person("David Meyer"), as.person("Achim Zeileis"), as.person("Kurt Hornik")), year = year, note = vers, textVersion = paste("David Meyer, Achim Zeileis, and Kurt Hornik (", year, "). vcd: Visualizing Categorical Data. ", vers, ".", sep="")) citEntry(entry="Article", header="To cite the strucplot framework (e.g., functions mosaic(), sieve(), assoc(), strucplot(), structable(), pairs.table(), cotabplot(), doubledecker()), additionally use:", title = "The Strucplot Framework: Visualizing Multi-Way Contingency Tables with vcd", author = personList(as.person("David Meyer"), as.person("Achim Zeileis"), as.person("Kurt Hornik")), journal = "Journal of Statistical Software", year = "2006", volume = "17", number = "3", pages = "1--48", url = "http://www.jstatsoft.org/v17/i03/", textVersion = paste("David Meyer, Achim Zeileis, and Kurt Hornik (2006).", "The Strucplot Framework: Visualizing Multi-Way Contingency Tables with vcd.", "Journal of Statistical Software, 17(3), 1-48.", "URL http://www.jstatsoft.org/v17/i03/") ) citEntry(entry="Article", header="If you use the residual-based shadings (in mosaic() or assoc()), please cite:", title = "Residual-based Shadings for Visualizing (Conditional) Independence", author = personList(as.person("Achim Zeileis"), as.person("David Meyer"), as.person("Kurt Hornik")), journal = "Journal of Computational and Graphical Statistics", year = "2007", volume = "16", number = "3", pages = "507--525", textVersion = paste("Achim Zeileis, David Meyer, and Kurt Hornik (2007).", "Residual-based Shadings for Visualizing (Conditional) Independence.", "Journal of Computational and Graphical Statistics, 16(3), 507-525.") ) vcd/inst/NEWS.Rd0000644000175100001440000002035212547003107013065 0ustar hornikusers\name{NEWS} \title{News for Package \pkg{vcd}} \newcommand{\cpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}} \section{Changes in version 1.4-1}{ \itemize{ \item add imports for functions in recommended packages to NAMESPACE \item \code{shading_hcl} now also uses solid line type for \code{abs(residuals) < eps} like \code{shading_hsv()}. } } \section{Changes in version 1.4-0}{ \itemize{ \item Add \code{shading_Marimekko} and \code{shading_diagonal}. \item Add residual-based shading to \code{rootogram()}. \item Add \code{residuals()} method for \code{"goodfit"} objects. \item Add \code{grid_abline()} for convenience. \item Add P-values to the output print.Kappa() produces. \item Fix legend of \code{distplot()} in case of leveled plots. \item \code{cotab_agreementplot} panel function for plotting conditional (stratified) agreement charts added. \item \code{loddsratio} added as an extension of \code{oddsratio} for conditioned generalized odds ratios. The plot method is greatly enhanced, and structural zeros (missing values) are also accepted. \code{oddsratio} is now just an alias for \code{loddsratio}. \item Bug fix in \code{pairs.table()}: for \code{"conditional"} type, tables are now reordered so that the conditioning variables come \emph{first}. \item \code{cotab_loddsratio} panel function for plotting conditional log-odds ratios plots added. \item \code{assocstats} now handles strata (all but the first two dimensions). \item \code{sieve} now accepts a \code{scale=} argument. \item \code{binreg_plot()} added for (conditioned) binary regression plots \item Bug fix in \code{mosaic()}: using \code{highlighting=} and/or \code{condvars=} now not only reorders the table, but also the split information, so that both remain consistent. \item All plot functions now have an option to return the produced plot as a grid object for further use (e.g., in \code{mplot()}). \item \code{mplot()} added for combining multiple grid plots in a multi-panel-layout. \item \code{legend_grid} now allows more options for positioning, and an \code{inset} argument has been added for relative adjustments. } } \section{Changes in version 1.3-2}{ \itemize{ \item \code{Ord_plot()} gets \code{lwd}, \code{lty} and \code{col} arguments to control plotting of the OLS and WLS lines. \item \code{distplot()} gets an \code{lwd} argument. \item Changed default line types for \code{sieve} so that positive residuals are shown with solid lines, as per Friendly specifications. \item fixed problems with \code{pairs_strucplot()} type argument, particularly for \code{type="conditional"} \item Fixed error in \code{CoalMiners} data (missing group, labels switched) \item Change default area type for sieve plots to "area" } } \section{Changes in version 1.3-1}{ \itemize{ \item several namespace issues fixed } } \section{Changes in version 1.3-0}{ \itemize{ \item Bug fixed in \code{assoc()} \item \code{grid_legend()} extended for better finetuning of graphical parameters \item \code{legend_resbased()} better handles spacing for labels. \item \code{legend_resbased()} and \code{legend_fixed()} now allow changing the font family. \item default diagonal panel in \code{pairs()} is now set to \code{pairs_diagonal_mosaic()}, with alternating labels and frequencies shown on the bars. \item labeling is more customizable in \code{fourfold()} } } \section{Changes in version 1.2-13}{ \itemize{ \item \code{agreementplot()} now allows to add marginals to the plot \item \code{abbreviate} argument of \code{labeling_border()} renamed to \code{abbreviate_labs} to prevent name clash with \code{abbreviate_foo} args in \code{labeling_cells()} \item Several partial matches fixed in code } } \section{Changes in version 1.2-12}{ \itemize{ \item Bug fix: \code{assoc()} would not plot tables with 0 residuals \item Bug fix: \code{structable()} adds dimnames and dimname names if none are specified \item Bug fix: print error message when subsetting/selecting of structable objects using more than 2 indices \item \file{NEWS} file changed to .Rd format } } \section{Changes in version 1.2-11}{ \itemize{ \item Bug fix: \code{gamma} argument removed from \code{hcl2hex()} } } \section{Changes in version 1.2-10}{ \itemize{ \item Add aperm method for structable objects \item For use with \code{shading_Friendly()}, \code{shading_hsv()} now sets the line type of borders corresponding to \code{abs(residual) < eps} to \code{lty[1]} in addition to setting \code{color} to \code{line_color}. \item In \code{fourfold()}, modified default \code{colors[3:4]} for non-significant log odds ratios to be more visually distinct from the fully saturated \code{colors[5:6]} for significant ones. \item In \code{fourfold()}, allow the function to work with tables with more than 3 dimensions, by restructuring all strata dimensions into a single combined 3rd dimension. \item In \code{fourfold()}, modified defaults for \code{mfrow}/\code{mfcol} to give landscape display, \eqn{nr <= nc}, rather than \eqn{nr >= nc}. If \code{length(dim(x)) > 3}, set \code{nr=dim(x)[3]}. } } \section{Changes in version 1.2-9}{ \itemize{ \item Fixed \code{Ord_plot()} for devices where the default filling is \code{"white"} and not \code{"transparent"} by explicitly setting it to the latter. \item Bug fix in \code{as.table.structable()}, returning the table in a different order than defined in the structable object, confusing in particular \code{plot.structable()}. \item add parameter to \code{ternaryplot()} to control the positioning of the plot labels. } } \section{Changes in version 1.2-8}{ \itemize{ \item Small bug fixes in handling of some graphical parameters. } } \section{Changes in version 1.2-7}{ \itemize{ \item Corrected df handling in \code{goodfit()} with ML estimation: only non-zero cells are used. This is backward compatible with versions \eqn{<=} 1.2-4. \item Fixed bug in \code{goodfit()} for binomial distribution with specified \code{"size"} parameter (introduced in 1.2-5). } } \section{Changes in version 1.2-6}{ \itemize{ \item Small typo in doc of \code{co_table()}. } } \section{Changes in version 1.2-5}{ \itemize{ \item Bundesliga data set has been augmented with the results of the seasons 2006/7, 2007/8, 2008/9 (thanks to Torsten Hothorn). \item \code{goodfit()} was modified to treat zero cells better: \sQuote{Internal} zero cells (i.e., counts below the maximal observed count that did not occur in the sample) are retained (and not dropped as before). \sQuote{Trailing} zero cells (i.e., counts above the maximal observed count) are still not considered. The documentation now points out the problems with the minimum-chi-squared method in the latter situation. \item \code{sieve()} now accepts a \code{gp_tile} argument to control the appearance of the cells (apart from the sieve color) } } \section{Changes in version 1.2-4}{ \itemize{ \item Bug fix: labeling arguments were incorrectly handled when the options were not provided as named vector \item \code{ternaryplot()} now makes use of the \code{cex} argument also for the rendering of optional labels, if any } } \section{Changes in version 1.2-3}{ \itemize{ \item \file{hcl-colors.pdf} removed from source ball (vignette now in \cpkg{colorspace}) } } \section{Changes in version 1.2-2}{ \itemize{ \item \code{strucplot()} now accepts a \code{df} argument that is passed to the shading functions. Also, expected values are no longer computed if residuals are given. } } \section{Changes in version 1.2-1}{ \itemize{ \item Fixed a bug in labeling (incorrect handling of some parameters) } } \section{Changes in version 1.2-0}{ \itemize{ \item Moved color palettes from \cpkg{vcd} to \cpkg{colorspace}, including \code{vignette("hcl-colors")}. Package \cpkg{colorspace} is (as before) loaded automatically with \cpkg{vcd}. } } vcd/inst/doc/0000755000175100001440000000000012547003156012571 5ustar hornikusersvcd/inst/doc/Z.cls0000755000175100001440000001703411502631361013510 0ustar hornikusers\def\fileversion{1.1} \def\filename{Z} \def\filedate{2006/10/11} %% %% Package `Z' to use with LaTeX2e for Z reports %% Copyright (C) 2004 Achim Zeileis %% \NeedsTeXFormat{LaTeX2e} \ProvidesClass{Z}[\filedate\space\fileversion\space Z class by Achim Zeileis] %% options \LoadClass[10pt,twoside]{article} \newif\if@notitle \@notitlefalse \newif\if@noheadings \@noheadingsfalse \DeclareOption{notitle}{\@notitletrue} \DeclareOption{noheadings}{\@noheadingstrue} \ProcessOptions %% required packages \RequirePackage{graphicx,color,hyperref,ae,fancyvrb} %\RequirePackage{thumbPDF} \RequirePackage[T1]{fontenc} \usepackage[authoryear,round,longnamesfirst]{natbib} \bibpunct{(}{)}{;}{a}{}{,} \bibliographystyle{jss} %% paragraphs \setlength{\parskip}{0.7ex plus0.1ex minus0.1ex} \setlength{\parindent}{0em} %% for all publications \newcommand{\Plaintitle}[1]{\def\@Plaintitle{#1}} \newcommand{\Shorttitle}[1]{\def\@Shorttitle{#1}} \newcommand{\Plainauthor}[1]{\def\@Plainauthor{#1}} \newcommand{\Keywords}[1]{\def\@Keywords{#1}} \newcommand{\Plainkeywords}[1]{\def\@Plainkeywords{#1}} \newcommand{\Abstract}[1]{\def\@Abstract{#1}} %% defaults \author{Firstname Lastname\\Affiliation} \title{Title} \Abstract{---!!!---an abstract is required---!!!---} \Plainauthor{\@author} \Plaintitle{\@title} \Shorttitle{\@title} \Keywords{---!!!---at least one keyword is required---!!!---} \Plainkeywords{\@Keywords} %% Sweave(-like) \DefineVerbatimEnvironment{Sinput}{Verbatim}{fontshape=sl} \DefineVerbatimEnvironment{Soutput}{Verbatim}{} \DefineVerbatimEnvironment{Scode}{Verbatim}{fontshape=sl} \newenvironment{Schunk}{}{} \setkeys{Gin}{width=0.8\textwidth} %% new \maketitle \def\maketitle{ \begingroup \def\thefootnote{\fnsymbol{footnote}} \def\@makefnmark{\hbox to 0pt{$^{\@thefnmark}$\hss}} \long\def\@makefntext##1{\parindent 1em\noindent \hbox to1.8em{\hss $\m@th ^{\@thefnmark}$}##1} \@maketitle \@thanks \endgroup \setcounter{footnote}{0} \if@noheadings %% \thispagestyle{empty} %% \markboth{\centerline{\@Shorttitle}}{\centerline{\@Plainauthor}} %% \pagestyle{myheadings} \else \thispagestyle{empty} \markboth{\centerline{\@Shorttitle}}{\centerline{\@Plainauthor}} \pagestyle{myheadings} \fi \let\maketitle\relax \let\@maketitle\relax \gdef\@thanks{}\gdef\@author{}\gdef\@title{}\let\thanks\relax } % Author information can be set in various styles: % For several authors from the same institution: % \author{Author 1 \and ... \and Author n \\ % Address line \\ ... \\ Address line} % if the names do not fit well on one line use % Author 1 \\ {\bf Author 2} \\ ... \\ {\bf Author n} \\ % For authors from different institutions: % \author{Author 1 \\ Address line \\ ... \\ Address line % \And ... \And % Author n \\ Address line \\ ... \\ Address line} % To start a seperate ``row'' of authors use \AND, as in % \author{Author 1 \\ Address line \\ ... \\ Address line % \AND % Author 2 \\ Address line \\ ... \\ Address line \And % Author 3 \\ Address line \\ ... \\ Address line} \def\@maketitle{\vbox{\hsize\textwidth \linewidth\hsize {\centering {\LARGE\bf \@title\par} \vskip 0.2in plus 1fil minus 0.1in { \def\and{\unskip\enspace{\rm and}\enspace}% \def\And{\end{tabular}\hss \egroup \hskip 1in plus 2fil \hbox to 0pt\bgroup\hss \begin{tabular}[t]{c}\large\bf\rule{\z@}{24pt}\ignorespaces}% \def\AND{\end{tabular}\hss\egroup \hfil\hfil\egroup \vskip 0.1in plus 1fil minus 0.05in \hbox to \linewidth\bgroup\rule{\z@}{10pt} \hfil\hfil \hbox to 0pt\bgroup\hss \begin{tabular}[t]{c}\large\bf\rule{\z@}{24pt}\ignorespaces} \hbox to \linewidth\bgroup\rule{\z@}{10pt} \hfil\hfil \hbox to 0pt\bgroup\hss \begin{tabular}[t]{c}\large\bf\rule{\z@}{24pt}\@author \end{tabular}\hss\egroup \hfil\hfil\egroup} \vskip 0.3in minus 0.1in \hrule \begin{abstract} \@Abstract \end{abstract}} \textit{Keywords}:~\@Keywords. \vskip 0.1in minus 0.05in \hrule \vskip 0.2in minus 0.1in }} %% \def\@maketitle{\vbox{\hsize\textwidth \linewidth\hsize %% {\centering %% {\LARGE\bf \@title\par} %% \def\And{\end{tabular}\hfil\linebreak[0]\hfil %% \begin{tabular}[t]{c}\large\bf\rule{\z@}{24pt}\ignorespaces}% %% \begin{tabular}[t]{c}\large\bf\rule{\z@}{24pt}\@author\end{tabular}% %% \vskip 0.3in minus 0.1in %% \hrule %% \begin{abstract} %% \@Abstract %% \end{abstract}} %% \textit{Keywords}:~\@Keywords. %% \vskip 0.1in minus 0.05in %% \hrule %% \vskip 0.2in minus 0.1in %% }} %% sections, subsections, and subsubsections \newlength{\preXLskip} \newlength{\preLskip} \newlength{\preMskip} \newlength{\preSskip} \newlength{\postMskip} \newlength{\postSskip} \setlength{\preXLskip}{1.8\baselineskip plus 0.5ex minus 0ex} \setlength{\preLskip}{1.5\baselineskip plus 0.3ex minus 0ex} \setlength{\preMskip}{1\baselineskip plus 0.2ex minus 0ex} \setlength{\preSskip}{.8\baselineskip plus 0.2ex minus 0ex} \setlength{\postMskip}{.5\baselineskip plus 0ex minus 0.1ex} \setlength{\postSskip}{.3\baselineskip plus 0ex minus 0.1ex} \newcommand{\jsssec}[2][default]{\vskip \preXLskip% \pdfbookmark[1]{#1}{Section.\thesection.#1}% \refstepcounter{section}% \centerline{\textbf{\Large \thesection. #2}} \nopagebreak \vskip \postMskip \nopagebreak} \newcommand{\jsssecnn}[1]{\vskip \preXLskip% \centerline{\textbf{\Large #1}} \nopagebreak \vskip \postMskip \nopagebreak} \newcommand{\jsssubsec}[2][default]{\vskip \preMskip% \pdfbookmark[2]{#1}{Subsection.\thesubsection.#1}% \refstepcounter{subsection}% \textbf{\large \thesubsection. #2} \nopagebreak \vskip \postSskip \nopagebreak} \newcommand{\jsssubsecnn}[1]{\vskip \preMskip% \textbf{\large #1} \nopagebreak \vskip \postSskip \nopagebreak} \newcommand{\jsssubsubsec}[2][default]{\vskip \preSskip% \pdfbookmark[3]{#1}{Subsubsection.\thesubsubsection.#1}% \refstepcounter{subsubsection}% {\large \textit{#2}} \nopagebreak \vskip \postSskip \nopagebreak} \newcommand{\jsssubsubsecnn}[1]{\vskip \preSskip% {\textit{\large #1}} \nopagebreak \vskip \postSskip \nopagebreak} \newcommand{\jsssimplesec}[2][default]{\vskip \preLskip% %% \pdfbookmark[1]{#1}{Section.\thesection.#1}% \refstepcounter{section}% \textbf{\large #1} \nopagebreak \vskip \postSskip \nopagebreak} \newcommand{\jsssimplesecnn}[1]{\vskip \preLskip% \textbf{\large #1} \nopagebreak \vskip \postSskip \nopagebreak} \renewcommand{\section}{\secdef \jsssec \jsssecnn} \renewcommand{\subsection}{\secdef \jsssubsec \jsssubsecnn} \renewcommand{\subsubsection}{\secdef \jsssubsubsec \jsssubsubsecnn} %% colors \definecolor{Red}{rgb}{0.7,0,0} \definecolor{Blue}{rgb}{0,0,0.8} \hypersetup{% hyperindex = {true}, colorlinks = {true}, linktocpage = {true}, plainpages = {false}, linkcolor = {Blue}, citecolor = {Blue}, urlcolor = {Red}, pdfstartview = {Fit}, pdfpagemode = {UseOutlines}, pdfview = {XYZ null null null} } \AtBeginDocument{ \hypersetup{% pdfauthor = {\@Plainauthor}, pdftitle = {\@Plaintitle}, pdfkeywords = {\@Plainkeywords} } } \if@notitle %% \AtBeginDocument{\maketitle} \else \AtBeginDocument{\maketitle} \fi %% commands \makeatletter \newcommand\code{\bgroup\@makeother\_\@codex} \def\@codex#1{{\normalfont\ttfamily\hyphenchar\font=-1 #1}\egroup} \makeatother %%\let\code=\texttt \let\proglang=\textsf \newcommand{\pkg}[1]{{\normalfont\fontseries{b}\selectfont #1}} \newcommand{\email}[1]{\href{mailto:#1}{\normalfont\texttt{#1}}} \newcommand{\doi}[1]{\href{http://dx.doi.org/#1}{\normalfont\texttt{doi:#1}}} \newcommand{\E}{\mathsf{E}} \newcommand{\VAR}{\mathsf{VAR}} \newcommand{\COV}{\mathsf{COV}} \newcommand{\Prob}{\mathsf{P}} vcd/inst/doc/strucplot.pdf0000755000175100001440000114666012214060362015335 0ustar hornikusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 4709 /Filter /FlateDecode /N 85 /First 707 >> stream x\ks6 |t6!nw:iji;Dllɕ8_@h'r; 05, FTB$:w^d28S""e S."L+otLhB:qiDQafUD%YkSـPI4 s XA!x捓L杈LZ0gE% CA[ŴaWڲ,:X= $(YTF3#XQ<b\,4j 4誐@hxF vPhX  qEVE-£f,p^x QsB3GъtQC\5{E#1CF?>f@Gj?VѠ`,4oOq=/12&g^~<E1Tμ=LٝfĞ]3m٣tܼLAL{sCXF_ 7!֕[bO&;Oh 'Gޞhl24Cv~:ifa.͚}e@q<6)#RexTkܟG =w]6gh>8v0Glv2]vh>߇/Óɬ yb%< Q[vd>%8#vآg6?i/>;nv'qKRş6ݿhXUj*%BaR2|(Ӣ"K^R,i(i_UA몤9C]K>WU,H:SjJK3i)th)QNcp#Ƥ\%u%%- _/w!UAAG*R6 *0Ya'Ӛ">g!?j4h/úEWb_yVRj9ZVv+),)%ortZ½)crqw''_sҶs~qqQ1C3hj2=ߥCCw^הi1 $ QEhTV.I˵fnƥzuS)SX_+׊ԎK:PZT46Vd ,{+P αyJy]fo+0xu&17$F.1E^M?pMg07@s)k+l{61<:{ߓUBpBf\ d0K 1 fr r\mAȭڌړ4"K̆OHr͟9'#~pn=ё'XqIP>QjFrv`3 .% ]O$>]'__tIu $:̆9>nb;||̟|?O?%7켞Nw5QR;|ȇgg>⣦&nkl4p~)?GG|krfpz|SDۓi]9b=Gz:.)4.ă1 t#Ӏ?OT1h;ced5B!^djUW4COͼ~s|gܦdg\Oϸ- $$Z>檗|,BސGB!XgCzL4\ioDг\So6 e`N)ԗWGi60JkV.6tAD#q?\ГqۓE诋*l]O g̋u9 e9h%r6lCVբ9\28ƨ{ /jE̦M =S[YC6--ehCi+>]!G/HP`v<|ȞS|GI\=i >9"saCEr4R)3!Ŝ~9RrW{q#N)wPS>c.bwƘLq_"\!V'.0ڊ\-jp ,Aԧ I򛒴[,zGwƳfya)C/lV[+2NȲ["ai1Ƚs$ul3;)~NvXs$ɊF9,IA1y35`+bI-huDiSc6ye}(eT.㛟_̘27GgTe[S.PbQ2.JO#eh}biOW\{>2Su^Ū k6=ZV=9 R招̷r_}y7vx=>۫B֓zqj[#Wx{lQJ%Oo:f]Ru|ЁyS&[%1)=ʗxޅ_l/v\y4$2+s:L s] plu|@3ZWBm댩,PZ_It!J^3ZFY(+%6UV JPDK|OwQANr-&R!LZLľMY|ȵ\͵\K̏DzU QRYҲ!H 0Z•YIZ̳tbR.[nv nzAUskcU!MPZ6e߭2T,_}PNy%deq•a#d „`ɅtYŷTS ä9GS*WVoe"^ʀb(uB_h'zSPw`F\A5 |0 hpح`2GZw09_cL+42Hi&z{ T+ $#^(+'h+K@-!N]Y}gj[Iڱ O:-58( (V@9m&"][,0E<UAͯ&;Ū*ڝ1S%S  (%q𕭯}"* 0 i#A `Q h LOô=|_(ڳuԯ[\ ~/ng7+n ̕qX^U\DoH]=O EҲr|Xh3n![CuuX}~E8Y[6}VvmتuW_鞿^-Wڿ-> 9;?OGkud-qt{._;=Vk8| =NvM\\KB7wC6wae\Řtbl:;g%8m>tb:z9 .fquҞ^g0mO&cgO(m:VSxLTzK| ړdn^ pw;ʤnr>9ąV*]xͽy=BUώஅ[k_Ѧ丩mC\Q~s16U;hw0`Mv'zJf|pB&/c%}Ʀ Y?T^zr 1_k:BcLɥoBp6_ B?~;B[9~ബe{ w.t C}nU\YBo/M/tjVNd?esaȫ6|c;N'rDH9Lu2P;~^ROԓ2 ]@إ`5`LpjIKWt:!O'h6/J #L;$ RiIG on [1fc>9ǿs2hJᒐ!t>_\oءu u2o\X}u^2Z$݌IBpBSlP@iw%&+7t ^n⚴GvA9W:Pp#l⛀҂6.:Wy\ԭ;E2L ԧaK 1ӽg/҆֗{umӏmƛ>U}6e8rpV?\ kQ`ڜIo|Ӓ/{aٶtOE˒#:%c\z]JzLБzgKM/)#+ޘ›9`樛!G -)DE/TRmb~tkytpydcva.tkX99i;)c7ԅ pi6 PWendstream endobj 87 0 obj << /Subtype /XML /Type /Metadata /Length 1763 >> stream GPL Ghostscript 9.07 contingency tables, mosaic plots, association plots, sieve plots, categorical data, independence, conditional independence, HSV, HCL, residual-based shading, grid, R 2013-09-11T14:24:16+02:00 2013-09-11T14:24:16+02:00 David M. Jones CMR10David Meyer, Achim Zeileis, Kurt HornikJournal of Statistical Software endstream endobj 88 0 obj << /Type /ObjStm /Length 3016 /Filter /FlateDecode /N 85 /First 766 >> stream xZks۶~>s'x?t:8M6O;IYm6Ht,HI(%- p8] &&YL[\tȒa1h,S[SZ3ePBpp!pLbQ h (5jEx-tey:(UxC;P"U+ctA(@6)wGjBHHJq3IZqt/& !YKT)Ouˀa Fkkhylct}d\cJgIq\O.}PtÎ0[>(f鰘1Bea5 F5?NExY\VhQr^Pnkoa8NaR{Vhm\5»;]x\cON7W\qfۤ2tff|tE#޷p 'bmQ̓bF 5rzspucbш*ChL#&HKל:ͱbPË*x\?!e1Sdu&%'zSLpZb' "~xiܢ%ppx%Zbz_!S.ii9\$9ۀTі{>$-dc 0,TSLX93dU|f}䁸J;d#PArq* $.1m ,)ax s'*Hv. 9=<ӛCRKL(N0뎑ܙ9( wB%"-2)xJH 9j񊻞 UN}*y)ْD(0at./"Gdlb LV`+η{3 aJ=JCI]ΔC;ǾK`Vd9OŽ/ػVG9Ug)nnx8-ϫ4irǃnNyuoE!El1fCAp/ >㋙x1q^L1}WL3m_Uz5-U]Ud`C/ ZݡcZJ0*.s$aeǹ7QÑZ=BZō钞 A8VOYBA5(?a>ymj۰vȭRKrDu?z93k׳n߹hR4wRK/&'O4&Nmv} x+b8q E)>[}OK]pר5o֣%@_|×F[1\Tpb`kcнqoX-n|߅tP<p#4[F8y5.Q2o8%WiR2g neM~rCiC7Tvo#}Ogh3H{/U&x*@^Yb0eU eH h:⤪KS'?1!Xo4/ŧHs!NSq:- Mř8r~VA$GbTBLA[rSq>I|THLL̊hsV^h0;ΦE!'B\φi!>ť" 7#Pk9Ur_{7ȹܙmzG .[\kz2kśyauxqyq=)6;Fs yYiҮ]d\,up9kKc KOA2ry݁"EQִHp:hה:]p%}~Qi!@tbBrӍrU#~jNHREr]1᲻JVaz ױo4zUhJ;i0(LvEvA !!Ge3FnyP=N.#;8DŽRw)(NqL6ޘn=NYKuzsH=<5-yqxQ6i{ek򀍲z n`=%:Uo|L[(@{0SvO <o|m+o (Js/@X-MA'vU6Jv JK@:$Օ3ںoc&ռ[xn3b]GζWC~.8At^uSr'ʉ9s 2K#m) > stream xZYsF~_1`**K޵6rM27 鐔W@)503==}|PB/2ReyIDmJ$nG-Vt *$ qNJ2<4&aL!I xd a"OHXx'q<6J-$T\2<҂ *P q"0 J+9ÓpZcf3=؛؅PE..p›&I 2J7>ƢL2$|\ wa<*8* IDz !#dZSK"1Dc2֋hrOF%x p)=aҨx)bȏwIN\7E'@rO$RT,]\7a66_Ͷgj}qdtOO2LIX% ղ?̮ٺ8O6h5e-ށO/ǦYZMnż,Y-6RXvrr-JL'gVa5av6}6-yjNj]V0Dhmŵzc``ӣHSv71V̠n;W76oCSgV=kZ{݁[ #}s(cѭ%Xϲ H+uT퉔KQܨV[u<:ƓdkR[ǠA8, [a6l \I2wd$Alm̏2a~: R<@-NPlXï81&\ϘC%[뽌^M^rcC*!!WmW8G¨`:`O_]]⠢Zgp> stream xZ[s۸~c;qppܼٙ6qfAksJr(Zi'Lm# A\sm e VhYKhơ[6@< Ieh"l4`<Ȗ;qFE¤)rgWd%1QQN #G;q0x ۉevIS28(6$cb 0Gl6z2)2G#pc 0ky!,'B;Y1ʓaHyt+PgpU0,cYD,B !R!<]$8WQ`.:+(ˣ B cE-daHr3gJNXr$zlR)W¬l +p]e̤2C e/o1c0GVfbbMЁd؉wIBLpALx* D/WUd1_J9ϨתzY_N'_!ȑ|Tի/(׌~]7ˋzdg_?'Ppޫ^c3U1?Zf-=CQfy]tiSi?ПF;gseC[8dˋ1n4Ao;@;b<4!Ԏ F^Cޖ?^,/fߦHj;O.Z&x=q:R{#~3uHFˤ=<_e/\(Z5THCJfTE[DwK cLjUq){Gڈ׶^;872gsK:`EYyMw-ˋ_3N[:7v, N5U' tvdUc;.SWRU Z{Pixr_N; 0a^lT9B5E(d%҈눴=Hq9&u,Mښ=qOFx/Yg۴$}TҀ-3$`I| 6cd ^yR y#p>6p dc3NgtujI@{o_\⎹փY$}[N5I뢖 Δ$)%X=T BmR@Dږ3$-O&B/^goW vLO$.bY*eԋI;(w/;z^? ԖՅx2^}j:Wrqysgߪϓt1Sf; &Wf-6K^yx6P.bm0z2^<_jtʮ-s?Gua@g8vd^H6 Xwto?W7WgQ`$>}ϻlؓ$"ih@{N /iGn ۑ6R[k{ϢMur+bb` :̂ zo@Dģm(L36"CQ^?L/?Y^mu-I]\ )~z>nD4hzUM_b1[̫˪~ijV}բZZVjiYOk-ְ`屔Ne>T`_wMvwpfpoz5V5Ը%a^Bh+ξ9}:|'$$+)J k^"M?p />VyND&/#mϗ{bxZ9.x#%]x[Owt'GD;՗(YxÒR%pRno+6cIF##:FFYu9-kZ;tyԲSk8ęsrZېtrV(1H&7& : /mgj6RG!iGBFC#k2(-F$Pm0!hƶ;n6r'SrY#Lf|AZVˑ ϼ0۰im)C}*PG^ zT *mrB !"PnEx!EAe㉲r@L[di b9q, G E }ZN1tHS Z"t7A!i#AhwQр#%* * hj9c4l%ˇPO҄8(9wGu>A !$85 "lcnqA}'T<@?OwÎBWÈ94`D㐳@TxwF,xQ&p|iBH؞>7~pv;B,n m`Y'ZgG=}/w".aAѹ|E'꡼Hyv8nDH1*+ha|wiR}:(\Q)3E;t{M`Gendstream endobj 346 0 obj << /Type /ObjStm /Length 2905 /Filter /FlateDecode /N 85 /First 763 >> stream xZ[s~GgR/~d2o;vꑜ:M0 Ih(RC@_, ((k<vo@&0ïd\1g @ eR8cRFgRk47c'iD[()%)eJKlSϔ#P.0 (h-^a0 !ы[fds3$-4h*(ff&Y`;f?OEf-Q`f쳁HD͜ 0◎#(lsȜ׀)s._L# ?tbc^bW#<ڀI"0ҝG2U , }X|X΢дO`QY8ȣ!*ɢS(ŢS(bT,BR$6HL RVŔ'+4tO K#O,{aˢ vȲN91`~1O,{]. &{ ff_d,i>_ݵeq|3Pֳ=pZ^^Lg/j ]Tj+1t&fػE2UeqY0P )+'zNb#tZ/iIY"/˲@ [5ou'u-q9I<A fOZby'+ꢸ^QbHPD`EzMupG>!ΌoYiy1);Y`d]*8g1q 3b7Ci%gٲE>{9 XM*2+F0 lXkr Av|1$%d]NP)\0'::2s1G0ۑ`Čϋ"u05^jk'l{&WL ~Orp)E֊谨IQ1KQE ibrT#/_Dޖ?;sI`2JU;LAqAYwe\!(4P C+A"Æ֊&xJ &!SPsͤR\pԆG ;;P\y@()d/߿?vi8_>FΔO)K>yU^HY2t)F(ey^/^i*0$;d >Kq{jժLJ{t{kѬ.E_M?ýE~<9Q8Lq OdGYM";lͳE̪.d.O^ B9&Cx:-!РH_Ej IH`%1[N'p@?ĕKٿ gOtq2R^/ N=ÌCl\FcU#1l퉱Ęgl!QZ"=ȜhPTܺM4VDMɸ[ B߂iթeNGl7Fx9tMGPӬSOgݤKFMȓSMKn*rjhx|@uO@U@'[ 9]x( 5 9V@ɪ'ܻ$ Og0P#,YjyE+;f=ƾj ~5YdQPSz:- "-9ZŻMk9uT 802pke\qqE$:aoO˃ u!D^[*a3z-U܍^ԁ6^ 5ٸ`*um|6~Z3pO7mdk tc'-nޫcv1;N djpDU#P(gbJa!oLxp;O<B]=tP",RI#T!D3eUlzajMiĀcH) NA"rwҥJؗJhj yoghAnϧwO݂r [(ks}kLu:{L o?rL*ǖ>{6AJ!r+PԓB>BJ>BÕRJ bjr6P><'EâʊmR<`CAޕF䃨%iI)Cٺ TGb J ~'P7S1fJ+j<2(+P6rj G,jA,/g3b_rA8%S{*N½mpߩ ~Sendstream endobj 432 0 obj << /Filter /FlateDecode /Length 6243 >> stream x\IsGv×jr_|,y >4DX򲺊Brb!/Nzg˻3>t鯻򿋏_Ye{]һh̬B޽x_jV9Ĭ 6&xK!;Z*x=`AxA&1e~s h)Y]6unNig2Uapunvg"N(3pwݟt|WEWwOx:}0w:pJ컄=̱*XJks![6d% e+`a0a qšA)g$!fuʅjgC?qVE k],N瀌{TL#M2nVkc#fȹ H]gX^Ll|Ef `qM|/]MQOx_$E>LA" 17܇%Gϝp9a i75]Kva:ӅZVjB?2tR Tsy;[+@=:?dØl t(ӿﳙc<lEbiϜu$ms1Y|ʚ`B,F~@FB8#cZyX;)s։MV ]O:nŐ8~Sﮙ=p^.gϷ'Gls8gXOTlzSӯOX ; e'yH:{K$W$tw!V7qXfL'x/?ւpTۜ9-]w{p:ٹ`/{%@d<&ր7sgB)dj` 1R`}4 Ħ1#'Od!vP\ᅮ|PNj# K86_ 0}A# @t+D 5Y%Un9Ē2Cڀׇ۬L z*2RV"k"Urp>`pw0KE}Jw .e@CA>j`7ʃ#$_^t/;!lJrpYoZY%#'= 0avȢ9ٿnYm͌ pbqvNb,LY2u,({wg"7gޘ۳W>(X8w.9$A_D!Cb[C?z:\L#4A0*Xu-d#s"akqDdŷ>%DiX @oa^aLe)YPzĂ;^M uo[_Vc*Iyo"&1>WE!rU)&A~:>w:yRם_yCf"9 "!bUNn $8 e 5`H M " J&j<^@J;|Nq0SW,k I bbrģ>`lbߑBoLQ >p$T0x 6o~,Ae6 X2Hڅ`\%C`SvT%!DR[+!ɰ{z UƜPBizS#7{IrBȣ,LC޶gB R[bS(~xKcaHLBX\dr+\mNt,mDR R*Л,VDWλ>R&"8BՔ4bE4h+ϰ<bQz6v/&H oޟJ+^7?A*:Oj~ŏ'lQ:$m}Z'~ARYKK ;=%! 1*PL*p4*.m{)M㤠YD(Bΰcn:+&V^ a{CRz&V h[@ᱻ(Fg b`#A* ?T(n+څhU^m@gO|FĚy(!{/Mđ6*N=Vb^/P\>~[p`w}YE#EV HC'Ns@p Y|'5yVVW G1Iy_rUp3X^vU(I}ns[; шfWZ" :0:U$Yvb^}0]9AY7׃-$ir*X5lN,!ECc}^ÇDYtlWq#uq.) |85TG\q׼rR΅CKD@ g_@a1pVJ dgr}{$ ̟<"I RxAZG&Ģo}.iOJyS0dq/FKSeRr<.79Xx';K,hYPK`˦J JMip eEۭ\AdaA( Aƾ薊ZFc,2lMKcړdF O0 i42Xd9 27$cZTΘ*-/G!4kE3f絩$cD =&I#ҢS U9e /(AB7%-m P&+PSER\=gpC"n0n\ҊF53ARE 44x Qr1nU!KB36հ4A=lk)Wt0Maվ~SBb8g\d!\Hsaǀ\*0o\jan6|iyirm-"Us)PC+n4ue X‘TYR Gϕa3ZD3GGW&C;PۚzD"|$~/QI0[KB ύþ⪉-6Gq 3! G䥲#$} g'I]~S!ÉWsš B $ ]UwRDceBُt?ȮIEWd(/ {a9mlbȖ犵#/UJulNpuܺQKmMG(LcLby"BXz=q9艅)cRt#}5;8[ ނ{NXS랽(ى$j/tL y#j dl 08E˿ t8&E5?=Lw2=Ϫ%̓Cb^h nF$=]a^J4%NKQ!L%}|VPV A*4(W*7y/\g^v0uhYjPX@RL]q1P y@RjOW AlTƱh^@L$g(Hxɋ( 7#}anj0_v^Q uMc<M=tRi0/)1._iZ9CL- D_8é'VQvch'v9U%KwduQ:e̾v1Zp [g,fer+^`iy @v ɥ*HI,xHe0S{m'ǯo:nj Ռ<' L1jV@f- [䐁Tږ .Fz%*zR5$I2yU,R!?J KZegRK]Zɦ,`gadݏ (V R/ 1hfE@F%>PH$WPK 0  ~(%gA }ʗ[8?&Mg@e7#J4Pz4O܆uS{ِ 0ʏL# Go!E@S_|% ]çZxb<1/< )[#(Л#Ri,_9.rT5BT;<1'BlPy$mp8򥛸z~Ha,~[~r4`Ө\ք O벳L-h½p+ǵO e<}lH2m1/V#vf>}%2Oa*5o+LUT8Z~r lmnSvD1'HL+6eΔCܺv!Z[@Ju3^I{fDa'ᇨH+BҎ!>>0_x*qv 7Dbkfj .mYna^ujBZ;oy }4~iۮgqU}=Jk5_ފ.k ؤFr 4iFNƆ'b~ܥ2J1,*&&ѢH?).nV( pH\O!,!O \^T S{?`CӻQ)WQLP>W_@[-'KqzOt@;mSr\PukGVfx6@l89-PJnKj_UW8y}YLA֠T\-h*m/?)egwa$j\ф!:=u*"1,;}h4V6+GF\EuHZ|:ݒ ~* s źȯ^> ߼% aY,Fk7]n1:vNi1~D,Cgam78s6-LjbcBH\P^T6m:ڍF)dq@*+K/_4q9n0@IqK""-Cʼ!6ʲ Bg`Ȑݧ/Ih,F#9y܅DhUPbZ/Qy' 5ٵ)y|G~ Y IE%k%=l0%:ğ4 FQ]bvpo\nAtR~Ȋ4R`Nendstream endobj 433 0 obj << /Filter /FlateDecode /Length 6273 >> stream x\[o7~Ggb`1p8-'؍cI:.<}ntKvA̴$Xm_z_÷{wrO~/Yeb}o~_^`Wv$h֪JԝS\6ۼY5}Һ۾|Qsw MTT*E^AheC.pl.YPtz9ί`v_LYW&Imqlu4q y%dCr {k>_˹{ZÄ> C`.(=u_q3(=H٧ي>9Mׯ!>={v_ҽҮ{ 6J[x!9GZ¢ߡ04Fz,Hh~G8n)uQI{: _Yd,(ز5 6& ;d C*jhəyX~dEx""N@>lD3\b~Ugo7+T9g8V_pg"iPlM6;E*=|MwK0'e@}]6Xc4=f=1)v邻X@K&d)1N+n)UeqV˸]ƃ2~ӿK 7_yŲjw>GnXC :d"M=إKQC +F[U r^~jn= l@-rA^ÛӇ+o`ƂpZ-! Nh6y\1Yi0IqGW,5A8H)pjY Sx|`g:%@Y]`jnp ik'U\dJ˙w}YGkn﯍YϢٰyf`QzcaO9]Ƀ8euFҐMAyjC"{v4!z'~}R_% F y#f;Xi=?y4d82 f+9ߨ`zT0m)Ń}d˨R8L-Zg)jW\ck< =KUl]Tvѳo`qhdK6{1{>ιH8K1euA{aHoʴeŲtMpau[7ka^9λ[*aP @c6Uw3A냊wSXDU*eZ‡lhS]B=/)zc/d'S|g" \4g䶄I e٦/z4_Ƙb)x1 (u8e`]/GrٵxA' Sj%B_ҧB?$ `{}85la~w`=, l6E){'a]9nFۚ}m>MY8 OOks[qmlqOj QDv=Ċ$ogƷr@{)0sGp cl{WSX,8YFθmO#",`~!W d5ד9DGckZ[B{.mHߪ5 *Bs%xt0<'m eڶ{$ m$dWbΉEc'VyEoR p nE1&V+!–ԇg;/qs5Mၞ %]al<ػ'ag;V}F* R)ka .Vd<.C +|Dgk fĈ:TfCFĸKIztu%߰_ѲwfWUn89(\39^}(CC95;L)G#kі5чa'M 0pK/>瞵0~ӋUWxa<7\K7X&R R IFh PP9)9XqxnΘ|M,K ӱZJt\m7]Xp _c4 Mq3+}|YA xKwVA0ugX1qA"Fǔp[ ~fMr[fו- '1L^Q_yڌ;5|G)hmȿ_T90P1%e3mJNѳ  u )c@6xt9whRxbbJp˷gMpȦhnd8, |hC"L1YM#wqcGWp 9OE8l=kiJz)(u nr,LC@DEqBYi@MN;đ0ea_a;F/d0Vi? @8|d^X7' ?@)WΐD1"K~-t46?Ԧ?ڠKXMZx%SD#NdS zО~BB]%%*#Y.:ֽ3>͋0vn`O\:( ^R”F92~ Yo9z( 76 z,d\(8i.?(6r6Sź<J"̩B 2= qa)_ΫNC6r.RF-.Q%w{Y@XwݼJPEg|oRLQdx!+U`b#XLLp5.ϕbx> '3ӊEj^ :}׷v\bGYb|p-4Z'w&a8aIkW6E(|=w(~Nvx5;jksSuwk6lmmdz=ǵ6w @mz;¡e@w x8gm vbSjS"ⲀM6r=W\XXv:wJ*|IPOQB\/nWBQG j6SmF3k 31x5k$h+X=xO6S 5H8u_%ʲե]yh` -P]PZclko++in|mRf#&ɸm8R#G,=v<۬RਂBNGKqF2/f\naKH6]/ &|om|7}#˺Z])!>F ZiLt{l'!Fw6Ȁ*3t 6DKwX=8ӭqW ?}S :=TѷRRwR] !Y=OB''qF 7T)FhnRI*Zҥ ؞ 39|wlۊ?< t9bĐYIc4Q( Fyʘ,r̂EiYKK]Lz-#&W_[ʄNnٽۤk3;?2|'mX.;;2Ni%/cYr:IJi-5 Bȹ7zq'R-4 6U%:s?33 ;t[+l4VaLQpvao^:(&WےsW&h/2;lDyjυl~kԁ&TNB8G"}ȬQЁ%m꽝yUJ.H)ONQ^LIM^Kd&|׸`B Bslfsw4^ݟɞ֛-O 9jl"hQ$N%Sq\NNNޫZͳcAp97Ԥ>P7endstream endobj 434 0 obj << /Filter /FlateDecode /Length 6342 >> stream x\[sG~'67(}"P^72ah aÿ}Rݕ]- 76էyˬЫ?~}m;3E;~wpOCR{O^T{>wNgRzۧ>8iݻ}HtK.t~br}b_ǥGy7:}w] :sסw8K v$x3} ӍthevЪCny!-ZFt.^B_pw}qZsНcS&핁p=xqr?Y GS.t*w7]/<H 0~{bǼs~a!O#tYlC&+  4aРJCFgD]{h9s`0wgJ|޹a2_ 1$8Bsa16QIl?|(tJ>}{Qڽ E"$Nt܄Š%AЯ8~Eg( _x"b'wzdg1m/]+-Yl%VjEQ7ahCai zS1^TRq6`rdؐS4蘔O[}ʦN]UϏ[Љa䍄Hn¸%Ilw͐ " %adãib6HQz#͘sb4pJKwOLɌ^]W#biB^R+:&>R|wdT/M1Lyg0 Xey8U 0{)j(#OHX 8x;)O´3^ )_zXmm]@<׈:5hA V? x b E%#(oQ6<FGҼoy3Жi_`<@`r XC1\vAf ]3J_sg=#xinjOBm +Z),Vz AII޶<:K(+n旴ViO KmKd4` FiN"!F3C:(4h4e`\m!~z@O]&[=>+|%盙cI#k N"g"@]Fܷ(g-aiVI|eS}Mo Dw&&·z|=ċcM4%= ׇwzd `GҞ.b(7RS $Ei~UfM;44JM7vyYI^|ZJ4oYs:͵³滿)n4/K4w\>*ʓPGa7 9®~*bm`w<$KץJ(GTJ>f+ ^13 #27K#ަ`)GI 2#Ih5 C3 (-م,e48|"G[sYb)4;"%'2>˼loF DT$/⡟q!Vճx.on+ 1)Ja5e6xgb]QSQap^>k'x+p9? Yϲ*z? 2xG `ZX`ǝ Kڎk?8"ʴl{W88׊z2Hp*{øvp`iUh ֡A;4|M_NѨ?tB4$(FT U̡a>tP] =+Vbyf3P nFg̫|C圶" qч'{Vي-FXٜmTtZdi[ s! 9ᣉ:!Tx'q~W&&ffWG9Ԗ4)%[u,LJWagO+H#kHr1!_4*$I?ڌEsUi o5&I>BI!dq&($1e*j*L_rIctH2麅Nہq8"*rHBRa6 /\)`[Uǐh\Z=7`+Z;FiB3'{ C-<+ O#jvp4G;Vg4L%g#9-XS'i֤!yAe\DP<'8 M_O{V@@8v'QLɽM8.;:6PJ~ RO8&ADgzl.9p[̃Ѽ(M'STB_0{7}["{ei,ͷ qio>m1:~ȡIG0;lbU$ IKD6I> Tg$k-%SIEF0~6VedHz~L+]ϦH0vy5"Lbyo"F}%GVƏ10pK ,Јld_,tJbA'#B5˗wBY-eb`9^q{E_HDt# wC7(8X<.I8$!v q ~G *) )<5$r pS?[!&@mN<_ X&Vܬ 8RƺRsBm):IfͬIҞ2@yܘ#=Y0`dH|PJ */W1TKEX"Е̿zCM}Xf`UVR;0eq zMI)L@#'$*h "0M;X7sK)8/ԩ=8g jzj?)~8)~E4@w\FLTEFEyM?C4tUE;:mp-÷}YmfD e} ׀ᅙBOÚee &X%ÇشTU4 8&폎(b7Uk u*jOroA)JYe@!xE( R;GsvIrꚚ4ΨFY0^WŘ sg\j`cnN߀!3KB Oa-Jtꍞ+UJZi<⌎B݅\%68+ZqM;KaJN|&xQNJy-@FNR5;2ӪUX(k#Ps)# =mLJn&.ʊ$p?4\AͱrЂ= ,Ś*"i{euPzeU>\K\/fK]i?angopۗYf"Et^p2[@v픳hq Ec9?ʌgDFKT,deʣBlBr17!YDHbTVd8`_cO{l6< l% !fE23%5鴦IkzL ̟ żws[R\W%mJhz0ԢW)o,A1!2zdΓf&Wޔhٰ̆u@_#H؃SS{Y*@C k2Y^@ӥQW0KHUj9*`?5XX1EAۃ)}%тH3…i`{fctʎ-|mwo4 2" YH! I_y][os,4YR]Q'.034J].s%PUeDžkS ހnO?;k:ۓ_{vN0eL |Y=cIу͔vZ0o[X :,mˬEۮ.m!kE}nBBW.xOcR.2&mm2+_}Ԅ:.*vtL]U&;[1"^)^X)[!i_&t=dpf2˱xXZJ|pU$Ϳ2'63e42˦E\KvTzm?_(D$NH3#oв5K)eX)bC\ki!|1LkVAew^.$/A%oKS>z$g]7ۮhrjw0r"u^5eǟo4Kӗ'e #fFQCJERp S/Puj@ ~$JXz}XEԘ@Y%f? y*`Kx_6.H.{f*ܫ|VNǢQ$S<0Хx+LI'ac1.4+QnE`C%X~SIiZ.ۣ)(&{.6:aIpd>#BgևR"cb 3p M ^Kp-+˸3&z}OwdEYIY@˺ŸGlL7nӀ&3J|/t *\|Sl/)Z1 .<|sڅgy,rCŭ(_:ޯ'!KhLOVNI24]L7g9}09gy9XAs0Ys~[m9AJ}!kri.?ƏCPy_Uμ5V1|(i-$ e~=bBl c,>M'Εm;÷J;N,:P7(`.i%+XtR] K\Q_7BYBoҴo{$X /,%}oˇs\D`&?%*ǻt?e"ށ$2ȁw*聧+V01.Sp/҄o4MXI;v>V)r"f|"pUȳ?fflu=.tJ9ǫBu_lL>kDYuA# 0!q\ kЕz* 򇑎QYse\E>e@?WtU<& zoqOgO P >Nq?JЮڮa^v30AsFz(8Iypo<ѭº5Z=2n[eI&N~5w];> stream xzt׶aМ`e dD B q&mȖ%"˖ 0!@h7!!!!g{GMr˽]_^K [}{ ս%D V8?k,zw3p:+ޥ/jxm| ! #wzz:ję34i„l܃wZJ~d=4b9^>(,,l_`ϏG3k:]nZ>|~PA܃)ly~[- ^$ttٮa.+wp]c׺}6n4y!ӦϘ9k玈u9oԶ1q>.jG&FOeIQC(;j&5ZC͢Qkԇ:j8eOS# (j#5D6Sj5J-SۨEGbjH-Qj5ZIMVQө =ާ¨~5eCP)ESPqN5I͡zSՇ>,]ʖKYQJJ,)Em!SjAn^>n~}gSc,DCEٴnb61=(kOz){Gg92wdx7o &ɮekw{\[oεyV?>8-HXI蠹 \4!~C]4T70fÞ8/>|1\0S o1mDF^uWX%m1t6[!?m%̈(Pȓck]7_L}@SFhQ֨j*lFr@ :ǩS4rH@Η^pK"h;ɐ2Xg߶R%FޢIBݮ +ćP7ť թi*<{Odzv⅜ 8O? AA4<o}Ln-U/4,Ňf&m&0 ,my1n*e06pՒҍ*B!^LakYAM΄TP3FK1V=4JPTVb5c2u$+̧߮bҦf!M‰m (l NlM:ItDw22mI/>3/'Q0ߍE*V̡wE/m\u:J&/J\̣n[⩔}̅E=y s%9(3j%htᦙ$Bf'UhwA,zok/fz>?~38>򃕇K V8W8ZJO u::omЃBWplj *]U$k5Ajs)r K2iR6h ͦԐz3ҞPn.Bӗ!SVhn$Ԡc,y{ߌ+~Alf䐷2B9qE2,02{hyDQM;N m"Ӡ]DEHg,JĒqx0xȲ-C^RX6-څn"4qh$Zh"'}k+^>+c ɚ s <[;/hCjO+*$ u<򧥴 f̐}pĐ \Ռx0 >Ґ@`~hj덻MS6NCVchm+&CRLJǟt6 "gĀESe(IXDHj~-]ķl5Xb‘-Ň~'}fM4B34{bm̩S (rkj|94ƙ4 fs %6m?J6a6i 鱐W'Aw]OME`/ ؒdz~ZU!Sa1rCY}(Xlr;"OL,$EH5 I9ijuI р!U).}/˕x׸ed}Yw][D_ N"AZGsC'+!.S'(ܫv@4R{€JD&Je ɏAjLС`#_='\`󤍮9dAfͧ}NC^Gjxժ~yHVfua-~}:SH4< `4OF$pbY+2CF4C' OPjcP#VT3Ja_j3=F3Z 6'^s+7D2G8X/>;5 nB?!f\W"T+KHu-;D ˱0ҋ3@#޶ ^LOٶd}mPL\rSp3>")~m錬L!|xso1B~ zfdr(JU(vMdR6rB!))q5jy}PL姲WB ZI_Ty/uz&9 5+5"[?󻌂;PNG[7ʗO%wwE}.@3㟮_#Qga5|@tW9u !֋УGGX&_1[|ԘWg KJ’?8j;ªW#rP&NY#QMJ*<_Y~U*c9~SqXK%K#)QqQU +uZ6єMzZ'ܐ*3&QF䣯x2aUӭm+׉q;~ŦV4Sz>T=6X.N9!X} nnfbe~Ȋb]EnrvHAGNMx7+)V}3x81^_C.ƒf& `GctܺɦV43b Yff?v䆃>vvPH$| Xk F Xs#d{MEؕw$&2 ry58v޽G+ MRH7jb;`Q̌%SOT|l|\?&la dW)`8;|Ԫf0k=ڶvrɾWh &eyjյju,//!!:wOi6S BZ͘Ʌ`zy4uٸhbj3JsVgW63#M[n 2k~"s!*B9N,CPT^CvqpߴPL4ǂp:k 6X$0w>MoZS1ҍ8RiXdU.!?mŅcBxFࠑvǨ*$c\J7S +(PSk.NJ,^dX /6fꡐ/ 96yrΒ_CY6=1ƥȟE7Ϻv(~UUv_c#Lw9/FAAAT/Fo|MXW{B$o&p (@pfjta\)4[ZlMh3SsͳǮ˻:"p@9k0MvC6+DxL^"Dp:qScOu#G$5}dd RJ q .'̐z NͿ{]Fk?BL2 XHdBE8Pà؅&`Q"9JM_q͹Cƽ'Q4Es"9#05gV Qt$6!W'طZT:ULVA8^(ӒժT9?uVZL>dH#t%4"RmUz7lxu8J+EVdNNl]wƦQ {yIp.ՈZ(a }Gp_ \_Fd'jD%5l"p)\zumzGW6wEx N%xw[7O@r4MFÎA(  ]p1`GKtLhʃLu-ӃH*R"b! - .Е7xn\4m`s|[5CD"#1@LCcJވ$V!- TĢ!M[4d(C<(CPfUvͿYtW FSeY -j TDKB\ 7RH/`Wjj.O+6@$ ̋+.(+q sp\j]R`/^ݰK ^T~/[\+  5DZƶ UV*.7\G?,~ϸzm4[g8sj9s:K<%TqI:'M8}ɈW&N( & ,ܲ`#'UDPt 7C@7@ߣnuxtI!欸>ke%S1=Lyk˭,D;&L] yA\A.*]@@DXЦSo~v)նݫCCBC˫= YYlemfHn+壩h Xf+KS@ N¹k7c•{LH0_C]xyia.QP%뷍RKvCQ{/5"l#Sg5#V;>Rp?hJN|Wsٙ5iJM_ etG*[G\`li͇c'%0lmFabѳ:)C~8AZ8d3O6Nm?虹IhQrv~6UL'/mLa6a7TV_VwrM*EUDRB='`0osжs ?7yBw:#H}2RL>jOM_Mð1P?3X5~B{O)tޯќȥz`NS rm۩V%BIJRA<#n2;(߰d^d2: ϗ!|'<=t@PNo Q3N1-%-DCx'tG/#mңM>׾ ,Vaauԣ~VGfDᏉ7,5%9Gyyrh&si^"-IE$,akRpZ%qL<$FI:34T.=ḧBlaoHۅym'Zw<ԕHm<㕴}ѨD+b~MB-_[բR K?oh=r+"0((^NdIV@LO҂$qq &)-%-+ԓCO.3gR r{I?q;Frhʛ;\+8G wg; @ !fs$o:ﰐ/a dW9yAD3%C횗O *#W["= 3gB>fE NaKP楔0"o0B^nFm#tɢ`{"%!)p(;FIe~)Ө|4 8zMt~;}w(btM ֹm GZl #fَ869p9q ^j?,m^vȽ /^Ȍpa;s›`'fN]Y뙚_7wك2~)˟!'& 5ևƱCܠ̬.2Hܖ5be|Hӗ'p uOQ;'{o|ξKuM ܠ5kvLU)$G;.q[@N>qWZ]?%}A$nhAf?|}@mwlԧ$ 5vw (󠱦 U.5%$s * bݪ`f8qoO:M#(86Nضe J@ Iwp + -w-i(|yK;xG;C41Y_SQ*wH.0"#lt}azo2Ct|WUTDS&׃QK KQCx{"3,&^.TJJSk2$DWZ_Y6ciWxe5֖ ~8#DpK,&EV>h-qE;o^MRKx wB~>'9j3 {zSJ_/7h%^! ŵJ]i=41g\oQZdβ2Ӓ pg  `ۚɲҏ`5HTSYŜxfBQ$&e Y,;S?F"W$Bx2`wCrIm|3Qz6 Q&ֲߌ}ш?-&xQ5:o(ǡH^( Պ$, c8\k."(u:(7cK_ _lyX_TVUshUR}_XPH.hw^_uD?7}?V>3vGQ+?=C4JR@d#nU)3D6~>>TP -)++}v}xk3pXk?EwP1KIchL'5{1dkW_gfsZYA"S{2Ddx=I/x1NF{-R@N  7 I7IȪ*.!%* "3HG"pܖ\_6v+@d"3T,DȎ=Ҥ(S/>EȧLVߞ"Ͳ١ N DLlVxXP'+!'?5;[kշLeDW32 }^e ygtwnlnf }'υI̺f _Jm2=`O|u5dp)D u3p)dd=̃d0^"[=v#txt| cAʭZ18Z*2 M|LGH~u.}艊2E&J&ʔߢ-/?vŷׯĝ;/mh]l-l?dEu+"*Rpeh8f2g* ^e|Ud$e 5uizǥ珄zW##zi?]{_䞒7ا330yޗkY/7}~*ԜT!rupe" 49)Ymgv1-)$¶ߥ\#:`4x ^>w.9sS&@HsK_Ps"#6ҋ}w}VWtPL&endstream endobj 436 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7379 >> stream xYXTWqtFCTh^4ƒdcIL4tAz/4z6CA $[,Qcbllɞ};oޗ}}|~(ν.gb5:e1}`F mzŸ` r=Gsx\nZbEZzAf13-^pVs.OLJ ]8㍄%7'*%kNZ7g KNwRW7gۊ iqoH_*;gMڼu b6LJNؔgsR֔.\xtfΚ-yE9)` TF΋iPf VK0˜m98+899+9s8;8AqrVqqVsppr^ggpI#r'|nQ3k  kb-=ʥPAoWL7yɏNxa'm2hV:A+ AGhN ͚&ri~n.W\EcP>.%J _RF ۡkZ|[JT0^KGuQ!J)06ǜz.}m8ChiXfOqW- v#E18QS ĮGiA39(Ġ-RSչZd' ĝ͞w)űĦH y”qh ̥zLU^:RBMZH/cOj:hR[QuIJr~Aޱ̽?$1dI~+=ÿXڛ/| ࣤb5\>!g{/٠ЪE4;0&ʕU4hV^a@&Ɏ'j1: j6_`~qE\A%WxyoC.ʎfIv ;m ш/N^GStۙM@k35)Nݼ-b; z(U^_MZ|nǦtvd:Z {6h~}A]#@ h# E(o,I~7[z̔oFBRצ7zOaۯo ^۷zz) bj#K%e=e8>USij!0,ND}Dj1hrT%@,A:>"h qRVkŚ,ZSTijP^ /A ս /ցB]D IS,~5V,.wyȉ:IZ $+e':nwx󿔱&^cp-4Rg{w^ 'ɺeHJ}jFq!u ]` ĥiԎ_ZmLXtM뤒tRKamE}k/Q F%f`Y̋IőNt2$DB1Np6~)TJunM"PV3_+MI,b-x p2m{i{g`VE+1?Rf*y_Sbү S:]herOŲ /|[Z- |_̉jȩ16uV(6bX_91fi`$rW^"UfU- RSvQ|hߙ}_]mns=9 t e&mS%KA!x7ɖZrAel/ŠXNDȀ'K%5}&L`ik/v j>QhHcxjًB+ihNbjCԪ pPsuP6թɅo=SwȘQdě-*, 6ØDN"|*e.~eu_ ?1<9 bD^yL FƄ]iӘD]% z|.AZ-be6%; :i+ՄNŜ_y^zygМ3( o{4zTrADHm 륧{P*f8bv8cp}q YɝFy҆%AS~NjFTvugtZթJ\e  [Gk.E`;PAXf lH8c8㐙.ӕf ရ読f;* hb S &NcNM-|)\yfؚ͕t+h&fKh$>XEc4 `q"VLK/S(/{}A%|t: 5C.Iu/vԠi4bQ3iF q]hz MeܤDJGfq|޺ik-\{R. i3yH[-@8WsL{L(c̯+=/{=[*nЛ8l4 *i~$Ks}ᩜQ{R?K=zoc/QYm_O{% PNI243݇_}:O  # UplӇ[[Z:K~{pLcV1ϒJ\--!t kj="=f^_\fSdrjB dvl(BOk7ְn+{4nA>zh Ð'|a!͎7gB^G Yu4/I"TWPlX&h1z}R8"c(zA[.0b+(G1@?.jq2#sEm퀹i,҃u\fI;=<7Py DIEIlP2G~& 味Z[PbmumP rl_N5PTX, E€;$㼪7XMT<`Vfq_ĦXMH<Z)S@*kl$ VsFV\Mo zJAr;@zuvYjZ[ ;d[p\Y#$d\& <˥ٓ́ſa@&0h'%XW43n'|m\Ox?'_$PMKI ɐWe$bc pU2kM.L@-OUS7FNb׎pv<靥8lpmB#GS;PNWysAvF}OZ^T.p)6{ ]8Z>A'\q[&M65C9[)xG"M>\#nuC'2-.a:!\!BiNgmfZbJ CSH44k|^B׶J{"={ȻQw&3.z|J/*E}myc/ZݸىL>jẀ|:ex Dqj7"6ă}%MDyiƪ8ɞmЮKgIY3"4J}X.3<̳7h~t]7Cq$`茭t@!A_n8u!`4bVإ@P"V46'Ƿq=7=طḻH2Ď:O.2lOc҇afh ֈ6JBk8j o-cjB&0cIMT ]|XZF F`GF7"h׀ZRP,[>8Ǘ>'%PA]BAiF p,j WnJɑh7PѮ6\(5"l| #Vl;Ws;cHuꆺRժP 4'9^.a..:ی6w6mڥϦS`1ittVSXV]yzG!F0x,z|,c(4r`Xzx ϗPs2a[Q"U[CB\4@>#pwcΠ]R(尪{p+qb=2ɖGMldA.dSе(KTJ)ka:uCꂞa.%W$^s l5.@ ÙWe="[WwQ/x_|nf7ȳtc?5`P#~> xG/HxBg1u=oך{\`' qSd6U%3‚gF@87iT(go:|+Ш*Z_ cKّӦPvJ(U*F5*)*""1)-5OYUyߵ-X!!;7ZnbnTs1oy(DF>KIQf),}I|SwBHu{ F/~ޏɬH+O-WU@9LeivϚ@s*E/} =| R*ʋ <4-vuS4v5=k+w#D _s~s]iW7?7uCO,!,r;}A,xw\ܜ@)- _.j?{6NaǬRtzdȺ|ʺ]_;ş .=:tǬGɌəBs3vm4H5`-Wf$z8޾x \ev<;:v(G\ ڛФsG@/"OIqTQڏc0eh+O+1^$-*RѪTFiK V*TcHHҤF{o£Mb/r6`s;`G\4jYC±\if8RȲ2Ϊ6bq*a$!B+VXd%yEIIZ']bFa=2bG>JtZ$|\,,;CzGG;O^Gf55)\s#emѩY#vhduQMJ̪F{= &`xpxlxXXZ*wfJ*15FiE2LEu*7<ǾLq.+5ETXX=ϊ6e /ǃЅs< x\NLmɮD24Nv4n~Y靏֫tǧ<-@tOY<9- |CrqLD$ٔ&%" EFb&1K}?U$-|0:DnA85~qPsJ=ζ]o"Y}F#=R?]J+q;FCË(z#uZ͹Y@$ȥ3k,7ШV 1Z"1ABO~G"37^ #_]8#Hʊ Z( 6%m 940z8 մ(:vj6i-֞ Rn#r< '2{lsK#g.5c5O6endstream endobj 437 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5057 >> stream xXTT־0^^`516D;(e u(3"RF5j,1^b.1F}xHHo]8}o.L&f\5 ?Ie]r ^fY`/{C;腿#ɂõF98yԩ82yFOFu:'PF?8{o t_XַƏ 1a~K}B}B4>ήAa};cVp0g`o aޜW=Fz^ݽlS) ԂF컸kR>,-(I-SmnO(.QIR^8jw.89$9 T{ n?̅g`HkžX^$.*~c8rW) Od7`QY5P2\2 { ]f/ K+T܅ VO]U\*]џCf륃ERW[8\BIVr ?1@&OL~|1,H_ߋeZ\ +'`i6\P^f(4-IB98>b8x2 %$#Qȡ&슍2! &y\krP;sƓp6!r0T()d~gtz;<@F o9<xCq=}UĖʓmUjo-8sđ jJUv,9 JJR{ /ؖƐXEq_gۆ=$s ˀ2Q*f NfIGO0J2uyezhJ2q3jNܕ~GqwS+tݵoߺy'`P78g jVCFnFfҳ]0k k{Ѣ; c |p TYϞ=E^.2p"vwhw@$eQYi*llYWnJh9K7(%Tu`YIC:CHCLuV D/'>=037a5fq"T#  &ɹF1X.u Ő+AqĤmbrpt_( }aDeU)! 5 hV-*x,&Sv0%0@A)(3o3E)/Z8A)ĔL+K!\ ͧuʙqz'JnMr 8LՏ1"% zuU/#f,2wwPK?ṙ 9/]d"r?}c%WmxtvI74k .s}T⦯{IE|I :|iSbqF̹iRfgM }hcf}uAMpmmWoxMt=^Xp?T2)^r22/o|u:Oz'*IWEܯ8mfts Xڷ]pv[/vCb98@XBKM(L8k=!HE9 '$*\a3sqnuK Kꓧ%b0\ xB`~3#2M[NٔI%ϱ9)0[?:AjzF LUL4E^~“ƒ@b8Y]YUS]P-ڑ-P Ǎ>S9]'K@–fBYiV.J(0vr5^ SJItQ.Ko s-X0 B:* X^ϵْ fC iEWgv#nCҞ:Qn:onӫm9^pImF#bv _F>l _#Z{9k&vOg z]+6nhu{}fš3T㑌 a;g|ŷ1wTeۘZeܱ5鑀a0W%Rt7ܨè[<3o%>:KY]PVhHNQ۾wo^qiEdZ奉Ԉ^U4)wdy5+wl2*T34- "|_/=+D:mUFtB)ٹ<ڥ Gᓻwu:pURS|}R[ۚ7FfFe!5boR7;\hݐ9H6=Xw$`rX6]m::]NEr|RB dTܟyfE >gq9eE؍8fS Gtk AS ;5)5knG- I8>{J-vԳY!=7-:f6@7 i;M蜵/&q#Q)Vݢ >Ԅtl9aX]qKy^yrfڹ[v;_aƓwȾ9IjT 쏯z^G}9z$ƊvPkH6$ ;_LI!%+Sɫo,LoZ5pYM#Nb2G:LKlߢRt mˎ[3v N5L>"'ig0l} opIM#yc,:9ΣFe估BN%e6M0ؽ`+ѥRZ!9P0fQDԗ'ejv3ƟfӿYF pw'|Xkʼ܌ 1^̀c ]m".ޛL:ķOkh_j}ӂ޴ŸH˄$2 G۬Q#F6~SU~ӾO~|stq (qcN2u6H|\Nlzڥ36l[{(?-lrUq:Qh)Lr|ljlg,$rKbʈR5zީdx Z̲3G.p m5Z]iZlC7FWCm?FB1j]GJG[J)՛ߛ5m,/8*ӑN;)\'aTYefEQEusQQ4u3uuR'<NY%1V89Α܍$+%28-D[%]QVn-ށa{.endstream endobj 438 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2484 >> stream xV{Pw]AnmŶ-jRhOZ%!1"iRzSOQ;7(j ^VRa**z=ZK"`ʟAyR-k<~ҝ!ϵ6/Fڗb(zjQ-(D rۋLPS_j}A*.|eCR) l "^^A;,' $8S1w7ymxQA4 FTC׹IX7~Cߕx)VH 4n O3tN ~$\K>(KUYjuQup|jk7+lAUW\PD~6!M6gBhq1f xڡL?U;L}·]*C)Xx*lA""OX',ژ!|DP0B#+dkqγ@[  vS3hۻ.pCe} e׍VLi2:tr y&W֘O;~*OX®rlρ_h[ي̅&`g1nݖlu@ eOBrm(yz̨Тu`>(X6%1IhwhX/8ശAِ; XjO 5M ɰߖ9HF9%D3),.K }ݐS/`u/<[ԍ< 47{k %08 u@7Oo!*-\XZnɀXI1NC6l}Ϙ13LKMY0A +s߬:RymPXՀ]-o?N"!)Ȇшk3YLlE ,<^cl%0hkD Li}NJZG `4wnpt(Y_WO\"E]A\q=s~ uK*"P*'hSb+6N6* *r1fմm]FfdbzƇ)~O*>\y[*sw:+2}͉]:Yz>4hyCeo vK( 7>Zfy뿹p~L>D쎆ma}4t06)-zirdd<4D~٠/$Fkx#EܕuӤbzC?pU}RRO:;p(Q؏m`>CuDd ?C#} Nb1[gd$mNl7',{F:dGɭjÅݐ}eا KyI~[dji;;}P:HB3Fdo'>gXSk +S FޞD6XY[ H>T6̳kԅH]]CRe^]<Cs/PУ iOǣ RR,>0"sj9=!1b{ļ_ts&s'S]3#QBYKNBq@H&A(,S32ꃕ%0,5&ַ^Ez2 Dgx|VD2R~endstream endobj 439 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3017 >> stream xmV PgfE$ʤC o$$FEapr 3oR e1kZkt]"b6fݘdOnvR]S}W0B\{uB6An$tdhdm޶cd:Q(v[չzEr]d⹮y{/q]6BInJezZ ##c~DBwgu͈i]cbRc]W'%\E$ĸ>nʤ]T׵I1 8HLJ^o.^üʬg60fb`ƗYɬbV31kyyqf\#f\(#-eNtXhUɓ|'u## LI^Ӡ9i#''nHi9ŅˀKרM-lykSI$J>%3s’:/͒Gr<*Ң$*GX#*'u}yrmm2}jnqcWc Xҗ o.f""ÒJ VѢ|K)V|EytYYL dO||A $'j@>PwF?mnnZ`3l|0D-P0$XB7t|Ja1CT[uGeM>!׀ 깥=޽]ޏtKpP1鷠(A%z4 =msD͏F#dq+p'&ȓm⨯Fţü<3_2B*a>ŞeANu).):) d[N+Z/Zp5D0!lhnnt^ j" j.F٪ʯ:wG|{͉/%5U q׾;퉛Scp%[ 3ZHіE@(b]7S[w6,_Rnj 4D`3HY4*1_Zp>̞6m_seZkhIV` n;E"q]0޻)9,:l1W EsuY'N;-4GS #,+h>E6DRa.S3>7A{Wo*3¦0R Lap*KUpHU-A%bϠVt[j7CI-`)]4`Sp`7絬J{&"\ ot[ Vʎ[8#NԄgW`q#~vxKr{ֳU7 mM-䃝yF4C/F "^a/%N=U G^*`V6 k̥BGǕtâE/I\cCi9[ ֽq "Q!"Tuco*0CGU: rKK F%JIURsU}.Um^3خ$r eY8Wr\:xrBOK?t r}0p7w~u>[J\XЛߴ'܏}DEDw &… e' X$e|[z4xoX8. cx.VzTH fyH6qw?HXԘw"Dbcp2>7X{ߖ \Ҳ^ꥊރlو )W ehTat%-y z &?Q[T^*( w_~9dSTI{N|!;㏴'[pùc/F)WY_:oHBID0@suȯ7* -g%;TMl7O,GUd bendstream endobj 440 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1954 >> stream x=TyPYIu0:2=KF7#:002`MB`L0OtpQTH[%.T 17y<οQhv6CѢ_@%F>V^x1xQ'쩓K-{Q/C'GOldžXD6m⎣_%ÍN]l5E %+Ac%$&ѰA7 Y F*/-qy(ЬRϛ?uq]>TU~S8O~8 +98NC>twN \bO4n!0<EyСN1_^s|ubwPmX>*E^ f~>",z+VlOLZ<_0#Em𮕬. ylrfRrbjlqK!Jb" u #OzQé5Q޶S{&w؏2Q٩-f@_{0s& =?6zuΟo]pY~lvΏ/dCp^C eʖ S .L)~G(=k7/nKήt8BCRYfk{{ Er<#2KhMa[c$}"MJ6vZ`6 .^>wlwkeWr}b>^AJXl$/YS ç#"õVl)@GaE[P͆X`I y*(8K\/xaH*1l{cc(?5endstream endobj 441 0 obj << /Filter /FlateDecode /Length 7354 >> stream x][w7r>'|93Yݸ'c]\<(ڈȤ%Yߞ*\340Pq#/p~}w6_|&⿞\<%0ec?s/ΝqCPFn/ Xc4A8y JAwM +Mqt8jy+ӄܼwX[9JG{۽ֻHd^yvpZȠ"0`ɴ\^(3xkӀ(N):R#v9n=LɛxG?~{!0!c0*1`|>d-ڙͯۺJchPvE*lS,lgq߯гiq!}g{$gK^Xun]`.5$yN(x_? 7CrbT6IؿnnQpEkh ]{S`ŏBпv>mďqy~D 7 zD4 mQ,V"u=*AըVL2UjRQq? jʨBD?ޢzFY :޽=KXT:kc"ȵ|F$zvcPύ`QwE53 MXpqȨr~YVRAUMr/u[o!$DIst.*R4NhfvWc{Wۨ5Q ي)k4L8Ul$  `SΏ(!NX[]Ѕ~֟.":v4ːyo4j.2UZiG6lRw2FK_a918oBE@3H_ʂZ^k~)b_$t6̀^\d7oFtUnNvfMPl_Βoo k4=7_#Fx%8 }qo 3‹8atD IMS\4IRKet~ " ѹu&-iRK >.i*Ep(T+LP&^V1 fhPgm2`[Iu$Ocf"Z |M߅X84Iiǻ;ejQ|6?Viϳq x}ƣx`/ ThfaL83؄;Ub5ݴQ s8ԩ`!mzn u'?$]I>ցG=h/-hW!I(MJ`xb?Gi^l@*u[řp*A) D:`i8IzY/3 x7?ttA[H608c(4AOQL;jxǝ=iB0*:LD"E]fL*ja,2/7۪Tޣ%ڛTSGcn;Z6ĻiBOV0Ўs@z({b^E zdEjN ZHAE'폏 l@dOٌh1Y'X$yN8ά>,e=rli&1LN w\2uPz &RN肱z{BP̵ݑ*=F(78N- W#;dO0!h&SOW>^0Z }j"#2],a*d!<~g/Ol*HLܙvui%l瀲Hw9zFQŘDEUA<3(i}ۍ= ʧ&o$KQ{ 3o ՗+f2ji& V$ypmGY %Մl| b>m>JL3\KgαΎJn3V3@c2`^O”MC.&p}d/‚];̍N8$#pF9I'rq9xU? NSRVN;]*.w0 n6Wbc]3ڧd $ųLϕ4b"'$F'& dUS\7D*>a6 _"ILң4P-b߾L(yPm\`\0#:|2S-m^mj`UrR9KE)қdo,ܪ`)(#eS:ij+ z9_^ @@lFlF=c) Yp9)|KG荅F;9j_҆`n76gnb}7Xny*[.nO7L:*=);vj}1a r[OY{r~ȕVbi#VųxTEacIJwIpk*DaYշ Sj.m!|>e709„1$ nfHgs#:kTV%nsW9TAarsT6)VjCeK}s4Ep. ]9K-_oPN}EaGL&BhYb;=vp4xs;z*0~yfE׶~9.0#0聳֠~ $mrkT?FҨ| WFi/[6&Q֨| tFd~$iiLK_2ԭ <@0c'Db}~ibBcKÙV`}i'U)VIw2xtÅA˜໗&i+U+ҩXx"Hiɺt~8M$-Q/'FHJp*Kʋ18t0oqDdt˫riv,[mk=3mU~̶VփPER[VE+l*ʑ?QKu7?Yna{;m=m+լ*^ѹ%*tT^N.^ Qou2u4܃zAFҩ#PR::w1*'S^R'hu*u,sރzAFAkW\ RJ2H)$8pR X5zJk PHbU+!m{&ii ]:bQFWtxB-=VTw dB= EZdW3wQyRlR&nfRfYZA`3tAh{fZuڽ`Dޡ8FDXi|3u KJJ:f{ZވZHw"'n[v4hzTz `xgB\[z' i 'MGZ:+.[3ⅶ/JeY/=M$ ^b$Sz;E:WR[Юy.USkPAT{Z^^PQdKtzEJG5>QCVGW{5JW(1Q5V,2$N'&/V]B.ػmj8aGEGU0PaLkա96(z:,AnOcO`5;䝍kȣ4=h#˴4qm5ڨS5$]d!ޣs'kNYF4u}F0߬4%ȭk+vTTMj[ïm4:1:JP''TixmqznKZm,,q2Z'R?Kq>GZ ke>L㲃svVJBnPkp# pD<o݋R.(M 6:(& 3M|y8|7 htߵWqb?|*S>2yeИ)DDPwsiz|d;fI2X3uGϯ=Hn| Iա[ĕJKou}ߴW9*Ҁ|-3Wdz6F9:c(Qt6Ni&u}]hI3ꦐgV+X͓Owr$._֮+endstream endobj 442 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2678 >> stream x{pSuoH.PnMBQ R[BJK&miwgMI_^DaVW|!:Pvuug#ܹ9}O@$L ĵ6-KpwO:ثDHBRB_ 4]P PkCYB|e+W-?RZ(+ڝ_"ߜ-TA)R.Rh Zfҥz~I|l EBEBGN]g얌U4:LYGQVBD)[WmVe=WT3D&,EG4LQir˼$DF8%?ƮL|ɮ1v2؊ڪV+S3.s2i'.߰]G1>>Osd^K0J@$FI^)_[J:Ԉ&DON\wOZxpL9V |N-q=!ěj]@7Z.f4݇Do-\c_Qn͌E~غsp{#@^82~"^<ղdnxBEfЌ]C4/ V wj0"K쨳1G} 2LPSz. ;rS IUliy:7gk49&(Alw.FL[ o2QUt)ix@H'73&:K5O-$zZAMeӦU _ ށp >ajŢt?'@2' q+AYg"bg8Ez)ACudzA5e/hۍnm6f1_0AYTĜ j2-1A-0eRh3 nòR*= >ÕaCPV)dveI/ޅj(qճޠ 4tF=.@ɸܯhNAyڄMK)Jh'EpՒE,htUu66OLkե*{Y7ҜH Я. .C̋kibFBю2n[j+*dtҲuWXYr 3aXBЁV\A\ W(Sfju:k-Pw(D3 Dd]`gOFG|%Zk Z_i㧤/*䗮;V{{*خ+B wa-DU\̚0PXprp3[iPKStqmdăYENu~nahMo}yhoӅwVWu5!kWqT)}+-%l>f {$ iB;jhT/""AW!D~ uX1VF㙛E) Vב$jttP͔R[j` +*"<"sQjɳ[w(׺nC`ApiDèmstNjo[8WdK< ?GZv oqĆ,Ǐ:?fxMV}'D1J]\Je8lO=C0Ll:ǙG$btXj.#e!alosl ]sKEߎa~|.?EʓE l*V^F2DFw+4H@0v#%-wF%~WCڑa ݅&ӧ2pfE EWgukR)+בcsLTJkNLX?$@Xssߊl]VIC4t9U'mua14p-f/A{(K୎{1U=HV.5|ΎWp`+D+*!zZ8 >A#D&1'o/-,*J%flj0W(\o~lN{aj;$LTc |kc1့tLrj1A5 (.#>OCn[wX%a_/=;'TD @RMwi?mq3B *D ߝ"֞4)TD?vPendstream endobj 443 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5760 >> stream xYXTֽbc/whTDP4"Jl((AA>"eP_QcXMD9g`&/|ᔽ^k;"J_D%6vvӧ;F.F 'ލC ׏|ql lDE"%>27q;ƛM7If3Mgf,smf@f|v9[k>ujppG/)>2':;˂w-0[l9͏%>^232oZx[,]LVA!NBw؄\f.n<{z͜5{'s?gEoumSMAQSk(j-5P먱5ZO6P({ ʒH-&Sj3J-QQө5fQ+*jeCP,52L(SJL SՇ2RQ Bj5ZL SFZFRBS;\l+Vѯ1XlpJ$_1̓>^}X?~M < zA?54RJI݇ R9C' [!&M*L6v۰a~HTE5T}6<ypw*L(%$G'$ĠHƫsoJT\ `]1%yzU ]\&Qb!Mb66v To\6%.# U8nߦL C6XFK}5)W7Yw^ 87+[H;H J*Pm& 0Khaa0}~ }+ΠvX ZtUu &`#cqjNj/?_\򲢚#sXʎ~_֣{ozkGP@"x,]-zbX,?x8`mDuu2;Eh{nn*!J4Ӑd23>GƆ+KR!<>ۦ؆BHs6왜>oaخ]Ӷ˻+Kv!F~$sRVɵ3;K_0df*Rt@V@ ] : oڲ1拀0ޯw.`O ˊ>2]gJv\w:3ñ^6~W(XiMx)->$C&,}@"m, SV@?Ik.n?Q)Aa\mLb3UYЊe:w4ܿ{NL;~Y2B8H9ݧة#!G#@%EUu\; [7ͣ<}TH:#IC{k^SjitjcJg|@g>3pG)|ł%KNph/\KcEpǠO3zVO?w+C dZ*P>9w+BbH [;(H4Q(C:ԟ_JVz#>mBﮎ<u8rR+!sNjt=pGF@z!dz(3t}3VQ3J/(gz5]JitNlHʂFdԖ#PcLfzQG#K/Exeamns*rRS R\R^ڂ%'[~ ' jF- L4aO$Ģ u s@qqf"7nb82hgp.SwQ o1fku=vhAxo&[Aȓv>=cG7J0Ub{LX+&;`DJ:&:\GZyif$c-E*H ^N@ܦs9Zd5wwiGa8" QkhRد}_EJ4MKcS ޤðnc>#%S,)sIHA9h/SZ" sܿq0z-w] bkQBxLrp<1s\z$0\q򩮥JT*nDxɄwmHMmK%.\FNjW_i]g6"1nQ"}󙎰wNGTVu&u-JFx!J;#]Iv#. *I :VQ^3MK\c'Ujh%_AS?0؂[]GAbzy jȪp#Al`Uy ag""TiCZމ;). i5AKG zI]R|$,)-ݯQ=;wgSYEQ(|­ cѬJfwJ&a[O?x%<ro v1/Z뿣_]aI.,z ,Ο[/]Q koK9,e;=ؙl`m=?ݕMO>ЊgnvօʌY{S\_WҰ>zSV><ϵt+b&/]2jvp5xt|le˳ sC^+37w\q9w:i #}m^܄ZLO} '{fqy e=Dj$yqNMm/^0g I2 Q`~o(fнU C;'( 9:{㍢"㧡l68( 0{0 p¯bU`GklFB,rL;:MſfFGIMrX&H[;(\w4NI$^N;}>%@^r6ر5A R#+X m^^%/ST$IJnS.^,%vwBތWuf/W]nմ ZlbGʐ2Y@`njk ~D7\&J))]Y$33 dbFVho]SxKq|h 2xcHn8%&tұA)C`ʺmN B_r=>փǥPX'i<\r-/]ʜs>9uEA^;>\0' 椿^3adMaAʷ z;9я(:3|%Pƿ$ x;pҷ8-X >3|F;[Y)YY B)|"tpdJvr1K~ VKcxEX#:.a2X*/F!G'27;vsKi7oC/K(Nxۙ=f%'{x+:Ą`~0l",VM1sI.3ta`7|}эGkj/SINIF(1#2vmv1Y ` ]Ampyzko$zux(/;4!9e~x;6߉Mw֑V:,SzߔF'^MAZ??]W\0ͲGgjGeBH{ږ새ys/0*$ǣhEߓhl~H4o%pEoSn-nG,!8."/>3XTgC4vi1q( $I =memba&u|n~ /# lW`6'$ûz8GAM >Z{:$9<%(0Yq$ZfoZ)u*ظD$gbqL!>/~qm'{  U]\ቖsy֙6D KraQC%ʾ~\_P>JCCaZ`endstream endobj 444 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 842 >> stream x-klTEge@ucnjު6 ʢИ-}d{˺>Rb)%;M+eibF+Z%&ЀMa$b" gYԩaf9_ Fv; V#6VPVSN$+r\ mːq,1KƻwvYFyGQ[_4|^o6pȒW`۴Fy˲bO$P:LE趺׌2wx!6p2Fst 6oi nAQTjQz D -CrFdGԁ##xa[b[x5M3̗xGw9NخHlWoXا;v'o2Wr)bY_6Zqb8S3ݞW _!@@A`gDGsO@@n(#׿ =JQ&!|3 Iȿ {~M]I/9Ήu1xp|UyӋ_غa_y i~uê+sYaw뉶CxC,ȁ=񡬕]o^;ݢG/S IK+FGn:B/:.^3'/O. ܦ^ Ie4r茚դBbvXfݵ)\o?P\D3&ܰj[ם}4psu멽4_KdPz\wUv Oä@-IVFx]S5:88p4g72wFtW_m9/ўy`%zݟu̦N'V{endstream endobj 445 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1012 >> stream x5kL[uϡAR19f^!a jLnAD ڎ6J\JWvíQ)eLeF Y2痙_4<`Yoy8&MpϪ{Ce;y H@lخId|>2桮\Ծ2R,UDw)_.++0UBK)LJF0Dv.TLfsBc,e GfII3FtoZ}\a'xO*V;eb te:IՃa'F ;atkBLa$G͕ Q.Z?%f/y>Q'uqJ pE$^b77◁XZݩfJ[۠n"+6!ꑷؒ{nm{:Kc1XH!Nj]bʿS#_vd[n60fzI_$8()gSޱ|E\ ݗk+%Y`zendstream endobj 446 0 obj << /Filter /FlateDecode /Length 8674 >> stream x=ɒu 'tQݬuq YBRH@ iv%+ʞ`'+oo\OO7W_}t}{+C.yߟc2tS6Ow<5:x_?yst00ywnt$}|o_ dXX(hE#!9 vz%U H:7cH_2 I*&~`J%>o(8H9HJlk{Wy4OĻn3;)Y!e *U_ 0$;IaxNJ/oӼKpnQF^k2sVZfs LouZt +x>#\}w?aE@j~ lmyc>@42fBkپɂo!Ÿ >M:4YF&Br-74ZG {.)Y rItI09^&%sP@6 T   L~(=R/DN]1.dx{BbQĠ‡f+~##<>6#NtW[О ,it":fȼ|C^CU7hͩf{s91q`+MejV9j|drB&lHbGTڌ%ٲVg] t3FPp(#n883V EImP&Wj(ܧ#FRu A/Ls4i!ljFZ*\pAd@ z\HH_Ӓ7ǐ ))1ق4ƺ0爛) p&s@ Ϥ$;.XEFMq&AO =gIRZ2=پAj$Y W-O_afJJ fc{?JFR"3D `4ɫMB[@S K@(s,{[#^R&",k,}ڠLX ġI Iq+׺AK(tQ;+y*Y88z!PVf(8cTKE9D-A4 ɷyw9qa7K 6_qpG 3QQ0PD- H^s u{t֠,E۱jSsfP 7 û0Isdc%R MELŶp$aн|4fNIOox6U(0F("%Ey9w*4ubiP+ٿJtf=K$s{qfz#{"/ţݽnvra[9'80 .{ "Mb= ЋDYX7&͈ #R&3@"[Hƚ#֛8&)_[>X 5WxH$-c[:d<{60Ph01fT/…*&-̣( #9&H佣ݠ*= gB&Oq\^Jĉ˹ D${!@?x|7 뚬re1$_rLߠLQ48|6,+) F`GKimWix3plBCƖ{{ya0 r;- PR Z |(;qr5<ֺ3qvC%nv)V,=~L2\ #I'_r)C(328SdҨzKV@ex4DwG倣uJthS?{!q[RY|>IDKƖ&G"w Cwښ}<Bs}ɈU:M“GytZ(|Q찬 /mC袜c詮ZN/S )eqCU+KA`?,Yk QJaTPܯlѓ&`®o+$~CB0;kr*^N@ FfTJ Rjԩ&;+ߺ 3t:6*I7\Ms]XԋP߻2fPfہ2?xgYEQ(U.40$h?_{bL4z-Q&jIҋ 7jC5ݸӔXwp+'`RIԨ^7cYp_ɩg3뼓ț}R )y+ SJ"l=$##{9o?a,J]1;*Zۋ+/֔v?̸-%D9 fÅkX\}CMƃ`OJ*NR@E% ^ qZ]K } T>m5^HL{ F,!L=購4rRi|$>Jr1Fݕ.S~x9 ((ֽ Hh:Z57=+7rl_;h#5jjT8H:ȉ%!綂9BzxHdt|ۆH4'"oK #a [d5G:=VJjBMeNɪmehQQs9Vm #tvG)9J]H-VׂoJ FbO~ps?.?kAư 2aFԂO3`[}5 6gػ'O ֏ooWmߴǯas,p) ,SIG+=>oas1m{JFfB~l@.>Z@?)?M>i[ugl=UnrsX&oLUPh\cYbKxfnɩrS/0taD`2gܯ&{Ba/MfÝi ?:[Y2b~(2KeD//aM|X[;~1N]¦PbJl{tnyz Eœ@|x)>J+nS%P Nݖr˳ }N( sW9pRKV M%Eۡ^؜듕cI~oVF*p?.1;U.lJb HԶԼV%v6Z5'ONfcw%ߢv<քcs&T!ls?-;EP*SW깊~IxqyQ/}=k^.YC3P6D\G'Ұf>pd/>kbסVC/,P˓hs 'c].B)dTYf%xI֊LpgT\L:J"P&U@Hj·dUؔ0J PjlDEA;۹‡6eNSXaPu|tB9ޅ(cG(; wV)C,s)dֲF4 +!eZh_.n^0,5ɔ%2r sP6}.,IX_:1l AlG K770b&Bi>ǵ:t +TD7%J\{Z miE)r\tIe?B(Wn,U4 ,6zhn3Ы= {SsK%C6Lą 9Ҷ[vRMMQg,Mx :\rtֱfdI. ىY3)Aܦ^ k8rLͼQN -Bә++&Ml׆-Qì8UȰCˎ{S̹Hw GwP(bkɻA&n ]bq[ iwi>f)?)P,EruvU_7N9Q.S N c"ViլɇDr"X|}l$T8~^0FA9_mgFp |4%{ozS)[^zzw+} d1D4]/C}FO%ЩxDmVVf[ zdf/*3+?dھZk@42eZeǃbEGd`󗧓<Ƨ߳Dnhc3AVRƃr|Фp\Үxz0_X)VDgpRJ.i72p֏TԠ{2@hml_tsX>6y'n̤޽[اŋ3vG5'wAnv-*3@OZ;)&[_WH,MMxX N]u!yl`wQK(PzLӓl4 pA4lC\5)G;,e_8Qa14$PNq諅bÃU˚R$(e 󓿥K[v!,Kx#ݶ!5Ia_J:ćr ~zJB=ު! LD(sPŦgV\hPGD?)X^MtX7L,a?eGUZi?klgŒڛd {Yq'Qau_ ! ~?o:+x":yǺ݇o (˘[& Hdki:%lp]ǓXO dn[f2:ʱK5a좃8H,=}9VS-`ԫjvm0)෫u#E?eYd!N񒴀z·b}=Dmٝs5/ҿUxHX@I=sj=}#3S׺`e|)GQϭA>#&u?JOc!%!t.Q!{di3@=V_w| +DUonu93Bl{RWu -G[wY<JXŜY_9}[Ai5mYgbZ}^:vը ?OvXV)]er3_` S5VO% 7_]gƹ(1+l +=+\ZЂg24@7-lnrc.Ǥ7] $u3 Xtj_ fea s(o>-Ȇxl-D;EO9Nw"ICkFg.A?nt]>-1ҸN~ɃxjWVW4T3v ƯQVCdn"l&z?aRfoeqskCg/c+()]d %:31%mSMHD_W%h˗Q1J nlE]*)iLXUxg͂ zZXnJm Hг.!icOuu%*\/,+endstream endobj 447 0 obj << /Filter /FlateDecode /Length 5156 >> stream x\Koɑ#Ջ|?,Ï⑼>}hT3T7MR"3+3\ ØR)+22_Ddo1ʍ^Mp+vSsiVHj"ͻW[Q*Z~n}an+Fj8}Ƴ*q„ሷ:°Vcr8}g=:!tR/E*5YI]A[7%Xa4_r͖M-߈]a5V1#Zz56r}$djt@Hn%~ͻ?]c+|2ZQ澾Zӎx3}|xPrxЄaZ*](HYIls+1pJ h:*Q|yy2/Xvs>]iW~11627K'^G|q5VB?y9 RJZmxQ’nO/-]Z8:-!.dtz"L`X|F*'UWahΐgLF6lmq2q5gyqE |T |Pxj4nUD r&W,h%JA[Iyt *hQkJ/yyE+TmqN|tP84ix<4>&m1>AC"%\Q3ݼTNpNItȁ p;$/.d%J7I7: VrJrmI~o^\|J'8'P ƒ4:"#kRSˋ/ c(t9UD@ *$$99/.dNɜ8@SGdo yX RɨSr-xU on}'C JT#9vHcBZ:Ûfs#$zxx‰cfr&U}o?%F*ҏ&")J !+ x W |E96I􏫒مW9So {*`f"C܇ kZ^|d±;Z  cÁCC"5Cc4ȥϬHOlrGA0[}hC$"UnPb uT x^']Ԣ5{0w iMu1(Q %FbQ  c Z!!Kc%Lڨ6 Tv8M4@w͐n iŎ Tx_!EqK+cF pF4 EY=#Lj:8ϕ"3b7v*vX ¹Ip$]#LD*n$fYpN"C0[mm}s9I wI.6UDn&Ҏ6 T s[&5DnE"fGPCiO(yBvAJZq hcd7V:0 #I`L!'C;4}d`jJYo?*nتzDv{J矎\usF$QdɉTd 1ik_Xr.z|z`z?J'B+{#P)Jhd'O^QP^I)R㟥}K;=%0 [<v:"2 t $~Z H8 {dɑA};pB!RjsgI# bTq˸LUPQQRa @nIp Bxh yxIQYRVsv.`p4 nc[[2ML%I};tw|qJQuut]ް- +'X&cgEmiZC]Ify"IpMj-rA '-5T /!:+KM@,,ɟ 7智YO@8,OT)IA!.r>67%+''Y6CۻJs$חܵ4ji]6YilK>g T%iT3&CXyzsDrZgYLg\f^·]Jv +#lfu,reD^d) c.wJYEQ]}X(F۵&}1'@S;i*Η*./˔е[3+0"XQw 'Ma m = x1K|c{QIq8EH[ :L%6)}ӕlqj[C!RX*r~ȮSZL 7RZLE/sKҹ gLڈXRSe._dϗ!H%*|"i*\vg{CYhu;rQ.$5]QomPȜxA1UܓP̄V |ם~@%=;*# ?ĒjqEneBn&*%,ZԚGk)zxضـ0YdX;ݢiOstܛ1gTx)`\jίn f:kޛʪ+Bw"}xڢ+gl[ Pͺ;@i7HxQ9S+z8]Fd]eR;Jll]|vvrdnC^Tmf*N! (9"P>/ -爠J:ћmmfV*@U]뉑:W8A7l2m5Oel3PX @nU'3z9[Bμ㘼VVe%aԍ8v!ྙt=dž{n:;jY.3?ZTю 5hJv "5!+V~ʷ̈8Wh_sǘ>=]|+{lGWv*@.F9O4:og$DЎSRe.o}QqZ>ÏP,E\86rfMȎLGk@oB)%u7g ^N_> $23;a9OUWþ֪\xX_s,|lQm8x D~KdǮ req?DFwL k ӄXgA䌜w~y1 ]]+*S{MܣP8 ͉qNȇ?S+F)6%U)7M\cQ>BsX$<&C 4/;I_jMC./-CISJ}f歔ā]C{f7m:f37N?Q⚸)9~kV!w+ow k>&>YtaV:Аome X~~\䔖n$؟ Q O~Np%C@9yT ե0[St~y 1"Ϯ< E;{a/ьQ",OcÓrNg; ddn:GEIȳ4?-MTZT%*^A~(qdetІ=ҵvʡmp vҊ#i.1@sާ+g2N#(Q'$Zk)t?7ǶSކ*S[L U^cfrFF۝9ӡ{wS ]ӗeVcn1|ņ$nï0] !\v3{u%\Zt ޸.VtF̬sg\miK%==޴O=>->xkoB"SW;ut gwHN!^fYn"2"e>x)6 O^HUjmVʮjQI+,%ykJ!41y RTnNP=$ڣ7y-3wwV%إI|HjMi3vc O"0Kv5+Ж}<'[(w_\ע( أ&@5'3].&VP :3SNQ ]GqN60Zi2U\2Yb__)3;L'ZsxkDSI7 ү |`'ru&S¹TeALUV i/@tbDYfZ͜`CgbG0+v%Tg{S/Hl-3;} _E\~Y3E?!_uڠ*sʏ//, K꿟 + 8+uCǷ}2r~ Ea,[X11)lnnv~jo=3wH}{o c X$R]V~;ƶ{f?od/endstream endobj 448 0 obj << /Filter /FlateDecode /Length 5078 >> stream x\mo$7r܏o <\>]8qwy.vJZi}f-^ߞHvfޞb,SUa#F_{qwߘ~<dtS\mRFrs,⨥xǨEtJg#Tv'F/ =` vZA^@锍{:uXCQQ6h @Il9:gd8% +7AC4WgoN!zI lFaa~ҍu^b:jx@B)IU5c بyK4{9113pqx'GeZqI>MA$')zoU*Tͯ,6邎sYNqE7 pҸi^pvЯt1tӬ+QPLnNLL^"X#|VuNkPQkLs6D.ɇ|CGum(B/n'XV&BrCEm*3 ݍ6v_"9y E f%oC6-Bug6-EYނ&xT)((VӨX9<ُO^FH hLNu[Oc 'o&8襍rRP!= Q\SB'Y:\m/f1 7VƔX3/[,1ct aJv3M#Z@g~}m~X(J[\^|Fg6;^%6FZYl47||Olf21 +D8|U$ᆫ;`Q2A]+&JmelZ] &uքP窝A)DrYЁocdv& m ?vH4)5{1zk'*4 nxHy ;zb I+v3Y lM!ij_lwfyΏ&;IV/C~nڤ oj6Uic+UDz.xm}~Ew|,D}n?|XO]}~D>bh>C,vvT2+i#!ݗq=\UZ{y|[/Ki%*/Z(+YRC /r;M@h[C2ś0tnjZcɻ[5u}x8z6=&x]oEa yxNY _QU2;|cEH5U'gayKYF\CTP4ZvV}Qfs[czzKf|Ӟo}5J cHɟkad2w nyy&R'3I |n7vUNKhhOMՠE#z]zdb|iU{S3lC' (#$+E(d[(_Wܡ(- `I$-j_& >%cl<#@OYtNid^1X5B`8W.s@MTU2Lӌ\T3zk(}.YF0H`>JaST}K^xGg⩠xMwԏIJj PPg[`Fk+_n2EcNC l[eŷRYoߦZ={iW'@%g%dI(qf>CPZ' 5 }E)LАjP*p8O,v1VȞ\=Tq`O3YmQf%$odsD؇N`i%fglmo">VtĹ|5YQ1BErjJo@ϑShLoׁ t14R\'*E /*/'2#cɧ,Z6nfJ!PmZ@z0ӉoxTώ_T3H`N \3;2sebC@dޓO-SEcb+91Zg&$1KLӼ$!WOf);Mvc (Go.dN^Cϑ*gSHЂygS_}$s.xJ|:K!|#3[ REW)oaa,ϯ(S-#-9Z]1 P$sae$|H>HHBo!`]]&N<.}$M>?:[+^,|O/=݊  kNxEQ6u|GL#ۦq,b elI}A7O ucjCw/}?loJZ ``O(Xvʋ^go}};6O;*jޠ~A}n"R\ҥ|~ैN0H>TZ yTW8x|&ʥ3v%j;sa+HUEa_rFTXVE!j>B,r7WWyBQx5kyF PjA`ᾄ,Z3mDh.Y g/w8D]v=]YHrPi6P+ZMPLK 3&n8DC*Gsٶ+襚 _i;tG:0o3Oumʘ;$)3lfK'/T6λ`~+@!m.uC &A( ^(R%XRSd>_3;O?QSW]6YaU\Oo-sq,;2rNl݌E.('Cwf?\xC4cQ_Rl:ٔz󅑤L0UmkzH<6Ts4>F 7g_ |hZ_IA*fic|&KpO' 'I4]KN=@w=ΦE۪ӪEjJf:g-Vk5y?g )t-k|Ԫ ũ,U|7S,ln*L\]CF#GlWa=%>'c"n\婱-R>X9m7]]OIR%ăn D"ž,1/ND Ҫ0 7`Sg}&A.3Lbjl<9Jk/oO;zJMCj@ȻQyJVk]LB-+Y&P9|^xHp$@Iti;tߩ[4/Q8[ ߢIX2rK~:D`1J.Q".p`}<nu?Hh$qde Ox+Eux {*y;NWNyNj9Mvʕ)Zxkv?QfI! BHVŚz-㽟Z]ws-;6dR%әqK#c:󧣟H|,;?8Sb%J\b掚6q2Qa8Rt9M&nJ_r iRzjY^{_DnO h;GK '>3H:{"]ϗ>s"\\iPdđek̘1~::/+̤_~:^Yl%7>lK]g4 =w7H7:ճ+SuHSݔoX8g沃Z=g7ZZQLOʽئ6I(ȓz Z 1L2/#J=.}uc9T7S(~=f`+wzbEToA.m{5iQ,&Z|]YrB ֹeG4]IkJP$ s sXU6/ = d,&=|lNendstream endobj 449 0 obj << /Filter /FlateDecode /Length 6771 >> stream x=k\uE>ʹ i)i^Zmh{σ<DN:'o6\=N|D_O?N9peNxCIT']2':+>0œ6ϷxJ*3QܞcvVm߬ڥ[hi SܼQal tܜWq~vsM&'ֻf'lW09(~R0.[bry/{9zj.zΧP6\yd8ٕm7t`|O6k6_Mm}vtdvpiԹ8WRppSJ.&x~`@w=N49micI+m7{0'/+&S =AyT{:%0{43xS:S;]30l1APv>?X(p%=9D.qE["n8E :V' Ot9V]@eTE7=ELvnvsxQςOaR؜*s@ x`> HP<Mo[dx O"1!\)-݈8{b(| 뀋-C06 Zlo G.MH%hD_6hΣ6Y!h37Ht]} :]PG=x-o|L4uJXUl1E 3!gK)H{:( j Pm\/+V!K!r1&PeB).;7tY@_Wz1!g+Mfk4! .|Wl*n24,F>#  RY'j}m^umUm~Su. Ejh@U TihqARuL.z)vuRw yχiMcne>8lu e>1]VAH-daXb lguzbkkQ讪twTX60νv]+ ΐԪcYӀiNw]*T4ƛ82M]5 /݉sjIFpJg!bqsC 0; {.S8uw;IG'/bRp"c"7,s\Uw)/tv0|LAT@֊GaB(7~!t9.$03=a #9z){gjѥ6Tl򒷊W/qM|R`hR6S l`^ q+kMZc^ m"+g<Yi{޴v  6x4/gjTB.b s5bqLeR-+K_r;G8pOd>A 6cN[B D#&-WEt̃5őgz=Q)[acu;C2̠MX&1S:Y2Ae7 8K=ald*G9+ }/zcϞ<6ڞ:mzW,6jS^^潜,oo~=_׆rDum AA Q9X{_k?aif)y#gX$1?eH ELPo˙1 M["E_k?aSܲh3}%h|ybw{W!pa~'ڠ\{W0c+t0'!|].d83s>Bfxzҷ:|5T] ) !^n.m' `cD>_ov|eKs5kHz179  Dn:js bR_զͿ0oųXN3dlBF~^(J/xmQڊ׎c' H)UR~MQ^וֹ(A/lDt 7dLyź€93TKd1Rw6Av=t(82hpaJ DXUpl5)1 cpdGx%[3w[ҋu}c 6i,+Jmodosi/2g8?tPlZkd%KnERL@phR' \#40$9kH/2nKn[L?vUviUօTH]TX饕u\%EHG.c&ۿZ G.ƅ'$2!h/b1fj!"Ĩٷ›p / a0$cbX'#ZOzt U`!pFdw`3vپ=7 xPQ*r)2#d)xI>iM79hZv1$4lR<| -zT K6Qd# eIx)Z;^;m,u ,<9Ү3ޗn+x6WC4]M'}VUEVZAFh6vqgF$r)a(PF>/9|.87f?yCD  @Wת=iI#A6f7L(*\(ݷf,Q "bB `qؖ&BV*lXfe_Z3GK+% Ľcxq 5O%ۈncZk(&6%mhS&yݯ_0ZG,'R uEäɧ0фoWtFJi,8pPر)IaW>8Vjop֛g?8G+o7+Q]k;3^vuuZgq+5)פ\hC%L(JJXүAu笠eRdrjiRWPMw`H1ckݶ)X jX[>ZW`"Q& md~T PSz߂xK٫W B d7KGE?$qӹ>J Nt8 +e+x@e>acʧ6kI}C\7r>λQ,ǓKM7/HwbS-q:bwo+}vS^Ք^]xTIc3Rr* ˹ؐe^faˌf1x-Of>endstream endobj 450 0 obj << /Filter /FlateDecode /Length 6943 >> stream x]Y\7v~W#DU$0G΋ՋZzZ[ݲYQ=S[};Ϯ>goeUg/^=곤ϢlًV֬_:k!oI~XXo`uLkɄZo[WoNZri~I js>w0[@heCZp`MdF(G۽!E .b ۘ]qlu49e/%i.ک6oS]ڮ7^[n¯vΰVZ8cYF{ڐ!z]N5ƴƖ4 *{1p0/?Xst9nicݛIqmT|=?S wkV{:ƔdWd4)tmw> L.(\AkQ2s4ܨ%%eܷ.:@KaOW CE xY}~tk~H5@%E*L;ʦU$ړqVr^@͓L/9YPː?l!iLhLjZt?fPt;idЎ<*=n/-(EwnӴU.㠌)$$M`]NۘT1=1D71lNPqӓ,D/Woks7pU@!Į?P=*CBWx9_hSgGku.ٍC4`+ [RGT9̅W@e _^$ER:Йe{E%LZ.64){Bht©|$kb ͌~X јZN!H u0A|}_CE}5XP!az S<5Vm 38^Y- YzCךAd'<)"'T-$WC;A+Gg|]v>=0rZ #*"(|{Q9Ku#E4;{rcIc3f9Ӗ=Boџ3$KNU^>M/&cLҶ&h *ѯ^ԍ^%9l̬q-8'n:RSG"Br4 /M!%6Vى|[yI:[-ZE?=յ]~olM"Qb4D_aQ 36͇`c#bfwmcRH9ͫ}mm^描L|ZN [_N˖aE?^l-Aoj6kN`)OpBg`fR^B ٟ ~Ǭ#V 6(B%rD(ܦ m)*삲X4DybYÈ y,,)-8 K m~3 {LWVY-F-E! SV:;ez8EDZ;L'_UԐ$КK0`h2-Wb=2f/K9!$8t\?僱SYOK+E􁜬fezX_ԟ݊s1Egc2mfcmgE`&Pl.)RF^^,9U!8IIC?G^DoxF$pi$l,mPf.rFFl}\>5&dsc eyy:LA͛~:U^&uF5a0ϾcUCqq ׫ 颙JO4seGzk`"H_̩ Z"ސ'"Z*e(lAJ'L 1n䭚Cw_*OjTh$O޸N$s 'ۄDv7XMfi~T&{18l|/$Wtu Y;FX@ZJ⤮|TIcCl͋gzuS&ob~㱘Rꦗ۔@㯘2 EfxmkWG1୦iZenRRxmtJ]:^ ;? G}t|?=ShB.肬 !14.t*[YJ{ Į*}l#`9+?̟Yo z nRj6*"ucU.NFFEBOTن Sj"Qڒs$R+p_Ӓ)GwI?H.n'PbGcu"gd1oT%*0eP\pm`E5\*~s}lT“{=(3k|EeAxr_X m>$pT4lkxwd᜖С&TeISgI8 7۰~7( ~uFfmRO@ ׯ:c>WK a:鵿 |Ze*1¹i3Sr?{Vl.\]e':a Heצ jFzl MSپY09yz AS/+[!\7չR(թ|C~8 EQ,'s ЀGYƥsH=^Mi95&ܫ2:ӓABt_*KD֤ƼEzֵlx y O,+۔Zfo 6D,M!Ȩ;J=5FvP $ңM`)D-Wʴ3[62l@.h{ k2'Pʄsa>{8r: ,15|=@n;k`cgG#IX,0Gվfk6}{K zgZ'FqKռ#}|]eqxW|/xbּüdpB+1RN\ xaE!q\Z%ςi:y[1.('儮H7x׃gRoW2W)H m.^,7eaX`M5m6w9Qp$ay)b)!fMeW@{]%̫o鱧%J kD kfQPb v/J6CaUнYN vUCÓrka$g y+.J)uBf-D1kKG 2> |Q6 A?Zi Q.z3^>ϏwYcZB#^rL~.x-:ŁbRIWY13vo&~D8J 2d@r4ˉZvHXI e'c2:2G=%i=e$|wNC_淵)ߌQ&*>/}WCIBוmVȵL9Eh}\%WJNbZꅈ'EYuK'G=nϓt!܄-4BG?=i&OzPmF }z0L4$j^G9CCQ/"HBKb5^ y+0Ry~fM&+؅H`i!ӿgxdmXS~)5:/g6wotEgi&,qpYJ< $zyHj2jE^]~;b%) Ղ%s#kR#J%d[&h)GOt\~U?5]l}gH@_zb+'kzLr_^.cl #E͍n8՗b,WQ?|]U/ zE|08 |ؼS@b$w6a? mbPbJ?ͻkGG|rW,?Cz֝n%_+~PCv,j]z9!I'0̹X{6O2xmܿ3v%&X(C [oE0s5 ImF/r=c/>CX ,gbAO~Ŀ3 }ɿh -Wh֚T&5mM|W悁u: HƶF JCzaq6 "kv@Q|sltpގBi^^O/v> stream xZߏ6~_.Ї$m+&=,utwF(JVAL75,ov?P~|,Dͷes+_ ax"rhWeծbRյrVuZ,vBʓ fTJZVWҒ Ng9!6t _фU_X >oywjĊ^Wo^$;[!6WV..8U AAIh31`~[\*ޱǴjc]68rf#$!iƘz )ⷽkV##/5o z*7O5X0}_@ьisUi QP ɌM)QH.P&~|y*/_%1^|W48 pɴYlؑ)m!q.5ށOaWk؍lkÀ6Sj3OK"{Ƚk$®642pVv҃0܃qVA^hkF& O{1yqh4eܒk_DWw}8'{an{6OðFFfvwoY-Ѡ1KO@lKR+U;+B9+`upłٓ5(2q]Ý&LՉ؝cd.b# )7/2"ZҁO@ `˴J8PA*Ԓu Hjah5#{$цD-snL*Rr̈y)?ɀ*S7X24YcL;YI_fD_ gmMŔ\ɊyB ;Zd`HТP~5].~28ҬȅB'BovAd9FFg c)xWQN |h$lJ!MSgP4jB v~ŷ 'OxIR;X-0|>AxɌ ƽC |8,]-CL")d_vQuR@ẙPƀs9W*M,@ nSPU5A&BN($d `:,i .X&MZxYL8Azv-2IC4Bf{!7A g,ѠR;_&3s`∷7IO,\NF;̅琜d0RIggdHFzIrvѲʏFh3 rk4{ \>AƱI0[W)~cŸ>h.dY1/< Y=B lUd HmŨ/f}ћ}[_hHp"ˑ&D3ӟI!Iߚh0V%!scdK92+dDh14%FNS.E&iJLhLEK^ `7%)idRJFm7$o6y)OL3+' @ Wg{ O"3 y uF1ʾXfKoXT͏S\eݑԀQ;wP[-x')+JMIްtԲ羛pbkz%<QXgw9yKTMi\?5i7stx)̰A,Ar$j@uA lVeQi_YMtEG8}x?o"0ff/fQendstream endobj 452 0 obj << /Filter /FlateDecode /Length 3385 >> stream x[Yo~_1o yp|BlD^F !W%)/I??_1P0TWwU}uLua__WO |Xmn\s3ϛ~.o䦱v^~}dFH>Y1[XgS}t ^o+)E8oӳ &r#o ̜ς3i\DwR'CIYTVXy),VuszGV?Wo!͆ ^t)(voINF)o;a Gyr%4|\<,X *(3s<>,`J';jv{bag9|p*tʞE"Z6P*kupuJ1)BbZݧ1uXHqmDgĒ_7E_:*e׫jwn 9BD>ର@v%:fAth h\Ktx*x)altSBBtHՏ Q UR%42Pő11#~^{n6z_K Cz$L@E<ݾ\oYe^\]iy)"plڙ0'01dڹ= tFzU+בf48/p'+8ȐOf^x/mh;b04~#Fug-^Jk1h|xi`Td|q̧J,1 Osp~&hG㸁UnjDʱeqf 1'E?I:ͺcPCeӫi p$ropE;ANNњ8a1:z*lId8! 7ш56$E*Jq/|4boḮiYy%DzLs>)PQfV_]l:\a[I%%mը hHs~KJZ<G&XqJK,@x%@@jS?B*B ;ûqAPDIn8 'p~* @xs@AG 5RqjXAC#ƿ*A p,N˜4rla`mOE漀aYwSG98rLRƖT {-F^B̗>U8 ү)ÙNEQH0Ts/H87'Ap*kd*MVVV=reIykDUEi"|2iDt ? T҇x#SK'I$bl:Mv#(Ael[My >5"Ā+ bi$"\-* Cum*I(cnxTiHEjGGq!Cum*Mdl ,:MUoHr*B#+꽠d:QU"4qTDf@&dHPC!@oenyij$9YXSr* kƩOJ'ŹBY{{GF8%)MM"+{Ӫt~ts.uu~j4u%R$@h45(ethLiqL]�C` (Ca>u; +G {)F\YJffo,hw%-p=moJc6~aZ2 ]D_e(ɶydGJɝq)ɿAe}-Sǔe>LEo_\B|H6R_&Bq ӗmy6,$J9$kשsdF`*J$lKgqLu!&LZjahp}$"JHJAOߥD!sB vb8B># 2WĸD6\^#2!K]gk]'ObѾ'4hMK[0YF.LW'iMQF2}QƁCCi$[]@6Ԋi`MxHBW4RKEB tHK@ۉj1auE`2t4R91MQ>5Kfưs1ѱ8@tj-Z# DZ7ȴN_VIIV{A\$ tW ճ'z\2/~`ԙүce/Ū}uh؇&+><Ϙ}z&:E# E#-۹KD ST`r44I{4RDf˘ [9B~ٍ4uQ8,NLۆ h3fVϨCTǑk$8ugy}h/*I )*9I4 " j@K Փ'z4[ȴHJ`J ]w`dUɘ)i&pzb>cz}znQT0PT4i."9_H| M=1 3!1-!gBEBLy'.QI km_.[H.4)CߙiH9D2jfh1\L|xfk$™yjag #'wHǭ )z <)d^$Yge(3Xq> stream x%Ok`%n:cuB2m FA*H eok$%Kuֵ+Uy޽_x02齇803Z>oyoMcgvIS«kHXnfr(m-,t&sM2J"k$'[EVސ5])QB-`eŶIzLU$/IAE*%ےE 7!B> $b,ֿɰF-|X ZnvwNmAHiX3׏\w0z%P܃÷].kwnp 7;ݏ:wn/Zcoqa;T7aɐFVM1]0DN! G}44}ӛ<2gƳYfM4$I! TBendstream endobj 454 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1883 >> stream xUipW &!ɮ2 Gf8I !(P%eٖd[֭wu_%. LS24Lɴ++ݝy{]p!ﮫ۷esvM' /ٿj1T/,`#Pm^yR^0J|7i_G,D-dVhiν:P Z-;)ߟ|W_(^, UΡ ufy!5Byo٠)O uW?p5G!0Z=y~^`}V@7M# AF,Af[%IZoΤ YZ \T_h J~)-n0@fM. 'lc<>mYTЉN\lh9M:쌦G;@̏ʵHB90p0)=GG1PF9#1.ar+:4p&G~]zpLFKRҟR$! ȿ++ҙ7߿r _{Y8{+unj ቂa=ǎdRѠA5jX )VrW?Pu5ڔn4GcY2T*LE#g= <)ɷgv:Ӟg2yf6~'[%xk*ōӵa&}dhۃ!i'MmZ̐P8/X1aP:\jOB{ߐs]DC/n/z#*^>\p<(b©CAO.7cpSjMw\aݯ{#\0Q% PM*V !GWq]P ؄UqEimk@eo$ޠMFSv}/>.mx/-..YF.]5Ud$X]MJ}endstream endobj 455 0 obj << /Filter /FlateDecode /Length 160 >> stream x]O10 b C 8QC_Ct;,: ":ր#MEY' ߔKWBi )(HEѵtXIG`4.qJM5☛&e=O) qSendstream endobj 456 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6401 >> stream xy TS1Pګ^+γUu3Uj@D@@B擄$$$ 3(8[;Wmc}㳵Z;?{nױ?I{,H>oGtBx [n`7 4??X*W׆!l}>p3Ţ䔜#G 4cC'O8c$QjbB 9)I 9EеԤБRrr2gN?>!={P=z鵠ם'?qG }gz ;0kGQ ^]77H6РM~gy^nvj?}s ^sfha9Wơz4[=a h+/>u ͉ar'݈.ElGBOZPRm ^=(j{RyJ.: 2y=C ,'[2S/q>R (w+_)QZ!ѪRWnA+\G$>ΰ`SP5c$i/p>Xإ+7[J#RZ3 >{ūl*bkxr PX<F'jEԧjjxݎwu4yZD.HpTm$ p@eQB4l c>x:+HeUܓzdS7ꎁ>+,x9\uPUfœh6>WN]oUCUe*\?ݰHF'JV4Y*L/&vmUIU @#u@KeWk-Rynƫy{8ı~`O* "]/i"$sص~zZ ]8R ii`v{جupz6XC.un;Ã鰉Im>5l-&gSy% &n4 #)x|LWV!~Xs4:2OOq7w ٣A</[7_V0ZޝҁDH(S^UeaN<@{`~cz 'vnTm1H~aLF(h&ui}I`Tc1?sްnȭc$%&Ԓ BfF6ټka&8 '9je1d:mZ.v|gGvpuK; Fׁv`Zc(\v25<"&IYa|) :p`b83;B'yG|Oޯ?Hv^Zed/.*s[\hh\3̤5nMmKk - "܅z̓ 3#>oyUJ\ zoDiki*m49D'w c0@Q?#9<ɣa~Ɓ0a&5xj$p{؊- gQ%t:`o؃Ђ4eM O+0zyk@U(*) hӖnB(X0+S<˚r 98Q<=bӐSF A>lBY5O@|0;+ub|6Pj-Hg }j2Ek>թ%)ڐ\ػ5yK:Fz Q!n~>&H4Ml g Rd|s=H~@ϊdr8*#?t t&JkuUua-Fـ@J ;z>0jzYVHx=lG$}M!xC"V6!hV6~R#n^b,.`ʚ Ibfzyj]ȣ]J(W.T29I5sًq5z#$ 尧Ѕ`3z94v˓pߺe՟i{RA3px<'T+cpΐ YQ9[2VR({;imj (?'P`$iι,ns^J](T]>(dd(Ѫ J&,2Tv^BʋK@Atsm[֖ìh/Z_x Ւ@*s&ZXy%bP׏zkt@I> ?:8}o+qLRL*RX*2pk_ڙ[\Pa`mʻE>on8O#DAfه8/Eaѝ,5kJnqgڞ(WX-+ 'P1$ ac:ip 4|o?] ¢ ~ ˋ'yqYb9aA},z:}"Ԟt?]g&3QHǛ_߮SUlg0ZD'JyۚM6˛jg+6 HDjtD9B奁3m#mWA/t5Z#2@ 'r^nӜJ*ܖ(ii.gK,/>]($h-^!lۘ~M쨇- oFpu>aZPkhofи&Ʃ0\Go«؇4,b&ȇU 2}䞠@-`zpG:N<t uš<)AIQ'dDX`J>M`cR %V)B.8ԔV3G+^ǽ ߾^Tf6XljS3|p:(ym6/tPBa݄܎f_ihwnVrnܴ$`5pbIZQ[x men^HtFjrE5c`2:Y$*(uf7`Tbk#ya5p {}h, QƇ%^Dcޅw"ӽ4 c"/!G^Bf_[EF"/a02; >w=d#ȶ"Io +xRiяʁd{F.W@'B ǕAep#BWŰ[Jh`@t^uWE 4;Q5'WwUfK+FhO^c !kiŤVPv@9\dAer jU` wHT(=" ř9 Dg-hb ,/d7~v%.;u u-ƄM+bm@,4)n5](^Q+eSL/IU;Ի(=(Ta_y@d.PODid0$"}IZjB [p*Zu8"dA*BRRc6WYZuu1OL9&c6*Ymfx`ߟS^ܮyAuKz?[wx nZT*-n5T?iB,z ֣QcaӓqZ2yR4`g*u⿭Y,G;.`XpW̤rIZ1y4M rOKitMpWK&siptΧ#ƉHBX/W%bv4N oxmP>6Mv`* ^zZoxJP gEpϭ>z'2WAn8jY- /䝇#L8 a̢ˣBO@3RYy^i]c-kPASlƹ!K/SRSӓ}Z2љ/C+VC'K"G  ȢBiS()]Υ*]5U6Epå.q|@{{R$ S@JJk|Ҟv$-T ~rUEIQR+@#v4,t`]GqjY1GVU͖fx9TzJr `o4M0mE9K<E,SLaϬlT Q׫ٱ/H_"+S;/sQ DPRQ%8ᑀ[xA5߸ <8[kde2NV0Z;@]Q4)F~]ot$_,*T쏫PrD򢕖Zhb` 0/h%Z[1Zlv< n5UUiaG1 NdФ!eQBm'F•5Sûɭa G@SWC:8h])Kd#@#Hy !d6u5GK\bo\zao }FZbLV {Or\ر->+yOrC^k LtJF !RI3F&FȔ؈q]Msidc]*€K#^j-R&BOAJ^bsJSh[RS]tX |{2{OC?|vK; ~}Ihx|jCTgZqȚck{ExҟSnBtJ!MXgp~oQfXur=FJШfҍ(9/\eǀ4fVZvmJKΓj-#m@-5 PX% :|-c#9|:|R(ܨ?FфbI0D hK]S7Љټ'NCꋷ?_Rw^AѰY Q譭wZ S{{^OB/ḲҹEbmu&( ~I)[r[`sm=.dzt {u'!endstream endobj 457 0 obj << /Filter /FlateDecode /Length 3137 >> stream x˒GL%XpũS+)`iS9H*,ɥV%KJ.tAcCVJ@/o x_y3K~ƚ6M9иyys~9Gyxcͬb~6swN88qn {n]n:zRv`Mq#or,s)~ ]NjކsU ΤqE`N0a)6gHĈsa:lwwKnE!@VU!3F7 ;gLG8=\l6ꆻ9ޱ4|u<3J xE?۟jkzB 1f@\5nƀds) JT;w)ʂRIy>n뎉VUH fzݾ{WY~J/c\Z2E&4 mb\=^,c m}`߀0bUT?UE?j}5>%԰{C_6/d JV̔cj\WEp*ΰ`*Bdn3vQRy.B:Ls]ΠU C1# m\4(5R5 5+{e PbpN;9Z WsqA[Kv†v7,p'ŀ!,a!58# Բ6zyXCǙ*"Cp"d*Nj^?Pse8Hɴa4_حquX"_my(uMhay $sNܥA]꾅dg]l+$VM=Uz' {5l-TevI@hKcjIVM` p -?-gy4}-)-ueb3gNCAaV Uh Q!DfWc+nwapd;eCK*ZE+y/ zŞ :Wjʭph Gz-^Y$K5 Q\Ԣ"CxgTA"S 4NbQ/T!vкhAt>򄓂8ύ_ ,ztUDAī υ;P%۸0HneJs(h7biI$fM@jn/PQ \*"5{ l[ j\Lp pF );b.EQ'4o}uBAu`s2YWclJwԯc;meԎ~' ( =X.:7i!8=Q"L1i98zIHQe"Pqw؁عwu2Q&U={*#UH²$Ä`f"H\]; ;8u-ȗ!͢.#B'/ 3mHC U%F (v5Rd9C@]?5ċLiƏ&[>27T THrt[U0ם;dp+gBa"iQ8$AJ2L"%¦/ 25&xi&O,@x~x7?D|Vaҩ+_̣_iaCg1 ,bHHhaYFBǝ!K2ZU.ЈFNbT" 5@Ef#\$QX@ ՉD >Q:Vnʴ>}/_]Hhc][*{Rcf%lܖݰli0 H|}:"Ӿ, ~KG%eeXI6t.'Q:HNa\_І$OkeҷO ?ILYo~"@c+ē>!b"|M˹oK9f"X/ovyusCVN0uߊ~󔯉!'Q!ȨF0ڇ|ʬYb^6~ީ lP['TS*N΃׍W~~TE48庱ȿepOr =cZ קe3y'C߄GM "?9v_e|CjYUu"o o?eU q~&#endstream endobj 458 0 obj << /Filter /FlateDecode /Length 5011 >> stream x\ێȑ}GCq~x`/` 0}iɮV˭lHE&9]ƴ'q(F~dgOtǁ} &Ƿ?j;zoTwo0A?:0{ϭ߱Q:axwRo S퇟'g27(˘r×0HyI* 8hU ΤqϤX99 &l`,ӂy'h+[1= y\&٨KkFuJ )>~<p@?\X7j{jd$vTJ2=ZբPq&E- N1p ט P!hH?^\27JasG_i =2UH $ΑpEM hyt1i9 (n3 AQ-bza x $bzd6[fhrA$pCޅS@|Ҵ!=I32#6AUZXle 4sңoA$*1bKAH)tNvjATM(>Z,M#ģ'-U B-m s%)d1Lsɕ˒qd@Hׁf"!hX6Jr $(;rAmUf8iUI9Ǎ7Ԝ^ J b K4U6qRX25iC{fc{QުلY!ɠ98e7AФCqAMn,mҨ 1HXTcPip`}Z4R`6m5=Cr$-n6Y IeYDPRS+ل@q_9,7 Ӊ]X 24wҖұ C+9_LZ-ԏs'VтC,AT~ނ_ [cZ-[7][\#f^")Q!Z;Fpÿ8n'0Xf"^o_?|}|h{plk qJgr UӤwy"md:€p,x`Oȉ8;hK Z4."8731^NN!6Ldirx/`DPs =|9LD"B'أmxmT& 1A+'+RvLbDCSt.Ibl`XPd5P?7hq`ksg`i r3]Xr4D,̱8V(dvT"K*!J )';@e]MN"7ЛIOna$;\$.U\)Ԭ=Ue;@ KQn*92?$EUY+Kcwth6Bhm \5-J4\('D*Th6JAnOcw ؄b4vCc1lncDvG}"T!R'ۘ*flwcUfk*;&-FHҾf{(Ydsd7!b5*۽L7ei!#Kf󂅄PtÕLmLp: v:+r<謤nOr+^ٺYPr )w3F0^RbsZ t).Irx~s.{Q|9( 17rdfqLa6*Jl(GbMϮ̮d@+I".TvCP\kA[tQR6o7r-JDe/S9mq̜FL;a Tg_F* I]l]<,4֕%ٺ i.ک!m;"L4&KnP#@VVUTWFɒK4 ‚ȱ*S2葪2>,d |b 7ʂ8s!t< 5IZ_NO$`NJl|4J^U$7=袝L/*c/2״ =&z#x~hIӰNmcDW:m p z~ >C5[iBY W25(g[T\y(19V"Ƌrd.jPXTN Q^6&zI C.0V6J']z$D꛵U6-*HnV]-2=4# bXO8ÅFͥZX;@ФB AaUiT ZZ:lgq곹mP;NwET2F.c4* k`!6^YEFJdt)zg=w--{g3.k=2O_QI=&qe,<1]ݻLƴTVr^zn2l{!K&xĸ_TmcgkVIp/A:!(ȱʉ]:q<5S_ Ϯ0fNK뱻 ('rJO&`/t$j+PUMguZ!&CaLw~^ ڶXNZ?PDO w)z Gnn "iCwޫsZjzADąl(W~rɢx@^u}֬wiݬ~z蹕5!sa 6mQp!Q^B! 6U(H4ZwKOYRuini9S>O%L)|?rcӦc-pg$*Þ i\VMsSF ?7f|Iw|鹱VԈbd&8A+߄'1aMj8rtS'Q㄀Gنra" U#~t`{*qN~c1z,vpɔ4"H U=DD/D_>MFt2%|^ư&NxG=XJ5*ƘTQtukXP$2P}a ΋0ONc'_0 P/IIE^=ս?OqᅾWR+N=jZl2>]U2cuu"lwCNl}?6yOeTpHEgi~,~_⇪INjM,XaJ֕8)+E;cDfuPuҞ,L>;:@-> stream xmT}LguwM4Tщ`"88MĂZJ[ x@>P)P@#]ƜUٌqL:tE3쯻'w% o/$Ih:xLq*)Nߗ_FO~G)\m"ҍGIM#VN+aa g+͝\t2Z'k44*7uZު (͙c6U KZ4[imnU0xMV9N54x-6nr ƒMҥZBMl$"X"XN >!h—C%72r WWl,;̻|$A@7R{dbrOa+㵖, U`0B{'L(@Q !M@ 5HyE ^L43 b&fBS.aߔIr϶1&@D^}]Ƣ*l{:+jjo2R5V.=hc?j$?DjG'*IAhc q]_6W~C^0?.">]'.)"bsqvsKp<~ ܏1Ҏ@tGa|& ~QW|?j0C5 m|K˼DڶjweWcMxD3r jjہ n8fb f}:νzbG$p29s/_[i;+[S!؀|PyY-7n>{CXf+y?5endstream endobj 460 0 obj << /Filter /FlateDecode /Length 6385 >> stream x\[o\9r~7Gdsx'$@f1Ebwf$ޑɗ[_]xۭ >8||u)WDj1lZϬڥ{hi S\Wal\}lquMRz_(.j;hzҁ{ /&quէېY SL,yIvح&O˰* Wx]&DP.zs()EDRr1c3yߔUNi..6^89w7yQt4DfWQRkGk'k'E=V==0.l]t28k=W9!mewi z]%. D zya%gC ;S߫B e MH5qV#ݬTU'L7ySj)W]y]UFPw! Hy zkZҬaNYHw=\v|MGSt-ur] LˢM*K=of 5˯Boau;+-Żu/ka[yCWo_DР 1 IVЛ&Bnb0uPRVNi$Til NCf(5mV8` 1r@N=SO?&͹>yp<= `g' Y{؃!l_Mr7O|Ln"@[#IZ1.{5n,;NmJ!{t|Zyυ% s+ݴc%f'߁´+ڲY"DC=@Mtܠef5FFtYXg7'UzV)MV;ZFV݈n'lElbo8,a]3MI:9'q$ +Ls T,50,YYycj?Pa]RR^P/ZT8,m`>"U i/ DE@h@<"# Klu|ain`P`n.ިOu~dU@>O8Ƙ81{&|>Hhz؁wpO-V;0=m]`,[[u`=P8b </aരy(Rۓ_<&c!s淫jg^Bz!.mh- ]}Sq5ML8 XD؛[˄3']:8q^&ҼQ zngtFiBa0 &'Z᷵f ™VmgDW;{.ԂsH,WZw{@/_KraQ.1[Xf.K/jR\Gx6q ݾ suGU6LD 蠆9ߚ!8(TL. `z N؛ۜ36kUm s(c̈]<4.A4(hv:JмNJon6s]Va'x`̅`T%IEwtWÓ N[(0|Y`'qQȔ:IP֥21bTd6+.L 0ÊNkby0nDU L2Kz){( XU 4w'LOd 6[zЉE1G=6Vj`ou1"br儈XmeT͜smR +D+PV/nL\j.\1y2TmBTqH,!=i3om+K6?T+qQ^u}XT7Si;vi苓탨Yj[P'aM~W/k6ٻoj6$ s$)s$xX˩#Nhi֒b4Um^w%G]؉/MP M7n&d$z;FUb@V2^y5ʞ(x]ss<:H5nyJA}w `oA'nXiOTIH^V()oK~/9bx8)ՇZ}vv zf*=#2 r?_U=Nݗc^H|&2M5MA&ԣlXUR үZIrobD8ր AmxFw[tntIx3Emڼ͑*s`># }1Ren r` C`rйC06wyH4/AP-!{T&ˎĎT xgQTwѩ.tE:D}TV=T4y*9ZOCDp31bgQOZ/fͼ`e TX@FĜ2N(<((h"<3w}H^ztD;K%TM }̵zc0 '>d&|BEnf g(Ny΂ҔTUVg8$ FH<Ȁ ]d!$7dd [40YU٘` עt8$^н:B,*f0ӓ(3 a9/,6QyRuA)яV³ );XVM맰UitʘD{ ЪBn ϮɏΔ,+?.IUuʹo=@$pE|$ZP5Z5O^r𗵣j=}V*zO>4贞$w7P v> }޹bE^،iϐC؛<̗4;U?.#)\G)Lգt>a$%|^d|fzO|M{DT+`yݧL 3V=bZ]/y}ɲyBjpZ1iw.jEh/k>eKݣmNK^ ˂Eo9L5g" 0eyb6 Kߥ4zl,A6jCm\!K& I=+V:8`Lmck+HvԪ6aVkj\F.sDP<~D~5ƟZ<S#kFÜsǘNlOLarG_|tuSS Ph'9hbe{Qid0b7n3L6GZ ֈx(5etRDAՈ(F"e 1Gy(T2ͬlHh8iLUSJyrOV|ʧHr<;ԺPZcWBIY~"ʆe?< C C;XYnTp߳WD8jg~)<6 }:,62/I=8n[v~;g|C',XRHIܝ/=EXc](hҁ_|Cc$m[4/m1PMo(k\Zac-~KU,LY8]/f4ДƳ0|GZK\6O? 2bE`3:sR)ѻJ;>{z Q!mqz!V74W4|%YlzQe,6M0=Ÿg}#uϵɜt1Q)uD@ V&xW(A,~ J\6UowבsW V+j~Ϯ-g\:,EMq׺уzR E=;> stream x[[o%q~OsNxoHlb4^,z$FV?.l>Zͬ =jR,*Sק KW'M=ͿoN zxO*ӳ'mTA)7O4%7զh}8m>@heCqbhFA6@ Qak~Hqd`6i`{_ȗT}NwVwca`pRzcW:¿+ wp{J.5uhsX7wSDjھ0cq;10lCc₇J[^;Sq#Pq tMRJ'K+zgQڤo,nob)h#"_?uحpU:|ܰtF|˶QݴiC}M1CF`G4 !V֦́v$ei\ېހA8R-GC|R4쑤+gZ|bZ3BhjSHoc{E D`'V]LI6˝f01ږlI׋jI}&y$'AXbvG/'ƽ{0QSl},&)>ϏrR(l :cz^"Pi/MnE34mn62gʆ^Ӄ~aF#B^~\~lbJyȸS,[ꉔDkr7ߝQ?)pbk, !v~vį&*Y3Kjvn^mm^MͿ֦6|sj6_UnwWyp[tzEGhN4y3-j~kbiQ)A*.v},2$z# ~Xɲ۔X " TlD<,q.awj̅< n23v-XfT!jr1=G.0?C4 Z{;?ci@7TLZ"CQxTc0{ǎm׭Ȁ#K5PӬMg 9rauk"92nJ\S|':5aa3zp#N{Y$p)61aW /QPcL8 'FhW1.nQ'AZ)8J cC,(3tl47/HNfT@fâAI?p>TvWcmumUHaag@PށXA ]6u3H ^hZYRLeB0L|:[VxK05I`Ol6seFQfb=rUЄE`GxɳwFb#G_ <TQV \0,D70ŬT=n9^DD#oRh F=Ts*sd5ly+>,}m`^H l;cxQ t rjr|nk`J$Nq$V=?xrf fgfl$3%z#dK!d3#-B5/*z/82lD n Y:{}=0#z4 Y4GH%X )c7@ﵤEOdR`ˢ g8kK> VOZH* pW%yF`V@l9LhD8^A̶MY6!qe(9B*ɓiVL94`K!q[5s-0k2u^Pkѯoզp=aJO i #d,ο$NQ/$\9%e#O `#LL ^^$xvڨX`b$ii mU`Eկ$:[g)5p1LAW׍b"j 33P=PS rg-V:*uTUDi-撡9NIjXƌWLW >\?yWF&%ײL~&QbcⳊa'?9ʀA~@:f1^ yx*nGrvKd;29/耹h}"Myu ><5&7 tH n u.A&J5/rQV\UL*A1m 1A0gzr`!/9K٩#>x!* ˬ6I[bRC tK^*^X6s?3> :O0~M:OX,p3-&3qpP?`nTt~ zdcB5`Y##MǢ+m\7Oe`8!v q?BΧuCDnV ~4zA'lO4白6zC Cx\ZK@i`m(3?*Ja xnTlöhx]Mջ `bDє(rNhf˴&.BM"u=p-Hpbz(ZzdnϵIt;8D6<.(;r6VVj;UYfZeh2k"3%)ҕ1g}S F#m*89Ƅb:!߼"6M_l:7r&pF@#׬H&\LTţ'>dE^Oږ*0BNcq 1oꞫHr?Y.*T WRL3=e DpAt>o9Kn]ꨦv^. ذkiE225;))sAύ; &#t4b|!JQF{_$3DjfHfĂ׽# Ypk!Sdڥ!Z\,V(z:ͯpu\Y Z9Nȵ]e)%% fp*@DSW)2 SA#t%,5།n li>o3iK,;3o(Tihεx=IG=9?|zr>UT=m `ֱjcJ ANybemLOV D0ٕfDfX<_ζ\Y0{)} ųE%8U(RQuw׼FQ T")o4 E %m2۟ jdnD~A]ށ~(v,9_}I@iCh0;W DᵾYG8Lfa#}%3-x.3|_=0dQ{N'4%h' ۃ/jROGx͋g{ڣgTN<^ۣ}+B4D=.z,+GK!˭ǍGm:L&E0akr}S3]a5)<6/ko@( ép*5OdjGjpԴpr ]gaI:BWϖH# n?#il{o`[N6*=Yx|k<{uW~ +FܻMoU~>73KSx+c\Ae}cԡߠ虥Ug}Wp5ʅ smom6΅4{1ԣKM[v?] Ϭ6zw+'UwFFGƅs[Wqxbp5B+6~ kcV:|_sO1@7`ΗoeU^daS]FfB~UK ϟS Ј%4Ӈfn-)W=7]N)=gc"=.=dܳ#i]{iNHIAgۧBɂ??AIendstream endobj 462 0 obj << /Filter /FlateDecode /Length 6147 >> stream x]Yo\u~W#<5aeF0-dSlMjFyoY:U.Qa)7JV)_W.4?Bl+T%}}fN߿8u|'unzM&篾ߜ96o&Zuzt0>o*mn񫨔K{e6g\AheC&n2QR۽!E Nb& ۘo\:͟Ü.dZ/uDթ}ʰ@awJ]py®  \7sP*e~eX3b7kACh=LFIN5LBi }O;54K ]ɔсOL\aZp?0kN4sw2(sP|WgǍh孵Ncԕ  GT8 hr2-6'ФJ5R]@ (`wyɳ#_pNy9ki k&Z&V9 H8a>̌̇r2[;*~R=._Lz>9jV6SFv |\^X!9i2 \[UJ j)جh乚ԋoC$} u[0O $.rأiy^mAGħ݃Rx$k䌯_[Ԯr5wpXMd(ky=w푐KVB>i܈;V rXiD5i<`0 @J`?y兠*y{0|A20{b6ζc>ۘ/ΎIh&K bS*,6N |Ɔ̆ )M̫c"uc PQ6;S` "65+7N2~cn*B"pjaa  i4{B?hf0bp|H3c/9nSC.4\hXa|wJ@E`7px @Rs+r8߂W=ۡͅ1iC7C l ׵yY?Em~S- 8؀~&ҰܕFc'?+>'.h7hd/tg<פD'Gf(պiH/EWgh͍$l~MүAtOJlx_q0>7xfޚ`Y&VG/ ~P x@FD.LMjͯ*c ) GJWeE8Ig*\1j~82bu?nw6[wK#(O^p*6psڼ՘%WlB[cRCJt)b4R7q%z$& .6H#,ja(B_@+(c"yU+fT^04.v0λ׵ǺHϛƁ."8D#v /c7ÃB)~qT'jAo,0h C^W=8 lJ0Y[2u;g":*XÍX"TNqjqve9B w>V$ >RL3˓܃"ӹX>+ J@cO|etJ+g)K9C|Hgҽ_m)$^dXdgA>ZG}DFe^I[m$v,֨b&fwdK1V r|9r<~6XͯkKNJ(d 9yk7_>16Lh-CjB"AFAIx2dUkE 'M(8B0lL) g[_r.]$)U bA ڻ5<K2VVJܸ hj0`V5|I b˚83nimUx909m)t2ےkD\!+^ M :t+C֋s9c(IZѰ@,)Ta2ɺ{(ED{yJO:+Z!p~$w)vmCMndofE oۉtV_%V Ε?{dž4KɊrZk"#k.uJ::̆-6e2i*/AN7{X=G1t; 4??{ I4%r6H6k 8Bdz M7R=W ,$xL͝$<ֺ1 [Jugtڞ*P4לQhdXal% a=U' pUpIAi?;µXꕱHLSPѦi-=ɣ%Pd-(^j\9F+ ׏8a9:^N]m kiW*uΓ/s8MvzFq8 oVy@^3'9ׁg9rFh uʸU‰\7lR_>6\LT5RHTOc# sby F7ewpQK/sƢn>xN}BH8_ˡgRy<,z4\؇pQm5RYuc^j671;ڈ[W|~6Ng 󓷰5wH¶͹Jlב.vm6JzVy3XwXmyLTcB"SG_x# 5zGe]m ,R{lF=%T!N*K+XE1?Խh!Iy덟/,Ĕ !eź*)× 0DAeI~ŋL٬1xħCM_5yx9 ]lAW'\SޗT7 bnJh1a)ˆmXȀ;͓jE4Jج5|N"|4"d/Kvkf%MIӇ ۾Ӝ 3H&v %*cYPw{Qڏi2aǛaZɿ|䁭tv^Rx5$ymB^K#7YdtU`JըlMh`!6NI5 )-Adcg=Tq[-$~d-thAZ |zئ;N~<%]9]czZ 砟4yj7_χn‚J9vv[o{krt@ \AeX#M4%JݭEQ[ԉO[)J'hL+_CpݭƵ!O/_Z%>Yf⇼oS 9pyvXaTÃVP<¥`^"F(eZvȲb)^74?賓I*4^وwxfBGg6L!Fj=ee- ^櫳%Iv=8ޛ1Fk xlAILRRG񬆱e-yK_O+`al`;>-%l{ Z^IpW"rgpyS+/Kl)iĽ+ٜެ~dJt 紦u6b<=@WD~n}ǦQsŊ+G4#{^ߝhr8؇g3w(K~*㪐pO)-!C<-6t$ܔ~N=.AaEgK2^,+O7uD9ռSLrH,A /6=*wQLe,٠ |٣7M`%6JPd1\^^D.NG)Sr dƊ蘏Y25WU1v)RؔPwjaVȼ#,viJBM\; en V7!nUTc4p 3b'^ЀmG[ǠE02`c5poē.Ԫ]rń@Nݑ%XH1O@"CNQ0L-]_qrj_Ez؋ZPGttO1єD5Yh'6˩ƞ<]~gך h-b*Ļp P_yVGkezSh`u` Y8PfWE@A쟨/)|*K,v@79xeՐ,]`EbZM/g֓]1sF9F. XirS"e?fP묵(ViӇ{¾+Ӿ|E2em8r?;.So8#+ IDLG]<00ۿ:4Ba-b |Q&M1G_Yk5M'FYM7YR2 q<^V;k %8SUG¤1f;endstream endobj 463 0 obj << /Filter /FlateDecode /Length 4955 >> stream x\.KZUߏݼpAփA kh2{=UE6Ylu4ށpCUX^.o?,B,w,$t~X~3,QDzHK2ȥ.>,:cVWRf}PV\]/~VkL:'@b`u ! ĸv'&+0`@K U윳d Ig v|hQ1OPd#8?4@Aj"ĜshK-Y8I1r~9Y @BYd.tVM/pqҁi!'s~YyKd sfs(@1\*Z#`9y AD2W?g~Yy=P DDzǀv97,߉7ѵ{Ny<,t`NB#bN#6;>nVq nZKsXzwtDX'*2mxRUSGeejAg:" R/ε/RRp\Up ;Vs*B8fPC= 25 R``LVP ۓBvQ2cBT1W))"-PZ]jK8WROQK1SVu$耱^DP%mK.F0@ [[(Pēޞ!ME|!=h =n=C9߀p9~t 9N IgX&~t!T-}BAGl;!B۵A{~S@kmޫ ] "ȍ}3]=B5ە@D=v%#dK/b|рֽ%&t/h 6~`dq/g٘v͎o\zI0 .qDZVr- }oU 5.Q:v!g60}yX#y#-Z8Mnr7ajM>T)(0~c )7u{hpI7wUSQ#)~KX<Ȍŵdc?Q0 }ZAq3CBz7m@wOX`(܈8򺪶o*!}@0gqZ-P>;c"'~t?7~n~?N{S?vv9y_?o&{p= ؖc8JY=u:~&N{ܘ[~~>G+NJTqLn0!'Ov?iSlO[smTMVsM<; w 9tcLAN`ޤ LsK"[v=PNB%^!1)cPETɡ!dK 'K+~v!рD2MQ L;%ٱ&4q܋J3$fȋ]+Q½m*]Д}޾H9ea8'ٌEsQ?~zQtc/)M./ S©FA8p~^ȜqKL &`oUHq2}C_S7ѽT%:R= #+1Mo'`8cg_a&4Zo8KM?St`; r#vz*". p}1d1Qm/ü_F{Ÿ/h2zs103e8oMo@eMA`c+8osqtb}h|rCOdZ$8L-;MJɍ@Cjw" }cQq6&}ӃαFKqOEkL]w[*x+srNf{aI&FiM\E0Ln> Ok\][7sg8㷪 xVWį@|JJ ,С#e34#偂kRgٷ+﮼ݕV<;C3d/#o(GȎ2um&w$!-HDy_GP_EyXJM]5ScHSGjԙO}tŝ{ O}!e}Nfnv8 .4hj[:; Ǽ ^}BhR|7u<;wendstream endobj 464 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 512 >> stream xcd`ab`dddu 1T~H3a!sO]nn?r ~(Ș[_PYQ`hii`d``ZXX('gT*hdX뗗%i(gd(((%*\"s JKR|SRm ``apc;[d<3gw/ZT]#d~,3Dg-ʔdjʁ22|?wzo1?SPtYgO\RrXN7GGqʞQ#Ŷa |Խc/ vF5|/y}ٳ=cq|V[7QԦ Vڸ?^nŕsKtsmcd7ob ݝE?V|wga(ohmWS'/`8} un9.<'\Xfendstream endobj 465 0 obj << /Filter /FlateDecode /Length 4559 >> stream x[[o#Gv~g#MguZ ya&0`F$fHf}?9JƔNܫ;_w_ti7w VkҹޱvƲ(9j0\?+9fl{;avfy%$kM2͕ka=*ҶO~tܶ+*NYێȘw﹡܆=LYtiugx :zgD+8k(cZius|?-oBNFIa;Rw6v 6szRMwmgpa9-, E6=듍5@I4ilW(NH\Q ,#wLj+%JuQ(0۷Kց1 j i { A|pF =MոIe7 ,(P Wfpg`8o3l#b!C)1@hmBr`^ڼK._Va8g@ wNɫ&_/ X@S\\zZ^J*Pٌ4挩F9:";?N|,OULЬG_ 2;5C)j/wLė3p|#ܧ#(hǎ\; D5Rg{#˽7N1/:╀{x/F݀w0i?]UPW:Ya|NɋjD" `UM:;ћbFS{953 :65RVM8G(ܚS7LA<{@~9d&dqlC@甲j+JB`go7#Z[-$A礅,Q|[Yu@0Fp~=J=~=gNA\mqYβBs<\'Be]򎸺đ\8f5Y 4ϯbeU$|vJU)XDDȫ'ӌRMUyv\`,~ɦ!&BaRѳ|zg!X "x+ǹ'ɕXن9&Q0+bC[1c:5&!TT*w`ƌԫLQ4rV !!,k8VI!J ӬFr#+^ÈFIF,;;)duJ#ڇa{<|Ӭa7>ش Gjiخvq4Fz|m֛sjўO/ {g~υ77y,lhRtq X&ȘHɜPNPtnu46<,o{.O=[Lòm9S>9=m&^we&npJ Z {݇ZS56I-\XD(m|eQ˘(9 E:ـGS-[)a},"aPM׾(PuSJXh ~$0t־N;)WҖ-neÔ37+v6 hRD wPag\`zm{D^^Ą ֒{Ȳ)EZbp>܊A氄 j ,t | /=Y:H 30s٠"@떞 2A<3)ޙ # AHε=cF[Ս])#餄m],.I Ʀ\Bڥ8 +2,b"UY"2:>Nt jSxp,C4LA72I#*/Tyjpx~/aVMd٪ ߃PvD=ISPnVPһX}(u H *sQ8 9ר,.ԗa5TKɾlO7*Bͮ(WԏhD=~0v%9̆:|_6NO"yLX_I/H:v)yb7ieᦜeWܵ8}r1uT\"2Pe;! *P& QD)|} a^KR}ٳJxxETe yyg\^U N3z(QDS<$(($в1$z|V=OC rd\9?*͜n]5@{0_}1`/\ _y!xCI%;DB&$CPkT2(PqT: >ږz[ ՝oe sOf|Ӄ/z~3F-1&rƍuTEaoKR:ĎqM8F{:^;vsh=15|e5oDT ֖u*Upᨹ 6}\Kqe/b W xI*e04!(<N&cMդckDvC }g#._9 u.~O_JM{޹fuT^:I/v$TUql'ҧ$2f NEHz1B*ԾuO) c> stream x\Ks#xܭ&S\rSCb+qEOh`0))3@y~ߋۓ] ;>y_O?8 \sI-? #קFշk60(VK&,ׯ`vuWG+8rھqЌ?Z(CΘa aXlv^E# "塊>?iV5sga+G$_9_qXHfW)ۙ`LFGUzd4  `8PmF I.[`u*! jsz|%Zl>>"}>E 7e;*abNp~"©slvޠKk~e G" Opp B(g%O8i71%Hrcm "BxB1Hc .C,+oqz<*9Tև42XTg\s+A$J\I+(aLF8&zf,Ԙv0,M48;V*lIL!YSO|Br!i\;>K2r܌8¸2*C"pBc7It"ͭ\IeYMH2Q sDEYfOK$%< Bft'~D `O= ' k@P  Hm7 U &{k߹Ff4R 6*7`~cvS՛7d?egA#SIW޴ aΑ*<*~B[IH%G5*ǒW1S"8Zb" G4 Q&fBСT E0I mnI" n¤A.|HXS$W% )[7l ``*oI%MZ`g0[G'XCL 0$1D٧۷ygjA* $_A%Z- Qρmm-ݫU.pr?Y@ \EcۻrrvԋU)]U3]ȮQC i$Gy1FV}kb +bDK=T)Nudf OҔgXሌ:mBO'e9%l6I-#` .'R0+.=JƛUt{q"'D:c3Nt5o ~]wKoNPOOmEnBș,]nԒ1j6({Dh( 9И+Dž-%0\ 32ށ㋛x kTa$ 9%\DCfD@k+b1*k=BYT)#e&c0"r`a/;/P2h Bl-pJG(wLDٺA"|M"QSsYHnFI4yQe51^yT.K2 B5M𗂎q)Hi='77)l1>_VÐΪqpĐ+СD A7iK<'Wx5+[bAgxPm t(pzYvo@+oatʗnPNW7gsQGJd!D(wMi$Ee߭+ 2fN)hIR]ܬ+JDK2 QZ@.(2Ei#? %S{CvPRA~,_i%}X`Ȥc|#=!=hP-ZLi`W. ïU5ae.;$iPH{`%0u|p,WtED POLw&e}yU%fpm/<^K`oHE6Hemv?'E/C*|I. ksx2Q- sߑ`;peu<@I$g[t#5gCx,b{xa$hLB2$pȺmyT_zUA_f.lymDWb PEsIk9euMr)),ENB><䶭 Nfj'^}Yr3&E+sv]Wt8CK!y4 OکNëI5.~ S e.dͅ#U'יtYL\IZM3o"t#3&S3H{0o+weump(M~U˅I0ܕ ߖE+Û>aY׽k띤[FL+-#֦(p}̾bo|#>,>ULB @rM3ۣ N;a -쇍aЏ nVr01W@&P[Z,fzGR惵DQ]P3;_Y\mtK b 5n.KQ\._ypx8Snՠ;gt=|>Ո{QB<:++)}&VGJ?Z䥛QkBQn[뫢U}bW⧟}!P&XlW=E(~MEA >xKKrof+q~XUu 9R:endstream endobj 467 0 obj << /Filter /FlateDecode /Length 3959 >> stream x[KoW,rlalYcKDrcER.Ň,|3]=, U=U޷ ˅ՁX=鯋C2b"\({-[Gmϻ) `#T|\ aBŪ&Э7˕֪Rv =S6v^`7"x+) 1h뺼;[ؖJrBD_tR>%Zz՝Tt/RQ._LuQ1. K8?0Z^qe3xAce9b{ utT# )bB9z3[ <9xVv_ޡxR (> rR|w>ێsJ^^ݼi*a t hBEކJ'5Ѥ?ḩ6.lP=*mڜlGt03cd/1Qqd7 Rv"Bw/l9o]̓:H>S|CR4חg_wH~pT'l#Bzw^EmA]ciz:S-n%D ӝ^RjP bGO{͖9s81xaM-x]rj !V+{QM"CTQP$h-V$rq6(,# gH# m9вT>˕!\B6^NyT4,{JPg&Qc4vMn-"k>jëPJ'5;䫑P"œ 8J{pAk`6uk/KihȐ0PZB*\jCj TX9PKSɳj3j54^ƕO0,a 5W]YImq)߇GGP7|4vFxDƂfoubQ$(o$GqKh#ϫI j|G7 z!rxס{-ߦCE+k\Ds-mdή!`D]z̺h+`ڒ{p*7s<9q0ғD01+=av6l;FNW VچkQ|R4/Ɏ)VtX4E G QF+J"#Vyb0 ĝO4 Y2q<@*ar,bB+<̑*ydTp%].?_lK<7WO'NNf%aڄe,-GG5H;똊+xV *CTq s!YV?T'uWK`CI|_ Gp\AFr9?EAsߞwL2;(4{CrK6vW)Eö)kF$i7aMл ]z[ǶǙ /cm]5]unfdaVסHMr F͡2pQUd>0ɨc[2rE[TdcCEr5DS h0x(䄑x)sJm)JdqڣI6>"c<:R@H. h.ߞqrQJKMnj{A fɄRVpFQ+ƴ+eD>bpb*9 ňOG4ȇڇ㑽(P뉐weDbHs)#Zތ>fJH$ZqyS0>]E BW4Ʋˏe6R,A$]IͮtGn~_dr.?\Y/+8&욯{ gI\ͦTFhmOgyx#4GWora^tSং4|4*hYL}|nNVGl5y<'jRmAC+y(ng>iDDVՉ a̭"-BRo.$r9!yS$A_i*bE&W˱eR{Ŏ2&[6OWYB:~&#Ck49K֤5%VaۉB,1"hlh֌m:Aԃo{6tzd;CO,r:o,kL8IY12f)> UHAG4#?ykhv$Pah ꒾054xkm{gLNיz6+`4Gj}5qLͦDH% pkn;ur*ަ^T'ٰ0OģVtklcxyVPJ g1+3w),`Tn3G}%>~ұ!eHmeΕ‚keGr~bu$f YQl+6ڜYpWAFi3u~k|pmGTo_q/3nz6:I餍ohġa)*6א=xLsK7J_=DR‚ԟRcjv)QǛv_N+шvolL@vIGȀ (.+x2Se,u ]s[~n ғ0ƙldC=8:{c[~zm[v}Clsu(>s:jC)Jm߫hɴ\QNqBv]W*1ԕ>ҍNwy m~ӨQ@Kv= 6݁6 \ZLMɷ-X_qP\ZqMxi#5#EߒJu8:w Bq"^1*'1_Ԥ4OmA UAѧ[6cw$}FYu۬G3lmL NKYnk6Λ+KݓMܛ`3_n|tFL/=ZQOuNO^ CGGp:wP^(E]It'f:%y"qxTy}=5F){5L=Cӌ1. o6!! Iz>E*rzl0Եi\Io2;alsޖ|b71lwcbeq"c.=u %F8ACy;ЖR&,endstream endobj 468 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 189 >> stream xcd`ab`dd v 544q~H3a#ew+o_ 0012:)槤)& 2000v00tgcQFBըqVн_pON@[{W4_N\;~*{r\y8pBendstream endobj 469 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2571 >> stream xuVkTSW1$\N꽡UǪ۪([""HB HB'! !/#фP؂CKj[A[m5}N,:kfG29Sw߿nmԣ jj1 ٭[X$HbࢹC `A(}c2"imP$ $Opmڴawڵ[Kxb~~^)wwW'y9w"D̚5Rtu^Ij'Vq|I7WWNpӄy%< 3Q'K1 {T(K**d_)(:|4wz ۃ2}, ;m^RaiZl' ۍm6ca[C#4#X֋dT3=1"X ֏Wŋ IINxOu<+ʠbByQ LK}u7Qg.]#C< UJH/?\wEFP,8s.o^͗W9(erzuViwhhE[6+tzIG@F(>4 LǷ( r pHɖv}/eC(X$5wkQ_9lM)C•E@C_ͦ3 b?#m?rB(P]&+VgiwA;=oi:=)';1A\~xƢ WG~bz"gG5Wj: ۔!6y&8@hN 9_)Fˌdz:dӀ+xSQh&j(|O\aPlηӃ eBX@Cr+/ՋjLDZZ= (}ι c:Hn^.UXS8f:4BPo"I!Z$u^9@<ł`S)hDDWfjjKQG aOi% !vA֩%V#%`12osC|\)`&tf50|4~U? lІ^0 J*Ap4ڈΏ}65&,X.?Os#<!f.WZEiەT#V)R D˸GuL-*q^K-T]\.T:Ξ9 !B}C0n0ֹ̨QגŅ/u=M.^_GoKM>U).M؟ϓJĄ($p 1Ǩ X^+4 <*.6W `C:I("ucYб-&qFH&yi4*,up8٪!+wlo/bGsb@RmK枙t@gD3OjV.[UF_ WylVG ,_C(YHϞ`a.KSPOO+?/?vvdzqChiF@9G>ڱxMY7 \ Dsh7:46>kw*ʶ?}:6PUrD\_cRR_q),KPx x^C)iyݸ {[P:vO0;L 2Ju$EEI B,geQ*Fw_3yt|2`cﱵ5Po4k$Ξ.xڴDp U D7(^0HւZb[@3[TV߻SNwqDf ?ĒoUj(:XN.ah&˸uuFmfJPs6^"I#p_h$91Q߾+~j4$G\!Kdފ?K8:=Y#EogfWP/.#VwIW3 tM<Ђ_8`i&JLms6ۈ#-ouW+j5uP(MF c/~=럯[JWEn|ڋkj#a8F6`zcu~Z|,I}NsV%*vNmFv)yfi&O'p;uO)h-xZD@h-۞0[8"(]4@_H}@yl>{u2ldY%l,}~:{cxV]a SUw+Z}>?1՟u UVG\(4L:9Z2n%^Z93fh 1U) PaSeݯQtA nڡq?t x~gIfs${wa]mv5pM4W*js`J]˪Brǡ@]Z3_Rpdh\"1N.LJ:0?endstream endobj 470 0 obj << /Filter /FlateDecode /Length 1895 >> stream xYMo7#0\~Gv9d{H3d4?Qw cZ׬b˨>_zh|iPAo#pǤ$Ah `i$IqzA\x9I)i $V:-0t0įxJEĉgE\$G&W: ,$Ōi:)Rcd QzƏ.t NrAnδÂ+ƣ̘hDDVAJYqi,R 0q([=(-AM!J+Vڸ`S TAL!1N>A\p 7Ekr(d ' *J_dm-LݡwZq& $aW;h=wnHyRRx'nV!ٜo^/V| R)OwePP{ N T6BӬ!:)jiaBABTJKϴ)4ji6BVf 00p-=5kZG@M *3m5 Gϴ4)T5Cz5DPH-l ޠE>"ӧ`{uL΄)<똢($+e W-Kms-sZyv>M,{|{p2TsaWdL>B_ M,L񾯊}Ȗ)ʔ02k12f!n3ÿᫍT'Wy2-R5e&2`)vcswX2Od.[h2XjV?Έy-u8U쏜|>+0S%~{}~ ~R9@L4l:wyh1t endstream endobj 471 0 obj << /Filter /FlateDecode /Length 6641 >> stream x]ێ]q}#z:'b"Cb,1ȃCΐ4fHC=U}]OJ80 [U׭>RmRڟ/\._zP.~o//\~Zg|>/ɛ2e/Tƚ;j;eWjJt'&M:\5[v Ju0>RS+R4IkjlH'd}8T 1E A=+o&Ҩ~<%VGs׳?ydBrIn.Z}{鳋?7/f }Bn ZUD ldUp_BG6/CiKHTo;B'qaU1m (O:Ҏ2Fo"!eRBVC$+Ȃ`UD\7j`y6+j`m#bOOhB [ VtXhVGV#f6Oс΁KHrtiߜ`qt%H@_p(8k K[):,cfqZApPI VCXAb3Hjrwk '2yGL0!u36"3e`Ud5QԻkO*-枬ݴEVG-_"#2/*qā K#Y GN;,r˻;, YAV c'GJ#դ55VCZhWCң#Eg`UDE3Y̫!RI_!(hw(\Ʌ5Uu\PVGXQӍIr)R uYEy'#rd#t# :s TXM B$;B4d0JK7ZeEr:dd5YϚ4~ľ:Z";"ʽnWEV}`vۅgA/\(⟬*.4~x Ȳd_\rD#ؓ/iQ Y5 a6vM"1 :m,ߺr1XAV\8 ^#r){3՞NVSa"׊o`:sX ,O1rfG+pKY~\y۩5X +'SVGe5vw 2r9XA%2|(?:dME38v'eGȪqІ-iX_>VCɢ\ R'e RENVG$2:e"s!H^!\@VC$mXaC%^ΎXMN{m"BMP+ 99t*"y>xx*{? x wY 䜌_t P޳EQ{6<AV# 2m#U.Ր> 4'WbtD*/!TU `5DJYĸA u 9d%^#4`uXd􆮮+!mg[S!*k {;v6RdR`5d5G[:./-ޮ@G`(~mCRsS+Yȷ)jȪQ?k4d z@VsVPnU"4†#qY/i&"X,T"yGï*|*ZA ?skTEVCcM>b0f"V["9W7! 춁+)iV %E?k4a"`DՑUc eG7' Y7L\#=~CJ(0Q{ w?tt~N#+~D{~ - s_#~4:{"+Vʷ3_~gx"aLgZ B̯>+Qg_|W:%x384z)zQC[?|Sl,OUU#G>|׳8Oy;͇ټ[՗hu}r7k뷼Da4ӲJ[U ޝŽ?_!;_K=}Uw=''z~]z3ho.õ9g~<^k4x 9䧺H}x>?U)~Er&S=.+8qtS1JJt}L2eCކL(/2! ȂqS?q$GOvڤEY_nZN>tm}HXم|ÿOLJD:ʥּ׳b6>ln6?#ټ[v6{6&C8ogogml6XgoM_gk]_XU*?j:bA櫥%ijogn)Q@ &h pnœs.ZX8hn. ']:CNW&#-Qt8KGJQu#==Yj0u2OFW>gǏ^=#95/ɋDu}w_72!]y~L{&MoqxE1{'5ژ$yX? +^T :DxYg0uɧQ 0z yccL% P"Qmvsl#Q5+GŇǢ5tt =h ~s|7yOSAHo*g9 hx%O>=J|hjjO'yRkPSi_tJEy=cf֨AH4&olOG#^lS+ɞ]qvE&˫%c AɏM E{> nP%SW{0-I?rMot:=,θ3>#em~+PXIi)t~/OQ$FiN>-'͚5Oy=glͬf^7C6f /F/`oY)1%3x.-P(4ըidO99+p9a*˼*_Qlup,Jq&LoaA_ʈu~(=Vi5 U ^rZwe1tO* PIL 4Ť;/h[tG˭2$lPÊb$[Xpr0+Fr8$78|7P/7KŠAnq"7}9'% NQvJGdSH'92}9Z,s*;jzڄbxT bJM`P{ uRTF' SŠ=8ÙY1 cO.6G*׽PDz8Xr6zgZL%sbu2$Hxyѧ{p{rd)0Rg>$+Q<}d|zQ~\%U&/Lk 9אǣv:D%by ~ݙLw1[l'/A9Ե:mNWxNVeԕz/%Eq{( %iۢn3rwj5f4/> stream xXɎ7 WQuhE6*893@bm8籺ujcPj'Yjon_^Ҿָ}}t [\]sJPc1'(T`敹vXb>tzT̾ym sYısى9\ yR_d`5k ObaNeǹvu$EV'K抧s?H/7/zd!R:joēzdq$6pL,6Jk6X?q92eɖ3f_Ma\73 66<.`i@l^ܳ%; ($6Sl3\b%ʫ&k, a! ul5?cɆKf#KNpN42 hDE:ZVHʫ,)Aj c]Bd1FKgdSw#Wts^ ҈={x 4\T%QPxBGy$UCX #ʫ L k2ڢe;4VY~CXn{EA0$NWCg;& * pֹ(P'M$̦?f*=pzG >/ M5nL(Fj($%dYُhLe:tWy'"]MArd6#$+u T^eDŽdS*~شң<@y3Wئ +le_x0DKl*rdB2FixICNA^C- 0/<(}- U J!(DdG}^WQΎQ1׎yv04B  k@gO:b7WG ;%㎓N/GGwo]\m˽pԑͣ] mx"%b՛ϽQ+]HwC 2/ŧ3W N(t@r7c_ qs0kcƞyzo]8mPdD;qk|Ci;/so _ M[@̷x\' ~% J;N)nRц(I.r}W%}s7i*]ݲˁ>N_Qyqy<> stream xWMo7#`ϙS H@F-;ImQ)fWZ*qW0 Q# 9uZϫQ/ko "'Ԯoa-ދ ے}sit:>xqt1w"le"qّYB>yĐ+h;.71BfEpH  bB∈c v`:-;*fW: TVoPrSx9Buc(tOuNlv%jOgƙġq8+ |76TBVtmE16ɷmsD$>oU@k? <%} 7P$ٺO(G@7' h+mt %=Мi(׏ ?c:TIJ  2LEc=8i4)Q{+%^-Nσp&ɦ8e3S  |u%0-4QA]EVC;K':=T&a92?Aӭ n9R 2L /b˩ϋa"fFZK1\DgVMScÈO11-E?gDˠVSAǶ8k<$2F[D@"F^AF y?&4N(#8% ey ͙ O@'g:-0tHLs*':=u.#HMZguꞻC7L I|Q 2JK+Eܛ:X:|Yp[~8~ԣitծYWER㌾aw;%K{JzmĪÉ& Dr*#M ՠ[[-xLendstream endobj 474 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 705 >> stream x-mHq;oեc=*. 2+" [5f\nt'ܜeTEIMD%d+~} axD*po;텹}~Ws3M@ :U`:]7)M&rDQIIqq(ՒFR& zczDi5MNL|֘j& &Fj"UD^G2$ҶtJZC#MRT")AJSArbH5qs'X1lvoch[oו{v1% :et|b,#JsZ -}!KDmvnsc%@+>Lx0O~;rO;k$@Nj"Np_KD O3j xbbL^.-x'8Ȇ&#P/ٌiVľ|^5s?!EXreqqakսqiC!0ne [~>7 endstream endobj 475 0 obj << /Filter /FlateDecode /Length 1918 >> stream xXn7}߯[~[4Eh"EAK"Yl'޸H ggf3B1Iꗷ6Js[\lدs JXI&UW10ʳHƱz_R|g+u>"Hi#Ū6-R|{IFx6*]xTR 4=tY+i|w$ۤh kJERЮZ_kE*Ŏ%Aܿ𐓥tG '͗7~Wo6(sm*\,WJ5+ݮaVVdc_jJKE@pMBi(V5+:\)43F)"uo /v_>p ;vW0kL{DV[U'`zRxx?-3( z1Qxr&1(yf Jb Ǩ}1@H"!ӡ ߭P\fdbJXӹE(-tLIIJQH݃D͞IP9ֶ3K>@ʏ$ރO=.;;Z8__(6' lM) %8 IOq,$鄿lt+%K0y;oޫH&@d~PP=$8HAW.q}=-$M|0`{oYJVx.ܣţXz+1HeKWʙ 訍@Z*T5 z9Bc!G1" d$FP\I$e 5q,i4H>1k8 PPA y<4 *"_I[(f^cw czM]z>`!$@Sq/Z;L gSx,p3 @D{3,X>h3tw{'ƫй״;#=[ڋCG+cFwPlP&~bdxIL>pdJ{&A=1Ytc2AXj􎈃3ymQ'0$a, oٙV;f0%\re`{FU",bB+d/9(FZ]bEғpK=ļ}.4㸊!E^Y6#8!1 ; &{6{@GˆU0Ozm[$z%}V0/f8=uZҾpYk#m|\(b@=6O,ԡKLLg3i4Q+Ihj@k[}Oz;4t4T߀i*=4X;ROTRɼĘV㭧$@i5ciW+6orU#$n jf[B\Dj3 RB?fрg0ug ~r_no+Gtҩci:L#>k6)Z6ΈBȧ׃vp_3Z~Yu28SΎ#;*7#;/7頼W_PO(8>B7a2T"ˆƱ"sq(XdRҖIdǵdn"K"ǡi"5]endstream endobj 476 0 obj << /Filter /FlateDecode /Length 1693 >> stream xXKo7 OU%zm-==i&y4Ax,CR$?>}km~^no_rn7i7Ɩݏml G:luSߵ-QΆ6zۼRFȑ}3Jx[,pR8u3%uqX:G:Yvt0VEgGkL4@˳I!7.'烪 M!ȨO~ КQ]܉l$u5sf ʤCb8iQlZD0 '7I ''ۛ10Ą@='b[܃'m9Zu;AI-zRƠCFx5RrH)dx^>,$k3,g+?o-$Mf[ج3>^^Ԅ]d:_vsqyNH0DŀH gfRYATMP˙V*LQꌺ; OsȑxXۜXt1=:Ќ.O:@{&>hɟfyhT(#f9e &wiqFAcq:AmY8~m0G,fLtUYC2STkffhhDP$ (s+N90+p %.9F  5ƉNyDɡB{FI(!w㹤/o8ƻ9 kn9 ̉Oj8(F8]O72^Mlϙ`62yqvMh!t B~4v S i%M$i3 :(1%zO!1ZN{FI(`-K:s5g;W REMq:ԉSz=wڃyq^u|ŃUdXSߗXB8C0uY%۝3)$۝#+{rŒ]v~_$L"T6!w'--mt(#S*c-Njn?͘${D;Z,0AiHa)2^}_N)="f;ߺEC^O$\Lv-+Sd7VnYw?PM,x*GWyuGS],be W/^| y)8Ol\ ϓͽ.IR]_ulxbH@@oC9% Mj[.*W2}к#Hyneo K*{ma jF>q gF!ؐaqduY)xIp\&Ś^tVb)Q@,hy#AX ~$\AJѠ#1yWC[5Ty$~wщn졤En[-tyLqU3OG#Raj#n3vyOҡryU3>&EA%EJ"&99ern;> stream x[Yo~'#?I߇p#&aIZ$W"%Y΃{虮!X6Rz_^+9\>?RG4qcwsSq*oS}qumNZfv}2 8=;zޝny:rzLfkܽR+U𫨔K[eڜ+Vu5F+R >d{L 709A&ۘmt/ÜorَGZߧSJY׽٣t JnrsxkGn-2|rR93uHEowl=ȸ;Er"D|2qYȯ+y]J-*rq]%_t~ȄWO Y+LSp]ɡ>Ź Թg켑WNZl"osUfS<kg Z3ˀł q,'Cǯ5 {8-O~0nnϐHѬi >^kvL,"Q}#+j %q;%y'#iϼY ^s] # Jl0rĊ2%0@j5YE}qj`MW'8C QI z]Vx|CԳr;Bca/HOLREWT*]jɌ[U]Q=:ezw`(BL,fyĔ;Ȱg(5.4aLEaeB9L3h~)G@:I*ngDlI!ɋ =I*\G}YYzX'kjйߗQ"߳1kus5F*\$ @s(f[m{0'ٔ181p:E K"Bl֞ *46r%HXap $$@^77@ sa0-Go`頽m4=F3w`rt|jdCЂEƓY 3>-  oǮ4EG$s8"4J(k: K8ml!KHCql<| }Ǖ>I߾# tۚz_6M[_]ٻI wAcxTZ f+}pghcQV,\tr MN"譐ճe: ZzǬm#''kiyF5nėB `f|*͆y\fB$ VK^Gܳlkb3Ӂ+EITyp/Bh [aNhqDC5:|DGnb^rU?*LA[ ikO./$[}oJSo7"_Yj\pl|Dx_ *PFv*n;,>׭SjC"I ΙQUա L{Js1Mwx!ȁۆDhtP` B;/y .Z0U_O;WyK \ ^K}ryF3+[/UPSXv|`vٟs,w9r6 w 3Aƨ5 zy^گ2)p^rϙ2ؐmbœnEPH݋{.5I[R*Bo Q#rlkLt܃2mWH+lrDU(:R +rW}ʁUrzpDZ+S. @iA1-t77wq@4jk+MP]  { -sdؙwB.yPq={Y{$uTܒD8 qLs-rJ@&Fy$ZY";3b¨NoSa2cH3CzUĄe6dB1cW8kƧ]v i11;<ܓ̍ j FC یגuQ4>`cxZ+MA4%3ŦHgspxScѥJ ^.c7-' 'pw,]4gLocѮ"nlBcҜ(n5dֹLNbOGМ*_^Wz[-vkो mvX@o߭czjkEO:~pu %Zک0݆7d߬L ra,C5#>T>uM1`w'WN)!fo!ػewM $rI_]utgMwPAKktdgFjݛP}aS4Lk/YqaVO]x33g;o oES_vbVv&0ڙ= hczֻ/7>EF, jJX`lg}-+w$c^vSjG|\JZ ޏ)D|ži/9='Oendstream endobj 478 0 obj << /Filter /FlateDecode /Length 5484 >> stream x\Ysu~] (>ݛU)UCr첅UKe0.@ yoYzO"J氧~gC5C'{wurycuGCVY=w1y:FlկjP9kV;;eoGjJ6ljs> I-^}/`|^P+ƱJ$eVheCZpmaS`rʉR7r#_]&vm .fuV@!$L6CHt|zy}#C srn'r:>quM'6} IpsBTAt&kI<9/UH(<V8(er\;+IJ]q[r>cl =brūXYw)E˝ *uf'%Q!HRGxu")tL':\rnHY~W)E1H8]d {]eR=SZ|JNjJ-(+#Ư *m&!' h<ґ 5t L`.\ȶ$>)C&Ɯ/6֓HYzbGe/FZhzޣd#Ѥ /ʷV TSOAp:E8M4\ŀ7zY68& t&0jԇz+4EcF*2[vf<UX:#ݢz)uT1AŕRd0tD2,(8@q<;i+./c-Y~kH+ nDK49ZG$tsn/ m^ R ek3P2O4N Qh];z@ϰGi2|\&n2 cVBEQ[ =v_vH)Y2.'f_ؿY=gmf[츫5654ՠ]_տ_Y 6d^eT1v!)>5!expc%o[y&{^LSKOy6WƏڪaLV'z26Y݉ewkÑ@4'MA蚣'^.\CЋ:c3!:q̅~FhN;<&Thä -JphrԸ9̃S{:G7qLe2 ,GW+l`\NǓ-0)kм[5?' ht]KSnc'WOPx"iޑ*/#gҊY4CN nvQ1bY&ؕ$/25Rϸ  H)#qXf:!rP>25*!<34֒3V;1>= ^ŋ2p5WI@QL`S%0*1 ׎FĐ&TŒ^Ѯ_<7l@7uM}'Oꐄ=݀{AAڋ:oS^v{l 4MDP= mۻ= Nﺯra#fjcQto?ż2ʼn}5JE@ ຒZi5 ws;`';sh@+gt`łs~OP}J;-8' \8{qx <&rmkC~ |1540}HY):w8z4H]7K4*K@~,8M8ɿP AUyڋyId 9KP y'b!!F}hJƎrPé]="4w9}c}'+ĴB6m(r&}x!52|9`LpKbu}ˋemنl%J0Bk8pUqoA&jPvg L{ 4pjM耊0IgJ. /֒fQH{1+=1!%!D n*[ڢ! լRH~qxY?P SaCZBVCRʚޗz%J)dj6/S9x20䚕ٸ,&'C,EX@!6iӵ)iL9"s֐f K f. ao]YN-rfA|Q n0۫t~w|x\JV{1`e6]}zNA$l\5ǹDmZ{ˀ(z "k8(Yi,> V_\e oias5-PƓۺ I h Y z)%1Ŭ^e61fi>XbO6 95o鱱ݯv,k߃r`wiƦYak -s(%^x;R:{qlp:CrVVmui,&õ[ l֌6*y n8bX nZ :Oy,\َY&g yjmt 9ɀQƉА5y*J8A3ɲM53eƺ<56T1$dl|[c%mNV$磊E_mMMANyB"ny̎(t µ%1 2Ia ~y-j!i쬶$7z`ډmcX_'R]30euDx |æ =`1,^X_uOE03Zc{v $fpcb+-Ӄ )'JIZ {!^3ڏH-?TћB9B@mmcM@"eQ,3ӖKaW :&o3+[l92`A$/H-cq݊h5헍G"^3^ 6 QNZl^EFL'OG$cpTQ.l&re_@⼒8?I}Q(_D EeK)A4 S+bp2/̼.k7'%!A7U ADNAdI QZ!S`O@6ܨ2yIu\k)"Vm4~+>'-{>^}9f#'YJRģe Z`ο @4 Ȁp5Ŋƙ jw"Fd !abc^|rv|AL-Nƅ 70(Hp},v闒{,ƘG8fۊ+N]\ $@of/>,s @wͨ.(.!+/W|=]Uѻ G(s\v0$Gt:u rTbGGI.jI$2˜Xz#*}_zl_ sXE×ui ʧen: U'_:Wt> ա@3_u7.RSE5]eY$?tI-~ۅ[ɖHL~Ew\6ci _PƋ=Z|^ |ӥi]JuI@sɂI?fBOnwn%zK(TC[Zo7װv욙.ھJ$uҝ{ӝ h."9xU3t\M*x7z,:4#+<܋ ǔ s7[ƎNqPgS4䇇 lYQ)cH4vRs^n(cZDT,OKkmr*qJ*1g-ay)P}2Tn:e>1ZM{g'xI<*k$uxB,4q.36_"s[y(<ϡ ݴpA 1#LqD>r#ϫ=ïU_ +UiJ:m@OIrrus.PSW7wut'M D 'L/H͘ɚT|C{'i.WLiTpQY X$~եy)E0m><1aցu ɫz+k2ͷ/ Ri^7 G5&:9l7̨Cmf`getSrђx\Ig &qAӖY$<Ƶ6R-|M:/> ,N9Z[8eR-YOzM mtl赛:bƏhClșJ !5?u3y$ 'niΈDI )RC5.,t̒Rȱ-i;/fa$s˘\Ź4A+|Nxth,u}sr4~@rT(,z<\`17>/]JgNAu~hd9 * ")tw)Si,ZtNÅJ$W|Wuu(""1;xGtR?jl/R{B8 eSdvJq?]q )1-ό򿺯.Ϟu't> stream x[Kؓx:|? `#Z VIݑw- ʯW$YY)HUWnFtכ62mWv_E&O]~vg^+Kjf]l϶;lrZF0fS6?S Ei„Md Fu ںuUMO%v?L !`mЃoAVro >ziWib ͗goId.! eۍ: L#7ӈך8ۈ!C9@R8iMwhhc- 'L 7`4V LDʨZ;[4V FBQLN=%`#aZv.t :G"+nf &tTVq 5+=+yci'" tJ$a&uJ(Jix8?F!2~4[4Y$uNDژAL@|+&RR!v t$<8Z)`EFNDRAN:MDgUlI#5Q(WeN<+a~=H;Wx^QM\kGw[XG!NS%M9HI=L%wyGLábSK=KRa+O4;G 9ض& ӘFY)~$0i ;?Pn;x+t m@myo9y s RwdԷuJ$v*hO ˖X_}>.ЄqD# : !hڡƌbb0;ľx5YFҤE3VA!T 1z@B=ZCg U/^`SiI{*H,ք _ E ncAa98|iFuyK\xM?O[>C>5(|9ucH>m9dF<ldJA|&Ã\}?P ְ$g_QFf'p a u&F4 ),|c7%L aw儐jG[8evEdՈcrF@Ƃ5h"^alwR4,'5JU,lSg^oS4un<ǎpMǹ~ta:E/U/,5C eiٍb 7d;@x-R WPyQ~c,8D;c,>Ld._'icpHxFKnwi/=י'XHAC=^IZjDu8m:M|!`^T5$jN+*r@oiw-%EJG2&9 ^=d6Ky6+ b\^#?c~܄鄵eXRffBG Z1J1#@3+["ӦqAŲCj>gM-vE^NX wˍ1)%Rϟ,6T?B"7 AHWm/jō%짣r+.}V[pr^Rˡ tqLn㬊'vvrb99 BzndA%ɇgSKV?QJjP9+( Y!Zش2ۄ}2 ,_q"4W^oǹ*5~ߧh̯qX6HJ.ɨV3\emGq)kZ fQRŤw&6p=gWJ=dvH*Kls]j#"ץsZ Q&%̍-x0ڇo4225,@TW7!3GJ ^m.-epھ'Nt횀HR/ (V&)vBѳ̼g9)jnGhvS4\.Esؚ Q9=Vm Q@3ЩkNli2wRt6%5K f^bS3p8$VXuYpgU(2&eh2lS>%9][vQnLM]Y>.X'_"c㧴Z,uq^7~P zŀ=f!gO8LF|թN`N#/e.rA:K 㡞ڔFr6p,9y=k= ]Y!H 9nH3Kce|D O+}(: I?Ω E\$1K'U3h%L+9 \[FKl3[ Rp#咙#{KFí1uX1Cq.28pzu~%Q հ,́E홀fVs95lQY=vJ+u&M71lK}z)Lz Ey𷒣6rL^kbfIcpN;E 's_K<"*YڇE z9Zib4XԵղTq\%}ԣ'ם %f·2ax"TEHWjOvmSe`S/uݎ ɟR͗p#wa$1>%1;@ôZ{R4h#a)kh(+njPFQfj? R+㤂KXj[uPJM;Q^&1*j0'Ȧq5Fmeq|amݰd@+G]Y]ۏf+gEXx-Xi3qv&n>To-xB PbP[U sO$Kzb;ve.L5z!'jxHz<+ >5Xwb" V{O<(Rxkff~6%~E1t__M2&@/"@n7@&Fn6ELsZE1.L}cV^mB7 25/˒( nendstream endobj 480 0 obj << /Filter /FlateDecode /Length 2565 >> stream xYKo4 d;].98B2 &)RΒUwLr_Fz|UViyqDž.(kWv /+5SwaQR>*;]?CgҁU2 ;/ ƙ)fM&p\Yk k?ᓴ:+jR796UA74mH(6*a2Ye-C9Ĩ9AԱh獜g9pnW6J+cݢ8a ȅ.mc@Ik@|\I(Jp!BHwRRu򇶈DT Jwa;s=8eY#DN\2y6 BdbTux@((0mB\"Ҵ_V-"` !FEc; ;HeSVo/t0ڑ"X!rZBEt49qhffob_R -VQdDpJMHW(1ǏN"$e8Zf(E`%씑d}+Bo+VM RɉS:||Y 0҉777Y@V)Z}jԾ6 [7WK M6v#kMKK& |LA0XTt+$cY9_1Y#Sӽ m=d' xB'c'(:.h!c}ۚ -17d<Czϲ9k:AT Bɍt++=n/1q" l-lf&!*#?Pi|:V{%/_PPÒ)dIaw 4x(~{4E0d§6p :%|77GV5%it}&v agׯQ.&嗙?F Zqdy#V=# s%aRf[kwؖەf>R,ds^6֮&{~o0pߦlY:+9 {4DY8[I]sύuön7p!nr$|=# MCK }BNbvɚt  |yB+SsKG.N.wY7b9˄*nO1dq/QF/I N//(EWc%-׽.1 HOy-- [[V#l׵a}y=o! s U֍zRmLeL)v8ӗű)I[n}ڎ:#Ywf]Cىnq{,CɰPkMTk*7 Bs8Fd8{4'=H L^:*s6ʌPe'J B!C1I%tQ0Фi6 1JOa *.2j| Ms`5dLvR%9( $&4@iRJ*pJé'pjKA8sNHΟ(x"L8PL#JS%W Pp+'y!ӓ D,ћ?/Cr&mS0mVc"=r$nmXKiӱhh"r)?lyTU g7Oz){QSv='8rdFt_“p4ٴ!_T:Opfxk4  sǂYԉƸzp}M׏20iAm^;n lUsaHÊO!fǺ > stream x[Yo~'#zl}pE ŀ-&/,Ԋ6ɥyHVgzGdI*7{㫫B7q9O2uQ\,z30GAV.nËg7KыVh#Tz„Fu0Qn}\i e{SP:ecw  ^3څ1h<fͧlp+v<tz\Zz՝rY]0ÓNESMZ#jҶg#$F`TΉ\yɕUu9&($&hN MdiM8%y+{ Bz9cb%4}&8|rpj wDW9_OmhNHR˕F x <#:K"Ϛ' hiyv@Iv*m/Y \6r`_WD>k":6?O|g9Fnn-XWcbM55'0.g;LD.4O`$3 M}"q_|_J?Z9'Uada* `d-'8ݷ;B@,BE||1޻V$G~5lT0D9$0Bؘp;oWx%(,q1hKd卪] ڈա.ivg-_-wlE'p:J@ L>ȁ3Kg/㳊Q9LÈiJGVt}RAzD)@YU6!DI+u*:$\ Cd^e%%#&1X(W{x/P΋tZP4$vIpu@OG5DS#~x"fZAǹ2֖-΂êӼ"!n︜C}K ~ [K/%bF0Һd{Pμ}=&@VQipd /2G;HBBY:r2A0SFzߕ@ɘu] gOʰMJBO6K-L7Hj-89> (=W lm)a!06yAܐєqv[.wǣB C:n`gmQY-A$G\ڷ!CXOߞޗ_TXɅQb2$ [7&Ȏi"U%CcUa3 a<aXv 1p_lFՈQE53cܱ̏|A8黲K;";a8B҄GGm-xٌMj7bl˶N&2*z2o[i€aÃ${mͪaj04zI?<#JG,{f/sH{LeDƚ7D㫍/'D ]i.q%ɋe3s2jhFgXŻ(ۼ/WP# `B^*wLOӄ/UMnٺ)& |BS"7̾51<P;V}q/> 7d8状 `LE;@,4rz/$ǿ_&H6-{hRuD9˦&b?kdǏq-!ow9k6T=79eK{syݨT|bKc i]ZE;1FmnJq2KXRLw %js )@mfHzRc*2p26Z֙B bHZu@sU뺲VŋWePj.c*JūYc/o3->nwyvuѱd]̭7VY.eia8)$6]>WT.;+uQ%ܤ'=fj Z|,TfP^tO\t"E}J.nV Q8}w;jf#͸CpeR٫#3!^IM+Sk}{VF.te\ *`# X&p77fjE(n#+uqxYUgaWweBui|ZEpCJYm('7S!AJٷ8`*M]y)X MWSh QA8JpoocL{˚S6emm+(5u2"DxylVy`Y(-qnұz <`A/lS5P(jHe6iݶ|*d2e:2DWD["ψYeYP0Cld%36`DCfn Ž+rwFwdCg\Q”=TJYoҏSR cCWCmMUV`KXrrL$KߵB(7/嘴0KڏYp> stream x<ێ\qN'_ $zlf)0z.ѦgZ;=ߞ"Yd33#a,ժS,^E\ __^>zJ߮.n׿>)#4F*}+JQK֏QEtJFV^;UUvVk5)\ 9S6Bxи J pD:mݐ@hr@ꦖo ]aנ v.jpUCVpF 0r5H9a5Fڎ9H` kF"H?i1D;ABvllU:q$FpC<=YJY.,=Jov!5*afH4hv=) z6[i 7Uv/ZH/d^t9tg 8'a~}?+ px#i |Lhii(eW cHZBwtracZau4^O%dED6 ~I;Ə{ySDǠs ٱzYb-a G4AC[ˁ9wPsX9E/μaߑ Vk8Z6& VNxjȉ=nun{k.q_JAZʪN_r&XPmcةvwg3v4OTG?##ܢ&sLgf7[4\~Q5)ٛl _\~L0u7ɨCe)!dCbKnbM I1BHGI 7I xPl5#qmF'm^K5kp'퀀o$H?~#w5ٞeΜ yɡ}ċd/ݶQ3 iu>4BOe-4Pt bϛ΂`M~Y0L @u̖ t mWtcsIu;xW%pP b&hv)fk-FUFS8G1cVY$!K.QKn] ٥h\@T{>U;"bi@,#JYO%B4eGx P%l5⯪g&^ZU7y2Fђj?0,?&.N"&D8vqY˸3(vp ;2()cgVM:H>)M3lfH wZS賜h YcҌ$O ׍j tD\NgA-evW'5Ju+/_>!XȄv^~ơ;AכxxSZ䒪!WIRBX]NH4ɞ'$a$dżsX!rv{{vŖW=l'0oԈꢑ.~j㧩Z S @b+n7L9ǁ IrWo.)֛\]3 x[B> :AtiKyXhԋj&Y(P{v75zܠ_IW?r|o(95K9%9D; R,UK"h뾘8mhXP|w*~׊T3ЁC~5j7HLV8W9H&UF.p4ǡ)]C~qܿm5`VuyV˯Gv˺0K='8 ÿ/0QF˫k]2د+c]]m]>_1duˠY];~db:W/L06_uM]aV`VMIۺb;e9/뒝.*K|R@T^ uNNL6~]T~CZ$<8?9WIl_R$?-j}|./V~/nV^߭(Ntڀk)E`__ެAHsߟDRխ0G0*aAʹΈbvHx0-&mA"F{F$Lœ*0hlgJYF(X'߮(#@/![U=e7Aƈ j> 4D5GDHy>`RA~b C@"QH4"X (^$vTi0`蠆 eԇOΈaxf\g8 8̌A$/<$AO1LVd ô ScE og! \_~*/$ 1IM8kPjeiKa)Exy Bk$Vzw#R1 ,e6 7ցxȝOٺŀҏ-w+KH rYD1u k|oo/⩅|HjR;FLȨ=8>F"TA_/A( zH!DAp'W58o mnP<bH( J8/]>11 x6<8^ͩ\~!Jtg ~WX j#H쥝V0kdo@SFi]OXms)iw 9k`dG ,mDjBTEX5*+N=4~i6v6j`鎵.+{wש>X [׵!J)HtiHM$q3$B[{wXW3Am$oANOrGX3u$ԣ'Z׬LH[{,RZ"hyT&PKcZc CY|WSȃ[-FisW=&ԦAZݗim)Jk3k@DA#|իo~& iןC~X|T9';yme{?-HjW5#SᕉɇY1B?ox6j+E=͓ƃޝ% l>0,Q`ϻ樎N{ݴnmu|\lMq' r2@r1 lv c@JKԘ[8C2`MZEκȩuv0Ziuwףi,򰫫}(ݜଣvrU{O2?T#dȖBBQy{yI2n1i)na]RM\BvP6dXuLLG.jmd"n,Y(ƓA^huw[E4S+YNҖcBi"~%9?;M.#u#[;fx{2| uY.2aYy MyBy!'tsjD$Azφ.!f2Z`SyXF.h_U\u׌n˄UN+f/8C[6gu—H؜73哇#M>}q*>duAGgNE.-X p!g>Ʌf}kJB<^BnC 麦KeMʗu:, I(sS ~jWg >G(m4qD|>`&Ƴ(xdC?;h,{ YUu :%؅6mJ5>t0h ’b>. WRzF_sMљE#]f~VӁp.8'E?)DP#Xu*h?%Ly Îf/7siVy~/E ć9/M֗pHYIM~F@8tn(=EL~Tr!}/-/x!B4ڕhϱ6[Ka8k.k*0?m:"FOs?|Lg}8}>TW鞫+J7#]f>\,kLSF䬳 -/Rn^iˬd2չقY/gܠ$A鼧O'Ү.e36;4 ç})xʶ8CQ<,It|zkaODym)['n*ڞ&HdS)A﫥x,&`> `pK qJuH'gp%f /N씆ծ.]]P ZPѕ.od{[.glڔ BސB¾P mMп6H)BH ,>5}k:.HF\@o=yyQ7W8OK,/!l#7d7g7ސ !wa ,p(aW6qlEy_]rmXx^Ȏ$SdxvHo#QVYc;bMC7QJLj)6LI7SKF+9KRTI$9a?n鰋#.u w:(ARtGD NE25'm2-sJGK AY&iP~NY࿓-GMj;G`JhrʳDĜendstream endobj 483 0 obj << /Filter /FlateDecode /Length 5053 >> stream xf%=Nw1>k/v@ H;w3;>&۰{ˍA3Px`^Ļ^ڐW6UCUf\ԣ:qvRe  `A>icdY`yM.@**s$osfؑ!-} 3Ti]+V#Q c"i*y(ӱ.7@ʫVq+a pR ̞@ S҈DmEIJ{~ӪrH3%dܦ<00|-ntҮ\7A(*tfnA*@+, #Zm>(3:wKU'F+vN!Ӡ/hSÛܟ&rD|ƣ" fNI:J܉"Hl- j"\2 @R0=P+^(#Du&'8ҹh% t[f#((+=[ٸ'{P)MDn*Pj=P:UQgPMCM ;9Tv@jKdT3 ,$Φ@37$vkH]1mfGkYGieui ~×!Hƴclh* ͈2Zd#%1 f́Ak8%SAd#$ȤYh4>g,(nqvL+ʤM#/ؑ%꒲VPy>{T#tHBB.?tdCt "u"L"BU}pZIۈuM=U1~E-=9ПnwHp?Cei ɒ%U!YIqba~_b`q~*"j1tYC ?աƛÄq5Z(o?mJ˚mWR6qMU?c¡70.xmsN.;C37daDk8z~J@];K12AGT5`ƽ\I2Tk]:WxYeM?_^a as͠"{w"r)mERMw4WT_p#Q ͳCI:> .]2ݽC*B+rGCh۵.?k/]zw5W|Ĺt9ku92<ט%}o&]@2;59E:!*j +1-a(E7m/q]P}!I4G0XgW,Aq}qC1ۼCg8)ta]fuol52M0J5o;Au4~]Wu*/Er:$πOTڹ :|4_PTW$EV$,Lc 4y!4Iuy"9.lHT::᫔~%Z'L59^m@Hŷu< K.&i/lXIY8L~dqI ~Wk¬VJk7*[% !%Ϫ_ޭ{}\%ޭ/}p|#WC6o뗇z$ m5]_ֿ[^wAHBVdAyȍjIuJNrdoWU0 Hepy9 H UF p8] В ɱR*U [fIdn$ 2щjH3enSll.`V#Qd~W@?>w\xc;C-Mb`_< |t|} ~xm!,hz3UX>e/7[dm|'CαLq{e2A-.-/Dw/9a=%S ;KZcWK#Mskeqr<˓]Ր48J8#XjMb' -u.=wXIWƴ京ѕGR\6-; a!#B)Bg'8k[>$"!qQ(kwՖy,a^Jesz7~oبs#6K_SAMZhDk##ȱXIۗP|}Rw0U}UssmJ[KϽۧ۴Aٕ=N:jzMMG]I"J}$ZS?*vAJ %% Jge"n+c&Da2X/nhMTP~cЊrӾ;[Gc*~n1Re!02dֶ.Éݐ]*t"q?\ό8 ~YN:}>晳Eg_ԉNab,-œ`j֘Z;w莎~H:;Z`9]3F5 4mC?>99?ĠCNN.n%n:%[3`k{n!(|C j^4}0q-Tabz&,DE5TˆjҜ6`6MOvϔc1;)Li @!ЃgLl"DKqDڙVl5ghmcC5heb!s/"K(%ӌc)alnG ɫh{Y4m۞j rT+GbbcV`pum.]b<#BXƠ^0ޘ[*osGvZ}.Va=s= 8SM;VZ6+ze3&ewHopendstream endobj 484 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 488 >> stream xcd`ab`dddwu041~H3a!-C5eُBMkW 022时LZ_PYQ`hii`d``ZXX('gT*hdX뗗%i(gd(((%*@ܧs JKR|SR SJKR2 r+KsAA L ] ̌,/tɰz +Au,,r((zd򿎰Y㻄Aš%Wz;[B.G)L ˼e~'ddXMz$q7 'y_a-bKQVt͞[֦Y;{4{dwow_?i?%~`.vJGU"T[kű7@J:Z:+~,!g֟ύm] Sg]9}.n9.|͓xxKendstream endobj 485 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 357 >> stream xJQd KR!)#"W3g T`h#H j- fq?oC`#Hm_@}բY3d#be eE[v2l pSF7F8E{<)6,0ϒqPRHe1)#GHa;*JAQ)K8t%,4jvWLfO 3,Gendstream endobj 486 0 obj << /Filter /FlateDecode /Length 2394 >> stream xYoX*=yE!)$v%ˑܹ;C.GU4iQPp7_\C%k$k7oߚXGZ> Z5)ΰ4RG^RT:j[M7#xzl.FthMd>qoRic2CINd36IHC}Je3#BpɫjC2C$I3YɛQlÃǘa#i9jUl~4rJ+Q* X**%*\MN+`QX)M~HX $R nl" Ԕ+*kvo~|_[,W #6 W)Ô 1"˩횒dᄉ[q۫%)A~|bTW(MLܔ怬(DB[i*` 8y#\r* \bYަ Y=̉ǬJU *eɌb6ie.eOyx@Vyke,>+Vfj|"ѱfiD:g}BX=Wݼ.ٍEOk`^zll41 |3'EPt66mm1 L=Ĝ3*2X6X鲉Fg }*pY)l^CKW-Mנ<^hX<2p+󩢙O^AJA:Σd:YlXHpQmS xS (psgfnɸ>fk >EYN/ a5&ׁwXP*CGyI.:8%\>4#kV3I_?OG?WvcjH&Hi~@g0 |GGz#[aR$b$9si(EIE1t0FZ36Ӡgd1Enץtm>ad^j69@SE*o^ Ǥٹd._){8?YkDɈ]XBxkI,<*᠓id@,yuuP + jY@_`,PAa϶淅f 7l0ȇ\ }0s@ynB{Jw.Nu!^7t@(\2{]FI]9~UF/(;V>4%sl%5 9f{dQ)x^~~k n|]_󐰃=dwx~f˘w| ?ln,)ieTWš>OLӧA߭9}) zi8'ݪ@v`t,ǟ/R6vhjiu78WH܌~Gw{TPnbO7;onwh„fD +W[z7=ѱN: +r_$M@OǥWJ4O5A @?7C?%X솼Wgcggٺ[X%]cnK,%HǟhcQ;kz/-cl'ڻwS%3`>#Ox$xkzcL~s4=+ޣw~eo/ 7cY7Iendstream endobj 487 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3079 >> stream xW{p]!,㘄d{-u@pJ!Ҥ@b`!$˒-˒-$[O?eٲeƀMq$M$!$66L2'ҙ~dn_Vw~ff=sRwjץ bfJSWAfw,hj)}B@2 $GxJu}*yʕY VHgLNR G~.qXYlCR)_bEII򬂢2Kʜ"XEvR-@]tA>`-"Mvt`3*Hډ> % ؊ 0|Ir73O~OgXb;(ǂnZiV*_ Hn ȍ;yAyùm4(P|T}|;pl2'+VUlG:5[ tb6ͺ cfI7~' xW{D-FKif*K4wuG̱M sQb?FMf1z@ENJUPsxPWhZ|~-ib09I{M^l2k(˷/xb.)HI,t.ec+ MqʇBT(W(_PЬZZPƺ`[M!4;yNCc=Ô8ʣeQZpp8&&r\ȆcN4_ G %֒xf 7.Aou5~üIy或Sڴ ;B}0^p&LqV`M֟Mfvl$0+yoD G_{mC p:2}(6b _"_l)(fhr8{ϯS+Xv6*n?'T~RCmY:UMAo"?;e+6UWÛjڧ/5Nc\?ZpB%YW+:c %$D! ]o9|j D_)0>vj+ioGoY) LL&WM vҁS=0hMڕf9u Hҽ.@ԱRBd]',g/3^0Fqšc߃[@R]vJ "LRסؒiMo*ˋ5mŠnd?I~ tw.x<| !IR( 4|!%kzeB'(o :2n{~{g;P\}?ӊU1]c^ی|Bt}JH52 ߀`z( ʁ%3?L᪝¯j1h`xn[\~;SBTz_<{@$7QB P_˧RІ4Su`2j=TJII_H߉ŃȆd`5zn|W=t@Ԫ ֬\3i=l šM۝s;n]ocbeX&0mڬZ[_]]&N h6,ӵ1z6w@ϗw*du'䡝~TﻈޙFYV2/ pIzo?Zgq#&zGdH~N 1bo!ȴ0kkK+d$q~ӎVUʷFE=[:$ xyy5O>"#Bj9*ʹGHerLjhDwi,>!:5i> stream xCCMSSI12%a_  0ja[pwCopyright (c) 1997, 2009 American Mathematical Society (), with Reserved Font Name CMSSI12.CMSSI12Computer ModernpragQSBHfV7N7tkʋ9d?XLyeTAʳVC +'2ww{12ZF:F,U6ȟh)+[g+DXvubJҋi`xWs|/8狺fi[nY{cSuYed5}a(iұKZfVDowlh&-))gozzjbVmyKitUjNT $b6xo}|{cboƱץNLd>@P}^W8f9=UvPXa  7 Ï K0endstream endobj 489 0 obj << /Filter /FlateDecode /Length 5774 >> stream x\[o\Gr~OD36 $@d$F@1")J6ᒢmm9]gD‹KuuW3/>߇rv̜]?3K=\=?)ūg=sMgSvdzo}ݹٙw#q[ ys ˛{nw6X6i ƶɓm@YS<ؾdӆ@e ѥMD8M0k]ec+NnsՆËrR@6.gJ;mCg[w9%]Y,a9wo~9}W@mW !gqO</p #+9m^=^{ o6~w:|λ&IܷL%npձ t'5LX{/EksIkJ.r l\*rIJ6Swr`<6ouh3c^~e8<{ @@ncK?\*j+ܞ%KK}w%1[<0C|Nwo^^Lȅ_:)c Eۥ؎8Zޗ]roכ/Rr:UBsԟo ^OX\>%{f.&7S!dA賒vi0Ng n&wp6e.#/d^o\f8 B} 5/[Mk޶uk5_!mm}4/sfIVoZКͦ?S%5y?p7|3j8ð2o[ӴωuI!C0T;6C [КrӚ/SjКbįoR5g% Nz=LLZK==ftgz@L%U. < `*chIq%´-B U 2޿i{MVK`y͛փ,@u~Ze4L”fFUlVzN Ӭ21t~5+HBU#Ǜ~)|CKrSw"thpi=T^m2Z5|#0Gx5+̕R _vFB%Qɬniy"o@S=MBِ9W= ۅ,MbuҬc@y_-pnʭMiVGmBV? v}1^㰇BB jݵ_ӚJ[hdךpzAj"g|DEj QT\9y0+iB'XM̟Sŵ9(T ! #L^J!&HzpJp0 jVbJR$ /v$Q6Zl`Z񂍝Sv Ѷ_UhM XϬrpz9`U;Lwe*j(v0^-SYȰB''e0. Ho j;MT F;Yb'>$'<+&) $(Cdpg7 kb,+F?6I{-X'^($2ǩzxܫcs FBՀe'>vjVۺ+P h ef2i ҄T5ߴmk^ko[Uk>G2'`4ͫt/Hx-VtQZ(mm orJpy?;N dh:*.vЁV :vƲa SKC`mʿ.AyxQ9`'3M}asi\_Vm LhM2[v(5 g0wiakC%^V leǁ8Ѧr|BTU]"g^C@vDKGEOX3asA'@)[ݼHZI,EtIڶ uW,@@, PQ%@#:>_U6 2[OǁbyYHq"ҡD*o))>(O>͞# 51,|6aL[llK } Bࡶ;&w"i#Lu+Saˑ#LgrEE^SOȍF;MRa 6'PY1s?BKڳ I>(]};VG4vmݢs`~߶t>YoZF6G^Wvq y55'eՇR#dU%tU;y(߷yך7yhM1B8AaO^I'A^ ([@;ʕ}JzamVo ɉLo(/Xs"E/z<3gw*7yPsx @RV c wmRf6K}Y9h9/,z?6H*V-~PvͿ&=6 L Y."|֙ɈZZ6k%=kF%edJs`D %!:mOUiUaNVa̵LsOt =30C_y=wFT8g92V|Zj!B Z@FfUy"G)&%fV& ;i :`@Y2 ?p" >"|ICNLᓄLWfBk.'a{z~EL"Dh4"Re[i-">- U~xB'W|r3r)%*W4JkήK;,Gy;`%}jR^9ڇ!5YS ; /ϗKqWփ龦ZP.:ovU#$AfhJ4JđMdE~Q{BrcN&az`/ hS7{U-՚2e{qP"%IџYšL.ZN}9:2+5cqL૟i()c/U#5yԚaqx5rr">='K\E ZD_WY5lZ66+rM< %q!"5eRID0H} Q~6NQR5z]n( $~?_xHZ}ݚ5s`{Qb ^H*VL ڌ>eGSo.*!O梪`ixLfj }sw1:1ovmJy0S3Pɱu(: 8TSY6;r࿢,Uv8; /w|މW:FX2_ 8VI}_P*Z(WٽTJ_]aÖ&Hz[D'=lVNU94*Hfޙ [@Nɭ;rމ R&7bjz Rq5^ v2[Ig6J*\CJ6<:O>=@IW1gǗinc 6e4w-ǑU<\|"$Ē$T:)m)Q6qB8 0QVB\5<ƠPNb!o@`qFDͦ8 #\QD۠fcZqhG'T\k򆉸%YRg DH }9X|>LU;:oa.|#K$&=ݥ=`|&Ffˋ:ֵƹV2}`O**ϨHx8uruƯϢV S1S5և;wвl_*V;=p Z<௾ٺ9 zNP9%_{,F$KR|[Њm8Lkimq6BzL#:uq2UՄ'3> stream xZ]o}y+0N Z"y0 XYJ묬ɯΐ#p*F C%yyg\vnV}cbwuꗕLv׻KEU?TvAvzv7+zR ET-ۭ7lV % 8å. ZF: O7慢ibAT` kt9lg@f7S1۪#X)*.bpNEX78IYl#ޡСx$z Civ>e-;mDBJ-%u/KҙX>j= ~cd/OǵD hIbŻJu H]qiT; ' m- ޡ-֛!c`ߜCNRIU_KrīTE^ (ACz@E֡wG4hS(\CIEyeKn K$PJ$9f}gaP}"%uzPOEDyV҈'K^$.yp98Xj8)TeP2AeTl2*TL,ϐoq,C5(\5t `TwÛrx]*MYZyS4r45 1xbwyѲӭ/ -ɌWlޗ7E /d^% !x]OUy!CNƻx[tva4;Ib/RroFjnMuy`@ӨNNr¥C8E~Ag5EdՇ9$i2uqR!& ŖS c=uNV|`,Lw-arֲ_UW#;\Kbp|ʗ,֭.c"b/j՗HS =aujAJ=RDOɬCޕ /9P b=6&r$ᕈ> stream x][uγ1KvV$qdX 8h̎MIk- xlze =*Xwn]Ls1'?O'{b/_W//)0&ãCx~\X1Cv'_~S[h&h_N8M>K>۴;/d5aE3ېwoi)NS6MvLnN¼.;Jt C no6W}!M&qL:=PlsIOl?'ޛKiW/>Q4w_/9YXt)XvG97W{ޔۈ30˴Տ_¢i4ˬa5|R=X;>߾DD]JhNe=߻7 1n ?u=98wxTƐ]`˒%e˦|xWǑHCM)-fΫ͂ &⼛ڛ=R`cJ7m1)ۺmH8{)kw]3y#{ѨcEV]3vipr儿!^ǰ W}G<` ya}LohWrB1Ijofyv_ 0' &G>x瀽A*㕬2#w,sH).ڼ׵y|^WyWK{AuЋ$E7%ԫQLdegdu!'$߲<Sj[p= CeGAO%x2TAQ%n@HC쎷r-&f>0% ֐N'<b.:E^tyy#|CdbBNsp4{;QkD$z'rWAXIE284NU l%s&oY)O HDOՌ\x~$ &|@oB.l tm=ǕF(t່,2o샃2$4)'En^dN۽4}B0B|&+׌̊h}r`MV?w:[߇= ;w9:"N@Jf"U΁\!%UXw C|>#ݭ#JX{OPVinS9<h9$K քd`܄=wU/ ^levq$T2!@@`dxFwZ6idl,ꖚڼy_`jnntw:9eU-b@K8 ŔͷR2F&:5H9wUy@mЇx$d3!Rsd=HQYPfG|%1:05AKI:󓵳{{(##ZJª eJ~(V."?1pkռ)@W^R|FM1xANtDӢAdK"p"G YI.w<].YV] 4C^VjJis6z^]HaOCtl)gPTB03RuHv>'ǏGGVdH ڕ zLWs6Fj,T\U4INYBB/* KKp<=}υlhaVLK,Vn![abRriҔQVʽ]I B^S{lOH_YIz%şs,!A'6ћumt5(/"lG^7R1͗қTl4 `vP]^#e&G]Jל(1M` i VrB1lj (!LeFCIx!nxD$bPiE8([GvڗP&lo# q\!Z9.D{Qaޏ &\>oSjY(P2I/vf{=Yc @[c? OR{ wypE{Ϗdw׃0.Nbs[ _6Mm~Vڼ>}uZ].Ӓ_uXB 4nL\E?9͊]^eg/u}/pGx=h"H%$E2cLi(~wR~+"StUjΘ60'0!Os>J[B|]7^>-ͻO/ӗ;my7`(}V"*"2Em!DWs?݁?Sw,ۓv>6;{WӿWgnCw_fj?{I%qʯӟ֍xK~=~L6ErxM2 -P8khc"jt<7 Q#)(>iϊK,Aҩy!#EA_e4Xs[q|[AMGxuXI^wn熉NN`9X R&yTOEQ*8]>:1cO +@nr9gW] _!1i@!0oh"3k@ܳMqYsy肑=^3߫}Y)m9sY2:-(nIˎs9dzD13'9CȴC\ EFnd_Ml:8˅O+lI Vdyv _ yL6=XB= HH2Ni)ӝlVC: ӵ_Tpr8ȜQ1K8g)Pu=XL ?Y1 ܣN*^e8[ABPuqm ?I^ږl8!.9y.XEEdPVuW%FxLLPkN]8䝜{o~gSђͩV^|B3, 8|=2'e=߫ΡeNw6w],6=P&kD>rZϋ 4ztT;IO~Hv; PԦ}_qDd3y.lFQY#oxǒzeCϸ)5D?1@WZ™/K,ϸŚXKJ)\:X^B}\& UW!A۸ycg1b1 JLŗ9ǙÚtFgs1dGLj!Le>s;eؗIVC,YV٨Т$ =D8/lgsT貞C$qT|pR-' k$Y^dk O'Np " eW ,°_ցPPC[/M)x0ޒ - )/9kw_Uyoќ{ے"nob)]Q?sRњۮg.㾙cU7BDM@Al/+U$6 6ytxVd*'#"OVtɳm'sdU )Y&s5W9ykS4575ۣ|M g)K4&UvP֘l 2$S(kG$`Qg, Ub]Dm-3!- l\\Wux`~F3GImcFJ򚇋 I Sh]hJ\yQS1Ӝ]b*pe8O9]FQέ&2#I毂ϊU:n]Wyj9Z L,)CV2ڴ 5JkR |X]sm̵$sG8 GǓF $~,܍xyTSSJɏ{RGSE,HɮL)D'^`8z9|p>-32Z}Dm-^# f/1DL*qAd)K6a,i4Lѓ^rY'A*h9 #Nc,N'Hkg`woRk҉|mlSJ`Vr<ϵ}s5l?eŃ׭h))}H`0+Qp %1K5\D*иt֑9W"Wf+t@U\V  adyLO|nM!nYqCҗAl[{Ƶqe6FjLlr\ј? A̟rE #ʒC;v27w2#, ~2qz@~BF7Ƭ=qG^.;+zrGǒ3|(eߡ#m$.pū >3bRI=I)6%S :>jAM.C8-T^[NGp{>_h[ ]u ^:JȆqtyu{%yLJ9l@ކ5T}3m|x{i_GN0(q Ͼ\-8Lip9Y֟C+V) )z:Ju}Lw sox ]T'x*]xUUk1źk!ѱϚ~_F\x`C Qu?HV DYA+yeKf!]\s:J={}>FƬ@?ɡT.nlr*Q*3ej@ssp t~m0} ur\ f^E:Qѻ 8fB*d2S{%``'?EKg $o&> i+?Q\6ekE4rv# )}q{SoH"˟/^ ט(;]-oe.yb0m/]Tf713ۚhifF 3 TK1+\ދ:2nc%wHC_%œ A9؃O5R O"endstream endobj 492 0 obj << /Filter /FlateDecode /Length 8061 >> stream x]o$qgȿEx7֎Q1 ԑǓȻz{g6$ gkjQ_UT Ӆ]|!]ϋ׻ϮB(]HʝRqSvwob)wpm px8 a` Qk5)x''Nٸ R/E*څ1h($/I}/ x=(o zA)׏.jYHE5``n.*':#wGm}*=Ag1:c ]ALwz]|/zmm:؆^fvtce4a/á7 Z )ꟿ)Iq jC0 k@UKMhѤH4)k>ģq_ryL{\ԡՄUW@o`(1Л7II*$FQ+1Awam+z(Pd|wd'׭ |L-rhf2^ntƈOp7wsrU4MDqjȈ-Cz_G:u&=Z%ݼS11S1v"ROքD7')nbYtо,Ia g#% o8k[9e̗ C}]21Г. PdɁ4%O#?!az%wq}3WHNN3;>q::;i9ï(藯==}3oP_xzOI 7U *EAj _ `AU׏OϰVxۛwO~~!aD|sB0^B v6@(=Ja*D Yh,"SU*bN=V  G1S=T @4 RY vC@=2tYąh7,xFz0 +qg`g{h2Pڌ8"GNX N^bP߇,j H ʊi-!29 ĝ=oX[<<{ap. k)\bcy<y99?{թTJ6ᵴHIvWÔY8{1xkr+T+cIڒ= {,=Pz8|1DyϞF=tgx_YNȩ@=Q}f$LcEm,J$J1q@,=_yi" XQ/#|i-sRUwfqX_`V W" o,|eP ׹vu8N-y0CРHӠLkzĸ2Zg8 K-lZ*r}8qayQ5%c7sq7E_ImK,K졝Luktx Drg(_tbVh|*VHDH P$ِsl&6$QcXHĊ46$*9ߙ$ِ I!I I+z@O6-RK+ F [a$U ܎~e۷l\%QAܣ|ŵDΙ9ѥܼ0oNjI~=1-_QաTYdu`aQHV/|NL,F*ZjT5'#T,`>uKVy@њo4l*Ty0ؿH #k)0wm):4ksݢRx@'8oXoY*%@0iܺ߱^.&9- 72ʦ5ĦkT x ްT0jQn.(I%?n*<yB@ ,zhLBsp]{7(,r7Tw'O 1xJQ}Ѡf#Ħ>?(;MqhǦ􎸨{8;{T# \*쯩xu>*j3>DoS@x1U6/C4usbWw;*X687TfR^ 6qamI^[׀jn?ILBaZ{Y8wU5Vq~:Fj;V󲍧Zk5F7zzm,inR0 E.W̕+~Tiա6m`K﬇cR,V|NfF*\yN(GEe[2Y:/n( ͺq$#Shrf6-' éMh:7(vsc2ʜf}̳:7XEiuHsNz*_:`ɾy"bn ka[|:4rH}zga}bhK2en|Sf'$/gM1PGS.wLxRmcCĨ&1ʣ)Mp`ŕ ;QYmA`ogo\ P+q +"Vz\zu1襎`B[6Ivh wڗ`PaL-`3 DfX^{^qxF~Q{wYp3~(mz9`)D''4±8yWK66b6#U=;lOx"]wQM"+Au^k#*5#;`m8=@,+7z,!bi V|IڙW[F@ ͛0Q2,be2VS|%X] $R#\ 䦗x:gCR@a̙В%-3 i+Vd(9'*/{t D۞$ 2MKDV'3z 3SS<#K` W}Y_`|%&0dnB73+a~5aKS bA0:PMwm@7ОLE7/3]V;!vzi7Xޮ!)M nVSR؋- ௸ҕAHԄ$*σ|jVC{Ĥ9ah8bW;_\`hflq, x :z1N)`0mZ&[?oT~ɛvPGl h n9&9"TQ4fcj6{5Ԕ8^x;rG!5CAF)w歙_2w#Z.6=m:JJD ?S~t%'o)ӓʉ[Mw(l]uP830OFQ5ddZ;#D}S뱒ޟ4<áJ7][! `hcVtl)?(ixڭ̆Bl"znQHCBA=6+>PyyhPoy)Y˗9'sp<~:󏋤\ .Υv`3}l'^B6YkZfH9ME(2XCLms-,9n9ʭv Jo1I<=zд*(^G5t6ͺ*[kX_Xg.ԘNGN|^m>*5սG .aOsM[h4gְz Os-fv?So_u-ܓ3lNuKX{m)ZNMB/`gǣ'2Ϗsd۲a]ڳ_?KC^%;[~wg- fv{m蟏zmN: 6'Ybv,@gۥm΀elhdmw^z;-1ov2 r}3> stream x=k$qaC$ 8F=$@N1=ewt{'=U|swK @jd$톍|߫ۧ n6_< 37^\OvRo=\ m}Ȝ _\Lq#@3f^W1冷#* w@U I$,F/N K8˴Aror8Fr^r+ z_ۄ/<՝ԣ3&N8Ō8~fǼB{1#0hxY;k~Dr; $ xFyyC:R6L,w 'Řjؿ)xͫ<dy<x3sV8&'+R&u]䷵y_V^NF[ ơXW"k%1;X=<,q[懿k>c*Q8VaGAr?x'^*cxu,Ʊ3[Ob8]ǎQDV’(-gZ2IzeupĨΚ07Tmg]pMD"#AKu0=VB`(j8,:Ecc%a ~97i5.^ca}Z B@8!&W'Q24SڸH0j16kl#?yT_7L0M*W1|"r Mf|Yy[%F6H{֎HJTv~W'emp3K,8|W7={gj%'(Jx1`[!s!I8ΩJN1R!D[Ort q'ZF0dv. : 򆡙D5+81<2[Yc:,i6#j&D1 PԊItIT%D#aT e(!&Q]d= r+jc䲗Mi@IP Ce6gB۹8 a `^(AC>pw8: ѷ+~AncݥPHw?pn?^A Au8_Rl />̭%u:d8T*J[΢\,8`*(GL3C9g/Q9tS ib}'.8YFu@I qҒ)i$)ŝ0Vm0U';'k=Y*d HJOqhMOuBe qAD@A;AD[?Xyzyv/ d@|fۛg9 .%|Q \2]0XT%Y]EiR\MK$XH FtPB.eA\E8!LbQ`Js ud-@E+E[RLH.D+ X}Q{]/| +w\_GjЌVge{Uw]yfǝgR`0U@brre,/\x='m`oNq.VfHizY B47tVqP19VZYA1fmEy(-*]c&X r^A'j?S#<21Z(4Y c| H ΅O*Vup}8Ra+(@ H@ 2E24t֑P14CƎP: \z; јhQ=U$T,ڐ֑MAڎMBVq`ݔ` n H@y dF@:pImյ;=ZB8QFU& QZZ2p & MޜA}AWB͛OzPf%Hì#j!"97&ʝĴDBDċ(ÐB`p EkؐYtJ*J!v8" ̹ol")FU`h>c1ngo 22;nb;dI+M&*ªI,YY5dVeLYaU-dJWx w #_!2sߑY}g2@ tFXru=iᦽL9| eg^U^uOcʫi/F*(2||^^MzYLe"lm:3v `-/H[(1 X.nCs2[Pfx>g9c1aUPVªr^VI)y5e=}t=jމh$fTH], K6˲*,ʊYA>:/,ʬ *XY-833kԣWI:7xNl xn~˱iS8wH"ыn"fn{vxbgGni/ 575^{vgZ | XΓ#}q:lBJ8HK  {+)Iq,q˼{9o1ȚdmӕZs#dFS|*,9%] : c=`ӝIwsa\ ̀3z4Z2oPz4#xgRcC^D9xXXTt9ȅ ɷs_l4#/cmbSއ{bb@ڢ+ BJ~Z:<Ԙ*]+ \z(r顇P'Ii%HC+rO9oo3i@?w* s\#51:NPalLG VX>!) aV id*2EhXA LQZViV nO&122 h걜\u4.q;¾x>z&SaLD,4cmȍxfʃ,2+ DeR@HX!AZ*2ʰJtgFILUdVH$Xi'D,UUB+C(Uh#TSY=+GyRO{H+#VZ+ TZBiBܟM5+]8݋u{J7T5ߌ5lc{^7/()!Z P~-yp/k3}i5ZL%/RkR!4?J%9~zrmp8w%za: X>C(@|LS 1rԔjC>g%bxҞ^bMPtNi4 U9&dC)fH'*Mj͗*ʚiPPLzpUuS *cфIS ([U;Se1z~Rv 0c CѩTg5.Y0֣9u]᪠'„rWqsz]M)!njQ%Jieʽ&kKȴ2נ,WNJ]P` LwհWPgQSmZؚV/KW.jэgvwdb*ޟW]v^[+lSO4>9<b E×%:<`a/r#Ҿ\K%;etuUNEW厑]}Jhնe(6="&CXy2k1Wb`oZ[Z&H;M[$Uk-PXI4grǽ_Ma <ܷZ'(x|U)jw)2Hj?6 [%NU(B;PRXRpRuP3`Ÿ*ٹx'XzY©\~\M+-DGPMHSOEyPM-Y-m5=r MPKRԝĚڙ48[`i5JY)r3ʼ$3Eя2/cd#*03%o 6eG,b&:[t=P`P < Ѧ41A=Rj$iFF8t@si0pgϾ_Mpt´Uz=UI5wX2z4n~bFUFu}ZVPl*ˑ|ޠ na\% -[=`|%--eZ%\iN%8JXsڤM-}ךIbƾf64 ғh` K~ԍ8+7M/ё. 1< LbHܠiC% R~)X2R%+6¸#1n[Nre +aYv;t:b 'CϛY.pkx& 2mq&"gGn4<] o.)yڛ#ڊ3/>{/kbP.Gt:$>D︚WFz:.-#Ke|[00c [8b* o!ݼ+Ƨ 9{L״;}@2T"_M緊9YX(%6)zrygb4Mq4d[O'=vl!kygSy6 o|1Lf{vn"-YPbjlNw^BO2,n 2wG3ųطU"s& W@1k-fo3۞H`k;aT|8wl"h&"c三 NK3 yG_Yx[,O_{ZG*\菝e:IOWuj3a-n?Ip@ y4[ c r I[Xf919!鐇5 |͉)%]ٷ 0=(qڵ+ݺ=,)97Q/O"$}N1*x85[9Dժ7D(FL]Igu'nc9{"($Հ(~ E3S<^zW&M'fB-fe~nRy4 j,]u &ɝr$Twee"]"&,j:y׫U(f b3>5i FTT 'EBD^dͱ6Iy3$'}CզM>LeѶxlOu6g0Hq_s$sj<ZEy<@IJB|v 䳻Y4;H%T}= b:t=\&onӶY~YԐ>~VE'@d~{a~-`Vla=7;Vi]:) $i6_ 9_r5]zKjߋ;/Se>Cp0}S2 nW!G˄gmU7H0)-l5zzV,ĀtU=iVjs$lv蝝|0銙n{llc@eqwc¡I dIv$ҥMa|l4eɍߣcؼX0ڧ`wNw>@3A{~i }EX1Ia~lyzq灌(>XnILR>EV!H՛T}5OfcaDMSendstream endobj 494 0 obj << /Filter /FlateDecode /Length 1833 >> stream xXIoE#Z\F%#q9LfqvB=߫F(\~[[e+d|yk;8ٴ?-!eGe8k]*m4NpҊnq6B]/UU`ukx謹E锍G)঳^%J &:m,0d9)XfTD+锇֠N9l'qQKj%"dE w Hӆi->4?/7`%5Εo76DZLo͔v8lKn:᠐kCyjxk|2[b_5g$ 7u (qDxg R.A%kJ VZl"&0 $@mzlPҏduK4v:73 50F Q/C[j{:3(&N4eI¦"c=H@σs! de"dJ T~$;ɑf19;: ,`DY+dJgI4P*'@)F4\#^p ˑƑB\%:Z@Ȏґݶ)W ۯ/OoݷЇwUSǨnWnS.}diG4-u6HF@:i *"P{i, 0sB]I^'$j]v*?v[ .`Yq7w,DC9x̓W)ЖhvHnL6!TNt~K[{P;h= ) A*DĢ\;ܰ E2G]&G\F!bR9oE:Ft7ݡEzQU2/옑;@2-+m^`1,fz@eځc̴j:[0T\u;hІwucI]> TR^VXT(4oR`xV`ᄌz2Y)q`R!EeX M6N@]E^Pe|AY%x|!lV)XDJQ!X1Gy((u^C&읋;x:&Y @VVvl9ds=lf< {[pNM05ԒDLh(,ZV&L&rfQif;Rg&RҼ庌Tk٪bsjpY쳒XL'9x1Fc„%&D!692j"巯QD,]B)aq!D(=0&?5U:\ {B:] "kPMYXe%-3# _fˮ .bkODH&{b4XlsIxV;=,,onZf Y0@eX+BN`!9M!)q(IEIp&bgǥq0X*36AՔv|Cj> stream x\Yo~#zMV0`AXAr-)Y@ߞ"=u|us!z_ޟ~6qqE/0C(\ѻrTt o}]_^D606B]D0:B>[V}XN( c Buo`.t[\[Ǡh 0O9`Sʦo ]WKaנK oqWQY RQ.`^r׽1rҶDAh].W0rahps-Tti鹴֪CpmQvK!eFMfZ8Eqnx ;-ui*&H /5#H@^O6o ߕ2\UW/KɁ$^:|Z!NuE9fbq-Qpژ]yr"5葕?']!z(.)E )Xz vۡJHq&j^ Р=IDy@y_cQqnCӐ#cYa5Q  Zzb%uoZ;ϊeڀ%4AC #QE.;!e;W$G.[Z/қ*h^*[eNx淸9G z=o&:s V1jWC*D< g 8beכ2<(lrx9m ?tIvW`(Ó2iZ6nrBmw647lMs/1* iMA3T%; 8'[V"2H4<e72AӴjX,MQdIS9)S.d|[)ZLꏛmz׼)v -ul&L|O9e2 qsxVqX2<*C6w, j΃25'ߖ2<)2jJ2߾ 5nž*c*i3ۦ ̘; cB2gHZC6Ἱn \{xYp(&`\0}X M$ѐbd"sV+KĆA!4"S+# *F]~S6`V$ڿ2/Q^usv]sI5Zϊ3 _w:Ϛ E~Ǥt9;]d-꣪Zz}j |=8i9%:n@? o=qC`0Av̻\i24#J)M}R]WauN" uk0*XSQfXAZԢ똣RjetaGo9 qwd^QS:Pap%--|nc?6s#ZX_su% 0,S*V^g|jYkFy&1U02ae5ôctSV% pl&=&w)xBd`ugghH;N< 0L U,f0u;4lsVSB#J ifLwdMѬ0gjQ_25? Ih~r<[}gڟ/ZjuZ4mscp&a1ƶ;ڱdR4-kw(COM\te?R/Rw]|<Tf]L [b/UA5ʾ%\3f鶘Yvk>e$c^8q19ЌܖtĭL''|K&'+¶.ˡ*k䍅(hV/lW]C(OADI]\r9ɀLKubxHRLc9Q:43s`=v항NS  SL1?A]砹氍f8 t'B1^'i'X]gǕs 4} ?·IM}y˲$+2Ū6O:*J/&2{Vʂ83>4 xɃIVBpUqbMFOj?c]@ᗯ<"a]Y][N KD1XT򈷓?]EnZêR1|E "pa/)yRFڨ k3[O{endstream endobj 496 0 obj << /Filter /FlateDecode /Length 5150 >> stream x]o丑¬Cd޲]d I\{fbLWZ4ӽ wH7Xidlj?Iw|z;Lǧ?̏??"&ǎwa*;Zv4ʌNa@f5ڍ[̸{8yÝc7(,nxB Ls冟'&3fiv'IABᓟUpŸMBO0-b7j/@Lyp=gs>S?,%Ǘ|'! іQ3@hF|㇃ !1u'{?t"Qrv4xD'92Z]blP7a,?<S(Ff㵚0%]CBF =x}ƒUfq3J+ >>)L IrQhsdtM6u$&>NZFzw5Q{9s Y9 &Z,LA4I .4.xxb%J9dNiM$Zp  g+m"!UO*{pg0B+9#$lޑH)R#Va;G Szdv($}25u0fHX~yY((VZ?AӋ֏mat*|Ӗ)$yBpCZgE$QFր)GqN^p9tpXe$Ig m#}ËU23nZq||`5 ]f,y"-yFe6qBW C *"\B [X;6I摑&wvm3 f]F1"4af0ց8r9ӇmA ~CD 2PNՈ~))YaHtUXLk7~1AOKjM~|ܟP2rr (ƍ)ZTU@ 5 pKB雋4AnS٫v a%,-v ;H@i$+2mLE*+Ӥ@Hҭv U H~4rV  R+9zͼW@Tk8dot$$c!E)Ulsȅ/tWK6)0p-ٶq*Vzځ2:WhہT[@M˶HMmAZܶqZ-ݶqC7_@(n;o-Z~9+ b Cer+tnZiʭ|eVjåV/4KSVG 9-PXjQZjuHHl,mV˺+&5.&)w睵,e!J}\j2nP5uALʐSҌk !N]ZRY* xӻ6oŖ[(ىL=`f79q BM 4Q)>e@`Bao(Y ~G)W4l^Lz'bf,zS}.l -!&)Cذ*+"Q~Y,N$/p#hq[@R.V$ Ι !Dz\GR75+ۅ$+v޳-`=󃂭#QڸӈZ9P[SVxEF'%%IͩE+a/DHmt,n"4fi;Vts)vyheC;_b˸omJ"hE(aWxwzL a9[ bwޜeOd6'ڴmWp W||CVw*١2˔_^.3IpyN6rr.493~k My l+A- zsf<7F⫩eu5b耗:Uv!Ŵ(v:L2ŵ\t?4!1vEӉHF>*6>g>z\ښ53dZ&-Y^ =-XBwHf}C-Jӳ (fƋϿ҈6gn46_#$)]m 7kydl$ $ 3>ZGdW~:2gR]Z1Y\$VHf}5DC^:s sunJ~s9]춟w Uv8JqSn YA,6\(4]nzRLSZ8ItNh]9J>ֆiCoFz}mr1$ %_*K9:W;tM׌)4浫rێށTE\%6w U4u7ⵞt\47Q^Szf)Q. 70*,wJ[;\ 9@a*|g*iq&Hp5\]Mwutw\UBN Q\.Q\"ۛށT. w{;7]*c~I3TePڦ-bb usegod{淧_F%ߑCT_pvP}J%e|!s$*)~&¨SKfλI){6 9fFX{F%WQqݚSgktMש|}G'?_mvjT]<_Iys7v5O iב^3+Ɩގ{f-\$]'5fr!<4u.9}^-G+/NwfduX@gemR8hF9cF)Y}vRI߷uҿKfx j<0~\dF">^>@ nrԲő v 2_3ryLVF=3ƏO=] ǥ\aG J&Q~00zI^ |bHʼ $Q~f*۰^}$_0CԴ\;P@ن|ͿDLϲԜ44[ b#̓-|`l@oXN_E&@\Ԃ&n#m yyr쬜7VצЅUǂ3:GIvzMꥥ$Bb :H.ujv(`B Xy3NIVp`CLpg co! T*'91WpIгf%YMfPrzeaTφ[j$'cŚ`~cJ(,Fu3F  mxg0sg>`99V+W U8qb TZ'Dekq0[!dV?6gPw:=ӗAs'6%ij{Y/7*ʐKE0Z120)eeL~?ֻr1ay7,>ɯ$SCxFhse՟Jwf9qڒI3,J-{Jtjn oaIwH/omB+<-L!-A;=)/|CmHļ贾n,+h6v`pvM3%EހM[Q~(h |!nSz="4>yUWayZ巕~$S{b~KmyjVUb8i}L`  ,]1%$y.F,L +ZB$R{%{v̉+c@aVS K瑸URmCUl6bîbI􅡶RBjlZ3 Jg:KþV<{<b9endstream endobj 497 0 obj << /Filter /FlateDecode /Length 4517 >> stream x\Yo7~Az6&d/$V1dYҌ+2o*,Th|""*3UW: /=8 1;=@;.f?Rhjrv }+gJVK7lmgϚ)-F(|!Njo|Z^f i:!tʆH)D'7w ՜7[kRa4rDA-0o檃Qn~+z!fy삖jN ~;d T뼁M:<>hwyia-msY*b +g +u:BϛBoXn]gsBDzrHrUB(䲐Wl~:hׅ)dީq9;svj/ /a𤐿q!IZМ}|>_('=N$~|Y#DJB>fڏxZ[18fGtxT9T0p ҁh^.w>cӁx٣╔W[Nf&L>h9{*;Ur߱q*ߟb<'D:7 CeH@ DqZNZ;m(8[cׅI6qz۬)_*',,  ,L$>vrDZ,qRYO]"™=G~ >l#X.3w+Iq4A`_xh?@RBު.Bps;ruhz9"LeGzXoPQUKlWc]k{ ^}5Hfu =ô#UOFg$9w]{vB炝/''=C N.MxIkJ.!jEB܇ǜU+YiDxVTGYamBx.80#&[ VEk<|W=x \vtn47:ȲUǙ\Fo _:F#8%-T`형jS/V"a;\UBg:'B?k!P'9vdm7 (ވԔh 3pCׇ4T lABh!65 "})(si0GDҝtnA ad nIjVh΄N$c(BcJi`rt w<:@ܢ1DFX!0&k[χֳيt8: G9FYJ,W@m.3A4Юb:Mo21VxD1Y>e0dirӖ7@{Y;<)IB!r~pQ{BR#6uV.̚$^{ p{3*I>kėx?;ČY?T'Qr6X ˓۸ ^  NY!')ϙ/KS<씬 rEĔc}wCr D dI͓ގ$&+ݶ&`[ܻ#>`6ez]S:A8M32# i''8`-1Ea9v!*^fS6w{'m8gIR4JS;Kد'@%K\lj^k޾;ݢS 5l,pC'T۹טw(F[M.{ jl`2y&1@GX-dV|&^Cks[+3(@H$`ux "lYM0UnFdOǼD*6O҅i9 |x5ږ<0b{\T:P& la.dy':>P#@)@S(3!y?m 3|Ts2Yc0YĖI1040ߗ&x?ɒe߱ϛ3ҁ) }yd?H cf?;fް9cť  z#eB"(+; Ò_wPyb%^'2MdS:S|@^nf|H#rwBjsn'[F]:EI_lD71y2f9fIk]=EĬ0NoRjRm=e7~*N!;׋p'=~4q:Aކ|RШ J߶LU h5ܖzayWi.Q@;-RCv7~>2\{$^X`FNI.{G.-dbצOʁ^D\j7s.Z#ޏeG_ëyզiIŚaJZB~VDQ7YMLŻ#E;)Q9Wb;[ٹ,+Eߙ\ifWaTNwM& 9F?,@h*;5uc Wփ:%݁oPU)m$ yo Ԙge ۪n~${[-:[jrKxLݝUR$*՗Dm'}ƂwN!7UhrfaH#}޺N\ IRky\% wRMm/̉-IIwI֒B\Ģ}xbfh2%)5.GXﷺ82*ɢW RHUgǖBZc'NXV}S3A7 xVRᘁyRozXP|;E}dD2 ~p՜<$8NXB:27XӬ{˅ U>F(:t( }G8a#ڒf6t0{-1ǥ'{bY0+5Xٍی:9NBИ;LtQ# =U+>J={!hmo+|i\2N}-Qkɶ=*gM~%4"s&uYZ\2޿/ӱ{ץuQZּ[% Mu3HBҁnl^1#L[OI $3O87%ퟰq|?> stream xUkp^auyL$Ӑh4<3 y%KkYXd=lɲ]=dmْc0&ghH M1@$mI;m\Qu&]C;Ͻ{=9[|p*^jë_#%]Z|T],Hڜ +| yb}wx_ޟ{|YZ|ו(ULZ%~i&@|!TA|]4rTh7H֓DLN%JڻXsoTj(ebUTh':bB"ʔ b)HT-9*R(h5!RH%%VIbN~S*Jd Uh5bL%X;娭ip52M(ؓXT7>HZR]©% L ,.JMA)ߢ#ԤTIݸK]>⿪Trݻʻi5np?K%e}a+jVE$&d+`2{;möc;nl#hX3gڲ\^<\5+_ UAƘ>瓼dA>jvAQ(R u:[As01N pcY#`nٵRZV9 pXKꪷ w;aOSFPd7Ϣ۳-"beEicUZ|d~h(7#047yis_;].8T rڦ+/,@coqWxod2z#g4UzdRސ1ox;?+p. |P 8L&[ y ~zjmkFϞ OpeLILJG{VeF0>K#J߸KלV /ƥ"3c8ݞq+E1N; @16Kb1۴jU &ƁtWbq.o0w@cҷ6p8)tL{f(V8 ǝf95˹oH'3ק>}NTMNCjv h%(pegs'+A[NEgϒn^(.NCYfd0o0fԣ>-w@^蕦jtгT5*P;.1 *إ~vO}aSrpPevZ4\M'G2ՖN\Og._#+>On-ϫkV;8[mm-ڭxAys s漬=rΊ ueP0kw@-MFiHn6ՉDb،7gRU[%# nPN_ CxWZjhEf&==p9EzZͨ&0v\hZ!*t\yܹw0AL~kxi`H[*mZeYsA̹[? |s>>m}LIg7F g/II]^gdZ5d,-D‡S}$K|9s{DUsDHXj>8&..| ]C3C^+X\C {oS"+%6/8^8}wؽEv=: 馜s!-2UrCڪbvjR+ Sd$zƟ {:X1Y;ox;x5?ær9mnYsA]ؘiocfMDړpE&Np?IV.Y!( uԶ_X+a5cWb06>/Hv ÁH}5go.yżU?vbVw zZ [nbI4~兩nÞYr(z<wmU[Ue=*_ܲccMurD%hٯEzx&]RE9Y;*@e!~ bh0[RJl.ɽЬxxcBL ՟-lq =➻w_cؿ,endstream endobj 499 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 626 >> stream xuoHqM.lwQ [#"sۢtjFMH-?KK4TP?Ƣ(뢗RN<<|^eK(?Ntܙc_g3!j{  ?jYuLe\mNiKGS-|٤e}f Bsendstream endobj 500 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 196 /Subtype /Image /Width 269 /Length 6092 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK " }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?RP #8CB۽o̎RAX}E# S,@.5AGF#9Kڵ(:(Xv>!{6d%җk[`)ڏٳ(۰(+jytڡr3+en6{ ~9YF4ej ȣgFd}[ E/jٖ-}qPTwFg,}ڴ0pM^9:UPiW(3 Ҝa>}(*3)@3;&_jvR3`lVP;R@d I7j2 Bҏh.C;oJNhj]ꏐ9K?H&. `j>Ac֙p1ԠqU,\Tz͒Xf.-u:WYO?vFk*itF)H)0HD;0)b"U^I4s!gwmEMZҔI &GG)/EP;$WC)'C{F)6Jh8Wd$0&8(&!:Hj=)ʂhRhfE?Z(RЁ:S ӀU>̏e;gҜeQjj/& d)FM>NY R?j;mb+B3 ^AȋzШ=խ7tPS{mFY&@u{4Om|Ao;ANӹsZC[6\VNdnJX"1=&$<{Fݚ 97Y@[\,2\/M5hrUX7P[ٸ&E!BYŝ NMcؾxyK؟YXn% m GbW;56#d֕mę$y>]hjVD*νg_?FkcdC JS/V'Q=*VX`<Sy,qY)?9C Z@UdZ]"¥:ժ,=Cĸ tc)6'*;TTE£XYgq"RS2CVCK垹}=Br*o(}b0zLOPc> q.i669"D7*4 ē'o-bW/fWx;x֣ `fĪ UWcR2=jܳb9#1yc*II?1~9k]bK<2w{J lwLc?:uxcSuiKioe!?N[M]j'2q9"7oDiA~d*.+Slƽ^TyW2`};wesU{lyIEAJ${ jldd/o[^@Kn3\nD ʃU- *żs\KݛU%%g֣@gvYWIE΋h[MFAʹi{ A%:@uYzkZ( o[|{nVq5Q[7.~hˍ*?*o /mXbHI쎬1M&c\`i☿TntRno:{W\p#\jk$إsm[O,7]5%l[=/if6 _XV3ٛ-0u2qL$t1cv$hF[Ċ$GUc}iEbd* {mZƈD }+'F tqZuĮgF1Zҝkâ6ܮ㎝rLkLr:Sb)ʤnP7 ƹYVf8IeM0~W~z~MC*Ydʚ^%AA*bE2exz,I'z Ğdl ~Qr#B͊՛_xs `\?-cIm^̷did&I?c6\` ؃i0 ı$=M3`RX0~q8G T,RM` l}N _pV+{T.y>cU) ʃDGNvƚFj{ˀ[5vvQU_IGRoz;sHM1-M4qԙ4X[\ãQ~ƪfr{bH9T9@Mڌ NE:TeX (;(5QsK=\"x `ݨ/FawDZu;ɷ TY,"LI74UjxyKǶjI!R@RӔ"0܎YAF3ڙ=)j`P#iM]" 3JL hf:L@.hJ 34fwM sI5zOYf $gFS'm\r0ZYWp*Ȟ `86O) SOZJbHXPM.h4@LQJC^h lƲJ' WKic ~`$V IBnJJ*/۹@q):^U݈֕1LҰ9߿FUlm #[/嶶f#ɡ"I3XevHClc;1Npr¹~{4C9XGB|!IJx4w fMaV<**~щr\ΤN?nl'Tm-Ҭi-I6邽}Xlmh+w޲E12n $m\'ޫ'ѳV@u:UMldRnXEt1ȇU6m գ2 TꉱwiIkiZ |²KA8|I"ȥWkN8l~B=zW9o1r/76gi%IJi+@ 3EjiK4ʹچ -.n"GVݞGݑʎ(Fސ5/ & Py?ȩ_%=^?2مrrhU?ʺSzkU|UO!^0%/JJwȪ;].7<@dҐѶ$zV>#-+دi@A^Z%%*ކPK\- 4n0pjr1i2Bivwk99+ncҩ_:ݏ=LTp >`A5uP))f)x9>f`]L$y*E6RPQ@ZJ)i(h_J#Rˌ5acIA*S銤xk+Me0tRH?:L=*HXD<Ȥ"sT5 Zw#IZ1*UX|OVΔ-Z.C*Au(Jv\ow hO8Sr\A໭]{v΢їF}rH91ɭ8{֮ =zɚRV3O4[+GLCpU˩b}t$7}qkJ&ܠd9or " XcM?f UG<^qvwb)Dhd f-I݊jr":ϑF,XֈN C@Tf<DZQEP(@.hRbE.i:h)h5RϜgQkIxcǥbΧV%DyXXBdM6Q{}ui('&[/"0?48"]L2֥ЮRU$RGnt_5I8g+6À~36 p*(袈-G'dAFi)kchҀh+94FKv3T= fC@vF#6*nf#-y Ns3߼SĐr{ ζ#^u1yi$UG4P`RQT {(P(Q@ Hii3L(Zv~h{ sJZ(u(Kzl21>QZ@{ F81)h J(R(P /P EP\QEQ@;endstream endobj 501 0 obj << /Filter /FlateDecode /Length 3697 >> stream xZَ}D +َm 3ayhiF1<39d-ւ p:%G#[Hzmj^odrFMu9J% I&՜ؔ:F&&SV2ym}Vw۝l6hbۨ}ߦR3NT^$SI$-cQjGqO&E( !+ȸkF#jFߑ\2*hq9tҭB:o9ʀzfF|ԦU #1f# xF) Yƅ[eUkjHk͋k4B7E?wVAئ`:6:,Z| Zǐ#! UYǜe5]c" A;JK`0H?kԕ%{woRbpv0%e|) q0T+^?o4~nmwŖ ƹfHE|*x0FUZˢW(~d03ICsxh9{t*cc,8jj ŷ8`| VR :#$CPR]%|mA&5gAgm?'cC~~zJL? ǾpQYGNc'Fƙ?Imv޵.AL˺+-g({ZҷL L(4 ΐO!`#igjB1<*E&QS@؃ QZFG$X1').ayiQuFy jv Xa=xpp3=&Oy: "O@uL)*ݙLb(X=auW( G0{O)Ft6,5륣l',ƐN-=\Ét0YoK1&+aMTz(-2 c`3:kahBE6m)ӎBbzNh sReP@P66ߥsS v2=(JxGI0V?J$,XJ)YJRjt]V"dBR)~xTV;r!&Yʂ' XIjL\RŹYWqNCXiXՔr8y&zrssv&B=﹗Ѳ1#kE-p$½Eqs3UCQC tH6TVWLG3ʡȭMi5[gfQ>v/ᎨJYB1 zP}pqϜ5?|~4r!P!`cS'ădj\ѕ.؍#q:%hnr)%x]+G}l0G>sv`Y_d6r!QKq{$9g>%fjNj VXOmMsSc}b[w]3QZ{k3*Q3(6+hǿ&(5#Nq-DT ރ`$I^JG(6كuʱȯg&ʱɗYEI5y{!FM>JPu:t pW}|9A_7p)K5}Sh o(6) 2oDCoCy 0֫DķLqyeGWmftXAIRq3\^ NfmceI`hOME̟$7I,V`[P)+H)|IJ L9l'wZ<̊(S! |HNlv>"X欬FjvuQp1Ս.kV({)6$3㙤1 g6P3ԭ`Y*iH]/雐^([*]By"a\Q|[HVቑ8F~#:J^V.1Y%*"*OV ,*@t\;[nYwY;[{X`L6PO  %>:|q+8!*{!ĸѾ/D q[A˻Q{3e`/W2"w ULA*/m;V;=˧Zv<ʪȱ,zfʨBJI9Q^t#ʫ'׽7dc⁼4Sᕫ]F0@8g.N|v{J[XL s7Y.(+ve z^S-}_ԁm4DL:sNQ`YLimD-##k ,o"49FfNPXgN TgB=.V/|b,Bɯ.YU_LF3F^9LR0܏?os噴Qܟv&1?ޖ-9m.=Qu͸CA0촏=űZ, >͞}s9aNl5hʘ VUTJ*LX0Q'/Sjfq:2u /k"G ]h^Wdj3 #[ejIDEv!̅*HS6a^N K ˼aN[U~j0dza֐P,W0ތJ Xw!/Evl[Wendstream endobj 502 0 obj << /Filter /FlateDecode /Length 5450 >> stream x\n$q}X-_X XCf p'RY]l͎bɨ̸7bA/{77Ogbss3~)\oRF QDxߕ⨥xǨV":հg#T\^` n{== 9S6xBxjz pg%vax":mݐI@a4'd$mR'fWyXqKGZ 0p{ g@i ) 3fJ$Q?9N 5X #D-|ՌR0{F4-`2="zh"PEuƧUipY:Bv-xc8̶vq*Eo f։1UW5Bf2Dg։ޜiOBJAXB |@82V80YH) UtwT;iX7L&-GQ0V"(F;gNEsq]2M"ƩLWai5 "X%V+M,NZh8x|}AN*{d騐/G9U L]tHGe!b8URQ[&y-5],{e?TŔ C9/ܑrPy{Xؿl q~:^k 6p9e\snԴ]=P@q':Qs~ѥE>قT_!_'`ȑ ̤kƩJdћ3#!~7Ϋ@]s C1@: 3Mv~hFuZW{;B8K!BEN DlwQL>v5ƥMi[Mۙ<~c4OmTA:cvZtf[[a|2r։^KFXcIԍ( VZhZ~\T }yܑP̙ДZnW24"/Nb7420JaNɖu'ꒁ,RY # dz=‹9LB<~=>憼v(xJZmV' M`?2I~OjB :ͧ|'BiE:s3ތpAo>q`b#?o|*/F3|L}^0ܵs@8ާIO cy)vdxp (MqSY%7cs{ܵe=^klhED,KjNWwyy06@1հQ6~F!%\.-!nf'bna(sx6|}+xG $bknZ]^t4GYgB&SP*V:s%k,WGۼ!\*Z8]c-;iOJBIjN^QLI{;$m[S&'}M!i9l׈&X7{,%x72~¨)?'ƈJh*xX,tՁ|l&I:~~dz_QMCZPtxkԤ^'o U6Lu od@,ߢpPXs`,Lŝ$G'b Wh\"|#bRc9^KajpzjbdQzb{?XMM(j) l/6%k8[[^nf(a`M`]~D`0zQbG5K.Hgh_+ wbi>Y.$aK:M1؄ૻ%HK-#zvBIu+!.St=IWt }*ܽkA) O-;w"?H| Us-3Gz QCTH; $ [kEC2,H] q|[!ƃ8c~SM=wPFS]R0=נ ћ@.w)VOGh'Rܕg'tY<%ݙtRP_21JXS]jNG:$uΩZa&F'5L/ x1 .Cn5BzfI0vzr?rpq?3d\.Ef r)3ȳu\)]'ҖP]U1#WI; +}p5dF0>?ӓd!{˅-/r=m>2?_yV(b;h%a_fΆ&ʬ4+Qޠ4]'lܛ'p^2s\ƅGC|~(^Pmz$Q`aCc36|j2ae9BY]W ?U>KdPn2!B!x7GˏUO'80 Y e#J"AdW ZglSL|5 +@f&sm+Wm3Xh-~a('65y}%)KGd!E=Ƞ)EIj7r_1=^6g }v MV)=%v9X#DsOOdRCn@dWV3>笩6e}&T0vdW,'+U%|qA6}:A.c<W"T3'`d?I% f\u9(=~cb6DbIې4YH5ek'KZBWO-ͺC\;f~rLM>oɡr{bS`Q{q[{xA䝼y % 9Ss7-IY[G3z~:ps aqɼ%s+ AS5Hʏ}K҂ -Dtdwq+ *gX= fa RhJ2G*ΒQ}c3/o4t"(b:白' ,$ͲK$]qPW-I\8+4)&|j'pő.d7 v t"|]JME5$+(ATyil֗P(u{Ֆ\7CmKjȇXS6D" ^<""=8[l:]4X.ᗪYR׉M3HuǙʟ $4`(/Ug#<޶6О/۱R+8kikoklo9ffFLM[({(6s{dZ^yI_ r~7q>ʼn6ůϯ}U#~CAL1v^͢ș*ϋS<&ÌiQ=w|lŃ>%|75 l<髠U^aSE6\Hev I@tb#Ki8)yqD p0RTS3<$$k(GLH!B@d# Ɖ*NMcI9|fgfҨ:Cbs17h0NsJs7^&vv,h8]b5&:7;yy?㴾ݠ~sT:'N)M+g6L:[4|䒵oZԨdfv404RQ.OjDe׺MXrXNF2s'+ȡrLtםHftW唙DsY.4pr.]+TJ@V&ˀ:I{~½|~fߴG:Av1dq\W-+M `9yoG7^Z26PRmT::hqͬ$*opV$oC#tI~Jc'@(a[Ñae}I\LEMjG*bԘryPjxZ\)[ |lB)tЖtڒ酿u LJyQ;ɏ,O.g4Gn9V̌V[vWmS eYhH&E׹n9|oNTawAox*ʪAI,3;fԩXH+%+CBd,w_ZZu5usno+̢C`v6uG+LA|d~ 7{K&?7طT^eendstream endobj 503 0 obj << /Filter /FlateDecode /Length 5328 >> stream x\Yo$q~#v坹 ,KCh3ZcfvőYhgW3/N:'6N'4鿝lӐٛTFu\&Nޟ^ ^V*5o:gW'߭<%zؚ}Z]7ƘUoU^z0=~}dK|jR4ί;ծn`|\chzA{/qk!:cwɨWӇ)&gKQ.u3uc6z+iЊR֦Վ0_O76J6Wڼ\6jP_}_1ڻvGR2=|NCwjrց?~j"fs(~]/| 6mm^t@5 ~ktD`b\v0ɩW6ĠaahB9w@;+_x]n.h}f~dD'CX `EƂ|݀^ͺ tfσi\ɉ(,yl#5%|xA*O6bxV[>[em[ !?B. 5jTT`k37nG+5k\gotC̀?T.TT^go6Ybda ޽dn:>pW/]}׵⡖#Ȕ20Zh} ]y+Ky54M`uB2^1` ]W=lm=:>xXuw)D?ݫt/(Lۭ\3S[*^P{ o&ڹO- ^w~]D9S3%:ɣ+1S !S)C:Gԝ]?lFz':RRD |e-RCfe1 {_&4Mg KAr Z\w}`r24Ҽ-c 0 *Jbe >wRn (qڞh"HFc7[ȓVޭ(0EƥO\NhbĿ'&e#XD!B; a#w2r~!zS ' pֻ?t\Bc?v]nS(iM ;F{ %-CM3§ r ܐJgQǀCD+oj6Eo.Z!sdOO}&Y/#_UbB o?q !CWDr҈yJ ZfvSh;=&FMBh@pmo8$ 5vB]HzPwnr v]j-G)&oIB7ElFq$pkuἫIO)X dfԎ<` L㆟ơ{n4J92>e>#/ݳ hϋPyI.*{{Kg,|\nL)DoEYTfSxxX<v2od&R-甥 p\GHj?0 tATAp~&HLDSF ^y-(6 ;ڿAG,6چNX~_Rg?K*@)F,yg> yfE* (9E$Վ/rǙtKdڮ7#G[M@]i3Nuv||>X}RmViܯKVC𴗇H)Ս'e{p }fcKȾ$ۓrXw m]#R6`vu1l>Cos$IF뺨6 \.Spi}&_ѰOVnDX6㜥q10)ڀGHI Ijx_Y>d CGt cl '|(?  ;(HD` DF%D)T#3⛫ {@:MAϜ BnIRK#2.}'-V] nlU4x޸JvNZKޖ,92`Sm#bU,6#|kފNEq`#pA\ $DDiLIqQd{Z˿=jP-vw!;i"%eD 08z錣MvJH>8yxOUh{0TmS9@؇tD&ؾ綯x-Y`٪&\~3@<K LhZd Qh$N@,)PTr)ƴ:)zN"jo>/DTu)7-:,Ժ ZxY!fDΦ+l; g.*cXkL (L mnM0x] ,>ㄌKCf)<iE.tb0z[hpM |SwƇCD%`P !VKLDNy+-!p3mE-;tAf\W78qgPfA L$s$ӷKs2cğ;}a^ M1A4mUJAr7B7JԹLLul vsK D"I %}$ڿ!ki]|qrݾW{TLq+0 !%4P.W:i2f4wY-6l8)9QM=X i`rwZ9cB dPVu_#oiw|OVx_]ŽKvs&bDDʂpʢ^f!,/װ8Lo;1",be_A==+|jT$2?h [0hQ[C)ڑ%j_(o/8Ps !eq~/FclyY,i'..Kޠʃt(ėJ|:\־]6kCm>?,u!6Kag5UMc}$((iUu 'ӂD_2pg54*,2 q#}7u/2L}S cnq3o8ON?$.xTj ~+Fß({ٵ)W~CtZä w6핣K%%(A,@SsDwd U#% 5<',n+w(Ĥ6+֏* Pu8RC@Ж]ga0+eWIC"6"':yWit6Zqemn]M O*:o38nL~d䒪Tٷ)8yܓk86=no7ÔѐUhё-OGKHk҆Ӏz ^T z頨v__TS5z;1܄?N5H^P®IƱ\\n\OSЖ+~gZj4X[DE͞#Ϊ1*CDob[Mσu$틿'0sOhfVdE=pÈN]@MBS,U6`ӈiv[맇58Dz03mF Żh9j\md(hN,iU y<鈱֦&m 7sM)N5;%=&HOPBP^ؒn{(]roX8H+/~rEq !Oْ7 -6u+hǼGC\@/U ᇼj0)ڵ/wKC{imNs?&ֺ,Z7ut!/*Ț8(#֍ǔרZ ޤMR-XW $N>YaSs/YPjF˺Iyk*Hi\(z4eUcھ 0[%jZiדSBX;9]k)7ӜUt7[;n&ځ R{0 =(%5 5[t@N } bendstream endobj 504 0 obj << /Filter /FlateDecode /Length 2668 >> stream xZY~_o lr&bH~]sȴg]7߬$!Flokb($}g Vj-giH"gNy;YrfqCeR:;@=aV{n$@=RMEcg9/%a*d1 Z i*ЃQ9{h٘|9'*B'fNG<;9?^UGprNmGL!"8< ye؅z` ډБ`b:\94'p(^X !2b扶'J 2FxHfV:ʋROmےA >2Ot*# [x"*)'f[i*f/ `$F. p8 |%g6s:Mp :<ы:w^)+LqFfY ʥǟ~}t BSHʧU!>wW(u(>d=Q071VqwZJDn(fͅ:if(vAod,mLln1wS+,nUB%,XӨF2Qa1y?irc]gHXTUqZ0RZ1?Â6j)\3m`= 8ڰ*nf:Qy~:C\NuVwy fQHu֜oe:B " Tҥ UA#n'PO {S rĹ:p7R }=%HMoؠ$[CH<2By=endstream endobj 505 0 obj << /Filter /FlateDecode /Length 4288 >> stream x\[s~gNelc/zZ9ͥGb\eሤ(F$BR 8sDJ6k?bF_+1ʕ˃_:9Uq|3,=ru *WAcvuty0>&K.Aqtrp>1J7k1\NׇZ%锍-R/pMoy!LާLTa8:m.UpB0loia5z=liWb tT0p:롶cp.x?FgL6ux^izmiuxzl(T<EN{h*!l4IF'Zp}Es-6t2b!+Ha5-a/8NʛC|'ln/hr.\8!VӪU^ ;mpژw}aU]F`3˛:R/Vw0Ma')q﫡ё԰P0tdQ̑16a7 abRC]J=Z/ix;d$kӷG>ޮ?չk!!™F ZVN΅O[mOC]Ltkv7 ϥ٩ѹu9 X'BBhX7L't(a AC= k,$vxcY5"AUy$ w?BEL乿+QqF JmL"k[e!d=) 6-d\b-: 3\7ҲC2x9(j01 q[ \a |A;̫6t0pvk/znkk]ט1+ȡ Vȟ& K2ë:<^ĝX҅QHJKAfL0 lraf,T[.wX⇴{YlӆY~&sn%}&j=rxk*z1- ԧl ?婔0n4 'mnF^̌e}R38ڸ͏wqpFK?6ُ]gBXБ.:{;9 "ܟC 8KO ~$[ pr}I^ ,-6/m`<ꌒm>ua}Q"NJ2zo3plVJ=6''4;7Ont%%f = $FJ*=IQ*JJDeOn믊:WJNÃkkBRzkڅ<-Us<0v4*^OХ%r'dkQ: igZ{| r; 4 S^\cxF@nQ̳E<"y3sۓ32"t%<&St9 8DՑ(Yw:ReI>Ɖp0NTdrU?~Г4fseeJ7-ixZ//P[=g!vGIk| V֙7tSI~J1+/96"Ej]!lEчDn^fؾܘI\ S.R^f0_ҤMTkWDɖ[,").YSіfRv꛺-^[ݧ3G"|{/Q| ň;Q9F1r6' 4ҙD$6 &Vg|j>{QS\=(,DC 2}p8G 3HYsg"ңGnQ{aw[9/,־h\W@YR߉YzS)MMs;EZ^ i&>oXESVɸ456W-<8Ls-;^\' +)]p蚸#*{`om* 侀>Հ(J'?,50sg{j-FGzOaȗTݱKk:<~lqTЂjBm}j.44R@ 7l,oܠ:s]tm[Y ˵x0zUʉM}7 amn[^IBp*m;UL4do|v*)k9{"Np9{b!^bD9;DQ9'91W;ksং""E_`ƼI7 5*67/Κ%sv-c,e\szx6@FHU~LHcar ؛K:M+kIvS02LtZJ^i¦J\S$O gz-N=QY9Yq]X$enF]3Tp,zUB[oܽ McY# ȷ8(=/ΦJ WATwTap4`W+dPE`szΟTT0JK[P1UgJwD2~=j)308>91f4s綶ǝqKf)Ga [ kZ_ޯmW;j^ aXͥp<]e/5km~SktRiM` œ"h;?NМ<䁝ΕŒaë4`ϒͻ]k@93jYhB/KZJO-3V5,/{⚕lI$/tȖYx9,Lޕ] לި>t꼢_z嘽yֆM{u&'K2_լe9&@!\eS*$j4W˩Iݩdϖ f:RĶ})l~֗曤2 R>VVD'( rfyIrF{n .o~L, t_wh=oFY58V#^Utߔ~GpSSՙ>O\˯2Tt)ib"Bhm 6ZoR|LM:"+=OzVS tڔ;9htE5)]rhn2hɪ }k65%|~?R֡nVʝ;>{I$ %_iC{cЖ3rw J6 L{VdLI_0[ 0Mn#BЫ/4d9!k\mŹ'lq(З+|ȞSHwO5IW]gu}v&ݶ>"v^:Y׾HW '[]X/?.X )PeFq*]*1m4Vq׷6ק'qG Io*Sn8.~o8opŹ:Z\Ozy2ipKR'#a+ӯW|pSendstream endobj 506 0 obj << /Type /XRef /Length 333 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 507 /ID [<78049844850ac7c71b492d8ab294c5dd><9034b5c88caf518ccc51099aa3856bef>] >> stream x?KPᛴԦK*UIť."..N nVADEE]IEܪ KIͽSNilm㯱`F~65 xjh&>n3UC3S tmjFY<[Ap0+Ǿ,eʗӤ:*-\!ä,/Sl5nm_fЮHBZ_):7LQ+'ħ2*-m\Vr`5nн·bGԓ}Z: tpv[nCuMU^XdP6u;5J#9xG*\;tDm(? endstream endobj startxref 314192 %%EOF vcd/inst/doc/struc.sxi0000755000175100001440000002162011150520606014453 0ustar hornikusersPKJS3Xmimetypeapplication/vnd.sun.xml.impressPKJS3 content.xml\[~ϯ ReWZ/SJuص$O$2HF3 yIIN7!GGt>Ǖ/<{ap-H8kK7o~ۻ|As!WnW$H&N$WoV'釈8 b:}wNHew 􇿊>+޼iz8WiﵸLj: 55$IZn'0=f1zaS1:Z+xH0-: A(ϙp=7oޅwW`n$Y< RCDxAΈ4H,a~AuN&5FY8'qxxxlfxA+ /(7IzWԭ{5|Z 8/!IY{ZyY9q{sY 2۶UeN!WC?qB{R YKb?ˀ<ɨOL6E[,s^heΪh!6 =Vmh6_XBWV` sKBd~; # 1 IXFYd Ɇ.Đ_zOOR\> XFiD$U#l!~)zA|L:R5 QHzeuc?Ï[Jȕj8/rZ#,/d qsQuww2Q[d{y|h)v>Vs8A7mԭm+L %H鮹0V4{ -)mwn+YPs)~mdAB=ƋK4lC#~.ijmsDZU LDkӱ4wM`1W}Qw^+xx}GkauνGn":ETm,Zl5)i WOq2,@!@L$adt3swp6*Įߤo$_W8ObL]^YX&1[>I2횰cȟL?=faaW@Psʬ,4Ji\8!CNG؁'yHIy+}kڅ;>{XH/vyء t(:'!+]bꃎLU 1䗠KRRkoQGn(KeUdjrG9)(32J T8!nf.~ҏr T$Ea@ x$pYPO0(np16ۀ0eaSC <a"8ς~ a q=;B6tu hH95őXLv 'x dl:\򁒰dժ+VeYzmd8sYevϵA}G;RtR&}x"&VoviyvC-P_ LI<1qz&ux<c!j3`pct2~^%tzʼxjs;:MnS J> ogVY%3$̗8И:}:S^@cpLq}ė˯eg˯{-3a*cR!L!!k>,IIS;p34OoPXZI$d᭖ܧw_9I\fZmFxmeˬM6N7e9T|}FPy-+u$)reHBn[:*FѲN] }746-L7ZN}PKF1D *\PKJS3 styles.xml][6~_J޸ v&dk3S=UGd vw>_ .6`Ʒf|^@zqh".K0rGe,pۿ?Kh6]x!w(U5ˏ$+i OTJE\%>k$hϿʒ.z'6\k%7r"/tyiw1u]o9k@[S .—U`T{1XJ8\z^kJh|亼~QrhNaܮ HAe  Ҳ,N3snq;Tviy\#h@g=J8l8scٮ9 噧?_a,G ~!Z0b7>\^&.钩K1 -LY׽ l2C7_;DO~ ?P"V(;F0݉O]q PJ?0$M@e+0E0.ZEiuXwK ~/#k4zV6% `jJP7̔*+p@O`Q,hV-U.SBR,Ⱦu#Er銆e'r⓫T18x%)\u8*!J:Uh`6=6/x"Xu"j̻mk"Ϊk@W?^gaRa=,&EDbpV Y_,~OayMљOWU]gfU ɴ&84=S5Ϊ.l%9֦i;vPA:})S:HӐD ZnyXfbͷ3Pͫ6>U?8|Sa[Wm@<3߾ju>C?eFRu5$MnS [F纜8_{U6hj 2|٫+ڹ2ÿ*kad(8f|O|C³`2fdq6e|V-Ϗ;H)^OF1vVU{6U}s&쵻 8ccKXTuAd^yAd^yAOKS݉W*ݲͶmnoUlkmܖ[3u6 l溎sr܊5fW숀j4+Jd {ͼ.`n &`n &˼xXY7%L6Ra&6;=ni _/Z~)̯;R짘B~w=FPP@mUeg-ԮTz0@y&-]p~Wىy:N7uqd^ՈV#jZXk5|ǵ CT#Xb-̞g- j r[ZkEZkeLu#t)aS&oS/`l[RF{:>F矆"~̞'~ jJ.]D 蟠 '蟠Y8`')c2΢/wvQW=Isq?{IθwG;v{3@nwΏntιjv~xfǧl?Mő>U8NfvDZ]m7nImeK1.r"+,鼍aVۆ޾Z Ϫ6Z[mPjvY֞X^~ZϠKt} jt u>ku}@uTPj}Sj#eI>WD'Ų2 J;$6'+,tl2} `g>LWGzT0ma[3&v~nXUxmQvz=!ꑁ`T.sLC8Ů2xD_|g8'.X\Lmj['[#Vqǵw:f/2wK1v'/o}A,n6cLQgv_VTKP&Ed)]3n{ō.bHd!S96`d!{b56D42J[-Lp? Ucmߑ:ܑO%S|}ҍ#25(dJ | <;zԦ]U~yiUyOҗa2h9E/ձQ9gXial"e}T齆|$*ޔekZgۊ(gXi7PָɼL} HZ|lTaxG%PlGO(tޥ#TݟXNIwܿN[ILmwhJ7q^!w7?PK 8PKJS3*meta.xml OpenOffice.org 1.1.4 (Linux)2005-09-18T14:10:532005-10-19T11:22:15en-US8PT1H47M45SPKJS3 settings.xmlZ[W8~_u(.9I'I_?i/XӚYli}{d_' xhD]a:0?Ne0V cn#*Rn6*4;d!3tNauﬧiVFXz3.w+)8[=0Rg{)Ye'y|EQ2X.fhPP&d<`Z\ 16|cg7^D~lk }eGgisގa\!Ҹ<8*q~ d*xh}ύ~=9O?*Os_!<_*}8> 0PXY|Q+O0.c(fDc!؂2F$qFm.y!h}߅3Ԃ|ЧCiL"WָRV,]N]rtI( Dp{cUiDT 1uY&fk/$Ҏ7ʪ{.K^&\~l+!Ҹ4?wzM:!%HdyE1CX60ދ{!A|oɎ7* o9jd7}DԉK"q^6J- "Vv$M "cQ"gLU\Q5hLZ7L-($L7|PJY\1r_*|{'1.@|Q7ނ,L-12&0)}t_^w˞N1J[\qUVdxsc'b߷Cq(g{Qd,9A="b*݂]C6aДA5=]m5+W7!OZ ˡ@܁~}&acn05wt0AgЛ3>RIy5c3T2E0:/9lM.r ^a~r%ԗVI]Qw7XsRyB0$R ֗iSy>@~qSKaJ&Y'w61| ^~bq43Bz{ L&e[+(]{s5 NP~ +C]}HZ6c v7BG51 z+ttI_\+݀$HBIWI GZ UXwiz 0 ԑבXqTP㉟J)*_ajɞUi׌`}_W I6)O1E2 ee.0/_RJ9:cdu}aΚGh Zu0=ohyCh4Ok6_ƽzSJoQF:/['W-+~Y=awd?:!/KHwPZ kp㻠Dqt@*Qt͸Tӣ޶c- P^=Ұ0o՞3-ŲΫ޼B4tjjbATէ D+4--Wbyj_M5y~ So^e5>ndJm[z5T=-E,n*'NxJDڬݫXxw9[2^b*k~XM-ᥨq 7ZvSiJT-پ2CPKOץ1)PKJS3META-INF/manifest.xmlұj0Onө;)ڃ3t49Ȓ!~BI_piq+kRX6S8+l7Osʟb/ʨ<(o;bmj?"fe&`#A$n fe‰٭m Yj Ԩ*Q sZ_4FRu'aj#W)|h}P5aȣӅ1dphĢQ_툫sko6k PKI\zPKJS3XmimetypePKJS3F1D *\ Econtent.xmlPKJS3 8 3 styles.xmlPKJS3*meta.xmlPKJS3Oץ1) settings.xmlPKJS3I\z META-INF/manifest.xmlPKZ "vcd/inst/doc/residual-shadings.Rnw0000755000175100001440000003655511150520606016701 0ustar hornikusers\documentclass{Z} %% need no \usepackage{Sweave} \usepackage{rotating} \newcommand{\given}{\, | \,} \title{Residual-based Shadings in \pkg{vcd}} \Plaintitle{Residual-based Shadings in vcd} \author{Achim Zeileis, David Meyer, \textnormal{and} Kurt Hornik\\Wirtschaftsuniversit\"at Wien, Austria} \Plainauthor{Achim Zeileis, David Meyer, Kurt Hornik} \Abstract{ This vignette is a companion paper to \cite{vcd:Zeileis+Meyer+Hornik:2005} which introduces several extensions to residual-based shadings for enhancing mosaic and association plots. The paper introduces (a)~perceptually uniform Hue-Chroma-Luminance (HCL) palettes and (b)~incorporates the result of an associated significance test into the shading. Here, we show how the examples can be easily reproduced using the \pkg{vcd} package. } \Keywords{association plots, conditional inference, contingency tables, HCL colors, HSV colors, mosaic plots} \begin{document} %\VignetteIndexEntry{Residual-based Shadings in vcd} %\VignetteDepends{vcd,colorspace,MASS,grid,HSAUR} %\VignetteKeywords{association plots, conditional inference, contingency tables, HCL colors, HSV colors, mosaic plots} %\VignettePackage{vcd} \SweaveOpts{engine=R,eps=FALSE} \section{Introduction} \label{sec:intro} In this vignette, we show how all empirical examples from \cite{vcd:Zeileis+Meyer+Hornik:2005} can be reproduced in \proglang{R}\citep[\mbox{\url{http://www.R-project.org/}}]{vcd:R:2006}, in particular using the package \pkg{vcd} \citep{vcd:Meyer+Zeileis+Hornik:2006}. Additionally, the pakcages \pkg{MASS} \citep[see][]{vcd:Venables+Ripley:2002}, \pkg{grid} \citep[see][]{vcd:Murrell:2002} and \pkg{colorspace} \citep{vcd:Ihaka:2004} are employed. All are automatically loaded together with \pkg{vcd}: <>= library("vcd") rseed <- 1071 @ Furthermore, we define a \code{rseed} which will be used as the random seed for making the results of the permutation tests (conditional inference) below exactly reproducible. In the following, we focus on the \proglang{R} code and output---for background information on the methods and the data sets, please consult \cite{vcd:Zeileis+Meyer+Hornik:2005}. \section{Arthritis data} \label{sec:arthritis} First, we take a look at the association of treatment type and improvement in the \code{Arthritis} data. The data set can be loaded and brought into tabular form via: <>= data("Arthritis", package = "vcd") (art <- xtabs(~ Treatment + Improved, data = Arthritis, subset = Sex == "Female")) @ Two basic explorative views of such a 2-way table are mosaic plots and association plots. They can be generated via \code{mosaic()} and \code{assoc()} from \pkg{vcd}, respectively. For technical documentation of these functions, please see \cite{vcd:Meyer+Zeileis+Hornik:2006b}. When no further arguments are supplied as in <>= mosaic(art) assoc(art) @ this yields the plain plots without any color shading, see Figure~\ref{fig:classic}. Both indicate that there are more patients in the treatment group with marked improvement and less without improvement than would be expected under independence---and vice versa in the placebo group. \setkeys{Gin}{width=\textwidth} \begin{figure}[b!] \begin{center} <>= grid.newpage() pushViewport(viewport(layout = grid.layout(1, 2))) pushViewport(viewport(layout.pos.col=1, layout.pos.row=1)) mosaic(art, newpage = FALSE, margins = c(2.5, 4, 2.5, 3)) popViewport() pushViewport(viewport(layout.pos.col=2, layout.pos.row=1)) assoc(art, newpage = FALSE, margins = c(5, 2, 5, 4)) popViewport(2) @ \caption{Classic mosaic and association plot for the arthritis data.} \label{fig:classic} \end{center} \end{figure} For 2-way tables, \cite{vcd:Zeileis+Meyer+Hornik:2005} suggest to extend the shading of \cite{vcd:Friendly:1994} to also visualize the outcome of an independence test---either using the sum of squares of the Pearson residuals as the test statistic or their absolute maximum. Both statistics and their corresponding (approximate) permutation distribution can easily be computed using the function \code{coindep_test()}. Its arguments are a contingency table, a specification of margins used for conditioning (only for conditional independence models), a functional for aggregating the Pearson residuals (or alternatively the raw counts) and the number of permutations that should be drawn. The conditional table needs to be a 2-way table and the default is to compute the maximum statistic (absolute maximum of Pearson residuals). For the Arthritis data, both, the maximum test <>= set.seed(rseed) (art_max <- coindep_test(art, n = 5000)) @ and the sum-of-squares test, indicate a significant departure from independence. <>= ss <- function(x) sum(x^2) set.seed(rseed) coindep_test(art, n = 5000, indepfun = ss) @ Thus, it can be concluded that the treatment is effective and leads to significantly more improvement than the placebo. The classic views from Figure~\ref{fig:classic} and the inference above can also be combined, e.g., using the maximum shading that highlights the cells in an association or mosaic plot when the associated residuals exceed critical values of the maximum test (by default at levels 90\% and 99\%). To compare this shading (using either HSV or HCL colors) with the Friendly shading (using HSV colors), we generate all three versions of the mosaic plot: <>= mosaic(art, gp = shading_Friendly(lty = 1, eps = NULL)) mosaic(art, gp = shading_hsv, gp_args = list( interpolate = art_max$qdist(c(0.9, 0.99)), p.value = art_max$p.value)) set.seed(rseed) mosaic(art, gp = shading_max, gp_args = list(n = 5000)) @ the results are shown in the upper row of Figure~\ref{fig:shadings}. The last plot could hae also been generated analogously to the second plot using \code{shading_hcl()} instead of \code{shading_hsv()}---\code{shading_max()} is simply a wrapper function which performs the inference and then visualizes it based on HCL colors. \section{Piston rings data} \label{sec:arthritis} Instead of bringing out the result of the maximum test in the shading, we could also use a sum-of-squares shading that visualizes the result of the sum-of-squares test. As an illustration, we use the \code{pistonrings} data from the \code{HSAUR} \citep{vcd:Everitt+Hothorn:2006} package giving the number of piston ring failurs in different legs of different compressors at an industry plant: <>= data("pistonrings", package = "HSAUR") pistonrings @ \begin{sidewaysfigure}[p] \begin{center} <>= mymar <- c(1.5, 0.5, 0.5, 2.5) grid.newpage() pushViewport(viewport(layout = grid.layout(2, 3))) pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 1)) mosaic(art, margins = mymar, newpage = FALSE, gp = shading_Friendly(lty = 1, eps = NULL)) popViewport() pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 2)) mosaic(art, gp = shading_hsv, margins = mymar, newpage = FALSE, gp_args = list(interpolate = art_max$qdist(c(0.9, 0.99)), p.value = art_max$p.value)) popViewport() pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 3)) set.seed(rseed) mosaic(art, gp = shading_max, margins = mymar, newpage = FALSE, gp_args = list(n = 5000)) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 1)) mosaic(pistonrings, margins = mymar, newpage = FALSE, gp = shading_Friendly(lty = 1, eps = NULL, interpolate = c(1, 1.5))) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 2)) mosaic(pistonrings, gp = shading_hsv, margins = mymar, newpage = FALSE, gp_args = list(p.value = 0.069, interpolate = c(1, 1.5))) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 3)) mosaic(pistonrings, gp = shading_hcl, margins = mymar, newpage = FALSE, gp_args = list(p.value = 0.069, interpolate = c(1, 1.5))) popViewport(2) @ \includegraphics[width=.9\textwidth,keepaspectratio]{residual-shadings-shadings} \caption{Upper row: Mosaic plot for the arthritis data with Friendly shading (left), HSV maximum shading (middle), HCL maximum shading (right). Lower row: Mosaic plot for the piston rings data with fixed user-defined cut offs 1 and 1.5 and Friendly shading (left), HSV sum-of-squares shading (middle), HCL sum-of-squares shading (right).} \label{fig:shadings} \end{center} \end{sidewaysfigure} Although there seems to be some slight association between the leg (especially center and South) and the compressor (especially numbers 1 and 4), there is no significant deviation from independence: <>= set.seed(rseed) coindep_test(pistonrings, n = 5000) set.seed(rseed) (pring_ss <- coindep_test(pistonrings, n = 5000, indepfun = ss)) @ This can also be brought out graphically in a shaded mosaicplot by enhancing the Friendly shading (based on the user-defined cut-offs 1 and 1.5, here) to use a less colorful palette, either based on HSV or HCL colors: <>= mosaic(pistonrings, gp = shading_Friendly(lty = 1, eps = NULL, interpolate = c(1, 1.5))) mosaic(pistonrings, gp = shading_hsv, gp_args = list(p.value = pring_ss$p.value, interpolate = c(1, 1.5))) mosaic(pistonrings, gp = shading_hcl, gp_args = list(p.value = pring_ss$p.value, interpolate = c(1, 1.5))) @ The resulting plots can be found in the lower row of Figure~\ref{fig:shadings}. The default in \code{shading_hcl()} and \code{shading_hsv()} is to use the asymptotical $p$~value, hence we set it explicitely to the permtuation-based $p$~value computed above. \section{Alzheimer and smoking} \label{sec:alzheimer} For illustrating that the same ideas can be employed for visualizing (conditional) independence in multi-way tables, \cite{vcd:Zeileis+Meyer+Hornik:2005} use a 3-way and a 4-way table. The former is taken from a case-control study of smoking and {A}lzheimer's disease (stratified by gender). The data set is available in \proglang{R} in the package \pkg{coin} \cite{vcd:Hothorn+Hornik+VanDeWiel:2006}. <>= data("alzheimer", package = "coin") alz <- xtabs(~ smoking + disease + gender, data = alzheimer) alz @ \begin{figure}[b!] \begin{center} <>= set.seed(rseed) cotabplot(~ smoking + disease | gender, data = alz, panel = cotab_coindep, n = 5000) @ \caption{Conditional mosaic plot with double maximum shading for conditional independence of smoking and disease given gender.} \label{fig:alz} \end{center} \end{figure} To assess whether smoking behaviour and disease status are conditionally independent given gender, \cite{vcd:Zeileis+Meyer+Hornik:2005} use three different types of test statistics: double maximum (maximum of maximum statistics in the two strata), maximum sum of squares (maximum of sum-of-squares statistics), and sum of squares (sum of sum-of-squares statistics). All three can be computed and assessed via permutation methods using the function \code{coindep_test()}: <>= set.seed(rseed) coindep_test(alz, 3, n = 5000) set.seed(rseed) coindep_test(alz, 3, n = 5000, indepfun = ss) set.seed(rseed) coindep_test(alz, 3, n = 5000, indepfun = ss, aggfun = sum) @ The conditional mosaic plot in Figure~\ref{fig:alz} shows clearly that the association of smoking and disease is present only in the group of male patients. The double maximum shading employed allows for identification of the male heavy smokers as the cells `responsible' for the dependence: other dementias are more frequent and Alzheimer's disease less frequent in this group than expected under independence. Interestingly, there seems to be another large residual for the light smoker group ($<$10 cigarettes) and Alzheimer's disease---however, this is only significant at 10\% and not at the 1\% level as the other two cells. <>= <> @ \section{Corporal punishment of children} As a 4-way example, data from a study of the Gallup Institute in Denmark in 1979 about the attitude of a random sample of 1,456 persons towards corporal punishment of children is used. The contingency table comprises four margins: memory of punishments as a child (yes/no), attitude as a binary variable (approval of ``moderate'' punishment or ``no'' approval), highest level of education (elementary/secondary/high), and age group (15--24, 25--39, $\ge$40 years). <>= data("Punishment", package = "vcd") pun <- xtabs(Freq ~ memory + attitude + age + education, data = Punishment) ftable(pun, row.vars = c("age", "education", "memory")) @ It is of interest whether there is an association between memories of corporal punishments as a child and attitude towards punishment of children as an adult, controlling for age and education. All three test statistics already used above confirm that memories and attitude are conditionally associated: \setkeys{Gin}{width=\textwidth} \begin{figure}[t!] \begin{center} <>= set.seed(rseed) cotabplot(~ memory + attitude | age + education, data = pun, panel = cotab_coindep, n = 5000, type = "assoc", test = "maxchisq", interpolate = 1:2) @ \caption{Conditional association plot with maximum sum-of-squares shading for conditional independence of memory and attitude given age and education.} \label{fig:pun} \end{center} \end{figure} \setkeys{Gin}{width=\textwidth} \begin{figure}[t!] \begin{center} <>= set.seed(rseed) cotabplot(~ memory + attitude | age + education, data = pun, panel = cotab_coindep, n = 5000, type = "mosaic", test = "maxchisq", interpolate = 1:2) @ \caption{Conditional mosaic plot with maximum sum-of-squares shading for conditional independence of memory and attitude given age and education.} \label{fig:pun2} \end{center} \end{figure} <>= set.seed(rseed) coindep_test(pun, 3:4, n = 5000) set.seed(rseed) coindep_test(pun, 3:4, n = 5000, indepfun = ss) set.seed(rseed) coindep_test(pun, 3:4, n = 5000, indepfun = ss, aggfun = sum) @ Graphically, this dependence can be brought out using conditional association or mosaic plots as shown in Figure~\ref{fig:pun} and \ref{fig:pun2}, respectively. Both reveal an association between memories and attitude for the lowest education group (first column) and highest age group (last row): experienced violence seems to engender violence again as there are less adults that disapprove punishment in the group with memories of punishments than expected under independence. For the remaining four age-education groups, there seems to be no association: all residuals of the conditional independence model are very close to zero in these cells. The figures employ the maximum sum-of-squares shading with user-defined cut offs 1 and 2, chosen to be within the range of the residuals. The full-color palette is used only for those strata associated with a sum-of-squares statistic significant at (overall) 5\% level, the reduced-color palette is used otherwise. This highlights that the dependence pattern is significant only for the middle and high age group in the low education column. The other panels in the first column and last row also show a similar dependence pattern, however, it is not significant at 5\% level and hence graphically down-weighted by using reduced color. <>= <> @ <>= <> @ \bibliography{vcd} \end{document} vcd/inst/doc/residual-shadings.R0000644000175100001440000001654112547003156016331 0ustar hornikusers### R code from vignette source 'residual-shadings.Rnw' ################################################### ### code chunk number 1: preliminaries ################################################### library("grid") library("vcd") rseed <- 1071 ################################################### ### code chunk number 2: Arthritis-data ################################################### data("Arthritis", package = "vcd") (art <- xtabs(~ Treatment + Improved, data = Arthritis, subset = Sex == "Female")) ################################################### ### code chunk number 3: Arthritis-classic (eval = FALSE) ################################################### ## mosaic(art) ## assoc(art) ################################################### ### code chunk number 4: Arthritis-classic1 ################################################### grid.newpage() pushViewport(viewport(layout = grid.layout(1, 2))) pushViewport(viewport(layout.pos.col=1, layout.pos.row=1)) mosaic(art, newpage = FALSE, margins = c(2.5, 4, 2.5, 3)) popViewport() pushViewport(viewport(layout.pos.col=2, layout.pos.row=1)) assoc(art, newpage = FALSE, margins = c(5, 2, 5, 4)) popViewport(2) ################################################### ### code chunk number 5: Arthritis-max ################################################### set.seed(rseed) (art_max <- coindep_test(art, n = 5000)) ################################################### ### code chunk number 6: Arthritis-sumsq ################################################### ss <- function(x) sum(x^2) set.seed(rseed) coindep_test(art, n = 5000, indepfun = ss) ################################################### ### code chunk number 7: Arthritis-extended (eval = FALSE) ################################################### ## mosaic(art, gp = shading_Friendly(lty = 1, eps = NULL)) ## mosaic(art, gp = shading_hsv, gp_args = list( ## interpolate = art_max$qdist(c(0.9, 0.99)), p.value = art_max$p.value)) ## set.seed(rseed) ## mosaic(art, gp = shading_max, gp_args = list(n = 5000)) ################################################### ### code chunk number 8: pistonrings-data ################################################### data("pistonrings", package = "HSAUR") pistonrings ################################################### ### code chunk number 9: shadings ################################################### mymar <- c(1.5, 0.5, 0.5, 2.5) grid.newpage() pushViewport(viewport(layout = grid.layout(2, 3))) pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 1)) mosaic(art, margins = mymar, newpage = FALSE, gp = shading_Friendly(lty = 1, eps = NULL)) popViewport() pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 2)) mosaic(art, gp = shading_hsv, margins = mymar, newpage = FALSE, gp_args = list(interpolate = art_max$qdist(c(0.9, 0.99)), p.value = art_max$p.value)) popViewport() pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 3)) set.seed(rseed) mosaic(art, gp = shading_max, margins = mymar, newpage = FALSE, gp_args = list(n = 5000)) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 1)) mosaic(pistonrings, margins = mymar, newpage = FALSE, gp = shading_Friendly(lty = 1, eps = NULL, interpolate = c(1, 1.5))) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 2)) mosaic(pistonrings, gp = shading_hsv, margins = mymar, newpage = FALSE, gp_args = list(p.value = 0.069, interpolate = c(1, 1.5))) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 3)) mosaic(pistonrings, gp = shading_hcl, margins = mymar, newpage = FALSE, gp_args = list(p.value = 0.069, interpolate = c(1, 1.5))) popViewport(2) ################################################### ### code chunk number 10: pistonrings-inference ################################################### set.seed(rseed) coindep_test(pistonrings, n = 5000) set.seed(rseed) (pring_ss <- coindep_test(pistonrings, n = 5000, indepfun = ss)) ################################################### ### code chunk number 11: pistonrings-plot (eval = FALSE) ################################################### ## mosaic(pistonrings, gp = shading_Friendly(lty = 1, eps = NULL, interpolate = c(1, 1.5))) ## mosaic(pistonrings, gp = shading_hsv, gp_args = list(p.value = pring_ss$p.value, interpolate = c(1, 1.5))) ## mosaic(pistonrings, gp = shading_hcl, gp_args = list(p.value = pring_ss$p.value, interpolate = c(1, 1.5))) ################################################### ### code chunk number 12: alzheimer-data ################################################### data("alzheimer", package = "coin") alz <- xtabs(~ smoking + disease + gender, data = alzheimer) alz ################################################### ### code chunk number 13: alzheimer-plot1 ################################################### set.seed(rseed) cotabplot(~ smoking + disease | gender, data = alz, panel = cotab_coindep, n = 5000) ################################################### ### code chunk number 14: alzheimer-inference ################################################### set.seed(rseed) coindep_test(alz, 3, n = 5000) set.seed(rseed) coindep_test(alz, 3, n = 5000, indepfun = ss) set.seed(rseed) coindep_test(alz, 3, n = 5000, indepfun = ss, aggfun = sum) ################################################### ### code chunk number 15: alzheimer-plot (eval = FALSE) ################################################### ## set.seed(rseed) ## cotabplot(~ smoking + disease | gender, data = alz, panel = cotab_coindep, n = 5000) ################################################### ### code chunk number 16: Punishment-data ################################################### data("Punishment", package = "vcd") pun <- xtabs(Freq ~ memory + attitude + age + education, data = Punishment) ftable(pun, row.vars = c("age", "education", "memory")) ################################################### ### code chunk number 17: Punishment-assoc1 ################################################### set.seed(rseed) cotabplot(~ memory + attitude | age + education, data = pun, panel = cotab_coindep, n = 5000, type = "assoc", test = "maxchisq", interpolate = 1:2) ################################################### ### code chunk number 18: Punishment-mosaic1 ################################################### set.seed(rseed) cotabplot(~ memory + attitude | age + education, data = pun, panel = cotab_coindep, n = 5000, type = "mosaic", test = "maxchisq", interpolate = 1:2) ################################################### ### code chunk number 19: Punishment-inference ################################################### set.seed(rseed) coindep_test(pun, 3:4, n = 5000) set.seed(rseed) coindep_test(pun, 3:4, n = 5000, indepfun = ss) set.seed(rseed) coindep_test(pun, 3:4, n = 5000, indepfun = ss, aggfun = sum) ################################################### ### code chunk number 20: Punishment-assoc (eval = FALSE) ################################################### ## set.seed(rseed) ## cotabplot(~ memory + attitude | age + education, data = pun, panel = cotab_coindep, ## n = 5000, type = "assoc", test = "maxchisq", interpolate = 1:2) ################################################### ### code chunk number 21: Punishment-mosaic (eval = FALSE) ################################################### ## set.seed(rseed) ## cotabplot(~ memory + attitude | age + education, data = pun, panel = cotab_coindep, ## n = 5000, type = "mosaic", test = "maxchisq", interpolate = 1:2) vcd/inst/doc/strucplot.Rnw0000755000175100001440000031120111636647070015330 0ustar hornikusers\documentclass[noJSS]{jss} %% need no \usepackage{Sweave} \usepackage{thumbpdf} %% almost as usual \author{David Meyer, Achim Zeileis, \textnormal{and} Kurt Hornik\\Wirtschaftsuniversit\"at Wien, Austria} \title{The Strucplot Framework:\\ Visualizing Multi-way Contingency Tables with \pkg{vcd}} %% for pretty printing and a nice hypersummary also set: \Plainauthor{David Meyer, Achim Zeileis, Kurt Hornik} %% comma-separated \Shorttitle{The Strucplot Framework} %% a short title (if necessary) \Plaintitle{The Strucplot Framework: Visualizing Multi-way Contingency Tables with vcd} %% an abstract and keywords \Abstract{ This paper has been published in the Journal of Statistical Software \citep{vcd:Meyer+Zeileis+Hornik:2006b} and describes the ``strucplot'' framework for the visualization of multi-way contingency tables. Strucplot displays include hierarchical conditional plots such as mosaic, association, and sieve plots, and can be combined into more complex, specialized plots for visualizing conditional independence, GLMs, and the results of independence tests. The framework's modular design allows flexible customization of the plots' graphical appearance, including shading, labeling, spacing, and legend, by means of ``graphical appearance control'' functions. The framework is provided by the \proglang{R} package \pkg{vcd}. } \Keywords{contingency tables, mosaic plots, association plots, sieve plots, categorical data, independence, conditional independence, HSV, HCL, residual-based shading, \pkg{grid}, \proglang{R}} \Plainkeywords{contingency tables, mosaic plots, association plots, sieve plots, categorical data, independence, conditional independence, HSV, HCL, residual-based shading, grid, R} \SweaveOpts{engine=R,eps=TRUE,height=6,width=7,results=hide,fig=FALSE,echo=TRUE} \setkeys{Gin}{width=0.7\textwidth} %\VignetteIndexEntry{The Strucplot Framework: Visualizing Multi-way Contingency Tables with vcd} %\VignetteDepends{vcd} %\VignetteKeywords{contingency tables, mosaic plots, association plots, sieve plots, categorical data, independence, conditional independence, HSV, HCL, residual-based shading, grid, R} %\VignettePackage{vcd} <>= set.seed(1071) library(vcd) data(Titanic) data(HairEyeColor) data(PreSex) data(Arthritis) art <- xtabs(~Treatment + Improved, data = Arthritis) @ \newcommand{\var}[1]{\textit{\texttt{#1}}} \newcommand{\data}[1]{\texttt{#1}} \newcommand{\class}[1]{\textsf{#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()}} %% end of declarations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \begin{document} %% include your article here, just as usual %% Note that you should use the \pkg{}, \proglang{} and \code{} commands. \section[Introduction]{Introduction} %% Note: If there is markup in \(sub)section, then it has to be escape as above. In order to explain multi-dimensional categorical data, statisticians typically look for (conditional) independence structures. Whether the task is purely exploratory or model-based, techniques such as mosaic and association plots offer good support for visualization. Both visualize aspects of (possibly higher-dimensional) contingency tables, with several extensions introduced over the last two decades, and implementations available in many statistical environments. A \emph{mosaic plot} \citep{vcd:Hartigan+Kleiner:1984} is basically an area-proportional visualization of (typically, observed) frequencies, composed of tiles (corresponding to the cells) created by recursive vertical and horizontal splits of a rectangle. Thus, the area of each tile is proportional to the corresponding cell entry \emph{given} the dimensions of previous splits. An \emph{association plot} \citep{vcd:Cohen:1980} visualizes the standardized deviations of observed frequencies from those expected under a certain independence hypothesis. Each cell is represented by a rectangle that has (signed) height proportional to the residual and width proportional to the square root of the expected counts, so that the area of the box is proportional to the difference in observed and expected frequencies. Extensions to these techniques have mainly focused on the following aspects. \begin{enumerate} \item Varying the shape of bar plots and mosaic displays to yield, e.g., double-decker plots \citep{vcd:hofmann:2001}, spine plots, or spinograms \citep{vcd:hofmann+theus}. \item Using residual-based shadings to visualize log-linear models \citep{vcd:Friendly:1994,vcd:Friendly:2000} and significance of statistical tests \citep{vcd:Meyer+Zeileis+Hornik:2003,vcd:Zeileis+Meyer+Hornik:2005}. \item Using pairs plots and trellis-like layouts for marginal, conditional and partial views \citep{vcd:Friendly:1999}. \item Adding direct user interaction, allowing quick exploration and modification of the visualized models \citep{vcd:Unwin+Hawkins+Hofmann:1996,vcd:Theus:2003}. \item Providing a modular and flexible implementation to easily allow user extensions \citep{vcd:Meyer+Zeileis+Hornik:2003,vcd:Meyer+Zeileis+Hornik:2006b}. \end{enumerate} \noindent Current implementations of mosaic displays can be found, e.g., for \proglang{SAS} \citep{vcd:SAS:2005}, \pkg{ViSta} \citep{vcd:young:1996}, \pkg{MANET} \citep{vcd:Unwin+Hawkins+Hofmann:1996}, \pkg{Mondrian} \citep{vcd:Theus:2003}, \proglang{R} \citep{vcd:R:2006}, and \proglang{S-PLUS} \citep{vcd:SPLUS:2005}. For \proglang{R}, currently three implementations do exist in the packages \pkg{graphics} (in base \proglang{R}), \pkg{vcd} \citep{vcd:Meyer+Zeileis+Hornik:2006b}, and \pkg{iplots} \citep{vcd:urbanek+wichtrey:2006}, respectively. Table \ref{tab:compare} gives an overview of the available functionality in these systems. Most environments are available on Windows, MacOS, and Linux/Unix variants, except \pkg{MANET} which is only available for the Macinthosh platforms. \begin{table}[h] \centering \begin{tabular}{|l|c|c|c|c|c|c|c|c|c|} \hline & & &\multicolumn{3}{c|}{} & & &\\ & \proglang{SAS} & \proglang{S-PLUS} &\multicolumn{3}{c|}{\proglang{R}} & \pkg{ViSta} & \pkg{MANET} & \pkg{Mondrian}\\ & & &\pkg{base}&\pkg{vcd} &\pkg{iplots}& & &\\\hline Basic functionality & $\times$ & $\times$ & $\times$ &$\times$ &$\times$ & $\times$ & $\times$& $\times$\\ Shape & & & &$\times$ && $\times$ & $\times$&\\ Res.-based shadings & $\times$ & & $\times$ & $\times$ & ($\times$) & &($\times$)& ($\times$)\\ Highlighting & & & &$\times$ &$\times$ & $\times$ & $\times$& $\times$\\ Conditional views & $\times$ & & &$\times$ & & $\times$ & $\times$&\\ Interaction & & & & &$\times$ & $\times$ & $\times$& $\times$\\ Linking & & & & &$\times$ & $\times$ & $\times$& $\times$\\ Extensible design & & & &$\times$ & & & &\\ Language & \proglang{SAS} & \proglang{S} & \proglang{R} & \proglang{R} & \proglang{R}/\proglang{Java} & \proglang{XLisp} & \proglang{C++} & \proglang{Java}\\ \hline \end{tabular} \caption{Comparison of current software environments.} \label{tab:compare} \end{table} Figures \ref{fig:arthritis} to \ref{fig:titanic} illustrate some of these extensions. Figure~\ref{fig:arthritis} shows the results from a double-blind clinical trial investigating a new treatment for rheumatoid arthritis, using an extended mosaic plot with residual-based shading based on the maximum statistic: clearly, the new treatment is effective. The dark blue cell indicates that the rate of treated patients showing marked improvement is significant at the 1\% level. Figure \ref{fig:ucbadmissions} visualizes the well-known UCB admissions data by means of a conditional association plot. The panels show the residuals from a conditional independence model (independence of gender and admission, given department), stratified by department. Clearly, the situation in department A (more women/less men accepted than would be expected under the null hypothesis) causes the rejection of the hypothesis of conditional independence. Figure~\ref{fig:presex} illustrates the conditional independence of premarital and extramarital sex, given gender and marital status. The $\chi^2$ test of independence, based on the permutation distribution, rejects the null hypothesis: possibly, because the tendency of people to have extramarital sex when they had premarital sex is particularly marked among married people? The rate of such women and men ist significant at the 0.01 and 0.1 level, respectively. Finally, Figure~\ref{fig:titanic} visualizes the ``Survival on the Titanic'' data using a double-decker plot. Here, a binary response (survival of the disaster) is to be explained by other factors (class, gender, and age). The gray boxes represent the proportion of survived passengers in a particular stratum. The proportions of saved women and children are indeed higher than those of men, but they clearly decrease from the 1st to the 3rd class. In addition, the proportion of saved men in the 1st class is higher than in the others. \setkeys{Gin}{width=0.7\textwidth} \begin{figure}[p] \begin{center} <>= mosaic(art, gp = shading_max, split_vertical = TRUE) @ \caption{Mosaic plot for the \data{Arthritis} data.} \label{fig:arthritis} \end{center} \end{figure} \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= cotabplot(UCBAdmissions, panel = cotab_coindep, shade = TRUE, legend = FALSE, type = "assoc") @ \caption{Conditional association plot for the \data{UCBAdmissions} data.} \label{fig:ucbadmissions} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \begin{figure}[p] \begin{center} <>= presextest <- coindep_test(PreSex, margin = c(1,4), indepfun = function(x) sum(x^2), n = 5000) mosaic(PreSex, condvars = c(1, 4), shade = TRUE, gp_args = list(p.value = presextest$p.value)) @ \caption{Mosaic plot for the \data{PreSex} data.} \label{fig:presex} \end{center} \end{figure} \setkeys{Gin}{width=0.8\textwidth} \begin{figure}[p] \begin{center} <>= doubledecker(Survived ~ ., data = Titanic, labeling_args = list(set_varnames = c(Sex = "Gender"))) @ \caption{Double-decker plot for the \data{Titanic} data.} \label{fig:titanic} \end{center} \end{figure} This paper describes the strucplot framework provided by the \pkg{vcd} package for the \proglang{R} environment for statistical computing and graphics, available from the Comprehensive \proglang{R} Archive Network (\url{http://CRAN.R-project.org/}). The framework integrates displays such as mosaic, association, and sieve plots by their unifying property of being flat representations of contingency tables. These basic plots, as well as specialized displays for conditional independence, can be used both for exploratory visualization and model-based analysis. Exploratory techniques include specialized displays for the bivariate case, as well as pairs and trellis-type displays for higher-dimensional tables. Model-based tools include methods suitable for the visualization of conditional independence tests (including permutation tests), as well as for the visualization of particular GLMs (logistic regression, log-linear models). Additionally, two of the framework's further strengths are its flexibility and extensibility: graphical appearance aspects such as shading, labeling, and spacing are modularized by means of ``\underline{\vphantom{g}gr}aphical \underline{\vphantom{g}ap}pearance \underline{\vphantom{g}con}trol'' (\emph{grapcon}) functions, allowing fine-granular customization and user-level extensions. The remainder of the paper is organized as follows. In Section \ref{sec:strucplot}, we give an overview of the strucplot framework, describing the hierarchy of the main components and the basic functionality. In Section \ref{sec:shading}, we demonstrate how (residual-based) shadings support the visualization of log-linear models and the results of independence tests. Also, we explain step-by-step how the concepts of generating and grapcon functions can be combined to provide a flexible customization of complex graphical displays as created by the strucplot framework. Sections \ref{sec:labeling} and \ref{sec:spacing} discuss in detail the labeling and spacing features, respectively. Section \ref{sec:example} exemplifies the framework in the analysis of a four-way data set. Section \ref{sec:conclusion} concludes the work. \section[The strucplot framework]{The strucplot framework} \label{sec:strucplot} The strucplot framework in the \proglang{R} package \pkg{vcd}, used for visualizing multi-way contingency tables, integrates techniques such as mosaic displays, association plots, and sieve plots. The main idea is to visualize the tables' cells arranged in rectangular form. For multi-way tables, the variables are nested into rows and columns using recursive conditional splits, given the margins. The result is a ``flat'' representation that can be visualized in ways similar to a two-dimensional table. This principle defines a class of conditional displays which allows for granular control of graphical appearance aspects, including: \begin{itemize} \item the content of the tiles \item the split direction for each dimension \item the graphical parameters of the tiles' content \item the spacing between the tiles \item the labeling of the tiles \end{itemize} The strucplot framework is highly modularized: Figure~\ref{fig:struc} shows the hierarchical relationship between the various components. On the lowest level, there are several groups of workhorse and parameter functions that directly or indirectly influence the final appearance of the plot (see Table \ref{tab:grapcons} for an overview). These are examples of grapcon functions. They are created by generating functions (\emph{grapcon generators}), allowing flexible parameterization and extensibility (Figure~\ref{fig:struc} only shows the generators). The generator names follow the naming convention \code{\textit{group\_foo}()}, where \code{\textit{group}} reflects the group the generators belong to (strucplot core, labeling, legend, shading, or spacing). The workhorse functions (created by \code{struc\_\textit{foo}()}, \code{labeling\_\textit{foo}()}, and \code{legend\_\textit{foo}()}) directly produce graphical output (i.e., ``add ink to the canvas''), whereas the parameter functions (created by \code{spacing\_\textit{foo}()} and \code{shading\_\textit{foo}()}) compute graphical parameters used by the others. The grapcon functions returned by \code{struc\_\textit{foo}()} implement the core functionality, creating the tiles and their content. On the second level of the framework, a suitable combination of the low-level grapcon functions (or, alternatively, corresponding generating functions) is passed as ``hyperparameters'' to \codefun{strucplot}. This central function sets up the graphical layout using grid viewports (see Figure~\ref{fig:layout}), and coordinates the specified core, labeling, shading, and spacing functions to produce the plot. On the third level, we provide several convenience functions such as \codefun{mosaic}, \codefun{sieve}, \codefun{assoc}, and \codefun{doubledecker} which interface \codefun{strucplot} through sensible parameter defaults and support for model formulae. Finally, on the fourth level, there are ``related'' \pkg{vcd} functions (such as \codefun{cotabplot} and the \codefun{pairs} methods for table objects) arranging collections of plots of the strucplot framework into more complex displays (e.g., by means of panel functions). \begin{table} \begin{tabular}{|l|l|l|} \hline \textbf{Group} & \textbf{Grapcon generator} & \textbf{Description}\\\hline strucplot & \codefun{struc\_assoc} & core function for association plots\\ core & \codefun{struc\_mosaic} & core function for mosaic plots\\ & \codefun{struc\_sieve} & core function for sieve plots\\\hline\hline labeling & \codefun{labeling\_border} & border labels\\ & \codefun{labeling\_cboxed} & centered labels with boxes, all labels clipped,\\ && and on top and left border\\ & \codefun{labeling\_cells} & cell labels\\ & \codefun{labeling\_conditional} & border labels for conditioning variables\\ && and cell labels for conditioned variables\\ & \codefun{labeling\_doubledecker} & draws labels for doubledecker plot\\ & \codefun{labeling\_lboxed} & left-aligned labels with boxes\\ & \codefun{labeling\_left} & left-aligned border labels\\ & \codefun{labeling\_left2} & left-aligned border labels, all labels on top and left border\\ & \codefun{labeling\_list} & draws a list of labels under the plot\\\hline\hline shading & \codefun{shading\_binary} & visualizes the sign of the residuals\\ & \codefun{shading\_Friendly} & implements Friendly shading (based on HSV colors)\\ & \codefun{shading\_hcl} & shading based on HCL colors\\ & \codefun{shading\_hsv} & shading based on HSV colors\\ & \codefun{shading\_max} & shading visualizing the maximum test statistic\\ && (based on HCL colors)\\ & \codefun{shading\_sieve} & implements Friendly shading customized for sieve plots\\ && (based on HCL colors)\\\hline\hline spacing & \codefun{spacing\_conditional} & increasing spacing for conditioning variables,\\&& equal spacing for conditioned variables\\ & \codefun{spacing\_dimequal} & equal spacing for each dimension\\ & \codefun{spacing\_equal} & equal spacing for all dimensions\\ & \codefun{spacing\_highlighting} & increasing spacing, last dimension set to zero\\ & \codefun{spacing\_increase} & increasing spacing\\\hline\hline legend & \codefun{legend\_fixed} & creates a fixed number of bins (similar to \codefun{mosaicplot})\\ & \codefun{legend\_resbased} & suitable for an arbitrary number of bins\\&& (also for continuous shadings)\\\hline \end{tabular} \caption{Available grapcon generators in the strucplot framework} \label{tab:grapcons} \end{table} \begin{figure}[h] \begin{center} \includegraphics[width=0.8\textwidth]{struc} \caption{Components of the strucplot framework.} \label{fig:struc} \end{center} \end{figure} \setkeys{Gin}{width=0.6\textwidth} \begin{figure}[h] \begin{center} <>= pushViewport(vcd:::vcdViewport(legend = T, mar =4)) seekViewport("main") grid.rect(gp = gpar(lwd = 3)) grid.text("main", gp = gpar(fontsize = 20)) seekViewport("sub") grid.rect(gp = gpar(lwd = 3)) grid.text("sub", gp = gpar(fontsize = 20)) seekViewport("plot") grid.rect(gp = gpar(lwd = 3)) grid.text("plot", gp = gpar(fontsize = 20)) seekViewport("legend") grid.text("legend", rot = 90, gp = gpar(fontsize = 20)) grid.rect(gp = gpar(lwd = 3)) seekViewport("legend_sub") grid.rect(gp = gpar(lwd = 3)) grid.text("[F]", gp = gpar(fontsize = 20)) seekViewport("legend_top") grid.rect(gp = gpar(lwd = 3)) grid.text("[E]", gp = gpar(fontsize = 20)) seekViewport("margin_top") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_top", gp = gpar(fontsize = 20)) seekViewport("margin_bottom") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_bottom", gp = gpar(fontsize = 20)) seekViewport("margin_right") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_right", rot = 90, gp = gpar(fontsize = 20)) seekViewport("margin_left") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_left", rot = 90, gp = gpar(fontsize = 20)) seekViewport("corner_top_left") grid.rect(gp = gpar(lwd = 3)) grid.text("[A]", gp = gpar(fontsize = 20)) seekViewport("corner_top_right") grid.rect(gp = gpar(lwd = 3)) grid.text("[B]", gp = gpar(fontsize = 20)) seekViewport("corner_bottom_left") grid.rect(gp = gpar(lwd = 3)) grid.text("[C]", gp = gpar(fontsize = 20)) seekViewport("corner_bottom_right") grid.rect(gp = gpar(lwd = 3)) grid.text("[D]", gp = gpar(fontsize = 20)) @ \caption{Viewport layout for strucplot displays with their names. [A] = ``corner\_top\_left'', [B] = ``corner\_top\_right'', [C] = ``corner\_bottom\_left'', [D] = ``corner\_bottom\_right'', [E] = ``legend\_top'', [F] = ``legend\_sub''.} \label{fig:layout} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \subsection{Mosaic, association, and sieve plots} As an example, consider the \data{HairEyeColor} data containing two polytomous variables (hair and eye color), as well as one (artificial) dichotomous gender variable (\code{Sex}). The ``flattened'' contingency table can be obtained using the \codefun{structable} function (quite similar to \codefun{ftable} in base \proglang{R}, but allowing the specification of split directions): <>= (HEC <- structable(Eye ~ Sex + Hair, data = HairEyeColor)) @ Let us first visualize the contingency table by means of a mosaic plot. % \citep{vcd:Hartigan+Kleiner:1984} which is basically % an area-proportional visualization of (typically, observed) frequencies, composed % of tiles (corresponding to the cells) created by recursive % vertical and horizontal splits of a square. Thus, the area of each tile % is proportional to the corresponding cell entry \emph{given} the % dimensions of previous splits. The effect of <>= mosaic(HEC) @ \noindent equivalent to <>= mosaic(~ Sex + Eye + Hair, data = HairEyeColor) @ %\setkeys{Gin}{width=0.75\textwidth} \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{HairEyeColor} data.} \label{fig:observed} \end{center} \end{figure} \noindent depicts the observed frequencies of the \code{HairEyeColor} data. If there are zero entries, tiles have zero area and are, additionally, marked by small bullets (see, e.g, Figure~\ref{fig:titanic}). By default, these cells are not split further. The bullets help distinguishing very small cells from zero entries, and are particularly useful when color shadings come into play (see the example using the \data{Bundesliga} data in Section \ref{sec:overview}). Note that in contrast to, e.g., \codefun{mosaicplot} in base \proglang{R}, the default split direction and level ordering in all strucplot displays correspond to the textual representation produced by the print methods. It is also possible to visualize the expected values instead of the observed values (see Figure~\ref{fig:expected}): <>= mosaic(HEC, type = "expected") @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{HairEyeColor} data (expected values).} \label{fig:expected} \end{center} \end{figure} %\setkeys{Gin}{width=0.7\textwidth} \noindent In order to compare observed and expected values, a sieve plot \citep{vcd:riedwyl+schuepbach:1994} could be used (see Figure~\ref{fig:sieve}): <>= sieve(~ Sex + Eye + Hair, data = HEC, spacing = spacing_dimequal(c(2,0,0))) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{Sieve plot for the \data{HairEyeColor} data visualizing simultaneously observed and expected values.} \label{fig:sieve} \end{center} \end{figure} \noindent where \code{spacing\_dimequal} is used to set the spacing of the second and third dimension to zero. Alternatively, we can directly inspect the residuals. The Pearson residuals (standardized deviations of observed from expected values) are conveniently visualized using association plots \citep{vcd:Cohen:1980}. In contrast to \codefun{assocplot} in base \proglang{R}, \pkg{vcd}'s \codefun{assoc} function scales to more than two variables (see Figure~\ref{fig:residuals}): <>= assoc(HEC, compress = FALSE) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Association plot for the \data{HairEyeColor} data.} \label{fig:residuals} \end{center} \end{figure} \noindent where the \code{compress} argument keeps distances between tiles equal. For both mosaic plots and association plots, the splitting of the tiles can be controlled using the \code{split\_vertical} argument. The default is to alternate splits starting with a horizontal one (see Figure~\ref{fig:split}): <>= options(width=60) @ <>= mosaic(HEC, split_vertical = c(TRUE, FALSE, TRUE), labeling_args = list(abbreviate = c(Eye = 3))) @ <>= options(width=70) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{HairEyeColor} data---alternative splitting.} \label{fig:split} \end{center} \end{figure} \noindent (Note that \code{HEC}, a \class{structable} object, already includes a splitting information which simply gets overloaded in this example.) For compatibility with \codefun{mosaicplot} in base \proglang{R}, the \codefun{mosaic} function also allows the use of a \code{direction} argument taking a vector of \code{"h"} and \code{"v"} characters: <>= mosaic(HEC, direction = c("v","h","v")) @ By a suitable combination of splitting, spacing, and labeling settings, the functions provided by the strucplot framework can be customized in a quite flexible way. For example, the default method for \codefun{doubledecker} is simply a wrapper for \codefun{strucplot}, setting the right defaults. Most default settings such as colors, spacing, and labeling are specified via the parameters and passed through to \codefun{strucplot}. The additional code just handles the dependent variable information, and in particular permutes the table to have the dependent variable as the last dimension as required for the doubledecker plot. Figure~\ref{fig:titanic} shows a doubledecker plot of the \data{Titanic} data, explaining the probability of survival (``survived'') by age, given sex, given class. It is created by: <>= doubledecker(Titanic) @ \noindent equivalent to: <>= doubledecker(Survived ~ Class + Sex + Age, data = Titanic) @ \subsection{Conditional and partial views} So far, we have visualized either full or collapsed tables, as suggested by the analysis task at hand. Subtables can be selected in a similar way as for objects of class \class{table} using indexing. Note, however, that subsetting of \class{structable} objects is more restrictive because of their inherent conditional structure. Since the variables on both the row and the columns side are nested, subsetting is only possible ``outside-in'', that is, indexing operates on blocks defined by the variable levels. In the following, we use the Titanic data again, this time collapsed over \code{Survived} to investigate the structure of crew and passengers (and having the \code{Child} and \code{Age} labels of the \code{Age} variable swapped for optical clarity): <>= options(width=75) @ <>= (STD <- structable(~ Sex + Class + Age, data = Titanic[,,2:1,])) STD["Male",] STD["Male", c("1st","2nd","3rd")] @ <>= options(width=70) @ \noindent \emph{Conditioning} on levels (i.e., choosing a table subset for fixed levels of the conditioning variable(s)) is done using the \code{[[} operator. %]] Here again, the sequence of conditioning levels is restricted by the hierarchical structure of the \class{structable} object. In the following examples, note that compared to subsetting, the first dimension(s) are dropped: <>= STD[["Male",]] STD[[c("Male", "Adult"),]] STD[["Male","1st"]] @ \noindent Now, there are several ways for visualizing conditional independence structures. The ``brute force'' method is to draw separate plots for the strata. The following example compares the association between hair and eye color, given gender, by using subsetting on the flat table and \pkg{grid}'s viewport framework to visualize the two groups besides each other: <>= pushViewport(viewport(layout = grid.layout(ncol = 2))) @ <>= pushViewport(viewport(layout.pos.col = 1)) mosaic(STD[["Male"]], margins = c(left = 2.5, top = 2.5, 0), sub = "Male", newpage = FALSE) popViewport() @ <>= pushViewport(viewport(layout.pos.col = 2)) mosaic(STD[["Female"]], margins = c(top = 2.5, 0), sub = "Female", newpage = FALSE) popViewport(2) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= <> <> <> @ \caption{Two mosaic displays put side-by-side, visualizing the distribution of class and age, given gender. The marginal distribution of gender cannot be seen.} \label{fig:parttable} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \noindent Note the use of the \code{margins} argument: it takes a vector with up to four values whose unnamed components are recycled, but ``overruled'' by the named arguments. Thus, in the second example, only the top margin is set to 2.5 lines, and all other to 0. This idea applies to almost all vectorized arguments in the strucplot framework (with \code{split\_vertical} as a prominent exception). The \codefun{cotabplot} function does a much better job on this task: it arranges stratified strucplot displays in a lattice-like layout, conditioning on variable \emph{levels}. The plot in Figure~\ref{fig:cotabplot} shows class and age group, given sex: <>= cotabplot(~ Class + Age | Sex, data = STD, split_vertical = TRUE) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= <> @ \caption{Conditional table plot for the \data{Titanic} data, again visualizing the distribution of age and class, given gender, using separate mosaic displays like the ``manual'' plot in Figure~\ref{fig:parttable}.} \label{fig:cotabplot} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} %\noindent The \code{labeling\_args} argument modifies the labels' %appearance: here, to be left-aligned and unclipped %(see Section \ref{sec:labeling}). \noindent Visualizing the strata separately ``hides'' the distribution of the conditioning variable(s) which may or may not be appropriate or sensible in a particular analysis step. If we wish to keep the information on the marginal distribution(s), we can use one single mosaic for the stratified plot since mosaic displays are ``conditional plots'' by definition. We just need to make sure that conditioning variables are used first for splitting. Both the default and the formula interface of \codefun{mosaic} allow the specification of conditioning variables (see Figure~\ref{fig:conditioning}): <>= mosaic(STD, condvars = "Sex", split_vertical = c(TRUE, TRUE, FALSE)) @ <>= mosaic(~ Class + Age | Sex, data = STD, split_vertical = c(TRUE, TRUE, FALSE)) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[h] \begin{center} <>= <> @ \caption{Mosaic plot again visualizing the distribution of class and age, given gender, this time using a single mosaic plot. In contrast to Figures~\ref{fig:parttable} and \ref{fig:cotabplot}, this plot also visualizes the marginal distribution of gender.} \label{fig:conditioning} \end{center} \end{figure} \setkeys{Gin}{width=0.7} \noindent The effect of using this is that conditioning variables are permuted ahead of the the conditioned variables in the table, and that \codefun{spacing\_conditional} is used as default to better distinguish conditioning from conditioned dimensions. This spacing uses equal space between tiles of conditioned variables, and increasing space between tiles of conditioning variables (See Section~\ref{sec:spacing}). Another set of high-level functions for visualizing conditional independence models are the \codefun{pairs} methods for \class{table} and \class{structable} objects. In contrast to \codefun{cotabplot} which conditions on variables, the \codefun{pairs} methods create pairwise views of the table. They produce, by default, a plot matrix having strucplot displays in the off-diagonal panels, and the variable names (optionally, with univariate displays) in the diagonal cells. Figure~\ref{fig:pairs} shows a pairs display for the \data{Titanic} data with univariate mosaics in the diagonal, and mosaic plots visualizing the corresponding bivariate mosaics in the upper and lower triangles. Due to the inherent asymmetry of mosaic displays, the corresponding plots in the upper and lower triangle differ depending on which variable is used first for splitting---inspecting both views might help detecting patterns in a data set. Additionally, we are using a special spacing and shading normally used to `highlight' %' the second variable in the first (as will be discussed in Section \ref{sec:spacing}): here, the intention of the spacing is to emphasize the conditional distributions of the second variable, given the first one, and the shading helps identifying the factor levels in the second variable. <>= pairs(STD, highlighting = 2, diag_panel = pairs_diagonal_mosaic, diag_panel_args = list(fill = grey.colors)) @ %\setkeys{Gin}{width=\textwidth} \setkeys{Gin}{width=0.7\textwidth} \begin{figure}[h] \begin{center} <>= <> @ \caption{Pairs plot for the \data{Titanic} data.} \label{fig:pairs} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \noindent The labels of the variables are to be read from left to right and from top to bottom. In addition, the levels can be matched by position within the columns and by shading within the rows. In plots produced by \codefun{pairs}, each panel's row and column define two variables $X$ and $Y$ used for the specification of four different types of independence: pairwise, total, conditional, and joint. The pairwise mosaic matrix shows bivariate marginal relations between $X$ and $Y$, collapsed over all other variables. The total independence mosaic matrix shows mosaic plots for mutual independence, i.e., for marginal and conditional independence among all pairs of variables. The conditional independence mosaic matrix shows mosaic plots for marginal independence of $X$ and $Y$, given all other variables. The joint independence mosaic matrix shows mosaic plots for joint independence of all pairs ($X$, $Y$) of variables from the others. Upper and lower parts can independently be used to display different types of independence models, or different strucplot displays (mosaic, association, or sieve plots). The available panel functions (\codefun{pairs\_assoc}, \codefun{pairs\_mosaic}, and \codefun{pairs\_sieve}) are simple wrappers to \codefun{assoc}, \codefun{mosaic}, and \codefun{sieve}, respectively. Obviously, seeing patterns in strucplot matrices becomes increasingly difficult with higher dimensionality. Therefore, this plot is typically used with a suitable residual-based shading (see Section \ref{sec:shading}). \subsection{Interactive plot modifications} All strucplot core functions are supposed to produce conditional hierarchical plots by the means of nested viewports, corresponding to the provided splitting information. Thus, at the end of the plotting, each tile is associated with a particular viewport. Each of those viewports has to be conventionally named, enabling other strucplot modules, in particular the labeling functions, to access specific tiles after they have been plotted. The naming convention for the viewports is: \begin{center} \code{\emph{[Optional prefix]}cell:\emph{Variable1}=\emph{Level1},\emph{Variable2}=\emph{Level2}} \dots \end{center} \noindent Clearly, these names depend on the splitting. The following example shows how to access parts of the plot after it has been drawn (see Figure~\ref{fig:afterplot}): <>= mosaic(~ Hair + Eye, data = HEC, pop = FALSE) seekViewport("cell:Hair=Blond") grid.rect(gp = gpar(col = "red", lwd = 4)) seekViewport("cell:Hair=Blond,Eye=Blue") grid.circle(r = 0.2, gp = gpar(fill = "cyan")) @ \noindent Note that the viewport tree is removed by default. Therefore, the \texttt{pop} argument has to be set to \texttt{FALSE} when viewports shall be accessed. \setkeys{Gin}{width=0.6\textwidth} \begin{figure}[h] \begin{center} <>= <> @ \caption{Adding elements to a mosaic plot after drawing.} \label{fig:afterplot} \end{center} \end{figure} In addition to the viewports, the main graphical elements get names following a similar construction method. This allows to change graphical parameters of plot elements \emph{after} the plotting (see Figure~\ref{fig:changeplot}): <>= assoc(Eye ~ Hair, data = HEC, pop = FALSE) getNames()[1:6] grid.edit("rect:Hair=Blond,Eye=Blue", gp = gpar(fill = "red")) @ %% code-chunk reuse does not work with parameter changing \begin{figure}[h] \begin{center} <>= x <- tab <- margin.table(HairEyeColor, 1:2) x[] <- "light gray" x["Blond","Blue"] <- "Red" assoc(tab, gp = gpar(fill = x)) @ \caption{Changing graphical parameters of elements after drawing.} \label{fig:changeplot} \end{center} \end{figure} \subsection{Performance issues} \label{sec:performance} As stated above, the implementation of strucplot displays is based on creating and nesting \pkg{grid} viewports. The main time-consuming steps performed by the core functions are the following: \begin{enumerate} \item recursively, split the table until the individual cells are reached \item during the splits, add viewports to the plot \item for the individual cells, add plot-specific content (rectangles for mosaics, bars for association plots, etc.) \end{enumerate} \noindent All these operations scale linearly with the amount of created viewports. For a $d$-dimensional table with $k_i$ levels, $i=1 \dots d$, the total number of needed viewports $T_d$ can roughly be estimated as \begin{equation} \label{eq:numbervp} T_d \quad = \quad k_1 + k_1k_2 + \cdots + k_1 \cdots k_d \quad =\quad \sum_{i=1}^d \prod_{j \le i} k_j \end{equation} \noindent since we first push the $k_1$ viewports for the levels of the first dimension, then, for \emph{each} of these, the $k_2$ levels of the second dimension, etc. If the number of levels is equal ($k$) for all dimensions, $T_d$ simplifies to \begin{equation} \label{eq:equalvp} T_d \quad = \quad \sum_{i=1}^d k^i = \frac{k(k^d-1)}{k-1} \end{equation} \noindent and so the time complexity for drawing a strucplot display is of order $k^d$. \section{Shadings} \label{sec:shading} Unlike other graphics functions in base \proglang{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 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:shadingcustom}). We provide several shading functions, including support for both HSV and HCL colors, and the visualization of significance tests (see Section \ref{sec:overview}). \subsection{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 <- 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} <>= <> @ \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 (transparent). 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}): <>= 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 Section \ref{sec:labeling}). \begin{figure}[h] \begin{center} <>= <> @ \caption{Recycling of parameters, used for highlighting the survived passengers in the \data{Titanic} data.} \label{fig:recycling} \end{center} \end{figure} \subsection{Customizing residual-based shadings} \label{sec:shadingcustom} 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 frequencies 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 \citep{vcd:Meyer+Zeileis+Hornik:2003,vcd:Zeileis+Meyer+Hornik:2005}, even allows to identify the 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 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 \code{royalblue4} color for positive and \code{mediumorchid4} color for negative residuals (see Figure~\ref{fig:binary}): <>= expected <- independence_table(ucb) (x <- (ucb - expected) / sqrt(expected)) (shading1_obj <- ifelse(x > 0, "royalblue4", "mediumorchid4")) mosaic(ucb, gp = gpar(fill = shading1_obj)) @ \begin{figure}[h] \begin{center} <>= <> @ \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_fun <- function(x) gpar(fill = ifelse(x > 0, "royalblue4", "mediumorchid4")) @ \noindent To create a mosaic display with binary shading, it now suffices to specify the data table along with \codefun{shading2\_fun}: <>= 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("royalblue4", "mediumorchid4")} 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 \proglang{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: <>= shading3a_fun <- function(col = c("royalblue4", "mediumorchid4")) { col <- rep(col, length.out = 2) function(x) gpar(fill = ifelse(x > 0, col[1], col[2])) } @ \noindent The first statement just makes sure that exactly two colors are specified. In the call to \codefun{mosaic}, using the new \codefun{shading3a\_fun} function, we can now simply change the colors: <>= mosaic(ucb, gp = shading3a_fun(c("royalblue4","mediumorchid4"))) @ \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): <>= shading3b_fun <- function(observed = NULL, residuals = NULL, expected = NULL, df = NULL, col = c("royalblue4", "mediumorchid4")) { col <- rep(col, length.out = 2) function(x) gpar(fill = ifelse(x > 0, col[1], col[2])) } class(shading3b_fun) <- "grapcon_generator" @ Note that in this simple binary shading example, the first four parameters are not used. 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: <>= 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. \subsection[An overview of the shading functions in vcd]{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 HSV space, and then briefly explain the differences to HCL space \citep[a detailed discussion can be found in][]{vcd:Zeileis+Meyer+Hornik:2005}. Color palettes in HCL space are preferable to palettes derived from HSV space from a perceptual point of view. Functions for creating palettes (see, e.g., \codefun{diverge\_hcl}) are provided with the \pkg{vcd} package. In 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}, top): <>= haireye <- margin.table(HairEyeColor, 1:2) mosaic(haireye, gp = shading_hsv) @ \noindent As introduced before, the default shading scheme is not \codefun{shading\_hsv} but \codefun{shading\_hcl} due to the better perceptual characteristics of HCL color space. The following example again illustrates the \data{HairEyeColor} data, this time with HCL colors: <>= mosaic(haireye, gp = shading_hcl) @ <>= mosaic(haireye, gp = shading_hcl, gp_args = list(h = c(130, 43), c = 100, l = c(90, 70))) @ \noindent In Figure~\ref{fig:haireye}, the plot in the middle depicts the default palette, and the bottom plot an alternative setting for Hue (\code{h}), Chroma (\code{c}), and Luminance (\code{l}). \setkeys{Gin}{width=0.5\textwidth} \begin{figure}[htbp] \begin{center} <>= mosaic(haireye, gp = shading_hsv, margin = c(bottom = 1), keep_aspect_ratio = FALSE) @ <>= mosaic(haireye, gp = shading_hcl, margin = c(bottom = 1), keep_aspect_ratio = FALSE) @ <>= mosaic(haireye, gp = shading_hcl, margin = c(bottom = 1), gp_args = list(h = c(130, 43), c = 100, l = c(90, 70)), keep_aspect_ratio = FALSE) @ \caption{Three mosaic plots for the \data{HairEyeColor} data using different color palettes. Top: default HSV color palette. Middle: default HCL color palette. Bottom: a custom HCL color palette.} \label{fig:haireye} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \noindent Large positive residuals (greater than $4$) can be found for brown eyes/black hair and blue eyes/blond hair, and are colored in deep 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 (gray for HCL-shading). 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:interpolatecontinuous}): <>= mosaic(haireye, shade = TRUE, gp_args = list(interpolate = 1:4)) @ \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: <>= 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:interpolatecontinuous}, right) is deceiving: <>= mosaic(haireye, shade = TRUE, gp_args = list(interpolate = ipol), labeling_args = list(abbreviate = c(Sex = TRUE))) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[htbp] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2))) pushViewport(viewport(layout.pos.col = 1)) mosaic(haireye, gp_args = list(interpolate = 1:4), margin = c(right = 1), keep_aspect_ratio= FALSE,newpage = FALSE,legend_width=5.5,shade = TRUE) popViewport(1) pushViewport(viewport(layout.pos.col = 2)) mosaic(haireye, gp_args = list(interpolate = ipol), margin = c(left=3,right = 1), keep_aspect_ratio = FALSE, newpage = FALSE, shade = TRUE) popViewport(2) @ \caption{\label{fig:interpolatecontinuous}The \data{HairEyeColor} data. Left: shading with 4 cut-off points. Right: continuous shading.} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \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}, left): <>= BL <- xtabs(~ HomeGoals + AwayGoals, data = Bundesliga, subset = Year == 1995) mosaic(BL, shade = TRUE) @ \noindent Note that in extended mosaic plots, bullets drawn for zero cells are shaded, too, bringing out non-zero residuals, if any. 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:bundesliga}, right): <>= mosaic(BL, gp = shading_Friendly, legend = legend_fixed, zero_size = 0) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[htbp] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2))) pushViewport(viewport(layout.pos.col = 1)) mosaic(BL, margin = c(right = 1), keep_aspect_ratio= FALSE, newpage = FALSE, legend_width=5.5, shade = TRUE) popViewport(1) pushViewport(viewport(layout.pos.col = 2)) mosaic(BL, gp = shading_Friendly, legend = legend_fixed, zero_size = 0, margin = c(right = 1), keep_aspect_ratio= FALSE, newpage = FALSE, legend_width=5.5) popViewport(2) @ \caption{The \data{Bundesliga} data for 1995. Left: Non-significant $\chi^2$ test. Right: using the Friendly shading and a legend with fixed bins.} \label{fig:bundesliga} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \noindent (The \code{zero\_size = 0} argument removes the bullets indicating zero observed values. This feature is not provided in the original \proglang{SAS} implementation of the Friendly mosaic plots.) % Figure~\ref{fig:shadingHSVHCL} depicts % HSV space in the upper panel and 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 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 HSV space all dimensions are confounded, which % obviously is problematic for coding information. In contrast, 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. % <>= % 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} % <>= % ## 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) % @ % <>= % ## 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} 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,vcd:Zeileis+Meyer+Hornik:2005}. 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}): <>= set.seed(4711) mosaic(~ Treatment + Improved, data = Arthritis, subset = Sex == "Female", gp = shading_max) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{The \data{Arthritis} data (female patients) with significant maximum test.} \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. \clearpage \section[Labeling]{Labeling} \label{sec:labeling} One of the major enhancements in package \pkg{vcd} compared to \codefun{mosaicplot} and \codefun{assocplot} in base \proglang{R} is the labeling in the strucplot framework which offers more features and greater flexibility. Like shading, spacing, and drawing of legend and core plot, labeling is now carried out by grapcon functions, rendering labeling completely modular. The user supplies either a labeling function, or, alternatively, a generating function that parameterizes a labeling function, to \codefun{strucplot} which then draws the labels. Labeling is well-separated from the actual plotting that occurs in the low-level core functions. It only relies on the viewport tree produced by them, and the \code{dimnames} attribute of the visualized table. Labeling functions are grapcons that ``add ink to the canvas'': the drawing of the labels happens after the actual plot has been drawn by the core function. Thus, it is possible to supply one's own labeling function, or to combine some of the basic functions to produce a more complex labeling. In the following, we describe the three basic modules (\codefun{labeling\_text}, \codefun{labeling\_list}, and \codefun{labeling\_cells}) and derived functions that build upon them. \subsection[Labels in the borders]{Labels in the borders: \texttt{labeling\_text()}} \codefun{labeling\_text} is the default for all strucplot displays. It plots labels in the borders similar to the \codefun{mosaicplot} function in base \proglang{R}, but is much more flexible: it is not limited to 4 dimensions, and the positioning and graphical parameters of levels and variable names are customizable. In addition, the problem of overlapping labels can be handled in several ways. As an example, again consider the \data{Titanic} data: by default, the variable names and levels are plotted ``around'' the plot in a counter-clockwise way (see Figure~\ref{fig:labels1}, top left): <>= mosaic(Titanic) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{Mosaic plot for the \data{Titanic} data with default settings % for labeling.} % \label{fig:defaults} % \end{center} % \end{figure} \noindent Note that the last two levels of the \code{survived} variable do overlap, as well as some adult and child labels of the \code{age} Variable. This issue can be addressed in several ways. The ``brute force'' method is to enable clipping for these dimensions (see Figure~\ref{fig:labels1}, top right): <>= mosaic(Titanic, labeling_args = list(clip = c(Survived = TRUE, Age = TRUE))) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{The effect of clipping.} % \label{fig:clipping} % \end{center} % \end{figure} \noindent The \code{clip} parameter is passed to the labeling function via the \code{labeling\_args} argument which takes a list of parameters. \code{clip} itself takes a vector of logicals (one for each dimension). % as mentioned before Almost all vectorized arguments in the strucplot framework can be abbreviated in the following way: unnamed components (or the defaults, if there are none) are recycled as needed, but overridden by the named components. Here, the default is \code{FALSE}, and therefore clipping is enabled only for the \code{survived} and \code{age} variables. A more sensible solution to the overlap problem is to abbreviate the levels (see Figure~\ref{fig:labels1}, middle left): <>= mosaic(Titanic, labeling_args = list(abbreviate = c(Survived = TRUE, Age = 3))) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Abbreviating.} % \label{fig:abbreviating} % \end{center} % \end{figure} \noindent The \code{abbreviate} argument takes a vector of integers indicating the number of significant characters the levels should be abbreviated to (\code{TRUE} is interpreted as 1, obviously). Abbreviation is performed using the \codefun{abbreviate} function in base \proglang{R}. Another possibility is to rotate the levels (see Figure~\ref{fig:labels1}, bottom): <>= mosaic(Titanic, labeling_args = list(rot_labels = c(bottom = 90, right = 0), offset_varnames = c(right = 1), offset_labels = c(right = 0.3)), margins = c(right = 4, bottom = 3)) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{Rotating labels.} % \label{fig:rotating} % \end{center} % \end{figure} \noindent Finally, we could also inhibit the output of repeated levels (see Figure~\ref{fig:labels1}, middle right): <>= mosaic(Titanic, labeling_args = list(rep = c(Survived = FALSE, Age = FALSE))) @ \setkeys{Gin}{width=0.9\textwidth} \begin{figure}[p] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2,nrow=3))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(Titanic, newpage = FALSE, keep = TRUE, margin = c(right = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(Titanic, labeling_args = list(clip = c(Survived = TRUE, Age = TRUE)), newpage = FALSE, keep = TRUE, margin = c(left = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(abbreviate = c(Survived = TRUE, Age = 2)), newpage = FALSE, keep = TRUE, margin = c(right = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(rep = c(Survived = FALSE, Age = FALSE)), newpage = FALSE, keep = TRUE, margin = c(left = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 1:2, layout.pos.row = 3)) pushViewport(viewport(width = 0.55)) mosaic(Titanic, labeling_args = list(rot_labels = c(bottom = 90, right = 0), offset_varnames = c(right = 1), offset_labels = c(right = 0.3)), margins = c(right = 4, bottom = 3), newpage = FALSE, keep = FALSE, gp_labels = gpar(fontsize = 10)) popViewport(3) @ \caption{Examples for possible labeling strategies for the Titanic data mosaic. Top left: default labeling (many labels overlap). Top right: with clipping turned on. Middle left: \texttt{Age} and \texttt{Survived} labels abbreviated. Middle right: \texttt{Age} labels not repeated. Bottom: \texttt{Age} and \texttt{Survived} labels rotated.} \label{fig:labels1} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} We now proceed with a few more ``cosmetic'' features (which do not all produce satisfactory results for our sample data). A first simple, but effectful modification is to position all labels and variables left-aligned (see Figure~\ref{fig:labels2}, top left): <>= mosaic(Titanic, labeling_args = list(pos_varnames = "left", pos_labels = "left", just_labels = "left", rep = FALSE)) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Left-aligning.} % \label{fig:left} % \end{center} % \end{figure} \noindent Note that obviously we need to change the justification to \code{"left"} as well. We can achieve the same effect by using the convenience function \codefun{labeling\_left}: <>= mosaic(Titanic, labeling = labeling_left) @ \noindent Next, we show how to put all levels to the bottom and right margins, and all variable names to the top and left margins (see Figure~\ref{fig:labels2}, top right): <>= mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, abbreviate = c(Survived = 1, Age = 3))) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{Changes in the margins.} % \label{fig:margins} % \end{center} % \end{figure} \noindent The tl\_\var{foo} (``top left'') arguments are \code{TRUE} by default. Now, we will add boxes to the labels and additionally enable clipping (see Figure~\ref{fig:labels2}, bottom left): <>= mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, boxes = TRUE, clip = TRUE)) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{Boxes and Clipping.} % \label{fig:boxes} % \end{center} % \end{figure} \noindent The values to \code{boxes} and \code{clip} are recycled for all dimensions. The result is pretty close to what calling \codefun{mosaic} with the \codefun{labeling\_cboxed} wrapper does, except that variables and levels, by default, are put to the top and to the left of the plot: <>= mosaic(Titanic, labeling = labeling_cboxed) @ \noindent Another variant is to put the variable names into the same line as the levels (see Figure~\ref{fig:labels2}, bottom right---clipping for \code{Survived} and \code{Age} is, additionally, disabled, and \code{Age} abbreviated): <>= mosaic(Titanic, labeling_args = list(tl_labels = TRUE, boxes = TRUE, clip = c(Survived = FALSE, Age = FALSE, TRUE), abbreviate = c(Age = 4), labbl_varnames = TRUE), margins = c(left = 4, right = 1, 3)) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Variable names beneath levels, and clipping disabled for the % survival variable.} % \label{fig:labbl} % \end{center} % \end{figure} \noindent \code{labbl\_varnames} (``variable names to the bottom/left of the labels'') is a vector of logicals indicating the side for the variable names. The resulting layout is close to what \codefun{labeling\_lboxed} produces, except that variables and levels, by default, are left-aligned and put to the bottom and to the right of the plot: <>= mosaic(Titanic, labeling = labeling_lboxed, margins = c(right = 4, left = 1, 3)) @ \noindent A similar design is used by the \codefun{doubledecker} function. \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2, nrow = 2))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(Titanic, labeling_args = list(pos_varnames = "left", pos_labels = "left", just_labels = "left", rep = FALSE), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 12)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, abbreviate = c(Survived = 1, Age = 3)), newpage = FALSE, keep = TRUE, margins = c(left = 4, right = 1, 3), gp_labels = gpar(fontsize = 12)) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, boxes = TRUE, clip = TRUE), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 12)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(tl_labels = TRUE, boxes = TRUE, clip = c(Survived = FALSE, Age = FALSE, TRUE), labbl_varnames = TRUE, abbreviate = c(Age = 4)), margins = c(left = 4, right = 1, 3), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 12)) popViewport(2) @ \caption{Advanced strategies for labeling of the Titanic data. Top left: left aligning of both variable names and labels. Top right: changes in the margins (all variable names are in the top and left margins, and all labels in the bottom and right margins). Bottom left: clipping turned on, and boxes used. Bottom right: variable names beneath levels, clipping disabled for the survival and age variables, and \texttt{Age} abbreviated.} \label{fig:labels2} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \subsection[Labels in the cells]{Labels in the cells: \texttt{labeling\_cells()}} This labeling draws both variable names and levels in the cells. As an example, we use the \data{PreSex} data on pre- and extramarital sex and divorce (see Figure~\ref{fig:labels3}, top left): <>= mosaic(~ MaritalStatus + Gender, data = PreSex, labeling = labeling_cells) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Cell labeling for the \data{PreSex} data.} % \label{fig:cell} % \end{center} % \end{figure} \noindent In the case of narrow cells, it might be useful to abbreviate labels and/or variable names and turn off clipping (see Figure~\ref{fig:labels3}, top right): <>= mosaic(~ PremaritalSex + ExtramaritalSex, data = PreSex, labeling = labeling_cells(abbreviate_labels = TRUE, abbreviate_varnames = TRUE, clip = FALSE)) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Cell labeling for the \data{PreSex} data, labels abbreviated.} % \label{fig:cell2} % \end{center} % \end{figure} \noindent For some data, it might be convenient to combine cell labeling with border labeling as done by \codefun{labels\_conditional} (see Figure~\ref{fig:labels3}, bottom left): <>= mosaic(~ PremaritalSex + ExtramaritalSex | MaritalStatus + Gender, data = PreSex, labeling = labeling_conditional(abbreviate_varnames = TRUE, abbreviate_labels = TRUE, clip = FALSE, gp_text = gpar(col = "red"))) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Conditional labeling for the \data{PreSex} data, labels (in % red for clarity) abbreviated.} % \label{fig:conditional} % \end{center} % \end{figure} \noindent Additionally, the cell labeling allows the user to add arbitrary text to the cells by supplying a character array in the same shape as the data array to the \code{text} argument (cells with missing values are ignored). In the following example using the \code{Titanic} data, this is used to add all observed values greater than 5 to the cells after the mosaic has been plotted (see Figure~\ref{fig:labels3}, bottom right): <>= mosaic(Titanic, labeling_args = list(abbreviate = c(Survived = 1, Age = 4)), pop = FALSE) tab <- ifelse(Titanic < 6, NA, Titanic) labeling_cells(text = tab, clip = FALSE)(Titanic) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{User-supplied text (observed frequencies exceeding 5) % added to a mosaic display of the \data{Titanic} data.} % \label{fig:text} % \end{center} % \end{figure} \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= grid.newpage() pushViewport(viewport(layout = grid.layout(ncol = 2, nrow = 2))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(~ MaritalStatus + Gender, data = PreSex, labeling = labeling_cells, newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(~ PremaritalSex + ExtramaritalSex, data = PreSex, labeling = labeling_cells(abbreviate_labels = TRUE, abbreviate_varnames = TRUE, clip = FALSE), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(~ PremaritalSex + ExtramaritalSex | MaritalStatus + Gender, data = PreSex, labeling = labeling_conditional(abbreviate_varnames = TRUE, abbreviate_labels = TRUE, clip = FALSE, gp_text = gpar(col = "red")), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(abbreviate = c(Survived = 1, Age = 3)), pop = FALSE, newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) tab <- ifelse(Titanic < 6, NA, Titanic) labeling_cells(text = tab, clip = FALSE)(Titanic) @ \caption{Cell labeling. Top left: default labeling using the \data{PreSex} data. Top right: abbreviated labels. Bottom left: conditional labeling (labels abbreviated and in red for clarity). Bottom right: user-supplied text (observed frequencies exceeding 5) added to a mosaic display of the \data{Titanic} data. Note that clipping is on by default (top left), and has explicitly been turned off for the three other plots.} \label{fig:labels3} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \subsection[A simple list of labels]{A simple list of labels: \texttt{labeling\_list()}} If problems with overlapping labels cannot satisfactorily resolved, the last remedy could be to simply list the levels below the plot (see Figure~\ref{fig:list}): <>= mosaic(Titanic, labeling = labeling_list, margins = c(bottom = 5)) @ \setkeys{Gin}{width=0.7\textwidth} \begin{figure}[p] \begin{center} <>= mosaic(Titanic, labeling = labeling_list, margins = c(bottom = 5), keep = TRUE) @ \caption{Labels indicated below the plot.} \label{fig:list} \end{center} \end{figure} \noindent The number of columns can be specified. \section{Spacing} \label{sec:spacing} Spacing of strucplot displays is customizable in a similar way than shading. The \code{spacing} argument of the \codefun{strucplot} function takes a list of \class{unit} vectors, one for each dimension, specifying the space between the tiles corresponding to the levels. Consider again the introductory example of the \data{Arthritis} data (Figure~\ref{fig:arthritis}). Since we are interested in the effect of the medicament in the placebo and treatment groups, a mosaic plot is certainly appropriate to visualize the three levels of \code{Improved} in the two \code{Treatment} strata. Another conceptual approach is to use spine plots with highlighting \citep{vcd:hummel:1996}. A spine plot is a variation of a bar plot where the heights of the bars are held constant, whereas the widths are used to represent the number of cases in each category. This is equivalent to a mosaic plot for a one-way table. If a second (indicator) variable is highlighted in a spine plot, we obtain a display equivalent to a simple mosaic display for a two-way table, except that no space between the levels of the highlighted variable is used. In the \data{Arthritis} example, we will highlight patients with \code{Marked} improvement in both groups. To obtain such a display within the strucplot framework, it suffices to set the space between the \code{Improved} tiles to 0 (see Figure~\ref{fig:artspine}): <>= (art <- structable(~Treatment + Improved, data = Arthritis, split_vertical = TRUE)) (my_spacing <- list(unit(0.5, "lines"), unit(c(0, 0), "lines"))) my_colors <- c("lightgray", "lightgray", "black") mosaic(art, spacing = my_spacing, gp = gpar(fill = my_colors, col = my_colors)) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Spine plot for the \data{Arthritis} data using the strucplot framework.} \label{fig:artspine} \end{center} \end{figure} \noindent Note that the default and formula methods for \codefun{mosaic} provide a convenience interface for highlighting. A similar plot (with slightly different shading) than the previous one can be obtained using: <>= mosaic(Improved ~ Treatment, data = Arthritis, split_vertical = TRUE) @ \noindent The strucplot framework also provides a set of spacing grapcon generators which compute suitable spacing objects for typical applications. The simplest spacing is \codefun{spacing\_equal} that uses the same space between all tiles (see Figure~\ref{fig:spacing}, top left): <>= mosaic(art, spacing = spacing_equal(unit(2, "lines"))) @ \noindent \codefun{spacing\_equal} is the default grapcon generator for two-dimensional tables. Slightly more flexible is \codefun{spacing\_dimequal} that allows an individual setting for each dimension (see Figure~\ref{fig:spacing}, top right): <>= mosaic(art, spacing = spacing_dimequal(unit(1:2, "lines"))) @ \noindent The default for multi-way contingency tables is \codefun{spacing\_increase} which uses increasing spaces for the dimensions. The user can specify a start value and the increase factor (see Figure~\ref{fig:spacing}, bottom left): <>= mosaic(art, spacing = spacing_increase(start = unit(0.5, "lines"), rate = 1.5)) @ \noindent For the arthritis example above, we could as well have used \codefun{spacing\_highlighting} which is similar to \codefun{spacing\_increase} but sets the spacing in the last splitting dimension to 0 (see Figure~\ref{fig:spacing}, bottom right): <>= mosaic(art, spacing = spacing_highlighting, gp = my_colors) @ \noindent Finally, \codefun{spacing\_conditional} can be used for visualizing conditional independence: it combines \codefun{spacing\_equal} (for the conditioned dimensions) and \codefun{spacing\_increase} (for the conditioning dimensions). As an example, consider Figure~\ref{fig:presex}: the spacing clearly allows to better distinguish the conditioning variables (\code{Gender} and \code{MaritalStatus}) from the conditioned variables (\code{PremaritalSex} and \code{ExtramaritalSex}). This spacing is the default when conditional variables are specified for a strucplot display (see Section \ref{sec:strucplot}). \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2, nrow = 2))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(art, spacing = spacing_equal(unit(2, "lines")), keep = TRUE, newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(art, spacing = spacing_dimequal(unit(c(0.5, 2), "lines")), keep = TRUE, newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(art, spacing = spacing_increase(start = unit(0.3, "lines"), rate = 2.5), keep = TRUE, newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(art, spacing = spacing_highlighting, keep = TRUE, newpage = FALSE) popViewport(2) @ \caption{Varying spacing for the Arthritis data. Top left: equal spacing for all dimensions. Top right: different spacings for individial dimensions. Bottom left: increasing spacing. Bottom right: spacing used for highlighting.} \label{fig:spacing} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \section{Example: Ovarian cancer survival} \label{sec:example} In the following, we demonstrate some of the described techniques in analyzing a data set originating from \citep{vcd:obel:1975} \cite[taken from][]{vcd:andersen:1991} about a retrospective study of ovary cancer carried out in 1973. Information was obtained from 299 women, who were operated for ovary cancer 10 years before. The data consists of four binary variables: the \code{stage} of the cancer at the time of operation (levels: \code{early}, \code{advanced}), the type of \code{operation} performed (\code{radical}, \code{limited}), the \code{survival} status after 10 years (\code{yes}, \code{no}), and \code{xray} indicating whether X-ray treatment was received (\code{yes}, \code{no}). The dataset in \pkg{vcd} comes pretabulated in a data frame, so we first create the four-way table: <>= tab <- xtabs(Freq ~ stage + operation + xray + survival, data = OvaryCancer) @ \noindent A ``flattened'' textual representation can be obtained using \codefun{structable}: <>= structable(survival ~ ., data = tab) @ \noindent A first overview can be obtained using a pairs plot (Figure~\ref{fig:ocpairs}): <>= dpa <- list(var_offset = 1.2, rot = -30, just_leveltext= "left") pairs(tab, diag_panel_args = dpa) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{Pairs plot for the \data{OvaryCancer} data showing mosaic displays for all pairwise distributions and bar plots for all marginal distributions.} \label{fig:ocpairs} \end{center} \end{figure} \noindent The pairs plot, by default, creates mosaic displays for all pairwise variable combinations, and bar plots in the diagonal to visualize the absolute frequencies of the variables. The \texttt{var\_offset} argument modifies the offset of the (centered) variable names to avoid overlap with the bars. Additionally, we use the \texttt{rot} and the \texttt{just\_leveltext} arguments to rotate the level names, again to avoid their overlap. First, we consider the marginal distributions. The study design involved (nearly) the same number of survived (150) and deceased (149) patients. Similarly balanced, 158 cases were in an advanced and 141 in an early stage. Most patients (251, 84\%) were treated with a radical operation, and 186 (62\%) were submitted to X-ray treatment. Next, we inspect the two-way interaction of the influencing factors (\code{stage}, \code{operation}, and \code{xray}): the corresponding mosaics exhibit symmetric, regular shapes with aligned tiles, which indicate no marginal interaction between these variables. The same is true for the interactions of \code{survival} with \code{operation} and \code{xray}, respectively. Only the stage seems to influence survival: here, the tiles are ``shifted''. A different view on the data, focused on the influence of the explanatory variables on \code{Survival}, can be obtained using a doubledecker plot (Figure~\ref{fig:ocdoubledecker}): <>= doubledecker(survival ~ stage + operation + xray, data = tab) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{Doubledecker plot for the \data{OvaryCancer} data showing the conditional distribution of X-ray, given operation, given stage, and with survival highlighted.} \label{fig:ocdoubledecker} \end{center} \end{figure} \noindent From a technical point of view, the display is constructed as a mosaic plot showing the conditional distribution of \code{survival}, given \code{xray}, given \code{operation}, given \code{stage}, with vertical splits for the conditioning variables and horizontal ones for \code{survival}. Additionally, there is zero space between the tiles of the last dimension and a binary shading is used for survived and deceased patients. Conceptually, this plot is interpreted as a mosaic plot of just the influencing variables, with \code{survival} highlighted in the tiles. Thus, the plot really shows the influence of the explanatory variables on \code{survival}. Clearly, the survival rate is higher among patients in an early stage, but neither radical operation nor X-ray treatment seem to improve the situation. From this exploratory phase, the survival rate seems to be slightly higher for patients who received a limited operation only, whereas the effect for X-ray treatment is less marked. To visualize inference results, we can make use of residual-based shadings, investigating log-linear models for the four-way table. Figure~\ref{fig:ocmosaicnull} visualizes the null model, where survival is independent from the combined effect of operation, X-ray treatment, and stage: <>= split <- c(TRUE, TRUE, TRUE, FALSE) mosaic(tab, expected = ~ survival + operation * xray * stage, split_vertical = split) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{OvaryCancer} data, with residual-based shading for the (clearly rejected) null model (survival)(operation, X-ray, stage).} \label{fig:ocmosaicnull} \end{center} \end{figure} \noindent The model is clearly rejected ($p$-value: 0.000). From the exploratory phase of our analysis, we (only) suspect \code{stage} to be influential on the survival rate. A corresponding hypothesis is that \code{survival} be independent of \code{xray} and \code{operation}, given \code{stage}. The model is specified using the \texttt{expected} argument, either using the \codefun{loglin} interface or the \codefun{loglm} formula interface (the resulting mosaic plot is shown in Figure \ref{fig:ocmosaicstage}): <>= mosaic(tab, expected = ~ (survival + operation * xray) * stage, split_vertical = split) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{OvaryCancer} data, with residual-based shading for the hypothesis of survival being independent of X-ray and operation, given stage. The hypothesis is not rejected.} \label{fig:ocmosaicstage} \end{center} \end{figure} \noindent Thus, based on this data, only pre-diagnosis seems to matter in ovarian cancer therapy. \section{Conclusion} \label{sec:conclusion} In this paper, we describe the ``strucplot'' framework for the visualization of multi-way contingency tables. Strucplot displays include popular basic plots such as mosaic, association, and sieve plots, integrated in a unified framework: all can be seen as visualizations of hierarchical conditional flat tables. Additionally, these core strucplot displays can be combined into more complex, specialized plots, such as pairs and trellis-like displays for visualizing conditional independence. Residual-based shadings permit the visualization of log-linear models and the results of independence tests. The framework's modular design allows flexible customization of the plots' graphical appearance, including shading, labeling, spacing, and legend, by means of graphical appearance control (``grapcon'') functions. These ``graphical hyperparameters'' are customized and created by generating functions. Our work includes a set of predefined grapcon generators for typical analysis tasks, and user-level extensions can easily be added. \bibliography{vcd} \begin{appendix} \section{Data sets} \label{sex:data} The data set names in the paper are those from the \proglang{R} system. In the following, we give a short description of each data set. \begin{description} \item[\texttt{Arthritis}] Data from a double-blind clinical trial investigating a new treatment for rheumatoid arthritis. Source: \cite{vcd:Koch+Edwards:1988}. Taken from: \cite{vcd:Friendly:2000}. Package: \pkg{vcd}. \item[\texttt{Bundesliga}] Results from the first German soccer league in the years 1995/6 \citep{vcd:Knorr-Held:1999} and 2001/2 (Collected by: Achim Zeileis). Package: \pkg{vcd}. \item[\texttt{HairEyeColor}] Distribution of hair and eye color and gender in 592 statistics students. The gender information is artificial. Source: \cite{vcd:Snee:1974}. Taken from: \cite{vcd:Friendly:2000}. Package: \pkg{datasets} (included in base \proglang{R}). \item[\texttt{OvaryCancer}] Data about a retrospective study of ovary cancer carried out in 1973. Information was obtained from 299 women, who were operated for ovary cancer 10 years before. Source: \cite{vcd:obel:1975}. Taken fromn: \cite{vcd:andersen:1991}. Package: \pkg{vcd}. \item[\texttt{PreSex}] Data on pre- and extra-marital sex and divorce. Source: \cite{vcd:thornes+collard:1979}. Taken from \cite{vcd:gilbert:1981}. Package: \pkg{vcd}. \item[\texttt{Titanic}] Information on the fate of passengers on the fatal maiden voyage of the ocean liner ``Titanic'', summarized according to economic status (class), gender (\code{Sex}), age and survival. Data originally collected by the British Board of Trade in their investigation of the sinking. Taken from: \cite{vcd:dawson:1995}. Package: \pkg{datasets} (included in base \proglang{R}). \item[\texttt{UCBAdmissions}] Aggregate data on applicants to graduate school at Berkeley for the six largest departments in 1973 classified by admission and gender. Source: \cite{vcd:Bickel+Hammel+O'Connell:1975}. Taken from: \cite{vcd:Friendly:2000}. Package: \pkg{datasets} (included in base \proglang{R}). \end{description} \end{appendix} \end{document} vcd/inst/doc/residual-shadings.pdf0000644000175100001440000065277712547236615016732 0ustar hornikusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 4520 /Filter /FlateDecode /N 100 /First 816 >> stream x\YsF~F.@NMM,YR(DBlt$HJ6%suRFl}^`8SL*7 9,s1ǼXy&h3cB0a,I&CńB3I0)%-gvLI' K3ŭ`R0%8~%SRKL)ÙLi)eޗLYL R`Z9I bځ( 9CP2#1Rf4Hd@ƙHAD72,'Y(DUNCyB}֢C'^YY2=Ics Ü%f0D`8< Dg@YA*,1%Ya0bǍD(%+е\b=I#q3".Ð 0g+``1 ) ڑxQRd  fHI`V"3D"k2`ZC 1`$ƃYXQldJ8&[vBhh L8DԲ" j/8gpp5 W`/#Ïp"D$:KDdtLqa?>-eI$&"ۼ(hi=(R~zeRE()>m\?Vl*U=.?,97Xzջ /iUcÍ7/XzH< ZJ/Gea؈CPIk 3N8wY[=VH NGDYBEs9x"`Upċ%ޱ%ė݂/!$ F& QH$ŖT>[s;lLJsA[VصsٶӧOI]H}_ίupȯ 2]Bu=-pf KjU(!JZ5TX:tq~6*dT|!.6TⲅB G}X\ (X&jE'p}Au1m˛َ7Uac1s.[#2 *B(Qx&!!*CPYU&?dt 8UJ%N:(|T|fi[5|0 L%5eF?,YZF(_Ny=SX]T<f 2N@?" jXK;8>SbO<ǻÎ[.H6F3cf=.9D~!J%1ԣr@ic{ ߙEelbî^ǣ{'{y$V~ܱtS[61hw[b%uDGZ-_{d[o竩ojJ5FTvTW":p,F&D=FCbVVFmZ!ԈD#4Ҕ6AauΩ!ߓ[re~KYߤPC@i|X<α% v Yߖb'$-Qg須JÚ 'IZ:NJ$wtDlگA6ZrPD|&3VĶ[7/~log<Ƭʒ]_ͲYlejs"H|OhEAZЉ9Az\R;|(&lxbYX6vJIէņU_U?[AWwkwsx9I|%}D; 4;'H!BC C5˂LGcBtze,$K')i jēZ}D6*2Y/E!f, +KwrCs&{a5rwwCSP+ ?H QBi7xgifC|λ`Aǒy]PԼEeg#U.Pqߡa-lI6:֝Q! Qa["vUS u='5 59Ct5}`R :jeȠ@"xơ9\#Bwq6ssN_}!C8¹w&F!x:l| uh/³BJt9'/4MNJO<ôH/2J'i6#L狈 a!q*{"C8ԘtJ'.3,9=lQ9_'mqHIcov3kF/%~C TWWyPyz^^e22,Gh*ϤjԦe]iJu%s3E壿AqzUq+oќS}M:L$5 Yie͵/(oʤĝdM{x;8],]>l$p7xY˨mf j7i1?0(oոUm6h,\3#. Fpval;Tdsڌ*܀?Ɉ?l5 ;ɒ/ѐcNOŃc1pX9M~Q#q ha͠,llG8Kzݰ?h%|^ЊyQ5ē}26=r읎AU_bIgo8IVLZg+㖭IG{rv(zO>W|pS{e۝`>%=kɽMq̲\ʵ}Kw EyrYJbAwVk}<&4߷X1(~aN],!iB:!nB@|γ}*;1k-Jn{&GUvmw6Gl':٫IU#6TP%.*Οxr8nkŋ;>n@j0o䗁dljhMWp*yYWEP7"[HN!g[X:5_Qy+j67+1$0Kꣲ;jI1>!o0ѽUEb3坸=(tT-M8م*Xw'_C^N59.8[[(WOe{E]l>9,|jhz'ojPl2Z1Ò:0r۾-7_XW;bjj|&/mir0N > *D$'?eGvd+c|V?b'y{97pt.!R{kùILjO|<|2 |m_%"endstream endobj 102 0 obj << /Filter /FlateDecode /Length 3076 >> stream xڭZYs~ׯ@ 5a`G*G)ډJ,զj %j  ,[yuMMF_/3"ʚz iVyTh(SE׋}i'*Xt_,&Ӭ [8f{bo;:+4@Z~x J*k5L*EST6Ϗ ez"} $=I΍o65{GЉu¡N[<"ΒLi70?DvwQY$eVE41YFi4(&XmljY_qŃ,}K6.B:4Ahxs-vIh&2Oy]]C=Fpyθ(UaF+}M&EփlTY8C+z%*@M^20npO0ƯS| a2ųMc hw_Di2@x2оppBV$i+kOl#kQ b sS +VɄ hyrx! STepS@"XN"T1+Iх{|n+c&}5IؑCi1NVTr|[ȳ$c[7X{sh oksc-DpAK>8i·ILHfF[{ǁC ԭ̈́W?e >c}ֆ;^I60 bSY_hSRH;/02z=졁<46 t $YCށ m,!ڣX-8eVIgHN(^69?ʈ@C bzalw!NImF6m3gØ^:2JNZgf/弒މuC: MFp =ƈFP9\F1nb zC[6 O[/̵-Pl<hH7?E{궕""$R%"-[w0I3&wa{ӑTB/=l-- 5Qڇ}W?Hpw:Ծǂ6;PK0EMFɈ+d2yI233F_ ;^$5K r0# ]kz-@&?= 98S+Ȝ/wKtzIOD6`vČ"uZ^]abNq  ooJ@ne n}@>=Ѧ0 l?cg#V(s -[U ۣ8 :Oy}h:ƄzT%HFE.fG]r婫Hg TAZH0ŭ-E >0bk$ųQxNi~z(18WxIySx RA^eD r iM &-i=B8+@5kxm ;ٯK=CSƈ=uAkm 0.|)qӪ3xdPf h]l%Evя upa9}곬 2گO$P0OvL T 4 ute᪞h-tsf@.|X\`' 5~Tݻ~b HF#z)/ $>gtQfpvv$nU3rSdrEЬѵx@˙ {EQyOoR1c1 PsRIAu%mW"4tA ֮~1Nt5-ӘJ B1o[488e|zr%1s޵GD.'Z잲CV<=,@BjW&TFmy^ƄiQ_+WS}G_>5l=-dGVmKOR$*( SQ KCB"}=a+ Mp0+?SVCAU۠o4KhFj*|?N=endstream endobj 103 0 obj << /Type /ObjStm /Length 3324 /Filter /FlateDecode /N 100 /First 879 >> stream xZ[S8~_tl L0dg*tin ;Mۆ&Լl%㣣sӹf1abK„Ѹ:&3),"fU0)&\c ]f;fճDYb1O R2(\R3$$!ZD @U $n,( ?Kdt0C 3J < 35DɘU^15G J&%TʄIE:l1!rPe!~ )6,ʖCMZ0n@9e0Lhu.!({Z\8rТ3)L6SDJ&f*+Oڲ% ڄiA&Ÿ$A'ҵrXѻ+k7Ե@ȁ.:K॑&x,veyVt1cy؛DMĢؾ(R)6~Zh,rY-W:;E6=3pId(q[ܰ Zq{^CoGc L EEEO1qt ٮA4S:iLjvca{,QBj)g58C)6lnI2TʂlͫGo=;<^ʪ;KKFY5-e]!iD{>_8h.|VU!|7V뇷XG_vxq{d,1^܎.6O<|`?f1&j&V\:7£iMP ETl,l2Rj7Ҏe֜$.2ɶF ~[1U鑼6`b7).Jh5ߒ[/ƾ>&~l-ƬѰM6rڙHQ)-M$ml)Vٴzi.K r P^k꫺9-{`ٶ£6bf<}V\x(ӂt6eU*Y&.=3f; 2 8qWf)='hء-v" >:a1ۈ.a2 9b/tyO+vU/Wf/:ȓi1Ce¦ L);f;ϊwp{}Nyu_\/kGo5l*_''LON6yXUh直yvRf 譪rOkӼO5j;iF񘅙tJg9VhQԳ202i~Z|08-ुrL9n+v'uA'"=(-=vm)>Q8pp!:쁋+G-3A񴻀$2UotAjS``(Z5z ~w@eBxHTFndՈw*D_^_7Ggu|*yT\pxJ1GZœ; b%C+'bEg.ulKpyyū\g\;K2Q,A=BDzwst, sY1Gε9#DǺBдԚ_3<$*t3?=>6T^'&J}LlH(8.W;y ӚϾ.x#H'7hX%LldR`BR,6 Nz÷aˈC%hm{“ok'!w!;ľ 7 ~|<;<>~=<{r%'ٓ=ݻȣB])V'u͖NEs#*ܴQx'qYܢ@+YPlZ^+#&bdIwf5Œ1t{C/fD_cÅA0oCM?d_TKu7Rh t Ok6/<-!6(͢qSa"X}oYj6FtXr-4,ER ISdr-aRI' f^Cmty-/kH@6x$[%;}5[kFGIC֘I#@3nq{# }+[::A@OhC}FnMbV潤 ,l#rF(;Hgvo $ )(Aj rTz%mƚ ͜ p VM `Pt3{ vdtmI"i:OH[?I3h=5_S]ЂZ^v/]ӳqN5#|/2~-pVQYW,YYLPyd zitSϐԺ {]|86-x*c+]RF]|K^zK\'7Hǒ ߈n,`)v>@6X_Uz{8("!ZlZ?'9_d3xlο9?/fTg_fe^78W_+ޮ|1J:cSߪ~WWZGx;aP I #Œ<;#Dhdb&MۡEVdLC#nU܃<ݣi^gtl]׏_YQ.8UYf9%ɶ!A_+kel^O'Cy!ha5+AyNxȟ'@nv&:ݵ/u]sGkyV=>ʗvHLeBL7}z ov-d[?>d*6$nڃO—kHěx (ל!gCuMI@h7d>v]$|ٺIuSUv Y롈6\  H8֌Vendstream endobj 204 0 obj << /BBox [ 0 0 792 432 ] /FormType 1 /PTEX.FileName (./residual-shadings-Arthritis-classic1.pdf) /PTEX.InfoDict 38 0 R /PTEX.PageNumber 1 /Resources << /ExtGState << /GSais 41 0 R >> /Font << /F2 39 0 R /F3 40 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 578 /Filter /FlateDecode >> stream xVn1+2Yoo+"RE]: NQuQiqvdG>>|`k->O)w˧{-H kAFŠD@֣m("dN &>*G ͈艊/&娘ƞ\@\ø_``78PRC ru هvΩ٦o^u!3*&tlc<<`,]lZ ,zLt%M"}_}kr\E4FשCSYlmrM[9Z!/g+.ϮZ8?RdyyFuIOQ+&^ټ=CO[9A循V8R˟z8Q:@xt*ڏk;`Η33]23w>sa73cFYTbvֳ(9ĐP5ʲ~fK!3>{t~&mEendstream endobj 205 0 obj << /Filter /FlateDecode /Length 1887 >> stream xڽnFБLS-Q,TRJ"ȷw2 %Z zy6y<5{y?+UTI>_ϫx^dETl~$˥#2e țf!aV'v/\hhVP$MJ~32N}LI+]Qx'$דj4* :"HGA?,^?GZ@ES0)20`+VL(OsB  "σ'Aw9Pޝ'V{PM4s}Ǜ|bc_T{ ߼iVz!La"9CVG'+)d= xYϻ v=#*"6Q}5nhpeQ-27hKK~vХDfaj;dFʼ~زsU"7)A:ѥ';V/.:Pz|vXGl7gQw2EO4HB PD@F-Y#ps5"m(o&~Z(mZ'LYnGGI)!7AyaNB A;M3aI6gl4Ā"hD3j҄PՄ>?qT@PQUszReTh!D L8OǑ_AKr2EЂfS^{KJ[Ej WLȿ]xZَQ\5@?iFBgNcWIÅ; AzDT)Lއ K qܢ"5 o6Hy7Vۘ?R-w aR&~HȽW $\n0Dm%Uɨ$j"Xc`rڐM)]g㋜V ?;@FA=MqHٗTG8g;ӵJ Ml)>мƎ@Y irQ*\jutIܓ0C9hAHj%w 0Y9ءyQ{9&#͆x1=.+ر?a蕄F-Fpg)vGN;" S%vvk*=s%k'TBS~0Dj;dTF =e32r<7hAӮ:(~#GGyUOo]O\"ôHP`yi>´׷F=l=W G6Q˱^3W]1f~,:4ҜJCFpUHyX"N O\;E?\)WߔS-q@ +(nN gU\yx7kpc 4jsR "ocEj_6tB $#;> stream xioP4>\AZՍiP$n?$)h:$!).ι\4Hacvvvvgۙ?7o3˽< f>Y^nzj"w\,1oK5ZgY{__qfA|6;_M%|XOo28㇞or 2qY^4Y&Fe)P1vFj844-Ch `|";c^QN7[F -CbPORj3/q?[rH~ 'Ay /Aj𻷇bD g.}:RLER&=DWEōdN<_'%)d j kE"PV鲩Y~Hzw(<[T"&(Үo*π/B\ )x'Y"˩{=ee|\Y٣ا]bbf~%/#xt:‡6D;WtZ?eu_qdݝ}G)W'(WِҙW2 畜CPDkFCWp p;k4([ObV!0yK@}ӑZO2 IpJ vw-֖6Z^gYmkbJ0dj8m? iAvLPm؉ٍٝHGaDB 2mUfdոuKh~'THCp QoDJSyCdcЌHAP,{|s s.?Zs#?!K&s03$a΅ A! 3{}]=OBpT$4j@ чOOy"ml&iB @ƕPlABeU $F)y]N^iszM"``OqjLJKUg\3(ݞ,+8 4%H*:+gFkqY}|B0. //ks;Ml2tk% ~[ 'D& .&IG iA6^Zˡ8}*P9R &Z -a1??$m/̠l@>\S  ~$~plH:k\K%0alDfJƙY.OmOsd%FAZ?.M 5"Ǝ,ɹDaJLwN/'y<. s7( dg1)?(ج o A'=&:4Ttw.؜Yv^)RWiҾbcZPr `C@a 9'SsmLem)ڑi),<Dg)=&ےǷeVk=[m@ Qco/┯qUpP;5"Xu|r-eAc E*N=_ZmٰK#k!ER! D~' >/LĉSwB"ގ\0lFBn9P8DCN{ȖHAR9 [畡>/|e؂×NY 48H>"d\RdSbJҨmwI=*c213_xaO9@,TR"[oyyN\T_PY=4m}Ԗ[Miaj@A_z5|S42F>JDHFê*?~Ɛ7 2z5q*Sd̦町v3@. 㤑m'S ȩЬj:O2#Ed5w?!XF!a]NVMVkJ,iޜ*"j#;Uq1௨cLd:tGYGɬPؑf"ojgt_yZ6rըَNo. %Pendstream endobj 207 0 obj << /BBox [ 0 0 1296 864 ] /FormType 1 /PTEX.FileName (./residual-shadings-shadings.pdf) /PTEX.InfoDict 51 0 R /PTEX.PageNumber 1 /Resources << /ExtGState << >> /Font << /F2 52 0 R /F3 53 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 2213 /Filter /FlateDecode >> stream xZM6q%*$Ha e.53#'9Ak-޳Z4|lu`>|PN3#4Jn{oaZ}%>o?Ï4\~݅hNjЙ7]J\xr= C'@sUw?ֆ os]ŏ8BˬL9YdB;DP߁`6oEwHYLa" Zx8^o^^BL`$,瘐]0zs=FdtbL[ %k]#` -XOH}I oEg{-%29>V~V7G3}q/ǙhWV8ÿ&缀`Uaz6_>?\6}2JU/3jr%Z#^ahRًM1Nl+ e6\B(&4 3@CY"#AV wz&˕08[BO'=ؚMɺHFZv!IW[GÖeSO9!]L(󠏁fۘkRQPQDt' "H} e(!8YՌđl A.l¢kqv]Xd, ,t]Z[viD-h炌("Q.AdQH7_@Ukfk˼?*<ṳ{S—꺷,h~;5 ╖jȫ^uf%jZ:ذ# KOT!xT~Bߥj^a eײ8߁tJӂp$$v0,VH۵ QcB-$fz*!FY!aeMM m-dJ6ELjѦ`imymAbmh-EFm3Bn8D6aY"4̳5ًC=Fowg´SI~Kv`OzkJ,Ꟗ²8=M^amH0\!YA676u!-RDehj>#49$o~>ކip09( H/<}މ3LN;~ 洣@ZrVԒo遇*d5 '!"@Y??fqK6H"." :Ejq-]X-R^6Q!2@O+^ o\Ü0:LI_TS%2}y V"DShvb s* n?s OD L{K|,nxPa-tV#H*J:X%2<xe"+j/&&Wە>6OA>m .r_*XE׾˘*~̘J5V?}9k]LJ+,XdBzh,DX5V*<5V5V2(4ZB^c%E5Z+Yd, ЂFcXSk>U%4Fg +!-20Im—ze9\Yfi>0N>(ZqLEQY8oUU}d&ﯬ,%/l&RK/+K.Lj+k?+j>S K1CK]T?ץB">olLq2~\Aw7rPF^"BD*K Qb#JkP bV"A4)`A9mz=6YM JlkBɢm UmPf]Y$0-TC# mR1Ś#zm /=4qqx8gC@NC2>C*_I9\> 3"i'[<*XUAh}.uH"$b*C \"&\rp%bǃܸ4OJ\Vendstream endobj 208 0 obj << /Filter /FlateDecode /Length 624 >> stream xڅTr0 +xf"rM;!KӃjɏr$IXIc XIPl4NDYBJi&J|Ice<ILA״TZ -O BcbyGUY vٳ8Ɇ b ~D+Gg#("7&RD̛#B-د`;?Pđh ʲ(1#JHdN M,>[yuj )-޹4I]Om-u&:efZo;0dݱ 6sd1JЗ3dѴ{>,w{瘥켡CUҳ*a(+>OIQT ,+:k.TBqM&WP=PfOsjTP UlzjDē$gk9iOs{ v3?>y|+{P:y*EYԠ ZdNۃ%q4?ʭrA`VN /=sk}M1}hB\kCٹMЩSPi!cZXBN ڎ5?6h(?ַooCf]endstream endobj 209 0 obj << /Filter /FlateDecode /Length 2389 >> stream xZ[o~J!&r-^A7-m- D(9vf8hiE@s83gmwxēxy"ד2*$\^OC[MLfRg_41TKxPk\ P?8f+p;ʼnӤ]7oh5ls;_\s:NX:ጳXP*JFW *8-q4M]8eZfsA@_7 oa{Fm8$LUd@CaR)r85DmI?4ITTfc<ؿ,=7{~)'ȣY8sf =BwOyg`-I"]޸IVjÍ whW{7h{.G]a6QZ= ˊw@1I" yκihj| zCH^v~/vz9XZY;#]Y4~{,'yMVF·+\\60YVx u;f{7<wȿZٴ!I"{ voIAX59W{.wÎME }X#2{fwomiLyNk ^αwVZyq.|υG0xp겳 Rmoww?c}Jދ[9ʋd( cF"tr#DxG^ N1 1|xLn ݞN,`G ^K{¨9WѥAY܁"u+ݕI. 1H7@51.6%IQ1a>%:ij\F)@zSa/%?:T$S,W7LDž%[8M}Jho^Y1Ҟ~QUi*DVb]=\u** P1tVaRKVh؋!ƍ7;&ƥh 4"i;e0>|Hxɸm }ȏ98kkcv)aR6vgd*0#)gYW;I®y|.&cde-wco ֜mS3֕Oe0Тuu5dt2S$M|<.'i@kԡJsa`[c+[%>qZ:Y`/D0!#WsNI*{`[tpZe'u4;g )S%k&eīR/!ڭղ!ǀGrw.lenq ih];@D-SՄ3qhSoRDŽ'J: Wd/gL1̢endstream endobj 210 0 obj << /BBox [ 0 0 648 360 ] /FormType 1 /PTEX.FileName (./residual-shadings-alzheimer-plot1.pdf) /PTEX.InfoDict 68 0 R /PTEX.PageNumber 1 /Resources << /ExtGState << >> /Font << /F2 69 0 R /F3 70 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 812 /Filter /FlateDecode >> stream x͗MO1sSTR VHنPTT] kԃ,kcc _ӶL_. '``>!8r5w8CgrDd Nψӻ#M1pPMZFaEWڿt8pYm_Y<‡v1Dׯ:~D6ià&cZP%ż8y$O  Cy](Aob:+13򠿝n]D[ >o<5Ŝ) iJBU  sW%*Ė6;$]S|fjW9ѫFzz"1P-Y\VmNZipG6L%s00ޣ{S7g)~YW/IOJhtZ1j#]*U̫U[6hTyd9[o6)JZij<\59={ym+z\yև$SoRVB57V6edydUb+R͞Eo3s;+)e%Fa9uV ghQNL^knAlH3C?KR9{tJ>'+|~j5R ]-Iޔv=dWgQ(E{V!^Q2ZL#:i}e;?&̺+xT. 9їf>}o|-l2 NSendstream endobj 211 0 obj << /Filter /FlateDecode /Length 1093 >> stream xWKoFWi.A[/ͩIuKV4IIɱsoϼ"873,ث{eX^μ+c/O4xo,{bJ(6%@"ol 8&_06be hrn] .b~F3^hY L{0"D*sl]u[ P!trDZ瓨5bʱdz |9] 9D~q-31G=|$~Lk`5i<@pIn!EK߼\3yYUHlI[ṻ eчJP OѼ+[{rK-L^oeq. #MLAyoG\(¿ kOSAxWU+^0{9\ _ D\:rVw U$rUNO$Hpբ'#|]F`nX݉TPL 2̼z2Ā80%;2W }qE L@ ;!,W=XxmwB)qh̙dt{[v+yܜFfa1}rg\؟v. $RRF F##qH9+֝cDI!lk~I=_-& ?MyfGY i!m9 YcokČ }y*e"]jNRO2߼ I_Tй*ձKk84resTθ?ա"5{3nxvڡ(Rٲ J]&Ƙ cU/j:z}Oendstream endobj 212 0 obj << /Filter /FlateDecode /Length 2076 >> stream xY[o6~ϯ0X/݀!O[Bۈmy4m> )VoRw.<琉FQ4zuEFy'2]ތL_8 s.џr,`6R*9d‡̂zӑ3}/f܎"H tIIJ&ZD0Kix*wc  v40Qg8I^--7@0ƙBALt3GK۵5[ tup[x `4e 0jQ TXk%޲ڌ&By&vn fȃ(HBHUCayDd((٠n.ˌ*\EP߀c߬.Z 8kQwi2خՀɎ8lS~WЀܘle["3*ꯚ-jvB`ߒx$"pAq`ڐ,ݥ `\gTʆ W6CICŜKt{\5=hǙ'[68-53*(\?R3#YIw}GfY  PҌ|2ƗzcCy? %FBJ'l%C #1E.0)R(z>[R,TLsCm c3 Նzp'$W='kA VL4v4و 7=-CXBڣDHV+9 x 6s6nK^KhHMK ˷"OsEQRpN\T}!(5z/ =ި[%̘"dPll1DEI"hJ9z ̭Y+<3Ԩ 2N^@CD9o0W!, .u]6.1sIq\f|=^olܨYfꦡ|DlU%@T([FxgcmLϜ.hUG`s s s5a1 <'htZzq,U$2J/=>%!6/'tr1ady\je TAj+-PXڬTjm$L Z4LS68h I+lS zݚyKWϸ~PYWtD{ q@0F5H:3瞚> stream xڍT.Lw CIǀ4-] ] R (HK) " %p;|ZYk}vxaP/1_['#r x@އBwQf Ccʰ;:a)/ \7mB P5Gmzm0nkXZe8unV! WFkՃr(քB~?5. / >t MR^;>Aa$> `xapCr[8w?<ҿEd xtDtVA"п<"@a?ay`T@>?3L?_ϻ{A8spX֋wԞ\#'7 2ٸ|mWilosWgi]DkRt;Mu)Z-~7I-8cd=;`?ҕwڄܮ]@ׇ/o§7~|{f+N/4l:+ ;//©ӳI{:$8_o|_}t\;(()hPOƟlƮ<J>%KM Dh@v|OP6U%]OַwM"^S,C7!9;DU|~9xVțf&~ 0KhCB3G"K@Aݚwq<%PNz}'=(BN M^:ڒ+Dgx7A / K{-+̢E 5'rSȧ!rū Ri;1et38s_ ]QsFf3toOϰڵ\BJ2F?pW0 +FP^ȗls54,BWlut o̯oo)c  >PyNy+3aaC1 , 10̆ #B|N6f2zɎFSIavꅞ_=iv|ZiXgv$@˨[]bJI]ѻSB^Fm?՚a%-o-Gx`nZ١fe]NߣLKsoШ@nyDϔC/4O3Sc }1igGS6+T*+?-;8XH"K dRO?)fw>y]~b#=!:V;h'xBIcfMF᳻9D?* /_DDF6;˷",Mg=\wJeN2lp 4Fw "'(EUWhg4q<\複t?_f΢ٗ6 Q!9q.[dӉ?%@d91`X3A `h{޺dz>kÙnrMnHOL%rP)k { +au:jugnAaN踡Cp,JK6&!a$<^ATfA/Gハ"5h clQ2K] @X ޔ4-X0x\כ,;~HQ-g a=Uw?'zKd(UScHr^c9z(*HPη [a}]m*<]*=-RKB2 eIT`/~VFJ= CL.[_Us tZУPo> 69&Pʘ@d, zT]tD|7w0>XsE jc8:BCy:kU]!?ԍ4~D g/7B ru+1: @Y^W)=Obϡ]-c\A eӛر2'L3߇͈ p]cFC! Nh}IٙL}ctLLż& WU5;3iG3zXV* 5 jj$ Mj4|#4K9՜^Tݫ{5SlGwȍVqf@ E<s07Y(C ,{?f%bzPcx҅}IDU W$ ]I"kﱦ]֍aXq\{zku_ptk8mI\嚗.V&=.kp׻k]&ՠ#y -$/v'ծwE,/nQDC@xTk>1<iճkc" I?=(yɥj凜}n!L0}^#WXoNgc+PN0 }8BdjT=odHUnm7EwW(hiD.;߷92c_NAs]tņ́~_ Cj{6Ss5h@A9O/\uuxuD2݋V(wuP>W礸O?u(N(EƎ_Ճ=&a)\&R@CCAӫqLkW`koc~ ɲ&Sao&ʟ^47LL {q=~wۯ$ž01yFUK:R3wEm,jU*~a!GX:.} $!UhG% 5ز^6Odrҙ BBC2B\W,&mT`K /)oֿywzX$T:|@깉䬲%z#3EܷgUFntW[`QK `կMv]}Xj3َ$xdYCqZ/C?XXJ-k)顥8w|k߈Hi8;J$bOvtȏ܅˝uwwiB1gSݝktmB"Q%=qXz$FOg1OU%tOSG}iDz,uӘ1vrTKNp-u9:<a1ESVFr?*5~,δ^K4,CM99(̳ 6y[jq'8W{C_3%eh&'jDVPE"Om4-zP#_5/7}NǎGy=u4T18T_OnF\ڧ<ßyʠrz֊ql)ۏ j*.P{+6ea`?t? oIPEƣ+ɇh[}O^Q/^ӏTMk_r<-.}XfnhxLG禮c/|;εJ ΈM\:]v s7õ5h9~WtHu4mnOB9bSPBk'˓3"g_ YQn(q"k ;{IC3陯 [$ knףmml q7מm v- W"j9xJnZ]Z*nj-6? ?ۙ$\e4e53=qڰJIjtQ`Q-WfСlHڮW(n9 4dn/. Ir '+)V{bτAN1Df_2;s6 &`4FϢ(@֖r,Ljd$=B#k'+Gix`&|8sO:{ԑ?3&I@6-g{h ){ ܤh9?_+CrS4 Sh+{t_:H3iL:u I Y^G`K%B.)"=[ח_>@iX"Ϳ4''?(MƒӈGUT av_5v~1dht/~g`Qld)lUpC"J-S+{cgk#VPh+kռ:'H=oҌEߣxq@i.l7Nd)xذUhlksҪhh}]'37nг n%Q'xx1.iA@IEKǔG : ~Na^~WtC`$ 36c4DMxEp4jS ~qճY$Nf/s>3GhܡeUQj^͊p8Trt||qjG-fˉDcOQsg\/* x R`ܖcJޓL鵸[gU2= uij.B ږG4-w\cﻐ%|ilώ,:0LDeIE\DBά 7FE᥊f)^+&PѯS .n֙g 3GvzGTgV|B: z+*Fcaڇ2ZDHEeA5V!]wdRg#&bT`é弚O)&"c6ɋpѧFcLbS[VӖ=llad7_@ƌH|]m48?=Ȉ6WGG~He7jZMH3h EyB7$9d I?FvD9iacaC ^haEWJ,Z(Sx̘f,E\xE{:'ΚWEߠq.PfcQ^k~Mp…D J#V'/I^  FV $fJRfP>k*+iI{KM˺R߷/0VPB6KBCD1-b!WOǢacJU//g(C,mܡ)$ZL[D D闣[JȄBlPsgԁRc+ìcoުBlRWa W /l,͕\,d)AIjO+ϱYwӪ[ J= 2-TO)s5)LyW WoSg-I07@_ȡyPzwO $3Nyd@C*`yYi^-ɂ26[+vY ̾MjzE1B:2]i5}: !x3]Pbsg]`ɢˤIO_b5^DK(8r=a1pHFfΛ,!=XqzT#B"kX`UA|Dld.vr<"߅g6Y"l%Cj;;4b+fS*:BڣAA?*׈1}C4;=zhx !#v+'i3ͼ2D+_4s2D5LBPM+ >ވxT}zfͶV[Z&y4ð5ˆMSuRv~ʢI&9tNK^+!g go1+kqaIdh[`X$Czy{ߓI \k_WLi~& :Ѷ/:-WL7t=F{C͋% ]~G*AQiQQ/Sj/*xq~\UpvC]GcWO}?f&FO| kbbmLjO =wNa?T*yD<f27/G8x9>.^ kgXVJh'*{=%^tdփXODhމKSMq09WmfƝmDVI4IݚQp5ZkwSBm4;lF[&C2s}䈘&K`ig߅7v1c@u7fsEsڛAg)QBȷɺ6YZ0YA #q3_*=<#nt_zG4\Ҥ檓f٨:(ƲӭQ!c TKȴ_=~OShg(C}-{1?Isy!&7`,( K?DuٌlBzrۄzCD$;IJ'A'Ưn`*%SD Iw2BdfSYH 3؄-{2mGKT(􆶝㐸Y$6V>U5u+bъ%ƽj|b[൜"-RE(GԬ{wPw/:a +`f`3GkM;CԊ SˍZk֏[G$M$PǥQ8 *@T|d1ߵP}37EE*GSZ6P8J6#;y֜=F{\T ;tkq~RR6sn33v*~k_lOd~ ?g7i||)"*7<ͷ}-ė+Rxv@ƙ߅%Zz%^ڄb0f;ML ga{^ v9鎪XZql#,Y̝Bx24endstream endobj 214 0 obj << /Filter /FlateDecode /Length1 1998 /Length2 13022 /Length3 0 /Length 14240 >> stream xڍPk %8wwwE/^KR({~?sd&ɵZZRkHX:d!,)I}N;;+;;' -6bVvr+yI!*NEw{WO.C'WA4l Pa(:9Ph]6< ``p1p- hr Aqdcd::Z22<& E t+ -@/   GWwGK+5;@KA r nW @ 'g7`dY!^f/Cӫ?]: +27?7 W3č lG¼YRqC>i+l>\;G'OG +_4,ݝt. ۼPȬA;;;yYذ@/+_g'g+ ?  *pp,9'd/z`/!qzY:9{1ٔ5UMJII'// %aov?ODG+'Hv?D<= ^FfPuzg^]_Q_V$no_?zy  qz-)@"hm6d^ Ku0_CSx nv;p,GsvYqpk8yx@WW7 q|9^lX .Wr+'WN&_&ؤ8lMzFQ/gAQ4(ZEkZ$`/~Ew:f`a_/lV`?zNpx5|Mh'+yog ū ?+?zD؜${}}CZ5+z*x\8^Ks| b G3^x:ᕋ?+?5?ku>Z wW{u~|@^ ' 0ۺ RO Ym4FeN)՟C~Han0\P<6 F%k?=&jNo,M N~9 G&c{r mVuqPǽ*U?P},ba[cW lNQpmy<-Ι,N b"B_ θy mNbb"rki:_ɽTEEߒxň"+rfNL w-epQ}`2̭x MZɑ}{."z'7'ʹϮbvcu$7a b]{{K3 I/Ky^_q ݹ䤜#RcQ)(j7!l*;Qh0Jc?}0^U-BVLw`6]Ö, AqpJԜZ5$q*TCK/Q$-Wŷ ӥ3Q-%-ʦNM<߫`VOO9ʹ zXǦ.Y xȅӴUFE\+TCS6C3E l{olGt=_ηPh~OmSe*dН1:U!kƀ7r-UPo-C.m=o&N7x9P,nS723,=֫>cROB3dG7\7[򅞄>0# ?Y?N[xx}*#a6]Q>Q=-י"9Zpo"@4OAw> ~a;W5SWxLr? Bڄ#Uh7FOVhpK p)j__VƏ2+{0aѯP굪 Ed+*6D\ fIXn>G3d)*KXMcCP8.a7dF?z6h?JTV(:7V4h-s'VP3t 21Zp pՌ #طJ8"%fl74ߨ u ӌX N-mT8V)_ 2{k<`"gQ d# JTTIKM(NnJS6wr9FIMXY>ʤ|ZG:g=N0U.4ir.]GCx~"ʵ6j@Ԡdl]l2nSa/$~5Q򞷍4@L>àwB]"I.%ςp>w|;.eT&Bśf,9c<<7 Uo[Hߑ59ݤ(=4 -dI__WD[s|d dB\1t( J`p(WشE)Ds}F!%Py֖uj~s:#w{H'0^ӀF&Wj3[]yw=X?,6E|P&7&> r{p T~1& duAk\Ě NK~IWYbٓfPtKuH\LLT5tE9DAdeYMdjB]LWQ/ux7آV9eB˜YW%Y$=P+BgLF(dDqTf3g=^O_ L a*1Lu(H3o$?Y) 2]UrPW~(Nr2@!m1yv^qh"@`ՙ=4MXN Mơ.C@Dy~]@%[we G5E'1aBxTm4cweT.*lYTؓ_kjߋ/~foX#ȸwRhR ;\u3knY҄/QɅ}MAcGF* ZKg:\Mxx"S= M60(*4!kplMT!`+Z<ZKA5/yOvv%*FnPe\ דmw"d:/X@I/~7TJ0)GcDX3*/)YqbUonTtY@/9hޱvmudzh!,kQzܙ,q7Z(E&i+" WxL<ĊEŨmCQ([]Zα@}tš3S殢oJ@}B: 3+?jr9;$P]J0(8| ⡏3l0Q< TZ-6 PNg%@.Y/Ԇ&ޥXɋw6]el ZZTQNvSL mkꋈܩ|YKXc&3V2t&; "KќHK}O+TYsr Iq>zZvJ usж#9% ('>#UzA*LJaCVTl\_nRz+EFXv5iw6S%w_x%lz4ejr|h~' ^tܾ\ǫ"-&ꆽhA38T9k5`n dC掮 5tTy5w7s!w75iJgގj*,/5>6g 4MݓTQzF=lE8=>|쓊+ҁLuQּ#[+"LJho0hb\8=[^|Ԥ/@h[øO#)#1-l?WFFf?in\E؊Hn3p%uXsyJ$4@*"]J-:r/l 4ԈXGGć5yӪ_@6-~7e Li۷FYc giU-l$:<n.h+E쎼ծ1ha֓8kc!C9-7@?۟NhMvXO՟d֝8&Wx@()5)-f: Qp3\f7W8iFޜ9*RI<HvD2n-g2Va?.nRl^2'Iïyuc™=h薙=UGG xkϧ\[i.d s cU sH ۘ}0quq.t n 5:Gq5NV͜p4?ș== 1:)cfUǵΑ9jw uq-o@!*URTݩ7f*-3c޼g56(<t݀K B~x0MQԨv[вㇲT+ p44 3Uja;*Xw*qE!98꺃 ܊rA3khU7JnIֆ_%{ gO@pkuU5hR.yEm{ѨrTКIiMq6_C sro=HË7K[հO9 VNA*L&i'l|mGNGآ3lwg#}P"~E\%D.YTu0ҜaQRT^&5q(:a TouvEuMuM*P.H}]RXՙ*R])Uk nz`DCFի^M5nN./!y;tLъI.-(L?QOت8X)9hʑWU6è˸S ',)xRŠ$5ElPU,H?t~QƮWX}6 yfCpOJ[yxxYMht'oA_TMØ^KPQ, *xt<ըdɧ.Ed)r1 ½񠰷Pӯ |}C>_S7 7i-̷ur}".ocfE0+@'`]{Ѧʟ[=Llx>,;]q,]pãct-h* dښ=x*G-S9n|QB}FB4XrǕdR靓рonVM 9,10=ed0V F*hw8+=aͅ$Spnm&Vu.1|)@g ?$+0pq1#"“9a%^!ޫ3*k2'~nUt J}Ɗ,K8i m}Ϩ~#wy-gDF:xk \ d 3<*͙ 3Bc oNp%S&lM5*hV('d֥I-KB+8Zzy=hm>WkBjH]MթF4^N[#A] ٌMXRڽ17YkBt#W}L?=y[ujP->ZݐH< Jy?IhĻk՗|i7˱(}B;' 'pͥ?>mk xNfT ۉ0I3$Kj SPrW2Jv^^,c;-vCԕG2V8^c|a&|1@_<~jo?"}1ŧS,#.y>W-쵒CbbX5{a@#[+J<]+HQ6lo(գJ4w'&:Uj h$7h!Lx>eˉVNxMn?)wT$cqDu* {0~DWܨJTU^.@ 8 cЀ mU̦erx|sU)@xu+mJ}aA?xOjhZWcثb{|ѕn8)F=Ag&7qDoAβZҺF"sƖs/=i&?ozrUuxJru_OwY\ '$R/qHR~R @K+C:M x{]vR>9}$$9%"0FQ?c2]l TPn)" bX6WZؼU'OUfO|i۾گύXS\9. Lj䜨%WaWxQn1OA!ca탥A:ݒF7s͚^P7,?x D I89:sĔRl)g9Td)b7TD괺I]37;nXUSvt<(*;U-tjX=d qfhu[!=e 5-UwxOdpٸ=?]>Gm9Pͤᙜgs\{H\c{=oȷb .>')N*2<]I`Hx^jn#?TqeJDNH e/SrӪuűE" v9PRn#7\&@#XӲ'UXp@s ^OxnJnqj}Gdo.xl%)G`tme4+*AUMIz$oq/IGzl8rbG+ j׉ɑcPd(ܪ<\[_HdX)$/GCOim# viX34j.McKoh4QF IPEli#G{[e:_3F5}"$7?`0eJҝw{6> |R09Z7!axHU:X]7Vi邸95Y*k&jHO5)#5Ãe^G/.[;$Q:,hn&׏UtVgiI} ;tvRM>IL(tڼقV[ B 0BAbPLyiҨ%s_#GIn)e0VaɚsFxAvbpmHZL|= #E;"1?UP@tU"r\͉Ї}F} 9%T_oZosdS#wHޔXT3$>Uψ$C<&>ˇTwNlYm1[ן^EZ fKKs?SŷPձTL-YZKn gN]+*%ؑ.,\"a*Rq֠m(4siRݸ1. ] .|ߔw] #l9x7wħ'ު4;%,^Q] Mky(׫P):"̅r]!ú5NUX?(#YE|Dƚ(\#]S8:j1gWƑ&иE trJ_Fܭ{Y-BTl1޷6ψژߴL ipVvcn(>2~46ï.9҂l6cG֙)U"2ThUbaKw!as7w2SWd^"q1W9xa}CqJRY{HW7|bgtu_>@6PNGz\{nCN&R;=?=. mjfUeM>QCπ$vC:87۶Arbt~U&Rԛ /}ӾN/ s"e^YF.F plw?K*>WMg1o,5 ?-8"MʝbojkU%ULݨ$2%lཱི v+0>7fHdS豯NFRt]yE%+Õ@X$\G]/ߍEP4>C)˗Zjޝ)y|(Ҕ{+Pj7f!`UÔ21cCfa?؄PfUvwfCGXp0QKbo".d|8sOU5MШ:gJǐw_+ۡ~Dd:H8Rtȥ$8ba &b9gg3thJi1XV$G{<)x*FObc4f`r]4Ǵ{(>$)wk̀Qu),e/ZRg??M_1qC1A7wvb]aJɂTrckZ,m>BZ2 rNfUJwO݆\gʆ?cQ_I4dŻUG X ]fG˶a<8|.=@rЭܫfȕ'A'N8F[W4)D5/Ϋ>b=m8{vkc=ίNtX%ߌ(W ^&VPSMn<6l&jO$yG"U*8^H2 jl;w vÜhg8\lR !LߣJ8XNѕ\3}Z\R|U5z iFEywxX=݉hЁL'g3{˯|8܍xK@Ꞵz]LU 3AO<]0ujA:<[ +KXBoi'մDvR%⨚KԼqWפ¯rh-5h#2P@Yx09ΆߋW9oӆeF@F 4T ':Y|gpOj(aSA@J}:99o=2>N)CPi "1/bZi BK2ĥžBm&_qxi4*=QN4Jܳ0ZQQE6\l!Ida9b:!vWi9(I=qJޒpհ'7FG OnYUpI)^f:|bjQw'W5l^BQonޯ[D @9M=`ȑ|IG-hOkm gaU(-sϡ`ȥBuDv+c(;؋QBwSRfC_myS+ ABCW 7gP-ոhdj<~PbkFw*ScBmGɯcmݪd,DTV6׹Q Vq){QuO=Z+ԙ@Ll,{-VQe6Cw3ʜYuaN''Ao2@QV4P'K0:hk=KBuBE @S4AzJb ňA{SNIQ}izRvH6a:ZđNSFT0*uJmInEkeQ䷳ۜj݀N|rcoc^ %/~MNv\Š5e;UpK71Oh?lDhu[ }4c }!5w鮢uJlOfTd[_蛹#r \+# %muϙR(u}=z֦qD{$oKdw4?+j*s j1OZJ J)*w )Htjє5h;ft$;10 ">L< vNBEi L1 *`>:Gi]y#ds-OވQLoio[141EgLTZGaf)j? ,eKOQ2e/CO|Swh5UHud]VIg V D] LΏǣzN" \k9w&R qdXpBZc9큛%$Hxx3QG1ӵc}MʲdL@--Z^USrJ8Jx*i;+u`G(nʸGljZY Ag+u$Fl4HKq8s30 BGS]<5H4mQas:{Up~nc3rshTz9rbBwoUn? ZnqkOxZBIfk1#8L|P#?-5 Wԟ6FxG׃z5.!y7JrglUaaza)c-ʃb{Οn/cx`'zD:_>3BQaA#)[7;\#p`mf`xП@&'i#t h fѤeZqĒGn=G` ꉀw~`&TC M"mTMSԙ({y 9\^"M}!EL0[7Ӝ\5{>1X;K,޸RL;{LPSqiCI zCR/5?W>\\_u/98=MFز:Bh2 O;& g }6g<1N8 sImT?هQ KK3>xA-[8TIe҈pAI)v X>]?LbVEroM?bRDJDNW +R"+ >˷ƾ]7ߎִe j4䋥Ww`"va CjLnz-wQ8TDGl/v@\vkC˚(44ˡRm;&B +c{N ]*IVx*N%H .꾠)~Ē:zJ݀ 0G2 ~:m l[HچKc8! 'WybU',I6wj4yiڬ/7,By\60 =/~Đmv۽8&c;4g c*e)LD4f7ͯW<CG.`'KBk_'wޕ2k$ePD3hn=MCt 6t{%8ڳ(=Ar L$@31g}@rr̹DM4x B0y㾠vs/ąwf^~h Nᧁ^\d}Ug`rD&qzEFV2ie}CUaj8[PВ`>*$f5wJ`[\fkLjKk?&נ&L Xx|%b_ 7 /vzSTE8P>EbNØ[/ ]J1$rMEmIgE\VHMuV ×G/ P,)|'-io .T}Z kZvwGH yٸ_T1dU[vngNֽCb8_kxLEA66iYs`gC:0-:q,S^O):lBsp!tHloK  z4;?ʸj8klTN ~~ЁvPWYSLa<:6$yQ&<\Z5PP 1Ұk@r h\f 7`X!#uvt3zxx˒g0cynyoɇ %ri]nN0hNj[W瘇'ju̗%{,}w21X~LL?^Tmы._Z:DihyRPtdO~Yo *FHƱ;єO˺`R wңfzܡ$njQ c_D哳/T4?t˕2$t郴LZMLJnnV?J*Q .ݷ v?ZpOl]KmC?dADkZG~e [1/ ՌVߠYFZ "\9M&5M [?uQG?TomETo[/;Pm767&Yxc:03F2AL^(H8lˎtD)=TQ@slcnO > stream xڍwP6 EtI*@ DJ(;JM*һ(U@"*)R޹>3NfoY|~LX B!q @P"@%CSX0X8 )Gi@pGCw@Rr i9  4 ^p'@a)yQh_ G#J z0p( 0\aP`a8Spr" /\0, s 0x@]ؿ f(g78B!`:L`!r6Ap п BQht80' ~9BX!# ߭CZ&|X(aEp/Y餎!qX_i10(}E F-9ÑNο`8C#`|*\`8$PFZ\F| }ѰF/5C8`00`~iD PGR;;A sK&X >z%0 DE5 /',.@@ 4!yu ?2"Q_%~ HPYE 4 o%PCwumC<?BEXZhC[uq’"]DI%ñZpm8Fa.B_6A 0L,aqKV}h"(_;)&)`0_J%$DX^'oDE(!@pFa( Z E*HV@bQo0B'BoMQP0փ*U6o!͌;bCEvn$ܜ Z@ZvnFjy3k|%V\.%i"zd)W&KAmCS7/c^xQ[GUYŷ/f>/ClӍn+R&yWMuq YӔcאTi1I~z6ʺSY-ŭu|)Ү)qoC:Zp9i2/W)ykљ y= ^dX=t]w=a|BIgy^{9GܪJ[d_ p}Íȝ pm+LɆݡgT_{j/qxMw³2O*zt }SͬS{{Wz[=$}{p=Yk gi|r+j8̨N0T+8WYp:t8 `DÓ>}UbEq7gJ-AzSSf>6L-t{K SUh\&P0&=kUiΏf~L1\Dלq6+\m\(?-fzB.5lYBؐz5NK)tj3z|TGiW#`dnbUu .eWAm9zO!m_y[nByn)?jIP2d5?%@>Ys@)x\;} _Nᯊhf:z'BN-خu>Cܖ9?xт'%Oy#5~LJ115J~LvtANVvs*pqy`fU1ge;J'oNa"v7GEAoȸ3͇!%A5A&bws@P ]*)>{ፃh\SPPS1[(2'}wNjOV B]1^"OeKUߐ]Yf$H= n[T1 49(Z*8 rWK9Cl(y'YSc_sNj%C@Т0wlG|xw SG|mU\wE#=d;Sn.#&Ok(JWPsWުtVyb)&(1cbgT_q6&yOP_v8.T[){HaO³Vw:~g=7Ƥ9^TsNwAB[Da$އ9`U/NĠŹmli T QYba k)%mADI|< 8(|)kCttDkx&Sݓ+O}Q>*6} k^f#)Y5p rC SAuY GyZ>M|Z`Gn#|z g޺^'?;d/Dr> @TiHҝ󾢉c3i&ɓlr3VNf^lfzB) ]ϻK?>ݴXYʻި3?tƺ:a,o$MO%Ӫ3 ~5sR8-P3/AGÖ́HACɩUǺg}|! ^pl'o|[`y2"tfMl&.4vHGS^f!An/:}M+:2fA  S- NG$}-A# ?'pԜV-+':z5mgN HLeC ˧{"_q+Uk~&ER*I@iY1D-DLw3aWpPooUbCPݒ>oU3bvp7%~qYK DLL§⟾~H3C^E¹iDв`˴ RbTĢ1 _Ԙv3yF@X`ʤTdj&Rj5t/z܋w_sVxNZqe\F1aM<#8G4ٝdSUݯ9ڌo,f2 'g[ү6k\ J6z_k_iCCuvaMNڇAg%<GRl6Ԗ'זnqIܞuzwe3"cy'c?+V-n)m^t.mrfRj/^Sa] 3IU;-DF2MW'xnRJSǭ4IK'ރL8i9nt _?Uϔ ]j?$"=`Xڊ]v\?Wf7)dGTv|E#i֙#nU.h1ZS qC6CYM')uEl< T}ًA4"7c+<;y#N0fe\ļlx˱) 4߂qVn2U'͖{舱mwǡC}\|m Y>P2M%?`Z~W}/̂> ~ŠTAZRr {|<:ƻ|54P0W搚"{=eb ۚ⨾+o 7f] OF;~n\ll?y)Ҧ웾xg{\)ՄÖy˚*-)"bvsb|>r1OxX 7Wc yqO;M*VQ0$36 2EY|3[}v Yuc 7{6+gM r6.Kal{u*_(#jgDw 'ׄqDYE{"RNݏEfVSPC a,|+桋FYi4)7z<} 5 Zg4)eB%zZCMm՝oc/rۭU)xX<|I>6H\-;^R"9 ͡,RG}\r+A#"eNg@͌! bCq*g)i_].xΎLa<=6ΔD>7%Bh#:_?,5z9F;G>4JUS746'uPlfI]y1lۚ*CީoiI፤?0; ,^vg<^>4 ̂idV&Qfs$8xJKH73Y.La@jW}\7uҘԹ!K! v\xOsd5%o]CA֭hҡqjKv[#hIG Hvj+UӘa-s>1L#[J r.>c U:ہf\ʚlټхn1 nq>h6/V=CI 0'TϓezzQ heCj={ Dp{P41-.)sCOЛdXRњrmyLPzNER^oRl$&tPHL$oaY #jf+Ѵ\,yWLK^<}I`ֳY1:(rSqxQ΃ دՍ$m5o4EXw9bVpGcs1@(e\YC?h mӶ(h#ŏ/3{^%5fWt }cd$D 9o+:H&d9WSs/P.3G r+Rg_Ԟ/C+mAFpG.UY /ɈENxX32 Rfnt͘V*"8Pѧ4vSry2`z刱Rj #y_;!EWI_<}$eL6 uIECB؇'+wX \d7׃Q;p^2V'_`=#m!R-d^9KDӢz'HbK*l6̌d2rZ2Kn<ÿ8f3|b#o}bQ+-"^9.w$ĤaҾD$sj]iLXl%*\R[Aa\gهAkYb$QdƩ9~:o'EZGw-~sC GWzt7u#φ|?Gn$_ICÛ-yGZrͯiVoŐ_א+## 'a^6I>ao~ډ^H.r)f+EMUq[U]䢗$GvQaAIpSA{GF%Õ3u iz=6,W:Qiř.gk+_5 |AA`ޒnȎOő׺{)>ܧx df:\kpo"cBgd3!l'!L/Ra,sUi~ J#㌄(ǾTsC) bemE;gOMXZJ gd찬X/HR1SU|nUhx/ѳa!I+e>6*gA%|^(]'vc<6E^RE܅mh8^~C|8MvhNoj Erb̞ӕt@X6B}P}ŹO-.V_x,^ Y/Kg_vwN9_ݡyCc_XnGXm}NoJ3k<'ArO~*Y|7˂Ux~knVuir|~v"GefgLә0RV~ oM* 2:)J,}W~\7In27<{[AnbDV"@);II?PqUWr5CʾR.[&N*¶}t> stream xڌP up]CpwwBCp;A9ޛ+`޻-=P+1ۛ%\YXb ,v&6Djju ?fDjM3ގ1' &nSȺX\||,,6;M@&Z diG="@'@ h V43ٛ.rqqcfvwwg2ufwpXT@'79௄&2cB[[8` h ^jgtj2%?6V&g_D :y,  @IR@g{z7)8$ET&řdWр,ag.fok sqFk 't$]5@@Mm@' 7/;zY1EdAv6q\\:YY 3)dlZwyX ` enog;2+iKh3|oF#' !7 *?e,.pXhe p>/7ݐn?n[> aCe9ze\LCe9K< 3f]ۀΠ.#a>pf3WoI ;3{'z0xO903ٻ,('Y/? ,q~#o `f0KFf߈ ,e~#oV X]T#o`VzXO7iFtxz83[_ j8>3{pkbkY`M4w߼|@[sg?l_6p -~C0/' _ݿNЁC,]7 hGW7'xgc[_n~dwh:`-p\@4́0]]6Ra/<`? (>'8/pV6Vo-bll p!]Ӻ=usqV+{`&/?R\=sO_Q@¬uMH};ΨV*=G7IUAkN"I[t7‹dGMuo›TZ~<ũN Ώ 3 <;h~n)Kʃ޽[ʣti8lvGeKt1F~`4ui > # [s)W28DouO3^+lT$74ޢɲxs˽Md(Rљҫ@v ]܆Xs!DX J(pZ\YjvXX/N־Qt;9 2ޅ44 nujyOlVJ/jy/$e] (n- $T;Bu3E r3oEb4Ɯ;Ak0ϔ|+v 0tϴ*5R \&O2M>ʁ( Oi >n>+-XP;Y0/"ƍi`tO:cw @ (WJuɑ--*o "F?/6q4s[iWkt^,W5EO׎aD)`g=f0`&dYoze ?}nt֯Yž-oׁZq0ĕ=!bWFE M"@gqUOO"T;l#bK`s*2D.y#7 ZqTY*&؅1QYR.onXo]G33D W%s/"|^UFFS& dyh9=kxX:_ Y8N?@`;h8V/CYuJe^b KS+4 1XPnKEĔ'>싟)Y~s.^ѝLڪ']hB5Kln\k](lǁ4 v;LI9e9wxRr&bRY?II6m!JO'J+yrfCcw.4K>u_S?rJc/֘?t;;&\AH.o>YEdͪ_TP 9K|N]_uwω 6Ү5@{!4\QSI8RMz5Qy]RSNR,LJv$:ymX;Ix hToyxnufY D.,pLGdLtL00Fzښx}W*9U(ʯ7n9w/NV !l *wFx\k&n^#8F#ؽeoKb0>+0:{#Vkj綎DL`V*1)e޵͒wZf SH?IޫJk dCgcYّh:YB޸_:<3`¡ŠW=(t,h,.;~8l)+ME^>,|'R'nm RܼT2yK ;.OpYϒJr;G#JDDW'm.Bh-Ӵe 1@ Yb<}^"3쐈Lz9M+.""cLzyjl fSE !p RrR2~n|wLM)DNʑLld:RdSVeW+Wӭ+!w^uԈ-Uk9,AZc)k۸zMϛEL J/?"L/=LNT8v:bb.”w<ç!sl%?*^EBow:@Z{%[ՃU ^+P/EL8TnjQ{ݛT?(&[yxucy!i*HQ nȄ,3 IVBi81KlvٴΰjWB{xM_v( GJb0{~T1I$t{o57S0SVUl\ϠeXϩ _Dm n^'\qTRC)4鏴5B*£h2 .yۯz4mO9VvthL:w]j;O}a3KEKFOCW$񖓬_[:7niw{b,_gd y&ܼ#5V9 Nw AstlSa8Y$xr11ho<3x&-g,xvHʩTU4?a0l}x3XyymՈzUg]wn:j ҆4#!ɷEL^ Ƿt_ Ͻ##fw ^t<,9Ӎa!J21yeDbD/"^ك#@:4S,65>T=k3N{R!6nzgfӨt%8*P]*7yF{Tx i"m=+AQn֝Zݪ$&6?( cmYRqTҗA< ?K ֑n~5F^5A9B78Y~;z܋UL8Oˏ86^&8dCw1UOO PauPzFw-ͯDI'W6MUqh.L%$B)`zz\,ZI~`hKMF\Ԛ@eJD7hKbV9? Uw\'Tg"0b7 ;ׂS PDd<7nmdcFRiL+c|)fJs;+DUਃɾ!RՑh̆-G We*䕫$WD _3.O?GcTwm.9 >˜6%J#Rfۋ8Pz7_EWpVh>gvRq-C!OEG[meqCH@[s˱cUohl0iGԶ:[l<p"̊V~r4Js_Z ͅ4z9:G7 _Bp VT$=g MRrep}G-02Ng""Ak: ΕgǓ:N$7|cIߨ@D\0Kcao64[mM«`t˕hSm[$|W ۄ&r 󄑡K~mF/*i7"muoщa\7z=ߓNiz/ ES~L3_kEtʜ9<%Jj4 xmX"+ӝ؄9kt)ok=X7 +/jǷmL;/;vΟRYޢzVټ-NČj9!s`}&g,0+4Nzs}PKSxgbESPֶՐ,{ " V+COu9_=WKǡ߶B[޾rf3(N>wf1(H8C+:Ϳ"m\\!Mq-*wSuE^I/Bmd~ .Kjܨ:UgK($4 " e?Z11oswju0")+S^9FNާCu=KkJϾcu)z_7dn,q؃VKZ"^"~LKWв2Vhz:\?IinF(sUGJ͋OT凍jSi@{#|3N&!Fs BvzUyOTa7lD~E6WjmqD"Yh0W4Is5à U~, &Ӿ ]o/w\"M1-$JJ̥8Y{uy3=W7j+,[ֵfpX4I7X}^bU7T`$ s}~(3.y]u Ꜿ=goG>riO(ݣ#&Z#'V;/t/}B|g԰ ,Jgl[:E>Ϟ!u ՚7'24k;r_ueдDn-;\>=NDŽPClEr.0<~s1"c@_DFk$%sTۑ@9FJR)nGa3qie*mL 9~l*L 6jM]h+ ҭj>>oB#)aDkȗKJPh70^ЪRWudUd޻QA(L7/bHX'T,O<< ШՁ׈ @9B0*-Ji:łH'$ bʤd+NU'X4paT+=\1=l+A Xw39 kxWXL~IXibi~[@3~ h7^b]9{JfOJ$ITMڥnakC'ǫ %i|GeG-Lg@Rүg!߿PzڻUT&]ּ=ע;pTƓ59q\/3E Tv1ԟ44Er*GQۚZVp/3N#Tprfv;_v=ۈ%զ-ΆtU x K^gyW>|]+y6 8b4V@&ة?,:E>_)~L.AA0fkYCt3b{R#/mf'v_\&v.9"E#y+YꎉU nCn; &qn/ 3-{+a#cEUdŖWr ^vW1Ef[q]fyo 9,7N,-*7rӻnarǮ2('mcah %"SŞqW}]6W4urF p{v=EbԊ' | _sV]T˒#o5\`1K?N5yEu9D\Am2R}ogL(>L ֱp-EN`A'ѤT1}gk {n{pmODd ]%f;\ W*jpi!{?PDCBGPSkr>[!x?(sԗAXD,5B>=H!:Je"TrYJ̌96b|,݉fF}B1\FWq Mrf8ؓp>;{v{ŒGlVYOi,G"w}!{xI֩Rne}EzrZ\ .:!OAO L_}34>~MU̔B,1FKx9z܌ѨsV*tm6s6?.s2.u] sMaNxgɠJ1'O5̹]tԞD\9 *q:#$WWk?:/*mN&I"x:G*HB0ot(#'4KOJR.Z%\ c %V,PR 9 SSz&S7:e!yeoړr,No<7d&?SD( cUtBTqO;ĩ?qzF/ю`V8ғMn<雅EwFJ8lrϫ#Qm*1ɽ^+Vʁf͗9kϴb&sbyzexdI:Uy\~OEEXӽY`mI\77I<,#zx.fp2J\ RAUxe}!q^I|S.::Y ȲJDOf{B"'& ⒫ĸ(ש5[3<g[1b'ReT΂ylib. +-pI30(OEg#s*Ƽt.6CQň`kB a/$4$mnn!bg&ˤ(ų>V5 T|iTk<^{G:bgH;nϢcBI隓ޮ5̮w _ܷFf4+uߤK@p$,ZWݜ'C>N.m2]م pjA"===.0K6ɏsaGnshFp"5|?+&+c锦cӝe{eN}N~A|HSDUP5ma'^ΕNwS~#S0Vw+hs"D'.OpwxsWaфm 3PLw|L?JUi}4e ZvG:?-:4 >\)UI@5}{8Qǀ aGǓ+0Jk p++LgH lPL^jKٖ2z?ujjF:ww!Rשo;\ @ޞ ș Dь+$l *IΏޚAj O@<4/Q:$w'C@LFL_-Uan)c?.uL@]DI(p)hm<5C8CŶbG\mF6Hw:DWڽ$Uܢ5Iuq=Xϻ/y٤I#ZM0mޮJ&+qC)mCW] ߨЋ[O]8nut˵ rzD\-G=vx 9,|#Ķ6$qm^b>L=AA-[yв3pE#ٚýtw[9g)UyLnYZpx`Ⱥf} `'ٔ3q*@tKV|Ruqr=ʁjO5 ݅,oL]QX5e!N^ybj6]oݼİZ>x&,M"9A.;wYv}NFl,=`MǪA2R&c.dOU[%u.ugSWN5΅Py@TUbfDrS1ش)i`/"vh/wxXcD@]Boerݖw٬^!#hzGe<{ַYqцm39"Քw# 2mjvõOg#n{ u._ 2Z>`3Ư&H">l]ޚ)d{緣7Й<>Cnm-9|L&0 5m%C FnId^kQtMq^Syy9 r: 0E/ѡc1$j y<:l]$<!ypVW3?DŽr; $lt"`ªͥk w}e\R1q}@&qh riuNbH1~st?.%jy^[gd%u M!(YV tCW$S54NhqX? zpmQ`R"W|(l%ز}\ou?Ѱv}ʄL6*XαDtEy񏀓(BCZ]&= O:԰&֩A86"xuT̾NxDSx٢+}rC 'ܸcM ۋN9v,lOab|MO9ky+:'A;ώ9j ;==R8WT5d2%-"t/l}zdxe|4U[nWmnUZnhBu5.H=_mK\}Q:=VP*|fgL*-Va1,n0d@ s%ž dw̼*^DZ(MzxRL$jo~=rWƨmW`QT J`!D=6:g󱧕T7+3W0)# ^ȉ"2_6\` e>2lYYfu4js>֡ jig.z,Śvw¾_/@dqx/? }@aZyxjSݝ4=oW:]rӪ?^*b?dC@X-$GZ{HϜPF`Ms3Di7Ia+Zot(E`M^\ #[T~T9]Y?| Þ bҹ6W ^pރM"ToSK p]KIqbeӴmobHχ`YWtbEt{IXBXkd=wYRQMV̓ B8}sX[LӠ3cCj(?;՛ַ<Ñ;v~u;sЮ&ě=yh *qm+N`h8wCwڿZ)9j!klYXDj[ {K>e`I3$Cliy}̤|c+j=(s^ij$d嗑j'_JAxP*m#b2)#&Lhk ۲24Ċt'9q>:_d6nK=B #(}J?DJ* @_W"Bыitnthe _{Ou;Sɩ$7#"MdlJZ+tm2_ "ߝ1P%b?%$ rRj|;ˑvk}BBp)hc^90#:_􈋹i&,{ސֳ4d;^8˨~Bן R BWIR7p3nbxź92F.Tn%wgZƥ|#!* -'jbHY9%4hTQq A)_,,|7DIp-5镁}Q"q3ȕ }xh ]N$끈Q)[Uu5W?OQZb;6 )NUi^"f%D'_^f]w1Dl#y6uL7| RX-Xcm9x39gPvђ'/cҗ,Cb=yrJvF1DlqzF/95bwP_z y;g+RY^aQ1Ȋ}OZt:RFD$ǎↀZJٟqAmdSLVh>pF}>1i%ή6 *7/"t4g®\\/OsQ'FƝ'mɨG5C:;K^D;  t 63[/ȏיM{em'rس\Zr>|~ryl;>hx/U:O((aG-hb:Ӫ B$1vmH~Q2PC`>fk|.vփc+m3}i(m)߄нyNՕH!pN\bR* S,^ btȜyLo]㝥 W1R__Pܿ8q+yʗ.0]c}W AϾS2)IMӍajtcSU*E/t3+\?~}'R}SN@_Znvm({yM(oi 3e%CF)i;53Orw; hy4Z{VX-ɢ3U.6gY&,h+G.9\svsZt X4tޖk\ޠ뜎ȗ 7t&6qX,Տi\!yM li5XcYj)pƆz(;1N #mX 's?OnX<ѽEn,t-0Xgvٝ w+6nKC;%`Ź^洈nl%~IW@2]\d: <סHaO K}YFynTYg.;=]`6(7CM<==#K|[6wgfahؖPZlp(.0^joGT*|(b W0-E}PaZ@Ӹ/D&;IWaKJJDy݁lc!-ܓawVdKg3#&Z.ݐ,>ԅ~nW!iaL?q&ά-mAka?vA~Rd I#KW?uV<3G- ITI~B/aQ?l!o%{2o_xɜ>i@qcBEk/`[ tXEnŽEuesJlSce$ 3[gy!nYA*56sxd8SngtiJq C-xш#`=!uN=Lz 6'8x?&d?ڪT%APcF<<{Av$;UJ[[`뱚{Z#6::~\Ow*A]L͘Qw HQ jM&T{2=Cqw`]S'U'vafz>?`U[TfT&cF,6KfJ] ީ#n/IFf[y̢rFđ|pWeX5-hf,}kAviƗZ'~s{Փ U?%WL d𝴒 2#xPxml@vlmq%kg-TOiܐxG0X҂Z3IzfJ6w,IԌO/5y?f΍S]Fde-Ҋ/ؚ8i9# Bnp(M `5\ᣎ2S{v'?߽5Yp@ћ2 yN4gu4ʿ£fj>2 ݊w^w ſaAhL@愡g(>ܚtQބՄwOC.ب [8 )pu)P=\1cJaL!e54#ޞp;C99.тV @7=uxBe_~TyeOt0jU 'r=)*! 煮L:}4}8#S1M'.rW]0q!\D3/ e$[jG0=P ù˭Cѵ,z IOcQ6.%MS[j'UWÎ@F餂0iTi%).H1<8$[A>g_k]frjTkU=l-k3fm| K?E;6#m]PDZ/5vCEf{?=߹ކU4eL6|6JM(6 JeA+#_qii )7RHR4~eb;fC3dZXL!!6#s6wkoI$?KO#}Q_T)m|<*6=t2cXpT)=EMik$̔~i #f$ Bl&+ar;}Ah=g8z_r++Yſ^ݻǝ $\4Y狔Wt8&xM3x6z^MM!x$??P~e5c*"- ۻ4#$U Sq獧5,8pX64,( @%exF eRlY󔥹 A[bvEh]Eb[AᏫy݆6mm6c:x@DilSjrPJ`3bݣ'&rByn-}.6 `E=Bc{>%ga:d%v.0Hm. x̵{ I.Vתԭ+ $^',s7߻9dNm0:=~z/qK"&"E_mI=!JBK>@i%ٷ{`0;iη`3E"YHS[,T }O; }YCo{p[.:/Bͯ{6;0b0bזRbq_8jrԀ?A]i0%,hvKqマ!a%SWy <&\wu&rlĉ~A+ XsʦRV;$I'E-3Ԯi -i{" D4ZnTEv]N h\5pLGK%GHͅj1oD,M8/&[LÌ*њ04[v_+ca3S%C0'}!+=P2kR*>t#%h+݅O{/?Y%7tkyclM.ϱSHKt3 ]"9;/{fpˇ2km_\겳ʓ󕴌DGA_$n5a<쥙sXLK7mx&%dԖ Fem94싙l s 9*WeF^-PO2pw0oU˄cWcp5UA,L"+ >@! !Y !R&jDl _ ~ [=yC+l'$KGQ>܀8XuԄfr~R>Vi(a Uj)ŏʗ*RP_H>O֍rb(}| ]s'-IcĂ󒊬nF01vwcW`Vui1ZybMVSCJ6jpƃfDL |Y_H5`%'g-Ё u#84W2W 5"%r?tHёGK3tG >6፶9o5(1+ -SI@1>G=+p #Ǘ =G+M-%o$ܕ%|xS˷ 1YX}܇Lb~jQ6=Kܻܕ70{:I!>-aLs :q4+fmYT <=ce1<9iqNUWgbTD/Mv$?lV}gCDz=)%F.M.kv$T)rQvwZqi }_iNJ{GRE?QSoɐ^osJuNJKQݑFLsu==3[FdZZG!1sג@h<2YgL_Ugآ5\raTJEN+/`V\^̋kN$bAf&EQɨVq n~m'Vf95a=|vekx[,q1K:Q.>$A֐n>>1њPu%Ƥ掛ֽWPU]fA=L=ł@?P4^X^>RI/u.M 4r:ȼlZBkME*ouD]@\2%Ų|q#gZ1KX<|Z@tF1qu j̇Vήyo 9 >?r:Ú5̌6We `at6%>?};h,_Ir }ܞ ;)5 15SPp/liX,,> rjصޖ~]9:d8\ Fe$T`dNeyWCL@WaD76ksP~:I_}ɕ,ycIac3;ȩ^[䖷H/A9/^#/U߃Vja1O1y?+lq1$j`5i?$ wpa0nR<(z*1y=YBUOgՈ_U~vbX7qL\)ӏFc]*CߥPqyWP,[Vi籅)x1UK8otvEpJY~A$Dzohbǥ[Q!/JM|b*+T?E&-2aR1#45Qui##yثҼ}Ʒ |?\(UEfx Ya2nqix;ê6 aH(&u-ߤ-e9W}zVpO$'h|t?Xm:G@Ha_i@4U !+l>r&ƂG9vf%V@[w2)cVUpG|%I84SMz,PAȰ9WbH}G3()UNpL b,dbXH(; ֙N;Gc]:E|3<]õfa1<ݍ8*Zzc&P1@Y"7aK| h|w}hLYwߏW$+YS"0VM/Ɛ[^ E?5A/H ]% vil1淾jrI>0\"eƢ!]H5%L cF0 nuxNT aȢQ,be'{1P6R@0r~Y4~] AAr£feٱ2kҸ{T8* e B$^w2\|ZӟQtz5n.` tySZsnfg3,Mi찔oyXX:p`è ά԰rԎ(wgjŲP~> \l0}lutVޫ7 endstream endobj 217 0 obj << /Filter /FlateDecode /Length1 1814 /Length2 12167 /Length3 0 /Length 13306 >> stream xڍP \CpI;!8 0  8 w ,'\ޚ~VwzR]Eba,)-ev;;+;;':-6fVuAbHAfg왨]\^A>Avv'; @d Pa(B@gtZ)dm{GC@Os 0T`6@f-60 3+j- pl@g h dXi6 Z+x؃,`g% xRP9"0>+m#Oc3 X5YeV;`hf y7s5ٛ?L +0{- G33p|2`K) sF#?ih|l7 q{YVaȦ9~ ta##O%>x9BVe??^f@ o"t%0ZxٟǏOFf {Cl*L_$ `apppr>Sn;yT[A|z)ɠ{mA<@?ony 47xz?z3ߌyv= yCkU U=yYXyeA@KuQO/C؃@u3ktϛga|8?wOy7 br̠P3xF</U96V0lx. E<6?D!~'MTT .;lgzgYqs?Y r؀am]Y|N_97/W| |/ ` >u||'[@7<^@;}nb!h[zS%ڍek%ަ 뎆WnķU΢F;}Bv;pA¹V$+ fQ\gemS.5IfۥTƞۦrCVLpb~~.L6 jvsx2ٽԞANXJ)J NzCZbB ǙuƢCn_a )TU ?&nv4BDUy!$hz3jDq-FdPA0P>2>"R^J6FT1NGA3Sqh?%31"{nj #J-TmH Ⴇb>~h5dYl 8fX\BLꎅߤq :qg՘W`ԉ_ c2s{yEhrs0X1x;i}ȱ Q.iWQNŞ \ܗ[|#cGAn-;zPRrW}_)D1YFX}%UK:5xsM*aD#\:*"!x0g̹_b _bdMHgHލzԴi/VЇ'DEVIꛛvKA[D:}Z mYz-p]FORŠK#?"+n~|r!w{2K3n-V$ Q%`Y |6&n{k+j͟10Z;t=H1M%`4"+Չ3᧫>nh7G^FR͈SOAJ)8wڊVځۓrJTz% tS*tJ;sr*/U6X! HvܐEl$7LC~u}s7 ~h*EgcdD@%w>p> 5BqXv,Fvn `?Gةj&Jb<4coRq>¹ҍB.lI0׵^|=A,+g^y?ݕ?AZ^etn#)ϡ]uTtbo4JߘCQo>+/>AD4QNDv'вi8c|ԝmi:SjBiFD:fE.G.i6U9n8 lz_me!DeY#m!mxȴؕيNWrVРcܯo&j,*?Hy5C񔪱3Oˎ!h{+յM׻l"nу̫V|l!Mrvq"!NA>AoIѮn,oӝeHGtbi=:pD!25`%܎mdN3#zrKAD#y%䱼jLukC$zZhIbTs\0qm.欂4ceSȤ(yO5!|i$YTH~OneT-,et׷ 3nR1Wg=^3%cV@ioo2:0˘r5qJTD}IE~xa `C"?Zmm YejZ)UkSp(u2#>0OJjhq VҀX٠_ | ׳-ju?ct"7 og~/'qy+kqG[4J.%1d r=HGBV؎~@1;Y`n^!F2*}VRPibgW̛*Xs%b;W0"*&2պ$MՎ,݉O\V[)r܃_@.JdK'ķUdwID<0Y$y -3nU@=((աѦaGZ%Q~.v>a?-߾kkv"IOUWs+iF,N:56{-Yfun[ŽrVRBiѡ߰{*$>i-Vw݌?;inG0+l&iPVwJ^e2ٶRH<& ߜHzPnm:-x?YDn%_x-)~o%.U޵&%В_n3!\@0blU8 X9~Ti|!p1unG ݇Z9׋$$bΨUuAO;"d."4&«3bTacy!p4(\;oEL%|L'Mw(6swY>S;kgjLaZ2{qg2|[1solIƹG_Ϟ__=H%pD ,SrDN ߎ՛,G-ͫ,scZnw0:>_hjƣh ?l ~):QF ljGkOZ$jR}xi3k&In!VJG?XN&$E:"K{5U}m7tqwN2|M!tO"%ͺՉb5tK&q:+l/KT& &S2nX`%6VxLo'IЊsVl\ SIYk_tzٿta*p\)ʀu-(Wi=?)pF]PJ: ݽSKs,Ede/iIũi=& ZtWx0=Y"20S%|1W.fHhYd2bQU.zxxl`ʸT0~*P70Rba2Άњyۀ#>E&;+-}6r~grV Lʊ9^ܑaΡ֝)(|#D-f6ylLx`!Xv!N o*.$!D czx;@J>@,d'cDtR:۴}fC=hzN]8Ik^3jktxQVlOXכyBtał~(/<x^+` O>e^ qCtalP: "ce^8EjfNAH&o"7d`9Iqx|Jv1 QX_VϮrE؏Cm!Uѯ+v?ʞ;X>{}p]M!=db0qt(a=WT?ms7-\|"F~NHw¥rYR$W,'%7g9zvrkK$(ujWz bXW)%ݧjd=T%Yˏm!~J9 ƪiHu1jM[m3EFسN曵Y7xhİ %rp%|!|*l.ѓГq`ѥ}bǸc]c6+iHBTs Ux*aхtyĦ|1qrLCmE&}mj79y^ѾU4gq, .076fWrcUuc :6Pۣ8_Z=z2+T>O<};r .A[@S|WHsI }pۛ}]u48(i8'%6N'ҳe]xNAKaIk,w* H`?Ȉerg R7.=q!rN;:lIJ7SJp-^9>S˱0 J$c^Td㧋-h(> yxCd[a6ÎZ4p% Y/ߪo;j! aS[1wYec%Fգ>}1+?ԗ숪}N V3B.tc(_8KVwokS/h6Vux\/2$n"U]vfx!~No(2xm k0܀v Z3:JUWE8ctsozFEmxl܏Hdi9}EO q t~K10~n!F3EHP!AJkF!zzuL&.yOiRB&=0DJ;|#oCe7_V9;  jBl̽δ>R!a_[C>610ٹx1ˆ /8UIpGs9{P]7'ɲ.z[U&,N%| 6,ZQ 5,3m`\@TRxi7]Z#Fo<,VZ?Ybێy2=qO2J985.P'_};k;+sz˼,mmrhekI)Àqaj<ğ̲DɆ䯼Ċj^faG)ٶ#dce8l/jk^"qk׈:k8)]?췃OPt_7xUL@iv,$ Plw5Zij Oh|r]`a=C ]+cn.ZԘX}o:as>1 "c,H_d՜L :r#[aWi~zBjrC21ؖ 3l!:Q-. PUj84sʪH+6'}[č&*ی7^w_-dX~֜@:{N&3FPgrxM]Q\X>nణK0e'`$+aݸggHgY sHjJZd+@& S^i%VQ[X>}@vbIػ4n[g-P[Dk(T )56GB۸F~@|cXvAajWA^_%׾mBC:{]b-xCEÔ_"y1/Gbxb^A9MƴH Kh_a."F-_چU[IM[_SOP=Y{>sd3ͣ+`Aծ{.d_37Xv^7~ )skĚ|f);UOe<JG@wtZu˅7'%)菫p`&,*7jk%1*c~Bcoiybt43e2՟{j탑KpHBt */3v40 pfQl46],gw@]?DxLՁc!YF$'-oO:wK>[)kLNf ͲZD&e0+K>hB=}JlU}LlS4W.S2ܟW d~s`]Ayr?p=\ҔsuKW;bE噜 %x֪r|󙙨̃>9{AS 1TQ=m%IKGjjc0VaZ׼>吖\QRyr>𰚫j4L3Muc˷O0A2jYrJ)ա++e]e4>)7|λjDl'Qo2]>Rxm]Fr,/ЫqL+XBqӹFE4UBxd_Ͼgq2myn,&e K,иHPyDj~ RlIeޢaH,>8+[btd}6w5W3f]Q!syUJœ_wBxXUgRTS4$5Y+@|gtWG^H_{}ו4[QC6untZᢲ^%?"aBB6f3YN5'5CYјpp?F@viQ< Y:E8aTv.c| _ևNr,$ 1ss*u+B{!T&/E(_%o";JCYABQ==ӏw6響c^$Ǎv-af˷b`ISdR28mտ KIF ]6T:\c6࢛CqaI'FrpF j&YQXL?jG:\ |r=JncNC]\t*ʺnl dȫ=HQ5rM+!M 7#.3r#`AyAPF %on]*8gGm;41~>ݑZ #S #)+,Bԑ!c"ozۛRڷ)e_JE3ݼi:O Yؙv!5z>#p՘ k.ZԸZ b %63yOw=ns;/m{c1vD C~1]mfC4%5*|^K59,ٜd)#ˡ:._mlEV r=lojx0`$a+Q4~q Hł=*ݔZ7~WtCM:x&:ME-RaA%V{Ndw|mbrdkjn>mڞZYjVz>TڍyU(CJHnfRYcD9Lm` 4/7%K6&U0^I/Lbh{?Sk3>Rʧ~X#c٥ȹn /59oO~qT8}0'E$#INϯ3US *s~_2ۀh&^xI&;̄O>R7 {Ŝ⣀xl,k׏GV|sCҗ$@t_DVI%<J""d~nd?L$CS,A;]1nyݣlz$+_|1uB& w=.32{Mg3ߵa:/%Wk0}iQO&ths)wVhO|1ыMY~ЕKuQ1N71cQx+q~"d&{;CS*n;-p18C]2 TMtk3ԇD&¯*/M:O!VB܄*x$ܯq56vVlS5(Z琾fiWq+UNd2a>ȭ{NW5z@ a'.]~-@Sɱ}PHI%cX>gyn5ܭu"%У8WCd $o:xZj[SYߟ=lO?ískF==Yo72A>wScL3}7b,U)JGsrnB|F9vP|N*. -`vso?eAm9ɠg],)5¢M筀q}]AAӋ@bѩwE,rBJ$dnyBTM~qd[*ڼTЩ\5TGF.o3L:?3q|[z.yF]h V=2wg]&*%)BR;e)?K3#M*ǬROEpeLJ*x ҆G |b5C9a] Kh4߸;^.dGM?tBQfŢ0E{ɠA 6j1= nDs%'/.ͱ}48|;NU$B_`Å2e &ILozh[f"&>Gww,x׵*7*@(rNO>/8/'xD0W7iz>{*G\XJ㺦dc V:8=J+ ˓E"Ns9:r3̐&wdʸo~{:/in03%(P8~[zbRp}h brUՂ5h|BàQJ d [0c:YͧϫKϗe8[ŲELӬ8bЗ)Imza>K!\VPl;sm7a}9wrD+f,jR SovD]+qt`WkbbUnc1yt ;Y𖲖O%zob-^ؿuD@O i膌!Ϸ0yiR@$Tc.eK46`Ѕy;4KР9kG(q'cSWat(-4ZH̄|9Y)I?Vn9endstream endobj 218 0 obj << /Filter /FlateDecode /Length1 2378 /Length2 14578 /Length3 0 /Length 15988 >> stream xڍeT\-Ӹ\6]C !@pu=}?1{V*UP"adurp T(kiqٹX9hhlA?$l\f L 6Uqr(8|Nvv: 濎$f3 6 '(3d]=eTNJDвuꍓ m-nC@W8>2@c0񏻿Ovda3 'g3Go[Gk=& 1-ٻ9ϛyڛ J +0wn 7V7[Uv&ZRrC+̼7?-~[:ZZ.ݙM XGf x^6lhy;RruvrXKZ?Hnf@o"$`uD,Z `B?sfhFʪ2S?jII'// '; (oIlN_L+{<FPu5@g y-_ϻבa do`K^TVZں;ZxY$"Rda@u'7MG@wK ܴT@oTG 'ߛ 0su5Fb'@+X9"n-/M/`8lM)A6?؋lZ8[YZغZ;#[gd/+qs3?j?lld%ܿ%6 8|rO;xLǟ?jp `g৔= G?w?b0O8ۻ+[sOܸ;X/9=84wy:?דTS;G'2#诋|uH sNBavua5Ğ,;c\=ڷH[PU ޕsJۈ~1VH"|' %MtZ/*r@?qC> ご3[}QQ7N{.jpdEUjs x!jp3v!Ȋ]MtMwUXs<3rHssb2>.G%No1t{WŃw T"|xm1%Ҳs'7 jΞ3as(vVG6 >y|eGAglFLv`> E(PGJƌ[ȇK|m>&}#I!lj?h i HKQbȌ &=mdfXDr4A=1 #e+unhVТw༻rwD$2=Ɇ@2q.*—6jd y=™BNjiE`U~TfJߴtIð}f<=3JHCrޭ_:3匏b!$kg۝笝ҚY(Y;ص'*p' \/4'64A:G c)N|_b9|ζInhpZ$TXь5Nڭy}3N5*u#a(V}+(7S(('7*:^e-d|.AG)aPB Sq[PT>b_ѿYEֲW ȱT+%5WߙjX&lJk;IXKy7BITU[UÈM,O'(쫺-0fƓprbEu3 B(7=f8[[".֋wDy>ݜY'u1 lO W  q֞& _%Du:SeKŴE"ѻ`. R,9t)rPa;W;/^4ld-ezfP-r3 OH0@@&xO|PNg%2{V^xF_nM.ysFQA(C3WUY_^dd/w|T$ ]b ­H?o0rzҝTX Sr޹$*[5d)=;3CeNma9 A0(xmS=ytzMIr&ݐ.m#&Tg%~AD;{-8H>y 0o':M>k:8۟6C_+RYOJN->ItS L~|~Ea@+8cQs;40P&˨I8aTg cF,ݞ.wO.5GG]֥_A(p2^bjv/O'RF gײ\}tH6}BZ&kR,A@F%/*l.kF,S3w'(-kG+YaF%*']wjQ-ͨʃ2~F2ejc̚86ٝ(jw14nBY DyQ=0jQ"{yݫ[xѻ[y¼"67iTm2;L뛙!f6_XҠO]>&h鋎ݭ:qBfbl?nXПf!<}) PԎ*:l (C)vZV,lDxh¤czﮊA[XZx#\ivBxWg'r^m 1o3'7J2uM^Z g׾6L07 8͋$ %nr~kOLln" 2Mz SVrbty?pM_p d-q '@c6&xCI\7.@uE ~& tmHɔYRt:zL+(N#ۺlMZ衛=c=jO>rShv >f؉pi ٲs>icK*倇ͺb'7\=MFAɑӕF۸a3{4^~dr x^e{߸Y x MmYq`|sg4φ&XroB[јMG+:m d^c mޚЙW|J*zB=8Ν/GZ]e^y"t[ݒ˄MP3bF`wWT85gBȇ{oMŇ*zgh2rZDƤ"K;:uz7ؠJot2S',D{fgU^/El20knȃf׺UW:< 3_]OęS $XE2 (0\~9[bZÃGăqо+ڤ7_\l SFO0DS ~y+:jf|& LkTEM3Հ2"zz2PANO* z*3 }Pl(<8Vaky[a-fi ?EVy *)Hv×^vs=&G|J[X9i"&ܖPxKۮe{=f<Ҫ70FFOt_/D[Q`D ~#c p Gir:S `7,!ip^轗7sŔ7PB귔aٌ_0@V,&~q>EagJA4J]tJgKyq"{4ίVÅe:jo]w,K_p"Yg` ~a me=۽?)4%qa98T|m%C[;A&?ΒlM]6 (kt媹(٩vq|ZG,oiN2#"dưxwe5uLyJ!ňrbz3s b(K\Uݞa_y@8ٹA@/i5V#T`>KT*ԐK>L˘TپT7vNG QNo<}"J3T 0zg+kB6kiÄ́qȯ'N|?ڗܜ׺i}~Cbl1]\E3zRH$5ʙu~e4.8ae0*IS"@4X̪a$zu&/ ό%Jz]0By(;]Iػg%W6ƻЫhtB Ea6AS?#YT?#%g 2١Z1ZH@234Ez~rmZMnD$K f~ &R>QTdܥw@X—P1𡙫$|\2&K}$6Ɠ7AA} k, )\8>@1J+kxD|B`a2@W y,˨m_b<[oLK""*B9QrpLW]gs=E9zmϷgTŞ8%zUUK:4.6:RB!mI(9deGwF"~y z?H^`* Rc.$XNhPۜ3;̿y9?sv;ӪbsSrqKU,c6 "ÅB*4,k$!vaug ̰j9ݡb.rF,kXtsd G#/!DRIIVc?Ҿ:s=m2t@fj(eȱfr\fgNX(xђ얌P-oq? s@op* xB#ǻz%޸qz%M&PP]`q'J P…4+6_VMbh9fԉF#y&%L $-O7c wB@/07-W픔ޜ 3ALt#kO^q9'`ڱɬ Hs:ZiR3Nxu;5>}yPdU/=0F|fMoA nN'3죇c@'a#0l'WnlUľSx$l"̈́ٵEl?䭬|kZ8^nݺd79` 9Xhn'ˏm"w.^ᗻy|=(7J0$vqJ~ DH1Jc N][N\Ay;#xSE{$vY;*Kye dL{LËoG&Ҥw]ôZzQg$4)uƽ\$SՎ-bI\`1;@22 N5&JBU S[5rli&f7] /'MA(O:RBdfuw$h_3mGVޜsdxG(f+髡IѬ( &}Ȕ /F@GkqP&' ;O5/S'1#Ii"NIN|Y*akbE!Gu=4Ye(zK[NęBKvAw0;;(ZסMvØ>V>O)/,xVT n,qIvFEo."eEv=>*) $W#I0b9jr|k\ PBBL.X7G˃(/> "K C|B]Azğ uU=Jhm^ XfYģ"ʯ2 hhՇ%]3;e/O·_R?j?FT}H>N]tNplE4Q7vɁ'YSܶ]M۽{؄F틅i9UKBR9CPZu˭Wp\mBPˋ7)!-vsCLKY hMQ! :&r8W)qV딕&ʺXYZk5dWq8f 8 j.f(ih7 `{mcFp6uMRnh?P&YDl#\ hV& U{E22?b^vNCѾ~|K0=?DTdP 'c5g C{I1|4ᓡ fLrF%|$=Yn`i(V0QV TQMJ7<"{p+m_(:)( ;do#bx2)ӽ} 4wZ G .< o4:)li|1 ^ͷ֤v6 wElړ4sVq: 6'^'%\ӗvq/1Z틉b?Ce +&v~"L\Ɖiv?uJzs]Jwrj>dd~1ir=w$"2[>;rV>338\k;#/OR[cR1 i/򡔟mD6xcdjxgA%\}צxv~DX[)ve E lgQ!GZ>SUFLFj0p'>U~1ŀTMOra~uƧ%"㞓E: /'\gYW1$b:m#%g){zvMgNKV)~>U8~y=6^i>~4*Uvr774i0 3ach[sѕ#ç=^d_)63Ksjp:}![q2pkh@+%_Xϳrh[vzس!k Lu@7Oo5P#ZTjcʫmm|=+Nxt۷3d.̾\8lج<6'C&Gko5_DS/uRDd κC'񯃐Gw"-h#句blK:t`ը`,,FH;Z-hw-" {^Hh. Ii3jQNJ -4YL"nlaՊ$IJ6=R'ahfv ldWH] !m*[Dϓ(y\|\FV~z PkBkJY\MvyU3| 7h|sjƐ:U=4\?Ġ\א{qW!I_Oe?B@lX޵7=PU=+pog=rZF5\[G0y^V"! 29yVO1xr<;1w5q.nm#_l%j0[ݘ0DŽIYY:Ss Mуrˏ',[jEoYp) 0zN=Xt:EҞUKI#odrS;`SBJw4FH= 6oKO77|]XjwpASR8 &U#ypcrXRƠzlC>DCM/#f/Hv=Y|A+5+l,V>3 }e@~BǻNɿbE+j&̇D츙H@;,Bjވ<jLt.4<3;kl13dDx ߀ќRNS B.&Hۢ&vȳzg: sO7'| E{18k5½Qhվ9x<$ Wl 觰m?4 ߅Œ{G)4LxM0n_ J~$~c=%OH,tf0+ih9 4sD͎1͉+jpHu‡<Cg{y`amyTKxfeB+ǹ6kl Ժoޅj Z/0ңze숫]m]c#ӎI[)2 ֶb4E. !ЗM,:5@Z^g c> ZI  h[!P[KS/-1oX)I XTd2(!xQƚē2^t )oʡ VeƑ1c̓7IRJ D;PҎJW"Q7A͒V矾{z鋘a4ީ>i}7ۤ vqN>d~Ҟ{]~ UTl7n?}cw6rϹ)aҮ*֐̽.A7òcKI-$Se7-44ck{BD?nCU{lS7*j`Yg͗_*U|詁ǥxC_?bBJafteRZf>6I >j#trgP bPׇyc"sWFo/E`&U B/>TȖB=cxE5ӑHTEE89]4Zǐ_+"Y#c2Tܞ5.iuI?+Q W+N 6-/&MДVV =.\GFрGWh7BZKNye~HIţntuw_/D1Z`?!]|0å-`+IWۮy-O•ֽKRUFG%_"/~$=Rמ~BT-GbR:S~Ig567I^~.éH <̌&1REvUlڭ_ [ȍ/b:%]0 zoT_$o#(c2|;[1~Eg[Dw}Y56({EYo=}Y Q\UьJ3Jw虈q>ҎQX_bE>߳WGZ:Џ]W2:^o6(jBs#MH^]-]k/zބ9~弌+a?*S,KH +{rF\BXd.y^h7BSM wm.7/x˸k"{;@7'w<,;7xg&9  c %*&rG6gǭg%n31"Ԥk%02ꆒ^0|(,r4'S^W$+6pK(v72W"(,WROE$uyHwE'gϢ*LEe h nuxH R_FKZڣSue\ki@9J1K$E즷] 1`J(*|MR.L6oBUR-[fKNiĬGIA>Eaޓ\[Ma_֌`-õZlC~iR K֌mo0GJԊPB 4_ A $Y$C NJ5PqUn[ `ɆZŤ3o͹)*d؝,s Pm5&^8=[K?&҇y0SK^ ip%Z,yퟲT4gܳ;V> ۭ[sk?!7mf8a0F/!څO6biW+at^!`[!PpkU9s8ee4:#=]%"`KD *]9r$'8rk?,ap}̙+_1<"nv6!SY9qޭH#<_͂wՆcd:&`,uM^t9eP-JfŜk)kFmHz|0uЈڴZm]2*BgOA^b =#U9l PD<8nӐT»ː j)nZD=-R,RYBxk]kFhuAI̴R;ȕv^%s]~|;Motr7Gge8jE$5)OEqtRxWflVb+ Qβz1Gz؋ț =h`vBK+MB uN"J +S԰~^q-|/^(mĢ`v1\PkC[_i l1||*(efS~Yc0mq,5)j rlbw+d(8WMiA9B(2 i7$Y&yƨle|M?1GCjSEsfx*vY)#2R!z~ne`l˨&9NI#췗i@dUu% "Z9#)v>!XOqhX 45(RUnUFլy!#,)/fU7-щ}s,Od O"״g\+Zn(j |ϲ ys2 2z6z>Q UyίVg;txj 9Q4C;r7xgIw:N1P9 /PICRGKߪ;lhfZLcHBj:TUfRk]ЀϠ6y UWRXi'JGZ~koW+|lEsd*?sHvŠCi!尷cQ:D͝ᆫ";W,[/)[(ݳF 07 T;XEpODPnPvא4QV(YgHC94뤄ֈ3̥[*55 CHBaa8 "PÊ=%HtyRtqiΣf9?R[[Ad3J7fj ;݋ )GK>ևŷQU̺x6b->Qҿ. (DvBsspv oҎaΰXy#?y#@)ƛqgް"Vs+Ds?fmS{ IqDqڇ}*k߷d\ P=Xm:?\!|< 2:$-7ȸQ.74}tLvŜp)3gл5oԡᇣ\~H7#,Uo`AI2[%*ghTVOz>\(`UQqYVc %}ClrL*QnK/syLi-lCGkEͻWɋ3"Yj$0̉ѯ7}Q?8RHb}(\a UK(; DFzA^u7r刟ـPߑK'#Nl>GP?ЎQ$˧zkHupW.R'gz0JWNQ=64.|=a̙]d kO+B L/ץ[RdБ]gMT}\FP1Z8ݰBXMưQc}eA2h جJƐ&_0~8ﱌo=/,}-4&9Q`%k\;L4> N~ϙɅ/;?,HTs(Dl k~RQVY!SD$}gҵ[)Mwmf;"*tŞ?ʼnHQ f}aUh{?_v.:Kgىs۞#Oḅ@}OՙhB9 G7␒U#~5޵q%Wg2f}+ ѱ<~%o^ X0"&ByI&fK4,#\2Yu!Z\CVJOmOirTmz$HhR9 =7od@?NT՗;2J#֢=qF~(׏|$!W-c2S{5.H$yFe󌎝%:wctG&[:Kn.#N@x\zi{c`Zx3 ՛]]̊ nQȁ1d-I@V7L&7t%>pćXĉZ: kBht˪-/@IymN>E1T*1}2Z&U+Ǧ>bV7hI"^"u6.V5\ A8f|nӤh!N˜~ƪz3Pu21@-ÃSbXK_Ⱕ>'IW['N4z;iTڍ :-!F(_/9q꾾ڊ'׌CU`b'(l:uثJ_TpHwK{҉;+G_5%M)ոC(׹_-*׷Yi+CYH>ƕHlEqp? m1APqė o_"B R.ڸSN1}bN˄Xs(p΂Gw]sD6g e5ј<ʇ臗[z-z$;hm> stream xڍwT6R HC7 tK 1%  ݒJI H R"ݝ7sk}ߚf{k}_{YkXxdm%8 5A$  ౰Cΐx,w;DHPT=~A_D_T@ pw @ 4xU8 cC:?6(p@ 0₪hv6P)إHW >>///^ n/ xA.q(`jx,CnCj!P!0[;詨Z_`J'W"(w0 @ah)"f vFQ`O0l:P(!lܡH/#߯46+l..~ Pw >|{>Aavhz=A< * 0(޿m$ @ x8* eFqsv({B$?<P$` euF P~}d0[8#S5R5C_N997#qqq@TXg5o`GByT&o٠[_Y)y8;`j=(ihQ75 P (H(B Ն"mڢJ A7%:'[oTmO@X}@ Q*x^nGBkb/?x4{ MOm$kZϫeixV>b/,E'F #Y9x4&ge[A9=U12Où{>m֙˦~M<,P "Ue|,1K*'|*_$7ލ7{tNNNv'F46F[ ɻM8bp%ּ7Ҿ{CBStlmzOc汔L_#09W+ ȯưSX}DI7|XYáƖ/L񒎹8,$2t=뺸{PyQ`!!-~,:p( ݾwQ,(F[} beAH -<ۮ6 OO,. D[{Wl|h0>|>d| }g\nc{viQZ]rFF i}|`*+ZHdU=.͍8э\]V{GʂN! 'QX,V\I~/B#5-w-6s ;Z486;6W}Z3yZ?{8V?:vnuVJZ-MƤ'p4 !)νNwz 6[w??]j6=QKkk8HJNoD+Gk }ZZ6XBHɹ1$[qK 9BaVu`X1K&(`+hI2|Ò!*#k&z*BZkG5#uZY%c7LG22"mPQeܮޠEiN8M:^M<QGi/̴OAsxG#?^adE#Ь>G xޯ19ݧ~5Ժ0G@ofqID@x_~['z|GYKr p3ruTOzKMX]sEkmh#H¥M|lvHa2C1@vY@LL2_A%B눂4 )덆e_ ឯHRԐejaPH@F9q1)nDzpίjzIEwCNĴ^Hsn="H7h %h5';I%?_sQ,%P"=!{;!{МT6m(F^- &U+lYBIB@þh𲍆 \5TQXE*穑l2'WDĒ\<57cqݟ•82=c)!H 7weaR/qͽxU) ls PwIRs#Yh>=lmZzQlv8eZm{(:AU/? MeIa;'3>Ʒ~mJ1V'؎ޭHSբOjT)#7Cy$2]kIڻ}na9׉f ZjO_E|<p.HQPgx冷=mYz\B%)ܛ+eså/QӘ Da1{8TIu/I(0#1p: l>O|TL*dD#l\!FwbZ(Tj ^txOӧáP&HW$mh3ģ3 >BXK =9z8`g(38mv>X.O0BOV_P zhݭo;]2FqX{kqQ Wwd7{k>NLopv/DH\߿樘nG^lV-)@p[3+tvʣܽ0ûK3Ǣ!>hzJ]hEǧ肫\D{HAx'; ۩Ө"M6B׻$gDhnxà/ت×aLznqr'ȌiIg7AX}N=[m(7a-~ΩʞxMFv+UÊ woZ, `Xo3kkX^OA4DhǒӪ`CI,_ ءUU+ ;9CQtZ)R_w( n}^r (ptnd~R(JL]6"xE.xqX"@ϪWN>ONZu„%[ OI"N7m-ʰSd1~w[ ы:/ Tf( sk}}F'm*_?r ]8e˕JtK@@B_jU]t~kwӾ|2p-.Ȯ J8@d(ui<Ůbe9/^9ǨH8<Թjnyqv~]ꡒ k{?OJ\4eBk>Dfz=> M$?=soPgeICk44P)ew+i) oe}mݘrq{̏ڂ꧿)mfƩr.ιqK_*[װ&GXY011c Va^!H}>O5B6;еتXx<Uf,]ږE8k7?x_te}4YzbGA 䩺F,7}ZRWM?7Hʨt͓UG'kX#44qLuܐ1> Vk ^OW\ 4Z|ƂB> N?p DŽQran cC硧BL@FC%XP< ]8׍͔@﹛=e;dk!w 9{ b`)$Pѽ!s^/W,&<ڡTy}u<< +iNxn+'Kol7"IwޙU,wUɟRt|ʚ?OmIzIE'#"DyɸfG-%v`S7ITSAдںlr^W7y+{QdA*Z9_'0yS/6ux9K$ҏҰ o8tGf龉Jڀ„xf}me<1%1*i8]c@)ĈmM ~ݰzI{ !CK=\_9}`]+Md R r Jv>a4@xk =KNto2{rBӭ7&_oIO9NGiMUbRZMwe"m?BT\y\}R%ILl:UjTtmqxF<.d^|lh/N`/zIG,R*S78)@GS.s'lU6ۻ=[9+|y ҉} Vy{3y=`T9,_li0Y8V! cƜ>C竄90`fJ; Le;>7be*3zJB#"er,zynU|ӈ ȮwD1^4<π69BC6^ٙ9M>bO}mrzީNve^ 3 3-_+DI=_K$] M_ :PvW͎ Y$"!c 4ho̚TQSmAG3å= P`jAA nrY];P*z8M"h"h>^hTo:Fʓf+;wZ8L N,F<^d)-havʣ1q50U.},^ʟJtz~9˳NUw6q'݄21y@6{U`vA?W`Ͱ(7F5-+ީ5n3qbVe7q'@-g#uG0Hd3B6 VšO?~Jy|X^NA9D~Cȣ IHe>kεOς̖X?<9d纎^UѢS|wEt3 4Td>{A1zc3hv?IrogXab#5-Yҿ) @%JA*wL\TM0:.?v=V :yI/d͒ &/ Aw5ghЦF'|*zHmixɂGLI^cʝU-Î)%m/̚vۦRk;@6f.,¬6&ꚩD$UV)J}htʋwLG&D~XXml0: b8 VOK^?YxG]lǕp^v.1y mҴollʹu}٦q04m&>3[[ecM$ۛ}Ev| 2˸}BȻKGD=3,u?MnxԂP9%'g'%(&؞pЍhm6 b}(W$KW9ItSFw֝%a3?+}vp2-Hq:0,7w2`79ޗx,CE\.-r%}s3kwoA-S?Wu.CG U)Ptycد>  {#n/YY^ugUtv _Zoѻ1o9>~i1JhV #ڈrrj:zlD Rq2&\3ABLa؏h'~/Eo{AM-Ķh@:bˆ}Ws8mLXx80Y:tvN/6Ԝt"^pTږ6?v,dg,C_#)"%}*&sė)OQ'.){NLn%$QۺUP[suäOM*~ͻ!R];f CPʕFhL%—I9u[mN0C~GGz۩ircK\}x|7y3& K36H B"6^-Q[>o7V FŹ|dH L鷝NsvvX%+*pM޶Oqr TY [[bendstream endobj 220 0 obj << /Filter /FlateDecode /Length1 1409 /Length2 6135 /Length3 0 /Length 7094 >> stream xڍxT>R= !-  3 )%! J HK#Hw{}Ykw~9gf 3>="y|>>A>>ff0ێlraP@ȻlH- ԄAj _X_D '7.P4yj0(,sq;:!u~bb"\ w0 дE8\> !|&c 灹;Js'r~QhٺPa89a/[wi (m7/_.+ݟ_@ :@[IBm!p2 C~o$ E2t!1aa!~) tU یs8 i @{?? D@`(ο# |H~dT= 7wyu 4 U8PSN p ""B UgwQEyz ?cg-R ۿo'DwO)y@ l+Գ90@j k5A`"l3" uDꜛ1`dF@ր AF9z@G UaFP@H`n냃Tr%GΪ=kӧg5Ĕ$j y#ɃIjp9KDFb4ӅIZ}h JXo|ţhIv`cG<0껖~jNJˮL5Pb1 ZmOP\e' XIBD?ցй8/OjVHdġ(Su['%Lw)KɈO0& hdjaMӾ^R2E2M4=º=[%ڹ `Yw9ٔj!'ovLOEfW ˞Y;sxo"[eN ܰ~l &ao'kڎJKSbaeAưbHeSPhC[,Mpͯ$oY6jx*xH:.&Q"懎eU!Dc,ɡ g"HVx`%e/':^A_ZqOϼ&}dauv,R+hbD>^-=h!*4MPhxq+a-O=EI2AûnEOzVr՚0z%u#B"PUω5RݗH%x +a0NypD_prD1W[Um[VFl~WhM3>}3W=;kĴDV/2l*JU7VpK u.^EY4HV1-^gX4ZÓo& 5g,y&KԧKI,Kq lVvY0V~kJ&;'6_C?-c͕7H6K,#zcZQ嵐M\b: H3|?lZ>V> =5(8=|0n^cEY@ K%4"xW#KI3\L Nk)na"sK: e"d!ShzQnIdh6{X^3~8v2nd=W{~VD NO6 FgXȃ 8ʟZ~-c MRyUNlɋ1590$?&h;Zh*7R˴*#Pgb{֪ޭnj&(/ Ա丮#5f7T}o/#0Ԫ mMy_1q-M}Gۋs[k~ᖩ{hqKz;^7qY/*"TgBNjwehHiɮ\@}KR/̸<3!kX;J561ViuX bEO'R,%kV_Ғ nT@ : {Z;%xǘyocS9wj6[f(UADBI|W$(3V<0uSEP.7-NiF+ܣxMmOȭ)L{˹ZdVT5wHWݘm9A7|L6\'%TPP҅IAw.Uf= a⣝ n5w?|{#:],e ;.up;ciGaʤm|oDɯ!%gF/reϨ>/9_{;`sa^sξ۫Q85C j.::YLvbycEc9eG~)ŧYWH1ݡ)a:2LDqLwȭ#hxv&Я)-ߊ?g6&XAQ?o]H cx$<%6֯u4Tno/11ɨB><& h4Sٿl\TV~qXYE %P~MF49Xw7lBMIUa BՇ~GE ?$(qT}[6jl* K:tryXޭ;rU3OWO4q3$2+o/#d'JߟAa P+Γyݭ6_; E)^[W_bZgͰ~)n|نXtfJ~uKP I ^eDh{yFWkvʎ).4_%[%؞:[ASC6SUX63;۲X* _4 xYNfSsdR*pfD%v3J¬$38 qpY>TL]uz?*HԀwe{tzjM=oeEY5֎۵OL6z!eADZ.05 gkK~+s qgč)%H< 3KOƎ.5!NYSg0(^;[})B7}B"3bYkc}R؜+Zes&GnBXY~0מOr}_}gE> zh5dxD=if ,<(N2Q1;*O9 gb74PI D¤UGjx#.݃HO7; Ȼ v1R\Xމ:bR昶,a9%Q |_0R 75՗II=Hݩ&V}_Yk H_I<)F`_{܈/t^(I(uϪs9ż_9M.O!@>ڎԼ:3Ztg>MH.o_f=((OzTm=:CM4˘n۽J}'ף脇Zܺ(Jrm"f$Ր=jCzy ]#@Ld *1 x X%:f#f(\+Nf(Xk%6^B*ģVu6üz'bW'F&9>sP`pcv(ÏfG7b}9y8UꖜײZ*L.~+U•ryX#ktI-dޙ^؟JhÕZVr=c TLoA'|MXc`~Ű< 0*gR9ǭVbĜ"OQ.LH GͽOa$5n{}u216`˹30Ҕfuy~~8p_@a)EV}.Y!RLo͇5|V%\Y;Dk'O- k/o˽sZ)JP TjniǬǹvCoYէl܀ K?q/U2kcZ>D$-ܩt!`WE+VuR˹fEt/bRf@&NtjXrT/GI?lܭQcǔ q$is]#b8JqN+1UQwGŝܞͿ]#o2ԅ9R9{W7-n`^N+'xR }N~"QoWI }22ټI=3oeӻIqhKυeHv˼K˕pS]6/hze=/1|0eY9LJ*hwTtbt#@JT jm\k1E|З؏(5ۅK=نb*lw}ӟ~nɁ1Y}_ֶAT1X\ fNG]2tU'6' Qz~Oj0wn~my_endstream endobj 221 0 obj << /Filter /FlateDecode /Length1 2025 /Length2 16111 /Length3 0 /Length 17348 >> stream xڌP[ .% nwnw~}U[S<^V3P3;@Ll̬|qE Y6V++3++;5_;с.@ЇMsqظ>YYy0q6(2TN^.֖V<}Кxy?1k;@bmfP4Y?2ͬ V rca`6wevtcxXj@W;W%{JcFhXY{Aa|̀[́.uY v`pll? d&ffN&^ k; @YJ b8hb_MR SȕY q̒@+_$]f˵upp/YX;[UPV?>&m@t=ͬXJ"_|e-_>&@ υMllsk3hiw3q.֞=֏c'3wt_W"()./gQL`bbs>}<8s_VGDY Gᅨ8Πw%Ǐ~hn}V.V?l_[_Q_*r:MnPt @+ͭ,cFD,?vkW)kO5߽agTqt󱋕}ǻWdx!|tq|>f0;8>>jX8 u\ѿLO"7~'v `>bM#A#`Q>2hM4 ZCL G fC\kfvG__7bd- -lƏf ?C GNlR\R\;@#_hmgwgno[.:eWGzVCmBjD =~Os"^EiI <^sG-vz8f/yoa5MYih0e|:vUpc#٘ڰǍ.CiUV4M'H1Qx<<HUbs󝲔W"IRic\Wwo2rOz%ioChM]Յ)ddbd, mCBoǓ_lË4eO%QQES[^.)(ؿ /5sZ]Wvd&P59k.q,IEgm ~,*%֚Qx7@-,;fh#x TYއ*HEyLrLU@=u6.k:N2r V{?gv=د=e$7"]R)/r)tն#O\:;we!⻖>cm1ڲK4nZ/=#.B; fEB$bTsdcܽ[‘r]ueo)/딣Ih&m]WppMaԹ׵"OWK1(Xklq57\KІ,M2|\z;O.OO, `"TOypvJ/IrpAǝ^;5Xmš JMy,?b bjMQp n3N:!‚UeUѳ,8Eݹ(v{q%Uٝ?@T$7NZWb=7^ |vğryӘS ټƚW+*9%-/7Xeirlϩe"E^WꦡOxTpKM7TI?P8DEmsbgIgY! -#iCdqg7e ,kAНG줷WZ(3ʷUߌ_u\EwQ'Rgc>}¨I L՘!A)Xfͷr)^$IVX8,zRgY%LP>GD3/1j*-/Ǹ2$TL/7)m PK_Rgb*Hxgzܰ\Y0.5qss P7߂Ge68uǩ:^y4@Dۉ]=pCr_t,ʅ1<,8fEy%2 `x7T< A\-z"dL_}0wC6!A`HNJQX*\VZ*$"'zxq6++*|9ԯ6&K&i:LB@tgm,CS( tW*7lze]?=gZ~T;`v4qRYLĪי1#hmGӀ$ʺ!υyP:Wڙn  f,d6(qk/2o1LƖUtIua Y7IGa)BK9W޲ii]`? {X )#o8uX <i"qXI<'oq{~[^)G%R68*Vy!S~4qHFlS^D(*r 6V`yMt5+{;u8`]4iR죦:q2]sWB:aWx; NMܖxDSǀ{6?׶r#v cu*;wEFh'Dc_g'_Ǡ]lMIjXb֗p̒wFtijJ πYnac EpFWaHͤ0kcs1J7T3v|j vr×N˷Gdu ȁ4}mL Ϡ[jF W_?xGMw@)b#K.i&wrz|1Qsa+uyyE4jF5EMȃ0}P-%,ȶ}KU w^.h"Kc\IlFlU-vY.aQ 4HrzH4)Jgxm&>o5Ľ`rj..:WJۚMd>B*!`ZPrz 8=Ԕ GD䪏*# G~j[mIвus7ݜ0-&μA~P9gKKDj}9 Z(NѢ %˚e1>Z˷3Jx簻^@5q2tvFupz`Y\I;?R(ߣtYMp\6ԑ7pr6L{dQx7厳 a*jCfE0:3?FEo: k2zo"naS~8Sx{f6N7h LphLU ~ypuqo 0@yƝ..}d-ȥZu%d^)MA2%pDҼem2Rբ*Ou>ܒb̤5}MїXhs#ц P~ŜI.oyJ[ץZck>ܻ"[DJd+QuKֺEDAEx^Y v~.b[0f,.D8 ; cx8t_uW$ylE9<d|'f f7|U'{=mܳ)(,M A sJ k0] w Juxi##SxgG?39sxAS"fлzUe._$Qc,FYnzu0=?wov,ܧ)M[hsa+u 70Jm:\{X+xh&BlPӑ,~œ3vMeX{Dxf' 8B@7īDDknKMiۓ`/]X ovkط)sh8'L}D:u*W;X'vrS,5?д^2L/믟KI# P<"(/#H_jQSDGz!$#Z9஺w@N- cS{gY630"=o yd4@;Y3{:cr8wbU":d[Z;XQܸYI_%>L5ѹL~S#D[Ea};3Oj-~ ^vܑTY"5knhS2^W<߾V"LvɞϹ1o#s#eQw!Ud ewe$YyHK7IgyO 8-]p88EwGjĶQB56D5hrɡ[ YM2ʈ>q[6F]T6PpѐX׬@n!mS<bZ1ɚ+@5m=g,Ѱj>>DCՄd<\Θ#Z[ mI5!2{B #t60S='nZ+; >pg{8Zxb$DimRЅZE1=3);opLX(؝tgd#:k]&-E"v<31<ƇBl>M, Q* I.xM)bM7lEerr1,$ٙY£Z? H-tjZ=du3YI"rOz1S*H% Au*ai~m-{MoFcy*NnIj1_mfURC%ndFEd iPNAOw[Q8VSHLSLGV.f_5 N#, ZW V*2a^\>|kUׯ|31)S' 1%i75%`>乃Fkdp}k q:<r9(6[faFC&.F{sD_cFqd?gg\DDw*n i{S}XW6(B䗆k'iIQ_H+#ʫ+{h (Q6쑺xs&5ë&_uº|aDc7mLMW;,h:IO+%(/(y.s:wZ`YM^󬐷y;*`y"2 ~;PϷ[((3;AZ.FpVʘ ZWxDs2n(j&cvs+Ry[ 2|n>|bAf=k ZhSK7,@(kdlES1c^]>p^4 ] SUv +,bƻ%/Kk7Jv]mz5;̟{ϖ[W/ qLY?% $<1F݂j iL65EnɖpԨ"e&:pؾ1T0 rw8*t_w6m72cBB衏L$10OD!a7e67ʯ|C#0Q] ϲacVG_Dq[97iɇ~>VdCNH iVVvw<eO2t]n!ac3੉s o6:i=:-iso#-׉Sadk1*x000Sbj54ŭڼOvWlrؒF3 ]dT>d3 ϣ^X  "q_#!d\ .t,k)xb 0f+'f lIbf ~φ[4͵ yeT1;6O3`q- @Ą [ӼBU_>`& TM$Т$Tg%u ɭm9 +[ ʠeNsWt:'1L!gum7_)K [B_k_e1hl[u&ɫG: BէS? z%[{+n+רdžSZe'Kw2f_;Zb>pH ?45Q!ڽ0˞ƅLFA/B3g.d3Bv&+w:ZhΖa.xW0s~RŚSGv۔'x-f5aBO4]!02yT ,˻/O__k]0ڈ{;rh~QAR/Xf5ukpfհD*c:#Sigy7>oҪ0Oog0 fXF/ 8V}|%83ϨESPy|i'}Tty:0z'{=Ʒc8LY`sphs&S̘A?D#KZW4 ]5JE9Vl2O KwHd Ngz~ܜ)HȐ+E_ݼ>1d aj{^D>+>ֵOCGFJR2kng)UG]ٱ$[JkjڐIefWb !_ d4_tNK `Sͳ gTpr/z(z][0O.gon8S+g61%2𻇣7ۮOp:ҸcbqMq6вh'ԈᴗUiR WbuC&YF2o8hDXUazH=jf^%g4C|xUAplED3z/ u >j~(L1厣,xs4A7WTR_I;-ÌOLmԾ{Dݒ Y;=[չH;ruYW v A1uOwdÌJm5\9c=~TtbY #Fq_LrYcgBC)|-N1#;'a"7Jޑp׎7 I甀ag#CQ$9ylɅ.e0bТeBa ^'͜2θ+wh#t]jٟ݁!$ ,|ocM^wQJ8JɞQ^d'^#;a@yԀDo[5}$ե5DƛȨf a )g䪫鿽".ɥR\V*?'lqn]軹S,"h䠠,hTC1شI_B:0vB}2G/oxmS~j'Γ>8'% 9|֎;0'7w/gGI._hV-m]Sȳk藡 Jʗ|=dir=%g32W DX>}kun#f>=+o4> $ S] pFֆrll?ʽ\A&˟*B#9 wc㪽5ѠBeDӗ,lll Mk`J`fpOEYb6~C3 FeШmZ`o_6?&MV80vS@G}Aj 1\H czd`+ŏZU=X6ݡ._nSD$b 2<~`NjTDY;'^:%Tym GuC& (|QqDCye‘ tk_>xwExRUs^Ѩ \ou ˘lWto'7R-پ>9]F "̷əɊ rK,f[/0ni^ɷϊ33"-SHxGk&p}Yq[U5 G?E'&jտ@ ˍE(d9s ~.悔u Gs`zwvi2JÛUHH W' 4٧[*]c^Wsv+$ +t?s 7j ?dSuDxOݽRwI4w{agpL'[hؖk"K|C+9=sLړrz !1!*f\` /f@SDɞjm'w ځY? IҌn}ogdcCht/Q̭c(>5C˱j=;E^0KGOG/{]-OBdtEz#ԣ *7\+>3TAl6An(/h9Y}^d[He_ R7OZ[j ;SaǏ":|~aH6`6@4z!ج$n.!$b)^ҵ !>S)ⷄ-5$mmY@4>^w[Pݦj_{ޤ1 ΒLZ~xϰ=Gaw ϟF%ھx{4Б*Sm$a.`WHzfΛ|7bAk=!y:٨:e|5k Ԥ3A.:"3Yz8b1{` ~rttyYU -Lg&]Dō);+vx.V~tkݗ8ᧉ\/gr tgF[e=cm~E.Kk:w19C̰0JT+~ANh,%,qJFݐ_zw{0_3B?~M 5=}_iKX˫LHK>.HnȓTqw*82i>he QunE0/( 3~m~K4QHGN܂!F^`:PN.{WUq^۴HzvmYW޾.y爫;Ty3p6gwTY"AguŬ 2v!DCj`=R' SNlI@w8ۜ*}J{Xiw!Ne _\++Oa]AB5$ ITmK? Wpg(rxWJ[`ΒuT%!|<]K4g2?oVw#sjH j23s.ofᷝtZD1v~JvD殑Z^979R&,ql/Zڞi-zaHKdh|kWgUކzʐ8ƣ3A@\]k*l֥\Q=T2xZi{%ƧҘNpj9(ǜcS ] %Faщ_,SDIFIώCR;TQS.?A=ma ӫ1_ ~w5zT OQ4-'WDL[mX*DȖx##G,,t rT \ck)Ԡ7U:x_qtaZHam-SnwI-Kj'ԫ[̱pTrtj} V3LK[ץnt]B!Ah26]Z :5yr&7}@ʐOGxiR,^͒8R70.n!:w甆!O3;~߬xzG3>W# K֭ /_FĞ"u/S",0?X{|8tӏK%wpOx #O' ryZ{Y%ȯdA@frvK"ótüD}MCW3!ӝ$pOMNZyc۔77khU-w<E!/HXw>N+Tiy^w{11d7ppn2ENRV̤ie{[W"yEval6NW0 C?y1H Niڐl7)4l8Z;ֱ-P@zWstc Dj$s6!*rr j=, 쵿U|E*V.ߺix6Dg$`~Q0@ϞBpOhAk}ԖU"ƩMT~.!gfȲH~qIJgkje C>&|@m@b,VR=05\mRt0:,|jwտv+_Xlٜ|6JsI*vܳkz,ӭ4c;@eY}=׀22LG~K"[m:ٕ È$]$¶ JQOzcUo|TU@-bh5:ba{|ܿQMYx&mwVF?>(fWV];, G;{ + ʷj -2~xxȲ-5+P $ %5T-#{)|1.b*G变ba]{МW9wPRIcz-ǟ`"Aθ8?0܄0F?cF HLi.h ½4j2}~RW"SxUav˗*%FUU~>iA{B2{Q,^/*onbQF{;ih)o{@r8+ ;\-& /,#K-Ԋ*J%&FS#$&P6* +HQDtCwd}Ff1*FmOUtkkW߫sȱЮ(jݙȹk"b;o}$;(}P~?ftV,qrLBGt p,y{݌}?y_jv4ZrT0ٿ% Uee aTĭ ٰ,7qٜ(wn6G)NBǩ`aMICendstream endobj 222 0 obj << /Filter /FlateDecode /Length1 2364 /Length2 16365 /Length3 0 /Length 17757 >> stream xڌPN !w.8l!www;K߫1\#'QT2A6 L<9f&+ 9?vr59Ȇ"@w{ d`f0s0s01X8 PQ9NY͍ lrf@FVe9JP9:020X;0M.f%h 2@oj 3s9A&.@hdc w(Kl6 W[2;dmk`fnc 01e]6X9 ̭  .`m̭WwlE@@G5õxEɖQ (%w)Ff5Pqdd 0y27Ap0p흀^t/B`f9 6&oo fz_?f_?O}ÌA6Vn>bF%%))iSSX gгY9_U߳ / ߗA PYLLF￘?_Sm_U_N$de_?~ks+Go͐u;Y_ 1@cEsG#7?^r03313|SoFoG1#_W``oo_,;j t{ 6 ;;/ #`0 e0q2  `8{? (q;(AQzZz_zAݍ}F wcacbm'3a4d0Tx}O;-?)L̝Q/7 !*M>ٟ0s5#f>?HJ㝲_K0i^}Ygdq}6XMoN9w4ПC/w5a !{3> QAޟ2FG3{?񝇣  5{ϿF .?X. {QnB;_#ad t!,/x-jj\'?ϑ﫧R{,w8=&QWgoJE[\!qRҚE/Nif 4TPGxBzvj~-]vN\(.ue_9d_fT#ϓf-8tE53F,GuZ衵^ЍOc|Cg4GIQl&jbϱ.3mY) \&+enq2:F?>$}e}[Z%`e!m5V\[ 'SGShMYA%7z=6Rr5 0zP}eN/<>L;~#e7yyb\gbaήS=0w9ȁk%Q d|7MP>m$x87KէҀjP1 Q.n5 2ܷo5a<* p'j/c6g%=M\IꩄvkgX .KoM?%);Ö~MpElE jFqnzTnݫQcbl]c RK0z%t.8l"^|4tM'0='N8\ ;R)2\V-~,]-@mӋ=j;i'w;*Xwj!=pS6X "H&)O|\#1Gnq$Ѣ86 IfԌ&>\o*HJQ9rEO&q*&PWbx~DY~0(+3j.qlFa4_ $L hMr|L̛ddM^~|;:پktΓy*N_~Zx֯?_y}l+U`bH誎fޠF4~Ɖt3*3櫨1pՂ3U .tX #+׮pڪTWVI$m#jWbI\f-m}4OD}[8-3I]@mX`tӌ:I ҂).T!ݩ V0>bܵhp]~¾E#?fEYX o_cTr7Q(&{j ;mH$ GlXAF  @x*{r4vw7jlK/~gۜ D|7.'1tpٟ2P/KgãE QYH2A2Ds Ǧsz;j\۬ic?v~k]6WQ}7mP[֞И ޯ 6 ǯSis+-+j렯;,R:>Tmê?,L;-DP=&lI_i]ep՟v31$-ˌ#)W?,I:aX<Ĩiz.Ǿ;"%]Zf곟Ή1`h,Ö1NkĸӁO(s4/J6}.=N)FX](w7zc V)1U>Q;ƣh<>};R‚ qgYJOs5;Vqk&;_D賢9ěCFikU^j~LIJޚ!MOw]]ŗckQˬQj v%ׁ(8.Vp_8aMST(^8*y*9S&9EmEzy,B(%FK5q%4_JSipbZbAt8 C2muY}dv'R ^*mG`΢*a4$}61Och}N[)t=g}-ƍ#9Oȵk#Uno}w<>nϖfXCs"I'QJzKg!K&JГ;[3~f40~h g-1>ۿabOH˳ LdX{<| x8Kz\9S(]|[:eBT#j7,bC.t^%͖!Jo URQ_<:xD{|v }m agI}w͉o(䗓PVc^Bxj>4R N.m\NK(wT(~ z&9s[Kx# |a tG4Ӱ ,0WZN7$x̧jlAj'AⳖhqr3e/'%b>*:Z jDRv@Ri\wXl#Wjt"4?e@ 6cڕ|Z~u1p ]b/ާ QV^b!lO偷yG틈U%1͒ڧ8dL*T@|uEz֞#/b&aMܐCGYH:c1!}N&;`j4zшM{M\8XkJI)Pɿ9H@TΒ] Z#,ɩ 5 <p2J[kj9!ƅ$C TQpr爅q Q_pדWhLcwA9P]$" LWؗ0MC}i=-"y#L.$!..Y î"9CLԁ͌j e5k|BgRGrʧRpEԢ~UE(mMS`ªo%\.r䰴b<Αᣤse> E8SHuH'Q[vtlF?dFǩ =a>*=64U@R:ȊCYҬfvh$pLrIHiM!>eyW3o_MD\#)Chw M,7j /N;He$ EP]X-X|r\u49>n&Bqu]GO'u^h~:SBg\IL/_gj\z }OCO~t}Y܍W靖(ˁ-"B%pBa胨1ŀOp=Ug&7-aaǀMЪm̝^k,ęwKT=:Z@8lA1`$,߬R*5j@wV}-gn:XV'{Ei|fKrf@қ3w=_E˷ LB Rrl6&R ŤpFUy? c \^Vy_yv6^? zإO-|a34~D-+r-;bǁLP%#E5EDjɼOse4R2N9n:ê :6Վ j<fB0 <SN`VPT-lh2wOK Hrb q4˓²U;Hx m#?<.4Q"_a> b+@ 52'\aFHY-U $V8hA`h6'-|䯤DXb-gP+]4d'LCm"LY ZR?^ԉÏ/t37KЇ2hn5JRL$]]ܪ fQ֟}$bs}mH|~nkS: ̯YNR#|?iuj&+{xP&_ *\唂Q0zB9LG]AO9ˢ%Nt9!qK*l3k#话8_#d&H7rE/Ͷ5pH$w4l͚EC9PSUWbJhqP:0oq@Wj MT䇬&H.C=0H"pp\7y=Ql$>ΪEZz29HoU jIޫͭqon[U'T/(d8@BD*#|IrzoyE ovb8(+NY!O_d!I ?4XtsMh]U^=<1/? )P+cDնpD!DE#9ڰ:,gǿX})ZU)+ ڕᾗ8NUYE|pl!".dUTb㆛{c LI1zG Kp[fX 5_:¡i!€Ef4p$"AO`Z?Z[ibge)(̄0u3[X^fJ׮QGWst_ O])j5Z7[ïLev9 wjFYTC]Ph xٖ|ȝU\{_O5>n(zFv'.f$`Ku2'q9H{hW®P`t7bP]` 1\Y&p6ig~1@qNb KC !(|Y:&fcjUlFْI2$~cw #1CF|UG5mqy%"acq7m emN fn^Ij RFKDskmB*[r23KiJ|Xyl=*J#GZ+G{` XcQ_Ku\prP9nct Vd#,ㆍX 0[4lݤ5w#)LH'@mʲwM`@T[hNJdu Hepq9RàLMZGOFUpv|kXFvhWĮK0f6{+?S9 Cf{L|;_cu8DOmZQܚ~߳N0 ̴c=} Uu. $&`(ĥU0W_\b*Htb!0 _|j])4m@]ǿhnj7+|dHch[RH \hJeu=+dv|(À4e  B|ܠ tIa ^aܷ#TˌT k45Uk$ ()4J7ݢOӛ|DmZ0r֒Uܲ<9PmqҒq  { 9c[Gy])acKRjNj|ZskGx]K#9F d u γyů,LJ!s$.kUtyX1&햵"3`JŢM,{o=BJHPevpd:/,nIߗ.s7 4F6W1:Uv؄\ةԇgј=f_ތj1c,3~[ԑ 8H4`]cDiio%O+]{{f*[Fp@s1JY~n2h8+[VT* Te1Zڌk 3ȐhBA3Co-ve_2866%lPbdU6f;'BQTegq\Vkl͖b6r [$ hPY/QUvW,jˆ(<@?ܦt/Z*S馎'{ER?g(약"ە!ةMSxn40ևa k3*:iZݭBܢxS'o_uQ0r2rMX\j";.0I61tF  ={cgs10lRdѨ (wiBQel;n,l7F.mQq-AҾn/Mwbo28 G`,tnbFK@vd?m~u Wi*n9Ef4ၡ,UO?ƦɊrO#m'2k!w ;UY--Hbͨk J#&mNkJ-R.p5ۜI!D,#2:ҕF0\_]:`J4A=lGJs)GشǫHwlh_~ Cq w hہZz9?Z"DjuZ=˅D_!ґOltRa e"xtN憪U@5 '3 gffv5/y-oo_^ *H ]-[B`4:ؤ{iV 01JPymaHm/}5"+i7@OQ[Mg|QR FA- bh(BtyDyQe^<1Ohv(VMe3/EflUt4Έ/W!{#-Qm5E*8FJ͹GpJ!6aAZ tJd%4Dcx}fMi\&n'PݨOj7С j7;W@qESWs.ְ wrĚUM~Kޱ R^u54fjEFLCsӳet!=NgΌEzfO׆^Z91UZUI`oqT']!Jnϋ,ey[<&+G ["x*In3p n"ۢV*&Ts1&B|@Ǎ heIPw MOg1#tK~3kyޥW%W)v"}0\ٕH Fnwbn4ټKY[şmInIo$j3:s%YKX^ݺQ;T7G2T}Pd#O/$m9W9 #@P$w"Ҳ%~v 'Rvbgߥ`#{^>A'1v]@oTyNhsrq9A=ZkSw[$Ȉr$70%<`i5͟M(ߺ( jm`P 5>)!vxWkwE2`S}A-)K-+ݛ-3ݼb?J U!O9@]s17;҇1j\p?lnl'[Y" HXkh]B}GjNs\'-u3nw[?o̥Dܳc9nߒwv$Ѩnv]6LYƍ=IM V(̠CZ~|J:D DZ{|cZ xF\d5VЮ/8q5G U^L jCpv=ӗ[ =(BD<8&KJ3~ryJ7d,S +.e c$ teAJzO *>aTF_SC^w'Njj|2mGh`&u@g iO\fSJDUcde"b)Hpڠ|&HF#qGyK[,U 37 ,rbƎbW.)»olN &Y0Hɓ-|4ܵv>0QZħ֞ѫR Z>T諰 X讀.8%Voț)ZVzR]X!wPw[kYBg4bGxQfteaEl'5)e(F$e@ulcSK/fŏnڲ*Z_Yt*C"}Ę;3@:>l fCXhtt*jRHS5hW e񀭓evvR 'z,?y^&'dF c2@1D(bDuoU !:Gã,KBO;2MWX+}#w8+ ^;r{|βMS@Bx&3O k"z]Xrz)g0~^guDW'*$бu8o`\{Bc<uF| yq$P_vjal,.9 Á qd۝цK[ʡ9oSeHҽ''Vw &0A~7sRP(l7{2~CF4C fIFYǬlC_#r41\!|Ӈ~2Aۜ[`M{*# K'=_Mlq;G='LmVsxJ~ش?LbXZvadNu%8*^{Pb@ym -+CK^+2cZPu@dB=$s)-:5O)ą椢Ez nƒ6!]]gi~0*gG@CmH@%6l Z.BMڰyf\]{Q% V睵[9j"s'abJM11WR;{2NYf6;lwc LT"F:;P}i#Dٗg)q጑9ůQu6.[=/B;!~eX0v{\B-Вh=:O:r&tM'uf+{)/!74 6ďDf!|DW*Xǁ<k//?J 5pljZ)O#y${OF FQPط>'wR0[+6v=p:w/!`;Ui&E{.NbMr겴{j@{D[|SB#jDt(d XmC+1D L9\D{c櫳6R2tRP$ TJm$˦kT"hjck=`W/2D䞽,+Ja7K;bRҙ|RV#l%PZx-f4E,Z[*s>'Ƽ^>! i, P m=i<1#Wwu`fHjeVlig&ꉮ!S9z~+͗<2K_+5^7,\[x\I\T5f:n9޳TYH!Del!…O҃Dz-K`յ8&0>S lvyHC-$!J7I16@C3CwIsnMϚWCFMo﷢3xIq԰$5eGpRqaV]nc !dOQWR/ A_1J$k#yW 2Ny~$Q' #3?$nQ Μ>k 3qyN +||tΝ+* vp+{A|DŚ:Lٕ4&Pxl%,l\ J(⃹&9$xjئu?1o*B>6HCo+%ޅ.D:ÜZsvich(#P;ܮɗeKwPVHCC8 k-X Hx^),;E0>}%X>X7W<)3eGQ97&,|c Γا`'y>4 r :\ x5EwL u6c:J:f ;oPλ&(=*dwXaK.d{raÁf>WxH!P5iy:K78=\=ItQ/A.y71^174ѥrÖ mȺPrDz4 =(H1$ƞ6^:Ƌ."ijUiA/jβ)Ijl(FڸmzWx!sgncIEFQK!_[nGG8xR&UsB~OLLtF B`@7i޶ܭ7QQTC[X!YxT|O-箜)"'K &wq=#U`h,AZ"tл¿I9h\Rnbi[ja/QIW܄rAnrV.a$o&wVǘ/_CuyrVճ%P9"ah%R^Qg7j6cd4l̈́iO#mqX.^2kMuH9̝YGz3ފ(!endstream endobj 223 0 obj << /BBox [ 0 0 792 792 ] /FormType 1 /PTEX.FileName (./residual-shadings-Punishment-assoc1.pdf) /PTEX.InfoDict 158 0 R /PTEX.PageNumber 1 /Resources << /ExtGState << /GSais 161 0 R >> /Font << /F2 159 0 R /F3 160 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 1961 /Filter /FlateDecode >> stream x͚n9^Ey|,f43,C,"h h9U7H])W]ulb^1>w#xϯ7/e޾c]${;IÍ`h. Sv,ix:u^^^>)T lRxż3vy`/nw&;?֏Q'Nژ-LX&)4J"0G`x m0O/zy+\zZ_OT C KTȽVa.Pye%QrX!.)\ޭ(SzmǓ!ϑذ B~wcįY)ϱo 89̈́ fql3Qs Db_{UiJ|fo`6)IJ:x 7͝JmGc`؝떓kQ9'7"m 1'ۇqS# /PK[IuR 39N).5k#ތ}moF1+[%q}^QB6ޠ_CCmoF MgF/Żu[ M:dnʧchɣF{r-*'F &ԩׂdEs,f"50ia¯w 8O5gMhkJl_BrU_ mMKsjaRpV}m⁾r5DZ}C:mUX吥F-,5L):0ºyPNhR`N4׽rr+3ATOi:Qx"m)%ݳ /c4X܈ͦF!nts8 I&*Ԑ h]MjpN l'I21|YHl8BI9? EǍNWQEC&_vU~:kb)[.YjNrR 8i*Nxat0PJAdVa絩41[Jj$=ʃyzKL 0 -Wbn$:2^֊*ќwI<%hF|92NḯV:9%у-IwN46pyTP&Y /%txf͡-#jHr$]Dhzu'x~CII?Dendstream endobj 224 0 obj << /Filter /FlateDecode /Length 637 >> stream xUێ0}W1kǹ\ B!I[M۴=3q. Tٱ3sjZ^Ų(R6N|bYdҶr'&~aj`q5]"MO6Ldv `0@jTgVqۡc9k7iakҦ=DZ6`6, x=F$osiU) ej7=}":D_;Yyίc"2nѡ @_x[# 2O 52a.]hHY{:n)o.؁FIԱx C%EݢQ6t0b6X?ѣ qXrQCݺmՅ˲ H2^$2Om> /Font << /F2 170 0 R /F3 171 0 R >> /ProcSet [ /PDF /Text ] >> /Subtype /Form /Type /XObject /Length 1635 /Filter /FlateDecode >> stream x͚Mo7<?h !oAF86"uYr?(E%>hy삸 ĿdTZLwRJLE?z+[}$] i%mwtuy#ޭ]"() ]e]kJ tA\oF.?98>z^a>^ln|?=RͷvykT'q}šfmvg&>'ҩItOFn_ 9zȀ(V/. zPR BQٗ)e1Aj[3CS8?Ǘ ʈkTnwq)B2$UNucЭfsrE^=i׮S_ aT4}&@_3}l4HOrݦ"?Ӎ-/oBࡩd]c|RYoح2N?O A MuzjCQPAh K1G{p^́TM.Ls nz-h*3mh-M?Z\&ƯP׸Ư%M12ƟfX) r׍oն1 ;~n`~tum'X O m>pSҚ&Vh{%ۗ;]!-jdC \H.+U| )qGږm˧M9>ִt.c0V_zNK@yE<7oae}yJ39O v@OByZ:ڍUѾ8TFxOA2u7XH]Zs)\ԃ*)O:A k \X`N-,fSI` >7'ħDh{Cî*97|l.-Nvf98Oĥ`:@Q8? ">_endstream endobj 226 0 obj << /Filter /FlateDecode /Length 1493 >> stream xڅWnF+x @L!9dCn&E/9S[ zW }qw{('?I8' |N\|r/a^[R5d{j<' _as\_yS7r͟?erAuR+G/oyk `;Aqb1њ۟y~?C@g#c=̲C< d5/̔ sړЯ8vh]#S6ݨRuweڳ9rab_fG&RF{ 'Mʌ‚rQ=.iIϡ-衧h^XPELH-JF(F hPMznEjşEg YH5HT-nR%Z4|QJA{ъ؇ᅧދC~ǃ͈}Y.ғ-|o-+AĤ7 *@0>b1 uO O"H (a-|;B.i LC(ΕH H"w+=R I"b͑R{1b#q{#>CmQwӒʿFS2g8;f~rʜO "'|)'IK񭨾0P)H4*vu,b:|dH<:a. ʎ]3($MI*~~&Aalry#d(9ïy=ʑ RHgF]+~16X"]M &R1zo..Z:O (Ľȹ eD\dU[ 6^"œLyFxJB圫y-(9 yeIy.hyJ/.QMS-NM0ugT&b2OOhÊ+2h2;devUO%<圄'ӥPZh\r%ERE\&36I9f +rN@Pwu^Xmr)Hz*fm.O0RQXK!3 RKAהz*J fUme38] Rk]ebjD^. l[Hl'F֗jT2%V$ƅCӿ|H3iRPB2"QW#ɼONJۈgw\oJn"iSa=&qxdAQ5.岃=A_Fxr{̝?S:}-{%̇o2,JgY!t(2 zXLj J4o`n ,svcFxEsK-تqXJ Hcb|]> stream xZ[o~ϯQpHNm8n⠰lbAK-"=2$9sxwt4o=xt:]tT"qƎ.&E*=wGs!R$DrVT4T'Ļu=99<ͪ-k~=_0swk8<$|}c]d+(6YRT^YQ%!__ÊKU;vr?Nj~gDñPiC`a%I_ӆɛ0ppsBj;@L{ͧc؍?^B8CĀ x3 :Pfgc% hZmAF u:Zr #Iu9,p҉ϔDXBqyKKg.Duæ` f.u쐯ѫKCkN%tp]b13s i AAy$ |'7c`gUT,NC@i=R܉ r=퉣.YrvNPUc 8BiJE|VZhn[M$|Ѭ|G^@g7/[7\Anp.bEx6<suSߡꊬ&.]w;qK M +t$qWTbW!Ԫ"J3r'hw9T'eY>uLS<"~FH &ƛdYSALl.v8rcY 0Qif7g>߿0g>ԄKB +eN-nP?2F|]St*|ދ.yG/V!lyk+:J/1 (g `MةO05@ Q-}7faa}pgY/iJ/Ulyʾ(,̀MavuTRY|!vul7vU(kg'﵏k&>.;,>kNHwb{A[{JvTڽ+`yų~7RN/$wU w8sI>8*`L7PtyZLKTI o^[QuibH| UuvbJ֌¾k$*%,.M4[ڙ2vs[X0I 4Q7QNb0A*B@ˊ?= ]]ocO_3W4ݎ9_dP&Uck{l1"?Uv]?%S!b{5C l=yCag(OwIs{%K)7]37eg\6| Sh9M{Sj:Ƭ˕nNݥKg]t_q L16ev6EJqE Vyضb|:yh"6w%|RO%/ˢ'vrdi*?O瘜\̤SBJ @C }˻<̴ f+d,Ӓ:U4ҭ5\׎tZe>¡MpD+2Y?Cbi[GAqJ [r:\m i|/-+ijܦ2ܟt5v!WHq 1' nC$.g-x3{;W}#1 }%U$m}z?X~ˡJA4 zQSendstream endobj 228 0 obj << /Filter /FlateDecode /Length1 1516 /Length2 8863 /Length3 0 /Length 9872 >> stream xڍTm5 %CwwHtC3- HHtRHHOZ߷f{O]:ZRV < cȨJssx9x`q4z]+WaO0@ pq q%E8{ž `dp rYU ЂXځ`^*$f 9przxxpWqf6 \AVߔj@'_8ڶv?Zkx,A`S xRTv V3 9)WBv?'g ls^˫pY;Wӽ{q5\0emM͙SlR+ Bf Җwm/gN?g30W7;mqs,a ?՟`]<F\Opf0+?SUI^WE/8!v~;?[ :@Ձv**!?I;f|>E/x7?KBNR2-P =2QrT HUJ_`PA_dAnp}OKoP7wK 眥q$k%9ׄZ9~rИ|O|?D=Gn-v~Wᘵ xxOBy~f),sM;Au4nǻ%&3ZHk8 Ҍzn2ɑ`66L.!t)i!u˗M04rJ5O.lL%;OnT>ym^tخj~&lwg=2Vh܏UŁ) _wOSʭ(J2Ρ_;Y傢j6b?Y{0pWͥ 2vCIU9pӍW%ݻ -126 +6\K;D>sȑzڥfUcV!9F)~%5':-!NSA;!2ȏކ./)qEIЍR@9Y~ܗ_:ȟCs$/:9;nOK%٫(0Vtfr,_I(`&I\%(W#a##bXs%=b8m 1 oLKo#-$? awNi~\R )pm<ı^w SDҶj'/B.Cb*0:W/Ln&SqT}'>R26(*U nbYV{Nه8`W!zt,u9@w4e tYFq@C7L q}T⪯u/~Cs]Ibu=*X>9#h[@uzHqC3Jq; i[HmzD.ds틝 J#i%6N:-;xuҠ**0sWsyKjk}b#JSIܾ4&}s0*e&5=)~{mDAq NLVm[upn!`n%kb3cX=ؠX_(hS F=͖&ybgEVsE1~\k7Fx<$` k}:bYz(ظUr&h7zTI 2r&g:=>6.@X>S_Ԑ̜uqQ 4 /?"s`*26h"` %/].H{]Mi*ao V~ŁkVG z`(Éz>GEsL(kɬ=|_'sl>P `Bg~`tݎLˏDu%Gkcg="TdgZ>CO| 0>8(( ) 5! cKG9._7oa# f+Sv'HP .{{b|]MVcwv՗o/Er*1fw> Wgѽf#%UmPڝdyFskż;^Q2=Y otf7I]2nl02WEe%ILiHq;8>Pkbs|-A6Z!~5'BA͐GYv;poEk3YTP~Aٺ !!Us>8&f0|O}0#7M \R6w>]lxz_F2N:yboq Lg6B>q^Ϯ?B#P(_H gXSt ?<ݒ3h)+enaG,'rJѶQ-/{FE*8Ӈ8dPs#k_:n̲ڌb\%܌&5ntzɉxrWe_Jfbibàtd"+D>+9]{"_Lcd¶0Y- b*rf4a^%Aw0 grIh!vM&:}B?'}30^÷3niq(o\ylWûsID1+ZK„O&vÿPH Z0ZaQnOm+)k;=M `\9ot=}Q 2z2˓g흰"B"[}yt>"M <)QPО%&7/S{d@rraE%It]c#ƉB8A:Bb>,zDoD_[ uFJRɢKSʇmZ?wF/# qSICb?I9اTj 6')=5c#iyT!I;+W5yƩVt,K|#h~oYҮ ЉYM G^M9# {*Seyd9{+)o kCS#"eFn@. כ ӂn{~Df{ן. )>4tAo99e>MLc襃Dȳ{2u_r Js,!1< 7-ܒQiͧySr;4AKmMb8첺:G]:XNV'X|,2yЅ@?ܹa"5d=?m%k#RWi,|딲,YeӦX>qo1Gث&LWpJ; ^'RdlZJ ϔLp'lj5O_NA+C$W%cJGM&݊nĸZNG cŷ+_i%]hj;JTW7YDq!PJ~M zB"}dU*?k bk>G+bƜ]uo fKwN jL4oNd_nZ33Ev) 9"a"PǀD83PEZW)`nhCPOJLz* J]8h:L9A\jPY*Tn6f7h*[=uԼ'#__éh\nH9.,{Q R:xU|kAgP֗f[E妍H37%I-VdU>">u -燩5)+ l _ p\Ef ؊i {>+WDv\DI0oMY$]}L"^ĀgOdCtѻQ{P(;bM\+˜G|qD RhM iqUl*]ÁoH#.ZoW@JWX?`*-8Jh-j2.@T\r @x/4$AL't:wjHDh1E S"Hm4>+A[ -}{@pgȔL^:bżُ6?.Ȫ^@ ƢtP07Ԭɘg`pՐcrMArq,hD] ͻNWօ-jۈWl 6͉7ZYCt0[F DVڍk9c*_w@zKC6\b,uc\F=_l~#B(a|М|!tC*j{LfY@뼓Fjs{SqNV՛<P5}:q}yhQ,s%~C c7ӱiEIirջ>v(CG7x>,ϵx{-!o,=Pj=Cu>{0B՘EFc+f) {gA14p͘)qhvZ|ͫtgǥ7X_7ܶ#٥&W|J3iuDĭ/fF{%d;5S4Hot!m›#6OgmZҋ°';HZ0k{ur”('O\+Q'9G\ixz.}4K,''}['# >fX 0%A+Ά%Hjuʹ21dRMd4VSxqZ9* ^ Yy4\XI!֡q)r_*.kpr ^) f%=tQ㽒M::Umj t|X RH~~Ws$аmXh)TfY.5XrJ1g[)'RahL_[f@Ȣb>hig –DIj)2Y #JN o>$V12 Uʃ D2);p]'Cjbp;[dkׯ V{I74#3)#loQ۞.>:٬#bT:O7pxMPL6劾d &VHtڒz[;T^;u2ȣa@&Jhi^ Qʏ%un,$#` 86@#b$3sc$TkS;tq;eHҒ"~y37k{/krh031dܯ?Q<} YVs|RaÙu/eM-U1ǫ9Z5Vu:h'Lj3diV[i_; 1ؿ& 1u3aTyӋĖ0˪4w"JUQ啸tj46O6)wn=e.*y$>Թ.SG(KIR>z]w'3a>"ח}'Ra7.mW_Ej)~'ads[>Woybڏ=?SC %R}oҷݏʩRگ'$J?U`a~=,vv{6A& +7!5u9.P|l _ y*\{|/R' P>yLbkx ~#{,&0( 2ߊ]&tR$~ FKhG<*Gh4W.Lw ޭbvלB/wrj yY |[8QzULE2 7F _czO?1stTdg۪* ,eFmWN^{:-F~+( FE|Z:,Y&Q S7aw*.u0Qv .Вć۲P~e^cPZ}tu[XQO0$14B(~ú9lDJ&'+9щAږ6ve882H֣F6^kwNH2>y}C1PA J4 "Q,YJ$-Qq?2jL~*M6u4}I hKY{C|<BM~'ջ,tV> [ L2u9u E%ULO/CIe$HLu=eD߸ زKN<<3oD3UvS! Cq_.:roUU)/K}^7%4| \R`D8ɑTjb2%C.ߤ'RC*񫡣<ۮ'ݤK:vuJ1n eF]^C t8^k]tj!LDwC6pa8s/.Bp/yˣmʚ/#2<g$p1 wSlx`\J>S߆gOrKCWB2x@ތ3^l mtKDO~cX g1BԽk׵3 a->ܲk* ]^=o| -HUۼ"Q3gB248j% k:ؕ,Zz>khŕ =,.Jvm wh N1ɐk*y #ɏuR.WEk^NjuG_yLΎ3*RDuJrwbªt_1 H,&=A_ԔKp$uOE(0nu)#;{q3PPGdYqYmo{1;9 2<>Ƞ/tNk/7y'XG9s#dž_L5}P`6T#w$5)M?ǡP 8qt/Ɔ쁔P-b%YoASn;,3|V_! .TGe|/}5i며m XxԎGjU e*#\؍bN ucHʒӶKh}΢i<ZͶMoj[ Wh}3 zD,ԣ>uvgA_4$a ;ǫ z9MSIץLb$'kendstream endobj 229 0 obj << /Filter /FlateDecode /Length1 1470 /Length2 6897 /Length3 0 /Length 7877 >> stream xڍw4\]6тDFeFE] 3 w;E'z zD I>}5g_w^gؘx H+2 (h@ ^M )&`{E0P@Ah"mD>882D`w PC".l H'/_K5'OLL;@YM5CZà^ !i$zxx]x([iNn uܡ/-#fl};r=p5pC@(zs܀?s;ܟ޿HG'0 Pce ^WOWne `w0 B>9, IsruuQ βtt"\]~OZO`C@l~9 0g7&h?2[+@Wx}/'o%/1 `&@/;r߈Y0?b]|` B{en/w}J54`N^  ||bBaN_K?'* :yp-8NwB{ @B ky~W@npo5o;^[=Hp (#֩!D2 цZAC@._W /zܬ׉ RUP4{K%5k` E.< | znltE6Hz rDV 1o'] BnBS 1PO5 Z"M۳j9:/Rl_ S9y|PmnDx/92-N^&YXS8g/%Q /cT jye7|:> rjPcqv%#?U+Q%NxU:kcT<Ŗk9MsוC}OI7Lj/vb }LO{/tҲҚ0` MVSR]d`1(F va,}a=ͷA kaq:lirjE'~='piI]'$]U(Cj^t@"NT_+N/z&"UҽqK03g`ey錙ZWo:-$?aΖg.'e4c#f݀AmC9aV'lՃdK Utuv璱B9>|+E110F2OjH$+ƒqaI=;PB2 !fjS=*NiB8zMĢ_J>fa30'q<>w[ChTRWHv{7U1:/Nxy;waBca"sG("Uj RSE^:R,OHMz$RyE/o ]z"'aeE VRT^I'i`}} -vep>P#ElDX ~I %n"S(]u:FfDr=P"աUm˙#ҍi:wo RR&r4"YgM&DnIf :hYW+9)5>ɪ L )S[qU=E bw"eH( (=/';ɏ2@Y=0\d[P+zN#BvBS#7l?[$]V(8LeT>O%HN j0yAA>Ƙ-j}aK1' KuOB"~eV`Yt㰨q>.II=!K,wbgt4rWX810& E*%,IL>q2%nL|dBhHءzgGB4Ҳ~ȘiVUVfHLSud:}lNM($J5mC8@1]mGĽhШc6@i_SR~̆}8܂caN^_DsAS_8uI| TmR_r$HTj8= Crqd |SFhTh80dyeHħHJ@i\9-.dqizOHFS`Ӗ:'S1'f-7r{gͲ::_vܰBDnE9y` súz~\#]F4=* O)(z{iGal#ܹp 惡إ"(Gl2AoMz8CdWx ҂շ8v&q"7p,G--wF!c6b, Iݺeΐ0(Y702t_E [Q}7NQ?,,'UC W2I9I=/LcOCukTLT{!P>[y-~D9|u"-njb&Ż58!_ں6hjȱӞ*|aAqL<7C9ֿCܢ1JDs.YW2%V;IbuԹvDh6n1W6#۞4Y4|}]USJ{Ev& ݚ(SMn|֡伆8 d?&BHʶaT~Ɠ\)ұpq02])kMۛ, 3 (B+eR3R'~}н~i;g;UՎP>7`ر l5* fR\SGO;{BklFӖ=@h(@qՄؽC_M] ̲Yh Q/]O@~ʙ%So6b LBqⲧግyB2#Wx a@;lȚJR Kϰר 귳$5"H Y)8fGA936 ۫ƃ\E !Tx4Ni(?^yVk2t`#MF;%'շli>oϞW'R+Ut\MjTxy˷6vKסoP%&sA7]}2:ZI$ -es ^Fɼv?WVs2W:HGHfu^d.@f[=*_R.Q#S[`=\B$y|SȕYde4pz}PPaUb !Vw"y+J B*TְXз+ś*;,ᾤvNV q߬oJ\ ק\I2#}zT{QOh{F|նɠ/t5^L z$*{\+1(Lkzڴq\2ə3-k0g|hﱴMG| 8:ޛZv({Y/((ĸaeR5\{|;Lm:>(]ץ֖A?ͷJ&v$,;GzOɄ//B{=&؏ K"_XH>,JrV8_BrixF&%Ȟ_c04D_.!io6eYvRYiN^Z ZA] dĻL.ϒ;q| 7omg0!=$ڂ{΋Z8S{C_ӻM%TieϾϽ,= &Ukir[wfgUR#w,CI@f2VCU,2UppN.$?o8<#8'h{^p"90zISZ :إsja?4rUk4.笺vnmt1W/LSdز֧aã` z[QE~ - oi3}vA&t*7 g-\K7JKxphN^ymZR[wZ(M߇l(w&שLx@̀Iյ\䢄&Saњ۬e]enP`bR= ZݼJoFʆYzW)Z4d(z*ѐ"xb!M̩ 8Z$ՓWܪo\JS"}87˪`vO^ܣ$RAv% !"y}뜖=(zzbReR{V5[xdoV-)X9+. 6Zh AwŜRǒ!=fRb[r /t ǺT`S{ߚjt7c&rR7:Q9ԋ&`|?V'cWy^m`jHާEP_㋴Qֿ/V[x!, &uf ]lTm"=c>edHohT?/r(.{y(?S:lWrOe j>n"ۣt~N:Zf\ΆB3:!nx˘N^瘮FNQv+6伐EӞmjA7e3]9$q{3٢&VB ]&TH!vf.iW$X|Ft eNݬ&֟Tiud%P x~ݸug.y n%^i/YF˾LNĢ+|D; 0|C'jR$VNy .rx.; éQEY%j._(T[* G+^60B&Q uT s0efT:l W1ܾ~U_YK'xdq<h g2[S=)3^Sdc0wn ¹7m#ҁnRQ${)YEYb,`yn76$te *(F"'^ت> stream xڍtT .! !9H! 9A 3 30P)tJ)!TD:D1wݻֽkzݽqCQ0+*!Th$$@(Ig"`d|V0T_{c/PH' !US@ߎ("@ ($̃O]e~B r7~a8.0ˊ0`aXTrbъb`w1YEu`0 ` vF&Fp{֛` p@!0e' . &ho?HI'ݟ蟉_`#}Hgaq0@]ƃpW`| <zy?!Ls9em$TCb=~ cY7$Gp#N?A@=H}OK?:g "3(S} B.AN?2? x `0g8jor8px= ?o􂢐W@Odb*l(OTJ *)#Pc5'> P rv ?#wc%a(\>$+FY_t<_f_ v#|8\2{yF@5%pOcסtFgp85c!.).#H)[vyo~`H $ed` C O@0/fŐ(e^ !Q98q?ĥ%(<_o`8lv ZqR-Zyo:CHoyFI*T9RO}CnU[PmߧȶoIv7ş9HE-6 v#l2˿)OiZHwݧﯘZ7ۨE~^1.g{/t1-ub(Uaگ8ã ڼ .$qR%~w%O.˫$d0s!{e"9)֝ B^-7(P:hsvwήZ~7?k;嵵*zB tmx@YSC7kRE2px)fgJ5֭"ʪl&;J_aYq^,_>T$! reēQ͊"mAT}g=#wlDJbTƈGtwrM w& ez(j&Cv ҾĒ~J+.)άMvVxtM;/M-WV U.jgޡ?pJ[$ *>yXއ]܉Jzo祝E0; < I#; egS q }0?)$e>|-UI`Ћ7dy_a[DG𾝱WQSl.un_9wgKq2D7)F\BJ/cx}7p Q1_X(n9v]ft\vG\$|v-ݴR'p/)vrf:=&_aT9zݘ>.gUf8n<†?yu1VܻU ~,i;}B?EXdWf Zc׹lEZ2OE>Bl5ǯ&;}vԟԍ٭5W8'*0fʈmSEBc)6ލ}u\WxPf Cs!kmCA 8^jJè`#AkɏFacy x /[* (4(Vc UO t2=bWZI_i[dRwvM w&"VeeZ_ ́W |Dz |.ii)"g˵{Y}4Oo9 [P4 VRʀfDv j?n-HV/hΏ!mXț]1SȞlHVA\V_deWTfY}kQ$h#gWĝ| -ᵪd vvwևM1}v1 J?򕛙@crWm"t%*~AS"YC\k,R#7+i"'|kstQQ /'1=; Q"pS=O;Վy wȎfw2,|z'Vmp˨RZDa6}wlD"Ԙg'=?rweFe6 w)l3WkAfzYykάv#*i.2E=(L3&$%,+4z,cs<80+ܫVw,vqVNSk *?eَMH2lo=RZ-ΉPBqP œ3f0]j th{WT%/`VrA&k5ݣ WHUmt| >Ma̽ӏBKr<uZ:bYz(;@ Ծ31E)06'yא!1[Fvquk#2PiˇkAξ߮Pa8)(tYVF4\~_60r̿඗tLA1u~%P)j{"3MI1TH+[@g˪[7mqcxnMFM(-Z~?zw[8LL@=kpZ[rw R6%U']/csu H^5 ^a̸*RPW9drg\RjnWZ}@kecVN&u霄'j!X\0r|d}MQ%k̃FMY F AgQ(RϏPJ Q׺8#qF]vdB,>ޙ>uk^I}Vv4'h M\jn̔tJPH9'nǘg[3YMU_\\+mOl ! .2#$_&N6ElնZ]z0[ڻC-lţJaʶ$J| սGWuح\ѷΈQ]x4p'$&.#:jV$r #Gd, 06]C|7%$ +e:WY%/;v5G*O>#"b2}eQ$}bnQ;xsCZZ>>7yuA|U T%,f+k\mI(1y"4|x,= dAG Gz/3Տ>U6 ;g/np!=򭛰Z]dNSx[i7.\{77 ARBR3g΃T4ۖl#-CT;TW 86薚ZF'c꾵PŚ@n(36"]"p[ȡBothyWtݭQr9^+bL5k}*,zl S8ɝonXfHqą{!ZmO>k`Рlu)Ux1u%zp:ddLՒ3<XņLAa8W;MUVW3_T̲uIB.g'9G"&쩆'FTj(ϲnX7Zv^* a |SJɌxzW Q$DIX>Gh8|=! 4H 9? .:?1s^D0syE6QzvdTo(EHf2_LJ_ ƙK}=^U+LG+ʅk >n8\\)ٔbfXY/WW~qAd}:w=Wq{C[{Oc =*_+bmd'a6'>#9ۂ ۝kQ}ǞDLj<tD+f3 _znve5$7{rhͧE%#,Ѓ" ٛHL V2Q9%`ZWNn$ hU^N兯4r4Eُ6׭^[("9}=T;MeqFוv[ͭA[fPXl[Xpƪu#6`kGqĨ}6+%w;fa;ͯEŶ7 )OЬH[y-8DcB4yLFC3 W^KmN|75:IJ-WSߔ0:u~t|Yq'꘽ vf}Ц=&> l< su[9%`ϮG æOy|f6Ҝ68']{b*8qO(蹅iJ)i¿ow(rMb > 5t-4G_Ud܍͸'\ES:93n W77^4.kN~vVҔ+7|gZ2RQjciН;żMձeQ72^#QmK\٭Y__,PAۂ&|5k #T}Ļ6D-xIܒ$ճTC6Y@cN4[iB'ή )HG SRjx n3IJUuC=F 6wAR+g"ơO{Ȓj&*x=q8Dc 3Cl?[TdZ9cP!nyVưHF헻Z:>u8M~;]R*_~2ȒByi\+`ymĎa_90Fn5$ %]TH߱y(g9yFhRCc6ٻSx y|aU4٭T|Q{{Ӂo Cł3E:cپq^*.4^,A2{: 2m84ɦ&Fqff}5M9֍l~I37Ͱ?VsVYqlMh&5p6: ~+\INܠ1EVvX<{VpU7J*d8ogl 16} Tzr VOzi Si]r5CLpehw:>WN t˟,XsB$ 8fR-Y$ߠVQ : e6 w n$/0dR+jlN@edHrAuv}oר5GJǩ-Nac?$8M<9vcK5 F~=Mg?Ks%u Mgd`;@UyM!mʟA#}"Gv,ڧP.7RA_́NU>Sfx絺3<=E d^|cwO]r+(Lr_l',U5F-};û M-?|վ| Y0uv_ fԣJKl>,Lwm7Uw6Y0T $Df?_2Vcn¸ ) f!cg W&>[MRȼ :鮏Q^kcP73B@U# q ,OiBԧWSYYe %󡫱e W$"tU|HZG+t(Dojm=k6AhLY@ǧmƛ_rRnK/ *[endstream endobj 231 0 obj << /Filter /FlateDecode /Length1 1974 /Length2 13977 /Length3 0 /Length 15184 >> stream xڍP ,x%84H7&wcf{Ugm;{m9MM,n 1@,lIe ~'  5Ztʤ\_͔!`=#+`c!Y e( ` $dmz: z;??/ӟq3 P6s:hafЄX^NQÃl-B4.@gw%3XPZ6 Ě+W3g U`]^@gMy%#_LwxhV { @UFӕ `on7353q3:عX8]]X\@0d#k @@ת{V;0 #6ū5:6rdC#`Jn@?+,As5OW1/yg'=}2z-K?˪+,$'UO3'? }=oR53rc'< kK?3Au *9{C6n6/#|dњ9b7׍PZbe%j]^7ClmwA.2 Oo^ۃ@5 gtfavOuJi9;y6q|_\XYW+=?~X%x9r ?Ro`X Af >?j7zl8cG X- ߐoWu6\m^,^eW&vT_8_3Wg ݯ/1h?ҿVok_򯺰Rq|__e-8z;WnL_z+ޫk^d t+̪+7?ߒA/Z,A,mknʼn؁>"5P˃ˏdnVXd> sT ǾE+vYMRCS"Sc#Hyܝ$$OF&~-ur޺:p!|zDђbxNJ k"Dq`tJˡ!_~W23wDZ}L`m$ʭ%|j6s‡(+PE 8Eu7IhT;UŔ D 3F舔p"6bӑsf UL{N4#ŨaDgPD򚶶$ͪhfM2={/g2RtiBqe}F=8RI0/}l}ť-4-›ViH3 :FkUKPNYu#|AnRQm6_g/q(f[al[c×o"[.O{A oxrUOngMn~Ey/ F*X=yu_sЧLu9.qśYy:Ww")IJvŻQ%P:UÄLYy iwĈ0"XM_ijYz Yh T0b+,B^Iށ&O;-~vgycMXT!*pr[8P3JNR.|Z(07\F:MJƃEgEUm AH7T'ہ|[zDJ8b<=yebwjk f4 WeQ4 CIQw[meѰΑťna,N% V$FrEcA%Ղ[XaBZC蠪lb . ;tBhck76RJ/2ఽ{mexxrmwEPInBTi>uȭA%Ց9I@?M|XǪtqgi; L2QT>NcYFzI~NfPOu_ 8RbK6~KP@ߵݙi|x()DQ~r6 mV1䌍3E?RBF)>c٘Wά8uҡ r]LڳP|e=2gښ\+GN>m .o}g/[jk;))@ݝ8&5I_OnII!\x~+$kG-DyUE7~Y $Ws^^ OJMZO0FA'~|JԈR&Vz) }K 3(3v;!7*>J"=OE=c))Wڱ#׈G6GJV]>ٲgW2s%hh11a054h%[/fZr &#g30*;>\Kyp*!Drη<.^EUY,pi6gOiߌ鳰_tFE1Oq#6~DyX?hAYւyTĈ~d1caR5A? a q \fcZ}b\ ͘N}Ɵh*i5DcfV6|h nx(S4^ .j,-C|ЩRp1>wONxXvS}n/ni\*}̥͟0A͇REA M+}}4ZYlc QW=z[sQƓQ=[7E|U4[ht^ZH%YKI7=W:xLvig[G#-HtR{ES9B!xw%jZal#p@{FE^&<sMp|L=0ѿ&N[fzTk!t'ZHo0h ml7hM":*、KUt$laA_Ͻݜ; V FB萮9|VA1|)}BwFm.a#W̷?/'xpwaj}G/CKގibIˏ<[K`fB), /EdE.ͥrޟS{$>!q$[cWŕ/AQ:BK<5 |4Tz*Bjelr93ڣ^(N;׳[(ޱPlY&&LB捯Cz˿ Ģ-*C$q:lGfJjL :]8 7pTa'-ݢvL_GORx 1oE~ [mi{{u'zaNT_NS ;ݷvth?&¡=ti$-DPxvkaVf}=y)x`U!q7 m]76 =')ճiwk&Fg@ާ^|}]{'BN>`mfĐR ݬ: {1hBp᣶goZߎF2H6v :!s C^{0'*.xt`s3bwp-iou=kM51Uo5NM31S ]`_n-KD&f.ww:_$dEj()K]o5 $= f!VHUQR4&DBthW/*)JߨM:`7*yae"<3\J?Kg>nU/RUUˈw侲3 ^+o ΤjbHWfV5ORn̻4eo.l LTKw u){+tYP P*E~Q,xlfS!{`0$Q +}x3iճ$58 {ᢩhTRg7q )l9mg*mCh#[2:qaL4<5fLs8ҟ?RzN3e7-X]tv!;; b`jdw N!TvnȃaEapyN XK;Y]i]'.mv$!&A^QЉ!"> DgdRE8}ش!'L erVJNYc9WJU*!k߃`*65đ)¥c\d} V2F ͮ+6: E} 1spG_Oo!Y@WZ-$U%;@/M/ٿ̔Aqu0%}B56hY\H))?AR#iN.O]'1,-r'ڠ"ci6^3pVpI":]\f*9Ӑ*O'0J`kn\,˻{Tb!e&'P( _iY]zB`]Vrp6}`/|y|N0r]K6I%h`1-YMK.O-JG@JUy7̵mf2zmTe[$jq8ZPtf:/(PE5y1bY5Ʊ.!9Nb RM0E$ρOc[~Q~$T"˚9԰Mȴ١!2]=)l6 V|53\BRjx*i'}vayB Pe f-`7(e ΍{qF #Mw(dX0Ƨ TTHlp |ɰDX7qECZfJqbH̞'kntmtrħf߲+ egdK17_<*9*bNYLYv&g_ǁwl`eFϏ;m5jPnU7[t;(OȬ.rN|Co9͸b LG``;iԙeGV丈ksʖhf nFAwDܗt8 y3s '\ 9@C $ؤL2`mz>:தpbs/ s}#WۅvS(g .R9+臿5@~(ƥz^U{#}oY.F{ݾL³DFES7?`πQ!'_ϾDxP\7;}yI&JQ;eiR:q"rًeZ+5Y`w$^׼]ǥ`G=̘$o|S4%v$9VJr 3s3c[|3,mCo, v-|Ϸw!B{˙N&ǗiF=F2 %a9h]ǬD&p4d\s|4|8"o(+V T'aKm_}^z{+/I4\ G6e<3厐#RvN8RRcy~Y[]fq3߅ŶXɻIs)Vu=uIpn1WCKk {=LO$HR%ň^ڵkGaҫW o73<+ ՅA %F Lylq<̕ "wĎ[c0Fq- }8o %7k M>|}iIQ5hTc,^dGpfEۺX .e^wclZŔk3[F]+iil>\Ius(O):+28Isȵ)|&msW2|N B>Յj j1VdOihcz=4=KfX#kI=؅2sb܈3 *q[e{]lZ[Sz><_ղI::~(w?H;Q:"!PTgS; hWRAnbHO@Z"Be"87H[.-{c]br(5GYB}uNћC#I ;K^,딈'ȾG{/Ul 4wECx)=MK>cÙbYc^կ$KOU%s<@M۹ WŁ3\l־/8\}rN#eDž؏)HN9eHv_ao?'sh͗= '3~>KH;p'IKc(C>3Uuf|P^wJV׉~XRH:ѩ􌇉fM@VU¤Q~쨬1WJa v<~|rL^> TIx!V5s^Jfun 0NZYr7GkEGCkvD!0x"eVޥϋcu&L!w]~|8e2c"Pu/i){j@R;)jwd[ kДz$88}Dk^U&)D)kuW+F'HNIW}R³#(vvxa.^APAB)VOu0VY=G͕Ȯ$ +YֲLeRe.;k%~Τ@wAU(I@^_joi"VA`bSzLi ;" Q7unnjG?No.rEUsąZ;$*,q^u,\#vm S:!5Z./rELt8Kl2+WpЍyerWyf Q]K9ӱo4#XwV\Rxr.=0[WSʟ7ETlv:4l6FcqXTfbX[ Z0SpBg#1w2X* Qę6O7Dj< ߂jѮQ,:EWIzĮ^ c)-M|KdDrL [>d=]Q`IP~8ɹ+WXLCơ'`d7 "3ɟu;ROpmeɼvoyHx>Fn:[ܘliZ ҫ}b>o{ ٠/u~int,B%[/#oh:wUqR^x -⥻gh>yvPP@Ou6|fT_>~`C 5`u,Q3"G.r}"Ej:$H4՛vMWy l94ϰ\˩F\ecu•*F<];WY_ ONP?,:%v?abP"05 ~ϚbdOgz- (g%8XRnK|Z #n˂9xl&\ߙR@3e)iTS+;w8xgRBB:ac崲w&`vb֝W`a y[Q-NWF!awC| ,)xE`7]e~6vm̧mRR~3_%qkCc}n4K+͒ 䐜oZ~/F130UJxaIt%;)#6X?P\`;j ;2zO:c{-6v`Z  * [V % & 5l̪{haBnnXë%XuIȍ\ˊ\2g0Jo_B+ K=Yig@i ̼ ,b.YFt J̷>/'dYgE[yD?q{rI#vҌr5;N/n24u G"IY{N%P_oXA:Œ+=YXWytSP}#s: 8 6J]\m3d~u2F˸~QymAYҽn6:-[@|N) VX+Z]@w?aE&e].8t;_擎lՃ aqa2 KD s} (  ^y(铆ZC);vm?o`F1?^!#"mX`on<%Xkeoaq[tm--':K_@IÖGDG{h(>m`AbA1ߙ#dJ PDnZKtn4n< 5@Q q>_gFaN8Q=T+,(ku]Kz~7*Ѳ!ӟ_.x(q,EBA;*+Lx L˷k1&|v p|=ÞQ Ҝ1vr ]Qި&\ƩIbA"81BZ]Kޛ`!OL8XLdJ2*P`Z*Ҽl|xm?& ZD'AɃ]EԚqEX cݡ|:ClC;YoQ" vʋoG/7f+k9l~k<]m{Ж Z&5/~zTZDrr]$w)wcV2j?Ui1XWWYߝH)erZ՟lBD'Xt'??5I:EClvD6D]mjwdjkӨs9JxC0ίe$XLֱT:_haKR&WpQ6թבnȘqo? ,#N3˫K.03&x*$&wc߅2@#OL4CmKf$/Ynn_:0IS:1>NrtAjy8"n075}ɻ!YҦa&K).#i谸eCC)Tk<FDy?^\eR~/Ky *(g4Ag: sb2ri3fǸ0#gi5j c+G&PlTM:*ZU \DR{a<`St;ϒ-*D|T "KUhLT{ܾ.3.)TJϷ>Sف/|KT4GӑciJ%_ZجJ'!pȈN%QA|NXA۠Uqz^P>\?7uU&QFav!g^l2U`6 5.BNF$$mÓ]gLNW<[oCIO 88nc*4[ Kl ڙܺ(4QsR#m"])js|jw-l V"rBb([L5"d=Q4\S(s=Fۤ }{h[:*->C>1x©h!Nl#z˕(Ӭ f ϕMx^>r o`š3-_07N24d=p"2?K6 uI"aO"8 /N!TMw|ϛ,=L5h*<#HGtؽ8LOd.8N9LxLv3kڗjopR~>F",'G~F3dfLGIHmCEdG9ʲoF14Q1Oջ*t]2r.*e;Irrba.ۂD}~]:8ٕC%iήВ-zV6i0R)$Ge龢~+dψedl<% B ׼p*7Z=YsCJC"9q&Fuˏ9Xr[TTvFI?[UtM1נ54֚MsTl1t*iZ|lB޵ϷПкi`O4>i p{VZ},ڂf P\?b'I;` N3oHʗc9?AHyQlL;\4V'0LÈ+G†yJ4:y14Az*KaRXFn3pLvct35[ pvsUz yFKH_l 핈|. r]Y Pv/'^ZEQo>\fuIN/Bj1t=-7g(!hFPdc{_4QE' Utgiu'K> !^u NV!x-.=%K~dssʴÝb~~1#0C=,QL{^7 Fپy , } ؾdlD= (4MqyxLﺹlڝ^&A-J}I&i.^!핢w3\,Uo ϢʎlvJriDsH<8rH"q+,*mosаs7R$5=t֌`֎;`[} Ukk-}>];%~DRwɎ$>*wl3cu`Wq yzu[5MLUtU/+ʲffL)]"{z5(ЀD~I27E>}t '. 1N3ӃH뾇`DȳPNl㛀jIirDW6 qUS?¤Ƌ V49n$eL[ݼ_m`1lv0Zg51&貜 sbDijf8 ?=@%u|ϔ]q,endstream endobj 232 0 obj << /Filter /FlateDecode /Length1 1417 /Length2 6088 /Length3 0 /Length 7047 >> stream xڍw4\m׶mDoA0ނ轎.fw%^"D!'Zt hQ޿I>}k:s{_gpv0U$/$*B $" 88h G"A2A @MOPH\ZHB @R(i2 nj"0wtBcu r$~\a(8@N0WLG(FB0JpsBݤ H7v<`(/=i.7 Gt@{CP0 O= Ĵ5zn0`?|?w($ w?#~'CP G8.0 !.HL> wa*!nh/`Yatu!_S`P uHoߦa1 Pq9@1$ɂa>P'_-|`BnH7,|= ^0  -E`p73(@! ;+̐#.&_**"}R@~a1P$![^}GE ( S:wEbfG@b ("K࿗'@\.B0CD ⿡?d{wT Ev~!?pU^:1K Gz=z0) 0><^<0';hMUP/ !(%¨{ā$ : Q_*) 4 [jD0J= e= &FPpO' K}3N̄^YUm~$_dMjN Z;7*dό/~`=gQ]qdK>N?6JVg,]jg!o&wlspV'{ߥ.R|I(KƼ!ήhIgμk麙lZOIes=]SmL-1^aK;w"*2]E L^^zgR۩Q_o/W{zQ|M:K/`rη\ "pԽ9G(3dWf FMЃ=(<3>bgOeǟD߻t?A5Ǹk)ⓍM40Ch9eK_$MB˅${x}8@ՒbȓO.hrP9ő-ڐzOUmscU2MVLLjM,v,עoo'}f|E(ĦM6e!O*Y`z`䙬]] ;pr^&fP`МzQWá޺lR>_KG׳+qj,d穞uUDt~xOa~Ŧ-]Oas۬7'^U*.@/3 0U$/eY(~%*siKk_^}5LmhIcCmtqvœWqz]=O'2ШB2\&ūA4 N/OpR'IIޅ1Y^تø [dd]ZޕWzTN46a%4]<=N## Z9mpc\Gd AYƬ6eOf|<ċԨV7OXv42ՙ ^ 1='\\nV~[,Ǵ N)ITE(y<ވ%|fǻV+j4||ATUL˜MHZ‰r5$Qy+?N%S(c_P }E.".<|JNoRNp6۔y=ÍwTX<xaQVwn8ssSb_V1vxITYs[bK-ˣ\pDBT#¢jZЕ^P$%ktM! 6swwx߮O&0_Ы+Z9=g+%rAq&/+SZp{i~:iØ烖5pB,=cj|E ZTʋH\*ҧFE[Sa{]@l_c8Q7[Enӯ?f?K/i4J= M$\3xQd%}m:ܴB\`U>=Wk$^Tx~# ~h,SBH#:H۸]AVz5MN?N"< M@+@Y# 'yaOo]NLQL9d7t+Y)!jZ% TcGAUn0eL WFRSc>&#B*뭶 ^7z\ȬcݑM;q\yb*!BuTWIWxݔ*Zj QP `ՔMF^lC}v ِ4B2c%7w\-jȣMFӆ2`Ȑ{S+\^g.v+;w2^#ϰң݊2-pl;V7vT9Hǻ?S&*r9'P j cE67A ddļQ0MeHRH"uLː =|l@!R""G%HUdp(!?éac"#Fk6 ɧA'bIֱ).L'֎ ymq֓[?-wުUj5~$J@Y9(PWaKT❚j IE:tzK-cͷ?}i\\ZwuUuX 6`@5B"%j*u:в5$h(5IM7}6RVy/$tǣpt7`Q ~B}-CCxꠜOpZ){^ }q*w߈2{ 3OsU0^$/~3O;̬($}ӵCIN4GzsD4aa.&׽=>.'tnY=(XuI ʭ5oLz2|pyt@EͷLo>w9zoNOԕϵw\&8zZ.̙ .Bn=Jnf]6X#B Th=R\b}"*) 9[lfmeLϚlrMDeSi]x 85+GLaRksOCK-N,nfUyV+(ݖbpLbYk*1&e/Je5EKOUe3j`FuVa2o=&9=&YAIG4i=7C)lXȳqpw֝q( sAO2 wLz9afO+b*]imKw%`dwFp#CCأ)pkyuqs!-<5qůE-˕=;E\]&Q vk6;~n1f> yUSKC> i1|SEQܼN'fQ2|8QPp7+C>GCxu3zVUjmӯ>C_?ƙG4wϮ|׳5-`o) Tq gNBF-jN3^41:9օQsXulZNYy8Xn Wi(痃cd5]juSD d(NSM<2)Ru!>m|,g(s1z5j o\Ƃ'?=F|vK:M(w\ n9< NyE+ujuU]F#^KT?` `$?~7!e&N摞Doh *B%Q/l >N}S#, lReM0aSk k{x"-_]T?fޟh=4–;ɧB }mS9Vq% IH( 2[6|ORE"8Y/i/K}p"ӵA{; Uf7 h*lClvnƉ("v4&CO_IÆw}M[sVwsϞ Ȱ^.|q򉴐thmݸ/lS2-8ߝ=t9Tzo :5t~,5h=] ޜ$c]٣7ƐppWX8: w(#v&!**qXp2Y jI7q{'YWPf@߷~wIXk84X;ȮUЅZwswl>O4p+6_H:)T|T(g^ >ku忹hFxe6KL}vn]܁GrOTl=v_vHl=ݰ}O:9BaN,J\yj SI[0'v_uJ!bj\>.<{GQ1J#&6-cc;բuG{}W7HkܹdH˙gL50'IFic)H("5èT~^3#ll2# 3bۭ, q8 Ir_M:Jv^}Ь[i$||-!f#?^ y=%`nA\yWcEwŖұE&J ۲<+2SsǷlUОfc#,srvǸ+4PJ.QY[DN RJrE=B+ю`"=4ēdFGMImmE`? *oQN].K6QJ&כ3qm; Q8n;yxw0&-+3ԊV2 {~&{Qq*1{tH2Ҕ$qsZ!utΐ\_~S>-ZEao fyY nNR2$ʙߑFs+F;=(R]{ҝz؍ciyu[n_ -Jp~ ŭvȧwY$Ej ^fgf~!-@rPXQUtD_ƕ@CsSl܉$O >Y¢B,ے :?p?4+4V%l7nP5̼7Zm4Ӄ**b2c^\W82Q`(k~rڊ%tEP]M-WezR(i[\6+}CG0L=V6HoT[p[7w uaukdJGlf?,h,+ w-p\٪n,;fDZ.W y[㋙5NMD? )nQ4~É9~V߸Iph8H5Tؔ*qnex v[Uqendstream endobj 233 0 obj << /Type /XRef /Length 159 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 101 0 R /Root 100 0 R /Size 234 /ID [<51cd91f8117bbeb25f1455d4409c55c8><6cbd89678895671234abde1fff2346be>] >> stream xcb&F~0 $8JT#3y@iѯ46JR?i,PX "9oH y'=DH~4DZH| bH{ 2`2 YsV@$&"yJ@:#70؜ ~v endstream endobj startxref 218185 %%EOF vcd/inst/doc/vcd.bib0000755000175100001440000006127011150520606014025 0ustar hornikusers%% general graphics & original methods @Article{vcd:Cohen:1980, author = {A. Cohen}, title = {On the Graphical Display of the Significant Components in a Two-Way Contingency Table}, journal = {Communications in Statistics---Theory and Methods}, year = {1980}, volume = {A9}, pages = {1025--1041} } @InProceedings{vcd:Hartigan+Kleiner:1981, author = {J. A. Hartigan and B. Kleiner}, title = {Mosaics for Contingency Tables}, booktitle = {Computer Science and Statistics: Proceedings of the 13th Symposium on the Interface}, pages = {268--273}, year = {1981}, editor = {W. F. Eddy}, address = {New York}, publisher = {Springer-Verlag} } @Article{vcd:Hartigan+Kleiner:1984, author = {J. A. Hartigan and B. Kleiner}, title = {A Mosaic of Television Ratings}, journal = {The American Statistician}, year = {1984}, volume = {38}, pages = {32--35} } @TechReport{vcd:Young:1996, author = {Forrest W. Young}, title = {{\pkg{ViSta}}: The Visual Statistics System}, institution = {UNC L.~L.~Thurstone Psychometric Laboratory Research Memorandum}, year = 1996, number = {94--1(c)} } @Book{vcd:Cleveland:1993, author = {William S. Cleveland}, title = {Visualizing Data}, publisher = {Hobart Press}, year = 1993, address = {Summit, New Jersey} } @Article{vcd:Becker+Cleveland+Shyu:1996, author = {Richard A. Becker and William S. Cleveland and Ming-Jen Shyu}, title = {The Visual Design and Control of Trellis Display}, journal = {Journal of Computational and Graphical Statistics}, year = {1996}, volume = {5}, pages = {123--155} } @InProceedings{vcd:Riedwyl+Schuepbach:1994, author = {H. Riedwyl and M. Sch{\"u}pbach}, title = {Parquet Diagram to Plot Contingency Tables}, booktitle = {Softstat '93: Advances in Statistical Software}, pages = {293--299}, year = 1994, editor = {F. Faulbaum}, address = {New York}, publisher = {Gustav Fischer} } %% color @InProceedings{vcd:Ihaka:2003, author = {Ross Ihaka}, title = {Colour for Presentation Graphics}, booktitle = {Proceedings of the 3rd International Workshop on Distributed Statistical Computing, Vienna, Austria}, editor = {Kurt Hornik and Friedrich Leisch and Achim Zeileis}, year = {2003}, url = {http://www.ci.tuwien.ac.at/Conferences/DSC-2003/Proceedings/}, note = {{ISSN 1609-395X}}, } @Article{vcd:Lumley:2006, author = {Thomas Lumley}, title = {Color Coding and Color Blindness in Statistical Graphics}, journal = {ASA Statistical Computing \& Graphics Newsletter}, year = {2006}, volume = {17}, number = {2}, pages = {4--7} } @Book{vcd:Munsell:1905, author = {Albert H. Munsell}, title = {A Color Notation}, publisher = {Munsell Color Company}, year = {1905}, address = {Boston, Massachusetts} } @Article{vcd:Harrower+Brewer:2003, author = {Mark A. Harrower and Cynthia A. Brewer}, title = {\pkg{ColorBrewer.org}: An Online Tool for Selecting Color Schemes for Maps}, journal = {The Cartographic Journal}, year = {2003}, volume = {40}, pages = {27--37} } @InProceedings{vcd:Brewer:1999, author = {Cynthia A. Brewer}, title = {Color Use Guidelines for Data Representation}, booktitle = {Proceedings of the Section on Statistical Graphics, American Statistical Association}, address = {Alexandria, VA}, year = {1999}, pages = {55--60} } @Article{vcd:Cleveland+McGill:1983, author = {William S. Cleveland and Robert McGill}, title = {A Color-caused Optical Illusion on a Statistical Graph}, journal = {The American Statistician}, year = {1983}, volume = {37}, pages = {101--105} } @Book{vcd:CIE:2004, author = {{Commission Internationale de l'\'Eclairage}}, title = {Colorimetry}, edition = {3rd}, publisher = {Publication CIE 15:2004}, address = {Vienna, Austria}, year = {2004}, note = {{ISBN} 3-901-90633-9} } @InProceedings{vcd:Moretti+Lyons:2002, author = {Giovanni Moretti and Paul Lyons}, title = {Tools for the Selection of Colour Palettes}, booktitle = {Proceedings of the New Zealand Symposium On Computer-Human Interaction (SIGCHI 2002)}, address = {University of Waikato, New Zealand}, month = {July}, year = {2002} } @Article{vcd:MacAdam:1942, author = {D. L. MacAdam}, title = {Visual Sensitivities to Color Differences in Daylight}, journal = {Journal of the Optical Society of America}, year = {1942}, volume = {32}, number = {5}, pages = {247--274}, } @Book{vcd:Wyszecki+Stiles:2000, author = {G\"unter Wyszecki and W. S. Stiles}, title = {Color Science}, edition = {2nd}, publisher = {Wiley}, year = {2000}, note = {{ISBN} 0-471-39918-3} } @Misc{vcd:Poynton:2000, author = {Charles Poynton}, title = {Frequently-Asked Questions About Color}, year = {2000}, howpublished = {URL \url{http://www.poynton.com/ColorFAQ.html}}, note = {Accessed 2006-09-14}, } @Misc{vcd:Wiki+HSV:2006, author = {Wikipedia}, title = {{HSV} Color Space --- {W}ikipedia{,} The Free Encyclopedia}, year = {2006}, howpublished = {URL \url{http://en.wikipedia.org/w/index.php?title=HSV_color_space&oldid=74735552}}, note = {Accessed 2006-09-14}, } @Misc{vcd:Wiki+LUV:2006, author = {Wikipedia}, title = {{Lab} Color Space --- {W}ikipedia{,} The Free Encyclopedia}, year = {2006}, howpublished = {URL \url{http://en.wikipedia.org/w/index.php?title=Lab_color_space&oldid=72611029}}, note = {Accessed 2006-09-14}, } @Article{vcd:Smith:1978, author = {Alvy Ray Smith}, title = {Color Gamut Transform Pairs}, journal = {Computer Graphics}, pages = {12--19}, year = {1978}, volume = {12}, number = {3}, note = {ACM SIGGRAPH 78 Conference Proceedings}, } %% url = {http://www.alvyray.com/}, @Article{vcd:Meier+Spalter+Karelitz:2004, author = {Barbara J. Meier and Anne Morgan Spalter and David B. Karelitz}, title = {Interactive Color Palette Tools}, journal = {{IEEE} Computer Graphics and Applications}, volume = {24}, number = {3}, year = {2004}, pages = {64--72}, } %% url = {http://graphics.cs.brown.edu/research/color/} @InCollection{vcd:Mollon:1995, author = {J. Mollon}, editor = {T. Lamb and J. Bourriau}, booktitle = {Colour: Art and Science}, title = {Seeing Color}, publisher = {Cambridge Univesity Press}, year = 1995 } %% Friendly publications @Article{vcd:Friendly:1994, author = {Michael Friendly}, title = {Mosaic Displays for Multi-Way Contingency Tables}, journal = {Journal of the American Statistical Association}, year = {1994}, volume = {89}, pages = {190--200} } @Article{vcd:Friendly:1999, author = {Michael Friendly}, title = {Extending Mosaic Displays: Marginal, Conditional, and Partial Views of Categorical Data}, journal = {Journal of Computational and Graphical Statistics}, year = {1999}, volume = {8}, number = {3}, pages = {373--395} } @Book{vcd:Friendly:2000, author = {Michael Friendly}, title = {Visualizing Categorical Data}, publisher = {\textsf{SAS} Insitute}, year = {2000}, address = {Carey, NC}, URL = {http://www.math.yorku.ca/SCS/vcd/} } %% Augsburg publications @Article{vcd:Theus+Lauer:1999, author = {Martin Theus and Stephan R. W. Lauer}, title = {Visualizing Loglinear Models}, journal = {Journal of Computational and Graphical Statistics}, year = 1999, volume = 8, number = 3, pages = {396--412} } @Article{vcd:Hofmann:2003, author = {Heike Hofmann}, title = {Constructing and Reading Mosaicplots}, journal = {Computational Statistics \& Data Analysis}, year = {2003}, volume = {43}, pages = {565--580} } @Article{vcd:Hofmann:2001, author = {Heike Hofmann}, title = {Generalized Odds Ratios for Visual Modelling}, journal = {Journal of Computational and Graphical Statistics}, year = {2001}, volume = {10}, pages = {1--13} } @Article{vcd:Theus:2003, author = {Martin Theus}, title = {Interactive Data Visualization Using \pkg{Mondrian}}, journal = {Journal of Statistical Software}, volume = 7, number = 11, pages = {1--9}, year = 2003, url = {http://www.jstatsoft.org/v07/i11/}, } @Unpublished{vcd:Hofmann+Theus, author = {Heike Hofmann and Martin Theus}, title = {Interactive Graphics for Visualizing Conditional Distributions}, note = {Unpublished Manuscript}, year = {2005} } @Article{vcd:Hummel:1996, author = {J. Hummel}, title = {Linked Bar Charts: Analysing Categorical Data Graphically}, journal = {Computational Statistics}, year = 1996, volume = 11, pages = {23--33} } @Article{vcd:Unwin+Hawkins+Hofmann:1996, author = {Antony R. Unwin and G. Hawkins and Heike Hofmann and B. Siegl}, title = {Interactive Graphics for Data Sets with Missing Values -- \pkg{MANET}}, journal = {Journal of Computational and Graphical Statistics}, year = 1996, pages = {113--122}, volume = 4, number = 6 } @Manual{vcd:Urbanek+Wichtrey:2006, title = {\pkg{iplots}: Interactive Graphics for \textsf{R}}, author = {Simon Urbanek and Tobias Wichtrey}, year = {2006}, note = {\textsf{R} package version 1.0-3}, url = {http://www.rosuda.org/iPlots/} } %% Software @Manual{vcd:R:2006, title = {\textsf{R}: {A} Language and Environment for Statistical Computing}, author = {{\textsf{R} Development Core Team}}, organization = {\textsf{R} Foundation for Statistical Computing}, address = {Vienna, Austria}, year = {2006}, note = {{ISBN} 3-900051-00-3}, url = {http://www.R-project.org/} } @Article{vcd:Murrell:2002, author = {Paul Murrell}, title = {The \pkg{grid} Graphics Package}, journal = {\proglang{R} News}, year = 2002, volume = 2, number = 2, pages = {14--19}, month = {June}, url = {http://CRAN.R-project.org/doc/Rnews/} } @Book{vcd:Murrell:2006, author = {Paul Murrell}, title = {\textsf{R} Graphics}, publisher = {Chapmann \& Hall/CRC}, address = {Boca Raton, Florida}, year = {2006}, } @Book{vcd:Venables+Ripley:2002, author = {William N. Venables and Brian D. Ripley}, title = {Modern Applied Statistics with \textsf{S}}, edition = {4th}, publisher = {Springer-Verlag}, address = {New York}, year = {2002}, note = {{ISBN} 0-387-95457-0}, url = {http://www.stats.ox.ac.uk/pub/MASS4/} } @Manual{vcd:Ihaka:2006, title = {\pkg{colorspace}: Colorspace Manipulation}, author = {Ross Ihaka}, year = {2006}, note = {\textsf{R} package version 0.95} } @Manual{vcd:Meyer+Zeileis+Hornik:2006, title = {\pkg{vcd}: Visualizing Categorical Data}, author = {David Meyer and Achim Zeileis and Kurt Hornik}, year = {2006}, note = {\textsf{R} package version 1.0-6} } @article{vcd:Ligges+Maechler:2003, title = {\pkg{scatterplot3d} -- An {R} Package for Visualizing Multivariate Data}, author = {Uwe Ligges and Martin M{\"a}chler}, journal = {Journal of Statistical Software}, year = 2003, pages = {1--20}, number = 11, volume = 8, url = {http://www.jstatsoft.org/v08/i11/} } @Manual{vcd:SAS:2005, title = {\proglang{SAS/STAT} Version 9}, author = {\proglang{SAS} Institute Inc.}, year = {2005}, address = {Cary, NC} } @Manual{vcd:SPLUS:2005, title = {\proglang{S-PLUS} 7}, author = {{Insightful Inc.}}, year = {2005}, address = {Seattle, WA} } %% data @Article{vcd:Azzalini+Bowman:1990, author = {A. Azzalini and A. W. Bowman}, title = {A Look at Some Data on the {O}ld {F}aithful Geyser}, journal = {Applied Statistics}, year = {1990}, volume = {39}, pages = {357--365}, } @Article{vcd:Obel:1975, author = {E.B. Obel}, title = {A Comparative Study of Patients with Cancer of the Ovary Who Have Survived More or Less Than 10 Years}, journal = {Acta Obstetricia et Gynecologica Scandinavica}, year = 1975, volume = 55, pages = {429--439} } @InCollection{vcd:Koch+Edwards:1988, author = {G. Koch and S. Edwards}, title = {Clinical Efficiency Trials with Categorical Data}, booktitle = {Biopharmaceutical Statistics for Drug Development}, editor = {K. E. Peace}, publisher = {Marcel Dekker}, address = {New York}, year = {1988}, pages = {403--451} } @TechReport{vcd:Knorr-Held:1999, author = {Leonhard Knorr-Held}, title = {Dynamic Rating of Sports Teams}, institution = {SFB 386 ``Statistical Analysis of Discrete Structures''}, year = {1999}, type = {Discussion Paper}, number = {98}, url = {http://www.stat.uni-muenchen.de/sfb386/} } @Article{vcd:Snee:1974, author = {R. D. Snee}, title = {Graphical Display of Two-Way Contingency Tables}, journal = {The American Statistician}, year = 1974, volume = 28, pages = {9--12} } @Article{vcd:Bickel+Hammel+O'Connell:1975, author = {P. J. Bickel and E. A. Hammel and J. W. O'Connell}, title = {Sex Bias in Graduate Admissions: Data from {B}erkeley}, journal = {Science}, year = 1975, volume = 187, pages = {398--403} } @Book{vcd:Gilbert:1981, author = {G. N. Gilbert}, title = {Modelling Society: An Introduction to Loglinear Analysis for Social Researchers}, publisher = {Allen and Unwin}, year = 1981, address = {London} } @Book{vcd:Thornes+Collard:1979, author = {B. Thornes and J. Collard}, title = {Who Divorces?}, publisher = {Routledge \& Kegan}, year = 1979, address = {London} } @Article{vcd:Dawson:1995, author = {Robert J. MacG Dawson}, title = {The ``Unusual Episode'' Data Revisited}, journal = {Journal of Statistics Education}, year = 1995, volume = 3, url = {http://www.amstat.org/publications/jse/v3n3/datasets.dawson.html} } @Article{vcd:Haberman:1974, author = {S. J. Haberman}, title = {Log-linear Models for Frequency Tables with Ordered Classifications}, journal = {Biometrics}, year = 1974, volume = 30, pages = {689--700} } @Article{vcd:Wing:1962, author = {J. K. Wing}, title = {Institutionalism in Mental Hospitals}, journal = {British Journal of Social Clinical Psychology}, year = 1962, volume = 1, pages = {38--51} } @Book{vcd:Andersen:1991, author = {E. B. Andersen}, title = {The Statistical Analysis of Categorical Data}, publisher = {Springer-Verlag}, year = {1991}, address = {Berlin}, edition = {2nd} } @Article{vcd:Haberman:1973, author = {S. J. Haberman}, title = {The Analysis of Residuals in Cross-classified Tables}, journal = {Biometrics}, year = {1973}, volume = {29}, pages = {205--220} } @Book{vcd:Everitt+Hothorn:2006, author = {Brian S. Everitt and Torsten Hothorn}, title = {A Handbook of Statistical Analyses Using \textsf{R}}, publisher = {Chapman \& Hall/CRC}, address = {Boca Raton, Florida}, year = {2006} } @Article{vcd:Salib+Hillier:1997, author = {Emad Salib and Valerie Hillier}, title = {A Case-Control Study of Smoking and {A}lzheimer's Disease}, journal = {International Journal of Geriatric Psychiatry}, year = {1997}, volume = {12}, pages = {295--300} } %% inference @Book{vcd:Agresti:2002, author = {Alan Agresti}, title = {Categorical Data Analysis}, publisher = {John Wiley \& Sons}, year = {2002}, address = {Hoboken, New Jersey}, edition = {2nd} } @Book{vcd:Mazanec+Strasser:2000, author = {Josef A. Mazanec and Helmut Strasser}, title = {A Nonparametric Approach to Perceptions-based Market Segmentation: Foundations}, publisher = {Springer-Verlag}, year = {2000}, address = {Berlin} } @Article{vcd:Strasser+Weber:1999, author = {Helmut Strasser and Christian Weber}, title = {On the Asymptotic Theory of Permutation Statistics}, journal = {Mathematical Methods of Statistics}, volume = {8}, pages = {220--250}, year = {1999} } @Book{vcd:Pesarin:2001, author = {Fortunato Pesarin}, title = {Multivariate Permutation Tests}, year = {2001}, publisher = {John Wiley \& Sons}, address = {Chichester} } @Article{vcd:Ernst:2004, author = {Michael D. Ernst}, title = {Permutation Methods: A Basis for Exact Inference}, journal = {Statistical Science}, volume = {19}, year = {2004}, pages = {676--685} } @Article{vcd:Patefield:1981, author = {W. M. Patefield}, title = {An Efficient Method of Generating $R \times C$ Tables with Given Row and Column Totals}, note = {{A}lgorithm AS 159}, journal = {Applied Statistics}, volume = {30}, year = {1981}, pages = {91--97} } %% own @InProceedings{vcd:Meyer+Zeileis+Hornik:2003, author = {David Meyer and Achim Zeileis and Kurt Hornik}, title = {Visualizing Independence Using Extended Association Plots}, booktitle = {Proceedings of the 3rd International Workshop on Distributed Statistical Computing, Vienna, Austria}, editor = {Kurt Hornik and Friedrich Leisch and Achim Zeileis}, year = {2003}, url = {http://www.ci.tuwien.ac.at/Conferences/DSC-2003/Proceedings/}, note = {{ISSN 1609-395X}}, } @TechReport{vcd:Zeileis+Meyer+Hornik:2005, author = {Achim Zeileis and David Meyer and Kurt Hornik}, title = {Residual-based Shadings for Visualizing (Conditional) Independence}, institution = {Department of Statistics and Mathematics, Wirtschaftsuniversit\"at Wien, Research Report Series}, year = {2005}, type = {Report}, number = {20}, month = {August}, url = {http://epub.wu-wien.ac.at/dyn/openURL?id=oai:epub.wu-wien.ac.at:epub-wu-01_871} } @Article{vcd:Zeileis+Meyer+Hornik:2007, author = {Achim Zeileis and David Meyer and Kurt Hornik}, title = {Residual-based Shadings for Visualizing (Conditional) Independence}, journal = {Journal of Computational and Graphical Statistics}, year = {2007}, volume = {16}, number = {3}, pages = {507--525}, doi = {10.1198/106186007X237856}, url = {http://statmath.wu-wien.ac.at/~zeileis/papers/Zeileis+Meyer+Hornik-2007.pdf} } @TechReport{vcd:Meyer+Zeileis+Hornik:2005a, author = {David Meyer and Achim Zeileis and Kurt Hornik}, title = {The Strucplot Framework: Visualizing Multi-Way Contingency Tables with \pkg{vcd}}, institution = {Department of Statistics and Mathematics, Wirtschaftsuniversit\"at Wien, Research Report Series}, year = {2005}, type = {Report}, number = {22}, month = {November}, url = {http://epub.wu-wien.ac.at/dyn/openURL?id=oai:epub.wu-wien.ac.at:epub-wu-01_8a1} } @Article{vcd:Meyer+Zeileis+Hornik:2006b, author = {David Meyer and Achim Zeileis and Kurt Hornik}, title = {The Strucplot Framework: Visualizing Multi-way Contingency Tables with \pkg{vcd}}, year = {2006}, journal = {Journal of Statistical Software}, volume = {17}, number = {3}, pages = {1--48}, url = {http://www.jstatsoft.org/v17/i03/} } @InCollection{vcd:Meyer+Zeileis+Hornik:2006a, author = {David Meyer and Achim Zeileis and Kurt Hornik}, title = {Visualizing Contingency Tables}, editor = {Chun-Houh Chen and Wolfang H\"ardle and Antony Unwin}, booktitle = {Handbook of Data Visualization}, series = {Springer Handbooks of Computational Statistics}, year = {2006}, publisher = {Springer-Verlag}, address = {New York}, note = {{ISBN} 3-540-33036-4, to appear} } @Article{vcd:Hothorn+Hornik+VanDeWiel:2006, author = {Torsten Hothorn and Kurt Hornik and Mark A. van de Wiel and Achim Zeileis}, title = {A {L}ego System for Conditional Inference}, journal = {The American Statistician}, year = {2006}, volume = {60}, number = {3}, pages = {257--263}, doi = {10.1198/000313006X118430} } @TechReport{vcd:Zeileis+Hornik:2006, author = {Achim Zeileis and Kurt Hornik}, title = {Choosing Color Palettes for Statistical Graphics}, institution = {Department of Statistics and Mathematics, Wirtschaftsuniversit\"at Wien, Research Report Series}, year = {2006}, type = {Report}, number = {41}, month = {October}, url = {http://epub.wu-wien.ac.at/} } %% bad color examples @Article{vcd:Gneiting+Sevcikova+Percival:2006, author = {Tilmann Gneiting and Hana \v{S}ev\v{c}\'ikov\'a and Donald B. Percival and Martin Schlather and Yindeng Jiang}, title = {Fast and Exact Simulation of Large Gaussian Lattice Systems in {$\mathbb{R}^2$}: Exploring the Limits}, year = {2006}, journal = {Journal of Computational and Graphical Statistics}, volume = {15}, number = {3}, pages = {483--501}, note = {Figures~1--4} } @Article{vcd:Yang+Buckley+Dudoit:2002, author = {Yee Hwa Yang and Michael J. Buckley and Sandrine Dudoit and Terence P. Speed}, title = {Comparison of Methods for Image Analysis on {cDNA} Microarray Data}, year = {2002}, journal = {Journal of Computational and Graphical Statistics}, volume = {11}, number = {1}, pages = {108--136}, note = {Figure~4a} } @Article{vcd:Kneib:2006, author = {Thomas Kneib}, title = {Mixed Model-based Inference in Geoadditive Hazard Regression for Interval-censored Survival Times}, year = {2006}, journal = {Computational Statistics \& Data Analysis}, volume = {51}, pages = {777--792}, note = {Figure~5 (left)} } @Article{vcd:Friendly:2002, author = {Michael Friendly}, title = {A Brief History of the Mosaic Display}, year = {2002}, journal = {Journal of Computational and Graphical Statistics}, volume = {11}, number = {1}, pages = {89--107}, note = {Figure~11 (left, middle)} } @Article{vcd:Celeux+Hurn+Robert:2000, author = {Gilles Celeux and Merrilee Hurn and Christian P. Robert}, title = {Computational and Inferential Difficulties with Mixture Posterior Distributions}, year = {2000}, journal = {Journal of the American Statistical Association}, volume = {95}, number = {451}, pages = {957--970}, note = {Figure~3} } %% pointers from Hadley @article{cleveland:1987, Author = {Cleveland, William and McGill, Robert}, Journal = {Journal of the Royal Statistical Society A}, Number = {3}, Pages = {192-229}, Title = {Graphical Perception: The Visual Decoding of Quantitative Information on Graphical Displays of Data}, Volume = {150}, Year = {1987}} @article{cleveland:1984, Author = {Cleveland, William S. and McGill, M. E.}, Journal = {Journal of the American Statistical Association}, Number = 387, Pages = {531-554}, Title = {Graphical Perception: Theory, Experimentation and Application to the Development of Graphical Methods}, Volume = 79, Year = 1984} @article{huang:1997, Author = {Huang, Chisheng and McDonald, John Alan and Stuetzle, Werner}, Journal = {Journal of Computational and Graphical Statistics}, Pages = {383--396}, Title = {Variable resolution bivariate plots}, Volume = {6}, Year = {1997}} @article{carr:1987, Author = {Carr, D. B. and Littlefield, R. J. and Nicholson, W. L. and Littlefield, J. S.}, Journal = {Journal of the American Statistical Association}, Number = {398}, Pages = {424-436}, Title = {Scatterplot Matrix Techniques for Large N}, Volume = {82}, Year = {1987}} @book{cleveland:1994, Author = {Cleveland, William}, Publisher = {Hobart Press}, Title = {The Elements of Graphing Data}, Year = {1994}} @book{chambers:1983, Author = {Chambers, John and Cleveland, William and Kleiner, Beat and Tukey, Paul}, Publisher = {Wadsworth}, Title = {Graphical methods for data analysis}, Year = {1983}} @book{bertin:1983, Address = {Madison, WI}, Author = {Bertin, Jacques}, Publisher = {University of Wisconsin Press}, Title = {Semiology of Graphics}, Year = {1983}} @book{wilkinson:2006, Author = {Wilkinson, Leland}, Publisher = {Springer-Verlag}, Series = {Statistics and Computing}, Title = {The Grammar of Graphics}, Year = {2005}} vcd/inst/doc/struc.pdf0000755000175100001440000000622011150520606014420 0ustar hornikusers%PDF-1.4 % 1 0 obj << /Length 2 0 R /Filter /FlateDecode >> stream xZn7 ?l99Hrv$ ?;A /=CɥZIP "ݬ.6əˋ Ya!jU_ȿvy!"LN//Y,6Hh ƶNيȽŝpX470/kj4~r-.eQCx4 |6RIᢾaBZ[F$'%8+[~U[uR[K@L]tcҡú7Ӵ6VgwBu(HqkWiK1uґF[K@o$T'j2kHA6ĢĐNWd#@c6ZJl`)cVٸF0@еXh>NuA?Q`~E[JJ) -b-[yy ƕҀ~L~iiuuPiIn00-ݨJ.jS~#S(^" YQm"PSvg[*C3*Ne ~*=zKek08-RzY cAm3yAF3s),>7l^Z")h&n ٣LIkkFr^Z3%E%vmk(;,*XK憣Ξn?ⅅ3LӷҜ9E#:{h5lg!䰩\j鷣mN1,#QFvhMBp[cl嚢((.)oW좵ۀٷXw";!B%x5*Z-tM^?푉׫[wHδe!]=Wix09Es{kp5 R.l'DodP"!YFh-UdYrB;qڣaJSvR(AT^ -,na&Qr!t  \\UӸDtPt-3ݘslHAVsF@{Tf!.Sڳ 埝'n5n']y<,i|-xѰ&ؒl9ǩs5K( gsņaqRR$+ܕ< zֺ'-]{=`_Cby3?a:H}22Ԉ+cMBܘ0>5 Q 1DN!S=A”Duibj/VZT_f~5@Mx#CkƸF+sG/h<,p @4^SL2:QI'4#w}Ǘ v35 O kڻq:2H/k:o^a{ͣQ'}nLQ˟+?YgX< ݨy:,Ҩ1);mG@cEI7%.`4ڨUҏyB3|SWS܉1mZ@X#d~TƔJ_&endstream endobj 2 0 obj 1891 endobj 4 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Courier /Encoding /WinAnsiEncoding >> endobj 5 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Helvetica /Encoding /WinAnsiEncoding >> endobj 6 0 obj << /F1 5 0 R /F2 4 0 R >> endobj 7 0 obj << /Font 6 0 R /ProcSet [ /PDF ] >> endobj 8 0 obj << /Type /Page /Parent 3 0 R /Resources 7 0 R /MediaBox [ 0 0 794 595 ] /Contents 1 0 R >> endobj 3 0 obj << /Type /Pages /Resources 7 0 R /MediaBox [ 0 0 595 842 ] /Kids [ 8 0 R ] /Count 1 >> endobj 9 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 10 0 obj << /Creator /Producer /CreationDate (D:20051019112228+02'00') >> endobj xref 0 11 0000000000 65535 f 0000000017 00000 n 0000001993 00000 n 0000002495 00000 n 0000002020 00000 n 0000002133 00000 n 0000002248 00000 n 0000002302 00000 n 0000002367 00000 n 0000002631 00000 n 0000002690 00000 n trailer << /Size 11 /Root 9 0 R /Info 10 0 R >> startxref 2901 %%EOF vcd/inst/doc/strucplot.R0000644000175100001440000010036412547003156014757 0ustar hornikusers### R code from vignette source 'strucplot.Rnw' ################################################### ### code chunk number 1: preliminaries ################################################### set.seed(1071) library(grid) library(vcd) data(Titanic) data(HairEyeColor) data(PreSex) data(Arthritis) art <- xtabs(~Treatment + Improved, data = Arthritis) ################################################### ### code chunk number 2: Arthritis ################################################### mosaic(art, gp = shading_max, split_vertical = TRUE) ################################################### ### code chunk number 3: UCBAdmissions ################################################### cotabplot(UCBAdmissions, panel = cotab_coindep, shade = TRUE, legend = FALSE, type = "assoc") ################################################### ### code chunk number 4: PreSex ################################################### presextest <- coindep_test(PreSex, margin = c(1,4), indepfun = function(x) sum(x^2), n = 5000) mosaic(PreSex, condvars = c(1, 4), shade = TRUE, gp_args = list(p.value = presextest$p.value)) ################################################### ### code chunk number 5: Titanic ################################################### doubledecker(Survived ~ ., data = Titanic, labeling_args = list(set_varnames = c(Sex = "Gender"))) ################################################### ### code chunk number 6: vcdlayout ################################################### pushViewport(vcd:::vcdViewport(legend = T, mar =4)) seekViewport("main") grid.rect(gp = gpar(lwd = 3)) grid.text("main", gp = gpar(fontsize = 20)) seekViewport("sub") grid.rect(gp = gpar(lwd = 3)) grid.text("sub", gp = gpar(fontsize = 20)) seekViewport("plot") grid.rect(gp = gpar(lwd = 3)) grid.text("plot", gp = gpar(fontsize = 20)) seekViewport("legend") grid.text("legend", rot = 90, gp = gpar(fontsize = 20)) grid.rect(gp = gpar(lwd = 3)) seekViewport("legend_sub") grid.rect(gp = gpar(lwd = 3)) grid.text("[F]", gp = gpar(fontsize = 20)) seekViewport("legend_top") grid.rect(gp = gpar(lwd = 3)) grid.text("[E]", gp = gpar(fontsize = 20)) seekViewport("margin_top") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_top", gp = gpar(fontsize = 20)) seekViewport("margin_bottom") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_bottom", gp = gpar(fontsize = 20)) seekViewport("margin_right") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_right", rot = 90, gp = gpar(fontsize = 20)) seekViewport("margin_left") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_left", rot = 90, gp = gpar(fontsize = 20)) seekViewport("corner_top_left") grid.rect(gp = gpar(lwd = 3)) grid.text("[A]", gp = gpar(fontsize = 20)) seekViewport("corner_top_right") grid.rect(gp = gpar(lwd = 3)) grid.text("[B]", gp = gpar(fontsize = 20)) seekViewport("corner_bottom_left") grid.rect(gp = gpar(lwd = 3)) grid.text("[C]", gp = gpar(fontsize = 20)) seekViewport("corner_bottom_right") grid.rect(gp = gpar(lwd = 3)) grid.text("[D]", gp = gpar(fontsize = 20)) ################################################### ### code chunk number 7: structable ################################################### (HEC <- structable(Eye ~ Sex + Hair, data = HairEyeColor)) ################################################### ### code chunk number 8: Observed ################################################### mosaic(HEC) ################################################### ### code chunk number 9: Observed2 ################################################### mosaic(~ Sex + Eye + Hair, data = HairEyeColor) ################################################### ### code chunk number 10: Observedfig ################################################### mosaic(HEC) ################################################### ### code chunk number 11: Expected ################################################### mosaic(HEC, type = "expected") ################################################### ### code chunk number 12: Expectedfig ################################################### mosaic(HEC, type = "expected") ################################################### ### code chunk number 13: sieve ################################################### sieve(~ Sex + Eye + Hair, data = HEC, spacing = spacing_dimequal(c(2,0,0))) ################################################### ### code chunk number 14: sievefig ################################################### sieve(~ Sex + Eye + Hair, data = HEC, spacing = spacing_dimequal(c(2,0,0))) ################################################### ### code chunk number 15: Residuals ################################################### assoc(HEC, compress = FALSE) ################################################### ### code chunk number 16: Residualsfig ################################################### assoc(HEC, compress = FALSE) ################################################### ### code chunk number 17: strucplot.Rnw:592-593 ################################################### options(width=60) ################################################### ### code chunk number 18: split1 ################################################### mosaic(HEC, split_vertical = c(TRUE, FALSE, TRUE), labeling_args = list(abbreviate_labs = c(Eye = 3))) ################################################### ### code chunk number 19: strucplot.Rnw:601-602 ################################################### options(width=70) ################################################### ### code chunk number 20: splitfig ################################################### mosaic(HEC, split_vertical = c(TRUE, FALSE, TRUE), labeling_args = list(abbreviate_labs = c(Eye = 3))) ################################################### ### code chunk number 21: split2 ################################################### mosaic(HEC, direction = c("v","h","v")) ################################################### ### code chunk number 22: doubledecker1 ################################################### doubledecker(Titanic) ################################################### ### code chunk number 23: doubledecker2 ################################################### doubledecker(Survived ~ Class + Sex + Age, data = Titanic) ################################################### ### code chunk number 24: strucplot.Rnw:665-666 ################################################### options(width=75) ################################################### ### code chunk number 25: subsetting ################################################### (STD <- structable(~ Sex + Class + Age, data = Titanic[,,2:1,])) STD["Male",] STD["Male", c("1st","2nd","3rd")] ################################################### ### code chunk number 26: strucplot.Rnw:675-676 ################################################### options(width=70) ################################################### ### code chunk number 27: conditioning ################################################### STD[["Male",]] STD[[c("Male", "Adult"),]] STD[["Male","1st"]] ################################################### ### code chunk number 28: Variables1 ################################################### pushViewport(viewport(layout = grid.layout(ncol = 2))) ################################################### ### code chunk number 29: Variables2 ################################################### pushViewport(viewport(layout.pos.col = 1)) mosaic(STD[["Male"]], margins = c(left = 2.5, top = 2.5, 0), sub = "Male", newpage = FALSE) popViewport() ################################################### ### code chunk number 30: Variables3 ################################################### pushViewport(viewport(layout.pos.col = 2)) mosaic(STD[["Female"]], margins = c(top = 2.5, 0), sub = "Female", newpage = FALSE) popViewport(2) ################################################### ### code chunk number 31: Variablesfig ################################################### pushViewport(viewport(layout = grid.layout(ncol = 2))) pushViewport(viewport(layout.pos.col = 1)) mosaic(STD[["Male"]], margins = c(left = 2.5, top = 2.5, 0), sub = "Male", newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 2)) mosaic(STD[["Female"]], margins = c(top = 2.5, 0), sub = "Female", newpage = FALSE) popViewport(2) ################################################### ### code chunk number 32: cotabplot ################################################### cotabplot(~ Class + Age | Sex, data = STD, split_vertical = TRUE) ################################################### ### code chunk number 33: cotabplotfig ################################################### cotabplot(~ Class + Age | Sex, data = STD, split_vertical = TRUE) ################################################### ### code chunk number 34: Conditioning1 ################################################### mosaic(STD, condvars = "Sex", split_vertical = c(TRUE, TRUE, FALSE)) ################################################### ### code chunk number 35: Conditioning2 ################################################### mosaic(~ Class + Age | Sex, data = STD, split_vertical = c(TRUE, TRUE, FALSE)) ################################################### ### code chunk number 36: Conditioningfig ################################################### mosaic(~ Class + Age | Sex, data = STD, split_vertical = c(TRUE, TRUE, FALSE)) ################################################### ### code chunk number 37: pairs ################################################### pairs(STD, highlighting = 2, diag_panel = pairs_diagonal_mosaic, diag_panel_args = list(fill = grey.colors)) ################################################### ### code chunk number 38: pairsfig ################################################### pairs(STD, highlighting = 2, diag_panel = pairs_diagonal_mosaic, diag_panel_args = list(fill = grey.colors)) ################################################### ### code chunk number 39: viewportnames ################################################### mosaic(~ Hair + Eye, data = HEC, pop = FALSE) seekViewport("cell:Hair=Blond") grid.rect(gp = gpar(col = "red", lwd = 4)) seekViewport("cell:Hair=Blond,Eye=Blue") grid.circle(r = 0.2, gp = gpar(fill = "cyan")) ################################################### ### code chunk number 40: viewportnamesfig ################################################### mosaic(~ Hair + Eye, data = HEC, pop = FALSE) seekViewport("cell:Hair=Blond") grid.rect(gp = gpar(col = "red", lwd = 4)) seekViewport("cell:Hair=Blond,Eye=Blue") grid.circle(r = 0.2, gp = gpar(fill = "cyan")) ################################################### ### code chunk number 41: changeplot ################################################### assoc(Eye ~ Hair, data = HEC, pop = FALSE) getNames()[1:6] grid.edit("rect:Hair=Blond,Eye=Blue", gp = gpar(fill = "red")) ################################################### ### code chunk number 42: changeplotfig ################################################### x <- tab <- margin.table(HairEyeColor, 1:2) x[] <- "light gray" x["Blond","Blue"] <- "Red" assoc(tab, gp = gpar(fill = x)) ################################################### ### code chunk number 43: ucb ################################################### (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)) ################################################### ### code chunk number 44: ucbfig ################################################### (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)) ################################################### ### code chunk number 45: recycling ################################################### mosaic(Titanic, gp = gpar(fill = c("gray","dark magenta")), spacing = spacing_highlighting, labeling_args = list(abbreviate_labs = c(Age = 3), rep = c(Survived = FALSE)) ) ################################################### ### code chunk number 46: recyclingfig ################################################### mosaic(Titanic, gp = gpar(fill = c("gray","dark magenta")), spacing = spacing_highlighting, labeling_args = list(abbreviate_labs = c(Age = 3), rep = c(Survived = FALSE)) ) ################################################### ### code chunk number 47: shading1 ################################################### expected <- independence_table(ucb) (x <- (ucb - expected) / sqrt(expected)) (shading1_obj <- ifelse(x > 0, "royalblue4", "mediumorchid4")) mosaic(ucb, gp = gpar(fill = shading1_obj)) ################################################### ### code chunk number 48: shading1fig ################################################### expected <- independence_table(ucb) (x <- (ucb - expected) / sqrt(expected)) (shading1_obj <- ifelse(x > 0, "royalblue4", "mediumorchid4")) mosaic(ucb, gp = gpar(fill = shading1_obj)) ################################################### ### code chunk number 49: shading2 ################################################### shading2_fun <- function(x) gpar(fill = ifelse(x > 0, "royalblue4", "mediumorchid4")) ################################################### ### code chunk number 50: shading3 ################################################### mosaic(ucb, gp = shading2_fun) ################################################### ### code chunk number 51: shading3 ################################################### shading3a_fun <- function(col = c("royalblue4", "mediumorchid4")) { col <- rep(col, length.out = 2) function(x) gpar(fill = ifelse(x > 0, col[1], col[2])) } ################################################### ### code chunk number 52: shading4 ################################################### mosaic(ucb, gp = shading3a_fun(c("royalblue4","mediumorchid4"))) ################################################### ### code chunk number 53: shading4 ################################################### shading3b_fun <- function(observed = NULL, residuals = NULL, expected = NULL, df = NULL, col = c("royalblue4", "mediumorchid4")) { col <- rep(col, length.out = 2) function(x) gpar(fill = ifelse(x > 0, col[1], col[2])) } class(shading3b_fun) <- "grapcon_generator" ################################################### ### code chunk number 54: shading5 ################################################### mosaic(ucb, gp = shading3b_fun, gp_args = list(col = c("red","blue"))) ################################################### ### code chunk number 55: haireye1 ################################################### haireye <- margin.table(HairEyeColor, 1:2) mosaic(haireye, gp = shading_hsv) ################################################### ### code chunk number 56: haireye2 ################################################### mosaic(haireye, gp = shading_hcl) ################################################### ### code chunk number 57: haireye3 ################################################### mosaic(haireye, gp = shading_hcl, gp_args = list(h = c(130, 43), c = 100, l = c(90, 70))) ################################################### ### code chunk number 58: haireyefig1 ################################################### mosaic(haireye, gp = shading_hsv, margin = c(bottom = 1), keep_aspect_ratio = FALSE) ################################################### ### code chunk number 59: haireyefig2 ################################################### mosaic(haireye, gp = shading_hcl, margin = c(bottom = 1), keep_aspect_ratio = FALSE) ################################################### ### code chunk number 60: haireyefig3 ################################################### mosaic(haireye, gp = shading_hcl, margin = c(bottom = 1), gp_args = list(h = c(130, 43), c = 100, l = c(90, 70)), keep_aspect_ratio = FALSE) ################################################### ### code chunk number 61: interpolate ################################################### mosaic(haireye, shade = TRUE, gp_args = list(interpolate = 1:4)) ################################################### ### code chunk number 62: continuous1 ################################################### ipol <- function(x) pmin(x/4, 1) ################################################### ### code chunk number 63: continuous2 ################################################### mosaic(haireye, shade = TRUE, gp_args = list(interpolate = ipol), labeling_args = list(abbreviate_labs = c(Sex = TRUE))) ################################################### ### code chunk number 64: interpolatefig ################################################### pushViewport(viewport(layout = grid.layout(ncol = 2))) pushViewport(viewport(layout.pos.col = 1)) mosaic(haireye, gp_args = list(interpolate = 1:4), margin = c(right = 1), keep_aspect_ratio= FALSE,newpage = FALSE,legend_width=5.5,shade = TRUE) popViewport(1) pushViewport(viewport(layout.pos.col = 2)) mosaic(haireye, gp_args = list(interpolate = ipol), margin = c(left=3,right = 1), keep_aspect_ratio = FALSE, newpage = FALSE, shade = TRUE) popViewport(2) ################################################### ### code chunk number 65: bundesliga ################################################### BL <- xtabs(~ HomeGoals + AwayGoals, data = Bundesliga, subset = Year == 1995) mosaic(BL, shade = TRUE) ################################################### ### code chunk number 66: friendly ################################################### mosaic(BL, gp = shading_Friendly, legend = legend_fixed, zero_size = 0) ################################################### ### code chunk number 67: bundesligafig ################################################### pushViewport(viewport(layout = grid.layout(ncol = 2))) pushViewport(viewport(layout.pos.col = 1)) mosaic(BL, margin = c(right = 1), keep_aspect_ratio= FALSE, newpage = FALSE, legend_width=5.5, shade = TRUE) popViewport(1) pushViewport(viewport(layout.pos.col = 2)) mosaic(BL, gp = shading_Friendly, legend = legend_fixed, zero_size = 0, margin = c(right = 1), keep_aspect_ratio= FALSE, newpage = FALSE, legend_width=5.5) popViewport(2) ################################################### ### code chunk number 68: arthritis ################################################### set.seed(4711) mosaic(~ Treatment + Improved, data = Arthritis, subset = Sex == "Female", gp = shading_max) ################################################### ### code chunk number 69: arthritisfig ################################################### set.seed(4711) mosaic(~ Treatment + Improved, data = Arthritis, subset = Sex == "Female", gp = shading_max) ################################################### ### code chunk number 70: default ################################################### mosaic(Titanic) ################################################### ### code chunk number 71: clipping ################################################### mosaic(Titanic, labeling_args = list(clip = c(Survived = TRUE, Age = TRUE))) ################################################### ### code chunk number 72: abbreviating ################################################### mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = TRUE, Age = 3))) ################################################### ### code chunk number 73: rotate ################################################### mosaic(Titanic, labeling_args = list(rot_labels = c(bottom = 90, right = 0), offset_varnames = c(right = 1), offset_labels = c(right = 0.3)), margins = c(right = 4, bottom = 3)) ################################################### ### code chunk number 74: repeat ################################################### mosaic(Titanic, labeling_args = list(rep = c(Survived = FALSE, Age = FALSE))) ################################################### ### code chunk number 75: label1fig ################################################### pushViewport(viewport(layout = grid.layout(ncol = 2,nrow=3))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(Titanic, newpage = FALSE, keep = TRUE, margin = c(right = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(Titanic, labeling_args = list(clip = c(Survived = TRUE, Age = TRUE)), newpage = FALSE, keep = TRUE, margin = c(left = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = TRUE, Age = 2)), newpage = FALSE, keep = TRUE, margin = c(right = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(rep = c(Survived = FALSE, Age = FALSE)), newpage = FALSE, keep = TRUE, margin = c(left = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 1:2, layout.pos.row = 3)) pushViewport(viewport(width = 0.55)) mosaic(Titanic, labeling_args = list(rot_labels = c(bottom = 90, right = 0), offset_varnames = c(right = 1), offset_labels = c(right = 0.3)), margins = c(right = 4, bottom = 3), newpage = FALSE, keep = FALSE, gp_labels = gpar(fontsize = 10)) popViewport(3) ################################################### ### code chunk number 76: left ################################################### mosaic(Titanic, labeling_args = list(pos_varnames = "left", pos_labels = "left", just_labels = "left", rep = FALSE)) ################################################### ### code chunk number 77: left2 ################################################### mosaic(Titanic, labeling = labeling_left) ################################################### ### code chunk number 78: margins ################################################### mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, abbreviate_labs = c(Survived = 1, Age = 3))) ################################################### ### code chunk number 79: boxes ################################################### mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, boxes = TRUE, clip = TRUE)) ################################################### ### code chunk number 80: boxes2 ################################################### mosaic(Titanic, labeling = labeling_cboxed) ################################################### ### code chunk number 81: labbl ################################################### mosaic(Titanic, labeling_args = list(tl_labels = TRUE, boxes = TRUE, clip = c(Survived = FALSE, Age = FALSE, TRUE), abbreviate_labs = c(Age = 4), labbl_varnames = TRUE), margins = c(left = 4, right = 1, 3)) ################################################### ### code chunk number 82: labbl2 ################################################### mosaic(Titanic, labeling = labeling_lboxed, margins = c(right = 4, left = 1, 3)) ################################################### ### code chunk number 83: label2fig ################################################### pushViewport(viewport(layout = grid.layout(ncol = 2, nrow = 2))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(Titanic, labeling_args = list(pos_varnames = "left", pos_labels = "left", just_labels = "left", rep = FALSE), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 12)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, abbreviate_labs = c(Survived = 1, Age = 3)), newpage = FALSE, keep = TRUE, margins = c(left = 4, right = 1, 3), gp_labels = gpar(fontsize = 12)) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, boxes = TRUE, clip = TRUE), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 12)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(tl_labels = TRUE, boxes = TRUE, clip = c(Survived = FALSE, Age = FALSE, TRUE), labbl_varnames = TRUE, abbreviate_labs = c(Age = 4)), margins = c(left = 4, right = 1, 3), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 12)) popViewport(2) ################################################### ### code chunk number 84: cell ################################################### mosaic(~ MaritalStatus + Gender, data = PreSex, labeling = labeling_cells) ################################################### ### code chunk number 85: cell2 ################################################### mosaic(~ PremaritalSex + ExtramaritalSex, data = PreSex, labeling = labeling_cells(abbreviate_labels = TRUE, abbreviate_varnames = TRUE, clip = FALSE)) ################################################### ### code chunk number 86: conditional ################################################### mosaic(~ PremaritalSex + ExtramaritalSex | MaritalStatus + Gender, data = PreSex, labeling = labeling_conditional(abbreviate_varnames = TRUE, abbreviate_labels = TRUE, clip = FALSE, gp_text = gpar(col = "red"))) ################################################### ### code chunk number 87: text ################################################### mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = 1, Age = 4)), pop = FALSE) tab <- ifelse(Titanic < 6, NA, Titanic) labeling_cells(text = tab, clip = FALSE)(Titanic) ################################################### ### code chunk number 88: label3fig ################################################### grid.newpage() pushViewport(viewport(layout = grid.layout(ncol = 2, nrow = 2))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(~ MaritalStatus + Gender, data = PreSex, labeling = labeling_cells, newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(~ PremaritalSex + ExtramaritalSex, data = PreSex, labeling = labeling_cells(abbreviate_labels = TRUE, abbreviate_varnames = TRUE, clip = FALSE), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(~ PremaritalSex + ExtramaritalSex | MaritalStatus + Gender, data = PreSex, labeling = labeling_conditional(abbreviate_varnames = TRUE, abbreviate_labels = TRUE, clip = FALSE, gp_text = gpar(col = "red")), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = 1, Age = 3)), pop = FALSE, newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) tab <- ifelse(Titanic < 6, NA, Titanic) labeling_cells(text = tab, clip = FALSE)(Titanic) ################################################### ### code chunk number 89: list ################################################### mosaic(Titanic, labeling = labeling_list, margins = c(bottom = 5)) ################################################### ### code chunk number 90: listfig ################################################### mosaic(Titanic, labeling = labeling_list, margins = c(bottom = 5), keep = TRUE) ################################################### ### code chunk number 91: artspine ################################################### (art <- structable(~Treatment + Improved, data = Arthritis, split_vertical = TRUE)) (my_spacing <- list(unit(0.5, "lines"), unit(c(0, 0), "lines"))) my_colors <- c("lightgray", "lightgray", "black") mosaic(art, spacing = my_spacing, gp = gpar(fill = my_colors, col = my_colors)) ################################################### ### code chunk number 92: artspinefig ################################################### (art <- structable(~Treatment + Improved, data = Arthritis, split_vertical = TRUE)) (my_spacing <- list(unit(0.5, "lines"), unit(c(0, 0), "lines"))) my_colors <- c("lightgray", "lightgray", "black") mosaic(art, spacing = my_spacing, gp = gpar(fill = my_colors, col = my_colors)) ################################################### ### code chunk number 93: artspine ################################################### mosaic(Improved ~ Treatment, data = Arthritis, split_vertical = TRUE) ################################################### ### code chunk number 94: space1 ################################################### mosaic(art, spacing = spacing_equal(unit(2, "lines"))) ################################################### ### code chunk number 95: space2 ################################################### mosaic(art, spacing = spacing_dimequal(unit(1:2, "lines"))) ################################################### ### code chunk number 96: space3 ################################################### mosaic(art, spacing = spacing_increase(start = unit(0.5, "lines"), rate = 1.5)) ################################################### ### code chunk number 97: spine4 ################################################### mosaic(art, spacing = spacing_highlighting, gp = my_colors) ################################################### ### code chunk number 98: spacingfig ################################################### pushViewport(viewport(layout = grid.layout(ncol = 2, nrow = 2))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(art, spacing = spacing_equal(unit(2, "lines")), keep = TRUE, newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(art, spacing = spacing_dimequal(unit(c(0.5, 2), "lines")), keep = TRUE, newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(art, spacing = spacing_increase(start = unit(0.3, "lines"), rate = 2.5), keep = TRUE, newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(art, spacing = spacing_highlighting, keep = TRUE, newpage = FALSE) popViewport(2) ################################################### ### code chunk number 99: oc1 ################################################### tab <- xtabs(Freq ~ stage + operation + xray + survival, data = OvaryCancer) ################################################### ### code chunk number 100: oc2 ################################################### structable(survival ~ ., data = tab) ################################################### ### code chunk number 101: oc3 ################################################### dpa <- list(var_offset = 1.2, rot = -30, just_leveltext= "left") pairs(tab, diag_panel = pairs_barplot, diag_panel_args = dpa) ################################################### ### code chunk number 102: ocpairs ################################################### dpa <- list(var_offset = 1.2, rot = -30, just_leveltext= "left") pairs(tab, diag_panel = pairs_barplot, diag_panel_args = dpa) ################################################### ### code chunk number 103: oc4 ################################################### doubledecker(survival ~ stage + operation + xray, data = tab) ################################################### ### code chunk number 104: ocdoubledecker ################################################### doubledecker(survival ~ stage + operation + xray, data = tab) ################################################### ### code chunk number 105: oc6 ################################################### split <- c(TRUE, TRUE, TRUE, FALSE) mosaic(tab, expected = ~ survival + operation * xray * stage, split_vertical = split) ################################################### ### code chunk number 106: ocmosaicnull ################################################### split <- c(TRUE, TRUE, TRUE, FALSE) mosaic(tab, expected = ~ survival + operation * xray * stage, split_vertical = split) ################################################### ### code chunk number 107: oc7 ################################################### mosaic(tab, expected = ~ (survival + operation * xray) * stage, split_vertical = split) ################################################### ### code chunk number 108: ocmosaicstage ################################################### mosaic(tab, expected = ~ (survival + operation * xray) * stage, split_vertical = split) vcd/tests/0000755000175100001440000000000012212345475012213 5ustar hornikusersvcd/tests/demos.R0000755000175100001440000000015011150520606013433 0ustar hornikuserslibrary(vcd) demo(discrete) demo(twoway) demo(mosaic) demo(mondrian) demo(strucplot) demo(hullternary) vcd/NAMESPACE0000644000175100001440000001160212547002536012267 0ustar hornikusersimport(MASS) import(grid) import(stats) import(grDevices) import(colorspace) importFrom("graphics", "pairs", "par") importFrom("utils","head","str","tail") importFrom("lmtest","coeftest","coeftest.default") export( ## generic functions "agreementplot", "assoc", "cd_plot", "cotabplot", "distplot", "doubledecker", "fourfold", "goodfit", "mosaic", "oddsratio", "rootogram", "sieve", "spine", "tile", "structable", "loddsratio", ## spacings "spacing_conditional", "spacing_equal", "spacing_dimequal", "spacing_increase", "spacing_highlighting", ## labelings "labeling_lboxed", "labeling_border", "labeling_cboxed", "labeling_left", "labeling_cells", "labeling_conditional", "labeling_list", "labeling_doubledecker", "labeling_values", "labeling_residuals", ## legends "legend_resbased", "legend_fixed", # shadings "shading_binary", "shading_hcl", "shading_hsv", "shading_max", "shading_Friendly", "shading_Friendly2", "shading_diagonal", "shading_Marimekko", "shading_sieve", "hcl2hex", # core functions "struc_mosaic", "struc_assoc", "struc_sieve", ## panel functions "pairs_barplot", "pairs_text", "pairs_diagonal_text", "pairs_diagonal_mosaic", "pairs_strucplot", "pairs_mosaic", "pairs_assoc", "pairs_sieve", "cotab_mosaic", "cotab_assoc", "cotab_sieve", "cotab_loddsratio", "cotab_agreementplot", "cotab_fourfold", "cotab_coindep", ## `normal' functions "Kappa", "assocstats", "table2d_summary", "co_table", "coindep_test", "grid_barplot", "hls", "is.structable", "independence_table", "mar_table", "Ord_estimate", "Ord_plot", "strucplot", "ternaryplot", "binreg_plot", "mplot", "grid_legend", "grid_abline", "woolf_test") S3method("[", "structable") S3method("[[", "structable") S3method("[<-", "structable") S3method("[[<-", "structable") ## We cannot do the following: ## S3method("rbind", "structable") ## S3method("cbind", "structable") ## Instead, we currently have to use: export("rbind.structable") export("cbind.structable") S3method("str", "structable") S3method("is.na", "structable") S3method("length", "structable") S3method("as.table", "structable") S3method("as.matrix", "structable") S3method("as.vector", "structable") S3method("dim", "structable") S3method("t", "structable") S3method("dimnames", "structable") S3method("agreementplot", "default") S3method("agreementplot", "formula") S3method("assoc", "default") S3method("assoc", "formula") S3method("assoc", "loglm") S3method("cd_plot", "default") S3method("cd_plot", "formula") S3method("cotabplot", "default") S3method("cotabplot", "formula") S3method("doubledecker", "default") S3method("doubledecker", "formula") S3method("mosaic", "default") S3method("mosaic", "formula") S3method("mosaic", "loglm") S3method("tile", "default") S3method("tile", "formula") S3method("rootogram", "default") S3method("rootogram", "goodfit") S3method("sieve", "default") S3method("sieve", "formula") S3method("sieve", "loglm") S3method("structable", "default") S3method("structable", "formula") S3method("spine", "default") S3method("spine", "formula") S3method("pairs", "table") S3method("pairs", "structable") S3method("fitted", "goodfit") S3method("fitted", "coindep_test") S3method("residuals", "goodfit") S3method("predict", "goodfit") S3method("confint", "Kappa") #S3method("confint", "oddsratio") S3method("plot", "goodfit") #S3method("plot", "oddsratio") S3method("plot", "loglm") S3method("plot", "structable") S3method("print", "Kappa") S3method("print", "summary.Kappa") S3method("print", "goodfit") #S3method("print", "oddsratio") #S3method("print", "summary.oddsratio") S3method("print", "assocstats") S3method("print", "summary.assocstats") S3method("print", "table2d_summary") S3method("print", "structable") S3method("summary", "Kappa") S3method("summary", "assocstats") S3method("summary", "goodfit") #S3method("summary", "oddsratio") # logoddsratio related methods S3method("loddsratio", "default") S3method("loddsratio", "formula") S3method("coef", "loddsratio") S3method("confint", "loddsratio") S3method("dim", "loddsratio") S3method("dimnames", "loddsratio") S3method("print", "loddsratio") S3method("plot", "loddsratio") S3method("summary", "loddsratio") S3method("vcov", "loddsratio") S3method("as.matrix", "loddsratio") S3method("as.array", "loddsratio") S3method("as.data.frame", "loddsratio") S3method("aperm", "loddsratio") S3method("t", "loddsratio") S3method("image", "loddsratio") S3method("tile", "loddsratio") vcd/demo/0000755000175100001440000000000012367374473012010 5ustar hornikusersvcd/demo/twoway.R0000644000175100001440000001521212475147055013460 0ustar hornikusers ##################### ## Fourfold tables ## ##################### ### Berkeley Admission Data ### ############################### data(UCBAdmissions) ## unstratified ### no margin is standardized x <- margin.table(UCBAdmissions, 2:1) fourfold(x, std = "i", extended = FALSE) ### std. for gender fourfold(x, margin = 1, extended = FALSE) ### std. for both fourfold(x, extended = FALSE) ## stratified fourfold(UCBAdmissions, extended = FALSE) fourfold(UCBAdmissions) ## extended plots ## using cotabplot cotabplot(UCBAdmissions, panel = function(x, condlevels, ...) fourfold(co_table(x, names(condlevels))[[paste(condlevels, collapse = ".")]], newpage = F, return_grob = FALSE, ...) ) ### Coal Miners Lung Data ### ############################# data(CoalMiners) ## Fourfold display, both margins equated fourfold(CoalMiners, mfcol = c(3,3)) ## Log Odds Ratio Plot data(CoalMiners, package = "vcd") lor_CM <- loddsratio(CoalMiners) plot(lor_CM) lor_CM_df <- as.data.frame(lor_CM) # fit linear models using WLS age <- seq(20, 60, by = 5) lmod <- lm(LOR ~ age, weights = 1 / ASE^2, data = lor_CM_df) grid.lines(age, fitted(lmod), gp = gpar(col = "blue")) qmod <- lm(LOR ~ poly(age, 2), weights = 1 / ASE^2, data = lor_CM_df) grid.lines(age, fitted(qmod), gp = gpar(col = "red")) ## Fourfold display, strata equated fourfold(CoalMiners, std = "ind.max", mfcol = c(3,3)) #################### ## Sieve Diagrams ## #################### ### Hair Eye Color ### ###################### data(HairEyeColor) ## aggregate over `sex': (tab <- margin.table(HairEyeColor, 1:2)) ## plot expected values: sieve(t(tab), sievetype = "expected", shade = TRUE) ## plot sieve diagram: sieve(t(tab), shade = TRUE) ### Visual Acuity ### ##################### data(VisualAcuity) attach(VisualAcuity) sieve(Freq ~ right + left, data = VisualAcuity, subset = gender == "female", main = "Unaided distant vision data", labeling_args = list(set_varnames = c(left = "Left Eye Grade", right = "Right Eye Grade")), shade = TRUE ) detach(VisualAcuity) ### Berkeley Admission ### ########################## ## -> Larger tables: e.g., Cross factors ### Cross Gender and Admission data(UCBAdmissions) (tab <- xtabs(Freq ~ Dept + I(Gender : Admit), data = UCBAdmissions)) sieve(tab, labeling_args = list(set_varnames = c("I(Gender:Admit)" = "Gender:Admission", Dept = "Department")), main = "Berkeley Admissions Data", shade = TRUE ) ## or use extended sieve plots: sieve(UCBAdmissions, shade = TRUE) ###################### ## Association Plot ## ###################### ### Hair Eye Color ### ###################### data(HairEyeColor) assoc(margin.table(HairEyeColor, 1:2), labeling_args = list(set_varnames = c(Hair = "Hair Color", Eye = "Eye Color")), main = "Association Plot") #################### ## Agreement Plot ## #################### ### Sexual Fun ### ################## data(SexualFun) ## Kappa statistics Kappa(SexualFun) ## Agreement Chart agreementplot(t(SexualFun), weights = 1) ## Partial Agreement Chart and B-Statistics (agreementplot(t(SexualFun), xlab = "Husband's Rating", ylab = "Wife's Rating", main = "Husband's and Wife's Sexual Fun") ) ### MS Diagnosis data ### ######################### data(MSPatients) ## use e.g., X11(width = 12), or expand graphics device agreementplot(t(MSPatients[,,1]), main = "Winnipeg Patients") agreementplot(t(MSPatients[,,2]), main = "New Orleans Patients") ################## ## Ternary Plot ## ################## ### sample data ### ################### (x <- rbind(c(A=10,B=10,C=80), c(40,30,30), c(20,60,20) ) ) ternaryplot(x, cex = 2, col = c("black", "blue", "red"), coordinates = TRUE ) ### Arthritis Treatment Data ### ################################ data(Arthritis) ## Build table by crossing Treatment and Sex (tab <- as.table(xtabs(~ I(Sex:Treatment) + Improved, data = Arthritis))) ## Mark groups col <- c("red", "red", "blue", "blue") pch <- c(1, 19, 1, 19) ## plot ternaryplot( tab, col = col, pch = pch, cex = 2, bg = "lightgray", grid_color = "white", labels_color = "white", main = "Arthritits Treatment Data" ) ## legend grid_legend(0.8, 0.7, pch, col, rownames(tab), title = "GROUP") ### Baseball Hitters Data ### ############################# data(Hitters) attach(Hitters) colors <- c("black","red","green","blue","red","black","blue") pch <- substr(levels(Positions), 1, 1) ternaryplot( Hitters[,2:4], pch = as.character(Positions), col = colors[as.numeric(Positions)], main = "Baseball Hitters Data" ) grid_legend(0.8, 0.9, pch, colors, levels(Positions), title = "POSITION(S)") detach(Hitters) ### Lifeboats on the Titanic ### ################################ data(Lifeboats) attach(Lifeboats) ternaryplot( Lifeboats[,4:6], pch = ifelse(side=="Port", 1, 19), col = ifelse(side=="Port", "red", "blue"), id = ifelse(men/total > 0.1, as.character(boat), NA), dimnames_position = "edge", dimnames = c("Men of Crew", "Men passengers", "Women and Children"), main = "Lifeboats on the Titanic" ) grid_legend(0.8, 0.9, c(1, 19), c("red", "blue"), c("Port", "Starboard"), title = "SIDE") ## Load against time for Port/Starboard boats plot(launch, total, pch = ifelse(side == "Port", 1, 19), col = ifelse(side == "Port", "red", "darkblue"), xlab = "Launch Time", ylab = "Total loaded", main = "Lifeboats on the Titanic" ) legend(as.POSIXct("1912-04-15 01:48:00"), 70, legend = c("SIDE","Port","Starboard"), pch = c(NA, 1, 19), col = c(NA, "red", "darkblue") ) text(as.POSIXct(launch), total, labels = as.character(boat), pos = 3, offset = 0.3 ) abline(lm(total ~ as.POSIXct(launch), subset = side == "Port"), col = "red") abline(lm(total ~ as.POSIXct(launch), subset = side == "Starboard"), col = "darkblue") detach(Lifeboats) vcd/demo/hullternary.R0000755000175100001440000000301211566471034014472 0ustar hornikusers###################################################### #### ternary plot demo #### Task: plotting data point hulls in a ternary plot #### data provided by Manuel Dominguez-Rodrigo ###################################################### library(vcd) ## data humans=matrix(c(18,19,17,21,7,9,8,62,70,53,69,81,73,71,20,10,30,10,12,18,19), ncol=3) colnames(humans)=c("young", "adult", "old") lions=matrix(c(41,59,62,49,45,21,12,5,11,13,38,29,33,40,42), ncol=3) colnames(lions)=c("young", "adult", "old") site=matrix(c(9,12,15,11,70,62,69,68,21,26,16,21), ncol=3) colnames(site)=c("young", "adult", "old") humans=matrix(c(18,19,17,21,7,9,8,62,70,53,69,81,73,71,20,10,30,10,12,18,19), ncol=3) ## regular ternary plot data = rbind(humans, lions, site) count = c(nrow(humans), nrow(lions), nrow(site)) rownames(data) = rep(c("humans", "lions", "site"), count) cols = rep(c("red", "green", "blue"), count) ternaryplot(data, col = cols) ## now try to draw hull prop2xy <- function(x) { x <- as.matrix(x) x <- x / rowSums(x) xp <- x[,2] + x[,3] / 2 yp <- x[,3] * sqrt(3) / 2 cbind(x = xp, y = yp) } hullpoints <- function(x) { ind <- chull(x) ind <- c(ind, ind[1]) x[ind,] } drawhull <- function(data, color) { hp <- hullpoints(prop2xy(data)) grid.lines(hp[,"x"], hp[,"y"], gp = gpar(col = color)) } ## setup plot region without data points ternaryplot(data, col = NA, pop = FALSE) ## grab plot viewport downViewport("plot") ## now plot hulls drawhull(humans, "blue") drawhull(site, "red") drawhull(lions, "green") vcd/demo/mosaic.R0000755000175100001440000000651711566471034013411 0ustar hornikusers##################### ## Mosaic Displays ## ##################### ######################### ## Hair Eye Color Data ## ######################### data(HairEyeColor) ## Basic Mosaic Display ## HairEye <- margin.table(HairEyeColor, c(1,2)) mosaic(HairEye, main = "Basic Mosaic Display of Hair Eye Color data") ## Hair Mosaic Display with Pearson residuals ## Hair <- margin.table(HairEyeColor,1) Hair mHair <- as.table(rep(mean(margin.table(HairEyeColor, 1)), 4)) names(mHair) <- names(Hair) mHair ## Pearson residuals from Equiprobability model ## resid <- (Hair - mHair) / sqrt(mHair) resid ## First Step in a Mosaic Display ## mosaic(Hair, residuals = resid, main = "Hair Color Proportions") ## Hair Eye Mosais Display with Pearson residuals ## mosaic(HairEye, main = " Hair Eye Color with Pearson residuals") ## Show Pearson Residuals ## (HairEye - loglin(HairEye, c(1, 2), fit = TRUE)$fit) / sqrt(loglin(HairEye, c(1, 2), fit = TRUE)$fit) ################### ## UKSoccer Data ## ################### data(UKSoccer) ## UKSoccer Mosaic Display ## mosaic(UKSoccer, main = "UK Soccer Scores") ############################### ## Repeat Victimization Data ## ############################### data(RepVict) ## mosaic(RepVict[-c(4, 7), -c(4, 7)], main = "Repeat Victimization Data") ################## ## 3-Way Tables ## ################## ## Hair Eye Sex Mosais Display with Pearson residuals ## mosaic(HairEyeColor, main = "Hair Eye Color Sex" ) mosaic(HairEyeColor, expected = ~ Hair * Eye + Sex, main = "Model: (Hair Eye) (Sex)" ) mosaic(HairEyeColor, expected = ~ Hair * Sex + Eye*Sex, main = "Model: (Hair Sex) (Eye Sex)") #################### ## Premarital Sex ## #################### data(PreSex) ## Mosaic display for Gender and Premarital Sexual Expirience ## ## (Gender Pre) ## mosaic(margin.table(PreSex, c(3, 4)), legend = FALSE, main = "Gender and Premarital Sex") ## (Gender Pre)(Extra) ## mosaic(margin.table(PreSex,c(2,3,4)), legend = FALSE, expected = ~ Gender * PremaritalSex + ExtramaritalSex , main = "(PreMaritalSex Gender) (Sex)") ## (Gender Pre Extra)(Marital) ## mosaic(PreSex, expected = ~ Gender * PremaritalSex * ExtramaritalSex + MaritalStatus, legend = FALSE, main = "(PreMarital ExtraMarital) (MaritalStatus)") ## (GPE)(PEM) ## mosaic(PreSex, expected = ~ Gender * PremaritalSex * ExtramaritalSex + MaritalStatus * PremaritalSex * ExtramaritalSex, legend = FALSE, main = "(G P E) (P E M)") ############################ ## Employment Status Data ## ############################ data(Employment) ## Employment Status ## # mosaic(Employment, # expected = ~ LayoffCause * EmploymentLength + EmploymentStatus, # main = "(Layoff Employment) + (EmployStatus)") # mosaic(Employment, # expected = ~ LayoffCause * EmploymentLength + # LayoffCause * EmploymentStatus, # main = "(Layoff EmpL) (Layoff EmplS)") # ## Closure ## # mosaic(Employment[,,1], main = "Layoff : Closure") # ## Replaced ## # mosaic(Employment[,,2], main = "Layoff : Replaced") ##################### ## Mosaic Matrices ## ##################### data(UCBAdmissions) pairs(PreSex) pairs(UCBAdmissions) pairs(UCBAdmissions, type = "conditional") pairs(UCBAdmissions, type = "pairwise", gp = shading_max) vcd/demo/mondrian.R0000755000175100001440000000115011566471034013731 0ustar hornikuserslibrary(vcd) ## shape foo1 <- c(3, 7, 3, 1.5) foo2 <- c(2, 6.5, 1.5) foo <- outer(foo1/sum(foo1), foo2/sum(foo2), "*") ## color mondrian <- rep("#EAE6E3", 12) mondrian[1] <- "#DE1024" mondrian[3] <- "#FFD83B" mondrian[12] <- "#032349" ## plot ## best visualized with resized display, e.g. using: ## get(getOption("device"))(width = 4.9, height = 7.5) grid.newpage() grid.rect(gp = gpar(fill = 1)) mondrianMosaic <- function(x, fill) mosaic(x, gp = gpar(col = rep(0, length(fill)), fill = fill), legend = FALSE, margins = 0, newpage = FALSE, keep_aspect_ratio = FALSE) mondrianMosaic(foo, mondrian) vcd/demo/strucplot.R0000755000175100001440000000413111566471034014163 0ustar hornikusersdata("Titanic") data("UCBAdmissions") data("HairEyeColor") data("PreSex") mosaic(Titanic) mosaic(Titanic, shade = TRUE) mosaic(~ Sex + Class, data = Titanic, shade = TRUE) mosaic(~ Sex + Class + Survived, data = Titanic, shade = TRUE) mosaic(~ PremaritalSex + ExtramaritalSex | MaritalStatus + Gender, data = PreSex) mosaic(~ PremaritalSex + ExtramaritalSex | MaritalStatus + Gender, data = PreSex, labeling = labeling_conditional(abbreviate_varnames = TRUE)) mosaic(Titanic, spacing = spacing_increase()) mosaic(Titanic, spacing = spacing_equal()) mosaic(Titanic, labeling = labeling_border()) mosaic(Titanic, labeling = labeling_cells()) mosaic(Titanic, labeling = labeling_cells(abbreviate_labels = TRUE)) mosaic(Titanic, labeling = labeling_cells(abbreviate_varnames = TRUE)) mosaic(Titanic, labeling = labeling_cells(abbreviate_varnames = TRUE, abbreviate_labels = TRUE)) mosaic(Titanic, labeling = labeling_border(abbreviate = TRUE)) mosaic(Titanic, labeling = labeling_border(abbreviate = c(Survived = TRUE))) mosaic(Titanic, labeling = labeling_border(rot_labels = c(bottom = 45))) mosaic(Titanic, labeling = labeling_border(tl_labels = TRUE)) mosaic(Titanic, labeling = labeling_border(tl_labels = TRUE, tl_varnames = FALSE)) mosaic(Titanic, labeling = labeling_border(tl_labels = TRUE, tl_varnames = c(TRUE,TRUE,FALSE,FALSE), boxes = TRUE)) mosaic(Titanic, labeling = labeling_cboxed()) mosaic(Titanic, labeling = labeling_lboxed()) mosaic(Titanic, labeling = labeling_left()) mosaic(Titanic, labeling = labeling_list(), mar = c(2,2,4,2)) mosaic(Titanic, labeling = labeling_border(rep = FALSE)) mosaic(Titanic, labeling = labeling_border(labbl_varnames = c(TRUE,TRUE,FALSE,FALSE))) mosaic(~ Gender + Admit | Dept, data = UCBAdmissions, labeling = labeling_conditional(labels_varnames = TRUE, varnames = FALSE), keep_aspect_ratio = FALSE, split_vertical = c(Dept = TRUE)) doubledecker(Titanic) assoc(Hair ~ Eye, data = HairEyeColor) assoc(Hair ~ Eye, data = HairEyeColor, compress = FALSE) assoc(HairEyeColor, labeling = labeling_lboxed()) pairs(Titanic, shade = TRUE) pairs(Titanic, panel_upper = pairs_assoc, shade = TRUE) vcd/demo/hcl.R0000755000175100001440000000467211566471034012704 0ustar hornikusersif(require("tcltk")) { hue <- tclVar("hue") chroma <- tclVar("chroma") luminance <- tclVar("luminance") fixup <- tclVar("fixup") hue <- tclVar(230) hue.sav <- 230 chroma <- tclVar(55) chroma.sav <- 55 luminance <- tclVar(75) luminance.sav <- 75 fixup <- tclVar(FALSE) replot <- function(...) { hue.sav <- my.h <- as.numeric(tclvalue(hue)) chroma.sav <- my.c <- as.numeric(tclvalue(chroma)) luminance.sav <- my.l <- as.numeric(tclvalue(luminance)) my.fixup <- as.logical(as.numeric(tclvalue(fixup))) barplot(1, col = hcl2hex(my.h, my.c, my.l, fixup = my.fixup), axes = FALSE) } replot.maybe <- function(...) { if(!((as.numeric(tclvalue(hue)) == hue.sav) && (as.numeric(tclvalue(chroma)) == chroma.sav) && (as.numeric(tclvalue(luminance)) == luminance.sav))) replot() } base <- tktoplevel() tkwm.title(base, "HCL Colors") spec.frm <- tkframe(base, borderwidth = 2) hue.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) chroma.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) luminance.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) fixup.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) tkpack(tklabel(hue.frm, text = "Hue")) tkpack(tkscale(hue.frm, command = replot.maybe, from = 0, to = 360, showvalue = TRUE, variable = hue, resolution = 1, orient = "horiz")) tkpack(tklabel(chroma.frm, text = "Chroma")) tkpack(tkscale(chroma.frm, command = replot.maybe, from = 0, to = 100, showvalue = TRUE, variable = chroma, resolution = 5, orient = "horiz")) tkpack(tklabel(luminance.frm, text = "Luminance")) tkpack(tkscale(luminance.frm, command = replot.maybe, from = 0, to = 100, showvalue = TRUE, variable = luminance, resolution = 5, orient = "horiz")) tkpack(tklabel(fixup.frm, text="Fixup")) for (i in c("TRUE", "FALSE") ) { tmp <- tkradiobutton(fixup.frm, command = replot, text = i, value = as.logical(i), variable = fixup) tkpack(tmp, anchor="w") } tkpack(hue.frm, chroma.frm, luminance.frm, fixup.frm, fill="x") ## Bottom frame on base: q.but <- tkbutton(base, text = "Quit", command = function() tkdestroy(base)) tkpack(spec.frm, q.but) replot() } vcd/demo/discrete.R0000755000175100001440000001357211566471034013737 0ustar hornikusers ################################################# ## Fitting and Graphing Discrete Distributions ## ################################################# data(HorseKicks) barplot(HorseKicks, col = 2, xlab = "Number of Deaths", ylab = "Number of Corps-Years", main = "Deaths by Horse Kicks") data(Federalist) barplot(Federalist, col = 2, xlab = "Occurrences of 'may'", ylab = "Number of Blocks of Text", main = "'may' in Federalist papers") data(WomenQueue) barplot(WomenQueue, col = 2, xlab = "Number of women", ylab = "Number of queues", main = "Women in queues of length 10") data(WeldonDice) barplot(WeldonDice, names = c(names(WeldonDice)[-11], "10+"), col = 2, xlab = "Number of 5s and 6s", ylab = "Frequency", main = "Weldon's dice data") data(Butterfly) barplot(Butterfly, col = 2, xlab = "Number of individuals", ylab = "Number of Species", main = "Butterfly species im Malaya") ############################ ## Binomial distributions ## ############################ par(mfrow = c(1,2)) barplot(dbinom(0:10, p = 0.15, size = 10), names = 0:10, col = grey(0.7), main = "p = 0.15", ylim = c(0,0.35)) barplot(dbinom(0:10, p = 0.35, size = 10), names = 0:10, col = grey(0.7), main = "p = 0.35", ylim = c(0,0.35)) par(mfrow = c(1,1)) mtext("Binomial distributions", line = 2, cex = 1.5) plot(0:10, dbinom(0:10, p = 0.15, size = 10), type = "b", ylab = "Density", ylim = c(0, 0.4), main = "Binomial distributions, N = 10", pch = 19) lines(0:10, dbinom(0:10, p = 0.35, size = 10), type = "b", col = 2, pch = 19) lines(0:10, dbinom(0:10, p = 0.55, size = 10), type = "b", col = 4, pch = 19) lines(0:10, dbinom(0:10, p = 0.75, size = 10), type = "b", col = 3, pch = 19) legend(3, 0.4, c("p", "0.15", "0.35", "0.55", "0.75"), lty = rep(1,5), col = c(0,1,2,4,3), bty = "n") ########################### ## Poisson distributions ## ########################### par(mfrow = c(1,2)) dummy <- barplot(dpois(0:12, 2), names = 0:12, col = grey(0.7), ylim = c(0,0.3), main = expression(lambda == 2)) abline(v = dummy[3], col = 2) diff <- (dummy[3] - dummy[2]) * sqrt(2)/2 lines(c(dummy[3] - diff, dummy[3] + diff), c(0.3, 0.3), col = 2) dummy <- barplot(dpois(0:12, 5), names = 0:12, col = grey(0.7), ylim = c(0,0.3), main = expression(lambda == 5)) abline(v = dummy[6], col = 2) diff <- (dummy[6] - dummy[5]) * sqrt(5)/2 lines(c(dummy[6] - diff, dummy[6] + diff), c(0.3, 0.3), col = 2) par(mfrow = c(1,1)) mtext("Poisson distributions", line = 2, cex = 1.5) ##################################### ## Negative binomial distributions ## ##################################### nbplot <- function(p = 0.2, size = 2, ylim = c(0, 0.2)) { plot(0:20, dnbinom(0:20, p = p, size = size), type = "h", col = grey(0.7), xlab = "Number of failures (k)", ylab = "Density", ylim = ylim, yaxs = "i", bty = "L") nb.mean <- size * (1-p)/p nb.sd <- sqrt(nb.mean/p) abline(v = nb.mean, col = 2) lines(nb.mean + c(-nb.sd, nb.sd), c(0.01, 0.01), col = 2) legend(14, 0.2, c(paste("p = ", p), paste("n = ", size)), bty = "n") } par(mfrow = c(3,2)) nbplot() nbplot(size = 4) nbplot(p = 0.3) nbplot(p = 0.3, size = 4) nbplot(p = 0.4, size = 2) nbplot(p = 0.4, size = 4) par(mfrow = c(1,1)) mtext("Negative binomial distributions for the number of trials to observe n = 2 or n = 4 successes", line = 3) ##################### ## Goodness of fit ## ##################### p <- weighted.mean(as.numeric(names(HorseKicks)), HorseKicks) p.hat <- dpois(0:4, p) expected <- sum(HorseKicks) * p.hat chi2 <- sum((HorseKicks - expected)^2/expected) pchisq(chi2, df = 3, lower = FALSE) ## or: HK.fit <- goodfit(HorseKicks) summary(HK.fit) ## Are the dice fair? p.hyp <- 1/3 p.hat <- dbinom(0:12, prob = p.hyp, size = 12) expected <- sum(WeldonDice) * p.hat expected <- c(expected[1:10], sum(expected[11:13])) chi2 <- sum((WeldonDice - expected)^2/expected) G2 <- 2*sum(WeldonDice*log(WeldonDice/expected)) pchisq(chi2, df = 10, lower = FALSE) ## Are the data from a binomial distribution? p <- weighted.mean(as.numeric(names(WeldonDice))/12, WeldonDice) p.hat <- dbinom(0:12, prob = p, size = 12) expected <- sum(WeldonDice) * p.hat expected <- c(expected[1:10], sum(expected[11:13])) chi2 <- sum((WeldonDice - expected)^2/expected) G2 <- 2*sum(WeldonDice*log(WeldonDice/expected)) pchisq(chi2, df = 9, lower = FALSE) ## or: WD.fit1 <- goodfit(WeldonDice, type = "binomial", par = list(prob = 1/3, size = 12)) WD.fit1$fitted[11] <- sum(predict(WD.fit1, newcount = 10:12)) WD.fit2 <- goodfit(WeldonDice, type = "binomial", par = list(size = 12), method = "MinChisq") summary(WD.fit1) summary(WD.fit2) F.fit1 <- goodfit(Federalist) F.fit2 <- goodfit(Federalist, type = "nbinomial") summary(F.fit1) par(mfrow = c(2,2)) plot(F.fit1, scale = "raw", type = "standing") plot(F.fit1, type = "standing") plot(F.fit1) plot(F.fit1, type = "deviation") par(mfrow = c(1,1)) plot(F.fit2, type = "deviation") summary(F.fit2) data(Saxony) S.fit <- goodfit(Saxony, type = "binomial", par = list(size = 12)) summary(S.fit) plot(S.fit) ############### ## Ord plots ## ############### par(mfrow = c(2,2)) Ord_plot(HorseKicks, main = "Death by horse kicks") Ord_plot(Federalist, main = "Instances of 'may' in Federalist papers") Ord_plot(Butterfly, main = "Butterfly species collected in Malaya") Ord_plot(WomenQueue, main = "Women in queues of length 10") par(mfrow = c(1,1)) ############### ## Distplots ## ############### distplot(HorseKicks, type = "poisson") distplot(HorseKicks, type = "poisson", lambda = 0.61) distplot(Federalist, type = "poisson") distplot(Federalist, type = "nbinomial") distplot(Saxony, type = "binomial", size = 12) vcd/demo/00Index0000755000175100001440000000062611566471034013140 0ustar hornikusersdiscrete Fitting and Graphing Discrete Distributions twoway 2-Way Contingency Tables mosaic Mosaic displays hcl Tcl/Tk-Demo for `hcl' colors hsv Tcl/Tk-Demo for `hsv' colors hls Tcl/Tk-Demo for `hls' colors strucplot Demo for new strucplot suite (assoc, mosaic, doubledeckerplot) mondrian Demo for (re)producing modern art using mosaic() hullternary Demo for adding data point hulls to a ternary plot vcd/demo/hsv.R0000755000175100001440000000373611566471034012736 0ustar hornikusersif(require("tcltk")) { hue <- tclVar("hue") saturation <- tclVar("saturation") value <- tclVar("value") hue <- tclVar(0) hue.sav <- 0 saturation <- tclVar(1) saturation.sav <- 1 value <- tclVar(1) value.sav <- 1 replot <- function(...) { hue.sav <- my.h <- as.numeric(tclvalue(hue)) saturation.sav <- my.s <- as.numeric(tclvalue(saturation)) value.sav <- my.v <- as.numeric(tclvalue(value)) barplot(1, col = hsv(my.h, my.s, my.v), axes = FALSE) } replot.maybe <- function(...) { if(!((as.numeric(tclvalue(hue)) == hue.sav) && (as.numeric(tclvalue(saturation)) == saturation.sav) && (as.numeric(tclvalue(value)) == value.sav))) replot() } base <- tktoplevel() tkwm.title(base, "HSV Colors") spec.frm <- tkframe(base, borderwidth = 2) hue.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) saturation.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) value.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) tkpack(tklabel(hue.frm, text = "Hue")) tkpack(tkscale(hue.frm, command = replot.maybe, from = 0, to = 1, showvalue = TRUE, variable = hue, resolution = 0.01, orient = "horiz")) tkpack(tklabel(saturation.frm, text = "Saturation")) tkpack(tkscale(saturation.frm, command = replot.maybe, from = 0, to = 1, showvalue = TRUE, variable = saturation, resolution = 0.01, orient = "horiz")) tkpack(tklabel(value.frm, text = "Value")) tkpack(tkscale(value.frm, command = replot.maybe, from = 0, to = 1, showvalue = TRUE, variable = value, resolution = 0.01, orient = "horiz")) tkpack(hue.frm, saturation.frm, value.frm, fill="x") ## Bottom frame on base: q.but <- tkbutton(base, text = "Quit", command = function() tkdestroy(base)) tkpack(spec.frm, q.but) replot() } vcd/demo/hls.R0000755000175100001440000000403211566471034012712 0ustar hornikusersif(require("tcltk")) { hue <- tclVar("hue") luminance <- tclVar("luminance") saturation <- tclVar("saturation") hue <- tclVar(0) hue.sav <- 0 luminance <- tclVar(0.5) luminance.sav <- 0.5 saturation <- tclVar(1) saturation.sav <- 1 replot <- function(...) { hue.sav <- my.h <- as.numeric(tclvalue(hue)) saturation.sav <- my.s <- as.numeric(tclvalue(saturation)) luminance.sav <- my.l <- as.numeric(tclvalue(luminance)) barplot(1, col = hls(my.h, my.l, my.s), axes = FALSE) } replot.maybe <- function(...) { if(!((as.numeric(tclvalue(hue)) == hue.sav) && (as.numeric(tclvalue(saturation)) == saturation.sav) && (as.numeric(tclvalue(luminance)) == luminance.sav))) replot() } base <- tktoplevel() tkwm.title(base, "HLS Colors") spec.frm <- tkframe(base, borderwidth = 2) hue.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) saturation.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) luminance.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) tkpack(tklabel(hue.frm, text = "Hue")) tkpack(tkscale(hue.frm, command = replot.maybe, from = 0, to = 1, showvalue = TRUE, variable = hue, resolution = 0.01, orient = "horiz")) tkpack(tklabel(luminance.frm, text = "Luminance")) tkpack(tkscale(luminance.frm, command = replot.maybe, from = 0, to = 1, showvalue = TRUE, variable = luminance, resolution = 0.01, orient = "horiz")) tkpack(tklabel(saturation.frm, text = "Saturation")) tkpack(tkscale(saturation.frm, command = replot.maybe, from = 0, to = 1, showvalue = TRUE, variable = saturation, resolution = 0.01, orient = "horiz")) tkpack(hue.frm, luminance.frm, saturation.frm, fill="x") ## Bottom frame on base: q.but <- tkbutton(base, text = "Quit", command = function() tkdestroy(base)) tkpack(spec.frm, q.but) replot() } vcd/data/0000755000175100001440000000000012367374476012000 5ustar hornikusersvcd/data/Lifeboats.rda0000755000175100001440000000113412547003156014362 0ustar hornikusersVMo@|B^B"B{Ԕ^r]GvrOf3"M+By;;v2L}0x#6#fMpeO 6 ZP݋ zS=E"^h?m_v*Wֻ.w+4;jvg: gD*a>˅ M"&dqk8iL9 AdѪZExһ<4ljQ+88dLp^$c}CFb",NJ>q%NV:1觽C9J VhzOE7Zm"ְc;5-82=&L>29f2M ¥Rs%JļAraƥHȱ/^[5멁._#.xzXw@.gW'TK` Ȟ=ai}[#?[>dGWOJllVaHuاr,Ml.oMtJemq#f%4_~ x8LF˟rXfr/J~7?|"5 vcd/data/Suicide.rda0000755000175100001440000000362312547003156014044 0ustar hornikusersoTe3ZM]`fs^`Hi;R)2mmh0@⒥K.Yt .]S}4& |so挎?m'yW)x}:8=>=Qs-(ޚGgE}/~?,_:@51/He7.2>so.J̿W?%5wG/Խ%s2>/?ό-Z/%f%?m_v_7]!=ȯ֊˗d.uI#JyNgz彻.HݢsDޓ)%9n$K_2~XsV#UuT~g]V5y;\LH^'$H}K? {$q#:Կ#㧥Dw~uy\?#Tq}ݾqv=u-2^_vyt>9^>zG\@scGx˨d:u{G מt:ߥꩣ|P@!r~.Sّ<d=USϩIާ&9)}}z}ZY׋^tr)/~rQ8'^KR<. W^ϥ\Nu;6 ).zc~}ț]x\q?s&yZ7n[~*Yzܸ>l%Ru9!}y6^֟_v)d"y;ω]zSOc5wxgVy_݊؞V*b{[1tLR}f4z{.fZ1Y?nLm^&k fC>z^=s[E_QS5E]ҟ3^o1=ߘSy]h\~ϹsH+O-jsIUoχtpt(2߯7a2RR~;y՝|NNu'IsAwם۪w|mXOPq)FT4J~Z`Z"kJZ9X1` ƀ1` ƀ1c#0} c#4Fh1Bc#4Fh fP#2Fd1"cDƈ#6Fl1+J)6Fl1c$H#1Fb1c$H#5Fj1RcH#3Ff12cdȌ#3F_ 66C6#6c66S6IIIIIIIIIIIi 4@Hi - - - - - - - - - - -$-$-$-$-$-$-$-$-$-$-"-"-"-"-"-"-"-"-"-"-&-&-&-&-&-&-&-&-&-&-!-!-!-!-!-!-!-!-!-!-%-%-%-%-%-%-%-%-%-%-#-#-#-#-#-#-#-#-#.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t 蒀. 蒀. 蒀. 蒠풵MjCCoe,6vcd/data/Arthritis.rda0000755000175100001440000000141011566471043014424 0ustar hornikusersՖYS@3 L"耂<!( sS!Ńeǜd:t:wXkݖeٖb?%gW5k~˶[;\ʼnvp10e  x2#  wkpiiY`R}J4sṕyp \ׁK<\<Gf@?j೬XdQ_&~ox.w uÁ ]'I}G?IFv,KjW$n&k񎹴ǖ7f!G?u#Zy6iD-t#ۗyե= XLZɸfJ3^^^=^Z֐fT4~r畖&jR#PZBM3sCZ#iCҲ\f)]W_8cXߣY\auL R|ag(>{xx G}os'{'$sŚZ=ޗ1ݾns篤 q4.tFׇ_n;n$ӵ\MVl$M}YI~XjkCײ{#n#YHvdϑ| R߄eBd˜(Se|)dRL..........>>>>>>>>>>!!!!!!!!!!ECѡPt(:EGDGDGDGDG$ vcd/data/Baseball.rda0000755000175100001440000003602311566471043014170 0ustar hornikusers} \Gun{{EH-oYmlϢZ,Y#K2igZbD00l!@!! Bd@IB%!Uԩf}7wusUTඣicLl|dℊYLxiX,Z>}[RR\zp򘯌 JUr2>m-CiډXYeKJr,(ONWiӽLʧ}U:+f889J41UՓZԇ'gL fEObb2Q !gcAm/ +S2#%?r ,Jq?X@k ^X)MSm+=yREj?9t6PK9[ kikC+ҳ\΢3*2C'=RTLUf-8Vv898S>1"  NۇP 78k!i;qb մJuҏV6J۽pg`PPeY(vdv-RR_%ZU3T\d7]Z2 ]AځGlޕq/ˣZ1kZzjZ*ӗGƞa9Zvw Fi|r]M z\QgT PIx8g1C $XfkfemzzҽXIJZ{j1mcvo`r{CC}w}}EB UfPyb2hwZL Qno̾gҾ1}y1Z[ 7G5`ٳf$O-f^=&JsGʕiʹ|jكP Jry|t℟Gc-9?XtDP +"q*^c3)f<֡냪B9aHv`wX (aTLZ%9AȡSͯRg̊C oxUu3(f8:=PSV8Rm%J a%sD9UU WKghw|ӸP8:,"IǼ[8TswhΎzAhMqfOH6+ y≢4,潕JqL77T&Y}ձaiQ]YՇN|m՚'J۔:EfC#jiX=]E],p.)Rm¯#gu"U]Ъ|F~[ A1mM'S W9:$Bj C#E)jn+ǪЈw8YԼv)Z("n wdO6y_2\+̎_0!(ZM m@jxGj2n+-T4nܛԈJʀ8_W(Ѩ~WQB-y >VOAD& ƓqZv'Ξ -ROڒw-{BK>hB5>((R]}ȑ'/;Z6 o&kR^ đ``qo7-49x,(s˵~;ĦVPq0U+ԻX|K^.䣆! $^Y+yrM SȔgU-C h䱡,j8XUWngiXUS_FQ9O:m*^,#<݊c!C2!{Oﲻ2J xuFa7л"imOJ$08X%;䗔Oޣ$:)do񌗡b d)/Ǜ3^lT!(7JMWʄO(bٳ;(QZx*NH2N~q!@)wT?^=s =! u o۩e񾐇MdjȧXasYSjv3D'oTZ){ B`fWq2Eߒ V@AzE%V a$;K*XVNyx)2߅utƘ:*Q =]?utOׅttQIQTsJǨ.TWѝDۨO꟧OW7Aѵ]t]OPRGt}\*=ʋ3*?Nеܕ-?q_Kz!]kw_(;%]C<1V^BW;ѝt-#o|]t 5͡2/wsUKTz. t.=?Dwx=Q9*Mwt]m&r(ԍ31wkL't7L;5gtŷS+T^BYtu;z-(vGY#nNcq_LnG77:y24}LL?# 됙_q|'1,eR;/a~]'T_AtahĽKwr6tŮ H"s''ېcK(ft+]X6&C͏|1xb+f[D1lBNeHp,:y?O:=.ư=LSTn辍M_ K7=϶ONwL{^X8ىy{N 6 !ߠ-!/E0 !:#퉗~%$ՐaH 鮹.R` ?z<p)It>®C^BׇB5f8x0]D C\NWqpP=2=Y_y<Krn>Htz Frb`׾Gl!r|uy^,##K<ޫv~ 6ix ?8C̷K#L *~qDŽL@-yXt;̼>2. z1?O0lÆ 4쾁 fƁl.l<`BIWMZ1Q7 S2{N7x10|^yy{+7G{}iq:mx1sпk_0Y/: `H Ow2~LkȮCl>A4\?Gd2~, ȽKz~k"_ xks}&+0Vp #8gyÃ%nmn?q_, \jbp+V?-+2 cIp a^ }3G̴e4ZsXXɴ~1MMknb :~⶘ċ1 62[,fݔ\n#y >| A 7WWr;]Q]by ÷.1hf㧕̣5<[o1:Be;R-U[~{~ϰ0u ctX6s`nAC>z.C֕| ncܷs:.8'#b|y,>0>_x^sa ƹۯyc:pO6C 2-L̵iw- qd )c|mV.;a'070͌m|mlf:}ܷs \dKxۜaZmf~Ot@<Ƈ\ȼ:W?㸒) mofމ=lbz }73<g <9fZ/dCU_pzE<ȂU<`_Ϯ`zCΎ'7;㳘bc`ǔuJ~wGaC~'׻|A*Fuh n`]t.1/d?2}W̧qq[i4]cc pcX1n |c'?mh\Ug^x/wy+h1NO3/ \33e:]8r˙ &-c6sVnѵׅF^œBw1_633 g:Y*J*X`\x/bz-fdA~lb=]{%ШNm!Y{%rC,%uuኜ$ ׇhF~! Oʑ3Eϡ;_=5Gߣ$o _H_nL'9XB^Bo~$߭4GcR옱6 dx#YQrXuS )J&u3:@G맑M/bt,FٺkG%Gd@>r~w r1oW.w:\d*KMk46tlafӋig6{N~eH{\Df&'K>@c ː.D;1Q/%ŵӜ3N>|<|ͻ=&ksZM̐\& 7!{>"'#zs^_޷>ɷ;/&G MS GhcSdO։=}a:ɴz{G_2IrZ`3^A<#ߛu~ɞtۮ DžF%3n~2¸]}. #/0V\Ms9w4G\i7 b{Fo1 clHe7]ow37p8^f4/fhh$5^ F~|FgkROME )!Lͯ@/0]K#OH 'cw@Sفt'#cζ8B>"7zCW3#u$=M_Fnj]w/as!O`wc-h 9G -1lbdobxح#,/s(C]BGƞk}MbSca'@w,4ig5ټ6{BgF | 0Σ6]ě b!hـ̣,k{ϐo8:Y[g2'?Vp r78Yp(x>'ӭaj銘hŘC.ey{ae#QB5gXܞ9 ׍S\o/ 'Cm{6 1WX'.##ͺu`O`Os8Y(_G.Fż\mb8M3qV!?r' ߭^Q/řcd&ubVd K DW^ ggjW*C k8n^?bYi5| '_'Bq^&3@Xs?A.p k%~6~*1.N8_X~)ٞ'\Gdktg} ?ƍ;ZX.%Xo .غ۳3$s_wa7j_،Gy{FVƉ1trVFzzC;|bݎWNl v {8CGv"Ct`f|-'[^6h6% И \9wC}n-{3+F\}E{V9.5Pe š <؃6ۜ5.ş1 .ցAsWGQ==0:D|o~ ?:yKMn~6V-FlYp{} 76N$ayhi::yGCtcձ.- |繱93;ߐٵ܋ѯYcl|1/!q&6%Zď a7o^Y.O0 Ώw9[_? 'Sس:F[ Kı!q#9掾#s%>팳V>O8bNwo}IJcРTșC+ '/0-(~@Bgiho6.񓎮t;O:\cN|:{i}ʌ+v>cov2E1I#þ 'O8E>;b 7seW31|ם2=3ڝL[hyjÿɦo?p?|B|r5,gߊ8fN^LGGJĘ8?ipIU}^1b x~oد,ox''8lm.Ġxbnh ?\#@|= /֠qhsk+ |+)\EL7B_| a{yldu#^GYO9$+OX6x{mcW:;IIo#Lƚnz45uOg3L;\s{D?ts gLzM&gl7=fL:0[d=XslNsw6k6Fpmri[zKx C xKAφ,0ϔs\K+V3|Lw. l8=GmCz\*7_Do0g|6s}7,6c`5R8Z$"զ?ۀZ=2yl ܗTIInKq8=bCR?%e92zTOq3. JJuYX|N~ B>1v9Rǖo9jm峟da l#H 5{-L*i/xFScO~> N_I9^ʸ.75n,,bZIJ Ly?7z J?mZ-Ksl4^RދXiTx€_!_e\/"̒/"oVhz)tk{џ>. 3*Y=J ǾVfr^XEDbn+B9\TB#I39z%GĆ-9 (T[mxDn7 $7ЭeM]ø%)?cLGʾNd]Kio]~})ow'elzTʼnR42{m@}1Bϰͪ)FF(Lޯ1%|9rFM/4T!A;>bdbE^ĉ0dB`b)]!`a0+AT.֡Y eF2ȌȮ%;ZmQ"8 DV\c\np"aւ/~)mߦR*|߂/%?^nV_׷~ـG~|\is >î36do n{Tj`O.mܧp,IrҔ87h\Z:;GQ$s3e>H{?eRHIǧ3rצOY|j?"% 2S >ȸOEh&$}Ѹŧ';?f cG39뇴:cYH!ϾH+106-1O$qsd4tTG,O3O~~gp&'?N۸tS}n/io_2.,[ Rʴ>KcH;Jsç|f`۟f?gpLl2~=ƥgy !I<&>~3p,G\ ت3nϖ4JA")y-d&]ҏsZuNc|Zm68;r9i2?~i0H#Go~7h^'GKuÆ,HU|ŧF`~C%>"}% tq㎏\-.qwҘH>HM@ʊMS{\~> &,4 {æww' vK6tiis*_gYl[w PACn. ?@>`hڝeY= @\hѽ&Ini ;HفnS[s9mA~DަmÇ#]C*96`B}'s!K]| Oosx8 v r ?p6E=fl\emǫaЊR<0ot-gt"?Ua=`ʞ/+'Nב}g'u $엽Yً>7_)si`JYύџc0SRD ~[ c[٠,޼+aI^֋C}Jy'wr~f3Ǭџ@Udqd0)4HBӈ1ei)|cns- cɾ|oi6z=yɾ|w%Xd?:\fШȞ|L&x{N0'9”D_=D/5*"/˹Ȯ `l4]E7'Fm"~-sr~,4G.tۈ.G}=7eyɇK/Uy7HS·z^OK֕rwýM?yۓ˿O2.=|q<~ D}}}c蘻3=oX<՘b~G;0Ue~՞vϙo_wx#bwd~w|׶N2S(?PIc;_S~3%{7_;Α;[>lxsgݛ~*6pkskk.Ztg\g&%>/\Ifm&t8Gf?\fp/f\25\Φӌ?}nlLkrce/&̍g;7V~zuX{:$hXIq sc%7rX+dˍ=Lsc%hML2率+?|ש:Jj'7VdnL+?wJZXyaه3>dO:Wn ~͍}יrc<۹l"{?7xm8Z3nkÇ[Jʕ|qb8!㎔'}-?R-e>/&Ig|寓į%jgN8yܮ!q]}E^|wv73`߫z kߙ]3߾';3tbc/w{4ynY|]|>6wv(mw&gm;sn|?r&#燑39?F#痑m>r9ȹ9#g>rM>τn>sy?||ԧZu~?7_]ׯ|^-I.,M|dxf΄%wLQng'f7e} ::׎R_Tk`=,[~z( =oǷwv?Y,YΗ_-uSMx(,EXʰTa҄ KܛJo[fC6dC6dC6dC6dC6dQ(l6 FaQ(m6JFiQ(m6*FeQ٨lT6*FmQۨm6jFmhl46Fchm6ZFkhm6:Fglt6:]05gkZV5kڲh9Zh9Zh9Є&4 MhBЄVhZVhZVh%ZVh%ZVh%ZVUhZVUhZVUh5ZVh5ZVh5Z֠5h Z֠5h Z֠5h-Z֢h-Z֢h-Z֡uhZ֡uhZ֡[ݲl~iH>+,vcd/data/WomenQueue.rda0000755000175100001440000000027712547003156014553 0ustar hornikusers]M0F k4$z~Td /آvaB' Nڙۤ}/3_I綐7D!D0G楕jTbvbJ5$č#gԈ-^;p5eRs cY e˲cٳT,$3opqfסM~wݭW.  vcd/data/OvaryCancer.rda0000755000175100001440000000054311566471043014675 0ustar hornikusers=O0/i6EJt`F"&*b1u=%.&@6~2!wJK}_}?Z`8BT(ݻPOֺag)6dvff2IjD1ƙz ,><B۷JL4Xs{jkYyu'NoPY ]_N?0cu\;ŗ__Wh =̖Ѩ& #HQ1Enԋ,tj+ͅ!'6"-4_1uf_ tO r!qy,EUb 45<#(R~7mPz7׻ǽ !8&8!8%8#8' G%L"D!:Cm;s`_^evcd/data/BrokenMarriage.rda0000755000175100001440000000056011566471043015350 0ustar hornikusersj@'_BECћAW]m1&&xk߬'nܙrhٙYrw=u2` 0l)?@$2њ#&[qy"ߊ]K OG ox~<*RUųNu\fL A,gp’x3XL I$$~)Jl4-_Zf6|'|grB~.?͔N<:(OyًنEt\Њ`Vf?$`IDo5]%h :]GЧ6\M-MmMM]M&m%򤪭R?Uvcd/data/Federalist.rda0000755000175100001440000000024712547003156014540 0ustar hornikusers r0b```b`f@$X84[jJjQbNfq 3/P=1H XfNRPiv4it^bnj1fa:<ac0 a cY l6L%7HCWX$1)'6vcd/data/Bundesliga.rda0000755000175100001440000015070311566471043014542 0ustar hornikusersܽos\u滺A ȦĀ,whB֘HedI*JyKK2E@r7lF;醓yuQQ>ϳ^{?U5n]fUw.^߽x^u?U.//~O.~.~.~/!C^@~k0O 8?:8s#6ؿCm9eydg!(] x=?'~GVxwu!RGu7b)v5[w`{ {p 0p XOY./˧ uY'.)uR ?^?O/M_ /o.:^=|`Uj:ÛpIy]+qngqz;TȷMXZOr';XX5q纣k'Vpʷu|P9xgu:<č'*Խ]^Hk\_saX7@8w7,;vzv%V|;cg*kb \s$ rn51_GW7q<V?4ş)9YgQW˱MX&n<^UyZ=0*.v׭[_gO8Gv8Ox ^ 8S`o[5T,u&YL\dk8?u=\b*xg˟[qg]]:ΰcV>3'zd:|uqiy֭5,nSzauX=}+qz>^eXpnU+aܪֿëb"ĝ7q}b9Ai9ր9Zago:<~ |j58 xn!w*}~Ա:7==BxP#|^Ku~,qGÚ!+ͼVc= A殮CI rx3IN/x֣j<60uXsG>]oW;ǂaj{ZbzBMg;0ȫuXA:~o!8q5=:H0bWWz9vfΏSC` ݀?ή0k|r%[}?8ßm|Du{PWuuGc=Mܠ/$6l'ެZOwWz jwb7 =۔NSX=xh-88l#Ջ8_ƙz)~85לVk3^o8c^]Y$gqZǟ)Nżǟ)Ib?̟SzjԢZ=逅'{ɰv?߀p~k^L}nA݀<33v}<=Oz͇??1]ky\>+6~9[j]tZ7/N6ZEܩSxẘO|}WreLnG`O:8qlQzqy9ea 3ƺ/p摰V`d"ta<LuQO7[a}m8?k;ݿj)eO;]ux؋ 8)O`ˏՓ))zXӋYoI}kߛɁE'Z |Ԁ Kڗ 8?(l_סLMv^g^xų/LN :Mxn]Ƴ ;x{*\>ٯV Ŝ !l05zX1/s &{%2?jy/b{>ϻ#tpL⁵j7vF3񸖳KbM`q]Ts;S Xωu_v'}Xo ?8œ a=?Oak{QLJnygU=Zu1ϪUuy8q}Jy|r8˟`OGp\qn0㳔㗲Oj+ГxB0 <52KHg4B?jT8<cjȴ {Ov7N/:=TLya{0,;1]t^i5/kܭƟǧ󳱦ŽǟuܙT78Î y.pǡ)^2G5l{+j5mE2]Dy kq6p:mZclk 'ıoT;&4gXiWp8z8ԅu)*/YUL?a#˵|/{Z ?`myHة:p< 8ikbq:Ǻng*kzpl7 {:cĖ{u[y!<9Rkvtns~/sfVc`u NƝ\%\Ysѧ9:mDf% 1M&q]WxNXCW?Ћ;5)yH1UǶS+γ&Sq9v9ѱr"׭-Nk%valwk9 ͫ}>q P]m>9)Ї3`s(ysp޶ zn PCaI)[Hk.`#Gw[2=tH?K:a!;UҮX0|8#pߴ] ҋu3i1[J~zf}N,H 鶮?`wלpЇڔfSgX?0YmLróuq=?WxIYftossn^ǟLqq'1z"WgA猓l8pﴮyqbɝeOts5^51{9:y f/0|n}6߮񽗉Of0 tv\gI?^rl~;t[O.Kv ͟)J;)z8j1 g8j?xs?@ 3\xL=9輀`>rot;cS5ggOKq~ZL3(Txg9E'4sij^U3#w0l:r9_c$z,6Yc8sؖ"|q>3k8ﰦ9i;1Nڴ.=|Cu<ߧ9+o yς ]0gcX'jcb=p_ͳ[޳XΧonNjo.''ZgssR}Yx%&A'c788ef^h"5xOL8uw8u2~x:bڳz7 =/5?}]ȲslȲlr"ϭ &3E8p\ϬۮpJ0d+XؘvYݒm?pSc̉2l 'c{zⅾ胾'?a9 7[=buJ?T  e8f>~cfq~nטCiׇ0 YY˛uF 9j<;`>`|g3Zo~_X'}'¾pHomA7| Ϫc պ7~/>u_|۴0+&Gg|P82:DNpBϻ>[or^d>_L]5ɟMqVܝj/V?vğ<Uɀ3&xƠWEٰa^;-yO:yScx \<JqxxXvUgc~:>\٭iĪZ0ŗ <3 +cxSwr:¿j߼|1GJx<{8?rc5ȦoΏ}+`LdFCk,x'b ֺX;ά=̓|NLpz}ȉ\D!7S[7Z-{!==sr_8'{5_'r ^ sjZτXpqg{YC2Ϟ=RȭpV5>q)v/=pW&5`ڿ]\g>Gҗƌ\L `a|o%HD:X|y+s%-{Y ^c^=İ>},Lz˙CRd;gWzs "j98̖wq#N?՞Lj; 6p-g‚?v 0P$õPxpы3v+6~vW gޯA6z{اh!u| /ғ;; l߉drv>lUW*|y#c QLXmr}6gC?ѝ~?/Cs:< U>gZg<0>·EmW8|5k:<=uunԺs9p=: gO/̫}o)yh̕m.a 5#zFq\YO9ς laS?'Emo07$ގ59|<b|לNipݭg^ybYi52#߅@e^^Te;sΊ3lպgYH u6JӋ¤6!ZNa۪; V/9ϼPCXAG|yK̼3`Y7|g=\T=O#̣uZ_ k]XjU^M-D}Z9/{r̨ 5:U|Y~2"6 w{kd+YⰪq>ez-L|Wq\U5c'W'2T'p8j{'?PHXܯ>?S~,)8V6},8j}%su}N`rga=Gkm k7yI:~-rIqy 65v5.Uۿ\\?VOwPOKsH+xc^~K6qSm#g, yczcŘ>DEV/X I؃cyh%]g5֋02*n_j٥̽a xL}&?=˥5{'z¢ ]5~ IK_5#a 9鬋>G§ }>y]j72˸Wnd {OP>'þ,z#5Q8/߫Ɲa xcW-ju=z0r~Ω=%OO :P!?6LcS4=ő0=w{~O85gI|T_%άƳlzu/ ]gY/yzvl> f>8<繫B3{2a-Ag봨VۨE0󚧱QYϯg`8f{0/PCcP',=D+1 ?Qٖ{ =-ᒷؿOA1BKk<{Z;q_<3<3a=:|W?6F1[!6șaT؎.O:8TX`lx&ߡg/?g`& ZMF'x&&1џK^K\7L<,={M?xXbxGf>T?P^S!WEJg8E|I۱k/p^Zb?zXse<0Їյ^p=Yr׳Vߧs$j ?:18[Ыr#g%%?ΰlgZX {<N3G8G8Ô<~_rc_\ݪεsl70ެqd|S8V0eటOlv[xa[(nʇ =zl=׉.)/{nUu9jqGjnl,<yzh֤0'~ý: uAX~=yk>xSi)N\=>}τ&>Kςa\Y5Ray`q`U`QG9R`vjL#v7V'^|"g q]Tۏ{: | !/0o ܹ>[/7ݷe\NVxsvwo_ 7%/}Kߟaxy_<~wg_l$oWy?wٷ_z|Ͽ/._˳^~|6ݛvvՋW_~?ߝxfg_~_{b_>W,7~;?|/ ݫ?8׊{|~훷Ͽz ׫_+݋Wo/P߮>?՛/g/Οb߽ċ/^}wow/Qڻ ۓ??0ݫ ߝys_o-xy/~ O~}Yxտ~ÿ>;El~o.Qf\ rY_R ً_|5~y?]D;r;~onݛưtAo}]Xo)OV\3Ņz[bwoŅPto.21zvCoVpoY{Tz_˗_[~?\`ͻoe_ۣw~W߼"_oߞ]"6g?wAoW߽ӟ.g_2J/_>CE}˷//Jک?*%;wtoԸepV۽o ײq*өw\_~w>Gj'վ!/fßw'[x~g_u:Y|G;,k sbxjicF<sH{&Yz}#Ú?pzg}ƿ_G%_O>bf\ǺDžE~}x2lX9pAt\GĊ5*W<9;'^^x3a T`mN0\rW:vGޏ?qk%8w?5Lu1;xSq/}g8 3 j9;8==8t9Wbi^R{/\Iߣ 8$R0x{uUMٷ ^Ͼk`pbݚ yI~5΅ubO;kfb'y6r㨃>غMO+qnNq5k eCmxzߪ0qZy2|\Ǽ%8E{5[8ȼiS̳^]Jwt%GW?O#q ?vF fO=]nUu'5~ r~.l1dײ` Bޫ#Ppɝ}_‏ Of ;f(w7Ʀ$NV5gԻ =4YGKSd6*SpgS[bZn p |UUKaĩm 啰m#=j=vCpvgxf8)dCGc.o!om;{14Qm hT{gkl91?]ISb-`)=?v5հɀayf0X'[uZ0vf\ո/NkZtfcɀ56™jt*ְϼÇzu )|o9(q_3a%_TQZ3l֘}8<` #8~`Ù5M <.UlfgpꪏA5m_}ɳf [79j. S5:XWId'/qXAѷXֽ% g}tXo>sܑ'Ϭߔ2y:.'}jOգ']Szá8em\+U50Oo!%|&.kp8j`Ϸ;K>vt*5rTvjR׳\uZ>5<g5`or?6M]SLS+,=c0]ɵ]Ƀ=Aۼ[Wm[M`Xߟgyָ/ԃuQ=yǥg õ ɦ/VB >1Yje7q81rO&KXqOqPlz՘=;Kl5+' 2n/.u{yZ/c o [jʁ s#{:`?j=ms [+Y50Z#Y|B~Uclk`x~N_zpC:d\6GN6\ìfkd0&`^|0,O=,l<yiݺ^&d8Fq?gɼsV({g=-a|0!gX80f:N`+؄>b{6nro٫IVZ@:+\ɏ\s|3bo3ɩ]a} <>Or:m)wuxhEk`Vu"?==1&T{d? {Z'/݀ȧ?/׸hoC{!>Д ~`Z?cIi#߂1}5lBoz`Xz"ğMdž|n)#3|jq_0<'f1Gվv>wm7-9fƽ_cSnO:aNa[kM̒O-xRj3llus>61ğ<ހSŋ5NX<=*õ`N/vo槾8~LclߤO s._@ܫv:jp57rWs]Ǫ'µ,OYi}~odDO9zFlZ8jߪ/c{~`nrv×}~!ۈvz rًg\7-u#u;*AG>:JN9?f1q֦[ɜ qOHKzj0zo'5֏9bkᢃǵGk0%9i8%oz}ebYR0i5̥loa_Qeb;ݿG*p!'qGX5e*wOcA<؃8=]L!j/XGo %=q_`YP!A0X}ϳ18l$1ovm@{c{݉g|Lzڳ'j-zC덝b&u>r`a}Lop3m}ϳj{O:mk3?La.ܳMqǟ?ޞ?dw/c+v(L5o g2'ϰ{u5,;A{31Hs$g=9 `c~!FW560[T;)}aY\) vPSkܷphZk͡8ݓqot`B+ &yτ;#֘M`xL%_c>4G_bOC<7s|aYrgCp]IutZ_g 1Bzd>Ϝ5)wa={}lE` oPfl|lgyIvָ=~ྰAvr|nuMท貮ڸ;Ef:[绞?ȱ7K|FpuD@e:܇%dpxZXG<~'\[u>DqF x`{Xg_}bmc?6 yZLۄo[{όQCί;5VgO'cK8NjЏ;x'|~m|VW}23y7cz>6.}{{{~VL赯39< ^`z{y Sa%8 A_Ǧ]gL;d{ufNԭψ%o[uV|TXYT$xӁsCEb9_FoơŷҟoX!2Tvw}a& bu{%ާ_To{*;jO}fKNn `YSɯ:vAo%]AGϟ8wvk`ۖt3a3`"{IlЏY{K$֘WV;#cnpKoi\3C0s3a9SO/fwYm<֙~kOa wj9|bOFrήpݗE }ϙ8Nߒ[IݩVo<;c'}3a{I;^.}_v]{@lی^ష&y=G70>y9 zV{6ﰡG0>VC;GoQbmz y7wbz.xݩv~:lح>IMbe܋Zx@M@;5ؠ ܤ'yҳYXVC~ygXc89K7k`CV҇]CvoFjpJ`s3Adj{VmߓO ,|ơ 0Mp;p%g` ic}J n]Cԧ=<~̿Հ}+~?g|8b.P|/q &>"SjU؂zM:&6/1Ok.1wtݩ6 }aPkZʃߟ-j\pnėD`3g0K/| ,u-["<ξOLqGߣ#yld}bĄ:qUK#X o=I>^։u!>^Y yk\|ìIܮVKcO8;57*0]*&LY܆;XD̅{֝p0sfO/_Ak1q1wA9 ^E@O8р,vg8yy_]g[Ϛnf@ g?mHQWH\prM|O\ksl'Pk\ؿ39 Z@=E> 1}k]s }8ہz0|oZ|U8ȃMt}zW^+;N,IGCꇯ%N,,zmJyh_6B7|*IU" ; ٗVXd^ٟ3:9q,[X]V҇u/ bx"yb#spUW9lEnç5|w|;MN`q1}fz˞Y=q﹧Cj7=۟V$>yg3u>. p$O]@'VۃKV}>}(j16K '硰Y!߾pc0c.}a{'|J̫>O9ֻc,sy`J:syV{ո{-{X_ p!ǔh;cs0x)ְ>滑VҙZ\\c7A-XkG,kD+RCN zjMن:.j9ڬP c)jstZ;sxc]a_.}2r.p"Lܠnf\Iv}u'k|\v |{ {0=Ə[4`wy8`R~\6=% u>'5O'y/A/ð {wW%KI XUzCl'5;8&'61j=ɀ?5{Rg8ۃ # yp1oUpl5i}/znܠ߄kgzY.r6d`_л5>=CAEu'cƙUkZ=ƽj y6:O}.kޗgNzVj8Ч]۩^DW'3{s\L^gBL?q0 e5`+X3Uz 3q/У{̾d̞3>5j=|".ɗdX n}ӽ t&ʞ?؇0U _әy߫OyϏX"}1/@w{,8^zO++؏%O carM7mz|f|ͼ'Gf Nqmlts^ u2{a~9Խj7>ܧ5zaD2kp\_74pc}|}҇p4plj|3{:.҃3dq#NC ơgle8t$6e},:8`v>~t<=* Ls*ϭ 83}=~#s-k<~\ȽdRzo0ݎؕ,ra/pvszsCzl߃3a"|_?X85|#{"y}_vfϦR/헼C]_#N-=a߃-+Spsqvvk3q^y}8"y|'vr{r9q \s w,Lf>Gy|4}r ,d6Z?٬' vuoVaQ- 38U98Cl̀ú7>|ܫA}rܟR8^?0}$cv 7_-A?s ā}X՞]9YƼ~lW;p[.:baž]8=\̕^bJvGnn ⊞j Ϥ_s @k"srgdk /j9<v  rCa!r0= XMCar~~;i.3$GrT-l}ϝ,y ϰC>)5??,#F)ً>u{̣j\kG/@][`ԇUyCsWҿ[[Fp-3[A|TX:N@?e^Y :9T֥o!LbxWj"{u|g yO8>lgsq/prOw&q!QEwԻ /.q/3NVxsvwo_ 7%/}Kߟaxy_<~wg_l$oWy?wٷ_z|Ͽ/._˳^~|g4^^Cjwgś7?[}~vKݛ7ko߽b߿ߡ~\g^ŹVo߼}fx_߾^W_y^z{~vw|<{wu~w[E$^~߿{3{_マeޞ/Յ^]͛ >zxk[&ޯ [xHKo#o.b/Ʈ_o}s_P7z_\ꟾbo^|uvoo.w/ w"Zgߑ㿼~;p4}^ \{’__~VHWo/ž/./޾{/.\ ۿ>s/a׳zcFg2 ן_ҋ?Z\ۯo}.^/I7g/=Y=9ꅅ}JݟtA/>ŗmQf\^v_}}]IUm,ߪ{Cۖr^ߊg_ZFut=jcqccԑgZ55Sbތת g56u~Ћ5gq k~K2^2>t}u؋yo?ąZpKr-f0lvyupjMsFגk_;̫#TfČkm| ky]C&c &p{f\g:V`:^ѹvKc{r ƱYWիCirVe{ٶ`՟6{[w䩃s^?ۀ7?3q߬qrz1zU)z!kn#sM%kkboV]˵:^2a둵yVn k{5r?=1ʘg?ox%f+m[jw'ٯsݽĺ%u5z|~=W wƾm]3~ y-۝'佐}(neY};u~{Y{M/3SLu# ^d}!5 ƺug$7zr=}\^sl9'} __{W!Aڷjle=nE2_rzc<b[5YgYK ԣW#_'ưm{*-DlgKdm{9{dJ]l_Vkv`8vY{=}߫Yɋ=^$F2wemٝskΟj~O{Y:g׫uLݧr9{3t>gx遲U~ƪjܯ{tves.|m/kl_#)޸7˺t#qsސϽ3g,woc^kqHNX2'wNrړWտ'^ݷYzyn'˞͚39s;v:z~u3쪫f~.7kCǬRל9mMl7U7gontN͸6}kz{f96+SulW?%W5g9bo}Mz'SzݫS_S޻W߭{]vj\7q~j~zRq}F϶'yzރJXkX#kݬGf}\Ͻ3}p:|.뽙Ⱦ=ژzfUc?9&Yo3DQGUz7UGz{S?}/sPXGx\+]Gv=:eW~LMo6\CgVqO^dl֡j ̩gMe95W37c-c]WnvzM;#'\}&e9|+dz6em'j'd]+s h|c<=Em)3<ףkooՋog}7ާΩ^.o̴Xn*~3kXSuײ߳}{gYc81\oU8}Sa|j>jW?2G]'|V%gd^[y4nsKGf!cޫ;ֹ&v ae@grӶ87{8B=YVyg߱x~}qw9't %}6]܎=%f׋L~+p?c݌k{QϬ؎IjcX|j >(>57c]ϝ|֨qnfO2{#^n~iݹֳq:3ߪ|^oeH?q>̣js8=3vz-+z{ϰeNmU䞕٧Y~yk/{{P> kd]Y>wOcy79aswW?R8r=\{kLL뭷uN;3v%mz2eCrs d wۓ>܊Ёώ'1Ǎx?VUs%y:5Oc)>QWcQ&?9.u;!x_saXWck㒜8?o6?S̳^<g߈bny\1W].^upOz}Ž@oMzdV\k}\W%9ls_Ucd Q>\t,mco'{2E+=:$]:X7_zӔ#usrǼv| igV7ڬeDZK<dNgFөɸZl[3zk+8k/Gd~)oG3'X5ֵW󺪖CYדּ=۶8kfܓr=}u짶ρkѫ?SﲮN_+D=q]c_\uY?~ȱ?:[ohx_znBxϘ'Oχ%]s7+ۣKx~=&amvޟ=3c|s{~絜+㔼ճ'=9zκ59{}yM Vy٧YyF5W]ڌ_ﺴ1slU55gu>8 _z=_uwO33yd]{8z$瞐Xܵ/|`Zc0/=q² >{Uu5+G.~/޷쯊k̷1AwUux~z}ol?3X}ܳ>'52vK{<սaɮܗ'yY`|2W|!kp 7+ql7:6yxjtu_rX9czje՘_wKdz5v9>;8^gD %y <0aOiYSgF&M鬙߹^u*~\{\Xٿʵ-.=.lId#9ٵ5{gj3/}`[z}̺czslUkb~YǺpk{+krwڗ{Es}\G/G{3oܳ{A﹭k}zo1GzƬ+=]Aۙ9_s}}*gr_7*)gھuyN5iwR^;wg~`:r{m4z${c#_O':֣5-gdr&7KdS{lNԵg?ԫw?|V\߬{xƭ7uY׽^ O޾Ï+3d{wUWizϽ=ۜ7K~u-h)^P5^;yXoҧ&ޟ/{Uc܇2.[qMU?v-}匝>h_䞗>dt?#zsҟ|ސֽ_O=t'= ˏorS:eȺ{u}̗^|׭s 5N?`K7sݹ<5?Q2>̳^&[q;xñL^ǺKrΐWg(;կձك}~2?㱦s4`fM2VoWgo-zr6z浩c՞zOe rO~ۃxu5'9o˙\<ϱ2Rޑ5J̬5kDꔳ)=~?O^ˏ^,lkom={vkh?=}m1Zwmoߌs+eS&Y]]g'͐72˾Ylw&jmί:"׻rvgSqz=s6ߨݎ]5׸^K_o\eZ<#d9Şًma9-l}5Y̝^=0SYcڰ7ݒl25Υ ӫ3Sr}xGގ=]3/rȾ=IE;={oE6!,"jŀ7ԀQFD@ (pQn] %Hd a-컌 {TTzͩIo\~z>3]UNzg~*}o06ja1Mc껅 C C7=އ4{.ưn8pKfʦqUրsUߟ-9Z~A Bݳ#p`M_c|M1Eue/?V:F/=3+6O]~S7i\7ƨ܅1Z52!m~s8|cB0AwR([:6 |,ڀPƭ1:p;UH}RڰTk}\/PXuNMtcǧa-IU΍ wx3H>Y|}Ncڌs6qk7 5 co~?i6췎?Zj7'sFjΝ_j3q9=c8Z ~r16}AvPhY`i*o^Ә4 s`n|JykوC}JXKWhV^z.7ԯ5%Kc5cvw.P[qCV}KL}&چڄaȾ4 cnV Ӹq*q:p]uq6ns>9􌮅/\S_r{DGW||~ri|x? ǘJh\r~ʆ!')tXkVN1Iۊ5h VSaq^ۀG9Ck3u8b]1oGlYA8q6Zvtkc#?1f1 C7xs?r>D E.qޢ1oP p=~nIDc-mj څ: j.~ڌZz.։q~ڏ ]X?{C _4ݣkmU[qs#~bOox}Jڋc}!C˦1 ʹ\)]oN6n]mvtia^w!ˍ{(ݟ9IM9wMuǧJp.O!ۆぶ7@ m76v!(u+j<zO4uj.?w0Ƨ5Q +UO8[!]ZU%Ayxjch]06X8.p>87&A9Aqv`fpI5* 0N ډe~ƭ5u.%-pQ?]tZV~F1f/-c,ñxj t霮jXN9(16·h]X>1n;_Fc6}r$|My0N95cj3W.ƝPGۃusmQ)zݓSѸx}U C7e9c;}:2i;1fi>!zM Wa^ϨN'6q1{|?'*]. C=rcb*Q{iwrL^o ϣxڈU1c0ui4 9ԏ/c~b ǂ{G7ԖS FR jaȾjAu7ߜqƾ @rUmvpqgW%9\g7|=vjW>E~SgWmڀmE?bpDÍ 5&0Һ[ZPwT 8sm¹ #Ur1iù*4Y[Xcֆ4O$Σk4Zg0J˳6<{_X!?cʏuc8UW׷Quʲ>SL,3Q]X6$CڂH>P=p|T3hsWtmIG7? K7 AUFk*-㜖Y6)>ϯcuT}M4̣jNOq;8gy+nX6 =d\N 8t\.Aޗg\a_pp{n!j%ڄk,j3#*O3Z4^C__ j=NJ}8u>l@ŕKrmD?Q{lS:{UkZg9={TP\_.ܨ߹7=77pSU2ұ`@\u3f~Q;3DyhYu|bmQi!kڐd}UZ͇Mur~n88ty`ΡbBxq^V?C_sHT78W*?-C57Auìxok'j3W&^Cr3{VCXqNו\_qqA~R{Ĝܽ{nm7n?;mܽU<_z]tgGw^ TCA܇cKտV/t w}a˭wwY'8p~FmlHd'-˦|殏zDe#w0d{9[UP۸JdjTmǏU`TG1PՉʶGsߵ6Q#iL% U֡1{0Z{\}]Wce{]~+\"S\Էla<ѲBR˓2۠̕}kΏ8ݰL硲t(@mXEUB,-oϫs wQZ.p)/ 1 ^7:[n- A,]7`wj\sX&wIFiӵ MC׾tJ>*AV;:Qq)>֓\9`[mDZl>sym8?o~U58scLc7NUk6xRIY6r3gGy`{V=4*k#[pycQym@>.& ؇Y86%\>n'wcŲډc|k"z=ǜ] 1W? >ô8sk5{7V~U0x/9$sV~Jo-_qQ7G`98}̓vcg(8vrPw{\P}Tϸ'j1Z76h\q>8Zreօ}Җ㯹эc~k?j!m;=PT:}ǹ6qx|}R6ր8537}_cN 4OǍMn9k6 ]p76USN=7>>T!3rPsLCeΡl8fWiUVAP/h~7~GahW5 N^ Ush~z;ZcaoF߲T=a .9Dpk?NІKϷ6􋵖# #GNx[>nGJ"[:k|nHvT$y<&sSs6qqNc_`=\̃c'P]dXڊ:SPVV*&☾TLSrJD:g]E+81h$8=CqNAo3.n~3c IqCai;9 Si[i]xu۸1އtNTEϸb7Xqϟ(Vbpͥs2Nh9KUwuY] |b/gr`TsUS}aLP۰^, qc{U~6Í{n$U qn.66a9}0ntS՚^kiXέ񨽴|ƲO[\s+)7}ܵ3>D-Be?v`}ps-n 73\,qh~=r hٮGtN_vUZ~5j+֓HCq c \{P{lʡ~zإ߳ȀXӘ:'mh0~./aաvsq`g:ډ}Z}EJ$sb]n.sh7xω:=X-i*=7YzփmT5 j:ڎk7^ս~.9{T'ZCpi\*퇊LVscۂeZ'׏nqDڋGV9Wimm\SD>y9yӀI{h;s6>8OcqcW4}ڃjmXQ*2 ;h^G869? ,<9Nۣ5h|緞Mbc +kjrg8/ ; 5|-ܜs wk^kuNq *78{88ݨ`\%D(+,{ŕGGöƌak&Z'QٖO+s2-7jqn~+-[W|nq0eͯ4?։+:iut{&..>>ȭ?8vPrs( y߸ءjմ|nc9?}\W͓x.}Ʊ|:h[e~Pyc礊p܀h3701+j\jj'9A﮸øu~61Z͏t1 - |NK=DNیGrx|Ms>K8-Fmڮڇu_ewe ͛N!q|pnyŹsAQz\'1օcmtfGhp!ZRr&0JK$X>G~U|^º1y-њN5'rXn5[CpjJ1pUr\lqsHD[׉|Kי?h,`{_h\3JG\\sk\rkFW1}ƭIbˣELz.=&6pI:|,D۬"- Ǎ_g+JqmV)4&m3^qwk.wڮYY6sߨ_`>Kk-՘XDZ6c^̯>굎kZuU>esߩDUv9ʛ跒}w0><57a,5{UUk 8T]h!Xm }߸:_maÐ͍lu^ڇ8oZè#\y8U1L\kk֎0=ա/8C[}z>{|\  Ahj']p,#Q^nA >TygÜ;3=7QkTg2$^[2\la| /e9Wڇ>>4Z\ t9MyTk?@V^u>֩dU=OvYzu 5pQUcG:shJ3 EMx^CqƍqUlrd^wɍo\$&ϳssiUWFu&pm:p=bǸ:,>DJeM˲ڎP.=+n_>Xǭg=@[ 8_2PP-0JMuA7W~'-)-ۣ:S*Q}1%C&oO\=FPrNq9\:GbS.hFu}B[zۍk l?_nZ`?'k!i[PcConF?K(yPև6}] qms>RRP5~|KTòF_p~ڢZW:U~5m5ƚ5[ay=^41h\}}lG]|Ճa`˯a4 Z~19➖~._N9gS?%x>=:~^ևD>PgnN`[T㶬jraT3!FQNU[u4ySp@ }QX89?qqAm2>uL}JWF';W>j7ne`۸9;.yXݬrUYV>== uاxO3oV}g6$Av)Cu em|K^Wes1Z_t/* aՉmes(114 zSuJu-0K'UƭhlkWU}Dͭ C~ͯw\<`bscZη|D>j P ha6sq~Qj#=R~n_1|z=Wp}Z6е5oقe`𞻇1č+&p}JیFmQ5V,Z8;h\Z7p]>|xڦ{;ܸAZim9{_/ط;OOWML/ܽSUHls*?`FCMU_r}78cYan}:ONn|:-[Ða~nY6qqbGsaZ~W7h{=[LnMw>g~]9G;a|WDqm(pj,&ƍ#S\Qܬ2*{NNSpSoC]e5a$7˲ʣ%I"=nGآ1a[i*bnSj¹p'.ZG5"}ÕmKE|)j%_$c;a?ӶujMXUGamWOC?>1:eՁ}ƍY}9>k09sza0J7i>+օOtc*1cF*n5[}~@hhܩZj G{-~nߋb>kޣq>&α즟rm7.^qQ˵ܸc$v2 wﲬvXAFb98G8B%z1a>k4Ul)ێ\>GA [wѾV35H>zڎF}Ec J{ܳ\l { ׊XQ2i8sus84F5ܵ.ngX\np԰Ӝ/pLrk1(=Psp4@mcn5j! <[?⎞íqΧ?7cFL;1a0/#%****N*#U)#\FZF:tj2RJZ2R2R2R2R2e2R2R2ҙeHuHHzwǯ1lgvƳ1mg\vƷ1ngvƻ1ogvƿ v;`GvŽ^ьl)F:Fo#i:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:f#i:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uLu̮3fWj]}qvuή;gWj]vuЮChWj]}vuҮVKiW7j]Ǔӹ6y666^u^u֭ZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:F1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uձ&oX/I'NI'NN: ^I't:btI<ꤓN:iN: I't:RtI<餓N:iN: 뤓N:iN: VꤓN:iN: I't:jtII't:ST'tNO5&7̏}a{~p7n*%Ox*84-.M XCo<'r;oz7W0 |;E[2bfEu(7yc壮8oN?.vFh/OƷgxK][fx;Swa`Ş8:Xk7&gx✟V{mq87N~7W]yckNOCoܻDp7wlIޘ;g| Wo>8v7}Cq{o|7>~7)xW,v%sol//kF/_v8??k?l/|pgpox޹&U'Z g,k3ǻ{]CWkf󇗼+~ 4Z0?vËQ8eS?䤏?>??L '>"y vy}c+/av?X/|%&^q8a?U_81ZNݗ73ݟ;2}5%|Y~K:3/>Sݞ8<#ك \ql\g+q>o1|AO{S]U /,&U7]>f 4l/Z y%_Kħ5iԂž5rqdf>(;žقQofb/| 8vxZ/38my/^^S.wtu^SՅV{cbªWy_ {f^8o|ᐵXZ|&5/) ?N. ׸BO9J UMp8pGOhZ\O,*';~'>|io[0臲gz\O3.XuO{}v}ޔW}}<+=MPEWxb=GE]l2;'C_'5&;~:E洶ar{_P6U,3׎wīE%6wŌ,̯gVNjkی-v#xGlW+|8/gew65B,rv8&{_[ek:Mްjd71y۴b1D?zD˯_,cV[ZukZsw-~oNΏ9bS=-ub}]b噽VYs#⾍wmirOk+G=_7놏NhgM^Z?G3GD? :e7k!㹞xYΐd9Է('oP'7qMn8/P'ʽoz }Ҝ|]#~z/|az_8K%(LO-T9eQ'o#3=qmp%plO;[;  w-8Ɔ;Uɬg.W|qGgz߫{M>y5?/:Beɥ Dy]V gnWDg7 lTMMFO,M3Ovg8)f*2qlw\N=~>t/kk5)P'lo(ϼ6/̬Yڈy&Z,-_ :A%W_)9S+yw?,-? l"O/z_/*I_̗S[UV-e.;A^_.xM0 8b.pĿ'6VsIW|("_]OW'k-ʹ7!D9DpN3E'tH\pI8ED)L3Y-+DzgiOE|9ö_nxQ9a=~]g$iכX?1H^]w,~MgxQ޷+¹CVsD8=≹EFɣ?၀hק- ]i&XIW/(5^0{֊'^R z"x󟅾Baǚ"?,i W\4yw|jÖx>qY#'H KD\qz?O/-Wϥn58o/آxNv_qM{-8sdȽ3~=&?9qÅo_(OΉ[zMgI̸3⊙{I݈+\P]nbi$[qC/x̳$.q7psň/|7*0o _=yWOqKW͒vKo|#=H`E YOF<Ѳg/\y(gkv dô$_q+.mbÿ#v5{9}}ef?qE?G?G"Mwxw|aJVn(߬UxWӈ'[ :w<2Vk_(?X?↯_KcU#xX^8"mw~u#^\WU%qEW?<Oy/|Cpt?̟QK*/F>D񿵭^$G<.$q1/'≵FJ_X(UaBxg2/#!V B0Qĕ!OsZq|v88pu~^4)/Pb1O ri`C괘/lTu!OZׇ\q@}@.m'NXı_| U3$NrŗJŽW^y=1_7aϪ!O<? ?fҤCX'K51fǐ' {.K/xsū70٬ySGcyg.G] i{t~MM:F]qXEQCy>4>OrT#>< ?s_Dݰȸ =A_x Y$k奚_ѶiQ_8fO3Qr#~w*˯jX~;)Ŀ֋z--uߧIb]7eHt?v8?5!wg;=w彻$51W+5qŇ ?uX$M7s_Ίz_f<7+5̘'$Isn ‹J+6Ϳ2-yb۫B]/<sŬX^2ne']󅳟 5}?wo0ʢCIMQ޺bhoՏܖ{y%抖ѽ2?<䄫j4瑕H̘J)|_`_:=7?kN*vjdb,dGT:%'J1ム#6][ =s/Όz8Z5g̹8Sq}gvgYpK*`gQG|iȷ4k :fN)nsĝd8n9ꏫ\s!SVј#~V.CCMBsğfeLל%~5<8t;Yst/\S#V̴wM=9S-`yڕ1G<(?'nsc,v[3e?3>\5@:ɋy#z>1eUsBy\qڼ'~rgaOcY2} G?4Suxmu?W q_FvKcAG<,_h[[i,hՉ}awk{zbi,~9舡w$wn#.b󵃪=*gi 9<?6'׹̘#N\/QW~XAOnk絉ykg{m@#k70YkwZr1G|/,Zh5PBrs!ˣc*ZC=vˠ孻t Xru&|a1'WU-k<1O̫ougɅ|n/0zlS~\qRyu%e/?'X@bLh׸!WPkrR-Ѿ 8c˗q^4]7Fyfa47k\ y#Pdc5CDIlt Xf{\户U/buii,/ύ¡{D> z⨚x_ԅ1O|6+!G2Pԗbj5F3юC:P1Wܲ! |SbyMBnX\GlvMϵ.>wh#^T8c9^/X-fRC¾+~xUGEy͞ĖX^S?숭Z*/ w;ʒg-޺DTˢˮ#votGjю;ΒlG-磸Y#NI$xJ,oe;b~,MLIOˍr8n WqA5a7$.._-OgaG\,Qƨ_|Z*z}n7?(ڷOqhǎOܳHV #Dw.W?(#S%~\5NS H:o>_ⅿyCz97Vg/s^-^!_2k9זx⹷G xg_h_.864.{L}дC'-lOB'^7[7Vc®/qS/|dCĜ]qy2]q4#OOwQ-Dk>n%s}+}7Oî܃b|=Gw 2TIS=qʒ_89omXoQ}q,_+8zoZxs'.]%)Wupc¿[?g+ns]928 Ou%^>|a?r|aSeN)rŔWE5.qXC|{cͷX6I<;94l㹩⎘q/1OeC®xųMj?.IY-[b" }a<Ѱ+f#?wƊ{z#4LI#8xg!8ⰛþU'6#rFI1/eI|lWwMVbRlq1<O'NMS.hYs;Ee/q e.-reD+J<5VM}D9r]~1۳xӦr畸bRen IsY%튧ϯaWRq])x|xV,{]ޡ,[<;/%!Ϲ/ /.a]=D{{';DI͒9+[aG|SDpi_EG~La3$?rHlG|ªKîmOfqtЯѿX|NXs(OcY"U6I}Re JUCs\16Y%tfSGTKxO#]y<u 7'ޞeqG0#bIf6W>'^ams;y; 5<w:^byvlGhǹɌA/lxr/lVͷ]cv _]i)"pVBvGv4쌷z 'vys-.sw|"]dzX[) E ;'sn{heí8T_\qAFSY97]QkK\q;,pg<Esr+NY8Whߋק\qfsѾ_%qYW*E|%Es[<'8Ooߗo~T^p ܝ?gExrѮb-~&ΏwWgpoVY~*oa>aˤV+rĜ<_/qRYiš5#"G==sKq\TAyw8 :70妴#neW>ȼߺeww/rȀ(KʓxN1g'-0RX~7$d|-ƫYW$z#'EEy,:숿v&gNwg1$6ɶ+s ߈M'͞*y=5|=nHB^;-^)Ebئs{RX^r{{\ea[JNmw|kI2'bk,{qĞkTdkm]+sfIBn~޼zikHW\ }9,Td\.3p\%WiE<8[soq'뱭9k:K|[\BؿQX.prW+C/ {V!qMEQG0G?&I2:SE{f ȷczssK{FOȷVm1"~X&H|k߫i򃍢YnsM~[l[/>W,Ŝ"rG'p2g8n] kH (E(PQ#.$E 8DdfG\wNWÎar㺈MqsRɭKXn*5,vȔ2;b%?"sR#^! X^rY#^zmUo1#漳inīNJwƝZ7|-[3mZUraG\vz{/qy7UK|E3&.+KGَb}q_)2Ӌ s\,KŒ;" ,5vƟ&"q'i44ggS$&N/;+<"ʩ!O)7 jwFd;鳅=5HT#qh_iYϬlY ywiP?漳a ϗslQ՝/E9ls4!z1?!3}*# tɗxؠƩBua#_~]7lGysTaϽeN/r=*q%hSypa%?wv.n8jCħn 8d_Iȱx,+!+_QE\S#_w3MN%qtG8䋻$%gVlqG?v "*Kynvv*wKDf4nI/dJ]ĊRϻ͒xrl{S,_f5n;bʢ]t[#nŠr^;Sv-~絫cLSPCpc9!Sw6_&djQN 3*sG#^8ʜ/v]IK1K%f$8:@M|oW`V+nlZ\OڮME%^ղ8r|tVmծo~{ ㈡//1(roV,XC%PPOmp_qġ ?<9 ; n͔Yӄ<05zQ3VJ?fI65MuϓE'l{Dܸ-Ni.;hT;-%3 ^&H^/^_K6<( ^JҒz3Kvls-6l*sOn$>}s^Tb%pPOVhb~TC,;]+z>FWat{"=tQv~k-%=n!KQ5ٓnߋzyT/D/ljziКrOL:3n%yQoޛ%Vٰx,ӾIȔJe%YdD}53d4agļVYHwf2?QXhwu{TSdM]տ~jv(W巬Rbޖ6K6M{!꽮gĶ넝׷ɱ{Dm-Λ%ddQ_i$z[&o9"zgz;6,dag{l)^ṉb: ]#_wǥcXjuT}GD 7l)ypKz%v>;nDk8dsnz.?*پpd/\3ߨ)ڳᆊ&vK[H|sZWg I[#qϩaw2\ۋN5?hǎJu+BiqwpغtW&9[KX+|Ŀd>q÷ '뱷s\%$Tox+zOvbCф"W( *qFolQ3jiWl,&9]k-rcGI|[]YbS%YbE9xc;PFIU+:yۆbo펑{5\vĻָ/t_j9ѮWdžmqQ_k= KbѰKL\2᥸+nuĭǣw~튻&7'슑KK.Nwŏx}+~RE7m"W<8į-qC7K<|I&Ka{+Dk%}\׳FI#WmwA-ro[\NQzmox#֛YEv?6Jx9Ikl.ra$fU⊗n8p+'KWlvkk-*rGI+pQd]%viwǿHv0xٮسI } ~pr=Oq ⋗835{H<;+.y6o^#q%QonvOo.q{A+zT➫%K\+6KtU+~`k_v-růN%1K+~fM 7$KaQjBxk#Í+[IWOwiIO͖xʾ}xjk%\4Gx:kl}k֯/kW"ŵ\*KrW׭Ĵ]q:掿? PSWcu KѮTq]Kx,RXM@#`(j),]k36&0_̹K搂= ſYۈ gvKbw74 LAt l5"׷L 7䳹Ig7.f2ٻ)հyԎL-[+]2IYt2}4|!duۖAfba$ f{h0/Ggj&KeBˑ{ l.DLdEiȪl-W<խ"& kfX=aÎCn~Ь C&@?'T i4I&:|5;\>ݰF\ܸ+VŻ䦕Z7*M^O-4s<&0]M9LO HnkC6pxT\OMR"{;˩!W\m?=`$ <}{fii~,C"AdWB$Y z aȽB&E#Uf5Ȫ5'=*?C^Or2#zȃbXbuB?Rhv#?RC?'yoD~>맧)"G/<34ex!qby*4^Hp?et$uf#vOT$;a/iZȮj1ɋJ _^;+ې fHhfC>'s:9 Hdiϓw=^s_! k5#R7]iA>\LiX_qGHYgc ljuZ_O`{zSO",ңsJhskg%𲆤ע0 . 4s/qJfv~Un1(9蜆䫳Kۡy iُ &i,DO7]ϛVr˴*BI]WӼ3 Vj!W.!&Ƚ0^]r";5 qoph1>i]#rR)"&cgrMq^6r ܨvͦIMHM h!750z*guhg;ې@{ҷh"9s[gۦ|9ssf5OFb?XmY񍅤r])2{ygzC ]RI}f6K '|daY'Ys#`=,),2a Yunq8eu{7yzxS=a]rxiWr_GeޔuJ|)u_VTvs+N?8=VCQ.񢼦@kBJYV x%)o<7e9meAvp\j)V ^,O5)pI</Svcd/data/Hospital.rda0000755000175100001440000000035612547003156014242 0ustar hornikusers]=@Ǭ+ClD,< ˍ&xUˍD0 ;!S@ӣMufωS@)wx'b 3dvw_mMRB82O!Q)Z7(|eE.VFqq+fU}拗Lkwccc4QAsr̎:u#Qiei/ѩjߦvcd/data/Trucks.rda0000755000175100001440000000071611566471043013736 0ustar hornikusersJ@7icmEQУG"6UoE^D{tM664&v*(xPPx}}?732_4S!D'ZR#Z\`\ОU^UB"2Dv@hpT p8Z": 1Cc#~ v.Vd v(dAtLBo{7=n7#7URnX[MGͣM0fӱ:JW~^}vڴPC~+u=4 '6L}|x Utq7esn૴pe6N$v':mrA09)<4 ,kfRQF((hJQ^ѴET0<;iH'.v4^>Jvcd/data/RepVict.rda0000755000175100001440000000070312547003156014027 0ustar hornikusers͓JA$b (-,SX՚ DldfwݝH"iAAV,B\s6Oǽ̙lz:3Dc ;X(N],z]`*$k}JJ!"'♎z!ZlxyH<ē#b8eSD~ NԠKbaV?x uلn/DcX{ I®eḒAZ:kr^e񙹜k#)M-YZ c\-r[I]y{itެ8hy({NU[)m}ٍflGTsJCB5|G}U;޾9]î8d/vcd/data/Employment.rda0000755000175100001440000000045612547003156014611 0ustar hornikuserseQN@v(U.]%n $ubj2@S ~5p@A`a2 1VQiKCDP)瘊9^oJ?{@]g~r Eۚ->ByY\^b#bE#dE;yϪk#Q\X .u25чeUEl&U^7\'JTgwc.(e)i==Y"ݶ{%OD?ՙvvcd/data/Saxony.rda0000755000175100001440000000032612547003156013735 0ustar hornikusers r0b```b`f@$X84[pbE~^%3P: J>- =;_@ZڭB0@+S2sAփ44P:/17a:<ac0 a c0a e0YpX; y9`ʓsѕ$&BT3vcd/data/PreSex.rda0000755000175100001440000000037012547003156013661 0ustar hornikusers 0EǦ jp^w" X;cEQ<86S!ue!93so&S n5ll؋'bz#(>%⬢__j9&.[Ӂ9 ԋ0am5剸'[HGL"s)#LM;aZ~NCs:MW)"^-J|SKBbW b~+B!Ǿ1Cvcd/data/Bundestag2005.rda0000755000175100001440000000122611566471043014703 0ustar hornikusers]S]HQwa5!HE"i\3g#\wGgfmf@ʴ"2(z^J| ^"!;Xpf9;Fd^ȳTٿ<7j$rY0k!e�~zfWlE/m׎X͟?w; \ y r-a O~_ jT[|^2dAQugօs`1fR A SA9CtVָ w4˦QԞQ ̱S:dnyJjZ$#&=/1 ?U-|%QSdTL2]Av1ֶ橩/RhLD8hyB4YmS=E=e BLz{҅G]AD3Ԡ.#/.n%'%@λzFŶ&՜#x"˥f6Iit Ϳ `vcd/data/JointSports.rda0000755000175100001440000000074311566471043014761 0ustar hornikusers͓O0ǻ10=za-?FQ Y+?ͿL--tk_off:BIA KYTҽi(d0"dPM%Uʁ\~P+}[wItD?B^ k}Yl9)h>\,/DILSKhs_=c0׌Ěa#;> VV1.LXs~]L%^m yP;pFc@NB*ӲdתlΗ¼F +N#~&ݍ5W{-&o=9K/wxKn$+ _/M#'qFr{}Z<"醭 FwQԦMY6Umj`LFG1tEt%tettUtȠȠȠȠȠȠȠȠȠȠ``````````(4Ju'ߓf!߿ 5fvcd/data/HorseKicks.rda0000755000175100001440000000024112547003156014515 0ustar hornikusers r0b```b`f@$X84G~Qqwfrv13/PsŀUsJ&H /D E( 4IF"hcF01af(+DI0A<Ē ?t9YKrR!Mvcd/data/CoalMiners.rda0000644000175100001440000000053512367374476014527 0ustar hornikusers]J@7I+`)x u!$٪=Jc]m%Mk(zx?GG|Yinө61Y-u,j3XU;(>&r2fTf_c?+_O|b%#\%_A(QwSb>Пp[7)-bQIcNp< ZݞȦMR-*[zfsKAQ ZcsӁV6w jųOpO+B+Bp^a2&B eubZ.)d>T(dp=|vcd/data/Rochdale.rda0000755000175100001440000000101412547003156014170 0ustar hornikusersVKK@޾4Ԁ<ЃxPتDLҴ' Zl&M\fv'Yrs٨EBHr)&g#CdAH[My!?0h_˴4޴A \wV*/,?:(=)֡ś K*N*N$@:nq8׫I ȪjtPN'>o_gKOUtshߓ~}yd(̄s] 䗸O?nKE1ZZN \+7q@*\2s<;S AźqQ{np|zcKIenw-qSP \6 irϾGX^:N փ_F 9*Dz fER[#c?u&UϰSQZO+ݩ-9a8ZO6G~$  vcd/data/MSPatients.rda0000755000175100001440000000041212547003156014477 0ustar hornikusers r0b```b`f@$X84op@bIfj^I1P( Z"PZ J@iʷN4 0P@S/DPB9%3H 9(fBST FaZZzN[6mFY݂oxal"ܺhg@\dY0oHHƔl{o,ݵ UZkِ3l~d%PQI #0NWjҍK\## ArHI*6\ikۄ/NqIvcd/data/Punishment.rda0000755000175100001440000000074211566471043014614 0ustar hornikusersSMK@ݤڀRЃG= ՋxAÒmI0*i@ݚ1 6yq~t+1f3a1nh6?Ala8&c`}~+> lV}c" ~% =(_ ܨW>o úw (*uy`-_}B6sKcuƹ6atJF*ZU9X8͂[43mN)}ALmõGx7핥j93jPjeF4h0۸]*/hs;[3uEj=ғHRӯMW$z&XTV#Kv2-ȵ<$@III qbO, !%#F48ipAdsI' A4i!HCt~n$ܹI}J0vcd/data/VisualAcuity.rda0000755000175100001440000000065311566471043015105 0ustar hornikusersJAggWAz@r֯F@QgmaZW#z/GIYA߬g; n !Pے!ѡeII]9CZC?%^dV'o$~ݪ3mYtzx@^zJ!ԇc}|__݅SXߕ6Akmf>TH)ρE;Kb$ d_P0NH>Xx+ꇒFApl|}wf5ˆݒJ.V-/ǻ8{N~2?Ӝ^[y?3PPPPPѰ @Hy$"H%2R =z0`ЃC =z0pE}q6x m'xDvcd/data/SpaceShuttle.rda0000755000175100001440000000075111566471043015066 0ustar hornikusersR0RPOpxmx)E;ϧR7On7KRgƘtl[LØkz[`,{#2Q/2 ͽSO>rnYTIŃ̝D>bF L|ȿt; w%DD"GCKD<8yp|ߔN3vcd/data/UKSoccer.rda0000755000175100001440000000032612547003156014132 0ustar hornikusers r0b```b`f@$X84Gwp~rrj3/` 72PJ{A9@:PZJh4yz 4ZJ34O\  VF ba::<ac0 P\ u$& G~n*XX kLI,i $&BT3gvcd/data/DanishWelfare.rda0000755000175100001440000000212411566471043015172 0ustar hornikusersNGCDT.zBQTUys7mISF@X?ҵi;?Gi9)Q+[2xf~;;3x#h)zTkբZLO-V[e\güwy-~\V6F2(SAdr~Yiq``|-pV)ާGTzv܏C\j𹥸MS>T>}A{xgu/.󼣠 a9k]b>ؠܥ3zܟ0?yګ}Vm}:E^jo'Uy\>w?]f*>%LOns^7UMvRw4fO,?~]V<ɻg%F9\'AG5.xtG~Υq6>?(ghg[o"ԺO5~>iN 'lj$$kdEyd 2 `( `( ahahaha`a`ǥaaXaaX`8`8`8axaxH`$0 F#H`0R)F #Ha0R6䑹L7h[I%5ZI^DRbbbbbbbbbbєhJ4%MDS)єhJ4-MEӢiѴhZ4-͈fD3ьhF4#͈fDYѬhV4+͊fEYќhN4'͉Ds9ќhN4/͋EyѼh^4/-yХlmzyņvcd/data/Hitters.rda0000755000175100001440000000535411566471043014110 0ustar hornikuserswXTP%cI|5|nS㱀1KI@ D@Qb|L5HoRtJgihXݻΜy윙{Μsfݹ 9V Tajf"6Qf*(}-bBaf-=^bR6^s[_s+hCFE_!͚*PCT:e?JT [gJ0!j˜.[0t(/0~u؇ޕк4xochT3؟@6gCM[vN]w&uaI jKYSũEVnYPNCalxp':Uo[oy&@]NOcח@B GjIaIdOi•[5's tְZp*[پi|Q/wrJ&~2*Ė& ]~ZZd6$',?9qAC!uʼnAKg&B#ϗKNKpl g= %oo@k=6yq~.BԦ _6Cu@OT1Qٝ3sΉ?zӇbZC bOÆADreήZ8# u˝ b[Bw~[!?>fӥ'+!:ű\wBƹ?nτ:cࠦ\$ '2-U/U7OBRzτ;$qSEl^`(9]+ήS^p=. vYϵy ze]q-J1P0:Bvi Ŀ."(IU URF#x+/̇ӼQV2{o!H$e7G0ϷBDy8E }pWHi,]iybig{VIEI2iStPڪȃ!sύ8:\nHY=uf5G4AJD\#u|Y ou#d7Nⷦ]-$sExBw 0>qn>]Z &Wߑ?ܞ Ƃ+Ph;_uTWi&}"!__o` y#٩O\HN;~&61淾K~ o@^r_G_b+o֏F&BK3NB((;i{hYXWg;J3UG}{C]Џۊ"XmYS則Cm)jߐU k,quzlVs( _9?iJ^;y۹_-wAdu?LIZ'z^P|_jw)n ]Uv΢ГKfB݄'N`XУ=stF} I2:yK/%, g># $?z6kH"]9b6Dό-i¿c.@N1:RNtϦb0D}:!uo'c2 /p78\'<%&~{v~iUl $fףb(09oŸCē6 lҿX w :R߼c9O6f =ػMOM).w~hޭ TwC-sVpS{אo u&Y3h$C'Ⱦñb=dW:#ezxo=|N?;= z$u@M?k&qqhѼޕ凞#,;wzN_!K,4'dyFVO畮kk7ӇLX8Z>>>84~yŲLX+Q@TPAK~%%%%Jj4(iQB 28dp!C <2xd#G <2xd! C@ 2dB *dB *dB jdFjdFjdAdhAdhAZdhEZdhEZdhC:d萡C:d萡C2̔c2QD<&fZ&2єd4%)MhJFS2є1hq1hq1h<3h<3h<&0h &0h &0h*FS1T&]G ū?Z8:^-~(^_Dvcd/data/SexualFun.rda0000755000175100001440000000034111566471043014367 0ustar hornikusersM @/RA:wdҩz_ a3;}qct 9΅Z&0hxr_{R&HW+4Ҽ@b#R׈,3WQӈSsRx2 GX}N +SJ[q^ VVA4Mwvcd/R/0000755000175100001440000000000012537035651011254 5ustar hornikusersvcd/R/fourfold.R0000644000175100001440000003657712515204773013240 0ustar hornikusers## Modifications - MF - 1 Dec 2010 # -- change default colors to more distinguishable values # -- allow to work with >3 dimensional arrays # -- modified defaults for mfrow/mfcol to give landscape display, nr <= nc, rather than nr >= nc # Take a 2+D array and return a 3D array, with dimensions 3+ as a single dimension # Include as a separate function, since it is useful in other contexts array3d <- function(x, sep=':') { if(length(dim(x)) == 2) { x <- if(is.null(dimnames(x))) array(x, c(dim(x), 1)) else array(x, c(dim(x), 1), c(dimnames(x), list(NULL))) return(x) } else if(length(dim(x))==3) return(x) else { x3d <- array(x, c(dim(x)[1:2], prod(dim(x)[-(1:2)]))) if (!is.null(dimnames(x))) { n3d <- paste(names(dimnames(x))[-(1:2)], collapse=sep) d3d <- apply(expand.grid(dimnames(x)[-(1:2)]), 1, paste, collapse=sep) dimnames(x3d) <- c(dimnames(x)[1:2], list(d3d)) names(dimnames(x3d))[3] <- n3d } return(x3d) } } "fourfold" <- function(x, # color = c("#99CCFF","#6699CC","#FF5050","#6060A0", "#FF0000", "#000080"), color = c("#99CCFF","#6699CC","#FFA0A0","#A0A0FF", "#FF0000", "#000080"), conf_level = 0.95, std = c("margins", "ind.max", "all.max"), margin = c(1, 2), space = 0.2, main = NULL, sub = NULL, mfrow = NULL, mfcol = NULL, extended = TRUE, ticks = 0.15, p_adjust_method = p.adjust.methods, newpage = TRUE, fontsize = 12, default_prefix = c("Row", "Col", "Strata"), sep = ": ", varnames = TRUE, return_grob = FALSE) { ## Code for producing fourfold displays. ## Reference: ## Friendly, M. (1994). ## A fourfold display for 2 by 2 by \eqn{k} tables. ## Technical Report 217, York University, Psychology Department. ## http://datavis.ca/papers/4fold/4fold.pdf ## ## Implementation notes: ## ## We need plots with aspect ratio FIXED to 1 and glued together. ## Hence, even if k > 1 we prefer keeping everything in one plot ## region rather than using a multiple figure layout. ## Each 2 by 2 pie is is drawn into a square with x/y coordinates ## between -1 and 1, with row and column labels in [-1-space, -1] ## and [1, 1+space], respectively. If k > 1, strata labels are in ## an area with y coordinates in [1+space, 1+(1+gamma)*space], ## where currently gamma=1.25. The pies are arranged in an nr by ## nc layout, with horizontal and vertical distances between them ## set to space. ## ## The drawing code first computes the complete are of the form ## [0, totalWidth] x [0, totalHeight] ## needed and sets the world coordinates using plot.window(). ## Then, the strata are looped over, and the corresponding pies ## added by filling rows or columns of the layout as specified by ## the mfrow or mfcol arguments. The world coordinates are reset ## in each step by shifting the origin so that we can always plot ## as detailed above. if(!is.array(x)) stop("x must be an array") dimx <- dim(x) # save original dimensions for setting default mfrow/mfcol when length(dim(x))>3 x <- array3d(x) if(any(dim(x)[1:2] != 2)) stop("table for each stratum must be 2 by 2") dnx <- dimnames(x) if(is.null(dnx)) dnx <- vector("list", 3) for(i in which(sapply(dnx, is.null))) dnx[[i]] <- LETTERS[seq(length = dim(x)[i])] if(is.null(names(dnx))) i <- 1 : 3 else i <- which(is.null(names(dnx))) if(any(i > 0)) names(dnx)[i] <- default_prefix[i] dimnames(x) <- dnx k <- dim(x)[3] if(!((length(conf_level) == 1) && is.finite(conf_level) && (conf_level >= 0) && (conf_level < 1))) stop("conf_level must be a single number between 0 and 1") if(conf_level == 0) conf_level <- FALSE std <- match.arg(std) findTableWithOAM <- function(or, tab) { ## Find a 2x2 table with given odds ratio `or' and the margins ## of a given 2x2 table `tab'. m <- rowSums(tab)[1] n <- rowSums(tab)[2] t <- colSums(tab)[1] if(or == 1) x <- t * n / (m + n) else if(or == Inf) x <- max(0, t - m) else { A <- or - 1 B <- or * (m - t) + (n + t) C <- - t * n x <- (- B + sqrt(B ^ 2 - 4 * A * C)) / (2 * A) } matrix(c(t - x, x, m - t + x, n - x), nrow = 2) } drawPie <- function(r, from, to, n = 500, color = "transparent") { p <- 2 * pi * seq(from, to, length = n) / 360 x <- c(cos(p), 0) * r y <- c(sin(p), 0) * r grid.polygon(x, y, gp = gpar(fill = color), default.units = "native") invisible(NULL) } stdize <- function(tab, std, x) { ## Standardize the 2 x 2 table `tab'. if(std == "margins") { if(all(sort(margin) == c(1, 2))) { ## standardize to equal row and col margins u <- sqrt(odds(tab)$or) u <- u / (1 + u) y <- matrix(c(u, 1 - u, 1 - u, u), nrow = 2) } else if(margin %in% c(1, 2)) y <- prop.table(tab, margin) else stop("incorrect margin specification") } else if(std == "ind.max") y <- tab / max(tab) else if(std == "all.max") y <- tab / max(x) y } odds <- function(x) { ## Given a 2 x 2 or 2 x 2 x k table `x', return a list with ## components `or' and `se' giving the odds ratios and standard ## deviations of the log odds ratios. if(length(dim(x)) == 2) { dim(x) <- c(dim(x), 1) k <- 1 } else k <- dim(x)[3] or <- double(k) se <- double(k) for(i in 1 : k) { f <- x[ , , i] if(any(f == 0)) f <- f + 0.5 or[i] <- (f[1, 1] * f[2, 2]) / (f[1, 2] * f[2, 1]) se[i] <- sqrt(sum(1 / f)) } list(or = or, se = se) } gamma <- 1.25 # Scale factor for strata labels angle.f <- c( 90, 180, 0, 270) # `f' for `from' angle.t <- c(180, 270, 90, 360) # `t' for `to' byrow <- FALSE if(!is.null(mfrow)) { nr <- mfrow[1] nc <- mfrow[2] } else if(!is.null(mfcol)) { nr <- mfcol[1] nc <- mfcol[2] byrow <- TRUE } else if(length(dimx)>3) { nr <- dimx[3] nc <- prod(dimx[-(1:3)]) } else { # nr <- ceiling(sqrt(k)) nr <- round(sqrt(k)) nc <- ceiling(k / nr) } if(nr * nc < k) stop("incorrect geometry specification") if(byrow) indexMatrix <- expand.grid(1 : nc, 1 : nr)[, c(2, 1)] else indexMatrix <- expand.grid(1 : nr, 1 : nc) totalWidth <- nc * 2 * (1 + space) + (nc - 1) * space totalHeight <- if(k == 1) 2 * (1 + space) else nr * (2 + (2 + gamma) * space) + (nr - 1) * space xlim <- c(0, totalWidth) ylim <- c(0, totalHeight) if (newpage) grid.newpage() if (!is.null(main) || !is.null(sub)) pushViewport(viewport(height = 1 - 0.1 * sum(!is.null(main), !is.null(sub)), width = 0.9, y = 0.5 - 0.05 * sum(!is.null(main), - !is.null(sub)) ) ) pushViewport(viewport(xscale = xlim, yscale = ylim, width = unit(min(totalWidth / totalHeight, 1), "snpc"), height = unit(min(totalHeight / totalWidth, 1), "snpc"))) o <- odds(x) ## perform logoddsratio-test for each stratum (H0: lor = 0) and adjust p-values if(is.numeric(conf_level) && extended) p.lor.test <- p.adjust(sapply(1 : k, function(i) { u <- abs(log(o$or[i])) / o$se[i] 2 * (1 - pnorm(u)) }), method = p_adjust_method ) scale <- space / (2 * convertY(unit(1, "strheight", "Ag"), "native", valueOnly = TRUE) ) v <- 0.95 - max(convertX(unit(1, "strwidth", as.character(c(x))), "native", valueOnly = TRUE) ) / 2 fontsize = fontsize * scale for(i in 1 : k) { tab <- x[ , , i] fit <- stdize(tab, std, x) xInd <- indexMatrix[i, 2] xOrig <- 2 * xInd - 1 + (3 * xInd - 2) * space yInd <- indexMatrix[i, 1] yOrig <- if(k == 1) (1 + space) else (totalHeight - (2 * yInd - 1 + ((3 + gamma) * yInd - 2) * space)) pushViewport(viewport(xscale = xlim - xOrig, yscale = ylim - yOrig)) ## drawLabels() u <- 1 + space / 2 adjCorr <- 0.2 grid.text( paste(names(dimnames(x))[1], dimnames(x)[[1]][1], sep = sep), 0, u, gp = gpar(fontsize = fontsize), default.units = "native" ) grid.text( paste(names(dimnames(x))[2], dimnames(x)[[2]][1], sep = sep), -u, 0, default.units = "native", gp = gpar(fontsize = fontsize), rot = 90) grid.text( paste(names(dimnames(x))[1], dimnames(x)[[1]][2], sep = sep), 0, -u, gp = gpar(fontsize = fontsize), default.units = "native" ) grid.text( paste(names(dimnames(x))[2], dimnames(x)[[2]][2], sep = sep), u, 0, default.units = "native", gp = gpar(fontsize = fontsize), rot = 90) if (k > 1) { grid.text(if (!varnames) dimnames(x)[[3]][i] else paste(names(dimnames(x))[3], dimnames(x)[[3]][i], sep = sep), 0, 1 + (1 + gamma / 2) * space, gp = gpar(fontsize = fontsize * gamma), default.units = "native" ) } ## drawFrequencies() ### in extended plots, emphasize charts with significant logoddsratios emphasize <- if(extended && is.numeric(conf_level)) 2 * extended * (1 + (p.lor.test[i] < 1 - conf_level)) else 0 d <- odds(tab)$or drawPie(sqrt(fit[1,1]), 90, 180, col = color[1 + (d > 1) + emphasize]) drawPie(sqrt(fit[2,1]), 180, 270, col = color[2 - (d > 1) + emphasize]) drawPie(sqrt(fit[1,2]), 0, 90, col = color[2 - (d > 1) + emphasize]) drawPie(sqrt(fit[2,2]), 270, 360, col = color[1 + (d > 1) + emphasize]) u <- 1 - space / 2 grid.text(as.character(c(tab))[1], -v, u, just = c("left", "top"), gp = gpar(fontsize = fontsize), default.units = "native") grid.text(as.character(c(tab))[2], -v, -u, just = c("left", "bottom"), gp = gpar(fontsize = fontsize), default.units = "native") grid.text(as.character(c(tab))[3], v, u, just = c("right", "top"), gp = gpar(fontsize = fontsize), default.units = "native") grid.text(as.character(c(tab))[4], v, -u, just = c("right", "bottom"), gp = gpar(fontsize = fontsize), default.units = "native") ## draw ticks if(extended && ticks) if(d > 1) { grid.lines(c(sqrt(fit[1,1]) * cos(3*pi/4), (sqrt(fit[1,1]) + ticks) * cos(3*pi/4)), c(sqrt(fit[1,1]) * sin(3*pi/4), (sqrt(fit[1,1]) + ticks) * sin(3*pi/4)), gp = gpar(lwd = 1), default.units = "native" ) grid.lines(c(sqrt(fit[2,2]) * cos(-pi/4), (sqrt(fit[2,2]) + ticks) * cos(-pi/4)), c(sqrt(fit[2,2]) * sin(-pi/4), (sqrt(fit[2,2]) + ticks) * sin(-pi/4)), gp = gpar(lwd = 1), default.units = "native" ) } else { grid.lines(c(sqrt(fit[1,2]) * cos(pi/4), (sqrt(fit[1,2]) + ticks) * cos(pi/4)), c(sqrt(fit[1,2]) * sin(pi/4), (sqrt(fit[1,2]) + ticks) * sin(pi/4)), gp = gpar(lwd = 1), default.units = "native" ) grid.lines(c(sqrt(fit[2,1]) * cos(-3*pi/4), (sqrt(fit[2,1]) + ticks) * cos(-3*pi/4)), c(sqrt(fit[2,1]) * sin(-3*pi/4), (sqrt(fit[2,1]) + ticks) * sin(-3*pi/4)), gp = gpar(lwd = 1), default.units = "native" ) } ## drawConfBands() if(is.numeric(conf_level)) { or <- o$or[i] se <- o$se[i] ## lower theta <- or * exp(qnorm((1 - conf_level) / 2) * se) tau <- findTableWithOAM(theta, tab) r <- sqrt(c(stdize(tau, std, x))) for(j in 1 : 4) drawPie(r[j], angle.f[j], angle.t[j]) ## upper theta <- or * exp(qnorm((1 + conf_level) / 2) * se) tau <- findTableWithOAM(theta, tab) r <- sqrt(c(stdize(tau, std, x))) for(j in 1 : 4) drawPie(r[j], angle.f[j], angle.t[j]) } ## drawBoxes() grid.polygon(c(-1, 1, 1, -1), c(-1, -1, 1, 1), default.units = "native", gp = gpar(fill = "transparent") ) grid.lines(c(-1, 1), c(0, 0), default.units = "native") for(j in seq(from = -0.8, to = 0.8, by = 0.2)) grid.lines(c(j, j), c(-0.02, 0.02), default.units = "native") for(j in seq(from = -0.9, to = 0.9, by = 0.2)) grid.lines(c(j, j), c(-0.01, 0.01), default.units = "native") grid.lines(c(0, 0), c(-1, 1), default.units = "native") for(j in seq(from = -0.8, to = 0.8, by = 0.2)) grid.lines(c(-0.02, 0.02), c(j, j), default.units = "native") for(j in seq(from = -0.9, to = 0.9, by = 0.2)) grid.lines(c(-0.01, 0.01), c(j, j), default.units = "native") popViewport(1) } if(!is.null(main) || !is.null(sub)) { if (!is.null(main)) grid.text(main, y = unit(1, "npc") + unit(1, "lines"), gp = gpar(fontsize = 20, fontface = 2)) if (!is.null(sub)) grid.text(sub, y = unit(0, "npc") - unit(1, "lines"), gp = gpar(fontsize = 20, fontface = 2)) popViewport(1) } popViewport(1) if (return_grob) return(invisible(grid.grab())) else return(invisible(NULL)) } vcd/R/utils.R0000755000175100001440000000006611150520606012531 0ustar hornikusersremove_trailing_comma <- function(x) sub(",$", "", x) vcd/R/assoc.R0000755000175100001440000002717412200255346012515 0ustar hornikusers#################################################################333 ## assocplot assoc <- function(x, ...) UseMethod("assoc") assoc.formula <- function(formula, data = NULL, ..., subset = NULL, na.action = NULL, main = NULL, sub = NULL) { if (is.logical(main) && main) main <- deparse(substitute(data)) else if (is.logical(sub) && sub) sub <- deparse(substitute(data)) assoc.default(structable(formula, data, subset = subset, na.action = na.action), main = main, sub = sub, ...) } assoc.default <- function(x, row_vars = NULL, col_vars = NULL, compress = TRUE, xlim = NULL, ylim = NULL, spacing = spacing_conditional(sp = 0), spacing_args = list(), split_vertical = NULL, keep_aspect_ratio = FALSE, xscale = 0.9, yspace = unit(0.5, "lines"), main = NULL, sub = NULL, ..., residuals_type = "Pearson", gp_axis = gpar(lty = 3) ) { if (is.logical(main) && main) main <- deparse(substitute(x)) else if (is.logical(sub) && sub) sub <- deparse(substitute(x)) if (!inherits(x, "ftable")) x <- structable(x) tab <- as.table(x) dl <- length(dim(tab)) ## spacing cond <- rep(TRUE, dl) cond[length(attr(x, "row.vars")) + c(0, length(attr(x, "col.vars")))] <- FALSE if (inherits(spacing, "grapcon_generator")) spacing <- do.call("spacing", spacing_args) spacing <- spacing(dim(tab), condvars = which(cond)) ## splitting arguments if (is.null(split_vertical)) split_vertical <- attr(x, "split_vertical") if(match.arg(tolower(residuals_type), "pearson") != "pearson") warning("Only Pearson residuals can be visualized with association plots.") strucplot(tab, spacing = spacing, split_vertical = split_vertical, core = struc_assoc(compress = compress, xlim = xlim, ylim = ylim, yspace = yspace, xscale = xscale, gp_axis = gp_axis), keep_aspect_ratio = keep_aspect_ratio, residuals_type = "Pearson", main = main, sub = sub, ...) } ## old code: more elegant conceptually, but less performant ## ## struc_assoc2 <- function(compress = TRUE, xlim = NULL, ylim = NULL, ## yspace = unit(0.5, "lines"), xscale = 0.9, ## gp_axis = gpar(lty = 3)) ## function(residuals, observed = NULL, expected, spacing, gp, split_vertical, prefix = "") { ## dn <- dimnames(expected) ## dnn <- names(dn) ## dx <- dim(expected) ## dl <- length(dx) ## ## axis limits ## resid <- structable(residuals, split_vertical = split_vertical) ## sexpected <- structable(sqrt(expected), split_vertical = split_vertical) ## rfunc <- function(x) c(min(x, 0), max(x, 0)) ## if (is.null(ylim)) ## ylim <- if (compress) ## matrix(apply(as.matrix(resid), 1, rfunc), nrow = 2) ## else ## rfunc(as.matrix(resid)) ## if (!is.matrix(ylim)) ## ylim <- matrix(as.matrix(ylim), nrow = 2, ncol = nrow(as.matrix(resid))) ## attr(ylim, "split_vertical") <- rep(TRUE, sum(!split_vertical)) ## attr(ylim, "dnames") <- dn[!split_vertical] ## class(ylim) <- "structable" ## if(is.null(xlim)) ## xlim <- if (compress) ## matrix(c(-0.5, 0.5) %o% apply(as.matrix(sexpected), 2, max), nrow = 2) ## else ## c(-0.5, 0.5) * max(sexpected) ## if (!is.matrix(xlim)) ## xlim <- matrix(as.matrix(xlim), nrow = 2, ncol = ncol(as.matrix(resid))) ## attr(xlim, "split_vertical") <- rep(TRUE, sum(split_vertical)) ## attr(xlim, "dnames") <- dn[split_vertical] ## class(xlim) <- "structable" ## ## split workhorse ## split <- function(res, sexp, i, name, row, col) { ## v <- split_vertical[i] ## splitbase <- if (v) sexp else res ## splittab <- lapply(seq(dx[i]), function(j) splitbase[[j]]) ## len <- sapply(splittab, function(x) sum(unclass(x)[1,] - unclass(x)[2,])) ## d <- dx[i] ## ## compute total cols/rows and build split layout ## dist <- unit.c(unit(len, "null"), spacing[[i]] + (1 * !v) * yspace) ## idx <- matrix(1:(2 * d), nrow = 2, byrow = TRUE)[-2 * d] ## layout <- if (v) ## grid.layout(ncol = 2 * d - 1, widths = dist[idx]) ## else ## grid.layout(nrow = 2 * d - 1, heights = dist[idx]) ## vproot <- viewport(layout.pos.col = col, layout.pos.row = row, ## layout = layout, name = remove_trailing_comma(name)) ## ## next level: either create further splits, or final viewports ## name <- paste(name, dnn[i], "=", dn[[i]], ",", sep = "") ## rows <- cols <- rep.int(1, d) ## if (v) cols <- 2 * 1:d - 1 else rows <- 2 * 1:d - 1 ## f <- if (i < dl) { ## if (v) ## function(m) split(res, splittab[[m]], i + 1, name[m], rows[m], cols[m]) ## else ## function(m) split(splittab[[m]], sexp, i + 1, name[m], rows[m], cols[m]) ## } else { ## if (v) ## function(m) viewport(layout.pos.col = cols[m], layout.pos.row = rows[m], ## name = remove_trailing_comma(name[m]), ## yscale = unclass(res)[,1], ## xscale = unclass(sexp)[,m], default.units = "null") ## else ## function(m) viewport(layout.pos.col = cols[m], layout.pos.row = rows[m], ## name = remove_trailing_comma(name[m]), ## yscale = unclass(res)[,m], ## xscale = unclass(sexp)[,1], default.units = "null") ## } ## vpleaves <- structure(lapply(1:d, f), class = c("vpList", "viewport")) ## vpTree(vproot, vpleaves) ## } ## ## start spltting on top, creates viewport-tree ## pushViewport(split(ylim, xlim, i = 1, name = paste(prefix, "cell:", sep = ""), ## row = 1, col = 1)) ## ## draw tiles ## mnames <- paste(apply(expand.grid(dn), 1, ## function(i) paste(dnn, i, collapse = ",", sep = "=") ## ) ## ) ## for (i in seq_along(mnames)) { ## seekViewport(paste(prefix, "cell:", mnames[i], sep = "")) ## grid.lines(y = unit(0, "native"), gp = gp_axis) ## grid.rect(y = 0, x = 0, ## height = residuals[i], ## width = xscale * unit(sqrt(expected[i]), "native"), ## default.units = "native", ## gp = structure(lapply(gp, function(x) x[i]), class = "gpar"), ## just = c("center", "bottom"), ## name = paste(prefix, "rect:", mnames[i], sep = "") ## ) ## } ## } ## class(struc_assoc2) <- "grapcon_generator" struc_assoc <- function(compress = TRUE, xlim = NULL, ylim = NULL, yspace = unit(0.5, "lines"), xscale = 0.9, gp_axis = gpar(lty = 3)) function(residuals, observed = NULL, expected, spacing, gp, split_vertical, prefix = "") { if(is.null(expected)) stop("Need expected values.") dn <- dimnames(expected) dnn <- names(dn) dx <- dim(expected) dl <- length(dx) ## axis limits resid <- structable(residuals, split_vertical = split_vertical) sexpected <- structable(sqrt(expected), split_vertical = split_vertical) rfunc <- function(x) c(min(x, 0), max(x, 0)) if (is.null(ylim)) ylim <- if (compress) matrix(apply(as.matrix(resid), 1, rfunc), nrow = 2) else rfunc(as.matrix(resid)) if (!is.matrix(ylim)) ylim <- matrix(as.matrix(ylim), nrow = 2, ncol = nrow(as.matrix(resid))) ylim[2,] <- ylim[2,] + .Machine$double.eps attr(ylim, "split_vertical") <- rep(TRUE, sum(!split_vertical)) attr(ylim, "dnames") <- dn[!split_vertical] class(ylim) <- "structable" if(is.null(xlim)) xlim <- if (compress) matrix(c(-0.5, 0.5) %o% apply(as.matrix(sexpected), 2, max), nrow = 2) else c(-0.5, 0.5) * max(sexpected) if (!is.matrix(xlim)) xlim <- matrix(as.matrix(xlim), nrow = 2, ncol = ncol(as.matrix(resid))) attr(xlim, "split_vertical") <- rep(TRUE, sum(split_vertical)) attr(xlim, "dnames") <- dn[split_vertical] class(xlim) <- "structable" ## split workhorse split <- function(res, sexp, i, name, row, col, index) { v <- split_vertical[i] d <- dx[i] splitbase <- if (v) sexp else res splittab <- lapply(seq(d), function(j) splitbase[[j]]) len <- abs(sapply(splittab, function(x) sum(unclass(x)[1,] - unclass(x)[2,]))) ## compute total cols/rows and build split layout dist <- if (d > 1) unit.c(unit(len, "null"), spacing[[i]] + (1 * !v) * yspace) else unit(len, "null") idx <- matrix(1:(2 * d), nrow = 2, byrow = TRUE)[-2 * d] layout <- if (v) grid.layout(ncol = 2 * d - 1, widths = dist[idx]) else grid.layout(nrow = 2 * d - 1, heights = dist[idx]) pushViewport(viewport(layout.pos.col = col, layout.pos.row = row, layout = layout, name = paste(prefix, "cell:", remove_trailing_comma(name), sep = ""))) ## next level: either create further splits, or final viewports rows <- cols <- rep.int(1, d) if (v) cols <- 2 * 1:d - 1 else rows <- 2 * 1:d - 1 for (m in 1:d) { nametmp <- paste(name, dnn[i], "=", dn[[i]][m], ",", sep = "") if (i < dl) { if (v) sexp <- splittab[[m]] else res <- splittab[[m]] split(res, sexp, i + 1, nametmp, rows[m], cols[m], cbind(index, m)) } else { pushViewport(viewport(layout.pos.col = cols[m], layout.pos.row = rows[m], name = paste(prefix, "cell:", remove_trailing_comma(nametmp), sep = ""), yscale = unclass(res)[,if (v) 1 else m], xscale = unclass(sexp)[,if (v) m else 1], default.units = "npc") ) ## draw tiles grid.lines(y = unit(0, "native"), gp = gp_axis) grid.rect(y = 0, x = 0, height = residuals[cbind(index, m)], width = xscale * unit(sqrt(expected[cbind(index, m)]), "native"), default.units = "native", gp = structure(lapply(gp, function(x) x[cbind(index,m)]), class = "gpar"), just = c("center", "bottom"), name = paste(prefix, "rect:", remove_trailing_comma(nametmp), sep = "") ) } upViewport(1) } } split(ylim, xlim, i = 1, name = "", row = 1, col = 1, index = cbind()) } class(struc_assoc) <- "grapcon_generator" vcd/R/tile.R0000655000175100001440000001446512466747451012361 0ustar hornikuserstile <- function(x, ...) UseMethod("tile") tile.formula <- function(formula, data = NULL, ..., main = NULL, sub = NULL, subset = NULL, na.action = NULL) { if (is.logical(main) && main) main <- deparse(substitute(data)) else if (is.logical(sub) && sub) sub <- deparse(substitute(data)) m <- match.call(expand.dots = FALSE) edata <- eval(m$data, parent.frame()) fstr <- strsplit(paste(deparse(formula), collapse = ""), "~") vars <- strsplit(strsplit(gsub(" ", "", fstr[[1]][2]), "\\|")[[1]], "\\+") varnames <- vars[[1]] dep <- gsub(" ", "", fstr[[1]][1]) if (!dep %in% c("","Freq")) { if (all(varnames == ".")) { varnames <- if (is.data.frame(data)) colnames(data) else names(dimnames(as.table(data))) varnames <- varnames[-which(varnames %in% dep)] } varnames <- c(varnames, dep) } if (inherits(edata, "ftable") || inherits(edata, "table") || length(dim(edata)) > 2) { dat <- as.table(data) if(all(varnames != ".")) { ind <- match(varnames, names(dimnames(dat))) if (any(is.na(ind))) stop(paste("Can't find", paste(varnames[is.na(ind)], collapse=" / "), "in", deparse(substitute(data)))) dat <- margin.table(dat, ind) } tile.default(dat, main = main, sub = sub, ...) } else { m <- m[c(1, match(c("formula", "data", "subset", "na.action"), names(m), 0))] m[[1]] <- as.name("xtabs") m$formula <- formula(paste(if("Freq" %in% colnames(data)) "Freq", "~", paste(varnames, collapse = "+"))) tab <- eval(m, parent.frame()) tile.default(tab, main = main, sub = sub, ...) } } tile.default <- function(x, tile_type = c("area", "squaredarea", "height", "width"), halign = c("left", "center", "right"), valign = c("bottom", "center", "top"), split_vertical = NULL, shade = FALSE, spacing = spacing_equal(unit(1, "lines")), set_labels = NULL, margins = unit(3, "lines"), keep_aspect_ratio = FALSE, legend = NULL, legend_width = NULL, squared_tiles = TRUE, main = NULL, sub = NULL, ...) { ## argument handling if (is.logical(main) && main) main <- deparse(substitute(x)) else if (is.logical(sub) && sub) sub <- deparse(substitute(x)) tile_type <- match.arg(tile_type) halign <- match.arg(halign) valign <- match.arg(valign) x <- as.table(x) dl <- length(d <- dim(x)) ## determine starting positions xpos <- 1 - (halign == "left") - 0.5 * (halign == "center") ypos <- 1 - (valign == "bottom") - 0.5 * (valign == "center") ## heuristic to adjust right/bottom margin to obtain squared tiles ## FIXME: better push another viewport? if (squared_tiles) { ## splitting argument if (is.structable(x) && is.null(split_vertical)) split_vertical <- attr(x, "split_vertical") if (is.null(split_vertical)) split_vertical <- FALSE if (length(split_vertical) == 1) split_vertical <- rep(c(split_vertical, !split_vertical), length.out = dl) if (length(split_vertical) < dl) split_vertical <- rep(split_vertical, length.out = dl) ## compute resulting dimnension dflat <- dim(unclass(structable(x, split_vertical = split_vertical))) ## adjust margins spacing <- spacing(d) delta <- abs(dflat[1] - dflat[2]) fac <- delta / max(dflat) un <- unit(fac, "npc") - unit(fac * 5 / spacing[[1]][[1]], "lines") leg <- if (shade) { if (is.null(legend_width)) unit(5, "lines") else legend_width } else unit(0, "npc") if (dflat[1] < dflat[2]) margins <- margins + unit.c(unit(0, "npc"), unit(0, "npc"), un + leg, unit(0, "npc")) if (dflat[1] > dflat[2]) margins <- margins + unit.c(unit(0, "npc"), un - leg, unit(0, "npc"), unit(0, "npc")) if (dflat[1] == dflat[2]) margins <- margins + unit.c(unit(0, "npc"), unit(0, "npc"), leg, unit(0, "npc")) } ## create dummy labels if some are duplicated ## and set the labels via set_labels dn <- dimnames(x) if (any(unlist(lapply(dn, duplicated)))) { dimnames(x) <- lapply(dn, seq_along) if (is.null(set_labels)) set_labels <- lapply(dn, function(i) structure(i, names = seq(i))) } ## workhorse function creating bars panelfun <- function(residuals, observed, expected, index, gp, name) { xprop <- expected / max(expected) if (tile_type == "height") grid.rect(x = xpos, y = ypos, height = xprop[t(index)], width = 1, gp = gp, just = c(halign, valign), name = name) else if (tile_type == "width") grid.rect(x = xpos, y = ypos, width = xprop[t(index)], height = 1, gp = gp, just = c(halign, valign), name = name) else if (tile_type == "area") grid.rect(x = xpos, y = ypos, width = sqrt(xprop[t(index)]), height = sqrt(xprop[t(index)]), gp = gp, just = c(halign, valign), name = name) else grid.rect(x = xpos, y = ypos, width = xprop[t(index)], height = xprop[t(index)], gp = gp, just = c(halign, valign), name = name) } mycore <- function(residuals, observed, expected = NULL, spacing, gp, split_vertical, prefix = "") { struc_mosaic(panel = panelfun)(residuals, array(1, dim = d, dimnames = dimnames(observed)), expected = observed, spacing, gp, split_vertical, prefix) } strucplot(x, core = mycore, spacing = spacing, keep_aspect_ratio = keep_aspect_ratio, margins = margins, shade = shade, legend = legend, legend_width = legend_width, main = main, sub = sub, set_labels = set_labels, ...) } vcd/R/structable.R0000644000175100001440000004367412264547557013577 0ustar hornikusers######################################### ## structable structable <- function(x, ...) UseMethod("structable") structable.formula <- function(formula, data = NULL, direction = NULL, split_vertical = NULL, ..., subset, na.action) { if (missing(formula) || !inherits(formula, "formula")) stop("formula is incorrect or missing") m <- match.call(expand.dots = FALSE) edata <- eval(m$data, parent.frame()) if (!is.null(direction)) split_vertical <- direction == "v" if (is.structable(data)) { split_vertical <- attr(data, "split_vertical") data <- as.table(data) } if (is.null(split_vertical)) split_vertical <- FALSE if (length(formula) == 3 && formula[[2]] == "Freq") formula[[2]] = NULL ## only rhs present without `.' in lhs => xtabs-interface if (length(formula) != 3) { if (formula[[1]] == "~") { if (inherits(edata, "ftable") || inherits(edata, "table") || length(dim(edata)) > 2) { data <- as.table(data) varnames <- attr(terms(formula, allowDotAsName = TRUE), "term.labels") dnames <- names(dimnames(data)) di <- match(varnames, dnames) if (any(is.na(di))) stop("incorrect variable names in formula") if (all(varnames != ".")) data <- margin.table(data, di) return(structable(data, split_vertical = split_vertical, ...)) } else if (is.data.frame(data)) { if ("Freq" %in% colnames(data)) return(structable(xtabs(formula(paste("Freq", deparse(formula))), data = data), split_vertical = split_vertical, ...)) else return(structable(xtabs(formula, data), split_vertical = split_vertical, ...)) } else { if (is.matrix(edata)) m$data <- as.data.frame(data) m$... <- m$split_vertical <- m$direction <- NULL m[[1]] <- as.name("model.frame") mf <- eval(m, parent.frame()) return(structable(table(mf), split_vertical = split_vertical, ...)) } } else stop("formula must have both left and right hand sides") } ## `ftable' behavior if (any(attr(terms(formula, allowDotAsName = TRUE), "order") > 1)) stop("interactions are not allowed") rvars <- attr(terms(formula[-2], allowDotAsName = TRUE), "term.labels") cvars <- attr(terms(formula[-3], allowDotAsName = TRUE), "term.labels") rhs.has.dot <- any(rvars == ".") lhs.has.dot <- any(cvars == ".") if (lhs.has.dot && rhs.has.dot) stop(paste("formula has", sQuote("."), "in both left and right hand side")) if (inherits(edata, "ftable") || inherits(edata, "table") || length(dim(edata)) > 2) { if (inherits(edata, "ftable")) data <- as.table(data) dnames <- names(dimnames(data)) rvars <- pmatch(rvars, dnames) cvars <- pmatch(cvars, dnames) if (rhs.has.dot) rvars <- seq_along(dnames)[-cvars] else if (any(is.na(rvars))) stop("incorrect variable names in rhs of formula") if (lhs.has.dot) cvars <- seq_along(dnames)[-rvars] else if (any(is.na(cvars))) stop("incorrect variable names in lhs of formula") split_vertical <- c(rep(FALSE, length(rvars)), rep(TRUE, length(cvars))) structable(margin.table(data, c(rvars, cvars)), split_vertical = split_vertical, ...) } else { if (is.matrix(edata)) m$data <- as.data.frame(data) m$... <- m$split_vertical <- m$direction <- NULL if (!is.null(data) && is.environment(data)) { dnames <- names(data) if (rhs.has.dot) rvars <- seq_along(dnames)[-cvars] if (lhs.has.dot) cvars <- seq_along(dnames)[-rvars] } else { if (lhs.has.dot || rhs.has.dot) stop("cannot use dots in formula with given data") } if ("Freq" %in% colnames(m$data)) m$formula <- formula(paste("Freq~", paste(c(rvars, cvars), collapse = "+"))) else m$formula <- formula(paste("~", paste(c(rvars, cvars), collapse = "+"))) m[[1]] <- as.name("xtabs") mf <- eval(m, parent.frame()) split_vertical <- c(rep(FALSE, length(rvars)), rep(TRUE, length(cvars))) structable(mf, split_vertical = split_vertical, ...) } } structable.default <- function(..., direction = NULL, split_vertical = FALSE) { ## several checks & transformations for arguments args <- list(...) if (length(args) == 0) stop("Nothing to tabulate") x <- args[[1]] x <- if (is.list(x)) table(x) else if (inherits(x, "ftable")) as.table(x) else if (!(is.array(x) && length(dim(x)) > 1 || inherits(x, "table"))) do.call("table", as.list(substitute(list(...)))[-1]) else x if (is.null(dimnames(x))) dimnames(x) <- lapply(dim(x), function(i) letters[seq_len(i)]) if (is.null(names(dimnames(x)))) names(dimnames(x)) <- LETTERS[seq_along(dim(x))] idx <- sapply(names(dimnames(x)), nchar) < 1 if(any(idx)) names(dimnames(x))[idx] <- LETTERS[seq_len(sum(idx))] ## splitting argument dl <- length(dim(x)) if (!is.null(direction)) split_vertical <- direction == "v" if (length(split_vertical) == 1) split_vertical <- rep(c(split_vertical, !split_vertical), length.out = dl) if (length(split_vertical) < dl) split_vertical <- rep(split_vertical, length.out = dl) ## permute & reshape ret <- base::aperm(x, c(rev(which(!split_vertical)), rev(which(split_vertical)))) dn <- dimnames(x) rv <- dn[split_vertical] cv <- dn[!split_vertical] rl <- if (length(rv)) sapply(rv, length) else 1 cl <- if (length(cv)) sapply(cv, length) else 1 dim(ret) <- c(prod(cl), prod(rl)) ## add dimnames attr(ret, "dnames") <- dn attr(ret, "split_vertical") <- split_vertical ## add dimension attributes in ftable-format attr(ret, "col.vars") <- rv attr(ret, "row.vars") <- cv class(ret) <- c("structable", "ftable") ret } "[[.structable" <- function(x, ...) { if(nargs() > 3) stop("Incorrect number of dimensions (max: 2).") args <- if (nargs() < 3) list(..1) else .massage_args(...) args <- lapply(args, function(x) if (is.logical(x)) which(x) else x) ## handle one-arg cases if (nargs() < 3) if (length(args[[1]]) > 1) ## resolve calls like x[[c(1,2)]] return(x[[ args[[1]][1] ]] [[ args[[1]][-1] ]]) else ## resolve x[[foo]] return(if (attr(x, "split_vertical")[1]) x[[,args[[1]] ]] else x[[args[[1]],]]) ## handle calls like x[[c(1,2), c(3,4)]] if (length(args[[1]]) > 1 && length(args[[2]]) > 1) return(x[[ args[[1]][1], args[[2]][1] ]] [[ args[[1]][-1], args[[2]][-1] ]]) ## handle calls like x[[c(1,2), 3]] if (length(args[[1]]) > 1) return(x[[ args[[1]][1], args[[2]] ]] [[ args[[1]][-1], ]]) ## handle calls like x[[1, c(1,3)]] if (length(args[[2]]) > 1) return(x[[ args[[1]], args[[2]][1] ]] [[ , args[[2]][-1] ]]) ## final cases like x[[1,2]] or x[[1,]] or x[[,1]] dnames <- attr(x, "dnames") split <- attr(x, "split_vertical") rv <- dnames[!split] cv <- dnames[split] lsym <- is.symbol(args[[1]]) rsym <- is.symbol(args[[2]]) if (!lsym) { rstep <- dim(unclass(x))[1] / length(rv[[1]]) if (is.character(args[[1]])) args[[1]] <- match(args[[1]], rv[[1]]) } if (!rsym) { cstep <- dim(unclass(x))[2] / length(cv[[1]]) if (is.character(args[[2]])) args[[2]] <- match(args[[2]], cv[[1]]) } lind <- if (!lsym) (1 + (args[[1]] - 1) * rstep) : (args[[1]] * rstep) else 1:nrow(unclass(x)) rind <- if (!rsym) (1 + (args[[2]] - 1) * cstep) : (args[[2]] * cstep) else 1:ncol(unclass(x)) ret <- unclass(x)[lind, rind, drop = FALSE] if (!lsym) { i <- which(!split)[1] split <- split[-i] dnames <- dnames[-i] } if (!rsym) { i <- which(split)[1] split <- split[-i] dnames <- dnames[-i] } attr(ret, "split_vertical") <- split attr(ret, "dnames") <- dnames ## add dimension attributes in ftable-format attr(ret, "col.vars") <- dnames[split] attr(ret, "row.vars") <- dnames[!split] class(ret) <- class(x) ret } "[[<-.structable" <- function(x, ..., value) { args <- if (nargs() < 4) list(..1) else .massage_args(...) ## handle one-arg cases if (nargs() < 4) return(if (length(args[[1]]) > 1) ## resolve calls like x[[c(1,2)]]<-value Recall(x, args[[1]][1], value = Recall(x[[ args[[1]][1] ]], args[[1]][-1], value = value)) else ## resolve x[[foo]]<-value if (attr(x, "split_vertical")[1]) Recall(x,,args[[1]], value = value) else Recall(x,args[[1]],, value = value) ) ## handle calls like x[[c(1,2), c(3,4)]]<-value if (length(args[[1]]) > 1 && length(args[[2]]) > 1) return(Recall(x, args[[1]][1], args[[2]][1], value = Recall(x[[ args[[1]][1], args[[2]][1] ]], args[[1]][-1], args[[2]][-1], value = value))) ## handle calls like x[[c(1,2), 3]]<-value if (length(args[[1]]) > 1) return(Recall(x, args[[1]][1], args[[2]], value = Recall(x[[ args[[1]][1], args[[2]] ]], args[[1]][-1], ,value = value))) ## handle calls like x[[1, c(1,3)]]<-value if (length(args[[2]]) > 1) return(Recall(x, args[[1]], args[[2]][1], value = Recall(x[[ args[[1]], args[[2]][1] ]],, args[[2]][-1], value = value))) ## final cases like x[[1,2]]<-value or x[[1,]]<-value or x[[,1]]<-value dnames <- attr(x, "dnames") split <- attr(x, "split_vertical") rv <- dnames[!split] cv <- dnames[split] lsym <- is.symbol(args[[1]]) rsym <- is.symbol(args[[2]]) if (!lsym) { rstep <- dim(unclass(x))[1] / length(rv[[1]]) if (is.character(args[[1]])) args[[1]] <- match(args[[1]], rv[[1]]) } if (!rsym) { cstep <- dim(unclass(x))[2] / length(cv[[1]]) if (is.character(args[[2]])) args[[2]] <- match(args[[2]], cv[[1]]) } lind <- if (!lsym) (1 + (args[[1]] - 1) * rstep) : (args[[1]] * rstep) else 1:nrow(unclass(x)) rind <- if (!rsym) (1 + (args[[2]] - 1) * cstep) : (args[[2]] * cstep) else 1:ncol(unclass(x)) ret <- unclass(x) ret[lind, rind] <- value class(ret) <- class(x) ret } "[.structable" <- function(x, ...) { if(nargs() > 3) stop("Incorrect number of dimensions (max: 2).") args <- if (nargs() < 3) list(..1) else .massage_args(...) args <- lapply(args, function(x) if (is.logical(x)) which(x) else x) ## handle one-arg cases if (nargs() < 3) return(if (attr(x, "split_vertical")[1]) x[,args[[1]] ] else x[args[[1]],]) ## handle calls like x[c(1,2), foo] if (length(args[[1]]) > 1) return(do.call(rbind, lapply(args[[1]], function(i) x[i, args[[2]]]))) ## handle calls like x[foo, c(1,3)] if (length(args[[2]]) > 1) return(do.call(cbind, lapply(args[[2]], function(i) x[args[[1]], i]))) ## final cases like x[1,2] or x[1,] or x[,1] dnames <- attr(x, "dnames") split <- attr(x, "split_vertical") rv <- dnames[!split] cv <- dnames[split] lsym <- is.symbol(args[[1]]) rsym <- is.symbol(args[[2]]) if (!lsym) { rstep <- dim(unclass(x))[1] / length(rv[[1]]) if (is.character(args[[1]])) args[[1]] <- match(args[[1]], rv[[1]]) } if (!rsym) { cstep <- dim(unclass(x))[2] / length(cv[[1]]) if (is.character(args[[2]])) args[[2]] <- match(args[[2]], cv[[1]]) } lind <- if (!lsym) (1 + (args[[1]] - 1) * rstep) : (args[[1]] * rstep) else 1:nrow(unclass(x)) rind <- if (!rsym) (1 + (args[[2]] - 1) * cstep) : (args[[2]] * cstep) else 1:ncol(unclass(x)) ret <- unclass(x)[lind, rind, drop = FALSE] if (!lsym) { i <- which(!split)[1] dnames[[i]] <- dnames[[i]][args[[1]]] } if (!rsym) { i <- which(split)[1] dnames[[i]] <- dnames[[i]][args[[2]]] } attr(ret, "split_vertical") <- split attr(ret, "dnames") <- dnames ## add dimension attributes in ftable-format attr(ret, "col.vars") <- dnames[split] attr(ret, "row.vars") <- dnames[!split] class(ret) <- class(x) ret } "[<-.structable" <- function(x, ..., value) { args <- if (nargs() < 4) list(..1) else .massage_args(...) ## handle one-arg cases if (nargs() < 4) return(## resolve x[foo] if (attr(x, "split_vertical")[1]) Recall(x,,args[[1]], value = value) else Recall(x,args[[1]],, value = value) ) ## handle calls like x[c(1,2), 3] if (length(args[[1]]) > 1) { for (i in seq_along(args[[1]])) x[ args[[1]][i], args[[2]] ] <- value[i,] return(x) } ## handle calls like x[1, c(2,3)] if (length(args[[2]]) > 1) { for (i in seq_along(args[[2]])) x[ args[[1]], args[[2]][i] ] <- value[,i] return(x) } ## final cases like x[1,2] or x[1,] or x[,1] dnames <- attr(x, "dnames") split <- attr(x, "split_vertical") rv <- dnames[!split] cv <- dnames[split] lsym <- is.symbol(args[[1]]) rsym <- is.symbol(args[[2]]) if (!lsym) { rstep <- dim(unclass(x))[1] / length(rv[[1]]) if (is.character(args[[1]])) args[[1]] <- match(args[[1]], rv[[1]]) } if (!rsym) { cstep <- dim(unclass(x))[2] / length(cv[[1]]) if (is.character(args[[2]])) args[[2]] <- match(args[[2]], cv[[1]]) } lind <- if (!lsym) (1 + (args[[1]] - 1) * rstep) : (args[[1]] * rstep) else 1:nrow(unclass(x)) rind <- if (!rsym) (1 + (args[[2]] - 1) * cstep) : (args[[2]] * cstep) else 1:ncol(unclass(x)) ret <- unclass(x) ret[lind, rind] <- value class(ret) <- class(x) ret } cbind.structable <- function(..., deparse.level = 1) { mergetables <- function(t1, t2) { ret <- cbind(unclass(t1),unclass(t2)) class(ret) <- class(t1) attr(ret, "split_vertical") <- attr(t1, "split_vertical") attr(ret, "dnames") <- attr(t1, "dnames") attr(ret, "row.vars") <- attr(t1, "row.vars") attr(ret, "col.vars") <- attr(t1, "col.vars") attr(ret, "col.vars")[[1]] <- c(attr(t1, "col.vars")[[1]],attr(t2, "col.vars")[[1]]) if (length(unique(attr(ret, "col.vars")[[1]])) != length(attr(ret, "col.vars")[[1]])) stop("Levels of factor(s) to be merged must be unique.") attr(ret, "dnames")[names(attr(ret, "col.vars"))] <- attr(ret, "col.vars") ret } args <- list(...) if (length(args) < 2) return(args[[1]]) ret <- mergetables(args[[1]], args[[2]]) if (length(args) > 2) do.call(cbind, c(list(ret), args[-(1:2)])) else ret } rbind.structable <- function(..., deparse.level = 1) { mergetables <- function(t1, t2) { ret <- rbind(unclass(t1),unclass(t2)) class(ret) <- class(t1) attr(ret, "split_vertical") <- attr(t1, "split_vertical") attr(ret, "dnames") <- attr(t1, "dnames") attr(ret, "row.vars") <- attr(t1, "row.vars") attr(ret, "col.vars") <- attr(t1, "col.vars") attr(ret, "row.vars")[[1]] <- c(attr(t1, "row.vars")[[1]],attr(t2, "row.vars")[[1]]) if (length(unique(attr(ret, "row.vars")[[1]])) != length(attr(ret, "row.vars")[[1]])) stop("Levels of factor(s) to be merged must be unique.") attr(ret, "dnames")[names(attr(ret, "row.vars"))] <- attr(ret, "row.vars") ret } args <- list(...) if (length(args) < 2) return(args[[1]]) ret <- mergetables(args[[1]], args[[2]]) if (length(args) > 2) do.call(rbind, c(list(ret), args[-(1:2)])) else ret } as.table.structable <- function(x, ...) { class(x) <- "ftable" ret <- NextMethod("as.table", object = x) structure(base::aperm(ret, match(names(attr(x, "dnames")), names(dimnames(ret)))), class = "table") } plot.structable <- function(x, ...) mosaic(x, ...) t.structable <- function(x) { ret <- t.default(x) attr(ret, "split_vertical") <- !attr(ret, "split_vertical") hold <- attr(ret, "row.vars") attr(ret, "row.vars") = attr(ret, "col.vars") attr(ret, "col.vars") = hold ret } is.structable <- function(x) inherits(x, "structable") dim.structable <- function(x) as.integer(sapply(attr(x, "dnames"), length)) print.structable <- function(x, ...) { class(x) <- "ftable" NextMethod("print", object = x) } dimnames.structable <- function(x) attr(x,"dnames") as.vector.structable <- function(x, ...) as.vector(as.table(x), ...) ## FIXME: copy as.matrix.ftable, committed to R-devel on 2014/1/12 ## replace by call to as.matrix.ftable when this becomes stable as_matrix_ftable <- function (x, sep = "_", ...) { if (!inherits(x, "ftable")) stop("'x' must be an \"ftable\" object") make_dimnames <- function(vars) { structure(list(do.call(paste, c(rev(expand.grid(rev(vars))), list(sep = sep)))), names = paste(collapse = sep, names(vars))) } structure(unclass(x), dimnames = c(make_dimnames(attr(x, "row.vars")), make_dimnames(attr(x, "col.vars"))), row.vars = NULL, col.vars = NULL) } as.matrix.structable <- function(x, sep="_", ...) { structure(as_matrix_ftable(x, sep, ...), dnames = NULL, split_vertical = NULL ) } length.structable <- function(x) dim(x)[1] is.na.structable <- function(x) sapply(seq_along(x), function(sub) any(is.na(sub))) str.structable <- function(object, ...) str(unclass(object), ...) find.perm <- function(vec1, vec2) { unlist(Map(function(x) which(x == vec2), vec1)) } aperm.structable <- function(a, perm, resize=TRUE, ...){ newtable <- aperm(as.table(a), perm = perm, resize = resize, ...) if (!is.numeric(perm)) perm <- find.perm(names(dimnames(newtable)), names(dimnames(a))) structable(newtable, split_vertical = attr(a, "split_vertical")[perm]) } ############# helper function .massage_args <- function(...) { args <- vector("list", 2) args[[1]] <- if(missing(..1)) as.symbol("grrr") else ..1 args[[2]] <- if(missing(..2)) as.symbol("grrr") else ..2 args } vcd/R/binregplot.R0000644000175100001440000002546412503645151013552 0ustar hornikusersbinreg_plot <- function(model, main = NULL, xlab = NULL, ylab = NULL, xlim = NULL, ylim = NULL, pred_var = NULL, pred_range = c("data", "xlim"), group_vars = NULL, base_level = NULL, subset, type = c("response", "link"), conf_level = 0.95, delta = FALSE, pch = NULL, cex = 0.6, jitter_factor = 0.1, lwd = 5, lty = 1, point_size = 0, col_lines = NULL, col_bands = NULL, legend = TRUE, legend_pos = NULL, legend_inset = c(0, 0.1), legend_vgap = unit(0.5, "lines"), labels = FALSE, labels_pos = c("right", "left"), labels_just = c("left","center"), labels_offset = c(0.01, 0), gp_main = gpar(fontface = "bold", fontsize = 14), gp_legend_frame = gpar(lwd = 1, col = "black"), gp_legend_title = gpar(fontface = "bold"), newpage = TRUE, pop = FALSE, return_grob = FALSE) { if (!inherits(model, "glm")) stop("Method requires a model of class 'glm'.") type <- match.arg(type) labels_pos <- match.arg(labels_pos) if (is.character(pred_range)) pred_range <- match.arg(pred_range) ## extract data from model mod <- model.frame(model) term <- terms(mod) data.classes <- attr(term, "dataClasses") nam <- names(data.classes) ## determine response r <- attr(term, "response") resp <- nam[r] data.classes <- data.classes[-r] nam <- nam[-r] ## determine numeric predictor (take first) if (is.null(pred_var)) { fac <- data.classes %in% c("factor","logical") pred_var_model <- names(data.classes[!fac][1]) pred_var <- names(unlist(sapply(all.vars(term), grep, pred_var_model)))[1] } else pred_var_model <- pred_var ## filter observed data using model (to account for models fitted with subset=...) dat <- model$data[row.names(mod),] ## sort observations using order of numeric predictor o <- order(dat[,pred_var]) mod <- mod[o,] dat <- dat[o,] ## apply subset argument, if any if (!missing(subset)) { e <- substitute(subset) i <- eval(e, dat, parent.frame()) i <- i & !is.na(i) dat <- dat[i,] mod <- mod[i,] } ## determine conditioning variables. Remove all those with only one level observed. if (is.null(group_vars)) { group_vars <- nam[data.classes %in% "factor"] sing <- na.omit(sapply(dat, function(i) all(i == i[1]))) if (any(sing)) group_vars <- setdiff(group_vars, names(sing)[sing]) if(length(group_vars) < 1) group_vars <- NULL } else if (is.na(group_vars) || is.logical(group_vars) && !group_vars[1]) group_vars <- NULL ## set y axis limits - either probability or logit scale if(is.null(ylim)) ylim <- if (type == "response") c(0,1) else range(predict(model, dat, type = "link")) ## allow for some cosmetic extra space ylimaxis <- ylim + c(-1, 1) * diff(ylim) * 0.04 if(is.null(xlim)) xlim <- if (is.numeric(pred_range)) range(pred_range) else range(dat[,pred_var]) xlimaxis <- xlim + c(-1, 1) * diff(xlim) * 0.04 ## set default base level ("no effect") of response to first level/0 if (is.null(base_level)) base_level <- if(is.matrix(mod[,resp])) 2 else if(is.factor(mod[,resp])) levels(mod[,resp])[1] else 0 if (is.matrix(mod[,resp]) && is.character(base_level)) base_level <- switch(base_level, success =, Success = 1, failure =, Failure = 2) ## determine labels of conditioning variables, if any if (is.null(group_vars)) { labels <- legend <- FALSE } else { ## compute cross-factors for more than two conditioning variables if (length(group_vars) > 1) { cross <- paste(group_vars, collapse = " x ") dat[,cross] <- factor(apply(dat[,group_vars], 1, paste, collapse = " : ")) group_vars <- cross } lev <- levels(dat[,group_vars]) } ## set x- and y-lab if (is.null(xlab)) xlab <- pred_var if (is.null(ylab)) ylab <- if (type == "response") { if (is.matrix(mod[,resp])) paste0("P(", c("Failure","Success")[base_level], ")") else paste0("P(", resp, ")") } else { if (is.matrix(mod[,resp])) paste0("logit(", c("Failure","Success")[base_level], ")") else paste0("logit(", resp, ")") } ## rearrange default plot symbol palette if (is.null(pch)) pch <- c(19,15,17, 1:14, 16, 18, 20:25) ## determine normal quantile for confidence band quantile <- qnorm((1 + conf_level) / 2) ## determine default legend position, given the curve's slope ## (positive -> topleft, negative -> topright) if (is.null(legend_pos)) legend_pos <- if (coef(model)[grep(pred_var, names(coef(model)))[1]] > 0) "topleft" else "topright" ## work horse for drawing points, fitted curve and confidence band draw <- function(ind, colband, colline, pch, label) { ## plot observed data as points on top or bottom ycoords <- if (is.matrix(mod[,resp])) { tmp <- prop.table(mod[ind,resp], 1)[,switch(base_level, 2, 1)] if (type == "link") family(model)$linkfun(tmp) else tmp } else jitter(ylim[1 + (mod[ind, resp] != base_level)], jitter_factor) if (cex > 0) grid.points(unit(dat[ind, pred_var], "native"), unit(ycoords, "native"), pch = pch, size = unit(cex, "char"), gp = gpar(col = colline), default.units = "native" ) ## confidence band and fitted values typ <- if (type == "response" && !delta) "link" else type if (is.character(pred_range)) { if (pred_range == "data") { D <- dat[ind,] P <- D[,pred_var] } else { P <- seq(from = xlim[1L], to = xlim[2L], length.out = 100L) D <- dat[ind,][rep(1L, length(P)),] D[,pred_var] <- P } } else { P <- pred_range D <- dat[ind,][rep(1L, length(P)),] D[,pred_var] <- P } pr <- predict(model, D, type = typ, se.fit = TRUE) lower <- pr$fit - quantile * pr$se.fit upper <- pr$fit + quantile * pr$se.fit if (type == "response" && !delta) { lower <- family(model)$linkinv(lower) upper <- family(model)$linkinv(upper) pr$fit <- family(model)$linkinv(pr$fit) } if (type == "response") { ## cut probs at unit interval lower[lower < 0] <- 0 upper[upper > 1] <- 1 } grid.polygon(unit(c(P, rev(P)), "native"), unit(c(lower, rev(upper)), "native"), gp = gpar(fill = colband, col = NA)) grid.lines(unit(P, "native"), unit(pr$fit, "native"), gp = gpar(col = colline, lwd = lwd, lty = lty)) if (point_size > 0) grid.points(unit(P, "native"), unit(pr$fit, "native"), pch = pch, size = unit(point_size, "char"), gp = gpar(col = colline)) ## add labels, if any if (labels) { x = switch(labels_pos, left = P[1], right = P[length(P)]) y = switch(labels_pos, left = pr$fit[1], right = pr$fit[length(pr$fit)]) grid.text(x = unit(x, "native") + unit(labels_offset[1], "npc"), y = unit(y, "native") + unit(labels_offset[2], "npc"), label = label, just = labels_just, gp = gpar(col = colline)) } } ## determine colors and plot symbols llev <- if (is.null(group_vars)) 1 else length(lev) pch <- rep(pch, length.out = llev) if (is.null(col_bands)) col_bands <- colorspace::rainbow_hcl(llev, alpha = 0.2) if (is.null(col_lines)) col_lines <- colorspace::rainbow_hcl(llev, l = 50) ## set up plot region, similar to plot.xy() if (newpage) grid.newpage() pushViewport(plotViewport(xscale = xlimaxis, yscale = ylimaxis, default.units = "native", name = "binreg_plot")) grid.rect(gp = gpar(fill = "transparent")) grid.xaxis() grid.yaxis() grid.text(xlab, y = unit(-3.5, "lines")) grid.text(ylab, x = unit(-3, "lines"), rot = 90) grid.text(main, y = unit(1, "npc") + unit(2, "lines"), gp = gp_main) pushViewport(viewport(xscale = xlimaxis, yscale = ylimaxis, default.units = "native", clip = "on")) ## draw fitted curve(s) if (is.null(group_vars)) { ## single curve draw(1:nrow(dat), col_bands, col_lines, pch[1]) } else { ## multiple curves for (i in seq_along(lev)) { ind <- dat[,group_vars] == lev[i] draw(ind, col_bands[i], col_lines[i], pch[i], lev[i]) } if (legend) grid_legend(legend_pos, labels = lev, col = col_lines, lty = "solid", lwd = lwd, vgap = legend_vgap, gp_frame = gp_legend_frame, inset = legend_inset, title = group_vars, gp_title = gp_legend_title) } if (pop) popViewport(2) if (return_grob) invisible(grid.grab()) else invisible(NULL) } ########### grid_abline <- function(a, b, ...) { ## taken from graphics::abline() if (is.object(a) || is.list(a)) { p <- length(coefa <- as.vector(coef(a))) if (p > 2) warning(gettextf("only using the first two of %d regression coefficients", p), domain = NA) islm <- inherits(a, "lm") noInt <- if (islm) !as.logical(attr(stats::terms(a), "intercept")) else p == 1 if (noInt) { a <- 0 b <- coefa[1L] } else { a <- coefa[1L] b <- if (p >= 2) coefa[2L] else 0 } } grid.abline(a, b, ...) } vcd/R/mosaic.R0000655000175100001440000003503112453520671012654 0ustar hornikusers########################################################### ## mosaicplot mosaic <- function(x, ...) UseMethod("mosaic") mosaic.formula <- function(formula, data = NULL, highlighting = NULL, ..., main = NULL, sub = NULL, subset = NULL, na.action = NULL) { if (is.logical(main) && main) main <- deparse(substitute(data)) else if (is.logical(sub) && sub) sub <- deparse(substitute(data)) m <- match.call(expand.dots = FALSE) edata <- eval(m$data, parent.frame()) fstr <- strsplit(paste(deparse(formula), collapse = ""), "~") vars <- strsplit(strsplit(gsub(" ", "", fstr[[1]][2]), "\\|")[[1]], "\\+") varnames <- vars[[1]] condnames <- if (length(vars) > 1) vars[[2]] else NULL dep <- gsub(" ", "", fstr[[1]][1]) if (is.null(highlighting) && (!dep %in% c("","Freq"))) { if (all(varnames == ".")) { varnames <- if (is.data.frame(data)) colnames(data) else names(dimnames(as.table(data))) varnames <- varnames[-which(varnames %in% dep)] } varnames <- c(varnames, dep) highlighting <- length(varnames) + length(condnames) } if (inherits(edata, "ftable") || inherits(edata, "table") || length(dim(edata)) > 2) { condind <- NULL dat <- as.table(data) if(all(varnames != ".")) { ind <- match(varnames, names(dimnames(dat))) if (any(is.na(ind))) stop(paste("Can't find", paste(varnames[is.na(ind)], collapse=" / "), "in", deparse(substitute(data)))) if (!is.null(condnames)) { condind <- match(condnames, names(dimnames(dat))) if (any(is.na(condind))) stop(paste("Can't find", paste(condnames[is.na(condind)], collapse=" / "), "in", deparse(substitute(data)))) ind <- c(condind, ind) } dat <- margin.table(dat, ind) } mosaic.default(dat, main = main, sub = sub, highlighting = highlighting, condvars = if (is.null(condind)) NULL else match(condnames, names(dimnames(dat))), ...) } else { m <- m[c(1, match(c("formula", "data", "subset", "na.action"), names(m), 0))] m[[1]] <- as.name("xtabs") m$formula <- formula(paste(if("Freq" %in% colnames(data)) "Freq", "~", paste(c(condnames, varnames), collapse = "+"))) tab <- eval(m, parent.frame()) mosaic.default(tab, main = main, sub = sub, highlighting = highlighting, ...) } } mosaic.default <- function(x, condvars = NULL, split_vertical = NULL, direction = NULL, spacing = NULL, spacing_args = list(), gp = NULL, expected = NULL, shade = NULL, highlighting = NULL, highlighting_fill = grey.colors, highlighting_direction = NULL, zero_size = 0.5, zero_split = FALSE, zero_shade = NULL, zero_gp = gpar(col = 0), panel = NULL, main = NULL, sub = NULL, ...) { zero_shade <- !is.null(shade) && shade || !is.null(expected) || !is.null(gp) if (!is.null(shade) && !shade) zero_shade = FALSE if (is.logical(main) && main) main <- deparse(substitute(x)) else if (is.logical(sub) && sub) sub <- deparse(substitute(x)) if (is.structable(x)) { if (is.null(direction) && is.null(split_vertical)) split_vertical <- attr(x, "split_vertical") x <- as.table(x) } if (is.null(split_vertical)) split_vertical <- FALSE dl <- length(dim(x)) ## splitting argument if (!is.null(direction)) split_vertical <- direction == "v" if (length(split_vertical) == 1) split_vertical <- rep(c(split_vertical, !split_vertical), length.out = dl) if (length(split_vertical) < dl) split_vertical <- rep(split_vertical, length.out = dl) ## highlighting if (!is.null(highlighting)) { if (is.character(highlighting)) highlighting <- match(highlighting, names(dimnames(x))) if (length(highlighting) > 0) { if (is.character(condvars)) condvars <- match(condvars, names(dimnames(x))) perm <- if (length(condvars) > 0) c(condvars, seq(dl)[-c(condvars,highlighting)], highlighting) else c(seq(dl)[-highlighting], highlighting) x <- aperm(x, perm) split_vertical <- split_vertical[perm] if (is.null(spacing)) spacing <- spacing_highlighting if (is.function(highlighting_fill)) highlighting_fill <- rev(highlighting_fill(dim(x)[dl])) if (is.null(gp)) gp <- gpar(fill = highlighting_fill) if (!is.null(highlighting_direction)) { split_vertical[dl] <- highlighting_direction %in% c("left", "right") if (highlighting_direction %in% c("left", "top")) { ## ugly: tmp <- as.data.frame.table(x) tmp[,dl] <- factor(tmp[,dl], rev(levels(tmp[,dl]))) x <- xtabs(Freq ~ ., data = tmp) gp <- gpar(fill = rev(highlighting_fill)) } } } } else if (!is.null(condvars)) { # Conditioning only if (is.character(condvars)) condvars <- match(condvars, names(dimnames(x))) if (length(condvars) > 0) { perm <- c(condvars, seq(dl)[-condvars]) x <- aperm(x, perm) split_vertical <- split_vertical[perm] } if (is.null(spacing)) spacing <- spacing_conditional } ## spacing argument if (is.null(spacing)) spacing <- if (dl < 3) spacing_equal else spacing_increase strucplot(x, condvars = if (is.null(condvars)) NULL else length(condvars), core = struc_mosaic(zero_size = zero_size, zero_split = zero_split, zero_shade = zero_shade, zero_gp = zero_gp, panel = panel), split_vertical = split_vertical, spacing = spacing, spacing_args = spacing_args, gp = gp, expected = expected, shade = shade, main = main, sub = sub, ...) } ## old code: more elegant, but less performant ## ## struc_mosaic2 <- function(zero_size = 0.5, zero_split = FALSE, ## zero_shade = TRUE, zero_gp = gpar(col = 0)) ## function(residuals, observed, expected = NULL, spacing, gp, split_vertical, prefix = "") { ## dn <- dimnames(observed) ## dnn <- names(dn) ## dx <- dim(observed) ## dl <- length(dx) ## ## split workhorse ## zerostack <- character(0) ## split <- function(x, i, name, row, col, zero) { ## cotab <- co_table(x, 1) ## margin <- sapply(cotab, sum) ## v <- split_vertical[i] ## d <- dx[i] ## ## compute total cols/rows and build split layout ## dist <- unit.c(unit(margin, "null"), spacing[[i]]) ## idx <- matrix(1:(2 * d), nrow = 2, byrow = TRUE)[-2 * d] ## layout <- if (v) ## grid.layout(ncol = 2 * d - 1, widths = dist[idx]) ## else ## grid.layout(nrow = 2 * d - 1, heights = dist[idx]) ## vproot <- viewport(layout.pos.col = col, layout.pos.row = row, ## layout = layout, name = remove_trailing_comma(name)) ## ## next level: either create further splits, or final viewports ## name <- paste(name, dnn[i], "=", dn[[i]], ",", sep = "") ## row <- col <- rep.int(1, d) ## if (v) col <- 2 * 1:d - 1 else row <- 2 * 1:d - 1 ## f <- if (i < dl) ## function(m) { ## co <- cotab[[m]] ## z <- mean(co) <= .Machine$double.eps ## if (z && !zero && !zero_split) zerostack <<- c(zerostack, name[m]) ## split(co, i + 1, name[m], row[m], col[m], z && !zero_split) ## } ## else ## function(m) { ## if (cotab[[m]] <= .Machine$double.eps && !zero) ## zerostack <<- c(zerostack, name[m]) ## viewport(layout.pos.col = col[m], layout.pos.row = row[m], ## name = remove_trailing_comma(name[m])) ## } ## vpleaves <- structure(lapply(1:d, f), class = c("vpList", "viewport")) ## vpTree(vproot, vpleaves) ## } ## ## start spltting on top, creates viewport-tree ## pushViewport(split(observed + .Machine$double.eps, ## i = 1, name = paste(prefix, "cell:", sep = ""), ## row = 1, col = 1, zero = FALSE)) ## ## draw rectangles ## mnames <- apply(expand.grid(dn), 1, ## function(i) paste(dnn, i, collapse=",", sep = "=") ## ) ## zeros <- observed <= .Machine$double.eps ## ## draw zero cell lines ## for (i in remove_trailing_comma(zerostack)) { ## seekViewport(i) ## grid.lines(x = 0.5) ## grid.lines(y = 0.5) ## if (!zero_shade && zero_size > 0) { ## grid.points(0.5, 0.5, pch = 19, size = unit(zero_size, "char"), ## gp = zero_gp, ## name = paste(prefix, "disc:", mnames[i], sep = "")) ## grid.points(0.5, 0.5, pch = 1, size = unit(zero_size, "char"), ## name = paste(prefix, "circle:", mnames[i], sep = "")) ## } ## } ## # draw boxes ## for (i in seq_along(mnames)) { ## seekViewport(paste(prefix, "cell:", mnames[i], sep = "")) ## gpobj <- structure(lapply(gp, function(x) x[i]), class = "gpar") ## if (!zeros[i]) { ## grid.rect(gp = gpobj, name = paste(prefix, "rect:", mnames[i], sep = "")) ## } else { ## if (zero_shade && zero_size > 0) { ## grid.points(0.5, 0.5, pch = 19, size = unit(zero_size, "char"), ## gp = gpar(col = gp$fill[i]), ## name = paste(prefix, "disc:", mnames[i], sep = "")) ## grid.points(0.5, 0.5, pch = 1, size = unit(zero_size, "char"), ## name = paste(prefix, "circle:", mnames[i], sep = "")) ## } ## } ## } ## } ## class(struc_mosaic2) <- "grapcon_generator" struc_mosaic <- function(zero_size = 0.5, zero_split = FALSE, zero_shade = TRUE, zero_gp = gpar(col = 0), panel = NULL) function(residuals, observed, expected = NULL, spacing, gp, split_vertical, prefix = "") { dn <- dimnames(observed) dnn <- names(dn) dx <- dim(observed) dl <- length(dx) zeros <- function(gp, name) { grid.lines(x = 0.5) grid.lines(y = 0.5) if (zero_size > 0) { grid.points(0.5, 0.5, pch = 19, size = unit(zero_size, "char"), gp = gp, name = paste(prefix, "disc:", name, sep = "")) grid.points(0.5, 0.5, pch = 1, size = unit(zero_size, "char"), name = paste(prefix, "circle:", name, sep = "")) } } ## split workhorse zerostack <- character(0) split <- function(x, i, name, row, col, zero, index) { cotab <- co_table(x, 1) margin <- sapply(cotab, sum) margin[margin == 0] <- .Machine$double.eps # margin <- margin + .Machine$double.eps v <- split_vertical[i] d <- dx[i] ## compute total cols/rows and build split layout dist <- if (d > 1) unit.c(unit(margin, "null"), spacing[[i]]) else unit(margin, "null") idx <- matrix(1:(2 * d), nrow = 2, byrow = TRUE)[-2 * d] layout <- if (v) grid.layout(ncol = 2 * d - 1, widths = dist[idx]) else grid.layout(nrow = 2 * d - 1, heights = dist[idx]) pushViewport(viewport(layout.pos.col = col, layout.pos.row = row, layout = layout, name = paste(prefix, "cell:", remove_trailing_comma(name), sep = ""))) ## next level: either create further splits, or final viewports row <- col <- rep.int(1, d) if (v) col <- 2 * 1:d - 1 else row <- 2 * 1:d - 1 for (m in 1:d) { nametmp <- paste(name, dnn[i], "=", dn[[i]][m], ",", sep = "") if (i < dl) { co <- cotab[[m]] ## zeros z <- mean(co) <= .Machine$double.eps split(co, i + 1, nametmp, row[m], col[m], z && !zero_split, cbind(index, m)) if (z && !zero && !zero_split && !zero_shade && (zero_size > 0)) zeros(zero_gp, nametmp) } else { pushViewport(viewport(layout.pos.col = col[m], layout.pos.row = row[m], name = paste(prefix, "cell:", remove_trailing_comma(nametmp), sep = ""))) ## zeros if (cotab[[m]] <= .Machine$double.eps && !zero) { zeros(if (!zero_shade) zero_gp else gpar(col = gp$fill[cbind(index,m)]), nametmp) } else { ## rectangles gpobj <- structure(lapply(gp, function(x) x[cbind(index, m)]), class = "gpar") nam <- paste(prefix, "rect:", remove_trailing_comma(nametmp), sep = "") if (!is.null(panel)) panel(residuals, observed, expected, c(cbind(index, m)), gpobj, nam) else grid.rect(gp = gpobj, name = nam) } } upViewport(1) } } ## start splitting on top, creates viewport-tree split(observed, i = 1, name = "", row = 1, col = 1, zero = FALSE, index = cbind()) } class(struc_mosaic) <- "grapcon_generator" vcd/R/assocstats.R0000655000175100001440000000321712504622116013563 0ustar hornikusersassocstats <- function(x) { if(!is.matrix(x)) { l <- length(dim(x)) str <- apply(x, 3 : l, FUN = assocstats) if (l == 3) { names(str) <- paste(names(dimnames(x))[3], names(str), sep = ":") } else { dn <- dimnames(str) dim(str) <- NULL names(str) <- apply(expand.grid(dn), 1, function(x) paste(names(dn), x, sep = ":", collapse = "|")) } return(str) } tab <- summary(loglm(~1+2, x))$tests phi <- sqrt(tab[2,1] / sum(x)) cont <- sqrt(phi^2 / (1 + phi^2)) cramer <- sqrt(phi^2 / min(dim(x) - 1)) structure( list(table = x, chisq_tests = tab, phi = ifelse(all(dim(x) == 2L), phi, NA), contingency = cont, cramer = cramer), class = "assocstats" ) } print.assocstats <- function(x, digits = 3, ...) { print(x$chisq_tests, digits = 5, ...) cat("\n") cat("Phi-Coefficient :", round(x$phi, digits = digits), "\n") cat("Contingency Coeff.:", round(x$cont, digits = digits), "\n") cat("Cramer's V :", round(x$cramer, digits = digits), "\n") invisible(x) } summary.assocstats <- function(object, percentage = FALSE, ...) { tab <- summary(object$table, percentage = percentage, ...) tab$chisq <- NULL structure(list(summary = tab, object = object), class = "summary.assocstats" ) } print.summary.assocstats <- function(x, ...) { cat("\n") print(x$summary, ...) print(x$object, ...) cat("\n") invisible(x) } vcd/R/doubledeckerplot.R0000755000175100001440000000547311720271060014727 0ustar hornikusers####################################### ### doubledecker plot doubledecker <- function(x, ...) UseMethod("doubledecker") doubledecker.formula <- function(formula, data = NULL, ..., main = NULL) { if (is.logical(main) && main) main <- deparse(substitute(data)) if (is.structable(data)) data <- as.table(data) m <- match.call(expand.dots = FALSE) edata <- eval(m$data, parent.frame()) fstr <- strsplit(paste(deparse(formula), collapse = ""), "~") vars <- strsplit(strsplit(gsub(" ", "", fstr[[1]][2]), "\\|")[[1]], "\\+") dep <- gsub(" ", "", fstr[[1]][1]) varnames <- vars[[1]] if (dep == "") stop("Need a dependent variable!") varnames <- c(varnames, dep) if(inherits(edata, "ftable") || inherits(edata, "table") || length(dim(edata)) > 2) { dat <- as.table(data) if(all(varnames != ".")) { ind <- match(varnames, names(dimnames(dat))) if (any(is.na(ind))) stop(paste("Can't find", paste(varnames[is.na(ind)], collapse=" / "), "in", deparse(substitute(data)))) dat <- margin.table(dat, ind) } else { ind <- match(dep, names(dimnames(dat))) if (is.na(ind)) stop(paste("Can't find", dep, "in", deparse(substitute(data)))) dat <- aperm(dat, c(seq_along(dim(dat))[-ind], ind)) } doubledecker.default(dat, main = main, ...) } else { tab <- if ("Freq" %in% colnames(data)) xtabs(formula(paste("Freq~", varnames, collapse = "+")), data = data) else xtabs(formula(paste("~", varnames, collapse = "+")), data = data) doubledecker.default(tab, main = main, ...) } } doubledecker.default <- function(x, depvar = length(dim(x)), margins = c(1, 4, length(dim(x)) + 1, 1), gp = gpar(fill = rev(gray.colors(tail(dim(x), 1)))), labeling = labeling_doubledecker, spacing = spacing_highlighting, main = NULL, keep_aspect_ratio = FALSE, ...) { x <- as.table(x) d <- dim(x) l <- length(d) if (is.character(depvar)) depvar <- match(depvar, names(dimnames(x))) condvars <- (1:l)[-depvar] x <- aperm(x, c(condvars, depvar)) strucplot(x, core = struc_mosaic(zero_split = FALSE, zero_shade = FALSE), condvars = l - 1, spacing = spacing, split_vertical = c(rep.int(TRUE, l - 1), FALSE), gp = gp, shade = TRUE, labeling = labeling, main = main, margins = margins, legend = NULL, keep_aspect_ratio = keep_aspect_ratio, ... ) } vcd/R/shadings.R0000644000175100001440000002453012537041353013177 0ustar hornikusers## convenience function for interfacing ## HCL colors as implemented in colorspace hcl2hex <- function(h = 0, c = 35, l = 85, fixup = TRUE) { colorspace::hex(polarLUV(l, c, h), fixup = fixup) } ## shading-generating functions should take at least the arguments ## observed, residuals, expected, df ## and return a function which takes a single argument (interpreted ## to be a vector of residuals). shading_hsv <- function(observed, residuals = NULL, expected = NULL, df = NULL, h = c(2/3, 0), s = c(1, 0), v = c(1, 0.5), interpolate = c(2, 4), lty = 1, eps = NULL, line_col = "black", p.value = NULL, level = 0.95, ...) { ## get h/s/v and lty my.h <- rep(h, length.out = 2) ## positive and negative hue my.s <- rep(s, length.out = 2) ## maximum and minimum saturation my.v <- rep(v, length.out = 2) ## significant and non-significant value lty <- rep(lty, length.out = 2) ## positive and negative lty ## model fitting (if necessary) if(is.null(expected) && !is.null(residuals)) stop("residuals without expected values specified") if(!is.null(expected) && is.null(df) && is.null(p.value)) { warning("no default inference available without degrees of freedom") p.value <- NA } if(is.null(expected) && !is.null(observed)) { expected <- loglin(observed, 1:length(dim(observed)), fit = TRUE, print = FALSE) df <- expected$df expected <- expected$fit } if(is.null(residuals) && !is.null(observed)) residuals <- (observed - expected)/sqrt(expected) ## conduct significance test (if specified) if(is.null(p.value)) p.value <- function(observed, residuals, expected, df) pchisq(sum(as.vector(residuals)^2), df, lower.tail = FALSE) if(!is.function(p.value) && is.na(p.value)) { v <- my.v[1] p.value <- NULL } else { if(is.function(p.value)) p.value <- p.value(observed, residuals, expected, df) v <- if(p.value < (1-level)) my.v[1] else my.v[2] } ## set up function for interpolation of saturation if(!is.function(interpolate)) { col.bins <- sort(interpolate) interpolate <- stepfun(col.bins, seq(my.s[2], my.s[1], length = length(col.bins) + 1)) col.bins <- sort(unique(c(col.bins, 0, -col.bins))) } else { col.bins <- NULL } ## store color and lty information for legend legend <- NULL if(!is.null(col.bins)) { res2 <- col.bins res2 <- c(head(res2, 1) - 1, res2[-1] - diff(res2)/2, tail(res2, 1) + 1) legend.col <- hsv(ifelse(res2 > 0, my.h[1], my.h[2]), pmax(pmin(interpolate(abs(res2)), 1), 0), v, ...) lty.bins <- 0 legend.lty <- lty[2:1] legend <- list(col = legend.col, col.bins = col.bins, lty = legend.lty, lty.bins = lty.bins) } ## set up function that computes color/lty from residuals rval <- function(x) { res <- as.vector(x) fill <- hsv(ifelse(res > 0, my.h[1], my.h[2]), pmax(pmin(interpolate(abs(res)), 1), 0), v, ...) dim(fill) <- dim(x) col <- rep(line_col, length.out = length(res)) if(!is.null(eps)) { eps <- abs(eps) col[res > eps] <- hsv(my.h[1], 1, v, ...) col[res < -eps] <- hsv(my.h[2], 1, v, ...) } dim(col) <- dim(x) # line type should be solid if abs(resid) < eps ltytmp <- ifelse(x > 0, lty[1], lty[2]) if(!is.null(eps)) ltytmp[abs(x) < abs(eps)] <- lty[1] dim(ltytmp) <- dim(x) return(structure(list(col = col, fill = fill, lty = ltytmp), class = "gpar")) } attr(rval, "legend") <- legend attr(rval, "p.value") <- p.value return(rval) } class(shading_hsv) <- "grapcon_generator" shading_hcl <- function(observed, residuals = NULL, expected = NULL, df = NULL, h = NULL, c = NULL, l = NULL, interpolate = c(2, 4), lty = 1, eps = NULL, line_col = "black", p.value = NULL, level = 0.95, ...) { ## set defaults if(is.null(h)) h <- c(260, 0) if(is.null(c)) c <- c(100, 20) if(is.null(l)) l <- c(90, 50) ## get h/c/l and lty my.h <- rep(h, length.out = 2) ## positive and negative hue my.c <- rep(c, length.out = 2) ## significant and non-significant maximum chroma my.l <- rep(l, length.out = 2) ## maximum and minimum luminance lty <- rep(lty, length.out = 2) ## positive and negative lty ## model fitting (if necessary) if(is.null(expected) && !is.null(residuals)) stop("residuals without expected values specified") if(!is.null(expected) && is.null(df) && is.null(p.value)) { warning("no default inference available without degrees of freedom") p.value <- NA } if(is.null(expected) && !is.null(observed)) { expected <- loglin(observed, 1:length(dim(observed)), fit = TRUE, print = FALSE) df <- expected$df expected <- expected$fit } if(is.null(residuals) && !is.null(observed)) residuals <- (observed - expected)/sqrt(expected) ## conduct significance test (if specified) if(is.null(p.value)) p.value <- function(observed, residuals, expected, df) pchisq(sum(as.vector(residuals)^2), df, lower.tail = FALSE) if(!is.function(p.value) && is.na(p.value)) { max.c <- my.c[1] p.value <- NULL } else { if(is.function(p.value)) p.value <- p.value(observed, residuals, expected, df) max.c <- ifelse(p.value < (1-level), my.c[1], my.c[2]) } ## set up function for interpolation of saturation if(!is.function(interpolate)) { col.bins <- sort(interpolate) interpolate <- stepfun(col.bins, seq(0, 1, length = length(col.bins) + 1)) col.bins <- sort(unique(c(col.bins, 0, -col.bins))) } else { col.bins <- NULL } ## store color and lty information for legend legend <- NULL if(!is.null(col.bins)) { res2 <- col.bins res2 <- c(head(res2, 1) - 1, res2[-1] - diff(res2)/2, tail(res2, 1) + 1) legend.col <- hcl2hex(ifelse(res2 > 0, my.h[1], my.h[2]), max.c * pmax(pmin(interpolate(abs(res2)), 1), 0), my.l[1] + diff(my.l) * pmax(pmin(interpolate(abs(res2)), 1), 0), ...) lty.bins <- 0 legend.lty <- lty[2:1] legend <- list(col = legend.col, col.bins = col.bins, lty = legend.lty, lty.bins = lty.bins) } ## set up function that computes color/lty from residuals rval <- function(x) { res <- as.vector(x) fill <- hcl2hex(ifelse(res > 0, my.h[1], my.h[2]), max.c * pmax(pmin(interpolate(abs(res)), 1), 0), my.l[1] + diff(my.l) * pmax(pmin(interpolate(abs(res)), 1), 0), ...) dim(fill) <- dim(x) col <- rep(line_col, length.out = length(res)) if(!is.null(eps)) { eps <- abs(eps) col[res > eps] <- hcl2hex(my.h[1], max.c, my.l[2], ...) col[res < -eps] <- hcl2hex(my.h[2], max.c, my.l[2], ...) } dim(col) <- dim(x) ltytmp <- ifelse(x > 0, lty[1], lty[2]) if(!is.null(eps)) ltytmp[abs(x) < abs(eps)] <- lty[1] dim(ltytmp) <- dim(x) return(structure(list(col = col, fill = fill, lty = ltytmp), class = "gpar")) } attr(rval, "legend") <- legend attr(rval, "p.value") <- p.value return(rval) } class(shading_hcl) <- "grapcon_generator" shading_Friendly <- function(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = c(2/3, 0), lty = 1:2, interpolate = c(2, 4), eps = 0.01, line_col = "black", ...) { shading_hsv(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = h, v = 1, lty = lty, interpolate = interpolate, eps = eps, line_col = line_col, p.value = NA, ...) } class(shading_Friendly) <- "grapcon_generator" shading_Friendly2 <- function(observed = NULL, residuals = NULL, expected = NULL, df = NULL, lty = 1:2, interpolate = c(2, 4), eps = 0.01, line_col = "black", ...) { shading_hcl(observed = NULL, residuals = NULL, expected = NULL, df = NULL, lty = lty, interpolate = interpolate, eps = eps, line_col = line_col, p.value = NA, ...) } class(shading_Friendly2) <- "grapcon_generator" shading_sieve <- function(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = c(260, 0), lty = 1:2, interpolate = c(2, 4), eps = 0.01, line_col = "black", ...) { shading_hcl(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = h, c = 100, l = 50, lty = lty, interpolate = interpolate, eps = eps, line_col = line_col, p.value = NA, ...) } class(shading_sieve) <- "grapcon_generator" shading_max <- function(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = NULL, c = NULL, l = NULL, lty = 1, eps = NULL, line_col = "black", level = c(0.9, 0.99), n = 1000, ...) { stopifnot(length(dim(observed)) == 2) ## set defaults if(is.null(h)) h <- c(260, 0) if(is.null(c)) c <- c(100, 20) if(is.null(l)) l <- c(90, 50) obs.test <- coindep_test(observed, n = n) col.bins <- obs.test$qdist(sort(level)) rval <- shading_hcl(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = h, c = c, l = l, interpolate = col.bins, lty = lty, eps = eps, line_col = line_col, p.value = obs.test$p.value, ...) return(rval) } class(shading_max) <- "grapcon_generator" shading_binary <- function(observed = NULL, residuals = NULL, expected = NULL, df = NULL, col = NULL) { ## check col argument if(is.null(col)) col <- hcl2hex(c(260, 0), 50, 70) col <- rep(col, length.out = 2) ## store color information for legend legend <- list(col = col[2:1], col.bins = 0, lty = NULL, lty.bins = NULL) ## set up function that computes color/lty from residuals rval <- function(x) gpar(fill = ifelse(x > 0, col[1], col[2])) ## add meta information for legend attr(rval, "legend") <- legend attr(rval, "p.value") <- NULL rval } class(shading_binary) <- "grapcon_generator" shading_Marimekko <- function(x, fill = NULL, byrow = FALSE) { if (is.null(fill)) fill <- colorspace::rainbow_hcl d <- dim(x) l1 <- if (length(d) > 1L) d[2] else d l2 <- if (length(d) > 1L) d[1] else 1 if (is.function(fill)) fill <- fill(l1) fill <- if (byrow) rep(fill, l2) else rep(fill, each = l2) gpar(col = NA, lty = "solid", fill = array(fill, dim = d)) } shading_diagonal <- function(x, fill = NULL) { if (is.null(fill)) fill <- colorspace::rainbow_hcl d <- dim(x) if (length(d) < 1L) stop("Need matrix or array!") if (d[1] != d[2]) stop("First two dimensions need to be of same length!") if (is.function(fill)) fill <- fill(d[1]) tp = toeplitz(seq_len(d[1])) gpar(col = NA, lty = "solid", fill = array(rep(fill[tp], d[1]), dim = d)) } vcd/R/coindep_test.R0000755000175100001440000000576311150520606014062 0ustar hornikuserscoindep_test <- function(x, margin = NULL, n = 1000, indepfun = function(x) max(abs(x)), aggfun = max, alternative = c("greater", "less"), pearson = TRUE) { DNAME <- deparse(substitute(x)) alternative <- match.arg(alternative) if(is.null(margin)) { rs <- rowSums(x) cs <- colSums(x) expctd <- rs %o% cs / sum(rs) Pearson <- function(x) (x - expctd)/sqrt(expctd) resids <- Pearson(x) ff <- if(is.null(aggfun)) { if(pearson) function(x) aggfun(indepfun(Pearson(x))) else function(x) aggfun(indepfun(x)) } else { if(pearson) function(x) indepfun(Pearson(x)) else function(x) indepfun(x) } if(length(dim(x)) > 2) stop("currently only implemented for (conditional) 2d tables") dist <- sapply(r2dtable(n, rowSums(x), colSums(x)), ff) STATISTIC <- ff(x) } else { ff <- if(pearson) function(x) indepfun(Pearson(x)) else function(x) indepfun(x) cox <- co_table(x, margin) nc <- length(cox) if(length(dim(cox[[1]])) > 2) stop("currently only implemented for conditional 2d tables") dist <- matrix(rep(0, n * nc), ncol = nc) for(i in 1:nc) { coxi <- cox[[i]] cs <- colSums(coxi) rs <- rowSums(coxi) expctd <- rs %o% cs / sum(rs) Pearson <- function(x) (x - expctd)/sqrt(expctd) if(any(c(cs, rs) < 1)) warning("structural zeros") ## FIXME dist[, i] <- sapply(r2dtable(n, rs, cs), ff) } dist <- apply(dist, 1, aggfun) Pearson <- function(x) { expctd <- rowSums(x) %o% colSums(x) / sum(x) return((x - expctd)/sqrt(expctd)) } STATISTIC <- aggfun(sapply(cox, ff)) ## just for returning nicely formatted fitted values ## and residuals: fit once more with loglm() vars <- names(dimnames(x)) condvars <- if(is.numeric(margin)) vars[margin] else margin indvars <- vars[!(vars %in% condvars)] coind.form <- as.formula(paste("~ (", paste(indvars, collapse = " + "), ") * ", paste(condvars, collapse = " * "), sep = "")) fm <- loglm(coind.form, data = x, fitted = TRUE) expctd <- fitted(fm) resids <- residuals(fm, type = "pearson") } pdist <- function(x) sapply(x, function(y) mean(dist <= y)) qdist <- function(p) quantile(dist, p) PVAL <- switch(alternative, greater = mean(dist >= STATISTIC), less = mean(dist <= STATISTIC)) METHOD <- "Permutation test for conditional independence" names(STATISTIC) <- "f(x)" rval <- list(statistic = STATISTIC, p.value = PVAL, method = METHOD, data.name = DNAME, observed = x, expected = expctd, residuals = resids, margin = margin, dist = dist, qdist = qdist, pdist = pdist) class(rval) <- c("coindep_test", "htest") return(rval) } fitted.coindep_test <- function(object, ...) object$expected ## plot.coindep_test ## mosaic.coindep_test ## assoc.coindep_test ## difficult, depends on functionals... vcd/R/plot.loglm.R0000644000175100001440000000206612305101201013444 0ustar hornikusersplot.loglm <- function(x, panel = mosaic, type = c("observed", "expected"), residuals_type = c("pearson", "deviance"), gp = shading_hcl, gp_args = list(), ...) { residuals_type <- match.arg(tolower(residuals_type), c("pearson", "deviance")) if(is.null(x$fitted)) x <- update(x, fitted = TRUE) expected <- fitted(x) residuals <- residuals(x, type = "pearson") observed <- residuals * sqrt(expected) + expected if(residuals_type == "deviance") residuals <- residuals(x, type = "deviance") gp <- if(inherits(gp, "grapcon_generator")) do.call("gp", c(list(observed, residuals, expected, x$df), as.list(gp_args))) else gp panel(observed, residuals = residuals, expected = expected, type = type, residuals_type = residuals_type, gp = gp, ...) } mosaic.loglm <- function(x, ...) { plot(x, panel = mosaic, ...) } assoc.loglm <- function(x, ...) { plot(x, panel = assoc, ...) } sieve.loglm <- function(x, ...) { plot(x, panel = sieve, ...) } vcd/R/tabletools.R0000655000175100001440000000522712456226636013564 0ustar hornikusersindependence_table <- function(x, frequency = c("absolute", "relative")) { if (!is.array(x)) stop("Need array of absolute frequencies!") frequency <- match.arg(frequency) n <- sum(x) x <- x / n d <- dim(x) ## build margins margins <- lapply(1:length(d), function(i) apply(x, i, sum)) ## multiply all combinations & reshape tab <- array(apply(expand.grid(margins), 1, prod), d, dimnames = dimnames(x)) if (frequency == "relative") tab else tab * n } mar_table <- function(x) { if(!is.matrix(x)) stop("Function only defined for 2-way tables.") tab <- rbind(cbind(x, TOTAL = rowSums(x)), TOTAL = c(colSums(x), sum(x))) names(dimnames(tab)) <- names(dimnames(x)) tab } table2d_summary <- function(object, margins = TRUE, percentages = FALSE, conditionals = c("none", "row", "column"), chisq.test = TRUE, ... ) { ret <- list() if (chisq.test) ret$chisq <- summary.table(object, ...) if(is.matrix(object)) { conditionals <- match.arg(conditionals) tab <- array(0, c(dim(object) + margins, 1 + percentages + (conditionals != "none"))) ## frequencies tab[,,1] <- if(margins) mar_table(object) else object ## percentages if(percentages) { tmp <- prop.table(object) tab[,,2] <- 100 * if(margins) mar_table(tmp) else tmp } ## conditional distributions if(conditionals != "none") { tmp <- prop.table(object, margin = 1 + (conditionals == "column")) tab[,,2 + percentages] <- 100 * if(margins) mar_table(tmp) else tmp } ## dimnames dimnames(tab) <- c(dimnames(if(margins) mar_table(object) else object), list(c("freq", if(percentages) "%", switch(conditionals, row = "row%", column = "col%") ) ) ) ## patch row% / col% margins if(conditionals == "row") tab[dim(tab)[1],,2 + percentages] <- NA if(conditionals == "column") tab[,dim(tab)[2],2 + percentages] <- NA ret$table <- tab } class(ret) <- "table2d_summary" ret } print.table2d_summary <- function (x, digits = max(1, getOption("digits") - 3), ...) { if (!is.null(x$table)) if(dim(x$table)[3] == 1) print(x$table[,,1], digits = digits, ...) else print(ftable(aperm(x$table, c(1,3,2))), 2, digits = digits, ...) cat("\n") if (!is.null(x$chisq)) print.summary.table(x$chisq, digits, ...) invisible(x) } vcd/R/ternaryplot.R0000655000175100001440000001111512445046632013762 0ustar hornikusers"ternaryplot" <- function (x, scale = 1, dimnames = NULL, dimnames_position = c("corner", "edge", "none"), dimnames_color = "black", id = NULL, id_color = "black", id_just = c("center", "center"), coordinates = FALSE, grid = TRUE, grid_color = "gray", labels = c("inside", "outside", "none"), labels_color = "darkgray", border = "black", bg = "white", pch = 19, cex = 1, prop_size = FALSE, col = "red", main = "ternary plot", newpage = TRUE, pop = TRUE, return_grob = FALSE, ...) { ## parameter handling labels <- match.arg(labels) if (grid == TRUE) grid <- "dotted" if (coordinates) id <- paste("(",round(x[,1] * scale, 1),",", round(x[,2] * scale, 1),",", round(x[,3] * scale, 1),")", sep="") dimnames_position <- match.arg(dimnames_position) if(is.null(dimnames) && dimnames_position != "none") dimnames <- colnames(x) if(is.logical(prop_size) && prop_size) prop_size <- 3 ## some error handling if(ncol(x) != 3) stop("Need a matrix with 3 columns") if(any(x < 0)) stop("X must be non-negative") s <- rowSums(x) if(any(s <= 0)) stop("each row of X must have a positive sum") ## rescaling x <- x / s ## prepare plot top <- sqrt(3) / 2 if (newpage) grid.newpage() xlim <- c(-0.03, 1.03) ylim <- c(-1, top) pushViewport(viewport(width = unit(1, "snpc"))) if (!is.null(main)) grid.text(main, y = 0.9, gp = gpar(fontsize = 18, fontstyle = 1)) pushViewport(viewport(width = 0.8, height = 0.8, xscale = xlim, yscale = ylim, name = "plot")) eps <- 0.01 ## coordinates of point P(a,b,c): xp = b + c/2, yp = c * sqrt(3)/2 ## triangle grid.polygon(c(0, 0.5, 1), c(0, top, 0), gp = gpar(fill = bg, col = border), ...) ## title, labeling if (dimnames_position == "corner") { grid.text(x = c(0, 1, 0.5), y = c(-0.02, -0.02, top + 0.02), label = dimnames, gp = gpar(fontsize = 12)) } if (dimnames_position == "edge") { shift <- eps * if (labels == "outside") 8 else 0 grid.text(x = 0.25 - 2 * eps - shift, y = 0.5 * top + shift, label = dimnames[2], rot = 60, gp = gpar(col = dimnames_color)) grid.text(x = 0.75 + 3 * eps + shift, y = 0.5 * top + shift, label = dimnames[1], rot = -60, gp = gpar(col = dimnames_color)) grid.text(x = 0.5, y = -0.02 - shift, label = dimnames[3], gp = gpar(col = dimnames_color)) } ## grid if (is.character(grid)) for (i in 1:4 * 0.2) { ## a - axis grid.lines(c(1 - i , (1 - i) / 2), c(0, 1 - i) * top, gp = gpar(lty = grid, col = grid_color)) ## b - axis grid.lines(c(1 - i , 1 - i + i / 2), c(0, i) * top, gp = gpar(lty = grid, col = grid_color)) ## c - axis grid.lines(c(i / 2, 1 - i + i/2), c(i, i) * top, gp = gpar(lty = grid, col = grid_color)) ## grid labels if (labels == "inside") { grid.text(x = (1 - i) * 3 / 4 - eps, y = (1 - i) / 2 * top, label = i * scale, gp = gpar(col = labels_color), rot = 120) grid.text(x = 1 - i + i / 4 + eps, y = i / 2 * top - eps, label = (1 - i) * scale, gp = gpar(col = labels_color), rot = -120) grid.text(x = 0.5, y = i * top + eps, label = i * scale, gp = gpar(col = labels_color)) } if (labels == "outside") { grid.text(x = (1 - i) / 2 - 6 * eps, y = (1 - i) * top, label = (1 - i) * scale, gp = gpar(col = labels_color)) grid.text(x = 1 - (1 - i) / 2 + 3 * eps, y = (1 - i) * top + 5 * eps, label = i * scale, rot = -120, gp = gpar(col = labels_color)) grid.text(x = i + eps, y = -0.05, label = (1 - i) * scale, vjust = 1, rot = 120, gp = gpar(col = labels_color)) } } ## plot points xp <- x[,2] + x[,3] / 2 yp <- x[,3] * top size = unit(if(prop_size) prop_size * (s / max(s)) else cex, "lines") grid.points(xp, yp, pch = pch, gp = gpar(col = col), default.units = "snpc", size = size, ...) ## plot if (!is.null(id)) grid.text(x = xp, y = unit(yp - 0.015, "snpc") - 0.5 * size, label = as.character(id), just = id_just, gp = gpar(col = id_color, cex = cex)) ## cleanup if(pop) popViewport(2) else upViewport(2) if (return_grob) invisible(grid.grab()) else invisible(NULL) } vcd/R/Ord_plot.R0000644000175100001440000000737412445046667013203 0ustar hornikusers# This should be revised to allow graphical parameters to be more easily passed # for points and lines # For now, added lwd, lty and col args for lines, with more useful defaults Ord_plot <- function(obj, legend = TRUE, estimate = TRUE, tol = 0.1, type = NULL, xlim = NULL, ylim = NULL, xlab = "Number of occurrences", ylab = "Frequency ratio", main = "Ord plot", gp = gpar(cex = 0.5), lwd = c(2,2), lty=c(2,1), col=c("black", "red"), name = "Ord_plot", newpage = TRUE, pop = TRUE, return_grob = FALSE, ...) { if(is.vector(obj)) { obj <- table(obj) } if(is.table(obj)) { if(length(dim(obj)) > 1) stop ("obj must be a 1-way table") x <- as.vector(obj) count <- as.numeric(names(obj)) } else { if(!(!is.null(ncol(obj)) && ncol(obj) == 2)) stop("obj must be a 2-column matrix or data.frame") x <- as.vector(obj[,1]) count <- as.vector(obj[,2]) } y <- count * x/c(NA, x[-length(x)]) fm <- lm(y ~ count) fmw <- lm(y ~ count, weights = sqrt(pmax(x, 1) - 1)) fit1 <- predict(fm, data.frame(count)) fit2 <- predict(fmw, data.frame(count)) if(is.null(xlim)) xlim <- range(count) if(is.null(ylim)) ylim <- range(c(y, fit1, fit2), na.rm = TRUE) xlim <- xlim + c(-1, 1) * diff(xlim) * 0.04 ylim <- ylim + c(-1, 1) * diff(ylim) * 0.04 lwd <- rep_len(lwd, 2) # assure length=2 lty <- rep_len(lty, 2) col <- rep_len(col, 2) if(newpage) grid.newpage() pushViewport(plotViewport(xscale = xlim, yscale = ylim, default.units = "native", name = name)) grid.points(x = count, y = y, default.units = "native", gp = gp, ...) grid.lines(x = count, y = fit1, default.units = "native", gp = gpar(lwd=lwd[1], lty=lty[1], col=col[1])) grid.lines(x = count, y = fit2, default.units = "native", gp = gpar(lwd=lwd[2], lty=lty[2], col=col[2])) grid.rect(gp = gpar(fill = "transparent")) grid.xaxis() grid.yaxis() grid.text(xlab, y = unit(-3.5, "lines")) grid.text(ylab, x = unit(-3, "lines"), rot = 90) grid.text(main, y = unit(1, "npc") + unit(2, "lines"), gp = gpar(fontface = "bold")) RVAL <- coef(fmw) names(RVAL) <- c("Intercept", "Slope") if(legend) { legend.text <- c(paste("slope =", round(RVAL[2], digits = 3)), paste("intercept =", round(RVAL[1], digits = 3))) if(estimate) { ordfit <- Ord_estimate(RVAL, type = type, tol = tol) legend.text <- c(legend.text, "", paste("type:", ordfit$type), paste("estimate:", names(ordfit$estimate),"=", round(ordfit$estimate, digits = 3))) legend.text <- paste(legend.text, collapse = "\n") } grid.text(legend.text, min(count), ylim[2] * 0.95, default.units = "native", just = c("left", "top")) } if(pop) popViewport() else upViewport() if(return_grob) invisible(structure(RVAL, grob = grid.grab())) else invisible(RVAL) } Ord_estimate <- function(x, type = NULL, tol = 0.1) { a <- x[1] b <- x[2] if(!is.null(type)) type <- match.arg(type, c("poisson", "binomial", "nbinomial", "log-series")) else { if(abs(b) < tol) type <- "poisson" else if(b < (-1 * tol)) type <- "binomial" else if(a > (-1 * tol)) type <- "nbinomial" else if(abs(a + b) < 4*tol) type <- "log-series" else type <- "none" } switch(type, "poisson" = { par <- a names(par) <- "lambda" if(par < 0) warning("lambda not > 0") }, "binomial" = { par <- b/(b - 1) names(par) <- "prob" if(abs(par - 0.5) > 0.5) warning("prob not in (0,1)") }, "nbinomial" = { par <- 1 - b names(par) <- "prob" if(abs(par - 0.5) > 0.5) warning("prob not in (0,1)") }, "log-series" = { par <- b names(par) <- "theta" if(par < 0) warning("theta not > 0") }, "none" = { par <- NA }) list(estimate = par, type = type) } vcd/R/grid_legend.R0000644000175100001440000001036712471732076013653 0ustar hornikusersgrid_legend <- function (x, y, pch = NA, col = par('col'), labels, frame = TRUE, hgap = unit(0.8, "lines"), vgap = unit(0.8, "lines"), default_units = "lines", gp = gpar(), draw = TRUE, title = NULL, just = 'center', lwd = NA, lty = NA, size = 1, gp_title = NULL, gp_labels = NULL, gp_frame = gpar(fill = "transparent"), inset = c(0, 0)) { inset <- rep(inset, length.out = 2) if((length(x) > 1) && missing(y)) { y <- x[2] x <- x[1] } if(is.character(x)) switch(x, left = {x = unit(0 + inset[1],'npc'); y = unit(0.5 + inset[2],'npc'); just = c("left","center")}, topleft = {x = unit(0 + inset[1],'npc'); y = unit(1 - inset[2],'npc'); just = c(0,1)}, top = {x = unit(0.5 + inset[1],'npc'); y = unit(1 - inset[2],'npc'); just = c("center", "top")}, topright = {x = unit(1 - inset[1],'npc'); y = unit(1 - inset[2],'npc'); just = c(1,1)}, center = {x = unit(0.5 + inset[1],'npc'); y = unit(0.5 + inset[2],'npc'); just = c("center","center")}, bottom = {x = unit(0.5 - inset[1],'npc'); y = unit(0 + inset[2],'npc'); just = c("center","bottom")}, bottomright = {x = unit(1 - inset[1],'npc'); y = unit(0 + inset[2],'npc'); just = c(1,0)}, right = {x = unit(1 - inset[1],'npc'); y = unit(0.5 + inset[2],'npc'); just = c("right","center")}, bottomleft = {x = unit(0 + inset[1],'npc'); y = unit(0 + inset[2],'npc'); just = c(0,0)}) labels <- as.character(labels) nlabs <- length(labels) if(length(pch) == 1) pch <- rep(pch, nlabs) if(length(lwd) == 1) lwd <- rep(lwd, nlabs) if(length(lty) == 1) lty <- rep(lty, nlabs) if(length(col) == 1) col <- rep(col, nlabs) if(length(gp_labels) == 1) gp_labels <- rep(list(gp_labels), nlabs) if (is.logical(title) && !title) title <- NULL if(is.null(title)) tit <- 0 else tit <- 1 if (!is.unit(hgap)) hgap <- unit(hgap, default_units) if (length(hgap) != 1) stop("hgap must be single unit") if (!is.unit(vgap)) vgap <- unit(vgap, default_units) if (length(vgap) != 1) stop("vgap must be single unit") if(tit) legend.layout <- grid.layout(nlabs + tit, 3, widths = unit.c(unit(2, "lines"), max(unit(rep(1, nlabs), "strwidth", as.list(c(labels))), unit(1, "strwidth", title) - unit(2, "lines")), hgap), heights = unit.pmax(unit(1, "lines"), vgap + unit(rep(1, nlabs + tit ), "strheight", as.list(c(labels,title))))) else legend.layout <- grid.layout(nlabs, 3, widths = unit.c(unit(2, "lines"), max(unit(rep(1, nlabs), "strwidth", as.list(labels))), hgap), heights = unit.pmax(unit(1, "lines"), vgap + unit(rep(1, nlabs), "strheight", as.list(labels)))) fg <- frameGrob(layout = legend.layout, gp = gp) if (frame) fg <- placeGrob(fg, rectGrob(gp = gp_frame)) if (tit) fg <- placeGrob(fg, textGrob(title, x = .2, y = 0.5, just = c("left", "center"), gp = gp_title), col = 1, row = 1) for (i in 1:nlabs) { if(!is.na(pch[i])) fg <- placeGrob(fg, pointsGrob(0.5, 0.5, pch = pch[i], size = unit(size, "char"), gp = gpar(col = col[i])), col = 1, row = i + tit) else if(!is.na(lwd[i]) || !is.na(lty[i])) fg <- placeGrob(fg, linesGrob( unit(c(0.2, .8), "npc"), unit(c(.5), "npc"), gp = gpar(col = col[i], lwd = lwd[i], lty=lty[i])), col = 1, row = i + tit) fg <- placeGrob(fg, textGrob(labels[i], x = .1, y = 0.5, just = c("left", "center"), gp = gp_labels[[i]]), col = 2, row = i + tit) } pushViewport(viewport(x, y, height = grobHeight(fg), width = grobWidth(fg), just = just )) if (draw) grid.draw(fg) popViewport(1) invisible(fg) } vcd/R/strucplot.R0000655000175100001440000002777412445053027013454 0ustar hornikusers################################################################ ### strucplot - generic plot framework for mosaic-like layouts ### 2 core functions are provided: struc_mosaic and struc_assoc ################################################################ strucplot <- function(## main parameters x, residuals = NULL, expected = NULL, condvars = NULL, shade = NULL, type = c("observed", "expected"), residuals_type = NULL, df = NULL, ## layout split_vertical = NULL, spacing = spacing_equal, spacing_args = list(), gp = NULL, gp_args = list(), labeling = labeling_border, labeling_args = list(), core = struc_mosaic, core_args = list(), legend = NULL, legend_args = list(), main = NULL, sub = NULL, margins = unit(3, "lines"), title_margins = NULL, legend_width = NULL, ## control parameters main_gp = gpar(fontsize = 20), sub_gp = gpar(fontsize = 15), newpage = TRUE, pop = TRUE, return_grob = FALSE, keep_aspect_ratio = NULL, prefix = "", ... ) { ## default behaviour of shade if (is.null(shade)) shade <- !is.null(gp) || !is.null(expected) type <- match.arg(type) if (is.null(residuals)) { residuals_type <- if (is.null(residuals_type)) "pearson" else match.arg(tolower(residuals_type), c("pearson", "deviance", "ft")) } else { if (is.null(residuals_type)) residuals_type <- "" } ## convert structable object if (is.structable(x)) { if (is.null(split_vertical)) split_vertical <- attr(x, "split_vertical") x <- as.table(x) } if (is.null(split_vertical)) split_vertical <- FALSE ## table characteristics d <- dim(x) dl <- length(d) dn <- dimnames(x) if (is.null(dn)) dn <- dimnames(x) <- lapply(d, seq) dnn <- names(dimnames(x)) if (is.null(dnn)) dnn <- names(dn) <- names(dimnames(x)) <- LETTERS[1:dl] ## replace NAs by 0 if (any(nas <- is.na(x))) x[nas] <- 0 ## model fitting: ## calculate df and expected if needed ## (used for inference in some shading (generating) functions). ## note: will *not* be calculated if residuals are given if ((is.null(expected) && is.null(residuals)) || !is.numeric(expected)) { if (!is.null(df)) warning("Using calculated degrees of freedom.") if (inherits(expected, "formula")) { fm <- loglm(expected, x, fitted = TRUE) expected <- fitted(fm) df <- fm$df } else { if (is.null(expected)) expected <- if (is.null(condvars)) as.list(1:dl) else lapply((condvars + 1):dl, c, seq(condvars)) fm <- loglin(x, expected, fit = TRUE, print = FALSE) expected <- fm$fit df <- fm$df } } ## compute residuals if (is.null(residuals)) residuals <- switch(residuals_type, pearson = (x - expected) / sqrt(ifelse(expected > 0, expected, 1)), deviance = { tmp <- 2 * (x * log(ifelse(x == 0, 1, x / ifelse(expected > 0, expected, 1))) - (x - expected)) tmp <- sqrt(pmax(tmp, 0)) ifelse(x > expected, tmp, -tmp) }, ft = sqrt(x) + sqrt(x + 1) - sqrt(4 * expected + 1) ) ## replace NAs by 0 if (any(nas <- is.na(residuals))) residuals[nas] <- 0 ## splitting if (length(split_vertical) == 1) split_vertical <- rep(c(split_vertical, !split_vertical), length.out = dl) if (is.null(keep_aspect_ratio)) keep_aspect_ratio <- dl < 3 ## spacing if (is.function(spacing)) { if (inherits(spacing, "grapcon_generator")) spacing <- do.call("spacing", spacing_args) spacing <- spacing(d, condvars) } ## gp (color, fill, lty, etc.) argument if (shade) { if (is.null(gp)) gp <- shading_hcl if (is.function(gp)) { if (is.null(legend) || (is.logical(legend) && legend)) legend <- legend_resbased gpfun <- if (inherits(gp, "grapcon_generator")) do.call("gp", c(list(x, residuals, expected, df), as.list(gp_args))) else gp gp <- gpfun(residuals) } else if (!is.null(legend) && !(is.logical(legend) && !legend)) stop("gp argument must be a shading function for drawing a legend") } else { if(!is.null(gp)) { warning("gp parameter ignored since shade = FALSE") gp <- NULL } } ## choose gray when no shading is used if (is.null(gp)) gp <- gpar(fill = grey(0.8)) ## recycle gpar values in the last dimension size <- prod(d) FUN <- function(par) { if (is.structable(par)) par <- as.table(par) if (length(par) < size || is.null(dim(par))) aperm(array(par, dim = rev(d))) else par } gp <- structure(lapply(gp, FUN), class = "gpar") ## set up page if (newpage) grid.newpage() if (keep_aspect_ratio) pushViewport(viewport(width = 1, height = 1, default.units = "snpc")) pushViewport(vcdViewport(mar = margins, oma = title_margins, legend = shade && !(is.null(legend) || is.logical(legend) && !legend), main = !is.null(main), sub = !is.null(sub), keep_aspect_ratio = keep_aspect_ratio, legend_width = legend_width, prefix = prefix)) ## legend if (inherits(legend, "grapcon_generator")) legend <- do.call("legend", legend_args) if (shade && !is.null(legend) && !(is.logical(legend) && !legend)) { seekViewport(paste(prefix, "legend", sep = "")) residuals_type <- switch(residuals_type, deviance = "deviance\nresiduals:", ft = "Freeman-Tukey\nresiduals:", pearson = "Pearson\nresiduals:", residuals_type) legend(residuals, gpfun, residuals_type) } ## titles if (!is.null(main)) { seekViewport(paste(prefix, "main", sep = "")) if (is.logical(main) && main) main <- deparse(substitute(x)) grid.text(main, gp = main_gp) } if (!is.null(sub)) { seekViewport(paste(prefix, "sub", sep = "")) if (is.logical(sub) && sub && is.null(main)) sub <- deparse(substitute(x)) grid.text(sub, gp = sub_gp) } ## make plot seekViewport(paste(prefix, "plot", sep = "")) if (inherits(core, "grapcon_generator")) core <- do.call("core", core_args) core(residuals = residuals, observed = if (type == "observed") x else expected, expected = if (type == "observed") expected else x, spacing = spacing, gp = gp, split_vertical = split_vertical, prefix = prefix) upViewport(1) ## labels if (is.logical(labeling)) labeling <- if (labeling) labeling_border else NULL if (!is.null(labeling)) { if (inherits(labeling, "grapcon_generator")) labeling <- do.call("labeling", c(labeling_args, list(...))) labeling(dn, split_vertical, condvars, prefix) } ## pop/move up viewport seekViewport(paste(prefix, "base", sep = "")) ## one more up if sandwich-mode if (pop) popViewport(1 + keep_aspect_ratio) else upViewport(1 + keep_aspect_ratio) ## return visualized table if (return_grob) invisible(structure(structable(if (type == "observed") x else expected, split_vertical = split_vertical), grob = grid.grab() ) ) else invisible(structable(if (type == "observed") x else expected, split_vertical = split_vertical)) } vcdViewport <- function(mar = rep.int(2.5, 4), legend_width = unit(5, "lines"), oma = NULL, legend = FALSE, main = FALSE, sub = FALSE, keep_aspect_ratio = TRUE, prefix = "") { ## process parameters if (is.null(legend_width)) legend_width <- unit(5 * legend, "lines") if (!is.unit(legend_width)) legend_width <- unit(legend_width, "lines") if (legend && !main && !sub && keep_aspect_ratio) main <- sub <- TRUE mar <- if (!is.unit(mar)) unit(pexpand(mar, 4, rep.int(2.5, 4), c("top","right","bottom","left")), "lines") else rep(mar, length.out = 4) if (is.null(oma)) { space <- if (legend && keep_aspect_ratio) legend_width + mar[2] + mar[4] - mar[1] - mar[3] else unit(0, "lines") oma <- if (main && sub) max(unit(2, "lines"), 0.5 * space) else if (main) unit.c(max(unit(2, "lines"), space), unit(0, "lines")) else if (sub) unit.c(unit(0, "lines"), max(unit(2, "lines"), space)) else 0.5 * space } oma <- if (!is.unit(oma)) unit(pexpand(oma, 2, rep.int(2, 2), c("top","bottom")), "lines") else rep(oma, length.out = 2) ## set up viewports vpPlot <- vpStack(viewport(layout.pos.col = 2, layout.pos.row = 3), viewport(width = 1, height = 1, name = paste(prefix, "plot", sep = ""), default.units = if (keep_aspect_ratio) "snpc" else "npc")) vpMarginBottom <- viewport(layout.pos.col = 2, layout.pos.row = 4, name = paste(prefix, "margin_bottom", sep = "")) vpMarginLeft <- viewport(layout.pos.col = 1, layout.pos.row = 3, name = paste(prefix, "margin_left", sep = "")) vpMarginTop <- viewport(layout.pos.col = 2, layout.pos.row = 2, name = paste(prefix, "margin_top", sep = "")) vpMarginRight <- viewport(layout.pos.col = 3, layout.pos.row = 3, name = paste(prefix, "margin_right", sep = "")) vpCornerTL <- viewport(layout.pos.col = 1, layout.pos.row = 2, name = paste(prefix, "corner_top_left", sep = "")) vpCornerTR <- viewport(layout.pos.col = 3, layout.pos.row = 2, name = paste(prefix, "corner_top_right", sep = "")) vpCornerBL <- viewport(layout.pos.col = 1, layout.pos.row = 4, name = paste(prefix, "corner_bottom_left", sep = "")) vpCornerBR <- viewport(layout.pos.col = 3, layout.pos.row = 4, name = paste(prefix, "corner_bottom_right", sep = "")) vpLegend <- viewport(layout.pos.col = 4, layout.pos.row = 3, name = paste(prefix, "legend", sep = "")) vpLegendTop <- viewport(layout.pos.col = 4, layout.pos.row = 2, name = paste(prefix, "legend_top", sep = "")) vpLegendSub <- viewport(layout.pos.col = 4, layout.pos.row = 4, name = paste(prefix, "legend_sub", sep = "")) vpBase <- viewport(layout = grid.layout(5, 4, widths = unit.c(mar[4], unit(1, "null"), mar[2], legend_width), heights = unit.c(oma[1], mar[1], unit(1, "null"), mar[3], oma[2])), name = paste(prefix, "base", sep = "")) vpMain <- viewport(layout.pos.col = 1:4, layout.pos.row = 1, name = paste(prefix, "main", sep = "")) vpSub <- viewport(layout.pos.col = 1:4, layout.pos.row = 5, name = paste(prefix, "sub", sep = "")) vpTree(vpBase, vpList(vpMain, vpMarginBottom, vpMarginLeft, vpMarginTop, vpMarginRight, vpLegendTop, vpLegend, vpLegendSub, vpCornerTL, vpCornerTR, vpCornerBL, vpCornerBR, vpPlot, vpSub)) } vcd/R/spacings.R0000755000175100001440000000344311566471033013214 0ustar hornikusers################################################################## ## spacings spacing_equal <- function(sp = unit(0.3, "lines")) { if (!is.unit(sp)) sp <- unit(sp, "lines") function(d, condvars = NULL) lapply(d, function(x) if(x > 1) rep(sp, x - 1) else NA) } class(spacing_equal) <- "grapcon_generator" spacing_dimequal <- function(sp) { if (!is.unit(sp)) sp <- unit(sp, "lines") function(d, condvars = NULL) lapply(seq_along(d), function(i) if(d[i] > 1) rep(sp[i], d[i] - 1) else NA) } class(spacing_dimequal) <- "grapcon_generator" spacing_increase <- function(start = unit(0.3, "lines"), rate = 1.5) { if (!is.unit(start)) start <- unit(start, "lines") function(d, condvars = NULL) { sp <- start * rev(cumprod(c(1, rep.int(rate, length(d) - 1)))) spacing_dimequal(sp)(d = d, condvars = condvars) } } class(spacing_increase) <- "grapcon_generator" spacing_highlighting <- function(start = unit(0.2, "lines"), rate = 1.5) { if (!is.unit(start)) start <- unit(start, "lines") function(d, condvars = NULL) c(spacing_increase(start, rate)(d, condvars)[-length(d)], list(unit(rep(0, d[length(d)]), "lines"))) } class(spacing_highlighting) <- "grapcon_generator" spacing_conditional <- function(sp = unit(0.3, "lines"), start = unit(2, "lines"), rate = 1.8) { condfun <- spacing_increase(start, rate) equalfun <- spacing_equal(sp) equalfun2 <- spacing_equal(start) function(d, condvars) { if (length(d) < 3) return(spacing_equal(sp)(d, condvars)) condvars <- seq(condvars) ret <- vector("list", length(d)) ret[condvars] <- if (length(condvars) < 3) equalfun2(d[condvars]) else condfun(d[condvars]) ret[-condvars] <- equalfun(d[-condvars]) ret } } class(spacing_conditional) <- "grapcon_generator" vcd/R/sieve.R0000644000175100001440000003147212467662166012532 0ustar hornikusers########################################################### ## sieveplot sieve <- function(x, ...) UseMethod("sieve") sieve.formula <- function(formula, data = NULL, ..., main = NULL, sub = NULL, subset = NULL) { if (is.logical(main) && main) main <- deparse(substitute(data)) else if (is.logical(sub) && sub) sub <- deparse(substitute(data)) m <- match.call(expand.dots = FALSE) edata <- eval(m$data, parent.frame()) fstr <- strsplit(paste(deparse(formula), collapse = ""), "~") vars <- strsplit(strsplit(gsub(" ", "", fstr[[1]][2]), "\\|")[[1]], "\\+") varnames <- vars[[1]] condnames <- if (length(vars) > 1) vars[[2]] else NULL if (inherits(edata, "ftable") || inherits(edata, "table") || length(dim(edata)) > 2) { condind <- NULL dat <- as.table(data) if(all(varnames != ".")) { ind <- match(varnames, names(dimnames(dat))) if (any(is.na(ind))) stop(paste("Can't find", paste(varnames[is.na(ind)], collapse=" / "), "in", deparse(substitute(data)))) if (!is.null(condnames)) { condind <- match(condnames, names(dimnames(dat))) if (any(is.na(condind))) stop(paste("Can't find", paste(condnames[is.na(condind)], collapse=" / "), "in", deparse(substitute(data)))) ind <- c(condind, ind) } dat <- margin.table(dat, ind) } sieve.default(dat, main = main, sub = sub, condvars = if (is.null(condind)) NULL else match(condnames, names(dimnames(dat))), ...) } else { tab <- if ("Freq" %in% colnames(data)) xtabs(formula(paste("Freq~", paste(c(condnames, varnames), collapse = "+"))), data = data, subset = subset) else xtabs(formula(paste("~", paste(c(condnames, varnames), collapse = "+"))), data = data, subset = subset) sieve.default(tab, main = main, sub = sub, ...) } } sieve.default <- function(x, condvars = NULL, gp = NULL, shade = NULL, legend = FALSE, split_vertical = NULL, direction = NULL, spacing = NULL, spacing_args = list(), sievetype = c("observed","expected"), gp_tile = gpar(), scale = 1, main = NULL, sub = NULL, ...) { if (is.logical(main) && main) main <- deparse(substitute(x)) else if (is.logical(sub) && sub) sub <- deparse(substitute(x)) sievetype = match.arg(sievetype) if (is.logical(shade) && shade && is.null(gp)) gp <- if (sievetype == "observed") # shading_sieve(interpolate = 0, lty = c("longdash", "solid")) shading_sieve(interpolate = 0, lty = c("solid", "longdash")) else shading_sieve(interpolate = 0, line_col = "darkgray", eps = Inf, lty = "dotted") if (is.structable(x)) { if (is.null(direction) && is.null(split_vertical)) split_vertical <- attr(x, "split_vertical") x <- as.table(x) } if (is.null(split_vertical)) split_vertical <- FALSE dl <- length(dim(x)) ## splitting argument if (!is.null(direction)) split_vertical <- direction == "v" if (length(split_vertical) == 1) split_vertical <- rep(c(split_vertical, !split_vertical), length.out = dl) if (length(split_vertical) < dl) split_vertical <- rep(split_vertical, length.out = dl) ## condvars if (!is.null(condvars)) { if (is.character(condvars)) condvars <- match(condvars, names(dimnames(x))) x <- aperm(x, c(condvars, seq(dl)[-condvars])) if (is.null(spacing)) spacing <- spacing_conditional } ## spacing argument if (is.null(spacing)) spacing <- if (dl < 3) spacing_equal(sp = 0) else spacing_increase strucplot(x, condvars = if (is.null(condvars)) NULL else length(condvars), core = struc_sieve(sievetype = sievetype, gp_tile = gp_tile, scale = scale), split_vertical = split_vertical, spacing = spacing, spacing_args = spacing_args, main = main, sub = sub, shade = shade, legend = legend, gp = gp, ...) } ## old version (not performant enough) ## ## struc_sieve <- function(sievetype = c("observed", "expected")) { ## sievetype = match.arg(sievetype) ## function(residuals, observed, expected, spacing, gp, split_vertical, prefix = "") { ## dn <- dimnames(expected) ## dnn <- names(dn) ## dx <- dim(expected) ## dl <- length(dx) ## n <- sum(expected) ## ## split workhorse ## split <- function(x, i, name, row, col, rowmargin, colmargin) { ## cotab <- co_table(x, 1) ## margin <- sapply(cotab, sum) ## v <- split_vertical[i] ## d <- dx[i] ## ## compute total cols/rows and build split layout ## dist <- unit.c(unit(margin, "null"), spacing[[i]]) ## idx <- matrix(1:(2 * d), nrow = 2, byrow = TRUE)[-2 * d] ## layout <- if (v) ## grid.layout(ncol = 2 * d - 1, widths = dist[idx]) ## else ## grid.layout(nrow = 2 * d - 1, heights = dist[idx]) ## vproot <- viewport(layout.pos.col = col, layout.pos.row = row, ## layout = layout, name = remove_trailing_comma(name)) ## ## next level: either create further splits, or final viewports ## name <- paste(name, dnn[i], "=", dn[[i]], ",", sep = "") ## row <- col <- rep.int(1, d) ## if (v) col <- 2 * 1:d - 1 else row <- 2 * 1:d - 1 ## proptab <- function(x) x / max(sum(x), 1) ## f <- if (i < dl) { ## if (v) ## function(m) split(cotab[[m]], i + 1, name[m], row[m], col[m], ## colmargin = colmargin * proptab(margin)[m], ## rowmargin = rowmargin) ## else ## function(m) split(cotab[[m]], i + 1, name[m], row[m], col[m], ## colmargin = colmargin, ## rowmargin = rowmargin * proptab(margin)[m]) ## } else { ## if (v) ## function(m) viewport(layout.pos.col = col[m], layout.pos.row = row[m], ## name = remove_trailing_comma(name[m]), ## yscale = c(0, rowmargin), ## xscale = c(0, colmargin * proptab(margin)[m])) ## else ## function(m) viewport(layout.pos.col = col[m], layout.pos.row = row[m], ## name = remove_trailing_comma(name[m]), ## yscale = c(0, rowmargin * proptab(margin)[m]), ## xscale = c(0, colmargin)) ## } ## vpleaves <- structure(lapply(1:d, f), class = c("vpList", "viewport")) ## vpTree(vproot, vpleaves) ## } ## ## start splitting on top, creates viewport-tree ## pushViewport(split(expected + .Machine$double.eps, ## i = 1, name = paste(prefix, "cell:", sep = ""), row = 1, col = 1, ## rowmargin = n, colmargin = n)) ## ## draw rectangles ## mnames <- apply(expand.grid(dn), 1, ## function(i) paste(dnn, i, collapse=",", sep = "=") ## ) ## for (i in seq_along(mnames)) { ## seekViewport(paste(prefix, "cell:", mnames[i], sep = "")) ## vp <- current.viewport() ## gpobj <- structure(lapply(gp, function(x) x[i]), class = "gpar") ## div <- if (sievetype == "observed") observed[i] else expected[i] ## if (div > 0) { ## square.side <- sqrt(vp$yscale[2] * vp$xscale[2] / div) ## ii <- seq(0, vp$xscale[2], by = square.side) ## jj <- seq(0, vp$yscale[2], by = square.side) ## grid.segments(x0 = ii, x1 = ii, y0 = 0, y1 = vp$yscale[2], ## default.units = "native", gp = gpobj) ## grid.segments(x0 = 0, x1 = vp$xscale[2], y0 = jj, y1 = jj, ## default.units = "native", gp = gpobj) ## } ## grid.rect(name = paste(prefix, "rect:", mnames[i], sep = ""), ## gp = gpar(fill = "transparent")) ## } ## } ## } ##class(struc_sieve) <- "grapcon_generator" struc_sieve <- function(sievetype = c("observed", "expected"), gp_tile = gpar(), scale = 1) { sievetype = match.arg(sievetype) function(residuals, observed, expected, spacing, gp, split_vertical, prefix = "") { observed <- scale * observed expected <- scale * expected if (is.null(expected)) stop("Need expected values.") dn <- dimnames(expected) dnn <- names(dn) dx <- dim(expected) dl <- length(dx) n <- sum(expected) ## split workhorse split <- function(x, i, name, row, col, rowmargin, colmargin, index) { cotab <- co_table(x, 1) margin <- sapply(cotab, sum) v <- split_vertical[i] d <- dx[i] ## compute total cols/rows and build split layout dist <- if (d > 1) unit.c(unit(margin, "null"), spacing[[i]]) else unit(margin, "null") idx <- matrix(1:(2 * d), nrow = 2, byrow = TRUE)[-2 * d] layout <- if (v) grid.layout(ncol = 2 * d - 1, widths = dist[idx]) else grid.layout(nrow = 2 * d - 1, heights = dist[idx]) pushViewport(viewport(layout.pos.col = col, layout.pos.row = row, layout = layout, name = paste(prefix, "cell:", remove_trailing_comma(name), sep = ""))) ## next level: either create further splits, or final viewports row <- col <- rep.int(1, d) if (v) col <- 2 * 1:d - 1 else row <- 2 * 1:d - 1 proptab <- function(x) x / max(sum(x), 1) for (m in 1:d) { nametmp <- paste(name, dnn[i], "=", dn[[i]][m], ",", sep = "") if (v) { colmargintmp <- colmargin * proptab(margin)[m] rowmargintmp <- rowmargin } else { rowmargintmp <- rowmargin * proptab(margin)[m] colmargintmp <- colmargin } if (i < dl) split(cotab[[m]], i + 1, nametmp, row[m], col[m], colmargin = colmargintmp, rowmargin = rowmargintmp, index = cbind(index, m)) else { pushViewport(viewport(layout.pos.col = col[m], layout.pos.row = row[m], name = paste(prefix, "cell:", remove_trailing_comma(nametmp), sep = ""), yscale = c(0, rowmargintmp), xscale = c(0, colmargintmp))) gpobj <- structure(lapply(gp, function(x) x[cbind(index, m)]), class = "gpar") ## draw sieve div <- if (sievetype == "observed") observed[cbind(index, m)] else expected[cbind(index, m)] gptmp <- gp_tile gptmp$col <- "transparent" grid.rect(name = paste(prefix, "rect:", nametmp, sep = ""), gp = gptmp) if (div > 0) { square.side <- sqrt(colmargintmp * rowmargintmp / div) ii <- seq(0, colmargintmp, by = square.side) jj <- seq(0, rowmargintmp, by = square.side) grid.segments(x0 = ii, x1 = ii, y0 = 0, y1 = rowmargintmp, default.units = "native", gp = gpobj) grid.segments(x0 = 0, x1 = colmargintmp, y0 = jj, y1 = jj, default.units = "native", gp = gpobj) } gptmp <- gp_tile gptmp$fill <- "transparent" grid.rect(name = paste(prefix, "border:", nametmp, sep = ""), gp = gptmp) } upViewport(1) } } ## start splitting on top, creates viewport-tree split(expected + .Machine$double.eps, i = 1, name = "", row = 1, col = 1, rowmargin = n, colmargin = n, index = cbind()) } } class(struc_sieve) <- "grapcon_generator" vcd/R/cotabplot.R0000655000175100001440000003025512505557216013376 0ustar hornikuserscotabplot <- function(x, ...) { UseMethod("cotabplot") } cotabplot.formula <- function(formula, data = NULL, ...) { m <- match.call() edata <- eval(m$data, parent.frame()) fstr <- deparse(formula) fstr <- gsub("*", "+", fstr, fixed = TRUE) fstr <- gsub("/", "+", fstr, fixed = TRUE) fstr <- gsub("(", "", fstr, fixed = TRUE) fstr <- gsub(")", "", fstr, fixed = TRUE) fstr <- strsplit(paste(fstr, collapse = ""), "~") vars <- strsplit(strsplit(gsub(" ", "", fstr[[1]][2]), "\\|")[[1]], "\\+") varnames <- vars[[1]] condnames <- if(length(vars) > 1) vars[[2]] else NULL if (inherits(edata, "ftable") || inherits(edata, "table") || length(dim(edata)) > 2) { tab <- as.table(data) if(all(varnames != ".")) { ind <- match(varnames, names(dimnames(tab))) if (any(is.na(ind))) stop(paste("Can't find", paste(varnames[is.na(ind)], collapse=" / "), "in", deparse(substitute(data)))) if (!is.null(condnames)) { condind <- match(condnames, names(dimnames(tab))) if (any(is.na(condind))) stop(paste("Can't find", paste(condnames[is.na(condind)], collapse=" / "), "in", deparse(substitute(data)))) ind <- c(condind, ind) } tab <- margin.table(tab, ind) } } else { tab <- if ("Freq" %in% colnames(data)) xtabs(formula(paste("Freq~", paste(c(condnames, varnames), collapse = " + "))), data = data) else xtabs(formula(paste("~", paste(c(condnames, varnames), collapse = " + "))), data = data) } tab <- margin.table(tab, match(c(varnames, condnames), names(dimnames(tab)))) cotabplot(tab, cond = condnames, ...) } cotabplot.default <- function(x, cond = NULL, panel = cotab_mosaic, panel_args = list(), margins = rep(1, 4), layout = NULL, text_gp = gpar(fontsize = 12), rect_gp = gpar(fill = grey(0.9)), pop = TRUE, newpage = TRUE, return_grob = FALSE, ...) { ## coerce to table x <- as.table(x) ## initialize newpage if(newpage) grid.newpage() ## process default option ldx <- length(dim(x)) if(is.null(cond)) { indep <- if(ldx > 1) 1:2 else 1 if(ldx > 2) cond <- 3:ldx } else { if(is.character(cond)) cond <- match(cond, names(dimnames(x))) cond <- as.integer(cond) indep <- (1:ldx)[!(1:ldx %in% cond)] } ## sort margins x <- margin.table(x, c(indep, cond)) ## convenience variables that describe conditioning variables if(is.null(cond)) { cond.n <- 0 cond.num <- cond.dnam <- cond.char <- NULL } else { cond.n <- length(cond) ## number of variables cond.num <- (length(indep) + 1):ldx ## position in x cond.dnam <- dimnames(x)[cond.num] ## corresponding dimnames cond.char <- names(cond.dnam) ## names of variables } ## create panel function (if necessary) if(inherits(panel, "grapcon_generator")) panel <- do.call("panel", c(list(x, cond.char), as.list(panel_args), list(...))) if(cond.n < 1) panel(x, NULL) ## no conditioning variables else { cond.nlevels <- sapply(cond.dnam, length) nplots <- prod(cond.nlevels) condition <- as.matrix(expand.grid(cond.dnam)) ## compute layout #Z# needs fixing for more than two conditioning variables if(is.null(layout)) { layout <- c(1,1,1) ## rows, cols, pages if(cond.n == 1) { layout[2] <- ceiling(sqrt(floor(cond.nlevels))) layout[1] <- ceiling(cond.nlevels/layout[2]) } else { layout[1] <- cond.nlevels[1] layout[2] <- cond.nlevels[2] if(cond.n >= 3) layout[3] <- nplots/prod(cond.nlevels[1:2]) #Z# FIXME if(layout[3] > 1) stop("multiple pages not supported yet") } } else { layout <- c(rep(layout, length.out = 2), 1) if(layout[1] * layout[2] < nplots) stop("number of panels specified in 'layout' is too small") } layout <- expand.grid(lapply(layout, function(x) 1:x))[1:nplots,] ## push basic grid of nr x nc cells nr <- max(layout[,1]) nc <- max(layout[,2]) pushViewport(plotViewport(margins)) pushViewport(viewport(layout = grid.layout(nr, nc, widths = unit(1/nc, "npc")))) strUnit <- unit(2 * ncol(condition), "strheight", "A") cellport <- function(name) viewport(layout = grid.layout(2, 1, heights = unit.c(strUnit, unit(1, "npc") - strUnit)), name = name) ## go through each conditioning combination for(i in 1:nrow(condition)) { ## conditioning information in ith cycle condi <- as.vector(condition[i,]) names(condi) <- colnames(condition) condistr <- paste(condi, collapse = ".") condilab <- paste(cond.char, condi, sep = " = ") ## header pushViewport(viewport(layout.pos.row = layout[i,1], layout.pos.col = layout[i,2])) pushViewport(cellport(paste("cell", condistr, sep = "."))) pushViewport(viewport(layout.pos.row = 1, name = paste("lab", condistr, sep = "."))) grid.rect(gp = rect_gp) grid.text(condilab, y = cond.n:1/cond.n - 1/(2*cond.n), gp = text_gp) grid.segments(0, 0:cond.n/cond.n, 1, 0:cond.n/cond.n) upViewport() ## main plot pushViewport(viewport(layout.pos.row = 2, name = paste("plot", condistr, sep = "."))) panel(x, condi) upViewport(2) grid.rect(gp = gpar(fill = "transparent")) upViewport() } upViewport() if(pop) popViewport() else upViewport() } if (return_grob) invisible(structure(x, grob = grid.grab())) else invisible(x) } cotab_mosaic <- function(x = NULL, condvars = NULL, ...) { function(x, condlevels) { if(is.null(condlevels)) mosaic(x, newpage = FALSE, pop = FALSE, return_grob = FALSE, ...) else mosaic(co_table(x, names(condlevels))[[paste(condlevels, collapse = ".")]], newpage = FALSE, pop = FALSE, return_grob = FALSE, prefix = paste("panel:", paste(names(condlevels), condlevels, sep = "=", collapse = ","), "|", sep = ""), ...) } } class(cotab_mosaic) <- "grapcon_generator" cotab_sieve <- function(x = NULL, condvars = NULL, ...) { function(x, condlevels) { if(is.null(condlevels)) sieve(x, newpage = FALSE, pop = FALSE, return_grob = FALSE, ...) else sieve(co_table(x, names(condlevels))[[paste(condlevels, collapse = ".")]], newpage = FALSE, pop = FALSE, return_grob = FALSE, prefix = paste("panel:", paste(names(condlevels), condlevels, sep = "=", collapse = ","), "|", sep = ""), ...) } } class(cotab_sieve) <- "grapcon_generator" cotab_assoc <- function(x = NULL, condvars = NULL, ylim = NULL, ...) { if(!is.null(x)) { fm <- coindep_test(x, condvars, n = 1) if(is.null(ylim)) ylim <- range(residuals(fm)) } function(x, condlevels) { if(is.null(condlevels)) assoc(x, newpage = FALSE, pop = FALSE, ylim = ylim, return_grob = FALSE, ...) else assoc(co_table(x, names(condlevels))[[paste(condlevels, collapse = ".")]], newpage = FALSE, pop = FALSE, return_grob = FALSE, ylim = ylim, prefix = paste("panel:", paste(names(condlevels), condlevels, sep = "=", collapse = ","), "|", sep = ""), ...) } } class(cotab_assoc) <- "grapcon_generator" cotab_fourfold <- function (x = NULL, condvars = NULL, ...) { function(x, condlevels) { if (is.null(condlevels)) fourfold(x, newpage = FALSE, return_grob = FALSE, ...) else fourfold(co_table(x, names(condlevels))[[paste(condlevels, collapse = ".")]], newpage = FALSE, return_grob = FALSE, ...) } } class(cotab_fourfold) <- "grapcon_generator" cotab_loddsratio <- function(x = NULL, condvars = NULL, ...) { function(x, condlevels) { if(is.null(condlevels)) { plot(loddsratio(x, ...), newpage = FALSE, pop = FALSE, return_grob = FALSE, ...) } else { plot(loddsratio(co_table(x, names(condlevels))[[paste(condlevels, collapse = ".")]], ...), newpage = FALSE, pop = FALSE, return_grob = FALSE, prefix = paste("panel:", paste(names(condlevels), condlevels, sep = "=", collapse = ","), "|", sep = ""), ...) } upViewport(2) } } class(cotab_loddsratio) <- "grapcon_generator" cotab_agreementplot <- function(x = NULL, condvars = NULL, ...) { function(x, condlevels) { if(is.null(condlevels)) agreementplot(x, newpage = FALSE, pop = FALSE, return_grob = FALSE, ...) else agreementplot(co_table(x, names(condlevels))[[paste(condlevels, collapse = ".")]], newpage = FALSE, pop = FALSE, return_grob = FALSE, prefix = paste("panel:", paste(names(condlevels), condlevels, sep = "=", collapse = ","), "|", sep = ""), ...) } } class(cotab_agreementplot) <- "grapcon_generator" cotab_coindep <- function(x, condvars, test = c("doublemax", "maxchisq", "sumchisq"), level = NULL, n = 1000, interpolate = c(2, 4), h = NULL, c = NULL, l = NULL, lty = 1, type = c("mosaic", "assoc"), legend = FALSE, ylim = NULL, ...) { if(is.null(condvars)) stop("at least one conditioning variable is required") ## set color defaults if(is.null(h)) h <- c(260, 0) if(is.null(c)) c <- c(100, 20) if(is.null(l)) l <- c(90, 50) ## process conditional variables and get independent variables ## store some convenience information ldx <- length(dim(x)) if(is.character(condvars)) condvars <- match(condvars, names(dimnames(x))) condvars <- as.integer(condvars) indep <- (1:ldx)[!(1:ldx %in% condvars)] ## sort margins x <- margin.table(x, c(indep, condvars)) ind.n <- length(indep) ind.num <- 1:ind.n ind.dnam <- dimnames(x)[ind.num] ind.char <- names(ind.dnam) cond.n <- length(condvars) cond.num <- (ind.n + 1):length(dim(x)) cond.dnam <- dimnames(x)[cond.num] cond.char <- names(cond.dnam) test <- match.arg(test) switch(test, "doublemax" = { if(is.null(level)) level <- c(0.9, 0.99) fm <- coindep_test(x, cond.num, n = n) resids <- residuals(fm) col.bins <- fm$qdist(sort(level)) gpfun <- shading_hcl(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = h, c = c, l = l, interpolate = col.bins, lty = lty, p.value = fm$p.value) }, "maxchisq" = { if(is.null(level)) level <- 0.95 level <- level[1] fm <- coindep_test(x, cond.num, n = n, indepfun = function(x) sum(x^2)) resids <- residuals(fm) chisqs <- sapply(co_table(residuals(fm), fm$margin), function(x) sum(x^2)) pvals <- 1 - fm$pdist(chisqs) gpfun <- sapply(pvals, function(p) shading_hcl(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = h, c = c, l = l, interpolate = interpolate, lty = lty, level = level, p.value = p)) }, "sumchisq" = { if(is.null(level)) level <- 0.95 level <- level[1] fm <- coindep_test(x, cond.num, n = n, indepfun = function(x) sum(x^2), aggfun = sum) resids <- residuals(fm) gpfun <- shading_hcl(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = h, c = c, l = l, interpolate = interpolate, lty = lty, level = level, p.value = fm$p.value) }) type <- match.arg(type) if(type == "mosaic") { rval <- function(x, condlevels) { if(is.null(condlevels)) { tab <- x gp <- if(is.list(gpfun)) gpfun[[1]] else gpfun } else { tab <- co_table(x, names(condlevels))[[paste(condlevels, collapse = ".")]] gp <- if(is.list(gpfun)) gpfun[[paste(condlevels, collapse = ".")]] else gpfun } mosaic(tab, newpage = FALSE, pop = FALSE, return_grob = FALSE, gp = gp, legend = legend, prefix = paste("panel:", paste(names(condlevels), condlevels, sep = "=", collapse = ","), "|", sep = ""), ...) } } else { if(is.null(ylim)) ylim <- range(resids) rval <- function(x, condlevels) { if(is.null(condlevels)) { tab <- x gp <- if(is.list(gpfun)) gpfun[[1]] else gpfun } else { tab <- co_table(x, names(condlevels))[[paste(condlevels, collapse = ".")]] gp <- if(is.list(gpfun)) gpfun[[paste(condlevels, collapse = ".")]] else gpfun } assoc(tab, newpage = FALSE, pop = FALSE, return_grob = FALSE, gp = gp, legend = legend, ylim = ylim, prefix = paste("panel:", paste(names(condlevels), condlevels, sep = "=", collapse = ","), "|", sep = ""), ...) } } return(rval) } class(cotab_coindep) <- "grapcon_generator" vcd/R/co_table.R0000755000175100001440000000161211623033204013135 0ustar hornikusersco_table <- function(x, margin, collapse = ".") { if (!is.array(x)) stop("x is not an array") if("xtabs" %in% class(x)) attr(x, "call") <- NULL dx <- dim(x) idx <- lapply(dx, function(i) 1:i) dn <- dimnames(x) if(is.character(margin)) { if(is.null(dn)) stop("margin must be an index when no dimnames are given") margin <- which(names(dn) %in% margin) } idxm <- expand.grid(idx[margin]) cotab1 <- function(i) { idx[margin] <- lapply(1:length(margin), function(j) idxm[i,j]) rval <- as.table(do.call("[", c(list(x), idx, list(drop = FALSE)))) if(length(dim(rval)) > 1) { dim(rval) <- dim(x)[-margin] dimnames(rval) <- dimnames(x)[-margin] } return(rval) } rval <- lapply(1:NROW(idxm), cotab1) if(!is.null(dn)) names(rval) <- apply(expand.grid(dn[margin]), 1, function(z) paste(z, collapse = collapse)) return(rval) } vcd/R/rootogram.R0000655000175100001440000001661312510525065013413 0ustar hornikusersrootogram <- function(x, ...) { UseMethod("rootogram") } rootogram.goodfit <- function(x, ...) { rootogram.default(x$observed, x$fitted, names = x$count, df = x$df, ...) } rootogram.default <- function(x, fitted, names = NULL, scale = c("sqrt", "raw"), type = c("hanging", "standing", "deviation"), shade = FALSE, legend = TRUE, legend_args = list(x = 0, y = 0.2, height = 0.6), df = NULL, rect_gp = NULL, rect_gp_args = list(), lines_gp = gpar(col = "red", lwd = 2), points_gp = gpar(col = "red"), pch = 19, xlab = NULL, ylab = NULL, ylim = NULL, main = NULL, sub = NULL, margins = unit(0, "lines"), title_margins = NULL, legend_width = NULL, main_gp = gpar(fontsize = 20), sub_gp = gpar(fontsize = 15), name = "rootogram", prefix = "", keep_aspect_ratio = FALSE, newpage = TRUE, pop = TRUE, return_grob = FALSE, ...) { if(is.null(names)) names <- names(x) if(is.table(x)) { if(length(dim(x)) > 1) stop ("x must be a 1-way table") x <- as.vector(x) } obs <- x fit <- fitted res <- (obs - fit) / sqrt(fit) if(is.null(xlab)) {xlab <- "Number of Occurrences"} if(match.arg(scale) == "sqrt") { obs <- sqrt(obs) fit <- sqrt(fit) if(is.null(ylab)) {ylab <- "sqrt(Frequency)"} } else { if(is.null(ylab)) {ylab <- "Frequency"} } ## rect_gp (color, fill, lty, etc.) argument if (shade) { if (is.null(rect_gp)) rect_gp <- shading_hcl if (is.function(rect_gp)) { if (is.null(legend) || (is.logical(legend) && legend)) legend <- legend_resbased gpfun <- if (inherits(rect_gp, "grapcon_generator")) do.call("rect_gp", c(list(obs, res, fit, df), rect_gp_args)) else rect_gp rect_gp <- gpfun(res) } else if (!is.null(legend) && !(is.logical(legend) && !legend)) stop("rect_gp argument must be a shading function for drawing a legend") } if (is.null(rect_gp)) rect_gp <- gpar(fill = "lightgray") ## set up page if (newpage) grid.newpage() if (keep_aspect_ratio) pushViewport(viewport(width = 1, height = 1, default.units = "snpc")) pushViewport(vcdViewport(mar = margins, oma = title_margins, legend = shade && !(is.null(legend) || is.logical(legend) && !legend), main = !is.null(main), sub = !is.null(sub), keep_aspect_ratio = keep_aspect_ratio, legend_width = legend_width, prefix = prefix)) ## legend if (inherits(legend, "grapcon_generator")) legend <- do.call("legend", legend_args) if (shade && !is.null(legend) && !(is.logical(legend) && !legend)) { seekViewport(paste(prefix, "legend", sep = "")) legend(res, gpfun, "Pearson\nresiduals:") } ## titles if (!is.null(main)) { seekViewport(paste(prefix, "main", sep = "")) if (is.logical(main) && main) main <- deparse(substitute(x)) grid.text(main, gp = main_gp) } if (!is.null(sub)) { seekViewport(paste(prefix, "sub", sep = "")) if (is.logical(sub) && sub && is.null(main)) sub <- deparse(substitute(x)) grid.text(sub, gp = sub_gp) } seekViewport(paste(prefix, "plot", sep = "")) switch(match.arg(type), "hanging" = { if(is.null(ylim)) {ylim <- range(-0.1 * c(fit-obs,fit), c(fit-obs,fit)) + c(0, 0.1)} dummy <- grid_barplot(obs, names = names, offset = fit - obs, gp = rect_gp, xlab = xlab, ylab = ylab, ylim = ylim, name = name, newpage = FALSE, pop = FALSE, return_grob = FALSE, ...) downViewport(name) grid.lines(x = dummy, y = fit, default.units = "native", gp = lines_gp) grid.points(x = dummy, y = fit, default.units = "native", gp = points_gp, pch = pch) grid.lines(x = unit(c(0, 1), "npc"), y = unit(0, "native")) if(pop) popViewport() else upViewport() }, "standing" = { if(is.null(ylim)) {ylim <- range(-0.01 * c(obs,fit), c(obs,fit)) } dummy <- grid_barplot(obs, names = names, gp = rect_gp, xlab = xlab, ylab = ylab, ylim = ylim, name = name, newpage = FALSE, pop = FALSE, return_grob = FALSE, ...) downViewport(name) grid.lines(x = dummy, y = fit, default.units = "native", gp = lines_gp) grid.points(x = dummy, y = fit, default.units = "native", gp = points_gp, pch = pch) if(pop) popViewport() else upViewport() }, "deviation" = { if(is.null(ylim)) {ylim <- range(-0.1 * c(fit-obs,fit), c(fit-obs,fit)) + c(0, 0.1)} dummy <- grid_barplot(fit - obs, names = names, gp = rect_gp, xlab = xlab, ylab = ylab, ylim = ylim, name = name, newpage = FALSE, pop = FALSE, return_grob = FALSE, ...) downViewport(name) grid.lines(x = dummy, y = fit, default.units = "native", gp = lines_gp) grid.points(x = dummy, y = fit, default.units = "native", gp = points_gp, pch = pch) if(pop) popViewport() else upViewport() } ) if (return_grob) invisible(grid.grab()) else invisible(NULL) } grid_barplot <- function(height, width = 0.8, offset = 0, names = NULL, xlim = NULL, ylim = NULL, xlab = "", ylab = "", main = "", gp = gpar(fill = "lightgray"), name = "grid_barplot", newpage = TRUE, pop = FALSE, return_grob = FALSE) { if(is.null(names)) names <- names(height) height <- as.vector(height) n <- length(height) width <- rep(width, length.out = n) offset <- rep(offset, length.out = n) if(is.null(names)) names <- rep("", n) if(is.null(xlim)) xlim <- c(1 - mean(width[c(1, n)]), n + mean(width[c(1, n)])) if(is.null(ylim)) ylim <- c(min(offset), max(height + offset)) if(newpage) grid.newpage() pushViewport(plotViewport(xscale = xlim, yscale = ylim, default.units = "native", name = name)) grid.rect(x = 1:n, y = offset, width = width, height = height, just = c("centre", "bottom"), default.units = "native", gp = gp) grid.yaxis() grid.text(names, x = unit(1:n, "native"), y = unit(rep(-1.5, n), "lines")) grid.text(xlab, y = unit(-3.5, "lines")) grid.text(ylab, x = unit(-3, "lines"), rot = 90) grid.text(main, y = unit(1, "npc") + unit(2, "lines"), gp = gpar(fontface = "bold")) if(pop) popViewport() else upViewport() if (return_grob) invisible(structure(1:n, grob = grid.grab())) else invisible(1:n) } vcd/R/loddsratio.R0000644000175100001440000005727512505557157013570 0ustar hornikusers## Modifications: ## -- return a dnames component, containing dimnames for the array version of coef ## -- added dim methods: dim.loddsratio, dimnames.loddsratio ## -- added print.loddsratio ## -- handle strata: result computed correctly, but structure of coef() loses names ## and confint doesn't work in the 2x2xk or RxCxk case ## -- Fixed problem with strata by setting rownames and colnames for contrast matrix ## DONE: handle multiple strata (|foo:bar) ## -- print.loddsratio now uses drop() for dimensions of length 1 ## -- made generic, anticipating a formula method, maybe structable or ftable methods ## DONE: decide which methods should allow a log=FALSE argument to provide exp(lor) ## -- Now handle any number of strata ## -- Added log= argument to print, coef methods, and added confint.loddsratio method, ## allowing log=FALSE ## -- Incorporated Z code additions, fixing some s ## -- Added as.matrix and as.array methods; had to make as.array S3 generic ## -- Added header to print method ## -- Added as.data.frame method (for use in plots) ## -- "LOR" is renamed "OR" if log=FALSE ## -- Revised as.matrix to drop leading 1:2 dimensions of length 1 ## -- Removed as.array generic, now in base ## -- DM: added plot.oddsratio method ## -- DM: added formula interface ## -- DM: add t() and aperm() methdos loddsratio <- function(x, ...) UseMethod("loddsratio") loddsratio.formula <- function(formula, data = NULL, ..., subset = NULL, na.action = NULL) { m <- match.call(expand.dots = FALSE) edata <- eval(m$data, parent.frame()) fstr <- strsplit(paste(deparse(formula), collapse = ""), "~") vars <- strsplit(strsplit(gsub(" ", "", fstr[[1]][2]), "\\|")[[1]], "\\+") varnames <- vars[[1]] condnames <- if (length(vars) > 1) vars[[2]] else NULL dep <- gsub(" ", "", fstr[[1]][1]) if (!dep %in% c("","Freq")) { if (all(varnames == ".")) { varnames <- if (is.data.frame(data)) colnames(data) else names(dimnames(as.table(data))) varnames <- varnames[-which(varnames %in% dep)] } varnames <- c(dep, varnames) } if (inherits(edata, "ftable") || inherits(edata, "table") || length(dim(edata)) > 2) { condind <- NULL dat <- as.table(data) if(all(varnames != ".")) { ind <- match(varnames, names(dimnames(dat))) if (any(is.na(ind))) stop(paste("Can't find", paste(varnames[is.na(ind)], collapse=" / "), "in", deparse(substitute(data)))) if (!is.null(condnames)) { condind <- match(condnames, names(dimnames(dat))) if (any(is.na(condind))) stop(paste("Can't find", paste(condnames[is.na(condind)], collapse=" / "), "in", deparse(substitute(data)))) ind <- c(ind, condind) } dat <- margin.table(dat, ind) } loddsratio.default(dat, strata = if (is.null(condind)) NULL else match(condnames, names(dimnames(dat))), ...) } else { m <- m[c(1, match(c("formula", "data", "subset", "na.action"), names(m), 0))] m[[1]] <- as.name("xtabs") m$formula <- formula(paste(if("Freq" %in% colnames(data)) "Freq", "~", paste(c(varnames, condnames), collapse = "+"))) tab <- eval(m, parent.frame()) loddsratio.default(tab, ...) } } loddsratio.default <- function(x, strata = NULL, log = TRUE, ref = NULL, correct = any(x == 0), ...) { ## check dimensions L <- length(d <- dim(x)) if(any(d < 2L)) stop("All table dimensions must be 2 or greater") if(L > 2L & is.null(strata)) strata <- 3L:L if(is.character(strata)) strata <- which(names(dimnames(x)) == strata) if(L - length(strata) != 2L) stop("All but 2 dimensions must be specified as strata.") ## dimensions of primary R x C table dp <- if (length(strata)) d[-strata] else d dn <- if (length(strata)) dimnames(x)[-strata] else dimnames(x) R <- dp[1] C <- dp[2] # shadow matrix with proper dimnames X <- matrix(0, R, C, dimnames=dn) ## process reference categories (always return list of length ## two with reference for rows/cols, respectively) if(is.null(ref)) { ref <- list(NULL, NULL) } else if(is.character(ref)) { if(length(ref) != 2L) stop("'ref' must specify both reference categories") ref <- list(match(ref[1L], rownames(x)), match(ref[2L], colnames(x))) } else if(is.numeric(ref)) { ref <- as.integer(rep(ref, length.out = 2L)) ref <- list(ref[1L], ref[2L]) } ## compute corresponding indices compute_index <- function(n, ref) { if(is.null(ref)) return(cbind(1:(n-1), 2:n)) rval <- cbind(ref, 1:n) d <- rval[,2L] - rval[,1L] rval <- rbind( rval[d > 0, 1:2], rval[d < 0, 2:1] ) return(rval[order(rval[,1L]),,drop = FALSE]) } Rix <- compute_index(R, ref[[1L]]) Cix <- compute_index(C, ref[[2L]]) ## set up contrast matrix for the primary R x C table contr <- matrix(0L, nrow = (R-1) * (C-1), ncol = R * C) colnames(contr) <- paste(rownames(X)[as.vector(row(X))], colnames(X)[as.vector(col(X))], sep = ":") rownames(contr) <- rep("", (R-1) * (C-1)) for(i in 1:(R-1)) for(j in 1:(C-1)) { rix <- (j-1) * (R-1) + i cix <- rep(Rix[i,], 2L) + R * (rep(Cix[j,], each = 2L) - 1L) contr[rix, cix] <- c(1L, -1L, -1L, 1L) rownames(contr)[rix] <- sprintf("%s/%s", paste(rownames(X)[Rix[i,]], collapse = ":"), paste(colnames(X)[Cix[j,]], collapse = ":")) } # handle strata if (!is.null(strata)) { if (length(strata)==1) { sn <- dimnames(x)[[strata]] } else { sn <- apply(expand.grid(dimnames(x)[strata]), 1, paste, collapse = ":") } rn <- as.vector(outer( dimnames(contr)[[1]], sn, paste, sep='|')) cn <- as.vector(outer( dimnames(contr)[[2]], sn, paste, sep='|')) contr <- kronecker(diag(prod(dim(x)[strata])), contr) rownames(contr) <- rn colnames(contr) <- cn } ## dimnames for array version dn <- list(rep("", R-1), rep("", C-1)) for(i in 1:(R-1)) dn[[1]][i] <- paste(rownames(x)[Rix[i,]], collapse = ":") for(j in 1:(C-1)) dn[[2]][j] <- paste(colnames(x)[Cix[j,]], collapse = ":") if (!is.null(strata)) dn <- c(dn, dimnames(x)[strata]) if (!is.null(names(dimnames(x)))) names(dn) <- names(dimnames(x)) ## point estimates if (is.logical(correct)) { add <- if(correct) 0.5 else 0 } else if(is.numeric(correct)) { add <- as.vector(correct) if (length(add) != length(x)) stop("array size of 'correct' does not conform to the data") } else stop("correct is not valid") ##coef <- drop(contr %*% log(as.vector(x) + add)) ##FIXME: 0 cells mess up the matrix product, try workaround: mat <- log(as.vector(x) + add) * t(contr) nas <- apply(contr != 0 & is.na(t(mat)), 1, any) coef <- apply(mat, 2, sum, na.rm = TRUE) coef[nas] <- NA ## covariances ##vcov <- crossprod(diag(sqrt(1/(as.vector(x) + add))) %*% t(contr)) tmp <- sqrt(1/(as.vector(x) + add)) * t(contr) tmp[is.na(tmp)] <- 0 vcov <- crossprod(tmp) vcov[nas,] <- NA vcov[,nas] <- NA rval <- structure(list( coefficients = coef, dimnames = dn, dim = as.integer(sapply(dn, length)), vcov = vcov, contrasts = contr, log = log ), class = "loddsratio") rval } ## dim methods dimnames.loddsratio <- function(x, ...) x$dimnames dim.loddsratio <- function(x, ...) x$dim ## t/aperm-methods t.loddsratio <- function(x) aperm(x) aperm.loddsratio <- function(a, perm = NULL, ...) { d <- length(a$dim) if(is.null(perm)) { perm <- if (d < 3) 2L : 1L else c(2L : 1L, d : 3L) } else { if (any(perm[1:2] > 2L) || (d > 2L) && any(perm[-c(1:2)] < 2L)) stop("Mixing of strata and non-strata variables not allowed!") } nams <- names(a$coefficients) a$coefficients <- as.vector(aperm(array(a$coef, dim = a$dim), perm, ...)) nams <- as.vector(aperm(array(nams, dim = a$dim), perm, ...)) names(a$coefficients) <- nams a$dimnames <- a$dimnames[perm] a$dim <- a$dim[perm] a$vcov <- a$vcov[nams, nams] a$contrasts <- a$contrasts[nams,] a } ## straightforward methods coef.loddsratio <- function(object, log = object$log, ...) if(log) object$coefficients else exp(object$coefficients) vcov.loddsratio <- function(object, log = object$log, ...) if(log) object$vcov else `diag<-`(object$vcov, diag(object$vcov) * exp(object$coefficients)^2) confint.loddsratio <- function(object, parm, level = 0.95, log = object$log, ...) { if (log) confint.default(object, parm = parm, level = level, ... ) else { object$log = TRUE exp(confint.default(object, parm = parm, level = level, ... )) } } make_header <- function(x) { vn <- names(dimnames(x)) header <- c(if(x$log) "log" else "", "odds ratios for", vn[1], "and", vn[2], if (length(vn)>2) c("by", paste(vn[-(1:2)], collapse=', ')), "\n\n") paste(header, sep = " ") } ## print method print.loddsratio <- function(x, log = x$log, ...) { cat(make_header(x)) print(drop(array(coef(x, log = log), dim = dim(x), dimnames = dimnames(x)), ...)) invisible(x) } summary.loddsratio <- function(object, ...) lmtest::coeftest(object, ...) ## reshape coef() methods as.matrix.loddsratio <- function (x, log=x$log, ...) { Coef <- coef(x, log = log) if (length(dim(x))==2) matrix(Coef, ncol = dim(x)[2], dimnames=dimnames(x)) else { # drop leading dimensions with length 1, then reshape ddim <- which(dim(x)[1:2]==1) dim(Coef) <- dim(x)[-ddim] dimnames(Coef) <- dimnames(x)[-ddim] if (length(dim(Coef))==1) Coef else matrix(Coef, ncol = prod(dim(Coef)[-1]), dimnames=list(dimnames(Coef)[[1]], apply(expand.grid(dimnames(Coef)[[-1]]), 1, paste, collapse = ":"))) } } as.array.loddsratio <- function (x, log=x$log, ...) { res <- array(coef(x, log = log), dim = dim(x), dimnames=dimnames(x)) drop(res) } as.data.frame.loddsratio <- function(x, row.names = NULL, optional, log=x$log, ...) { df <-data.frame(expand.grid(dimnames(x)), LOR = coef(x, log=log), ASE = sqrt(diag(vcov(x, log=log))), row.names=row.names, ... ) if (!log) colnames(df)[ncol(df)-1] <- "OR" df } image.loddsratio <- function(x, interpolate = NULL, legend = legend_fixed, gp = shading_Friendly, gp_args = NULL, labeling = labeling_values("residuals", suppress = 0), perm = NULL, ...) { a <- as.array(x) if (!is.null(dim(a))) { if (is.null(perm)) { d <- seq_along(dim(a)) perm <- c(d[-c(1:2)], 1:2) } a <- aperm(a, perm) } else { a <- as.table(a) names(dimnames(a)) <- names(dimnames(x))[1] } if (is.null(interpolate)) interpolate <- seq(0.1, max(abs(a), length.out = 4)) if (is.null(gp_args)) gp_args <- list(interpolate = interpolate) tmp <- a tmp[] <- 1 mosaic(tmp, type = "expected", residuals = a, shade = TRUE, gp = shading_Friendly, gp_args = gp_args, legend = legend, labeling = labeling, ...) } tile.loddsratio <- function(x, interpolate = NULL, legend = legend_fixed, gp = shading_Friendly, gp_args = NULL, labeling = labeling_values("residuals", suppress = 0), halign = "center", valign = "center", perm = NULL, ...) { a <- as.array(x) if (!is.null(dim(a))) { if (is.null(perm)) { d <- seq_along(dim(a)) perm <- c(d[-c(1:2)], 1:2) } a <- aperm(a, perm) } else { a <- as.table(a) names(dimnames(a)) <- names(dimnames(x))[1] } if (is.null(interpolate)) interpolate <- seq(0.1, max(abs(a), length.out = 4)) if (is.null(gp_args)) gp_args <- list(interpolate = interpolate) tile(abs(a), halign = halign, valign = valign, residuals = a, shade = TRUE, gp = shading_Friendly, gp_args = gp_args, legend = legend, labeling = labeling, ...) } "plot.loddsratio" <- function(x, baseline = TRUE, gp_baseline = gpar(lty = 2), lines = TRUE, lwd_lines = 3, confidence = TRUE, conf_level = 0.95, lwd_confidence = 2, whiskers = 0, transpose = FALSE, col = NULL, cex = 0.8, pch = NULL, bars = NULL, gp_bars = gpar(fill = "lightgray", alpha = 0.5), bar_width = unit(0.05, "npc"), legend = TRUE, legend_pos = "topright", legend_inset = c(0, 0), legend_vgap = unit(0.5, "lines"), gp_legend_frame = gpar(lwd = 1, col = "black"), gp_legend_title = gpar(fontface = "bold"), gp_legend = gpar(), legend_lwd = 1, legend_size = 1, xlab = NULL, ylab = NULL, xlim = NULL, ylim = NULL, main = NULL, gp_main = gpar(fontsize = 12, fontface = "bold"), newpage = TRUE, pop = FALSE, return_grob = FALSE, prefix = "", ...) { ## handle default values, limits etc. LOG <- x$log values <- as.array(x) d <- dim(values) if (is.null(bars)) bars <- is.null(d) oddsrange <- range(values, na.rm = TRUE) if(confidence) { CI <- confint(x, log = LOG, level = conf_level) lwr <- CI[,1] upr <- CI[,2] oddsrange <- if (baseline) c(min(0, lwr, na.rm = TRUE), max(0, upr, na.rm = TRUE)) else c(min(lwr, na.rm = TRUE), max(upr, na.rm = TRUE)) } if (is.null(main)) main <- paste(make_header(x), collapse = " ") if (is.null(xlim)) xlim <- if (is.null(d)) c(1, length(values)) else c(1, d[1]) if (is.null(ylim)) ylim <- oddsrange ylimaxis <- ylim + c(-1, 1) * diff(ylim) * 0.04 xlimaxis <- xlim + c(-1, 1) * diff(xlim) * 0.04 ncols <- if (is.null(d)) 1 else prod(d[-1]) if (is.null(col)) col <- rainbow_hcl(ncols, l = 50) if (is.null(pch)) pch <- c(19,15,17, 1:14, 16, 18, 20:25) labs <- if (is.null(d)) names(values) else dimnames(values)[[1]] if (is.null(xlab)) xlab <- if (is.null(d)) names(dimnames(x))[3] else names(dimnames(values))[1] if (is.null(ylab)) ylab <- paste(if (LOG) "L" else "", "OR(", paste(names(dimnames(x))[1:2], collapse = " / "), ")", sep = "") if (newpage) grid.newpage() if (transpose) { ## set up plot region, similar to plot.xy() pushViewport(plotViewport(xscale = ylimaxis, yscale = xlimaxis, default.units = "native", name = paste(prefix,"oddsratio_plot"))) grid.yaxis(name = "yaxis", seq_along(labs), labs, edits = gEdit("labels", rot = 90, hjust = .5, vjust = 0)) grid.xaxis() grid.text(ylab, y = unit(-3.5, "lines")) grid.text(xlab, x = unit(-3, "lines"), rot = 90) grid.text(main, y = unit(1, "npc") + unit(1, "lines"), gp = gp_main) pushViewport(viewport(xscale = ylimaxis, yscale = xlimaxis, default.units = "native", clip = "on")) ## baseline if (baseline) grid.lines(unit(c(1,1) - LOG, "native"), unit(c(0,1), "npc"), gp = gp_baseline) # workhorse for one stratum draw_one_stratum <- function(vals, pch = "o", col = "black", offset = 0, jitter = 0) { if (bars) { if (any(vals > !LOG)) grid.rect(unit(vals[vals > !LOG], "native"), unit(seq_along(vals)[vals > !LOG], "native"), height = bar_width, width = unit(vals[vals > !LOG] - !LOG, "native"), just = "right", gp = gp_bars ) if (any(vals < !LOG)) grid.rect(unit(vals[vals < !LOG], "native"), unit(seq_along(vals)[vals < !LOG], "native"), height = bar_width, width = unit(abs(vals[vals < !LOG] - !LOG), "native"), just = "left", gp = gp_bars ) } if (lines) grid.lines(unit(vals, "native"), unit(seq_along(vals), "native"), gp = gpar(col = col, lwd = lwd_lines), default.units = "native" ) grid.points(unit(vals, "native"), unit(seq_along(vals), "native"), pch = pch, size = unit(cex, "char"), gp = gpar(col = col, lwd = lwd_lines), default.units = "native" ) if (confidence) for (i in seq_along(vals)) { ii <- i + jitter grid.lines(unit(c(lwr[offset + i], upr[offset + i]), "native"), unit(c(ii, ii), "native"), gp = gpar(col = col, lwd = lwd_confidence)) grid.lines(unit(c(lwr[offset + i], lwr[offset + i]), "native"), unit(c(ii - whiskers/2, ii + whiskers/2), "native"), gp = gpar(col = col, lwd = lwd_confidence)) grid.lines(unit(c(upr[offset + i], upr[offset + i]), "native"), unit(c(ii - whiskers/2, ii + whiskers/2), "native"), gp = gpar(col = col, lwd = lwd_confidence)) } } } else { ## set up plot region pushViewport(plotViewport(xscale = xlimaxis, yscale = ylimaxis, default.units = "native", name = "oddsratio_plot")) grid.xaxis(seq_along(labs), labs) grid.yaxis() grid.text(xlab, y = unit(-3.5, "lines")) grid.text(ylab, x = unit(-3, "lines"), rot = 90) grid.text(main, y = unit(1, "npc") + unit(1, "lines"), gp = gp_main) pushViewport(viewport(xscale = xlimaxis, yscale = ylimaxis, default.units = "native", clip = "on")) ## baseline if (baseline) grid.lines(unit(c(0,1), "npc"), unit(c(1,1) - LOG, "native"), gp = gp_baseline) ## workhorse for one stratum draw_one_stratum <- function(vals, pch = "o", col = "black", offset = 0, jitter = 0) { if (bars) { if (any(vals > !LOG)) grid.rect(unit(seq_along(vals)[vals > !LOG], "native"), unit(vals[vals > !LOG], "native"), width = bar_width, height = unit(vals[vals > !LOG] - !LOG, "native"), just = "top", gp = gp_bars ) if (any(vals < !LOG)) grid.rect(unit(seq_along(vals)[vals < !LOG], "native"), unit(vals[vals < !LOG], "native"), width = bar_width, height = unit(abs(vals[vals < !LOG] - !LOG), "native"), just = "bottom", gp = gp_bars ) } if (lines) grid.lines(unit(seq_along(vals), "native"), unit(vals, "native"), gp = gpar(col = col, lwd = lwd_lines), default.units = "native" ) grid.points(unit(seq_along(vals), "native"), unit(vals, "native"), pch = pch, size = unit(cex, "char"), gp = gpar(col = col, lwd = lwd_lines), default.units = "native" ) if (confidence) for (i in seq_along(vals)) { ii <- i + jitter grid.lines(unit(c(ii, ii), "native"), unit(c(lwr[offset + i], upr[offset + i]), "native"), gp = gpar(col = col, lwd = lwd_confidence)) grid.lines(unit(c(ii - whiskers/2, ii + whiskers/2), "native"), unit(c(lwr[offset + i], lwr[offset + i]), "native"), gp = gpar(col = col, lwd = lwd_confidence)) grid.lines(unit(c(ii - whiskers/2, ii + whiskers/2), "native"), unit(c(upr[offset + i], upr[offset + i]), "native"), gp = gpar(col = col, lwd = lwd_confidence)) } } } if (is.null(d)) draw_one_stratum(values, pch[1], col[1]) else { jitt <- scale(seq_len(prod(d[-1])), scale = 25 * prod(d[-1])) for (i in 1 : prod(d[-1])) draw_one_stratum(values[(i - 1) * d[1] + seq(d[1])], pch[(i - 1 ) %% length(pch) + 1], col[i], offset = (i - 1) * d[1], jitt[i]) if (legend) grid_legend(legend_pos, labels = apply(expand.grid(dimnames(values)[-1]), 1, paste, collapse = "|"), pch = pch[1 : prod(d[-1])], col = col, lwd = legend_lwd, lty = "solid", size = legend_size, vgap = legend_vgap, gp = gp_legend, gp_frame = gp_legend_frame, inset = legend_inset, title = paste(names(dimnames(values)[-1]), collapse = " x "), gp_title = gp_legend_title, ...) } grid.rect(gp = gpar(fill = "transparent")) if (pop) popViewport(2) if (return_grob) invisible(grid.grab()) else invisible(NULL) } vcd/R/labeling.R0000755000175100001440000007175211720272420013161 0ustar hornikusers################################################################ ## labeling pexpand <- function(par, len, default_value, default_names, choices = NULL) { if (is.null(par)) par <- default_value nam <- names(par) if (!is.null(choices)) par <- sapply(par, match.arg, choices) if (is.null(nam)) { default_value <- par par <- rep(par, length.out = len) nam <- names(par) <- default_names } else if (length(nam[nam == ""])) { default_value <- par[nam == ""] nam <- nam[nam != ""] } ret <- rep(default_value, length.out = len) if (!is.null(nam)) { names(ret) <- default_names ret[nam] <- par[nam] } ret } labeling_list <- function(gp_text = gpar(), just = "left", pos = "left", lsep = ": ", sep = " ", offset = unit(c(2, 2), "lines"), varnames = TRUE, cols = 2, ...) { function(d, split_vertical, condvars, prefix = "") { if (is.table(d)) d <- dimnames(d) ld <- length(d) labeling_border(labels = FALSE, varnames = varnames)(d, split_vertical, condvars, prefix) seekViewport(paste(prefix, "margin_bottom", sep = "")) pos <- unit(switch(pos, left = 0, center = 0.5, 1) / cols, "npc") ind <- split(seq(ld), rep.int(seq(cols), ceiling(ld / cols))[seq(ld)]) for (i in seq_along(ind)) grid.text(x = offset[1] + pos + unit((i - 1) / cols, "npc"), y = unit(1, "npc") - offset[2], paste(names(d[ind[[i]]]), sapply(d[ind[[i]]], paste, collapse = sep), sep = lsep, collapse = "\n" ), just = c(just, "top"), gp = gp_text ) } } class(labeling_list) <- "grapcon_generator" labeling_conditional <- function(...) { function (d, split_vertical, condvars, prefix = "") { if (is.table(d)) d <- dimnames(d) v <- rep.int(TRUE, length(d)) v[seq(condvars)] <- FALSE labeling_border(labels = !v, ...)(d, split_vertical, condvars, prefix) labeling_cells(labels = v, ...)(d, split_vertical, condvars, prefix) } } class(labeling_conditional) <- "grapcon_generator" labeling_cells <- function(labels = TRUE, varnames = TRUE, abbreviate_labels = FALSE, abbreviate_varnames = FALSE, gp_text = gpar(), lsep = ": ", lcollapse = "\n", just = "center", pos = "center", rot = 0, margin = unit(0.5, "lines"), clip_cells = TRUE, text = NULL, ...) { function(d, split_vertical, condvars, prefix = "") { if (is.table(d)) d <- dimnames(d) dn <- names(d) ld <- length(d) ## expand parameters if (length(pos) < 2) pos <- c(pos, pos) labels <- pexpand(labels, ld, TRUE, dn) varnames <- pexpand(varnames, ld, TRUE, dn) abbreviate_labels <- pexpand(abbreviate_labels, ld, FALSE, dn) abbreviate_varnames <- pexpand(abbreviate_varnames, ld, FALSE, dn) ## margin if (!is.unit(margin)) margin <- unit(margin, "lines") prvars <- ifelse(abbreviate_varnames, sapply(seq_along(dn), function(i) abbreviate(dn[i], abbreviate_varnames[i])), dn) prvars <- ifelse(varnames, paste(prvars, lsep, sep = ""), "") ## draw labels split <- function(vind = 1, labs = c()) { n <- d[[vind]] for (labind in seq_along(n)) { lab <- c(labs, n[labind]) names(lab) <- names(d)[1:vind] mlab <- paste(prefix, "cell:", paste(dn[1:vind], lab, sep = "=", collapse = ","), sep = "") if (vind < ld) split(vind + 1, lab) else { seekViewport(mlab) pushViewport(viewport(width = max(unit(0, "npc"), unit(1, "npc") - 2 * margin), height = unit(1, "npc") - 2 * margin, clip = clip_cells)) txt <- if (!is.null(text)) { lab <- lab[names(dimnames(text))] do.call("[", c(list(text), as.list(lab))) } else { prlab <- ifelse(abbreviate_labels, sapply(seq_along(lab), function(i) abbreviate(lab[i], abbreviate_labels[i])), lab) prlab <- prlab[labels[1:ld]] paste(prvars[labels[1:ld]], prlab, sep = "", collapse = lcollapse) } grid.text(if(!is.na(txt)) txt, x = switch(pos[1], left =, top = 0, center = 0.5, 1), y = switch(pos[2], left =, top = 1, center = 0.5, 0), gp = gp_text, just = just, rot = rot) popViewport() } } } split() seekViewport(paste(prefix, "base", sep = "")) upViewport(1) } } class(labeling_cells) <- "grapcon_generator" labeling_border <- function(labels = TRUE, varnames = labels, set_labels = NULL, set_varnames = NULL, tl_labels = NULL, alternate_labels = FALSE, tl_varnames = NULL, gp_labels = gpar(fontsize = 12), gp_varnames = gpar(fontsize = 12, fontface = 2), rot_labels = c(0, 90, 0, 90), rot_varnames = c(0, 90, 0, 90), pos_labels = "center", pos_varnames = "center", just_labels = "center", just_varnames = pos_varnames, boxes = FALSE, fill_boxes = FALSE, offset_labels = c(0, 0, 0, 0), offset_varnames = offset_labels, labbl_varnames = NULL, labels_varnames = FALSE, sep = ": ", abbreviate_labs = FALSE, rep = TRUE, clip = FALSE, ... ) { ## expand parameters that apply to the four table margins pos_labels <- pexpand(pos_labels, 4, "center", c("top", "right", "bottom", "left"), c("left", "center", "right")) just_labels <- pexpand(just_labels, 4, "center", c("top", "right", "bottom", "left"), c("left", "center", "right")) offset_varnames <- if (!is.unit(offset_varnames)) unit(pexpand(offset_varnames, 4, rep.int(0, 4), c("top","right","bottom","left")), "lines") else rep(offset_varnames, length.out = 4) offset_labels <- if (!is.unit(offset_labels)) unit(pexpand(offset_labels, 4, rep.int(0, 4), c("top","right","bottom","left")), "lines") else rep(offset_labels, length.out = 4) rot_labels <- pexpand(rot_labels, 4, c(0, 90, 0, 90), c("top", "right", "bottom", "left")) if (inherits(gp_varnames, "gpar")) gp_varnames <- list(gp_varnames) gp_varnames <- pexpand(gp_varnames, 4, list(gpar(fontsize = 12, fontface = 2)), c("top", "right", "bottom", "left")) rot_varnames <- pexpand(rot_varnames, 4, c(0, 90, 0, 90), c("top", "right", "bottom", "left")) pos_varnames <- pexpand(pos_varnames, 4, "center", c("top", "right", "bottom", "left"), c("left", "center", "right")) just_varnames <- pexpand(just_varnames, 4, pos_varnames, c("top", "right", "bottom", "left"), c("left", "center", "right")) function(d, split_vertical, condvars, prefix = "") { if (is.table(d)) d <- dimnames(d) dn <- names(d) ld <- length(d) ## expand table- (i.e., dimensionality)-dependent parameters clip <- pexpand(clip, ld, TRUE, dn) labels <- pexpand(labels, ld, TRUE, dn) labels_varnames <- pexpand(labels_varnames, ld, FALSE, dn) ## tl_labels def <- logical() def[split_vertical] <- rep(c(TRUE, FALSE), length.out = sum(split_vertical)) def[!split_vertical] <- rep(c(TRUE, FALSE), length.out = sum(!split_vertical)) tl_labels <- if (is.null(tl_labels)) def else pexpand(tl_labels, ld, def, dn) ## rep labels rep <- pexpand(rep, ld, TRUE, dn) printed <- lapply(d, function(i) rep.int(FALSE, length(i))) ## alternate labels alternate_labels <- pexpand(alternate_labels, ld, FALSE, dn) ## abbreviate abbreviate_labs <- pexpand(abbreviate_labs, ld, FALSE, dn) labs <- d for (i in seq_along(d)) if (abbreviate_labs[i]) labs[[i]] <- abbreviate(labs[[i]], abbreviate_labs[i]) ## gp_labels if (inherits(gp_labels, "gpar")) gp_labels <- list(gp_labels) gp_labels <- pexpand(gp_labels, ld, list(gpar(fontsize = 12)), dn) ## varnames varnames <- pexpand(varnames, ld, labels, dn) ## tl_varnames if (is.null(tl_varnames) && is.null(labbl_varnames)) tl_varnames <- tl_labels tl_varnames <- pexpand(tl_varnames, ld, tl_labels, dn) ## labbl_varnames if (!is.null(labbl_varnames)) labbl_varnames <- pexpand(labbl_varnames, ld, TRUE, dn) ## boxes boxes <- pexpand(boxes, ld, FALSE, dn) ## fill_boxes dnl <- sapply(d, length) fill_boxes <- if (is.atomic(fill_boxes)) { fill_boxes <- if (is.logical(fill_boxes)) ifelse(pexpand(fill_boxes, ld, FALSE, dn), "grey", NA) else pexpand(fill_boxes, ld, "grey", dn) col <- rgb2hsv(col2rgb(fill_boxes)) lapply(seq(along.with = dnl), function(i) if (is.na(fill_boxes[i])) "white" else hsv(h = col["h",i], s = col["s",i], v = seq(from = col["v",i], to = 0.5 * col["v",i], length = dnl[i]) ) ) } else { fill_boxes <- pexpand(fill_boxes, ld, "white", dn) lapply(seq(ld), function(i) pexpand(fill_boxes[[i]], dnl[i], "white", d[[i]]) ) } ## precompute spaces lsp <- tsp <- bsp <- rsp <- 0 labsp <- rep.int(0, ld) for (i in seq_along(dn)[tl_labels & labels]) labsp[i] <- if (split_vertical[i]) { if (alternate_labels[i]) bsp <- bsp - 1 tsp <- tsp + 1 } else { if (alternate_labels[i]) rsp <- rsp + 1 lsp <- lsp - 1 } for (i in rev(seq_along(dn)[!tl_labels & labels])) labsp[i] <- if (split_vertical[i]) { if (alternate_labels[i]) tsp <- tsp + 1 bsp <- bsp - 1 } else { if (alternate_labels[i]) lsp <- lsp - 1 rsp <- rsp + 1 } if(is.null(labbl_varnames)) { ## varnames in the outer margin ## compute axis names tt <- bt <- lt <- rt <- "" for (i in seq_along(dn)) { var <- if (!is.null(set_varnames) && !is.na(set_varnames[dn[i]])) set_varnames[dn[i]] else dn[i] if (varnames[i]) { if (split_vertical[i]) { if (tl_varnames[i]) tt <- paste(tt, var, sep = if (tt == "") "" else " / ") else bt <- paste(bt, var, sep = if (bt == "") "" else " / ") } else { if (tl_varnames[i]) lt <- paste(lt, var, sep = if (lt == "") "" else " / ") else rt <- paste(rt, var, sep = if (rt == "") "" else " / ") } } } ## draw axis names if (tt != "") grid.text(tt, y = unit(1, "npc") + unit(tsp + 1, "lines") + offset_varnames[1], x = switch(pos_varnames[1], left =, bottom = 0, center =, centre = 0.5, 1), rot = rot_varnames[1], just = just_varnames[1], gp = gp_varnames[[1]]) if (bt != "") grid.text(bt, y = unit(bsp - 1, "lines") + -1 * offset_varnames[3], x = switch(pos_varnames[3], left =, bottom = 0, center =, centre = 0.5, 1), rot = rot_varnames[3], just = just_varnames[3], gp = gp_varnames[[3]]) if (lt != "") grid.text(lt, x = unit(lsp - 1, "lines") + -1 * offset_varnames[4], y = switch(pos_varnames[4], left =, bottom = 0, center =, centre = 0.5, 1), rot = rot_varnames[4], just = just_varnames[4], gp = gp_varnames[[4]]) if (rt != "") grid.text(rt, x = unit(1, "npc") + unit(rsp + 1, "lines") + offset_varnames[2], y = switch(pos_varnames[2], left =, bottom = 0, center =, centre = 0.5, 1), rot = rot_varnames[2], just = just_varnames[2], gp = gp_varnames[[2]]) } else { ## varnames beneath labels for (i in seq_along(dn)) { var <- if (!is.null(set_varnames) && !is.na(set_varnames[dn[i]])) set_varnames[dn[i]] else dn[i] if (varnames[i]) { if (split_vertical[i]) { if (tl_labels[i]) { if (labbl_varnames[i]) { grid.text(var, y = unit(1, "npc") + unit(1 + tsp - labsp[i], "lines") + offset_varnames[1], x = unit(-0.5, "lines"), just = "right", gp = gp_varnames[[4]]) } else { grid.text(var, y = unit(1, "npc") + unit(1 + tsp - labsp[i], "lines") + offset_varnames[1], x = unit(1, "npc") + unit(0.5, "lines"), just = "left", gp = gp_varnames[[2]]) } } else { if (labbl_varnames[i]) { grid.text(var, y = unit(labsp[i], "lines") + -1 * offset_varnames[3], x = unit(-0.5, "lines"), just = "right", gp = gp_varnames[[4]]) } else { grid.text(var, y = unit(labsp[i], "lines") + -1 * offset_varnames[3], x = unit(1, "npc") + unit(0.5, "lines"), just = "left", gp = gp_varnames[[2]]) } } } else { if (tl_labels[i]) { if (labbl_varnames[i]) { grid.text(var, x = unit(lsp - 1 - labsp[i], "lines") + -1 * offset_varnames[4], y = unit(-0.5, "lines"), just = "right", rot = 90, gp = gp_varnames[[4]]) } else { grid.text(var, x = unit(lsp - 1 - labsp[i], "lines") + -1 * offset_varnames[4], y = unit(1, "npc") + unit(0.5, "lines"), just = "left", rot = 90, gp = gp_varnames[[2]]) } } else { if (labbl_varnames[i]) { grid.text(var, x = unit(1, "npc") + unit(labsp[i], "lines") + offset_varnames[2], y = unit(-0.5, "lines"), just = "right", rot = 90, gp = gp_varnames[[4]]) } else { grid.text(var, x = unit(1, "npc") + unit(labsp[i], "lines") + offset_varnames[2], y = unit(1, "npc") + unit(0.5, "lines"), just = "left", rot = 90, gp = gp_varnames[[2]]) } } } } } } ## draw labels split <- function(vind = 1, root = paste(prefix, "cell:", sep = ""), left = TRUE, right = TRUE, top = TRUE, bottom = TRUE) { n <- d[[vind]] vl <- length(n) sp <- split_vertical[vind] labseq <- seq_along(n) if (!sp) labseq <- rev(labseq) for (labind in labseq) { mlab <- paste(root, dn[vind], "=", n[labind], sep = "") if (labels[vind] && (rep[vind] || !printed[[vind]][labind])) { lab <- if (!is.null(set_labels) && !is.null(set_labels[[dn[vind]]])) set_labels[[dn[vind]]][labind] else labs[[vind]][labind] if (labels_varnames[vind]) lab <- if (!is.null(set_varnames) && !is.na(set_varnames[dn[vind]])) paste(set_varnames[dn[vind]], lab, sep = sep) else paste(dn[vind], lab, sep = sep) if (sp) { if (tl_labels[vind]) { if (top) { seekViewport(mlab) if (clip[vind]) pushViewport(viewport(height = unit(1, "npc") + 2 * offset_labels[1] + unit(2 * (2 + tsp - labsp[vind]), "lines"), clip = "on")) if (boxes[vind]) grid.rect(height = unit(0.8, "lines"), y = unit(1, "npc") + offset_labels[1] + unit(1 + tsp - labsp[vind] - (2 + as.numeric(offset_labels[1]) + tsp - labsp[vind]) * clip[vind], "lines"), gp = gpar(fill = fill_boxes[[vind]][labind])) grid.text(lab, y = unit(1, "npc") + offset_labels[1] + unit(1 + tsp - labsp[vind] - (2 + as.numeric(offset_labels[1]) + tsp - labsp[vind]) * clip[vind], "lines"), x = unit(0.15 * switch(pos_labels[1], left =, bottom = 1, center =, centre = 0, -1) * boxes[vind], "lines") + unit(switch(pos_labels[1], left =, bottom = 0, center =, centre = 0.5, 1), "npc"), rot = rot_labels[1], just = just_labels[1], gp = gp_labels[[vind]]) if (clip[vind]) popViewport() printed[[vind]][labind] <<- TRUE } } else { if (bottom) { seekViewport(mlab) if (clip[vind]) pushViewport(viewport(height = unit(1, "npc") + 2 * offset_labels[3] + unit(2 * (1 + abs(labsp[vind])), "lines"), clip = "on")) ### if (boxes[vind]) grid.rect(height = unit(0.8, "lines"), y = -1 * offset_labels[3] + unit(labsp[vind] + (1 + as.numeric(offset_labels[3]) + abs(labsp[vind])) * clip[vind], "lines"), gp = gpar(fill = fill_boxes[[vind]][labind])) grid.text(lab, y = -1 * offset_labels[3] + unit(labsp[vind] + (1 + as.numeric(offset_labels[3]) + abs(labsp[vind])) * clip[vind], "lines"), x = unit(0.15 * switch(pos_labels[3], left =, bottom = 1, center =, centre = 0, -1) * boxes[vind], "lines") + unit(switch(pos_labels[3], left =, bottom = 0, center =, centre = 0.5, 1), "npc"), rot = rot_labels[3], just = just_labels[3], gp = gp_labels[[vind]]) if (clip[vind]) popViewport() printed[[vind]][labind] <<- TRUE } } } else { if (tl_labels[vind]) { if (left) { seekViewport(mlab) if (clip[vind]) pushViewport(viewport(width = unit(1, "npc") + 2 * offset_labels[4] + unit(2 * (2 - lsp + labsp[vind]), "lines"), clip = "on")) if (boxes[vind]) grid.rect(width = unit(0.8, "lines"), x = -1 * offset_labels[4] + unit(lsp - 1 - labsp[vind] + (2 - lsp + as.numeric(offset_labels[4]) + labsp[vind]) * clip[vind], "lines"), gp = gpar(fill = fill_boxes[[vind]][labind])) grid.text(lab, x = -1 * offset_labels[4] + unit(lsp - 1 - labsp[vind] + (2 - lsp + as.numeric(offset_labels[4]) + labsp[vind]) * clip[vind], "lines"), y = unit(0.15 * switch(pos_labels[4], left =, bottom = 1, centre = 0, -1) * boxes[vind], "lines") + unit(switch(pos_labels[4], left =, bottom = 0, center =, centre = 0.5, 1), "npc"), rot = rot_labels[4], just = just_labels[4], gp = gp_labels[[vind]]) if (clip[vind]) popViewport() printed[[vind]][labind] <<- TRUE } } else { if (right) { seekViewport(mlab) if (clip[vind]) pushViewport(viewport(width = unit(1, "npc") + 2 * offset_labels[2] + unit(2 * (1 + abs(labsp[vind])), "lines"), clip = "on")) if (boxes[vind]) grid.rect(width = unit(0.8, "lines"), x = offset_labels[2] + unit(1, "npc") + unit(labsp[vind] - (1 + as.numeric(offset_labels[2]) + abs(labsp[vind])) * clip[vind], "lines"), gp = gpar(fill = fill_boxes[[vind]][labind])) grid.text(lab, x = offset_labels[2] + unit(1, "npc") + unit(0.1, "lines") + unit(labsp[vind] - (1 + as.numeric(offset_labels[2]) + abs(labsp[vind])) * clip[vind], "lines"), y = unit(0.15 * switch(pos_labels[2], left =, bottom = 1, center =, centre = 0, -1) * boxes[vind], "lines") + unit(switch(pos_labels[2], left =, bottom = 0, center =, centre = 0.5, 1), "npc"), rot = rot_labels[2], just = just_labels[2], gp = gp_labels[[vind]]) if (clip[vind]) popViewport() printed[[vind]][labind] <<- TRUE } } } } if (vind < ld) Recall(vind + 1, paste(mlab, ",", sep = ""), if (sp) left && labind == 1 else left, if (sp) right && labind == vl else right, if (!sp) top && labind == 1 else top, if (!sp) bottom && labind == vl else bottom) } } ## patch for alternating labels, part 1 if (any(alternate_labels)) { ## save set_labels set_labels_hold <- set_labels ## create vanilla set_labels-object set_labels <- d ## copy old set_labels if (!is.null(set_labels_hold)) set_labels[names(set_labels_hold)] <- set_labels_hold ## mask half of the labels for (i in which(alternate_labels)) if (length(d[[i]]) > 1) set_labels[[i]][seq(2, length(d[[i]]), 2)] <- "" } split() ## patch for alternating labels, part 2 if (any(alternate_labels)) { ## create again vanilla set_labels-object set_labels <- d ## copy again old set_labels if (!is.null(set_labels_hold)) set_labels[names(set_labels_hold)] <- set_labels_hold ## clear all non-alternated labels labels[!alternate_labels] <- FALSE ## mask other half of alternated labels for (i in which(alternate_labels)) set_labels[[i]][seq(1, length(d[[i]]), 2)] <- "" ## invert tl_labels and labsp tl_labels <- ! tl_labels labsp <- -labsp ## label again split() } seekViewport(paste(prefix, "base", sep = "")) upViewport(1) } } class(labeling_border) <- "grapcon_generator" labeling_doubledecker <- function(lab_pos = c("bottom", "top"), dep_varname = TRUE, boxes = NULL, clip = NULL, labbl_varnames = FALSE, rot_labels = rep.int(0, 4), pos_labels = c("left", "center", "left", "center"), just_labels = c("left", "left", "left", "center"), varnames = NULL, gp_varnames = gpar(fontsize = 12, fontface = 2), offset_varnames = c(0, -0.6, 0, 0), tl_labels = NULL, ...) { lab_pos <- match.arg(lab_pos) if (inherits(gp_varnames, "gpar")) gp_varnames <- list(gp_varnames) gp_varnames <- pexpand(gp_varnames, 4, list(gpar(fontsize = 12, fontface = 2)), c("top", "right", "bottom", "left")) function(d, split_vertical, condvars, prefix = "") { if (is.table(d)) d <- dimnames(d) ld <- length(d) dn <- names(d) ## expand dimension parameters boxes <- pexpand(boxes, ld, c(rep.int(TRUE, ld - 1), FALSE), dn) clip <- pexpand(clip, ld, c(rep.int(TRUE, ld - 1), FALSE), dn) varnames <- pexpand(varnames, ld, c(rep.int(TRUE, ld - 1), FALSE), dn) tl_labels <- pexpand(tl_labels, ld, c(rep.int(lab_pos == "top", ld - 1), FALSE), dn) if (!is.null(labbl_varnames)) labbl_varnames <- pexpand(labbl_varnames, ld, FALSE, dn) ## expand side parameters rot_labels <- pexpand(rot_labels, 4, c(0, 0, 0, 0), c("top", "right", "bottom", "left")) pos_labels <- pexpand(pos_labels, 4, c("left", "center", "left", "center"), c("top", "right", "bottom", "left"), c("left", "center", "right")) just_labels <- pexpand(just_labels, 4, c("left", "left", "left", "center"), c("top", "right", "bottom", "left"), c("left", "center", "right")) offset_varnames <- if (!is.unit(offset_varnames)) unit(pexpand(offset_varnames, 4, c(0, -0.6, 0, 0), c("top","right","bottom","left")), "lines") else rep(offset_varnames, length.out = 4) labeling_border(boxes = boxes, clip = clip, labbl_varnames = labbl_varnames, rot_labels = rot_labels, pos_labels = pos_labels, just_labels = just_labels, varnames = varnames, gp_varnames = gp_varnames, offset_varnames = offset_varnames, tl_labels = tl_labels, ... )(d, split_vertical, condvars, prefix) if (!(is.logical(dep_varname) && !dep_varname)) { if (is.null(dep_varname) || is.logical(dep_varname)) dep_varname <- names(d)[length(d)] seekViewport(paste(prefix, "margin_right", sep = "")) grid.text(dep_varname, x = unit(0.5, "lines"), y = unit(1, "npc"), just = c("left","top"), gp = gp_varnames[[2]]) } } } class(labeling_doubledecker) <- "grapcon_generator" labeling_left <- function(rep = FALSE, pos_varnames = "left", pos_labels = "left", just_labels = "left", ...) labeling_border(rep = rep, pos_varnames = pos_varnames, pos_labels = pos_labels, just_labels = just_labels, ...) class(labeling_left) <- "grapcon_generator" labeling_left2 <- function(tl_labels = TRUE, clip = TRUE, pos_varnames = "left", pos_labels = "left", just_labels = "left", ...) labeling_border(tl_labels = tl_labels, clip = clip, pos_varnames = pos_varnames, pos_labels = pos_labels, just_labels = just_labels, ...) class(labeling_left2) <- "grapcon_generator" labeling_cboxed <- function(tl_labels = TRUE, boxes = TRUE, clip = TRUE, pos_labels = "center", ...) labeling_border(tl_labels = tl_labels, boxes = boxes, clip = clip, pos_labels = pos_labels, ...) class(labeling_cboxed) <- "grapcon_generator" labeling_lboxed <- function(tl_labels = FALSE, boxes = TRUE, clip = TRUE, pos_labels = "left", just_labels = "left", labbl_varnames = FALSE, ...) labeling_border(tl_labels = tl_labels, boxes = boxes, clip = clip, pos_labels = pos_labels, labbl_varnames = labbl_varnames, just_labels = just_labels, ...) class(labeling_lboxed) <- "grapcon_generator" labeling_values <- function(value_type = c("observed", "expected", "residuals"), suppress = NULL, digits = 1, clip_cells = FALSE, ...) { value_type <- match.arg(value_type) if (value_type == "residuals" && is.null(suppress)) suppress <- 2 if (is.null(suppress)) suppress <- 0 if (length(suppress) == 1) suppress <- c(-suppress, suppress) function(d, split_vertical, condvars, prefix) { lookup <- if (value_type == "observed") "x" else value_type if (!exists(lookup, envir = parent.frame())) stop(paste("Could not find", dQuote(value_type), "object.")) values <- get(lookup, envir = parent.frame()) values <- ifelse((values > suppress[2]) | (values < suppress[1]), round(values, digits), NA) labeling_border(...)(d, split_vertical, condvars, prefix) labeling_cells(text = values, clip_cells = clip_cells, ...)(d, split_vertical, condvars, prefix) } } class(labeling_values) <- "grapcon_generator" labeling_residuals <- function(suppress = NULL, digits = 1, clip_cells = FALSE, ...) labeling_values(value_type = "residuals", suppress = suppress, digits = digits, clip_cells = clip_cells, ...) class(labeling_residuals) <- "grapcon_generator" vcd/R/spine.R0000755000175100001440000001077211150520606012514 0ustar hornikusersspine <- function(x, ...) UseMethod("spine") spine.formula <- function(formula, data = list(), breaks = NULL, ylab_tol = 0.05, off = NULL, main = "", xlab = NULL, ylab = NULL, ylim = c(0, 1), margins = c(5.1, 4.1, 4.1, 3.1), gp = gpar(), name = "spineplot", newpage = TRUE, pop = TRUE, ...) { ## extract x, y from formula mf <- model.frame(formula, data = data) if(NCOL(mf) != 2) stop("`formula' should specify exactly two variables") y <- mf[,1] if(!is.factor(y)) stop("dependent variable should be a factor") x <- mf[,2] if(is.null(xlab)) xlab <- names(mf)[2] if(is.null(ylab)) ylab <- names(mf)[1] spine(x, y, breaks = breaks, ylab_tol = ylab_tol, off = off, main = main, xlab = xlab, ylab = ylab, ylim = ylim, margins = margins, gp = gp, name = name, newpage = newpage, pop = pop, ...) } spine.default <- function(x, y = NULL, breaks = NULL, ylab_tol = 0.05, off = NULL, main = "", xlab = NULL, ylab = NULL, ylim = c(0, 1), margins = c(5.1, 4.1, 4.1, 3.1), gp = gpar(), name = "spineplot", newpage = TRUE, pop = TRUE, ...) { ## either supply a 2-way table (i.e., both y and x are categorical) ## or two variables (y has to be categorical - x can be categorical or numerical) if(missing(y)) { if(length(dim(x)) != 2) stop("a 2-way table has to be specified") tab <- x x.categorical <- TRUE if(is.null(xlab)) xlab <- names(dimnames(tab))[1] if(is.null(ylab)) ylab <- names(dimnames(tab))[2] xnam <- dimnames(tab)[[1]] ynam <- dimnames(tab)[[2]] ny <- NCOL(tab) nx <- NROW(tab) } else { if(!is.factor(y)) stop("dependent variable should be a factor") x.categorical <- is.factor(x) if(!x.categorical) stopifnot(is.numeric(x), is.vector(x)) if(is.null(xlab)) xlab <- deparse(substitute(x)) if(is.null(ylab)) ylab <- deparse(substitute(y)) if(x.categorical) { tab <- table(x, y) xnam <- levels(x) nx <- NROW(tab) } ynam <- levels(y) ny <- length(ynam) } ## graphical parameters if(is.null(gp$fill)) gp$fill <- gray.colors(ny) gp$fill <- rep(gp$fill, length.out = ny) off <- if(!x.categorical) 0 else if(is.null(off)) 0.02 else off/100 if(x.categorical) { ## compute rectangle positions on x axis xat <- c(0, cumsum(prop.table(margin.table(tab, 1)) + off)) } else { ## compute breaks for x if(is.null(breaks)) breaks <- list() if(!is.list(breaks)) breaks <- list(breaks = breaks) breaks <- c(list(x = x), breaks) breaks$plot <- FALSE breaks <- do.call("hist", breaks)$breaks ## categorize x x1 <- cut(x, breaks = breaks, include.lowest = TRUE) ## compute rectangle positions on x axis xat <- c(0, cumsum(prop.table(table(x1)))) ## construct table tab <- table(x1, y) nx <- NROW(tab) } ## compute rectangle positions on y axis yat <- rbind(0, apply(prop.table(tab, 1), 1, cumsum)) ## setup plot if(newpage) grid.newpage() pushViewport(plotViewport(xscale = c(0, 1 + off * (nx-1)), yscale = ylim, default.units = "native", name = name, margins = margins, ...)) ## compute coordinates ybottom <- as.vector(yat[-(ny+1),]) ybottom[ybottom < ylim[1]] <- ylim[1] ybottom[ybottom > ylim[2]] <- ylim[2] ytop <- as.vector(yat[-1,]) ytop[ytop < ylim[1]] <- ylim[1] ytop[ytop > ylim[2]] <- ylim[2] xleft <- rep(xat[1:nx], rep(ny, nx)) xright <- rep(xat[2:(nx+1)] - off, rep(ny, nx)) gp$fill <- rep(gp$fill, nx) ## plot rectangles grid.rect(xleft, ybottom, width = (xright-xleft), height = (ytop-ybottom), just = c("left", "bottom"), default.units = "native", gp = gp) ## axes ## 1: either numeric or level names if(x.categorical) grid.text(x = unit((xat[1:nx] + xat[2:(nx+1)] - off)/2, "native"), y = unit(-1.5, "lines"), label = xnam, check.overlap = TRUE) else grid.xaxis(at = xat, label = breaks) ## 2: axis with level names of y yat <- yat[,1] equidist <- any(diff(yat) < ylab_tol) yat <- if(equidist) seq(1/(2*ny), 1-1/(2*ny), by = 1/ny) else (yat[-1] + yat[-length(yat)])/2 grid.text(x = unit(-1.5, "lines"), y = unit(yat, "native"), label = ynam, rot = 90, check.overlap = TRUE) ## 3: none ## 4: simple numeric grid.yaxis(main = FALSE) ## annotation grid.text(xlab, y = unit(-3.5, "lines")) grid.text(ylab, x = unit(-3, "lines"), rot = 90) grid.text(main, y = unit(1, "npc") + unit(2, "lines"), gp = gpar(fontface = "bold")) ## pop if(pop) popViewport() ## return table visualized names(dimnames(tab)) <- c(xlab, ylab) invisible(tab) } vcd/R/pairsplot.R0000644000175100001440000002136212475126621013417 0ustar hornikusers################################################################# ### pairsplot ## modified, 2-14-2014, MF: fix expected values for type= pairs.table <- function(x, upper_panel = pairs_mosaic, upper_panel_args = list(), lower_panel = pairs_mosaic, lower_panel_args = list(), diag_panel = pairs_diagonal_mosaic, diag_panel_args = list(), main = NULL, sub = NULL, main_gp = gpar(fontsize = 20), sub_gp = gpar(fontsize = 15), space = 0.3, newpage = TRUE, pop = TRUE, return_grob = FALSE, margins = unit(1, "lines"), ...) { if (newpage) grid.newpage() if (inherits(upper_panel, "grapcon_generator")) upper_panel <- do.call("upper_panel", c(upper_panel_args, list(...))) if (inherits(lower_panel, "grapcon_generator")) lower_panel <- do.call("lower_panel", c(lower_panel_args, list(...))) if (inherits(diag_panel, "grapcon_generator")) diag_panel <- do.call("diag_panel", diag_panel_args) d <- length(dim(x)) l <- grid.layout(d, d) pushViewport(viewport(width = unit(1, "snpc"), height = unit(1, "snpc"))) pushViewport(vcdViewport(mar = margins, legend = FALSE, legend_width = NULL, main = !is.null(main), sub = !is.null(sub))) ## titles if (!is.null(main)) { seekViewport("main") if (is.logical(main) && main) main <- deparse(substitute(x)) grid.text(main, gp = main_gp) } if (!is.null(sub)) { seekViewport("sub") if (is.logical(sub) && sub && is.null(main)) sub <- deparse(substitute(x)) grid.text(sub, gp = sub_gp) } seekViewport("plot") pushViewport(viewport(layout = l, y = 0, just = "bottom")) for (i in 1:d) for(j in 1:d) { pushViewport(viewport(layout.pos.col = i, layout.pos.row = j)) pushViewport(viewport(width = 1 - space, height = 1 - space)) if (i > j) { if (!is.null(upper_panel)) upper_panel(x, j, i) } else if (i < j) { if (!is.null(lower_panel)) lower_panel(x, j, i) } else if (!is.null(diag_panel)) diag_panel(x, i) if (pop) popViewport(2) else upViewport(2) } if (pop) popViewport(3) else upViewport(3) if (return_grob) invisible(structure(x, grob = grid.grab())) else invisible(x) } pairs.structable <- function(x, ...) pairs(as.table(x), ...) ## upper/lower panels pairs_assoc <- function(...) pairs_strucplot(panel = assoc, ...) class(pairs_assoc) <- "grapcon_generator" pairs_mosaic <- function(...) pairs_strucplot(panel = mosaic, ...) class(pairs_mosaic) <- "grapcon_generator" pairs_sieve <- function(...) pairs_strucplot(panel = sieve, ...) class(pairs_sieve) <- "grapcon_generator" pairs_strucplot <- function(panel = mosaic, type = c("pairwise", "total", "conditional", "joint"), legend = FALSE, margins = c(0, 0, 0, 0), labeling = NULL, ...) { type = match.arg(type) function(x, i, j) { index <- 1:length(dim(x)) rest <- index[!index %in% c(i, j)] rest2 <- index[!index %in% 1:2] tl <- tail(index, 2) rest3 <- index[!index %in% tl] expected <- switch(type, joint = list(1:2, rest2), conditional = list(c(tl[1], rest3), c(tl[2], rest3)), total = sapply(c(j, i, rest), list), NULL) margin <- switch(type, pairwise = c(j, i), conditional = c(rest, j, i), c(j, i, rest)) panel(x = margin.table(x, margin), expected = expected, labeling = labeling, margins = margins, legend = legend, split_vertical = TRUE, newpage = FALSE, pop = FALSE, prefix = paste("panel:Y=",names(dimnames(x))[i],",X=", names(dimnames(x))[j],"|",sep = ""), ...) } } class(pairs_strucplot) <- "grapcon_generator" ## diagonal panels pairs_text <- function(dimnames = TRUE, gp_vartext = gpar(fontsize = 17), gp_leveltext = gpar(), gp_border = gpar(), ...) function(x, i) { x <- margin.table(x, i) grid.rect(gp = gp_border) grid.text(names(dimnames(x)), gp = gp_vartext, y = 0.5 + dimnames * 0.05, ...) if (dimnames) grid.text(paste("(",paste(names(x), collapse = ","), ")", sep = ""), y = 0.4, gp = gp_leveltext) } class(pairs_text) <- "grapcon_generator" pairs_diagonal_text <- function(varnames = TRUE, gp_vartext = gpar(fontsize = 17, fontface = "bold"), gp_leveltext = gpar(), gp_border = gpar(), pos = c("right","top"), distribute = c("equal","margin"), rot = 0, ...) { xc <- unit(switch(pos[1], left = 0.1, center = 0.5, 0.9), "npc") yc <- unit(switch(pos[2], top = 0.9, center = 0.5, 0.1), "npc") distribute <- match.arg(distribute) function(x, i) { x <- margin.table(x, i) grid.rect(gp = gp_border) if (varnames) grid.text(names(dimnames(x)), gp = gp_vartext, x = xc, y = yc, just = pos, ...) l <- length(dimnames(x)[[1]]) po <- if (distribute == "equal") unit(cumsum(rep(1 / (l + 1), l)), "npc") else { sizes = prop.table(x) unit(cumsum(c(0,sizes))[1:l] + sizes / 2, "npc") } grid.text(dimnames(x)[[1]], x = po, y = unit(1, "npc") - po, gp = gp_leveltext, rot = rot) } } class(pairs_diagonal_text) <- "grapcon_generator" pairs_barplot <- function(gp_bars = NULL, gp_vartext = gpar(fontsize = 17), gp_leveltext = gpar(), just_leveltext = c("center", "bottom"), just_vartext = c("center", "top"), rot = 0, abbreviate = FALSE, check_overlap = TRUE, fill = "grey", var_offset = unit(1, "npc"), ...) function(x, i) { if (!is.unit(var_offset)) var_offset <- unit(var_offset, "npc") dn <- names(dimnames(x)) x <- margin.table(x, i) if (is.function(fill)) fill <- rev(fill(dim(x))) if (is.null(gp_bars)) gp_bars <- gpar(fill = fill) pushViewport(viewport(x = 0.3, y = 0.1, width = 0.7, height = 0.7, yscale = c(0,max(x)), just = c("left", "bottom")) ) xpos <- seq(0, 1, length = length(x) + 1)[-1] halfstep <- (xpos[2] - xpos[1]) / 2 grid.rect(xpos - halfstep, rep.int(0, length(x)), height = x, just = c("center", "bottom"), width = halfstep, gp = gp_bars, default.units = "native", name = paste("panel:diag=", dn[i], "|bars", sep = ""), ...) grid.yaxis(at = pretty(c(0,max(x)))) txt <- names(x) if (abbreviate) txt <- abbreviate(txt, abbreviate) grid.text(txt, y = unit(-0.15, "npc"), rot = rot, x = xpos - halfstep, just = just_leveltext, gp = gp_leveltext, check.overlap = check_overlap) popViewport(1) grid.text(names(dimnames(x)), y = var_offset, just = just_vartext, gp = gp_vartext) } class(pairs_barplot) <- "grapcon_generator" pairs_diagonal_mosaic <- function(split_vertical = TRUE, margins = unit(0, "lines"), offset_labels = -0.4, offset_varnames = 0, gp = NULL, fill = "grey", labeling = labeling_values, alternate_labels = TRUE, ...) function(x, i) { if (is.function(fill)) fill <- rev(fill(dim(x)[i])) if (is.null(gp)) gp <- gpar(fill = fill) mosaic(margin.table(x, i), newpage = FALSE, split_vertical = split_vertical, margins = margins, offset_labels = offset_labels, offset_varnames = offset_varnames, prefix = "diag", gp = gp, labeling = labeling_values, labeling_args = list(alternate_labels = TRUE), ...) } class(pairs_diagonal_mosaic) <- "grapcon_generator" vcd/R/woolf_test.R0000755000175100001440000000131411150520606013553 0ustar hornikuserswoolf_test <- function(x) { DNAME <- deparse(substitute(x)) if (any(x == 0)) x <- x + 1 / 2 k <- dim(x)[3] or <- apply(x, 3, function(x) (x[1,1] * x[2,2]) / (x[1,2] * x[2,1])) w <- apply(x, 3, function(x) 1 / sum(1 / x)) o <- log(or) e <- weighted.mean(log(or), w) STATISTIC <- sum(w * (o - e)^2) PARAMETER <- k - 1 PVAL <- 1 - pchisq(STATISTIC, PARAMETER) METHOD <- "Woolf-test on Homogeneity of Odds Ratios (no 3-Way assoc.)" names(STATISTIC) <- "X-squared" names(PARAMETER) <- "df" structure(list(statistic = STATISTIC, parameter = PARAMETER, p.value = PVAL, method = METHOD, data.name = DNAME, observed = o, expected = e), class = "htest") } vcd/R/mplot.R0000644000175100001440000000471112445041727012534 0ustar hornikusersmplot <- function(..., .list = list(), layout = NULL, cex = NULL, main = NULL, gp_main = gpar(fontsize = 20), sub = NULL, gp_sub = gpar(fontsize = 15), keep_aspect_ratio = TRUE) { l <- c(list(...), .list) ll <- length(l) m <- !is.null(main) s <- !is.null(sub) ## calculate layout if (is.null(layout)) layout <- c(trunc(sqrt(ll)), ceiling(ll / trunc(sqrt(ll)))) ## push base layout grid.newpage() hts = unit(1 - 0.1 * m - 0.1 * s, "null") if (m) hts <- c(unit(0.1, "null"), hts) if (s) hts <- c(hts, unit(0.1, "null")) pushViewport(viewport(layout = grid.layout(nrow = 1 + m + s, ncol = 1, heights = hts) ) ) ## push main, if any if (!is.null(main)) { pushViewport(viewport(layout.pos.row = 1, layout.pos.col = NULL)) grid.text(main, gp = gp_main) popViewport(1) } ## push strucplots if (is.null(cex)) cex <- sqrt(1/layout[1]) pushViewport(viewport(layout.pos.row = 1 + m, layout.pos.col = NULL)) pushViewport(viewport(layout = grid.layout(nrow = layout[1], ncol = layout[2]), gp = gpar(cex = cex) ) ) count <- 1 for (i in seq_len(layout[1])) for (j in seq_len(layout[2])) if(count <= ll) { pushViewport(viewport(layout.pos.row = i, layout.pos.col = j)) pushViewport(viewport(width = 1, height = 1, default.units = if (keep_aspect_ratio) "snpc" else "npc")) if (inherits(l[[count]], "grob")) grid.draw(l[[count]]) else if (!is.null(attr(l[[count]], "grob"))) grid.draw(attr(l[[count]], "grob")) popViewport(2) count <- count + 1 } popViewport(2) ## push sub, if any if (!is.null(sub)) { pushViewport(viewport(layout.pos.row = 1 + m + s, layout.pos.col = NULL)) grid.text(sub, gp = gp_sub) popViewport() } popViewport(1) } vcd/R/distplot.R0000644000175100001440000001360012535524147013242 0ustar hornikusers# added lwd arg, changed default point sizes distplot <- function(x, type = c("poisson", "binomial", "nbinomial"), size = NULL, lambda = NULL, legend = TRUE, xlim = NULL, ylim = NULL, conf_int = TRUE, conf_level = 0.95, main = NULL, xlab = "Number of occurrences", ylab = "Distribution metameter", gp = gpar(cex = 0.8), lwd=2, name = "distplot", newpage = TRUE, pop = TRUE, return_grob = FALSE, ...) { if(is.vector(x)) { x <- table(x) } if(is.table(x)) { if(length(dim(x)) > 1) stop ("x must be a 1-way table") freq <- as.vector(x) count <- as.numeric(names(x)) } else { if(!(!is.null(ncol(x)) && ncol(x) == 2)) stop("x must be a 2-column matrix or data.frame") freq <- as.vector(x[,1]) count <- as.vector(x[,2]) } myindex <- (1:length(freq))[freq > 0] mycount <- count[myindex] myfreq <- freq[myindex] switch(match.arg(type), "poisson" = { par.ml <- suppressWarnings(goodfit(x, type = type)$par$lambda) phi <- function(nk, k, N, size = NULL) ifelse(nk > 0, lgamma(k + 1) + log(nk/N), NA) y <- phi(myfreq, mycount, sum(freq)) if(!is.null(lambda)) y <- y + lambda - mycount * log(lambda) fm <- lm(y ~ mycount) par.estim <- exp(coef(fm)[2]) names(par.estim) <- "lambda" txt <- "exp(slope)" if(!is.null(lambda)) { par.estim <- par.estim * lambda txt <- paste(txt, "x lambda") } legend.text <- paste(txt, "=", round(par.estim, digits = 3)) if(is.null(main)) main <- "Poissoness plot" }, "binomial" = { if(is.null(size)) { size <- max(count) warning("size was not given, taken as maximum count") } par.ml <- suppressWarnings(goodfit(x, type = type, par = list(size = size))$par$prob) phi <- function(nk, k, N, size = NULL) log(nk) - log(N * choose(size, k)) y <- phi(myfreq, mycount, sum(freq), size = size) fm <- lm(y ~ mycount) par.estim <- exp(coef(fm)[2]) par.estim <- par.estim / (1 + par.estim) names(par.estim) <- "prob" legend.text <- paste("inv.logit(slope) =", round(par.estim, digits = 3)) if(is.null(main)) main <- "Binomialness plot" }, "nbinomial" = { if(is.null(size)) { par.ml <- suppressWarnings(goodfit(x, type = type)$par) size <- par.ml$size par.ml <- par.ml$prob }else{ xbar <- weighted.mean(mycount, myfreq) par.ml <- size / (size+xbar) } phi <- function(nk, k, N, size = NULL) log(nk) - log(N * choose(size + k - 1, k)) y <- phi(myfreq, mycount, sum(freq), size = size) fm <- lm(y ~ mycount) par.estim <- 1 - exp(coef(fm)[2]) names(par.estim) <- "prob" legend.text <- paste("1-exp(slope) =", round(par.estim, digits = 3)) if(is.null(main)) main <- "Negative binomialness plot" }) yhat <- ifelse(myfreq > 1.5, myfreq - 0.67, 1/exp(1)) yhat <- phi(yhat, mycount, sum(freq), size = size) if(!is.null(lambda)) yhat <- yhat + lambda - mycount * log(lambda) phat <- myfreq / sum(myfreq) ci.width <- qnorm(1-(1 - conf_level)/2) * sqrt(1-phat)/sqrt(myfreq - (0.25 * phat + 0.47)*sqrt(myfreq)) RVAL <- cbind(count, freq, NA, NA, NA, NA, NA) RVAL[myindex,3:7] <- cbind(y,yhat,ci.width, yhat-ci.width, yhat + ci.width) RVAL <- as.data.frame(RVAL) names(RVAL) <- c("Counts", "Freq", "Metameter", "CI.center", "CI.width", "CI.lower", "CI.upper") if(is.null(xlim)) xlim <- range(RVAL[,1]) if(is.null(ylim)) ylim <- range(RVAL[,c(3,6,7)], na.rm = TRUE) xlim <- xlim + c(-1, 1) * diff(xlim) * 0.04 ylim <- ylim + c(-1, 1) * diff(ylim) * 0.04 if(newpage) grid.newpage() pushViewport(plotViewport(xscale = xlim, yscale = ylim, default.units = "native", name = name)) grid.points(x = RVAL[,1], y = RVAL[,3], default.units = "native", gp = gp, ...) grid.lines(x = xlim, y = predict(fm, newdata = data.frame(mycount = xlim)), default.units = "native", gp = gpar(lwd=lwd, col = 2)) grid.rect(gp = gpar(fill = "transparent")) grid.xaxis() grid.yaxis() grid.text(xlab, y = unit(-3.5, "lines")) grid.text(ylab, x = unit(-3, "lines"), rot = 90) grid.text(main, y = unit(1, "npc") + unit(2, "lines"), gp = gpar(fontface = "bold")) if(conf_int) { grid.points(x = RVAL[,1], y = RVAL[,4], pch = 19, gp = gpar(cex = 0.5)) grid.segments(RVAL[,1], RVAL[,6], RVAL[,1], RVAL[,7], default.units = "native", gp = gpar(lty = 3)) } if(legend) { mymin <- which.min(RVAL[,5]) leg.x <- RVAL[mymin,1] if(RVAL[mymin,6] - ylim[1] > ylim[2] - RVAL[mymin,7]) leg.y <- ylim[1] + 0.7 * (RVAL[mymin,6] - ylim[1]) else leg.y <- ylim[2] legend.text <- c(paste("slope =", round(coef(fm)[2], digits = 3)), paste("intercept =", round(coef(fm)[1], digits = 3)), "", paste(names(par.estim),": ML =", round(par.ml, digits=3)), legend.text) legend.text <- paste(legend.text, collapse = "\n") grid.text(legend.text, leg.x, leg.y - 0.05 * abs(leg.y), default.units = "native", just = c("left", "top")) } if(pop) popViewport() else upViewport() if (return_grob) structure(invisible(RVAL), grob = grid.grab()) else invisible(RVAL) } vcd/R/Kappa.R0000644000175100001440000000454612477411346012446 0ustar hornikusersKappa <- function (x, weights = c("Equal-Spacing", "Fleiss-Cohen")) { if (is.character(weights)) weights <- match.arg(weights) d <- diag(x) n <- sum(x) nc <- ncol(x) colFreqs <- colSums(x)/n rowFreqs <- rowSums(x)/n ## Kappa kappa <- function (po, pc) (po - pc) / (1 - pc) std <- function (p, pc, kw, W = diag(1, ncol = nc, nrow = nc)) { sqrt((sum(p * sweep(sweep(W, 1, W %*% colSums(p) * (1 - kw)), 2, W %*% rowSums(p) * (1 - kw)) ^ 2) - (kw - pc * (1 - kw)) ^ 2) / crossprod(1 - pc) / n) } ## unweighted po <- sum(d) / n pc <- crossprod(colFreqs, rowFreqs)[1] k <- kappa(po, pc) s <- std(x / n, pc, k) ## weighted W <- if (is.matrix(weights)) weights else if (weights == "Equal-Spacing") 1 - abs(outer(1:nc, 1:nc, "-")) / (nc - 1) else 1 - (abs(outer(1:nc, 1:nc, "-")) / (nc - 1))^2 pow <- sum(W * x) / n pcw <- sum(W * colFreqs %o% rowFreqs) kw <- kappa(pow, pcw) sw <- std(x / n, pcw, kw, W) structure( list(Unweighted = c( value = k, ASE = s ), Weighted = c( value = kw, ASE = sw ), Weights = W ), class = "Kappa" ) } print.Kappa <- function (x, digits=max(getOption("digits") - 3, 3), CI=FALSE, level=0.95, ...) { tab <- rbind(x$Unweighted, x$Weighted) z <- tab[,1] / tab[,2] tab <- cbind(tab, z, `Pr(>|z|)` = 2 * pnorm(-abs(z))) if (CI) { q <- qnorm((1 + level)/2) lower <- tab[,1] - q * tab[,2] upper <- tab[,1] + q * tab[,2] tab <- cbind(tab, lower, upper) } rownames(tab) <- names(x)[1:2] print(tab, digits=digits, ...) invisible(x) } summary.Kappa <- function (object, ...) structure(object, class = "summary.Kappa") print.summary.Kappa <- function (x, ...) { print.Kappa(x, ...) cat("\nWeights:\n") print(x$Weights, ...) invisible(x) } confint.Kappa <- function(object, parm, level = 0.95, ...) { q <- qnorm((1 + level) / 2) matrix(c(max(-1, object[[1]][1] - object[[1]][2] * q), min(1, object[[1]][1] + object[[1]][2] * q), max(-1, object[[2]][1] - object[[2]][2] * q), min(1, object[[2]][1] + object[[2]][2] * q)), ncol = 2, byrow = TRUE, dimnames = list(Kappa = c("Unweighted","Weighted"), c("lwr","upr")) ) } vcd/R/oddsratioplot.R0000655000175100001440000001125312475151317014271 0ustar hornikusers"oddsratio" <- function(x, stratum = NULL, log = TRUE) loddsratio(x, strata = stratum, log = log) ## "oddsratio" <- ## function (x, stratum = NULL, log = TRUE) { ## l <- length(dim(x)) ## if (l > 2 && is.null(stratum)) ## stratum <- 3:l ## if (l - length(stratum) > 2) ## stop("All but 2 dimensions must be specified as strata.") ## if (l == 2 && dim(x) != c(2, 2)) ## stop("Not a 2x2 table.") ## if (!is.null(stratum) && dim(x)[-stratum] != c(2,2)) ## stop("Need strata of 2x2 tables.") ## lor <- function (y) { ## if (any(y == 0)) ## y <- y + 0.5 ## y <- log(y) ## or <- y[1,1] + y[2,2] - y[1,2] - y[2,1] ## if (log) or else exp(or) ## } ## ase <- function(y) { ## if (any(y == 0)) ## y <- y + 0.5 ## sqrt(sum(1/y)) ## } ## if(is.null(stratum)) { ## LOR <- lor(x) ## ASE <- ase(x) ## } else { ## LOR <- apply(x, stratum, lor) ## ASE <- apply(x, stratum, ase) ## } ## structure(LOR, ## ASE = ASE, ## log = log, ## class = "oddsratio" ## )} ## "print.oddsratio" <- ## function(x, ...) { ## if (length(dim(x)) > 1) ## print(cbind(unclass(x)), ...) ## else ## print(c(x), ...) ## invisible(x) ## } ## "summary.oddsratio" <- ## function(object, ...) { ## if(!is.null(dim(object))) ## ret <- object ## else { ## LOG <- attr(object, "log") ## ASE <- attr(object, "ASE") ## Z <- object / ASE ## ret <- cbind("Estimate" = object, ## "Std. Error" = if (LOG) ASE, ## "z value" = if (LOG) Z, ## "Pr(>|z|)" = if (LOG) 2 * pnorm(-abs(Z)) ## ) ## colnames(ret)[1] <- if (LOG) "Log Odds Ratio" else "Odds Ratio" ## } ## class(ret) <- "summary.oddsratio" ## ret ## } ## "print.summary.oddsratio" <- ## function(x, ...) { ## if(!is.null(attr(x, "log"))) { ## cat("\n") ## cat(if(attr(x, "log")) "Log Odds Ratio(s):" else "Odds Ratio(s):", "\n\n") ## print(as.data.frame(unclass(x)), ...) ## cat("\nAsymptotic Standard Error(s):\n\n") ## print(attr(x, "ASE"), ...) ## cat("\n") ## } else printCoefmat(unclass(x), ...) ## invisible(x) ## } ## "plot.oddsratio" <- ## function(x, ## conf_level = 0.95, ## type = "o", ## xlab = NULL, ## ylab = NULL, ## xlim = NULL, ## ylim = NULL, ## whiskers = 0.1, ## baseline = TRUE, ## transpose = FALSE, ## ...) ## { ## if (length(dim(x)) > 1) ## stop ("Plot function works only on vectors.") ## LOG <- attr(x, "log") ## confidence <- !(is.null(conf_level) || conf_level == FALSE) ## oddsrange <- range(x) ## if(confidence) { ## CI <- confint(x, level = conf_level) ## lwr <- CI[,1] ## upr <- CI[,2] ## oddsrange[1] <- trunc(min(oddsrange[1], min(lwr))) ## oddsrange[2] <- ceiling(max(oddsrange[2], max(upr))) ## } ## if (transpose) { ## plot(x = unclass(x), ## y = 1:length(x), ## ylab = if (!is.null(ylab)) ylab else "Strata", ## xlab = if (!is.null(xlab)) xlab else if (LOG) "Log Odds Ratio" else "Odds Ratio", ## type = type, ## yaxt = "n", ## xlim = if(is.null(xlim)) oddsrange else xlim, ## ...) ## axis (2, at = 1:length(x), names(x)) ## if (baseline) ## lines(c(1,1) - LOG, c(0,length(x) + 1), lty = 2, col = "red") ## if (confidence) ## for (i in 1:length(x)) { ## lines(c(lwr[i], upr[i]), c(i, i)) ## lines(c(lwr[i], lwr[i]), c(i - whiskers/2, i + whiskers/2)) ## lines(c(upr[i], upr[i]), c(i - whiskers/2, i + whiskers/2)) ## } ## } else { ## plot(unclass(x), ## xlab = if (!is.null(xlab)) xlab else "Strata", ## ylab = if(!is.null(ylab)) ylab else if(LOG) "Log Odds Ratio" else "Odds Ratio", ## type = type, ## xaxt = "n", ## ylim = if(is.null(ylim)) oddsrange else ylim, ## ...) ## axis (1, at = 1:length(x), names(x)) ## if (baseline) ## lines(c(0,length(x) + 1), c(1,1) - LOG, lty = 2, col = "red") ## if (confidence) ## for (i in 1:length(x)) { ## lines(c(i, i), c(lwr[i], upr[i])) ## lines(c(i - whiskers/2, i + whiskers/2), c(lwr[i], lwr[i])) ## lines(c(i - whiskers/2, i + whiskers/2), c(upr[i], upr[i])) ## } ## } ## } ## "confint.oddsratio" <- ## function(object, parm, level = 0.95, ...) { ## ASE <- attr(object, "ASE") ## LOG <- attr(object, "log") ## I <- ASE * qnorm((1 + level) / 2) ## cbind( ## lwr = if (LOG) object - I else exp(log(object) - I), ## upr = if (LOG) object + I else exp(log(object) + I) ## ) ## } vcd/R/agreementplot.R0000644000175100001440000001364512472412330014245 0ustar hornikusers## Modified 1/25/2012 11:43AM by M. friendly # -- added fill_col argument, specifying a function to be used to fill the tiles # -- added xscale, yscale arguments to show the marginal frequencies at top & right # -- added line_col to change the color of the diagonal line ## Modified 3/24/2012 11:38AM by M. friendly # -- fixed buglet with yscale=TRUE and reverse_y=FALSE "agreementplot" <- function (x, ...) UseMethod ("agreementplot") "agreementplot.formula" <- function (formula, data = NULL, ..., subset) { m <- match.call(expand.dots = FALSE) edata <- eval(m$data, parent.frame()) if (inherits(edata, "ftable") || inherits(edata, "table")) { data <- as.table(data) varnames <- attr(terms(formula), "term.labels") if (all(varnames != ".")) data <- margin.table(data, match(varnames, names(dimnames(data)))) agreementplot(data, ...) } else { if (is.matrix(edata)) m$data <- as.data.frame(data) m$... <- NULL m[[1]] <- as.name("model.frame") mf <- eval(m, parent.frame()) if (length(formula) == 2) { by <- mf y <- NULL } else { i <- attr(attr(mf, "terms"), "response") by <- mf[-i] y <- mf[[i]] } by <- lapply(by, factor) x <- if (is.null(y)) do.call("table", by) else if (NCOL(y) == 1) tapply(y, by, sum) else { z <- lapply(as.data.frame(y), tapply, by, sum) array(unlist(z), dim = c(dim(z[[1]]), length(z)), dimnames = c(dimnames(z[[1]]), list(names(z)))) } x[is.na(x)] <- 0 agreementplot(x, ...) } } "agreementplot.default" <- function(x, reverse_y = TRUE, main = NULL, weights = c(1, 1 - 1 / (ncol(x) - 1)^2), margins = par("mar"), newpage = TRUE, pop = TRUE, xlab = names(dimnames(x))[2], ylab = names(dimnames(x))[1], xlab_rot = 0, xlab_just = "center", ylab_rot = 90, ylab_just = "center", fill_col = function(j) gray((1 - (weights[j]) ^ 2) ^ 0.5), line_col = "red", xscale=TRUE, yscale = TRUE, return_grob = FALSE, prefix = "", ...) { if (length(dim(x)) > 2) stop("Function implemented for two-way tables only!") if (ncol(x) != nrow(x)) stop("Dimensions must have equal length!") nc <- ncol(x) ## compute relative frequencies n <- sum(x) colFreqs <- colSums(x) / n rowFreqs <- rowSums(x) / n ## open viewport if (newpage) grid.newpage() pushViewport(plotViewport(margins, name = paste(prefix,"agreementplot"))) pushViewport(viewport(width = unit(1, "snpc"), height = unit(1, "snpc"))) if(!is.null(main)) grid.text(main, y = unit(1.1, "npc"), gp = gpar(fontsize = 25)) ## axis labels grid.text(xlab, y = -0.12, gp = gpar(fontsize = 20)) grid.text(ylab, x = -0.1, gp = gpar(fontsize = 20), rot = 90) grid.rect(gp = gpar(fill = "transparent")) xc <- c(0, cumsum(colFreqs)) yc <- c(0, cumsum(rowFreqs)) my.text <- if(reverse_y) function(y, ...) grid.text(y = y, ...) else function(y, ...) grid.text(y = 1 - y, ...) my.rect <- if(reverse_y) function(xleft, ybottom, xright, ytop, ...) grid.rect(x = xleft, y = ybottom, width = xright - xleft, height = ytop - ybottom, just = c("left","bottom"), ...) else function(xleft, ybottom, xright, ytop, ...) grid.rect(x = xleft, y = 1 - ybottom, width = xright - xleft, height = ytop - ybottom, just = c("left","top"), ...) A <- matrix(0, length(weights), nc) for (i in 1:nc) { ## x - axis grid.text(dimnames(x)[[2]][i], x = xc[i] + (xc[i + 1] - xc[i]) / 2, y = - 0.04, check.overlap = TRUE, rot = xlab_rot, just = xlab_just, ...) ## y - axis my.text(dimnames(x)[[1]][i], y = yc[i] + (yc[i + 1] - yc[i]) / 2, x = - 0.03, check.overlap = TRUE, rot = ylab_rot, just = ylab_just, ...) ## expected rectangle my.rect(xc[i], yc[i], xc[i + 1], yc[i + 1]) ## observed rectangle y0 <- c(0, cumsum(x[i,])) / sum(x[i,]) x0 <- c(0, cumsum(x[,i])) / sum(x[,i]) rec <- function (col, dens, lb, tr) my.rect(xc[i] + (xc[i + 1] - xc[i]) * x0[lb], yc[i] + (yc[i + 1] - yc[i]) * y0[lb], xc[i] + (xc[i + 1] - xc[i]) * x0[tr], yc[i] + (yc[i + 1] - yc[i]) * y0[tr], gp = gpar(fill = fill_col(j), col = col, rot = 135) ) for (j in length(weights):1) { lb <- max(1, i - j + 1) tr <- 1 + min(nc, i + j - 1) A[j, i] <- sum(x[lb:(tr-1),i]) * sum(x[i, lb:(tr-1)]) rec("white", NULL, lb, tr) ## erase background rec("black", if (weights[j] < 1) weights[j] * 20 else NULL, lb, tr) } ## correct A[j,i] -> not done by Friendly==Bug? for (j in length(weights):1) if (j > 1) A[j, i] <- A[j, i] - A[j - 1, i] } if (reverse_y) grid.lines(c(0, 1), c(0, 1), gp = gpar(col = line_col, linetype = "longdash")) else grid.lines(c(0, 1), c(1, 0), gp = gpar(col = line_col, linetype = "longdash")) if (xscale) { cx <- xc[-(nc+1)] + diff(xc)/2 grid.text(colSums(x), x = cx, y = 1.03, rot = xlab_rot, just = xlab_just, ...) grid.xaxis(at = xc, label = FALSE, main=FALSE, gp = gpar(fontsize=10), draw = TRUE, vp = NULL) } if (yscale) { cy <- yc[-(nc+1)] + diff(yc)/2 my.text(rowSums(x), x = 1.04, y = cy, rot = 0, just = ylab_just, ...) grid.yaxis(at = if(reverse_y) yc else 1-yc, FALSE, main=FALSE, gp = gpar(fontsize=10), draw = TRUE, vp = NULL) } if (pop) popViewport(2) else upViewport(2) ## Statistics - Returned invisibly ads <- crossprod(diag(x)) ar <- n * n * crossprod(colFreqs, rowFreqs) if (return_grob) invisible(structure(list( Bangdiwala = ads / ar, Bangdiwala_Weighted = (sum(weights * A)) / ar, weights = weights), grob = grid.grab() ) ) else invisible(list( Bangdiwala = ads / ar, Bangdiwala_Weighted = (sum(weights * A)) / ar, weights = weights) ) } vcd/R/cd_plot.R0000655000175100001440000000705012445057350013025 0ustar hornikuserscd_plot <- function(x, ...) { UseMethod("cd_plot") } cd_plot.formula <- function(formula, data = list(), plot = TRUE, ylab_tol = 0.05, bw = "nrd0", n = 512, from = NULL, to = NULL, main = "", xlab = NULL, ylab = NULL, margins = c(5.1, 4.1, 4.1, 3.1), gp = gpar(), name = "cd_plot", newpage = TRUE, pop = TRUE, return_grob = FALSE, ...) { ## extract x, y from formula mf <- model.frame(formula, data = data) if(NCOL(mf) != 2) stop("`formula' should specify exactly two variables") y <- mf[,1] if(!is.factor(y)) stop("dependent variable should be a factor") x <- mf[,2] if(!is.numeric(x)) stop("explanatory variable should be numeric") ## graphical parameters if(is.null(xlab)) xlab <- names(mf)[2] if(is.null(ylab)) ylab <- names(mf)[1] ## call default interface cd_plot(x, y, plot = plot, ylab_tol = ylab_tol, bw = bw, n = n, from = from, to = to, main = main, xlab = xlab, ylab = ylab, margins = margins, gp = gp, name = name, newpage = newpage, pop = pop, ...) } cd_plot.default <- function(x, y, plot = TRUE, ylab_tol = 0.05, bw = "nrd0", n = 512, from = NULL, to = NULL, main = "", xlab = NULL, ylab = NULL, margins = c(5.1, 4.1, 4.1, 3.1), gp = gpar(), name = "cd_plot", newpage = TRUE, pop = TRUE, return_grob = FALSE, ...) { ## check x and y if(!is.numeric(x)) stop("explanatory variable should be numeric") if(!is.factor(y)) stop("dependent variable should be a factor") ny <- length(levels(y)) ## graphical parameters if(is.null(xlab)) xlab <- deparse(substitute(x)) if(is.null(ylab)) ylab <- deparse(substitute(y)) if(is.null(gp$fill)) gp$fill <- gray.colors(ny) gp$fill <- rep(gp$fill, length.out = ny) ## unconditional density of x dx <- if(is.null(from) & is.null(to)) density(x, bw = bw, n = n, ...) else density(x, bw = bw, from = from, to = to, n = n, ...) x1 <- dx$x ## setup conditional values yprop <- cumsum(prop.table(table(y))) y1 <- matrix(rep(0, n*(ny-1)), nrow = (ny-1)) ## setup return value rval <- list() for(i in 1:(ny-1)) { dxi <- density(x[y %in% levels(y)[1:i]], bw = dx$bw, n = n, from = min(dx$x), to = max(dx$x), ...) y1[i,] <- dxi$y/dx$y * yprop[i] rval[[i]] <- approxfun(x1, y1[i,], rule = 2) } names(rval) <- levels(y)[1:(ny-1)] ## use known ranges y1 <- rbind(0, y1, 1) y1 <- y1[,which(x1 >= min(x) & x1 <= max(x))] x1 <- x1[x1 >= min(x) & x1 <= max(x)] ## plot polygons if(plot) { ## setup if(newpage) grid.newpage() pushViewport(plotViewport(xscale = range(x1), yscale = c(0, 1), default.units = "native", name = name, margins = margins, ...)) ## polygons for(i in 1:(NROW(y1)-1)) { gpi <- gp gpi$fill <- gp$fill[i] grid.polygon(x = c(x1, rev(x1)), y = c(y1[i+1,], rev(y1[i,])), default.units = "native", gp = gpi) } ## axes grid.rect(gp = gpar(fill = "transparent")) grid.xaxis() grid.yaxis(main = FALSE) equidist <- any(diff(y1[,1]) < ylab_tol) yat <- if(equidist) seq(1/(2*ny), 1-1/(2*ny), by = 1/ny) else (y1[-1,1] + y1[-NROW(y1), 1])/2 grid.text(x = unit(-1.5, "lines"), y = unit(yat, "native"), label = levels(y), rot = 90, check.overlap = TRUE) ## annotation grid.text(xlab, y = unit(-3.5, "lines")) grid.text(ylab, x = unit(-3, "lines"), rot = 90) grid.text(main, y = unit(1, "npc") + unit(2, "lines"), gp = gpar(fontface = "bold")) ## pop if(pop) popViewport() } ## return conditional density functions if (plot && return_grob) invisible(structure(rval, grob = grid.grab())) else invisible(rval) } vcd/R/hls.R0000755000175100001440000000106511150520606012157 0ustar hornikusershls <- function(h = 1, l = 0.5, s = 1) { RGB <- function(q1, q2, hue) { if (hue > 360) hue <- hue - 360 if (hue < 0) hue <- hue + 360 if (hue < 60) q1 + (q2 - q1) * hue / 60 else if (hue < 180) q2 else if (hue < 240) q1 + (q2 - q1) * (240 - hue) / 60 else q1 } h <- h * 360 p2 <- if (l <= 0.5) l * (1 + s) else l + s - (l * s) p1 <- 2 * l - p2; if (s == 0) R <- G <- B <- l else { R <- RGB(p1, p2, h + 120) G <- RGB(p1, p2, h) B <- RGB(p1, p2, h - 120) } rgb(R, G, B) } vcd/R/legends.R0000755000175100001440000001705512212351252013017 0ustar hornikuserslegend_resbased <- function(fontsize = 12, fontfamily = "", x = unit(1, "lines"), y = unit(0.1, "npc"), height = unit(0.8, "npc"), width = unit(0.7, "lines"), digits = 2, check_overlap = TRUE, text = NULL, steps = 200, ticks = 10, pvalue = TRUE, range = NULL) { if(!is.unit(x)) x <- unit(x, "native") if(!is.unit(y)) y <- unit(y, "npc") if(!is.unit(width)) width <- unit(width, "lines") if(!is.unit(height)) height <- unit(height, "npc") function(residuals, shading, autotext) { res <- as.vector(residuals) if(is.null(text)) text <- autotext p.value <- attr(shading, "p.value") legend <- attr(shading, "legend") if (all(residuals == 0)) { pushViewport(viewport(x = x, y = y, just = c("left", "bottom"), default.units = "native", height = height, width = width)) grid.lines(y = 0.5) grid.text(0, x = unit(1, "npc") + unit(0.8, "lines"), y = 0.5, gp = gpar(fontsize = fontsize, fontfamily = fontfamily)) warning("All residuals are zero.") } else { if (is.null(range)) range <- range(res) if (length(range) != 2) stop("Range must have length two!") if (is.na(range[1])) range[1] <- min(res) if (is.na(range[2])) range[2] <- max(res) pushViewport(viewport(x = x, y = y, just = c("left", "bottom"), yscale = range, default.units = "native", height = height, width = width)) if(is.null(legend$col.bins)) { col.bins <- seq(range[1], range[2], length = steps) at <- NULL } else { col.bins <- sort(unique(c(legend$col.bins, range))) col.bins <- col.bins[col.bins <= range[2] & col.bins >= range[1]] at <- col.bins } y.pos <- col.bins[-length(col.bins)] y.height <- diff(col.bins) grid.rect(x = unit(rep.int(0, length(y.pos)), "npc"), y = y.pos, height = y.height, default.units = "native", gp = gpar(fill = shading(y.pos + 0.5 * y.height)$fill, col = 0), just = c("left", "bottom")) grid.rect(gp = gpar(fill = "transparent")) if(is.null(at)) at <- seq(from = head(col.bins, 1), to = tail(col.bins, 1), length = ticks) lab <- format(round(at, digits = digits), nsmall = digits) tw <- lab[which.max(nchar(lab))] ## if(is.null(at)) ## at <- seq(from = head(col.bins, 1), to = tail(col.bins, 1), length = ticks) ## tw <- paste(rep("4", digits), collapse = "") ## if (any(trunc(at) != at)) ## tw <- paste(tw, ".", sep = "") ## if (any(at < 0)) ## tw <- paste(tw, "-", sep = "") grid.text(format(signif(at, digits = digits)), x = unit(1, "npc") + unit(0.8, "lines") + unit(1, "strwidth", tw), y = at, default.units = "native", just = c("right", "center"), gp = gpar(fontsize = fontsize, fontfamily = fontfamily), check.overlap = check_overlap) grid.segments(x0 = unit(1, "npc"), x1 = unit(1,"npc") + unit(0.5, "lines"), y0 = at, y1 = at, default.units = "native") } popViewport(1) grid.text(text, x = x, y = unit(1, "npc") - y + unit(1, "lines"), gp = gpar(fontsize = fontsize, fontfamily = fontfamily, lineheight = 0.8), just = c("left", "bottom") ) if(!is.null(p.value) && pvalue) { grid.text(paste("p-value =\n", format.pval(p.value), sep = ""), x = x, y = y - unit(1, "lines"), gp = gpar(fontsize = fontsize, fontfamily = fontfamily, lineheight = 0.8), just = c("left", "top")) } } } class(legend_resbased) <- "grapcon_generator" legend_fixed <- function(fontsize = 12, fontfamily = "", x = unit(1, "lines"), y = NULL, height = NULL, width = unit(1.5, "lines"), steps = 200, digits = 1, space = 0.05, text = NULL, range = NULL) { if(!is.unit(x)) x <- unit(x, "native") if(!is.unit(y) && !is.null(y)) y <- unit(y, "npc") if(!is.unit(width)) width <- unit(width, "lines") if(!is.unit(height) && !is.null(height)) height <- unit(height, "npc") function(residuals, shading, autotext) { res <- as.vector(residuals) if(is.null(text)) text <- autotext if (is.null(y)) y <- unit(1, "strwidth", text) + unit(1, "lines") if (is.null(height)) height <- unit(1, "npc") - y pushViewport(viewport(x = x, y = y, just = c("left", "bottom"), yscale = c(0,1), default.units = "npc", height = height, width = width)) p.value <- attr(shading, "p.value") legend <- attr(shading, "legend") if (is.null(range)) range <- range(res) if (length(range) != 2) stop("Range must have length two!") if (is.na(range[1])) range[1] <- min(res) if (is.na(range[2])) range[2] <- max(res) if(is.null(legend$col.bins)) { col.bins <- seq(range[1], range[2], length = steps) } else { col.bins <- sort(unique(c(legend$col.bins, range))) col.bins <- col.bins[col.bins <= range[2] & col.bins >= range[1]] } l <- length(col.bins) y.height <- (1 - (l - 2) * space) / (l - 1) y.pos <- cumsum(c(0, rep(y.height + space, l - 2))) res <- col.bins[-l] + diff(col.bins) / 2 grid.rect(x = unit(rep.int(0, length(y.pos)), "npc"), y = y.pos, height = y.height, default.units = "npc", gp = shading(res), just = c("left", "bottom")) numbers <- format(col.bins, nsmall = digits, digits = digits) wid <- unit(1, "strwidth", format(max(abs(col.bins)), nsmall = digits, digits = digits)) grid.text(numbers[-l], x = unit(1, "npc") + unit(0.6, "lines") + wid, y = y.pos, gp = gpar(fontsize = fontsize, fontfamily = fontfamily), default.units = "npc", just = c("right", "bottom")) grid.text(numbers[-1], x = unit(1, "npc") + unit(0.6, "lines") + wid, y = y.pos + y.height, gp = gpar(fontsize = fontsize, fontfamily = fontfamily), default.units = "npc", just = c("right", "top")) wid2 <- unit(1, "strwidth", format(max(abs(trunc(col.bins))))) + unit(0.3, "strwidth", ".") grid.segments(x0 = unit(1, "npc") + wid2 + unit(0.6, "lines"), x1 = unit(1, "npc") + wid2 + unit(0.6, "lines"), y0 = unit(y.pos, "npc") + 1.5 * unit(1, "strheight", "-44.4"), y1 = unit(y.pos + y.height, "npc") - 1.5 * unit(1, "strheight", "-44.4") ) popViewport(1) grid.text(text, x = x + 0.5 * width, y = 0, gp = gpar(fontsize = fontsize, fontfamily = fontfamily, lineheight = 0.8), just = c("left", "top"), rot = 90 ) } } class(legend_fixed) <- "grapcon_generator" vcd/R/goodfit.R0000655000175100001440000002325212511044617013032 0ustar hornikusersgoodfit <- function(x, type = c("poisson", "binomial", "nbinomial"), method = c("ML", "MinChisq"), par = NULL) { if(is.vector(x)) { x <- table(x) } if(is.table(x)) { if(length(dim(x)) > 1) stop ("x must be a 1-way table") freq <- as.vector(x) count <- as.numeric(names(x)) } else { if(!(!is.null(ncol(x)) && ncol(x) == 2)) stop("x must be a 2-column matrix or data.frame") freq <- as.vector(x[,1]) count <- as.vector(x[,2]) } ## fill-in possibly missing cells nfreq <- rep(0, max(count) + 1) nfreq[count + 1] <- freq freq <- nfreq count <- 0:max(count) n <- length(count) ## starting value for degrees of freedom df <- -1 type <- match.arg(type) method <- match.arg(method) switch(type, "poisson" = { if(!is.null(par)) { if(!is.list(par)) stop("`par' must be a named list") if(names(par) != "lambda") stop("`par' must specify `lambda'") par <- par$lambda method <- "fixed" } else if(method == "ML") { df <- df - 1 par <- weighted.mean(count,freq) } else if(method == "MinChisq") { df <- df - 1 chi2 <- function(x) { p.hat <- diff(c(0, ppois(count[-n], lambda = x), 1)) expected <- sum(freq) * p.hat sum((freq - expected)^2/expected) } par <- optimize(chi2, range(count))$minimum } par <- list(lambda = par) p.hat <- dpois(count, lambda = par$lambda) }, "binomial" = { size <- par$size if(is.null(size)) { size <- max(count) warning("size was not given, taken as maximum count") } if(size > max(count)) { nfreq <- rep(0, size + 1) nfreq[count + 1] <- freq freq <- nfreq count <- 0:size n <- length(count) } if(!is.null(par$prob)) { if(!is.list(par)) stop("`par' must be a named list and specify `prob'") par <- par$prob method <- "fixed" } else if(method == "ML") { df <- df - 1 par <- weighted.mean(count/size, freq) } else if(method == "MinChisq") { df <- df - 1 chi2 <- function(x) { p.hat <- diff(c(0, pbinom(count[-n], prob = x, size = size), 1)) expected <- sum(freq) * p.hat sum((freq - expected)^2/expected) } par <- optimize(chi2, c(0,1))$minimum } par <- list(prob = par, size = size) p.hat <- dbinom(count, prob = par$prob, size = par$size) }, "nbinomial" = { if(!is.null(par)) { if(!is.list(par)) stop("`par' must be a named list") if(!(isTRUE(all.equal(names(par), "size")) | isTRUE(all.equal(sort(names(par)), c("prob", "size"))))) stop("`par' must specify `size' and possibly `prob'") if(!is.null(par$prob)) method <- "fixed" } switch(method, "ML" = { if(is.null(par$size)) { df <- df - 2 par <- fitdistr(rep(count, freq), "negative binomial")$estimate par <- par[1]/c(1, sum(par)) } else { df <- df - 1 method <- c("ML", "with size fixed") size <- par$size xbar <- weighted.mean(count,freq) par <- c(size, size/(xbar+size)) } }, "MinChisq" = { if(is.null(par$size)) { df <- df - 2 ## MM xbar <- weighted.mean(count,freq) s2 <- var(rep(count,freq)) p <- xbar / s2 size <- xbar^2/(s2 - xbar) par1 <- c(size, p) ## minChisq chi2 <- function(x) { p.hat <- diff(c(0, pnbinom(count[-n], size = x[1], prob = x[2]), 1)) expected <- sum(freq) * p.hat sum((freq - expected)^2/expected) } par <- optim(par1, chi2)$par } else { df <- df - 1 method <- c("MinChisq", "with size fixed") chi2 <- function(x) { p.hat <- diff(c(0, pnbinom(count[-n], size = par$size, prob = x), 1)) expected <- sum(freq) * p.hat sum((freq - expected)^2/expected) } par <- c(par$size, optimize(chi2, c(0, 1))$minimum) } }, "fixed" = { par <- c(par$size, par$prob) }) par <- list(size = par[1], prob = par[2]) p.hat <- dnbinom(count, size = par$size, prob = par$prob) }) expected <- sum(freq) * p.hat df <- switch(method[1], "MinChisq" = { length(freq) + df }, "ML" = { sum(freq > 0) + df }, "fixed" = { c(length(freq), sum(freq > 0)) + df } ) structure(list(observed = freq, count = count, fitted = expected, type = type, method = method, df = df, par = par), class = "goodfit") } # does this need a residuals_type arg? print.goodfit <- function(x, residuals_type = c("pearson", "deviance", "raw"), ...) { residuals_type <- match.arg(residuals_type) cat(paste("\nObserved and fitted values for", x$type, "distribution\n")) if(x$method[1] == "fixed") cat("with fixed parameters \n\n") else cat(paste("with parameters estimated by `", paste(x$method, collapse = " "), "' \n\n", sep = "")) resids <- residuals(x, type = residuals_type) RVAL <- cbind(x$count, x$observed, x$fitted, resids) colnames(RVAL) <- c("count", "observed", "fitted", paste(residuals_type, "residual")) rownames(RVAL) <- rep("", nrow(RVAL)) print(RVAL, ...) invisible(x) } summary.goodfit <- function(object, ...) { df <- object$df obsrvd <- object$observed count <- object$count expctd <- fitted(object) G2 <- sum(ifelse(obsrvd == 0, 0, obsrvd * log(obsrvd/expctd))) * 2 n <- length(obsrvd) pfun <- switch(object$type, poisson = "ppois", binomial = "pbinom", nbinomial = "pnbinom") p.hat <- diff(c(0, do.call(pfun, c(list(q = count[-n]), object$par)), 1)) expctd <- p.hat * sum(obsrvd) X2 <- sum((obsrvd - expctd)^2 / expctd) names(G2) <- "Likelihood Ratio" names(X2) <- "Pearson" if(any(expctd < 5) & object$method[1] != "ML") warning("Chi-squared approximation may be incorrect") RVAL <- switch(object$method[1], ML = G2, MinChisq = X2, fixed = c(X2, G2) ) RVAL <- cbind(RVAL, df, pchisq(RVAL, df = df, lower.tail = FALSE)) colnames(RVAL) <- c("X^2", "df", "P(> X^2)") cat(paste("\n\t Goodness-of-fit test for", object$type, "distribution\n\n")) print(RVAL, ...) invisible(RVAL) } plot.goodfit <- function(x, ...) { rootogram(x, ...) } fitted.goodfit <- function(object, ...) { object$fitted } residuals.goodfit <- function(object, type = c("pearson", "deviance", "raw"), ...) { obsrvd <- object$observed expctd <- fitted(object) count <- object$count n <- length(obsrvd) pfun <- switch(object$type, poisson = "ppois", binomial = "pbinom", nbinomial = "pnbinom") p.hat <- diff(c(0, do.call(pfun, c(list(q = count[-n]), object$par)), 1)) expctd <- p.hat * sum(obsrvd) res <- switch(match.arg(type), pearson = (obsrvd - expctd) / sqrt(expctd), deviance = ifelse(obsrvd == 0, 0, obsrvd * log(obsrvd / expctd)), obsrvd - expctd) return(res) } predict.goodfit <- function(object, newcount = NULL, type = c("response", "prob"), ...) { if(is.null(newcount)) newcount <- object$count type <- match.arg(type) densfun <- switch(object$type, poisson = "dpois", binomial = "dbinom", nbinomial = "dnbinom") RVAL <- do.call(densfun, c(list(x = newcount), object$par)) if (type == "response") RVAL <- RVAL * sum(object$observed) return(RVAL) } vcd/vignettes/0000755000175100001440000000000012547003156013057 5ustar hornikusersvcd/vignettes/struc.sxi0000755000175100001440000002162011720273431014745 0ustar hornikusersPKJS3Xmimetypeapplication/vnd.sun.xml.impressPKJS3 content.xml\[~ϯ ReWZ/SJuص$O$2HF3 yIIN7!GGt>Ǖ/<{ap-H8kK7o~ۻ|As!WnW$H&N$WoV'釈8 b:}wNHew 􇿊>+޼iz8WiﵸLj: 55$IZn'0=f1zaS1:Z+xH0-: A(ϙp=7oޅwW`n$Y< RCDxAΈ4H,a~AuN&5FY8'qxxxlfxA+ /(7IzWԭ{5|Z 8/!IY{ZyY9q{sY 2۶UeN!WC?qB{R YKb?ˀ<ɨOL6E[,s^heΪh!6 =Vmh6_XBWV` sKBd~; # 1 IXFYd Ɇ.Đ_zOOR\> XFiD$U#l!~)zA|L:R5 QHzeuc?Ï[Jȕj8/rZ#,/d qsQuww2Q[d{y|h)v>Vs8A7mԭm+L %H鮹0V4{ -)mwn+YPs)~mdAB=ƋK4lC#~.ijmsDZU LDkӱ4wM`1W}Qw^+xx}GkauνGn":ETm,Zl5)i WOq2,@!@L$adt3swp6*Įߤo$_W8ObL]^YX&1[>I2횰cȟL?=faaW@Psʬ,4Ji\8!CNG؁'yHIy+}kڅ;>{XH/vyء t(:'!+]bꃎLU 1䗠KRRkoQGn(KeUdjrG9)(32J T8!nf.~ҏr T$Ea@ x$pYPO0(np16ۀ0eaSC <a"8ς~ a q=;B6tu hH95őXLv 'x dl:\򁒰dժ+VeYzmd8sYevϵA}G;RtR&}x"&VoviyvC-P_ LI<1qz&ux<c!j3`pct2~^%tzʼxjs;:MnS J> ogVY%3$̗8И:}:S^@cpLq}ė˯eg˯{-3a*cR!L!!k>,IIS;p34OoPXZI$d᭖ܧw_9I\fZmFxmeˬM6N7e9T|}FPy-+u$)reHBn[:*FѲN] }746-L7ZN}PKF1D *\PKJS3 styles.xml][6~_J޸ v&dk3S=UGd vw>_ .6`Ʒf|^@zqh".K0rGe,pۿ?Kh6]x!w(U5ˏ$+i OTJE\%>k$hϿʒ.z'6\k%7r"/tyiw1u]o9k@[S .—U`T{1XJ8\z^kJh|亼~QrhNaܮ HAe  Ҳ,N3snq;Tviy\#h@g=J8l8scٮ9 噧?_a,G ~!Z0b7>\^&.钩K1 -LY׽ l2C7_;DO~ ?P"V(;F0݉O]q PJ?0$M@e+0E0.ZEiuXwK ~/#k4zV6% `jJP7̔*+p@O`Q,hV-U.SBR,Ⱦu#Er銆e'r⓫T18x%)\u8*!J:Uh`6=6/x"Xu"j̻mk"Ϊk@W?^gaRa=,&EDbpV Y_,~OayMљOWU]gfU ɴ&84=S5Ϊ.l%9֦i;vPA:})S:HӐD ZnyXfbͷ3Pͫ6>U?8|Sa[Wm@<3߾ju>C?eFRu5$MnS [F纜8_{U6hj 2|٫+ڹ2ÿ*kad(8f|O|C³`2fdq6e|V-Ϗ;H)^OF1vVU{6U}s&쵻 8ccKXTuAd^yAd^yAOKS݉W*ݲͶmnoUlkmܖ[3u6 l溎sr܊5fW숀j4+Jd {ͼ.`n &`n &˼xXY7%L6Ra&6;=ni _/Z~)̯;R짘B~w=FPP@mUeg-ԮTz0@y&-]p~Wىy:N7uqd^ՈV#jZXk5|ǵ CT#Xb-̞g- j r[ZkEZkeLu#t)aS&oS/`l[RF{:>F矆"~̞'~ jJ.]D 蟠 '蟠Y8`')c2΢/wvQW=Isq?{IθwG;v{3@nwΏntιjv~xfǧl?Mő>U8NfvDZ]m7nImeK1.r"+,鼍aVۆ޾Z Ϫ6Z[mPjvY֞X^~ZϠKt} jt u>ku}@uTPj}Sj#eI>WD'Ų2 J;$6'+,tl2} `g>LWGzT0ma[3&v~nXUxmQvz=!ꑁ`T.sLC8Ů2xD_|g8'.X\Lmj['[#Vqǵw:f/2wK1v'/o}A,n6cLQgv_VTKP&Ed)]3n{ō.bHd!S96`d!{b56D42J[-Lp? Ucmߑ:ܑO%S|}ҍ#25(dJ | <;zԦ]U~yiUyOҗa2h9E/ձQ9gXial"e}T齆|$*ޔekZgۊ(gXi7PָɼL} HZ|lTaxG%PlGO(tޥ#TݟXNIwܿN[ILmwhJ7q^!w7?PK 8PKJS3*meta.xml OpenOffice.org 1.1.4 (Linux)2005-09-18T14:10:532005-10-19T11:22:15en-US8PT1H47M45SPKJS3 settings.xmlZ[W8~_u(.9I'I_?i/XӚYli}{d_' xhD]a:0?Ne0V cn#*Rn6*4;d!3tNauﬧiVFXz3.w+)8[=0Rg{)Ye'y|EQ2X.fhPP&d<`Z\ 16|cg7^D~lk }eGgisގa\!Ҹ<8*q~ d*xh}ύ~=9O?*Os_!<_*}8> 0PXY|Q+O0.c(fDc!؂2F$qFm.y!h}߅3Ԃ|ЧCiL"WָRV,]N]rtI( Dp{cUiDT 1uY&fk/$Ҏ7ʪ{.K^&\~l+!Ҹ4?wzM:!%HdyE1CX60ދ{!A|oɎ7* o9jd7}DԉK"q^6J- "Vv$M "cQ"gLU\Q5hLZ7L-($L7|PJY\1r_*|{'1.@|Q7ނ,L-12&0)}t_^w˞N1J[\qUVdxsc'b߷Cq(g{Qd,9A="b*݂]C6aДA5=]m5+W7!OZ ˡ@܁~}&acn05wt0AgЛ3>RIy5c3T2E0:/9lM.r ^a~r%ԗVI]Qw7XsRyB0$R ֗iSy>@~qSKaJ&Y'w61| ^~bq43Bz{ L&e[+(]{s5 NP~ +C]}HZ6c v7BG51 z+ttI_\+݀$HBIWI GZ UXwiz 0 ԑבXqTP㉟J)*_ajɞUi׌`}_W I6)O1E2 ee.0/_RJ9:cdu}aΚGh Zu0=ohyCh4Ok6_ƽzSJoQF:/['W-+~Y=awd?:!/KHwPZ kp㻠Dqt@*Qt͸Tӣ޶c- P^=Ұ0o՞3-ŲΫ޼B4tjjbATէ D+4--Wbyj_M5y~ So^e5>ndJm[z5T=-E,n*'NxJDڬݫXxw9[2^b*k~XM-ᥨq 7ZvSiJT-پ2CPKOץ1)PKJS3META-INF/manifest.xmlұj0Onө;)ڃ3t49Ȓ!~BI_piq+kRX6S8+l7Osʟb/ʨ<(o;bmj?"fe&`#A$n fe‰٭m Yj Ԩ*Q sZ_4FRu'aj#W)|h}P5aȣӅ1dphĢQ_툫sko6k PKI\zPKJS3XmimetypePKJS3F1D *\ Econtent.xmlPKJS3 8 3 styles.xmlPKJS3*meta.xmlPKJS3Oץ1) settings.xmlPKJS3I\z META-INF/manifest.xmlPKZ "vcd/vignettes/residual-shadings.Rnw0000644000175100001440000003711312445055772017172 0ustar hornikusers\documentclass[nojss]{jss} %% need no \usepackage{Sweave} \usepackage{rotating} \newcommand{\given}{\, | \,} \title{Residual-Based Shadings in \pkg{vcd}} \Plaintitle{Residual-Based Shadings in vcd} \author{Achim Zeileis, David Meyer, \textnormal{and} Kurt Hornik\\Wirtschaftsuniversit\"at Wien, Austria} \Plainauthor{Achim Zeileis, David Meyer, Kurt Hornik} \Abstract{ This vignette is a companion paper to \cite{vcd:Zeileis+Meyer+Hornik:2007} which introduces several extensions to residual-based shadings for enhancing mosaic and association plots. The paper introduces (a)~perceptually uniform Hue-Chroma-Luminance (HCL) palettes and (b)~incorporates the result of an associated significance test into the shading. Here, we show how the examples can be easily reproduced using the \pkg{vcd} package. } \Keywords{association plots, conditional inference, contingency tables, HCL colors, HSV colors, mosaic plots} \Address{ Achim Zeileis\\ E-mail: \email{Achim.Zeileis@R-project.org}\\ David Meyer\\ E-mail: \email{David.Meyer@R-project.org}\\ Kurt Hornik\\ E-mail: \email{Kurt.Hornik@R-project.org}\\ } \begin{document} %\VignetteIndexEntry{Residual-Based Shadings in vcd} %\VignetteDepends{vcd,colorspace,MASS,grid,HSAUR,grid} %\VignetteKeywords{association plots, conditional inference, contingency tables, HCL colors, HSV colors, mosaic plots} %\VignettePackage{vcd} \SweaveOpts{engine=R,eps=FALSE} \section{Introduction} \label{sec:intro} In this vignette, we show how all empirical examples from \cite{vcd:Zeileis+Meyer+Hornik:2007} can be reproduced in \proglang{R}\citep[\mbox{\url{http://www.R-project.org/}}]{vcd:R:2006}, in particular using the package \pkg{vcd} \citep{vcd:Meyer+Zeileis+Hornik:2006}. Additionally, the pakcages \pkg{MASS} \citep[see][]{vcd:Venables+Ripley:2002}, \pkg{grid} \citep[see][]{vcd:Murrell:2002} and \pkg{colorspace} \citep{vcd:Ihaka:2004} are employed. All are automatically loaded together with \pkg{vcd}: <>= library("grid") library("vcd") rseed <- 1071 @ Furthermore, we define a \code{rseed} which will be used as the random seed for making the results of the permutation tests (conditional inference) below exactly reproducible. In the following, we focus on the \proglang{R} code and output---for background information on the methods and the data sets, please consult \cite{vcd:Zeileis+Meyer+Hornik:2007}. \section{Arthritis data} \label{sec:arthritis} First, we take a look at the association of treatment type and improvement in the \code{Arthritis} data. The data set can be loaded and brought into tabular form via: <>= data("Arthritis", package = "vcd") (art <- xtabs(~ Treatment + Improved, data = Arthritis, subset = Sex == "Female")) @ Two basic explorative views of such a 2-way table are mosaic plots and association plots. They can be generated via \code{mosaic()} and \code{assoc()} from \pkg{vcd}, respectively. For technical documentation of these functions, please see \cite{vcd:Meyer+Zeileis+Hornik:2006b}. When no further arguments are supplied as in <>= mosaic(art) assoc(art) @ this yields the plain plots without any color shading, see Figure~\ref{fig:classic}. Both indicate that there are more patients in the treatment group with marked improvement and less without improvement than would be expected under independence---and vice versa in the placebo group. \setkeys{Gin}{width=\textwidth} \begin{figure}[b!] \begin{center} <>= grid.newpage() pushViewport(viewport(layout = grid.layout(1, 2))) pushViewport(viewport(layout.pos.col=1, layout.pos.row=1)) mosaic(art, newpage = FALSE, margins = c(2.5, 4, 2.5, 3)) popViewport() pushViewport(viewport(layout.pos.col=2, layout.pos.row=1)) assoc(art, newpage = FALSE, margins = c(5, 2, 5, 4)) popViewport(2) @ \caption{Classic mosaic and association plot for the arthritis data.} \label{fig:classic} \end{center} \end{figure} For 2-way tables, \cite{vcd:Zeileis+Meyer+Hornik:2007} suggest to extend the shading of \cite{vcd:Friendly:1994} to also visualize the outcome of an independence test---either using the sum of squares of the Pearson residuals as the test statistic or their absolute maximum. Both statistics and their corresponding (approximate) permutation distribution can easily be computed using the function \code{coindep_test()}. Its arguments are a contingency table, a specification of margins used for conditioning (only for conditional independence models), a functional for aggregating the Pearson residuals (or alternatively the raw counts) and the number of permutations that should be drawn. The conditional table needs to be a 2-way table and the default is to compute the maximum statistic (absolute maximum of Pearson residuals). For the Arthritis data, both, the maximum test <>= set.seed(rseed) (art_max <- coindep_test(art, n = 5000)) @ and the sum-of-squares test, indicate a significant departure from independence. <>= ss <- function(x) sum(x^2) set.seed(rseed) coindep_test(art, n = 5000, indepfun = ss) @ Thus, it can be concluded that the treatment is effective and leads to significantly more improvement than the placebo. The classic views from Figure~\ref{fig:classic} and the inference above can also be combined, e.g., using the maximum shading that highlights the cells in an association or mosaic plot when the associated residuals exceed critical values of the maximum test (by default at levels 90\% and 99\%). To compare this shading (using either HSV or HCL colors) with the Friendly shading (using HSV colors), we generate all three versions of the mosaic plot: <>= mosaic(art, gp = shading_Friendly(lty = 1, eps = NULL)) mosaic(art, gp = shading_hsv, gp_args = list( interpolate = art_max$qdist(c(0.9, 0.99)), p.value = art_max$p.value)) set.seed(rseed) mosaic(art, gp = shading_max, gp_args = list(n = 5000)) @ the results are shown in the upper row of Figure~\ref{fig:shadings}. The last plot could hae also been generated analogously to the second plot using \code{shading_hcl()} instead of \code{shading_hsv()}---\code{shading_max()} is simply a wrapper function which performs the inference and then visualizes it based on HCL colors. \section{Piston rings data} \label{sec:arthritis} Instead of bringing out the result of the maximum test in the shading, we could also use a sum-of-squares shading that visualizes the result of the sum-of-squares test. As an illustration, we use the \code{pistonrings} data from the \code{HSAUR} \citep{vcd:Everitt+Hothorn:2006} package giving the number of piston ring failurs in different legs of different compressors at an industry plant: <>= data("pistonrings", package = "HSAUR") pistonrings @ \begin{sidewaysfigure}[p] \begin{center} <>= mymar <- c(1.5, 0.5, 0.5, 2.5) grid.newpage() pushViewport(viewport(layout = grid.layout(2, 3))) pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 1)) mosaic(art, margins = mymar, newpage = FALSE, gp = shading_Friendly(lty = 1, eps = NULL)) popViewport() pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 2)) mosaic(art, gp = shading_hsv, margins = mymar, newpage = FALSE, gp_args = list(interpolate = art_max$qdist(c(0.9, 0.99)), p.value = art_max$p.value)) popViewport() pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 3)) set.seed(rseed) mosaic(art, gp = shading_max, margins = mymar, newpage = FALSE, gp_args = list(n = 5000)) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 1)) mosaic(pistonrings, margins = mymar, newpage = FALSE, gp = shading_Friendly(lty = 1, eps = NULL, interpolate = c(1, 1.5))) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 2)) mosaic(pistonrings, gp = shading_hsv, margins = mymar, newpage = FALSE, gp_args = list(p.value = 0.069, interpolate = c(1, 1.5))) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 3)) mosaic(pistonrings, gp = shading_hcl, margins = mymar, newpage = FALSE, gp_args = list(p.value = 0.069, interpolate = c(1, 1.5))) popViewport(2) @ \includegraphics[width=.9\textwidth,keepaspectratio]{residual-shadings-shadings} \caption{Upper row: Mosaic plot for the arthritis data with Friendly shading (left), HSV maximum shading (middle), HCL maximum shading (right). Lower row: Mosaic plot for the piston rings data with fixed user-defined cut offs 1 and 1.5 and Friendly shading (left), HSV sum-of-squares shading (middle), HCL sum-of-squares shading (right).} \label{fig:shadings} \end{center} \end{sidewaysfigure} Although there seems to be some slight association between the leg (especially center and South) and the compressor (especially numbers 1 and 4), there is no significant deviation from independence: <>= set.seed(rseed) coindep_test(pistonrings, n = 5000) set.seed(rseed) (pring_ss <- coindep_test(pistonrings, n = 5000, indepfun = ss)) @ This can also be brought out graphically in a shaded mosaicplot by enhancing the Friendly shading (based on the user-defined cut-offs 1 and 1.5, here) to use a less colorful palette, either based on HSV or HCL colors: <>= mosaic(pistonrings, gp = shading_Friendly(lty = 1, eps = NULL, interpolate = c(1, 1.5))) mosaic(pistonrings, gp = shading_hsv, gp_args = list(p.value = pring_ss$p.value, interpolate = c(1, 1.5))) mosaic(pistonrings, gp = shading_hcl, gp_args = list(p.value = pring_ss$p.value, interpolate = c(1, 1.5))) @ The resulting plots can be found in the lower row of Figure~\ref{fig:shadings}. The default in \code{shading_hcl()} and \code{shading_hsv()} is to use the asymptotical $p$~value, hence we set it explicitely to the permtuation-based $p$~value computed above. \section{Alzheimer and smoking} \label{sec:alzheimer} For illustrating that the same ideas can be employed for visualizing (conditional) independence in multi-way tables, \cite{vcd:Zeileis+Meyer+Hornik:2007} use a 3-way and a 4-way table. The former is taken from a case-control study of smoking and {A}lzheimer's disease (stratified by gender). The data set is available in \proglang{R} in the package \pkg{coin} \cite{vcd:Hothorn+Hornik+VanDeWiel:2006}. <>= data("alzheimer", package = "coin") alz <- xtabs(~ smoking + disease + gender, data = alzheimer) alz @ \begin{figure}[b!] \begin{center} <>= set.seed(rseed) cotabplot(~ smoking + disease | gender, data = alz, panel = cotab_coindep, n = 5000) @ \caption{Conditional mosaic plot with double maximum shading for conditional independence of smoking and disease given gender.} \label{fig:alz} \end{center} \end{figure} To assess whether smoking behaviour and disease status are conditionally independent given gender, \cite{vcd:Zeileis+Meyer+Hornik:2007} use three different types of test statistics: double maximum (maximum of maximum statistics in the two strata), maximum sum of squares (maximum of sum-of-squares statistics), and sum of squares (sum of sum-of-squares statistics). All three can be computed and assessed via permutation methods using the function \code{coindep_test()}: <>= set.seed(rseed) coindep_test(alz, 3, n = 5000) set.seed(rseed) coindep_test(alz, 3, n = 5000, indepfun = ss) set.seed(rseed) coindep_test(alz, 3, n = 5000, indepfun = ss, aggfun = sum) @ The conditional mosaic plot in Figure~\ref{fig:alz} shows clearly that the association of smoking and disease is present only in the group of male patients. The double maximum shading employed allows for identification of the male heavy smokers as the cells `responsible' for the dependence: other dementias are more frequent and Alzheimer's disease less frequent in this group than expected under independence. Interestingly, there seems to be another large residual for the light smoker group ($<$10 cigarettes) and Alzheimer's disease---however, this is only significant at 10\% and not at the 1\% level as the other two cells. <>= <> @ \section{Corporal punishment of children} As a 4-way example, data from a study of the Gallup Institute in Denmark in 1979 about the attitude of a random sample of 1,456 persons towards corporal punishment of children is used. The contingency table comprises four margins: memory of punishments as a child (yes/no), attitude as a binary variable (approval of ``moderate'' punishment or ``no'' approval), highest level of education (elementary/secondary/high), and age group (15--24, 25--39, $\ge$40 years). <>= data("Punishment", package = "vcd") pun <- xtabs(Freq ~ memory + attitude + age + education, data = Punishment) ftable(pun, row.vars = c("age", "education", "memory")) @ It is of interest whether there is an association between memories of corporal punishments as a child and attitude towards punishment of children as an adult, controlling for age and education. All three test statistics already used above confirm that memories and attitude are conditionally associated: \setkeys{Gin}{width=\textwidth} \begin{figure}[t!] \begin{center} <>= set.seed(rseed) cotabplot(~ memory + attitude | age + education, data = pun, panel = cotab_coindep, n = 5000, type = "assoc", test = "maxchisq", interpolate = 1:2) @ \caption{Conditional association plot with maximum sum-of-squares shading for conditional independence of memory and attitude given age and education.} \label{fig:pun} \end{center} \end{figure} \setkeys{Gin}{width=\textwidth} \begin{figure}[t!] \begin{center} <>= set.seed(rseed) cotabplot(~ memory + attitude | age + education, data = pun, panel = cotab_coindep, n = 5000, type = "mosaic", test = "maxchisq", interpolate = 1:2) @ \caption{Conditional mosaic plot with maximum sum-of-squares shading for conditional independence of memory and attitude given age and education.} \label{fig:pun2} \end{center} \end{figure} <>= set.seed(rseed) coindep_test(pun, 3:4, n = 5000) set.seed(rseed) coindep_test(pun, 3:4, n = 5000, indepfun = ss) set.seed(rseed) coindep_test(pun, 3:4, n = 5000, indepfun = ss, aggfun = sum) @ Graphically, this dependence can be brought out using conditional association or mosaic plots as shown in Figure~\ref{fig:pun} and \ref{fig:pun2}, respectively. Both reveal an association between memories and attitude for the lowest education group (first column) and highest age group (last row): experienced violence seems to engender violence again as there are less adults that disapprove punishment in the group with memories of punishments than expected under independence. For the remaining four age-education groups, there seems to be no association: all residuals of the conditional independence model are very close to zero in these cells. The figures employ the maximum sum-of-squares shading with user-defined cut offs 1 and 2, chosen to be within the range of the residuals. The full-color palette is used only for those strata associated with a sum-of-squares statistic significant at (overall) 5\% level, the reduced-color palette is used otherwise. This highlights that the dependence pattern is significant only for the middle and high age group in the low education column. The other panels in the first column and last row also show a similar dependence pattern, however, it is not significant at 5\% level and hence graphically down-weighted by using reduced color. <>= <> @ <>= <> @ \bibliography{vcd} \end{document} vcd/vignettes/strucplot.Rnw0000644000175100001440000031176312445055727015631 0ustar hornikusers\documentclass[nojss]{jss} %% need no \usepackage{Sweave} %% omit thumbpdf at the moment due to problems on some systems %% \usepackage{thumbpdf} %% almost as usual \author{David Meyer, Achim Zeileis, \textnormal{and} Kurt Hornik\\Wirtschaftsuniversit\"at Wien, Austria} \title{The Strucplot Framework:\\ Visualizing Multi-way Contingency Tables with \pkg{vcd}} %% for pretty printing and a nice hypersummary also set: \Plainauthor{David Meyer, Achim Zeileis, Kurt Hornik} %% comma-separated \Shorttitle{The Strucplot Framework} %% a short title (if necessary) \Plaintitle{The Strucplot Framework: Visualizing Multi-way Contingency Tables with vcd} %% an abstract and keywords \Abstract{ This paper has been published in the Journal of Statistical Software \citep{vcd:Meyer+Zeileis+Hornik:2006b} and describes the ``strucplot'' framework for the visualization of multi-way contingency tables. Strucplot displays include hierarchical conditional plots such as mosaic, association, and sieve plots, and can be combined into more complex, specialized plots for visualizing conditional independence, GLMs, and the results of independence tests. The framework's modular design allows flexible customization of the plots' graphical appearance, including shading, labeling, spacing, and legend, by means of ``graphical appearance control'' functions. The framework is provided by the \proglang{R} package \pkg{vcd}. } \Keywords{contingency tables, mosaic plots, association plots, sieve plots, categorical data, independence, conditional independence, HSV, HCL, residual-based shading, \pkg{grid}, \proglang{R}} \Plainkeywords{contingency tables, mosaic plots, association plots, sieve plots, categorical data, independence, conditional independence, HSV, HCL, residual-based shading, grid, R} \Address{ David Meyer\\ E-mail: \email{David.Meyer@R-project.org}\\ Achim Zeileis\\ E-mail: \email{Achim.Zeileis@R-project.org}\\ Kurt Hornik\\ E-mail: \email{Kurt.Hornik@R-project.org}\\ } \SweaveOpts{engine=R,eps=TRUE,height=6,width=7,results=hide,fig=FALSE,echo=TRUE,eps=FALSE} \setkeys{Gin}{width=0.7\textwidth} %\VignetteIndexEntry{The Strucplot Framework: Visualizing Multi-way Contingency Tables with vcd} %\VignetteDepends{vcd,grid} %\VignetteKeywords{contingency tables, mosaic plots, association plots, sieve plots, categorical data, independence, conditional independence, HSV, HCL, residual-based shading, grid, R} %\VignettePackage{vcd} <>= set.seed(1071) library(grid) library(vcd) data(Titanic) data(HairEyeColor) data(PreSex) data(Arthritis) art <- xtabs(~Treatment + Improved, data = Arthritis) @ \newcommand{\var}[1]{\textit{\texttt{#1}}} \newcommand{\data}[1]{\texttt{#1}} \newcommand{\class}[1]{\textsf{#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()}} %% end of declarations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \begin{document} %% include your article here, just as usual %% Note that you should use the \pkg{}, \proglang{} and \code{} commands. \section[Introduction]{Introduction} %% Note: If there is markup in \(sub)section, then it has to be escape as above. In order to explain multi-dimensional categorical data, statisticians typically look for (conditional) independence structures. Whether the task is purely exploratory or model-based, techniques such as mosaic and association plots offer good support for visualization. Both visualize aspects of (possibly higher-dimensional) contingency tables, with several extensions introduced over the last two decades, and implementations available in many statistical environments. A \emph{mosaic plot} \citep{vcd:Hartigan+Kleiner:1984} is basically an area-proportional visualization of (typically, observed) frequencies, composed of tiles (corresponding to the cells) created by recursive vertical and horizontal splits of a rectangle. Thus, the area of each tile is proportional to the corresponding cell entry \emph{given} the dimensions of previous splits. An \emph{association plot} \citep{vcd:Cohen:1980} visualizes the standardized deviations of observed frequencies from those expected under a certain independence hypothesis. Each cell is represented by a rectangle that has (signed) height proportional to the residual and width proportional to the square root of the expected counts, so that the area of the box is proportional to the difference in observed and expected frequencies. Extensions to these techniques have mainly focused on the following aspects. \begin{enumerate} \item Varying the shape of bar plots and mosaic displays to yield, e.g., double-decker plots \citep{vcd:hofmann:2001}, spine plots, or spinograms \citep{vcd:hofmann+theus}. \item Using residual-based shadings to visualize log-linear models \citep{vcd:Friendly:1994,vcd:Friendly:2000} and significance of statistical tests \citep{vcd:Meyer+Zeileis+Hornik:2003,vcd:Zeileis+Meyer+Hornik:2007}. \item Using pairs plots and trellis-like layouts for marginal, conditional and partial views \citep{vcd:Friendly:1999}. \item Adding direct user interaction, allowing quick exploration and modification of the visualized models \citep{vcd:Unwin+Hawkins+Hofmann:1996,vcd:Theus:2003}. \item Providing a modular and flexible implementation to easily allow user extensions \citep{vcd:Meyer+Zeileis+Hornik:2003,vcd:Meyer+Zeileis+Hornik:2006b}. \end{enumerate} \noindent Current implementations of mosaic displays can be found, e.g., for \proglang{SAS} \citep{vcd:SAS:2005}, \pkg{ViSta} \citep{vcd:young:1996}, \pkg{MANET} \citep{vcd:Unwin+Hawkins+Hofmann:1996}, \pkg{Mondrian} \citep{vcd:Theus:2003}, \proglang{R} \citep{vcd:R:2006}, and \proglang{S-PLUS} \citep{vcd:SPLUS:2005}. For \proglang{R}, currently three implementations do exist in the packages \pkg{graphics} (in base \proglang{R}), \pkg{vcd} \citep{vcd:Meyer+Zeileis+Hornik:2006b}, and \pkg{iplots} \citep{vcd:urbanek+wichtrey:2006}, respectively. Table \ref{tab:compare} gives an overview of the available functionality in these systems. Most environments are available on Windows, MacOS, and Linux/Unix variants, except \pkg{MANET} which is only available for the Macinthosh platforms. \begin{table}[h] \centering \begin{tabular}{|l|c|c|c|c|c|c|c|c|c|} \hline & & &\multicolumn{3}{c|}{} & & &\\ & \proglang{SAS} & \proglang{S-PLUS} &\multicolumn{3}{c|}{\proglang{R}} & \pkg{ViSta} & \pkg{MANET} & \pkg{Mondrian}\\ & & &\pkg{base}&\pkg{vcd} &\pkg{iplots}& & &\\\hline Basic functionality & $\times$ & $\times$ & $\times$ &$\times$ &$\times$ & $\times$ & $\times$& $\times$\\ Shape & & & &$\times$ && $\times$ & $\times$&\\ Res.-based shadings & $\times$ & & $\times$ & $\times$ & ($\times$) & &($\times$)& ($\times$)\\ Highlighting & & & &$\times$ &$\times$ & $\times$ & $\times$& $\times$\\ Conditional views & $\times$ & & &$\times$ & & $\times$ & $\times$&\\ Interaction & & & & &$\times$ & $\times$ & $\times$& $\times$\\ Linking & & & & &$\times$ & $\times$ & $\times$& $\times$\\ Extensible design & & & &$\times$ & & & &\\ Language & \proglang{SAS} & \proglang{S} & \proglang{R} & \proglang{R} & \proglang{R}/\proglang{Java} & \proglang{XLisp} & \proglang{C++} & \proglang{Java}\\ \hline \end{tabular} \caption{Comparison of current software environments.} \label{tab:compare} \end{table} Figures \ref{fig:arthritis} to \ref{fig:titanic} illustrate some of these extensions. Figure~\ref{fig:arthritis} shows the results from a double-blind clinical trial investigating a new treatment for rheumatoid arthritis, using an extended mosaic plot with residual-based shading based on the maximum statistic: clearly, the new treatment is effective. The dark blue cell indicates that the rate of treated patients showing marked improvement is significant at the 1\% level. Figure \ref{fig:ucbadmissions} visualizes the well-known UCB admissions data by means of a conditional association plot. The panels show the residuals from a conditional independence model (independence of gender and admission, given department), stratified by department. Clearly, the situation in department A (more women/less men accepted than would be expected under the null hypothesis) causes the rejection of the hypothesis of conditional independence. Figure~\ref{fig:presex} illustrates the conditional independence of premarital and extramarital sex, given gender and marital status. The $\chi^2$ test of independence, based on the permutation distribution, rejects the null hypothesis: possibly, because the tendency of people to have extramarital sex when they had premarital sex is particularly marked among married people? The rate of such women and men ist significant at the 0.01 and 0.1 level, respectively. Finally, Figure~\ref{fig:titanic} visualizes the ``Survival on the Titanic'' data using a double-decker plot. Here, a binary response (survival of the disaster) is to be explained by other factors (class, gender, and age). The gray boxes represent the proportion of survived passengers in a particular stratum. The proportions of saved women and children are indeed higher than those of men, but they clearly decrease from the 1st to the 3rd class. In addition, the proportion of saved men in the 1st class is higher than in the others. \setkeys{Gin}{width=0.7\textwidth} \begin{figure}[p] \begin{center} <>= mosaic(art, gp = shading_max, split_vertical = TRUE) @ \caption{Mosaic plot for the \data{Arthritis} data.} \label{fig:arthritis} \end{center} \end{figure} \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= cotabplot(UCBAdmissions, panel = cotab_coindep, shade = TRUE, legend = FALSE, type = "assoc") @ \caption{Conditional association plot for the \data{UCBAdmissions} data.} \label{fig:ucbadmissions} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \begin{figure}[p] \begin{center} <>= presextest <- coindep_test(PreSex, margin = c(1,4), indepfun = function(x) sum(x^2), n = 5000) mosaic(PreSex, condvars = c(1, 4), shade = TRUE, gp_args = list(p.value = presextest$p.value)) @ \caption{Mosaic plot for the \data{PreSex} data.} \label{fig:presex} \end{center} \end{figure} \setkeys{Gin}{width=0.8\textwidth} \begin{figure}[p] \begin{center} <>= doubledecker(Survived ~ ., data = Titanic, labeling_args = list(set_varnames = c(Sex = "Gender"))) @ \caption{Double-decker plot for the \data{Titanic} data.} \label{fig:titanic} \end{center} \end{figure} This paper describes the strucplot framework provided by the \pkg{vcd} package for the \proglang{R} environment for statistical computing and graphics, available from the Comprehensive \proglang{R} Archive Network (\url{http://CRAN.R-project.org/}). The framework integrates displays such as mosaic, association, and sieve plots by their unifying property of being flat representations of contingency tables. These basic plots, as well as specialized displays for conditional independence, can be used both for exploratory visualization and model-based analysis. Exploratory techniques include specialized displays for the bivariate case, as well as pairs and trellis-type displays for higher-dimensional tables. Model-based tools include methods suitable for the visualization of conditional independence tests (including permutation tests), as well as for the visualization of particular GLMs (logistic regression, log-linear models). Additionally, two of the framework's further strengths are its flexibility and extensibility: graphical appearance aspects such as shading, labeling, and spacing are modularized by means of ``\underline{\vphantom{g}gr}aphical \underline{\vphantom{g}ap}pearance \underline{\vphantom{g}con}trol'' (\emph{grapcon}) functions, allowing fine-granular customization and user-level extensions. The remainder of the paper is organized as follows. In Section \ref{sec:strucplot}, we give an overview of the strucplot framework, describing the hierarchy of the main components and the basic functionality. In Section \ref{sec:shading}, we demonstrate how (residual-based) shadings support the visualization of log-linear models and the results of independence tests. Also, we explain step-by-step how the concepts of generating and grapcon functions can be combined to provide a flexible customization of complex graphical displays as created by the strucplot framework. Sections \ref{sec:labeling} and \ref{sec:spacing} discuss in detail the labeling and spacing features, respectively. Section \ref{sec:example} exemplifies the framework in the analysis of a four-way data set. Section \ref{sec:conclusion} concludes the work. \section[The strucplot framework]{The strucplot framework} \label{sec:strucplot} The strucplot framework in the \proglang{R} package \pkg{vcd}, used for visualizing multi-way contingency tables, integrates techniques such as mosaic displays, association plots, and sieve plots. The main idea is to visualize the tables' cells arranged in rectangular form. For multi-way tables, the variables are nested into rows and columns using recursive conditional splits, given the margins. The result is a ``flat'' representation that can be visualized in ways similar to a two-dimensional table. This principle defines a class of conditional displays which allows for granular control of graphical appearance aspects, including: \begin{itemize} \item the content of the tiles \item the split direction for each dimension \item the graphical parameters of the tiles' content \item the spacing between the tiles \item the labeling of the tiles \end{itemize} The strucplot framework is highly modularized: Figure~\ref{fig:struc} shows the hierarchical relationship between the various components. On the lowest level, there are several groups of workhorse and parameter functions that directly or indirectly influence the final appearance of the plot (see Table \ref{tab:grapcons} for an overview). These are examples of grapcon functions. They are created by generating functions (\emph{grapcon generators}), allowing flexible parameterization and extensibility (Figure~\ref{fig:struc} only shows the generators). The generator names follow the naming convention \code{\textit{group\_foo}()}, where \code{\textit{group}} reflects the group the generators belong to (strucplot core, labeling, legend, shading, or spacing). The workhorse functions (created by \code{struc\_\textit{foo}()}, \code{labeling\_\textit{foo}()}, and \code{legend\_\textit{foo}()}) directly produce graphical output (i.e., ``add ink to the canvas''), whereas the parameter functions (created by \code{spacing\_\textit{foo}()} and \code{shading\_\textit{foo}()}) compute graphical parameters used by the others. The grapcon functions returned by \code{struc\_\textit{foo}()} implement the core functionality, creating the tiles and their content. On the second level of the framework, a suitable combination of the low-level grapcon functions (or, alternatively, corresponding generating functions) is passed as ``hyperparameters'' to \codefun{strucplot}. This central function sets up the graphical layout using grid viewports (see Figure~\ref{fig:layout}), and coordinates the specified core, labeling, shading, and spacing functions to produce the plot. On the third level, we provide several convenience functions such as \codefun{mosaic}, \codefun{sieve}, \codefun{assoc}, and \codefun{doubledecker} which interface \codefun{strucplot} through sensible parameter defaults and support for model formulae. Finally, on the fourth level, there are ``related'' \pkg{vcd} functions (such as \codefun{cotabplot} and the \codefun{pairs} methods for table objects) arranging collections of plots of the strucplot framework into more complex displays (e.g., by means of panel functions). \begin{table} \begin{tabular}{|l|l|l|} \hline \textbf{Group} & \textbf{Grapcon generator} & \textbf{Description}\\\hline strucplot & \codefun{struc\_assoc} & core function for association plots\\ core & \codefun{struc\_mosaic} & core function for mosaic plots\\ & \codefun{struc\_sieve} & core function for sieve plots\\\hline\hline labeling & \codefun{labeling\_border} & border labels\\ & \codefun{labeling\_cboxed} & centered labels with boxes, all labels clipped,\\ && and on top and left border\\ & \codefun{labeling\_cells} & cell labels\\ & \codefun{labeling\_conditional} & border labels for conditioning variables\\ && and cell labels for conditioned variables\\ & \codefun{labeling\_doubledecker} & draws labels for doubledecker plot\\ & \codefun{labeling\_lboxed} & left-aligned labels with boxes\\ & \codefun{labeling\_left} & left-aligned border labels\\ & \codefun{labeling\_left2} & left-aligned border labels, all labels on top and left border\\ & \codefun{labeling\_list} & draws a list of labels under the plot\\\hline\hline shading & \codefun{shading\_binary} & visualizes the sign of the residuals\\ & \codefun{shading\_Friendly} & implements Friendly shading (based on HSV colors)\\ & \codefun{shading\_hcl} & shading based on HCL colors\\ & \codefun{shading\_hsv} & shading based on HSV colors\\ & \codefun{shading\_max} & shading visualizing the maximum test statistic\\ && (based on HCL colors)\\ & \codefun{shading\_sieve} & implements Friendly shading customized for sieve plots\\ && (based on HCL colors)\\\hline\hline spacing & \codefun{spacing\_conditional} & increasing spacing for conditioning variables,\\&& equal spacing for conditioned variables\\ & \codefun{spacing\_dimequal} & equal spacing for each dimension\\ & \codefun{spacing\_equal} & equal spacing for all dimensions\\ & \codefun{spacing\_highlighting} & increasing spacing, last dimension set to zero\\ & \codefun{spacing\_increase} & increasing spacing\\\hline\hline legend & \codefun{legend\_fixed} & creates a fixed number of bins (similar to \codefun{mosaicplot})\\ & \codefun{legend\_resbased} & suitable for an arbitrary number of bins\\&& (also for continuous shadings)\\\hline \end{tabular} \caption{Available grapcon generators in the strucplot framework} \label{tab:grapcons} \end{table} \begin{figure}[h] \begin{center} \includegraphics[width=0.8\textwidth]{struc} \caption{Components of the strucplot framework.} \label{fig:struc} \end{center} \end{figure} \setkeys{Gin}{width=0.6\textwidth} \begin{figure}[h] \begin{center} <>= pushViewport(vcd:::vcdViewport(legend = T, mar =4)) seekViewport("main") grid.rect(gp = gpar(lwd = 3)) grid.text("main", gp = gpar(fontsize = 20)) seekViewport("sub") grid.rect(gp = gpar(lwd = 3)) grid.text("sub", gp = gpar(fontsize = 20)) seekViewport("plot") grid.rect(gp = gpar(lwd = 3)) grid.text("plot", gp = gpar(fontsize = 20)) seekViewport("legend") grid.text("legend", rot = 90, gp = gpar(fontsize = 20)) grid.rect(gp = gpar(lwd = 3)) seekViewport("legend_sub") grid.rect(gp = gpar(lwd = 3)) grid.text("[F]", gp = gpar(fontsize = 20)) seekViewport("legend_top") grid.rect(gp = gpar(lwd = 3)) grid.text("[E]", gp = gpar(fontsize = 20)) seekViewport("margin_top") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_top", gp = gpar(fontsize = 20)) seekViewport("margin_bottom") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_bottom", gp = gpar(fontsize = 20)) seekViewport("margin_right") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_right", rot = 90, gp = gpar(fontsize = 20)) seekViewport("margin_left") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_left", rot = 90, gp = gpar(fontsize = 20)) seekViewport("corner_top_left") grid.rect(gp = gpar(lwd = 3)) grid.text("[A]", gp = gpar(fontsize = 20)) seekViewport("corner_top_right") grid.rect(gp = gpar(lwd = 3)) grid.text("[B]", gp = gpar(fontsize = 20)) seekViewport("corner_bottom_left") grid.rect(gp = gpar(lwd = 3)) grid.text("[C]", gp = gpar(fontsize = 20)) seekViewport("corner_bottom_right") grid.rect(gp = gpar(lwd = 3)) grid.text("[D]", gp = gpar(fontsize = 20)) @ \caption{Viewport layout for strucplot displays with their names. [A] = ``corner\_top\_left'', [B] = ``corner\_top\_right'', [C] = ``corner\_bottom\_left'', [D] = ``corner\_bottom\_right'', [E] = ``legend\_top'', [F] = ``legend\_sub''.} \label{fig:layout} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \subsection{Mosaic, association, and sieve plots} As an example, consider the \data{HairEyeColor} data containing two polytomous variables (hair and eye color), as well as one (artificial) dichotomous gender variable (\code{Sex}). The ``flattened'' contingency table can be obtained using the \codefun{structable} function (quite similar to \codefun{ftable} in base \proglang{R}, but allowing the specification of split directions): <>= (HEC <- structable(Eye ~ Sex + Hair, data = HairEyeColor)) @ Let us first visualize the contingency table by means of a mosaic plot. % \citep{vcd:Hartigan+Kleiner:1984} which is basically % an area-proportional visualization of (typically, observed) frequencies, composed % of tiles (corresponding to the cells) created by recursive % vertical and horizontal splits of a square. Thus, the area of each tile % is proportional to the corresponding cell entry \emph{given} the % dimensions of previous splits. The effect of <>= mosaic(HEC) @ \noindent equivalent to <>= mosaic(~ Sex + Eye + Hair, data = HairEyeColor) @ %\setkeys{Gin}{width=0.75\textwidth} \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{HairEyeColor} data.} \label{fig:observed} \end{center} \end{figure} \noindent depicts the observed frequencies of the \code{HairEyeColor} data. If there are zero entries, tiles have zero area and are, additionally, marked by small bullets (see, e.g, Figure~\ref{fig:titanic}). By default, these cells are not split further. The bullets help distinguishing very small cells from zero entries, and are particularly useful when color shadings come into play (see the example using the \data{Bundesliga} data in Section \ref{sec:overview}). Note that in contrast to, e.g., \codefun{mosaicplot} in base \proglang{R}, the default split direction and level ordering in all strucplot displays correspond to the textual representation produced by the print methods. It is also possible to visualize the expected values instead of the observed values (see Figure~\ref{fig:expected}): <>= mosaic(HEC, type = "expected") @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{HairEyeColor} data (expected values).} \label{fig:expected} \end{center} \end{figure} %\setkeys{Gin}{width=0.7\textwidth} \noindent In order to compare observed and expected values, a sieve plot \citep{vcd:riedwyl+schuepbach:1994} could be used (see Figure~\ref{fig:sieve}): <>= sieve(~ Sex + Eye + Hair, data = HEC, spacing = spacing_dimequal(c(2,0,0))) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{Sieve plot for the \data{HairEyeColor} data visualizing simultaneously observed and expected values.} \label{fig:sieve} \end{center} \end{figure} \noindent where \code{spacing\_dimequal} is used to set the spacing of the second and third dimension to zero. Alternatively, we can directly inspect the residuals. The Pearson residuals (standardized deviations of observed from expected values) are conveniently visualized using association plots \citep{vcd:Cohen:1980}. In contrast to \codefun{assocplot} in base \proglang{R}, \pkg{vcd}'s \codefun{assoc} function scales to more than two variables (see Figure~\ref{fig:residuals}): <>= assoc(HEC, compress = FALSE) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Association plot for the \data{HairEyeColor} data.} \label{fig:residuals} \end{center} \end{figure} \noindent where the \code{compress} argument keeps distances between tiles equal. For both mosaic plots and association plots, the splitting of the tiles can be controlled using the \code{split\_vertical} argument. The default is to alternate splits starting with a horizontal one (see Figure~\ref{fig:split}): <>= options(width=60) @ <>= mosaic(HEC, split_vertical = c(TRUE, FALSE, TRUE), labeling_args = list(abbreviate_labs = c(Eye = 3))) @ <>= options(width=70) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{HairEyeColor} data---alternative splitting.} \label{fig:split} \end{center} \end{figure} \noindent (Note that \code{HEC}, a \class{structable} object, already includes a splitting information which simply gets overloaded in this example.) For compatibility with \codefun{mosaicplot} in base \proglang{R}, the \codefun{mosaic} function also allows the use of a \code{direction} argument taking a vector of \code{"h"} and \code{"v"} characters: <>= mosaic(HEC, direction = c("v","h","v")) @ By a suitable combination of splitting, spacing, and labeling settings, the functions provided by the strucplot framework can be customized in a quite flexible way. For example, the default method for \codefun{doubledecker} is simply a wrapper for \codefun{strucplot}, setting the right defaults. Most default settings such as colors, spacing, and labeling are specified via the parameters and passed through to \codefun{strucplot}. The additional code just handles the dependent variable information, and in particular permutes the table to have the dependent variable as the last dimension as required for the doubledecker plot. Figure~\ref{fig:titanic} shows a doubledecker plot of the \data{Titanic} data, explaining the probability of survival (``survived'') by age, given sex, given class. It is created by: <>= doubledecker(Titanic) @ \noindent equivalent to: <>= doubledecker(Survived ~ Class + Sex + Age, data = Titanic) @ \subsection{Conditional and partial views} So far, we have visualized either full or collapsed tables, as suggested by the analysis task at hand. Subtables can be selected in a similar way as for objects of class \class{table} using indexing. Note, however, that subsetting of \class{structable} objects is more restrictive because of their inherent conditional structure. Since the variables on both the row and the columns side are nested, subsetting is only possible ``outside-in'', that is, indexing operates on blocks defined by the variable levels. In the following, we use the Titanic data again, this time collapsed over \code{Survived} to investigate the structure of crew and passengers (and having the \code{Child} and \code{Age} labels of the \code{Age} variable swapped for optical clarity): <>= options(width=75) @ <>= (STD <- structable(~ Sex + Class + Age, data = Titanic[,,2:1,])) STD["Male",] STD["Male", c("1st","2nd","3rd")] @ <>= options(width=70) @ \noindent \emph{Conditioning} on levels (i.e., choosing a table subset for fixed levels of the conditioning variable(s)) is done using the \code{[[} operator. %]] Here again, the sequence of conditioning levels is restricted by the hierarchical structure of the \class{structable} object. In the following examples, note that compared to subsetting, the first dimension(s) are dropped: <>= STD[["Male",]] STD[[c("Male", "Adult"),]] STD[["Male","1st"]] @ \noindent Now, there are several ways for visualizing conditional independence structures. The ``brute force'' method is to draw separate plots for the strata. The following example compares the association between hair and eye color, given gender, by using subsetting on the flat table and \pkg{grid}'s viewport framework to visualize the two groups besides each other: <>= pushViewport(viewport(layout = grid.layout(ncol = 2))) @ <>= pushViewport(viewport(layout.pos.col = 1)) mosaic(STD[["Male"]], margins = c(left = 2.5, top = 2.5, 0), sub = "Male", newpage = FALSE) popViewport() @ <>= pushViewport(viewport(layout.pos.col = 2)) mosaic(STD[["Female"]], margins = c(top = 2.5, 0), sub = "Female", newpage = FALSE) popViewport(2) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= <> <> <> @ \caption{Two mosaic displays put side-by-side, visualizing the distribution of class and age, given gender. The marginal distribution of gender cannot be seen.} \label{fig:parttable} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \noindent Note the use of the \code{margins} argument: it takes a vector with up to four values whose unnamed components are recycled, but ``overruled'' by the named arguments. Thus, in the second example, only the top margin is set to 2.5 lines, and all other to 0. This idea applies to almost all vectorized arguments in the strucplot framework (with \code{split\_vertical} as a prominent exception). The \codefun{cotabplot} function does a much better job on this task: it arranges stratified strucplot displays in a lattice-like layout, conditioning on variable \emph{levels}. The plot in Figure~\ref{fig:cotabplot} shows class and age group, given sex: <>= cotabplot(~ Class + Age | Sex, data = STD, split_vertical = TRUE) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= <> @ \caption{Conditional table plot for the \data{Titanic} data, again visualizing the distribution of age and class, given gender, using separate mosaic displays like the ``manual'' plot in Figure~\ref{fig:parttable}.} \label{fig:cotabplot} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} %\noindent The \code{labeling\_args} argument modifies the labels' %appearance: here, to be left-aligned and unclipped %(see Section \ref{sec:labeling}). \noindent Visualizing the strata separately ``hides'' the distribution of the conditioning variable(s) which may or may not be appropriate or sensible in a particular analysis step. If we wish to keep the information on the marginal distribution(s), we can use one single mosaic for the stratified plot since mosaic displays are ``conditional plots'' by definition. We just need to make sure that conditioning variables are used first for splitting. Both the default and the formula interface of \codefun{mosaic} allow the specification of conditioning variables (see Figure~\ref{fig:conditioning}): <>= mosaic(STD, condvars = "Sex", split_vertical = c(TRUE, TRUE, FALSE)) @ <>= mosaic(~ Class + Age | Sex, data = STD, split_vertical = c(TRUE, TRUE, FALSE)) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[h] \begin{center} <>= <> @ \caption{Mosaic plot again visualizing the distribution of class and age, given gender, this time using a single mosaic plot. In contrast to Figures~\ref{fig:parttable} and \ref{fig:cotabplot}, this plot also visualizes the marginal distribution of gender.} \label{fig:conditioning} \end{center} \end{figure} \setkeys{Gin}{width=0.7} \noindent The effect of using this is that conditioning variables are permuted ahead of the the conditioned variables in the table, and that \codefun{spacing\_conditional} is used as default to better distinguish conditioning from conditioned dimensions. This spacing uses equal space between tiles of conditioned variables, and increasing space between tiles of conditioning variables (See Section~\ref{sec:spacing}). Another set of high-level functions for visualizing conditional independence models are the \codefun{pairs} methods for \class{table} and \class{structable} objects. In contrast to \codefun{cotabplot} which conditions on variables, the \codefun{pairs} methods create pairwise views of the table. They produce, by default, a plot matrix having strucplot displays in the off-diagonal panels, and the variable names (optionally, with univariate displays) in the diagonal cells. Figure~\ref{fig:pairs} shows a pairs display for the \data{Titanic} data with univariate mosaics in the diagonal, and mosaic plots visualizing the corresponding bivariate mosaics in the upper and lower triangles. Due to the inherent asymmetry of mosaic displays, the corresponding plots in the upper and lower triangle differ depending on which variable is used first for splitting---inspecting both views might help detecting patterns in a data set. Additionally, we are using a special spacing and shading normally used to `highlight' %' the second variable in the first (as will be discussed in Section \ref{sec:spacing}): here, the intention of the spacing is to emphasize the conditional distributions of the second variable, given the first one, and the shading helps identifying the factor levels in the second variable. <>= pairs(STD, highlighting = 2, diag_panel = pairs_diagonal_mosaic, diag_panel_args = list(fill = grey.colors)) @ %\setkeys{Gin}{width=\textwidth} \setkeys{Gin}{width=0.7\textwidth} \begin{figure}[h] \begin{center} <>= <> @ \caption{Pairs plot for the \data{Titanic} data.} \label{fig:pairs} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \noindent The labels of the variables are to be read from left to right and from top to bottom. In addition, the levels can be matched by position within the columns and by shading within the rows. In plots produced by \codefun{pairs}, each panel's row and column define two variables $X$ and $Y$ used for the specification of four different types of independence: pairwise, total, conditional, and joint. The pairwise mosaic matrix shows bivariate marginal relations between $X$ and $Y$, collapsed over all other variables. The total independence mosaic matrix shows mosaic plots for mutual independence, i.e., for marginal and conditional independence among all pairs of variables. The conditional independence mosaic matrix shows mosaic plots for marginal independence of $X$ and $Y$, given all other variables. The joint independence mosaic matrix shows mosaic plots for joint independence of all pairs ($X$, $Y$) of variables from the others. Upper and lower parts can independently be used to display different types of independence models, or different strucplot displays (mosaic, association, or sieve plots). The available panel functions (\codefun{pairs\_assoc}, \codefun{pairs\_mosaic}, and \codefun{pairs\_sieve}) are simple wrappers to \codefun{assoc}, \codefun{mosaic}, and \codefun{sieve}, respectively. Obviously, seeing patterns in strucplot matrices becomes increasingly difficult with higher dimensionality. Therefore, this plot is typically used with a suitable residual-based shading (see Section \ref{sec:shading}). \subsection{Interactive plot modifications} All strucplot core functions are supposed to produce conditional hierarchical plots by the means of nested viewports, corresponding to the provided splitting information. Thus, at the end of the plotting, each tile is associated with a particular viewport. Each of those viewports has to be conventionally named, enabling other strucplot modules, in particular the labeling functions, to access specific tiles after they have been plotted. The naming convention for the viewports is: \begin{center} \code{\emph{[Optional prefix]}cell:\emph{Variable1}=\emph{Level1},\emph{Variable2}=\emph{Level2}} \dots \end{center} \noindent Clearly, these names depend on the splitting. The following example shows how to access parts of the plot after it has been drawn (see Figure~\ref{fig:afterplot}): <>= mosaic(~ Hair + Eye, data = HEC, pop = FALSE) seekViewport("cell:Hair=Blond") grid.rect(gp = gpar(col = "red", lwd = 4)) seekViewport("cell:Hair=Blond,Eye=Blue") grid.circle(r = 0.2, gp = gpar(fill = "cyan")) @ \noindent Note that the viewport tree is removed by default. Therefore, the \texttt{pop} argument has to be set to \texttt{FALSE} when viewports shall be accessed. \setkeys{Gin}{width=0.6\textwidth} \begin{figure}[h] \begin{center} <>= <> @ \caption{Adding elements to a mosaic plot after drawing.} \label{fig:afterplot} \end{center} \end{figure} In addition to the viewports, the main graphical elements get names following a similar construction method. This allows to change graphical parameters of plot elements \emph{after} the plotting (see Figure~\ref{fig:changeplot}): <>= assoc(Eye ~ Hair, data = HEC, pop = FALSE) getNames()[1:6] grid.edit("rect:Hair=Blond,Eye=Blue", gp = gpar(fill = "red")) @ %% code-chunk reuse does not work with parameter changing \begin{figure}[h] \begin{center} <>= x <- tab <- margin.table(HairEyeColor, 1:2) x[] <- "light gray" x["Blond","Blue"] <- "Red" assoc(tab, gp = gpar(fill = x)) @ \caption{Changing graphical parameters of elements after drawing.} \label{fig:changeplot} \end{center} \end{figure} \subsection{Performance issues} \label{sec:performance} As stated above, the implementation of strucplot displays is based on creating and nesting \pkg{grid} viewports. The main time-consuming steps performed by the core functions are the following: \begin{enumerate} \item recursively, split the table until the individual cells are reached \item during the splits, add viewports to the plot \item for the individual cells, add plot-specific content (rectangles for mosaics, bars for association plots, etc.) \end{enumerate} \noindent All these operations scale linearly with the amount of created viewports. For a $d$-dimensional table with $k_i$ levels, $i=1 \dots d$, the total number of needed viewports $T_d$ can roughly be estimated as \begin{equation} \label{eq:numbervp} T_d \quad = \quad k_1 + k_1k_2 + \cdots + k_1 \cdots k_d \quad =\quad \sum_{i=1}^d \prod_{j \le i} k_j \end{equation} \noindent since we first push the $k_1$ viewports for the levels of the first dimension, then, for \emph{each} of these, the $k_2$ levels of the second dimension, etc. If the number of levels is equal ($k$) for all dimensions, $T_d$ simplifies to \begin{equation} \label{eq:equalvp} T_d \quad = \quad \sum_{i=1}^d k^i = \frac{k(k^d-1)}{k-1} \end{equation} \noindent and so the time complexity for drawing a strucplot display is of order $k^d$. \section{Shadings} \label{sec:shading} Unlike other graphics functions in base \proglang{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 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:shadingcustom}). We provide several shading functions, including support for both HSV and HCL colors, and the visualization of significance tests (see Section \ref{sec:overview}). \subsection{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 <- 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} <>= <> @ \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 (transparent). 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}): <>= mosaic(Titanic, gp = gpar(fill = c("gray","dark magenta")), spacing = spacing_highlighting, labeling_args = list(abbreviate_labs = 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 Section \ref{sec:labeling}). \begin{figure}[h] \begin{center} <>= <> @ \caption{Recycling of parameters, used for highlighting the survived passengers in the \data{Titanic} data.} \label{fig:recycling} \end{center} \end{figure} \subsection{Customizing residual-based shadings} \label{sec:shadingcustom} 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 frequencies 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 \citep{vcd:Meyer+Zeileis+Hornik:2003,vcd:Zeileis+Meyer+Hornik:2007}, even allows to identify the 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 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 \code{royalblue4} color for positive and \code{mediumorchid4} color for negative residuals (see Figure~\ref{fig:binary}): <>= expected <- independence_table(ucb) (x <- (ucb - expected) / sqrt(expected)) (shading1_obj <- ifelse(x > 0, "royalblue4", "mediumorchid4")) mosaic(ucb, gp = gpar(fill = shading1_obj)) @ \begin{figure}[h] \begin{center} <>= <> @ \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_fun <- function(x) gpar(fill = ifelse(x > 0, "royalblue4", "mediumorchid4")) @ \noindent To create a mosaic display with binary shading, it now suffices to specify the data table along with \codefun{shading2\_fun}: <>= 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("royalblue4", "mediumorchid4")} 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 \proglang{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: <>= shading3a_fun <- function(col = c("royalblue4", "mediumorchid4")) { col <- rep(col, length.out = 2) function(x) gpar(fill = ifelse(x > 0, col[1], col[2])) } @ \noindent The first statement just makes sure that exactly two colors are specified. In the call to \codefun{mosaic}, using the new \codefun{shading3a\_fun} function, we can now simply change the colors: <>= mosaic(ucb, gp = shading3a_fun(c("royalblue4","mediumorchid4"))) @ \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): <>= shading3b_fun <- function(observed = NULL, residuals = NULL, expected = NULL, df = NULL, col = c("royalblue4", "mediumorchid4")) { col <- rep(col, length.out = 2) function(x) gpar(fill = ifelse(x > 0, col[1], col[2])) } class(shading3b_fun) <- "grapcon_generator" @ Note that in this simple binary shading example, the first four parameters are not used. 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: <>= 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. \subsection[An overview of the shading functions in vcd]{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 HSV space, and then briefly explain the differences to HCL space \citep[a detailed discussion can be found in][]{vcd:Zeileis+Meyer+Hornik:2007}. Color palettes in HCL space are preferable to palettes derived from HSV space from a perceptual point of view. Functions for creating palettes (see, e.g., \codefun{diverge\_hcl}) are provided with the \pkg{vcd} package. In 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}, top): <>= haireye <- margin.table(HairEyeColor, 1:2) mosaic(haireye, gp = shading_hsv) @ \noindent As introduced before, the default shading scheme is not \codefun{shading\_hsv} but \codefun{shading\_hcl} due to the better perceptual characteristics of HCL color space. The following example again illustrates the \data{HairEyeColor} data, this time with HCL colors: <>= mosaic(haireye, gp = shading_hcl) @ <>= mosaic(haireye, gp = shading_hcl, gp_args = list(h = c(130, 43), c = 100, l = c(90, 70))) @ \noindent In Figure~\ref{fig:haireye}, the plot in the middle depicts the default palette, and the bottom plot an alternative setting for Hue (\code{h}), Chroma (\code{c}), and Luminance (\code{l}). \setkeys{Gin}{width=0.5\textwidth} \begin{figure}[htbp] \begin{center} <>= mosaic(haireye, gp = shading_hsv, margin = c(bottom = 1), keep_aspect_ratio = FALSE) @ <>= mosaic(haireye, gp = shading_hcl, margin = c(bottom = 1), keep_aspect_ratio = FALSE) @ <>= mosaic(haireye, gp = shading_hcl, margin = c(bottom = 1), gp_args = list(h = c(130, 43), c = 100, l = c(90, 70)), keep_aspect_ratio = FALSE) @ \caption{Three mosaic plots for the \data{HairEyeColor} data using different color palettes. Top: default HSV color palette. Middle: default HCL color palette. Bottom: a custom HCL color palette.} \label{fig:haireye} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \noindent Large positive residuals (greater than $4$) can be found for brown eyes/black hair and blue eyes/blond hair, and are colored in deep 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 (gray for HCL-shading). 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:interpolatecontinuous}): <>= mosaic(haireye, shade = TRUE, gp_args = list(interpolate = 1:4)) @ \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: <>= 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:interpolatecontinuous}, right) is deceiving: <>= mosaic(haireye, shade = TRUE, gp_args = list(interpolate = ipol), labeling_args = list(abbreviate_labs = c(Sex = TRUE))) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[htbp] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2))) pushViewport(viewport(layout.pos.col = 1)) mosaic(haireye, gp_args = list(interpolate = 1:4), margin = c(right = 1), keep_aspect_ratio= FALSE,newpage = FALSE,legend_width=5.5,shade = TRUE) popViewport(1) pushViewport(viewport(layout.pos.col = 2)) mosaic(haireye, gp_args = list(interpolate = ipol), margin = c(left=3,right = 1), keep_aspect_ratio = FALSE, newpage = FALSE, shade = TRUE) popViewport(2) @ \caption{\label{fig:interpolatecontinuous}The \data{HairEyeColor} data. Left: shading with 4 cut-off points. Right: continuous shading.} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \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}, left): <>= BL <- xtabs(~ HomeGoals + AwayGoals, data = Bundesliga, subset = Year == 1995) mosaic(BL, shade = TRUE) @ \noindent Note that in extended mosaic plots, bullets drawn for zero cells are shaded, too, bringing out non-zero residuals, if any. 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:bundesliga}, right): <>= mosaic(BL, gp = shading_Friendly, legend = legend_fixed, zero_size = 0) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[htbp] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2))) pushViewport(viewport(layout.pos.col = 1)) mosaic(BL, margin = c(right = 1), keep_aspect_ratio= FALSE, newpage = FALSE, legend_width=5.5, shade = TRUE) popViewport(1) pushViewport(viewport(layout.pos.col = 2)) mosaic(BL, gp = shading_Friendly, legend = legend_fixed, zero_size = 0, margin = c(right = 1), keep_aspect_ratio= FALSE, newpage = FALSE, legend_width=5.5) popViewport(2) @ \caption{The \data{Bundesliga} data for 1995. Left: Non-significant $\chi^2$ test. Right: using the Friendly shading and a legend with fixed bins.} \label{fig:bundesliga} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \noindent (The \code{zero\_size = 0} argument removes the bullets indicating zero observed values. This feature is not provided in the original \proglang{SAS} implementation of the Friendly mosaic plots.) % Figure~\ref{fig:shadingHSVHCL} depicts % HSV space in the upper panel and 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 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 HSV space all dimensions are confounded, which % obviously is problematic for coding information. In contrast, 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. % <>= % 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} % <>= % ## 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.4, 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) % @ % <>= % ## 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} 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,vcd:Zeileis+Meyer+Hornik:2007}. 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}): <>= set.seed(4711) mosaic(~ Treatment + Improved, data = Arthritis, subset = Sex == "Female", gp = shading_max) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{The \data{Arthritis} data (female patients) with significant maximum test.} \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. \clearpage \section[Labeling]{Labeling} \label{sec:labeling} One of the major enhancements in package \pkg{vcd} compared to \codefun{mosaicplot} and \codefun{assocplot} in base \proglang{R} is the labeling in the strucplot framework which offers more features and greater flexibility. Like shading, spacing, and drawing of legend and core plot, labeling is now carried out by grapcon functions, rendering labeling completely modular. The user supplies either a labeling function, or, alternatively, a generating function that parameterizes a labeling function, to \codefun{strucplot} which then draws the labels. Labeling is well-separated from the actual plotting that occurs in the low-level core functions. It only relies on the viewport tree produced by them, and the \code{dimnames} attribute of the visualized table. Labeling functions are grapcons that ``add ink to the canvas'': the drawing of the labels happens after the actual plot has been drawn by the core function. Thus, it is possible to supply one's own labeling function, or to combine some of the basic functions to produce a more complex labeling. In the following, we describe the three basic modules (\codefun{labeling\_text}, \codefun{labeling\_list}, and \codefun{labeling\_cells}) and derived functions that build upon them. \subsection[Labels in the borders]{Labels in the borders: \texttt{labeling\_text()}} \codefun{labeling\_text} is the default for all strucplot displays. It plots labels in the borders similar to the \codefun{mosaicplot} function in base \proglang{R}, but is much more flexible: it is not limited to 4 dimensions, and the positioning and graphical parameters of levels and variable names are customizable. In addition, the problem of overlapping labels can be handled in several ways. As an example, again consider the \data{Titanic} data: by default, the variable names and levels are plotted ``around'' the plot in a counter-clockwise way (see Figure~\ref{fig:labels1}, top left): <>= mosaic(Titanic) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{Mosaic plot for the \data{Titanic} data with default settings % for labeling.} % \label{fig:defaults} % \end{center} % \end{figure} \noindent Note that the last two levels of the \code{survived} variable do overlap, as well as some adult and child labels of the \code{age} Variable. This issue can be addressed in several ways. The ``brute force'' method is to enable clipping for these dimensions (see Figure~\ref{fig:labels1}, top right): <>= mosaic(Titanic, labeling_args = list(clip = c(Survived = TRUE, Age = TRUE))) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{The effect of clipping.} % \label{fig:clipping} % \end{center} % \end{figure} \noindent The \code{clip} parameter is passed to the labeling function via the \code{labeling\_args} argument which takes a list of parameters. \code{clip} itself takes a vector of logicals (one for each dimension). % as mentioned before Almost all vectorized arguments in the strucplot framework can be abbreviated in the following way: unnamed components (or the defaults, if there are none) are recycled as needed, but overridden by the named components. Here, the default is \code{FALSE}, and therefore clipping is enabled only for the \code{survived} and \code{age} variables. A more sensible solution to the overlap problem is to abbreviate the levels (see Figure~\ref{fig:labels1}, middle left): <>= mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = TRUE, Age = 3))) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Abbreviating.} % \label{fig:abbreviating} % \end{center} % \end{figure} \noindent The \code{abbreviate} argument takes a vector of integers indicating the number of significant characters the levels should be abbreviated to (\code{TRUE} is interpreted as 1, obviously). Abbreviation is performed using the \codefun{abbreviate} function in base \proglang{R}. Another possibility is to rotate the levels (see Figure~\ref{fig:labels1}, bottom): <>= mosaic(Titanic, labeling_args = list(rot_labels = c(bottom = 90, right = 0), offset_varnames = c(right = 1), offset_labels = c(right = 0.3)), margins = c(right = 4, bottom = 3)) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{Rotating labels.} % \label{fig:rotating} % \end{center} % \end{figure} \noindent Finally, we could also inhibit the output of repeated levels (see Figure~\ref{fig:labels1}, middle right): <>= mosaic(Titanic, labeling_args = list(rep = c(Survived = FALSE, Age = FALSE))) @ \setkeys{Gin}{width=0.9\textwidth} \begin{figure}[p] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2,nrow=3))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(Titanic, newpage = FALSE, keep = TRUE, margin = c(right = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(Titanic, labeling_args = list(clip = c(Survived = TRUE, Age = TRUE)), newpage = FALSE, keep = TRUE, margin = c(left = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = TRUE, Age = 2)), newpage = FALSE, keep = TRUE, margin = c(right = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(rep = c(Survived = FALSE, Age = FALSE)), newpage = FALSE, keep = TRUE, margin = c(left = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 1:2, layout.pos.row = 3)) pushViewport(viewport(width = 0.55)) mosaic(Titanic, labeling_args = list(rot_labels = c(bottom = 90, right = 0), offset_varnames = c(right = 1), offset_labels = c(right = 0.3)), margins = c(right = 4, bottom = 3), newpage = FALSE, keep = FALSE, gp_labels = gpar(fontsize = 10)) popViewport(3) @ \caption{Examples for possible labeling strategies for the Titanic data mosaic. Top left: default labeling (many labels overlap). Top right: with clipping turned on. Middle left: \texttt{Age} and \texttt{Survived} labels abbreviated. Middle right: \texttt{Age} labels not repeated. Bottom: \texttt{Age} and \texttt{Survived} labels rotated.} \label{fig:labels1} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} We now proceed with a few more ``cosmetic'' features (which do not all produce satisfactory results for our sample data). A first simple, but effectful modification is to position all labels and variables left-aligned (see Figure~\ref{fig:labels2}, top left): <>= mosaic(Titanic, labeling_args = list(pos_varnames = "left", pos_labels = "left", just_labels = "left", rep = FALSE)) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Left-aligning.} % \label{fig:left} % \end{center} % \end{figure} \noindent Note that obviously we need to change the justification to \code{"left"} as well. We can achieve the same effect by using the convenience function \codefun{labeling\_left}: <>= mosaic(Titanic, labeling = labeling_left) @ \noindent Next, we show how to put all levels to the bottom and right margins, and all variable names to the top and left margins (see Figure~\ref{fig:labels2}, top right): <>= mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, abbreviate_labs = c(Survived = 1, Age = 3))) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{Changes in the margins.} % \label{fig:margins} % \end{center} % \end{figure} \noindent The tl\_\var{foo} (``top left'') arguments are \code{TRUE} by default. Now, we will add boxes to the labels and additionally enable clipping (see Figure~\ref{fig:labels2}, bottom left): <>= mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, boxes = TRUE, clip = TRUE)) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{Boxes and Clipping.} % \label{fig:boxes} % \end{center} % \end{figure} \noindent The values to \code{boxes} and \code{clip} are recycled for all dimensions. The result is pretty close to what calling \codefun{mosaic} with the \codefun{labeling\_cboxed} wrapper does, except that variables and levels, by default, are put to the top and to the left of the plot: <>= mosaic(Titanic, labeling = labeling_cboxed) @ \noindent Another variant is to put the variable names into the same line as the levels (see Figure~\ref{fig:labels2}, bottom right---clipping for \code{Survived} and \code{Age} is, additionally, disabled, and \code{Age} abbreviated): <>= mosaic(Titanic, labeling_args = list(tl_labels = TRUE, boxes = TRUE, clip = c(Survived = FALSE, Age = FALSE, TRUE), abbreviate_labs = c(Age = 4), labbl_varnames = TRUE), margins = c(left = 4, right = 1, 3)) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Variable names beneath levels, and clipping disabled for the % survival variable.} % \label{fig:labbl} % \end{center} % \end{figure} \noindent \code{labbl\_varnames} (``variable names to the bottom/left of the labels'') is a vector of logicals indicating the side for the variable names. The resulting layout is close to what \codefun{labeling\_lboxed} produces, except that variables and levels, by default, are left-aligned and put to the bottom and to the right of the plot: <>= mosaic(Titanic, labeling = labeling_lboxed, margins = c(right = 4, left = 1, 3)) @ \noindent A similar design is used by the \codefun{doubledecker} function. \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2, nrow = 2))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(Titanic, labeling_args = list(pos_varnames = "left", pos_labels = "left", just_labels = "left", rep = FALSE), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 12)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, abbreviate_labs = c(Survived = 1, Age = 3)), newpage = FALSE, keep = TRUE, margins = c(left = 4, right = 1, 3), gp_labels = gpar(fontsize = 12)) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, boxes = TRUE, clip = TRUE), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 12)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(tl_labels = TRUE, boxes = TRUE, clip = c(Survived = FALSE, Age = FALSE, TRUE), labbl_varnames = TRUE, abbreviate_labs = c(Age = 4)), margins = c(left = 4, right = 1, 3), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 12)) popViewport(2) @ \caption{Advanced strategies for labeling of the Titanic data. Top left: left aligning of both variable names and labels. Top right: changes in the margins (all variable names are in the top and left margins, and all labels in the bottom and right margins). Bottom left: clipping turned on, and boxes used. Bottom right: variable names beneath levels, clipping disabled for the survival and age variables, and \texttt{Age} abbreviated.} \label{fig:labels2} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \subsection[Labels in the cells]{Labels in the cells: \texttt{labeling\_cells()}} This labeling draws both variable names and levels in the cells. As an example, we use the \data{PreSex} data on pre- and extramarital sex and divorce (see Figure~\ref{fig:labels3}, top left): <>= mosaic(~ MaritalStatus + Gender, data = PreSex, labeling = labeling_cells) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Cell labeling for the \data{PreSex} data.} % \label{fig:cell} % \end{center} % \end{figure} \noindent In the case of narrow cells, it might be useful to abbreviate labels and/or variable names and turn off clipping (see Figure~\ref{fig:labels3}, top right): <>= mosaic(~ PremaritalSex + ExtramaritalSex, data = PreSex, labeling = labeling_cells(abbreviate_labels = TRUE, abbreviate_varnames = TRUE, clip = FALSE)) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Cell labeling for the \data{PreSex} data, labels abbreviated.} % \label{fig:cell2} % \end{center} % \end{figure} \noindent For some data, it might be convenient to combine cell labeling with border labeling as done by \codefun{labels\_conditional} (see Figure~\ref{fig:labels3}, bottom left): <>= mosaic(~ PremaritalSex + ExtramaritalSex | MaritalStatus + Gender, data = PreSex, labeling = labeling_conditional(abbreviate_varnames = TRUE, abbreviate_labels = TRUE, clip = FALSE, gp_text = gpar(col = "red"))) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Conditional labeling for the \data{PreSex} data, labels (in % red for clarity) abbreviated.} % \label{fig:conditional} % \end{center} % \end{figure} \noindent Additionally, the cell labeling allows the user to add arbitrary text to the cells by supplying a character array in the same shape as the data array to the \code{text} argument (cells with missing values are ignored). In the following example using the \code{Titanic} data, this is used to add all observed values greater than 5 to the cells after the mosaic has been plotted (see Figure~\ref{fig:labels3}, bottom right): <>= mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = 1, Age = 4)), pop = FALSE) tab <- ifelse(Titanic < 6, NA, Titanic) labeling_cells(text = tab, clip = FALSE)(Titanic) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{User-supplied text (observed frequencies exceeding 5) % added to a mosaic display of the \data{Titanic} data.} % \label{fig:text} % \end{center} % \end{figure} \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= grid.newpage() pushViewport(viewport(layout = grid.layout(ncol = 2, nrow = 2))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(~ MaritalStatus + Gender, data = PreSex, labeling = labeling_cells, newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(~ PremaritalSex + ExtramaritalSex, data = PreSex, labeling = labeling_cells(abbreviate_labels = TRUE, abbreviate_varnames = TRUE, clip = FALSE), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(~ PremaritalSex + ExtramaritalSex | MaritalStatus + Gender, data = PreSex, labeling = labeling_conditional(abbreviate_varnames = TRUE, abbreviate_labels = TRUE, clip = FALSE, gp_text = gpar(col = "red")), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = 1, Age = 3)), pop = FALSE, newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) tab <- ifelse(Titanic < 6, NA, Titanic) labeling_cells(text = tab, clip = FALSE)(Titanic) @ \caption{Cell labeling. Top left: default labeling using the \data{PreSex} data. Top right: abbreviated labels. Bottom left: conditional labeling (labels abbreviated and in red for clarity). Bottom right: user-supplied text (observed frequencies exceeding 5) added to a mosaic display of the \data{Titanic} data. Note that clipping is on by default (top left), and has explicitly been turned off for the three other plots.} \label{fig:labels3} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \subsection[A simple list of labels]{A simple list of labels: \texttt{labeling\_list()}} If problems with overlapping labels cannot satisfactorily resolved, the last remedy could be to simply list the levels below the plot (see Figure~\ref{fig:list}): <>= mosaic(Titanic, labeling = labeling_list, margins = c(bottom = 5)) @ \setkeys{Gin}{width=0.7\textwidth} \begin{figure}[p] \begin{center} <>= mosaic(Titanic, labeling = labeling_list, margins = c(bottom = 5), keep = TRUE) @ \caption{Labels indicated below the plot.} \label{fig:list} \end{center} \end{figure} \noindent The number of columns can be specified. \section{Spacing} \label{sec:spacing} Spacing of strucplot displays is customizable in a similar way than shading. The \code{spacing} argument of the \codefun{strucplot} function takes a list of \class{unit} vectors, one for each dimension, specifying the space between the tiles corresponding to the levels. Consider again the introductory example of the \data{Arthritis} data (Figure~\ref{fig:arthritis}). Since we are interested in the effect of the medicament in the placebo and treatment groups, a mosaic plot is certainly appropriate to visualize the three levels of \code{Improved} in the two \code{Treatment} strata. Another conceptual approach is to use spine plots with highlighting \citep{vcd:hummel:1996}. A spine plot is a variation of a bar plot where the heights of the bars are held constant, whereas the widths are used to represent the number of cases in each category. This is equivalent to a mosaic plot for a one-way table. If a second (indicator) variable is highlighted in a spine plot, we obtain a display equivalent to a simple mosaic display for a two-way table, except that no space between the levels of the highlighted variable is used. In the \data{Arthritis} example, we will highlight patients with \code{Marked} improvement in both groups. To obtain such a display within the strucplot framework, it suffices to set the space between the \code{Improved} tiles to 0 (see Figure~\ref{fig:artspine}): <>= (art <- structable(~Treatment + Improved, data = Arthritis, split_vertical = TRUE)) (my_spacing <- list(unit(0.5, "lines"), unit(c(0, 0), "lines"))) my_colors <- c("lightgray", "lightgray", "black") mosaic(art, spacing = my_spacing, gp = gpar(fill = my_colors, col = my_colors)) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Spine plot for the \data{Arthritis} data using the strucplot framework.} \label{fig:artspine} \end{center} \end{figure} \noindent Note that the default and formula methods for \codefun{mosaic} provide a convenience interface for highlighting. A similar plot (with slightly different shading) than the previous one can be obtained using: <>= mosaic(Improved ~ Treatment, data = Arthritis, split_vertical = TRUE) @ \noindent The strucplot framework also provides a set of spacing grapcon generators which compute suitable spacing objects for typical applications. The simplest spacing is \codefun{spacing\_equal} that uses the same space between all tiles (see Figure~\ref{fig:spacing}, top left): <>= mosaic(art, spacing = spacing_equal(unit(2, "lines"))) @ \noindent \codefun{spacing\_equal} is the default grapcon generator for two-dimensional tables. Slightly more flexible is \codefun{spacing\_dimequal} that allows an individual setting for each dimension (see Figure~\ref{fig:spacing}, top right): <>= mosaic(art, spacing = spacing_dimequal(unit(1:2, "lines"))) @ \noindent The default for multi-way contingency tables is \codefun{spacing\_increase} which uses increasing spaces for the dimensions. The user can specify a start value and the increase factor (see Figure~\ref{fig:spacing}, bottom left): <>= mosaic(art, spacing = spacing_increase(start = unit(0.5, "lines"), rate = 1.5)) @ \noindent For the arthritis example above, we could as well have used \codefun{spacing\_highlighting} which is similar to \codefun{spacing\_increase} but sets the spacing in the last splitting dimension to 0 (see Figure~\ref{fig:spacing}, bottom right): <>= mosaic(art, spacing = spacing_highlighting, gp = my_colors) @ \noindent Finally, \codefun{spacing\_conditional} can be used for visualizing conditional independence: it combines \codefun{spacing\_equal} (for the conditioned dimensions) and \codefun{spacing\_increase} (for the conditioning dimensions). As an example, consider Figure~\ref{fig:presex}: the spacing clearly allows to better distinguish the conditioning variables (\code{Gender} and \code{MaritalStatus}) from the conditioned variables (\code{PremaritalSex} and \code{ExtramaritalSex}). This spacing is the default when conditional variables are specified for a strucplot display (see Section \ref{sec:strucplot}). \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2, nrow = 2))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(art, spacing = spacing_equal(unit(2, "lines")), keep = TRUE, newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(art, spacing = spacing_dimequal(unit(c(0.5, 2), "lines")), keep = TRUE, newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(art, spacing = spacing_increase(start = unit(0.3, "lines"), rate = 2.5), keep = TRUE, newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(art, spacing = spacing_highlighting, keep = TRUE, newpage = FALSE) popViewport(2) @ \caption{Varying spacing for the Arthritis data. Top left: equal spacing for all dimensions. Top right: different spacings for individial dimensions. Bottom left: increasing spacing. Bottom right: spacing used for highlighting.} \label{fig:spacing} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \section{Example: Ovarian cancer survival} \label{sec:example} In the following, we demonstrate some of the described techniques in analyzing a data set originating from \citep{vcd:obel:1975} \cite[taken from][]{vcd:andersen:1991} about a retrospective study of ovary cancer carried out in 1973. Information was obtained from 299 women, who were operated for ovary cancer 10 years before. The data consists of four binary variables: the \code{stage} of the cancer at the time of operation (levels: \code{early}, \code{advanced}), the type of \code{operation} performed (\code{radical}, \code{limited}), the \code{survival} status after 10 years (\code{yes}, \code{no}), and \code{xray} indicating whether X-ray treatment was received (\code{yes}, \code{no}). The dataset in \pkg{vcd} comes pretabulated in a data frame, so we first create the four-way table: <>= tab <- xtabs(Freq ~ stage + operation + xray + survival, data = OvaryCancer) @ \noindent A ``flattened'' textual representation can be obtained using \codefun{structable}: <>= structable(survival ~ ., data = tab) @ \noindent A first overview can be obtained using a pairs plot (Figure~\ref{fig:ocpairs}): <>= dpa <- list(var_offset = 1.2, rot = -30, just_leveltext= "left") pairs(tab, diag_panel = pairs_barplot, diag_panel_args = dpa) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{Pairs plot for the \data{OvaryCancer} data showing mosaic displays for all pairwise distributions and bar plots for all marginal distributions.} \label{fig:ocpairs} \end{center} \end{figure} \noindent The pairs plot, by default, creates mosaic displays for all pairwise variable combinations, and bar plots in the diagonal to visualize the absolute frequencies of the variables. The \texttt{var\_offset} argument modifies the offset of the (centered) variable names to avoid overlap with the bars. Additionally, we use the \texttt{rot} and the \texttt{just\_leveltext} arguments to rotate the level names, again to avoid their overlap. First, we consider the marginal distributions. The study design involved (nearly) the same number of survived (150) and deceased (149) patients. Similarly balanced, 158 cases were in an advanced and 141 in an early stage. Most patients (251, 84\%) were treated with a radical operation, and 186 (62\%) were submitted to X-ray treatment. Next, we inspect the two-way interaction of the influencing factors (\code{stage}, \code{operation}, and \code{xray}): the corresponding mosaics exhibit symmetric, regular shapes with aligned tiles, which indicate no marginal interaction between these variables. The same is true for the interactions of \code{survival} with \code{operation} and \code{xray}, respectively. Only the stage seems to influence survival: here, the tiles are ``shifted''. A different view on the data, focused on the influence of the explanatory variables on \code{Survival}, can be obtained using a doubledecker plot (Figure~\ref{fig:ocdoubledecker}): <>= doubledecker(survival ~ stage + operation + xray, data = tab) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{Doubledecker plot for the \data{OvaryCancer} data showing the conditional distribution of X-ray, given operation, given stage, and with survival highlighted.} \label{fig:ocdoubledecker} \end{center} \end{figure} \noindent From a technical point of view, the display is constructed as a mosaic plot showing the conditional distribution of \code{survival}, given \code{xray}, given \code{operation}, given \code{stage}, with vertical splits for the conditioning variables and horizontal ones for \code{survival}. Additionally, there is zero space between the tiles of the last dimension and a binary shading is used for survived and deceased patients. Conceptually, this plot is interpreted as a mosaic plot of just the influencing variables, with \code{survival} highlighted in the tiles. Thus, the plot really shows the influence of the explanatory variables on \code{survival}. Clearly, the survival rate is higher among patients in an early stage, but neither radical operation nor X-ray treatment seem to improve the situation. From this exploratory phase, the survival rate seems to be slightly higher for patients who received a limited operation only, whereas the effect for X-ray treatment is less marked. To visualize inference results, we can make use of residual-based shadings, investigating log-linear models for the four-way table. Figure~\ref{fig:ocmosaicnull} visualizes the null model, where survival is independent from the combined effect of operation, X-ray treatment, and stage: <>= split <- c(TRUE, TRUE, TRUE, FALSE) mosaic(tab, expected = ~ survival + operation * xray * stage, split_vertical = split) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{OvaryCancer} data, with residual-based shading for the (clearly rejected) null model (survival)(operation, X-ray, stage).} \label{fig:ocmosaicnull} \end{center} \end{figure} \noindent The model is clearly rejected ($p$-value: 0.000). From the exploratory phase of our analysis, we (only) suspect \code{stage} to be influential on the survival rate. A corresponding hypothesis is that \code{survival} be independent of \code{xray} and \code{operation}, given \code{stage}. The model is specified using the \texttt{expected} argument, either using the \codefun{loglin} interface or the \codefun{loglm} formula interface (the resulting mosaic plot is shown in Figure \ref{fig:ocmosaicstage}): <>= mosaic(tab, expected = ~ (survival + operation * xray) * stage, split_vertical = split) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{OvaryCancer} data, with residual-based shading for the hypothesis of survival being independent of X-ray and operation, given stage. The hypothesis is not rejected.} \label{fig:ocmosaicstage} \end{center} \end{figure} \noindent Thus, based on this data, only pre-diagnosis seems to matter in ovarian cancer therapy. \section{Conclusion} \label{sec:conclusion} In this paper, we describe the ``strucplot'' framework for the visualization of multi-way contingency tables. Strucplot displays include popular basic plots such as mosaic, association, and sieve plots, integrated in a unified framework: all can be seen as visualizations of hierarchical conditional flat tables. Additionally, these core strucplot displays can be combined into more complex, specialized plots, such as pairs and trellis-like displays for visualizing conditional independence. Residual-based shadings permit the visualization of log-linear models and the results of independence tests. The framework's modular design allows flexible customization of the plots' graphical appearance, including shading, labeling, spacing, and legend, by means of graphical appearance control (``grapcon'') functions. These ``graphical hyperparameters'' are customized and created by generating functions. Our work includes a set of predefined grapcon generators for typical analysis tasks, and user-level extensions can easily be added. \bibliography{vcd} \begin{appendix} \section{Data sets} \label{sex:data} The data set names in the paper are those from the \proglang{R} system. In the following, we give a short description of each data set. \begin{description} \item[\texttt{Arthritis}] Data from a double-blind clinical trial investigating a new treatment for rheumatoid arthritis. Source: \cite{vcd:Koch+Edwards:1988}. Taken from: \cite{vcd:Friendly:2000}. Package: \pkg{vcd}. \item[\texttt{Bundesliga}] Results from the first German soccer league in the years 1995/6 \citep{vcd:Knorr-Held:1999} and 2001/2 (Collected by: Achim Zeileis). Package: \pkg{vcd}. \item[\texttt{HairEyeColor}] Distribution of hair and eye color and gender in 592 statistics students. The gender information is artificial. Source: \cite{vcd:Snee:1974}. Taken from: \cite{vcd:Friendly:2000}. Package: \pkg{datasets} (included in base \proglang{R}). \item[\texttt{OvaryCancer}] Data about a retrospective study of ovary cancer carried out in 1973. Information was obtained from 299 women, who were operated for ovary cancer 10 years before. Source: \cite{vcd:obel:1975}. Taken fromn: \cite{vcd:andersen:1991}. Package: \pkg{vcd}. \item[\texttt{PreSex}] Data on pre- and extra-marital sex and divorce. Source: \cite{vcd:thornes+collard:1979}. Taken from \cite{vcd:gilbert:1981}. Package: \pkg{vcd}. \item[\texttt{Titanic}] Information on the fate of passengers on the fatal maiden voyage of the ocean liner ``Titanic'', summarized according to economic status (class), gender (\code{Sex}), age and survival. Data originally collected by the British Board of Trade in their investigation of the sinking. Taken from: \cite{vcd:dawson:1995}. Package: \pkg{datasets} (included in base \proglang{R}). \item[\texttt{UCBAdmissions}] Aggregate data on applicants to graduate school at Berkeley for the six largest departments in 1973 classified by admission and gender. Source: \cite{vcd:Bickel+Hammel+O'Connell:1975}. Taken from: \cite{vcd:Friendly:2000}. Package: \pkg{datasets} (included in base \proglang{R}). \end{description} \end{appendix} \end{document} vcd/vignettes/vcd.bib0000644000175100001440000006167512305073216014324 0ustar hornikusers%% general graphics & original methods @Article{vcd:Cohen:1980, author = {A. Cohen}, title = {On the Graphical Display of the Significant Components in a Two-Way Contingency Table}, journal = {Communications in Statistics---Theory and Methods}, year = {1980}, volume = {A9}, pages = {1025--1041} } @InProceedings{vcd:Hartigan+Kleiner:1981, author = {J. A. Hartigan and B. Kleiner}, title = {Mosaics for Contingency Tables}, booktitle = {Computer Science and Statistics: Proceedings of the 13th Symposium on the Interface}, pages = {268--273}, year = {1981}, editor = {W. F. Eddy}, address = {New York}, publisher = {Springer-Verlag} } @Article{vcd:Hartigan+Kleiner:1984, author = {J. A. Hartigan and B. Kleiner}, title = {A Mosaic of Television Ratings}, journal = {The American Statistician}, year = {1984}, volume = {38}, pages = {32--35} } @TechReport{vcd:Young:1996, author = {Forrest W. Young}, title = {{\pkg{ViSta}}: The Visual Statistics System}, institution = {UNC L.~L.~Thurstone Psychometric Laboratory Research Memorandum}, year = 1996, number = {94--1(c)} } @Book{vcd:Cleveland:1993, author = {William S. Cleveland}, title = {Visualizing Data}, publisher = {Hobart Press}, year = 1993, address = {Summit, New Jersey} } @Article{vcd:Becker+Cleveland+Shyu:1996, author = {Richard A. Becker and William S. Cleveland and Ming-Jen Shyu}, title = {The Visual Design and Control of Trellis Display}, journal = {Journal of Computational and Graphical Statistics}, year = {1996}, volume = {5}, pages = {123--155} } @InProceedings{vcd:Riedwyl+Schuepbach:1994, author = {H. Riedwyl and M. Sch{\"u}pbach}, title = {Parquet Diagram to Plot Contingency Tables}, booktitle = {Softstat '93: Advances in Statistical Software}, pages = {293--299}, year = 1994, editor = {F. Faulbaum}, address = {New York}, publisher = {Gustav Fischer} } %% color @InProceedings{vcd:Ihaka:2003, author = {Ross Ihaka}, title = {Colour for Presentation Graphics}, booktitle = {Proceedings of the 3rd International Workshop on Distributed Statistical Computing, Vienna, Austria}, editor = {Kurt Hornik and Friedrich Leisch and Achim Zeileis}, year = {2003}, url = {http://www.ci.tuwien.ac.at/Conferences/DSC-2003/Proceedings/}, note = {{ISSN 1609-395X}}, } @Article{vcd:Lumley:2006, author = {Thomas Lumley}, title = {Color Coding and Color Blindness in Statistical Graphics}, journal = {ASA Statistical Computing \& Graphics Newsletter}, year = {2006}, volume = {17}, number = {2}, pages = {4--7} } @Book{vcd:Munsell:1905, author = {Albert H. Munsell}, title = {A Color Notation}, publisher = {Munsell Color Company}, year = {1905}, address = {Boston, Massachusetts} } @Article{vcd:Harrower+Brewer:2003, author = {Mark A. Harrower and Cynthia A. Brewer}, title = {\pkg{ColorBrewer.org}: An Online Tool for Selecting Color Schemes for Maps}, journal = {The Cartographic Journal}, year = {2003}, volume = {40}, pages = {27--37} } @InProceedings{vcd:Brewer:1999, author = {Cynthia A. Brewer}, title = {Color Use Guidelines for Data Representation}, booktitle = {Proceedings of the Section on Statistical Graphics, American Statistical Association}, address = {Alexandria, VA}, year = {1999}, pages = {55--60} } @Article{vcd:Cleveland+McGill:1983, author = {William S. Cleveland and Robert McGill}, title = {A Color-caused Optical Illusion on a Statistical Graph}, journal = {The American Statistician}, year = {1983}, volume = {37}, pages = {101--105} } @Book{vcd:CIE:2004, author = {{Commission Internationale de l'\'Eclairage}}, title = {Colorimetry}, edition = {3rd}, publisher = {Publication CIE 15:2004}, address = {Vienna, Austria}, year = {2004}, note = {{ISBN} 3-901-90633-9} } @InProceedings{vcd:Moretti+Lyons:2002, author = {Giovanni Moretti and Paul Lyons}, title = {Tools for the Selection of Colour Palettes}, booktitle = {Proceedings of the New Zealand Symposium On Computer-Human Interaction (SIGCHI 2002)}, address = {University of Waikato, New Zealand}, month = {July}, year = {2002} } @Article{vcd:MacAdam:1942, author = {D. L. MacAdam}, title = {Visual Sensitivities to Color Differences in Daylight}, journal = {Journal of the Optical Society of America}, year = {1942}, volume = {32}, number = {5}, pages = {247--274}, } @Book{vcd:Wyszecki+Stiles:2000, author = {G\"unter Wyszecki and W. S. Stiles}, title = {Color Science}, edition = {2nd}, publisher = {Wiley}, year = {2000}, note = {{ISBN} 0-471-39918-3} } @Misc{vcd:Poynton:2000, author = {Charles Poynton}, title = {Frequently-Asked Questions About Color}, year = {2000}, howpublished = {URL \url{http://www.poynton.com/ColorFAQ.html}}, note = {Accessed 2006-09-14}, } @Misc{vcd:Wiki+HSV:2006, author = {Wikipedia}, title = {{HSV} Color Space --- {W}ikipedia{,} The Free Encyclopedia}, year = {2006}, howpublished = {URL \url{http://en.wikipedia.org/w/index.php?title=HSV_color_space&oldid=74735552}}, note = {Accessed 2006-09-14}, } @Misc{vcd:Wiki+LUV:2006, author = {Wikipedia}, title = {{Lab} Color Space --- {W}ikipedia{,} The Free Encyclopedia}, year = {2006}, howpublished = {URL \url{http://en.wikipedia.org/w/index.php?title=Lab_color_space&oldid=72611029}}, note = {Accessed 2006-09-14}, } @Article{vcd:Smith:1978, author = {Alvy Ray Smith}, title = {Color Gamut Transform Pairs}, journal = {Computer Graphics}, pages = {12--19}, year = {1978}, volume = {12}, number = {3}, note = {ACM SIGGRAPH 78 Conference Proceedings}, } %% url = {http://www.alvyray.com/}, @Article{vcd:Meier+Spalter+Karelitz:2004, author = {Barbara J. Meier and Anne Morgan Spalter and David B. Karelitz}, title = {Interactive Color Palette Tools}, journal = {{IEEE} Computer Graphics and Applications}, volume = {24}, number = {3}, year = {2004}, pages = {64--72}, } %% url = {http://graphics.cs.brown.edu/research/color/} @InCollection{vcd:Mollon:1995, author = {J. Mollon}, editor = {T. Lamb and J. Bourriau}, booktitle = {Colour: Art and Science}, title = {Seeing Color}, publisher = {Cambridge Univesity Press}, year = 1995 } %% Friendly publications @Article{vcd:Friendly:1994, author = {Michael Friendly}, title = {Mosaic Displays for Multi-Way Contingency Tables}, journal = {Journal of the American Statistical Association}, year = {1994}, volume = {89}, pages = {190--200} } @Article{vcd:Friendly:1999, author = {Michael Friendly}, title = {Extending Mosaic Displays: Marginal, Conditional, and Partial Views of Categorical Data}, journal = {Journal of Computational and Graphical Statistics}, year = {1999}, volume = {8}, number = {3}, pages = {373--395} } @Book{vcd:Friendly:2000, author = {Michael Friendly}, title = {Visualizing Categorical Data}, publisher = {\textsf{SAS} Insitute}, year = {2000}, address = {Carey, NC}, URL = {http://www.math.yorku.ca/SCS/vcd/} } %% Augsburg publications @Article{vcd:Theus+Lauer:1999, author = {Martin Theus and Stephan R. W. Lauer}, title = {Visualizing Loglinear Models}, journal = {Journal of Computational and Graphical Statistics}, year = 1999, volume = 8, number = 3, pages = {396--412} } @Article{vcd:Hofmann:2003, author = {Heike Hofmann}, title = {Constructing and Reading Mosaicplots}, journal = {Computational Statistics \& Data Analysis}, year = {2003}, volume = {43}, pages = {565--580} } @Article{vcd:Hofmann:2001, author = {Heike Hofmann}, title = {Generalized Odds Ratios for Visual Modelling}, journal = {Journal of Computational and Graphical Statistics}, year = {2001}, volume = {10}, pages = {1--13} } @Article{vcd:Theus:2003, author = {Martin Theus}, title = {Interactive Data Visualization Using \pkg{Mondrian}}, journal = {Journal of Statistical Software}, volume = 7, number = 11, pages = {1--9}, year = 2003, url = {http://www.jstatsoft.org/v07/i11/}, } @Unpublished{vcd:Hofmann+Theus, author = {Heike Hofmann and Martin Theus}, title = {Interactive Graphics for Visualizing Conditional Distributions}, note = {Unpublished Manuscript}, year = {2005} } @Article{vcd:Hummel:1996, author = {J. Hummel}, title = {Linked Bar Charts: Analysing Categorical Data Graphically}, journal = {Computational Statistics}, year = 1996, volume = 11, pages = {23--33} } @Article{vcd:Unwin+Hawkins+Hofmann:1996, author = {Antony R. Unwin and G. Hawkins and Heike Hofmann and B. Siegl}, title = {Interactive Graphics for Data Sets with Missing Values -- \pkg{MANET}}, journal = {Journal of Computational and Graphical Statistics}, year = 1996, pages = {113--122}, volume = 4, number = 6 } @Manual{vcd:Urbanek+Wichtrey:2006, title = {\pkg{iplots}: Interactive Graphics for \textsf{R}}, author = {Simon Urbanek and Tobias Wichtrey}, year = {2006}, note = {\textsf{R} package version 1.0-3}, url = {http://www.rosuda.org/iPlots/} } %% Software @Manual{vcd:R:2006, title = {\textsf{R}: {A} Language and Environment for Statistical Computing}, author = {{\textsf{R} Development Core Team}}, organization = {\textsf{R} Foundation for Statistical Computing}, address = {Vienna, Austria}, year = {2006}, note = {{ISBN} 3-900051-00-3}, url = {http://www.R-project.org/} } @Article{vcd:Murrell:2002, author = {Paul Murrell}, title = {The \pkg{grid} Graphics Package}, journal = {\proglang{R} News}, year = 2002, volume = 2, number = 2, pages = {14--19}, month = {June}, url = {http://CRAN.R-project.org/doc/Rnews/} } @Book{vcd:Murrell:2006, author = {Paul Murrell}, title = {\textsf{R} Graphics}, publisher = {Chapmann \& Hall/CRC}, address = {Boca Raton, Florida}, year = {2006}, } @Book{vcd:Venables+Ripley:2002, author = {William N. Venables and Brian D. Ripley}, title = {Modern Applied Statistics with \textsf{S}}, edition = {4th}, publisher = {Springer-Verlag}, address = {New York}, year = {2002}, note = {{ISBN} 0-387-95457-0}, url = {http://www.stats.ox.ac.uk/pub/MASS4/} } @Manual{vcd:Ihaka:2006, title = {\pkg{colorspace}: Colorspace Manipulation}, author = {Ross Ihaka}, year = {2006}, note = {\textsf{R} package version 0.95} } @Manual{vcd:Meyer+Zeileis+Hornik:2006, title = {\pkg{vcd}: Visualizing Categorical Data}, author = {David Meyer and Achim Zeileis and Kurt Hornik}, year = {2006}, note = {\textsf{R} package version 1.0-6} } @article{vcd:Ligges+Maechler:2003, title = {\pkg{scatterplot3d} -- An {R} Package for Visualizing Multivariate Data}, author = {Uwe Ligges and Martin M{\"a}chler}, journal = {Journal of Statistical Software}, year = 2003, pages = {1--20}, number = 11, volume = 8, url = {http://www.jstatsoft.org/v08/i11/} } @Manual{vcd:SAS:2005, title = {\proglang{SAS/STAT} Version 9}, author = {\proglang{SAS} Institute Inc.}, year = {2005}, address = {Cary, NC} } @Manual{vcd:SPLUS:2005, title = {\proglang{S-PLUS} 7}, author = {{Insightful Inc.}}, year = {2005}, address = {Seattle, WA} } %% data @Article{vcd:Azzalini+Bowman:1990, author = {A. Azzalini and A. W. Bowman}, title = {A Look at Some Data on the {O}ld {F}aithful Geyser}, journal = {Applied Statistics}, year = {1990}, volume = {39}, pages = {357--365}, } @Article{vcd:Obel:1975, author = {E.B. Obel}, title = {A Comparative Study of Patients with Cancer of the Ovary Who Have Survived More or Less Than 10 Years}, journal = {Acta Obstetricia et Gynecologica Scandinavica}, year = 1975, volume = 55, pages = {429--439} } @InCollection{vcd:Koch+Edwards:1988, author = {G. Koch and S. Edwards}, title = {Clinical Efficiency Trials with Categorical Data}, booktitle = {Biopharmaceutical Statistics for Drug Development}, editor = {K. E. Peace}, publisher = {Marcel Dekker}, address = {New York}, year = {1988}, pages = {403--451} } @TechReport{vcd:Knorr-Held:1999, author = {Leonhard Knorr-Held}, title = {Dynamic Rating of Sports Teams}, institution = {SFB 386 ``Statistical Analysis of Discrete Structures''}, year = {1999}, type = {Discussion Paper}, number = {98}, url = {http://www.stat.uni-muenchen.de/sfb386/} } @Article{vcd:Snee:1974, author = {R. D. Snee}, title = {Graphical Display of Two-Way Contingency Tables}, journal = {The American Statistician}, year = 1974, volume = 28, pages = {9--12} } @Article{vcd:Bickel+Hammel+O'Connell:1975, author = {P. J. Bickel and E. A. Hammel and J. W. O'Connell}, title = {Sex Bias in Graduate Admissions: Data from {B}erkeley}, journal = {Science}, year = 1975, volume = 187, pages = {398--403} } @Book{vcd:Gilbert:1981, author = {G. N. Gilbert}, title = {Modelling Society: An Introduction to Loglinear Analysis for Social Researchers}, publisher = {Allen and Unwin}, year = 1981, address = {London} } @Book{vcd:Thornes+Collard:1979, author = {B. Thornes and J. Collard}, title = {Who Divorces?}, publisher = {Routledge \& Kegan}, year = 1979, address = {London} } @Article{vcd:Dawson:1995, author = {Robert J. MacG Dawson}, title = {The ``Unusual Episode'' Data Revisited}, journal = {Journal of Statistics Education}, year = 1995, volume = 3, url = {http://www.amstat.org/publications/jse/v3n3/datasets.dawson.html} } @Article{vcd:Haberman:1974, author = {S. J. Haberman}, title = {Log-linear Models for Frequency Tables with Ordered Classifications}, journal = {Biometrics}, year = 1974, volume = 30, pages = {689--700} } @Article{vcd:Wing:1962, author = {J. K. Wing}, title = {Institutionalism in Mental Hospitals}, journal = {British Journal of Social Clinical Psychology}, year = 1962, volume = 1, pages = {38--51} } @Book{vcd:Andersen:1991, author = {E. B. Andersen}, title = {The Statistical Analysis of Categorical Data}, publisher = {Springer-Verlag}, year = {1991}, address = {Berlin}, edition = {2nd} } @Article{vcd:Haberman:1973, author = {S. J. Haberman}, title = {The Analysis of Residuals in Cross-classified Tables}, journal = {Biometrics}, year = {1973}, volume = {29}, pages = {205--220} } @Book{vcd:Everitt+Hothorn:2006, author = {Brian S. Everitt and Torsten Hothorn}, title = {A Handbook of Statistical Analyses Using \textsf{R}}, publisher = {Chapman \& Hall/CRC}, address = {Boca Raton, Florida}, year = {2006} } @Article{vcd:Salib+Hillier:1997, author = {Emad Salib and Valerie Hillier}, title = {A Case-Control Study of Smoking and {A}lzheimer's Disease}, journal = {International Journal of Geriatric Psychiatry}, year = {1997}, volume = {12}, pages = {295--300} } %% inference @Book{vcd:Agresti:2002, author = {Alan Agresti}, title = {Categorical Data Analysis}, publisher = {John Wiley \& Sons}, year = {2002}, address = {Hoboken, New Jersey}, edition = {2nd} } @Book{vcd:Mazanec+Strasser:2000, author = {Josef A. Mazanec and Helmut Strasser}, title = {A Nonparametric Approach to Perceptions-based Market Segmentation: Foundations}, publisher = {Springer-Verlag}, year = {2000}, address = {Berlin} } @Article{vcd:Strasser+Weber:1999, author = {Helmut Strasser and Christian Weber}, title = {On the Asymptotic Theory of Permutation Statistics}, journal = {Mathematical Methods of Statistics}, volume = {8}, pages = {220--250}, year = {1999} } @Book{vcd:Pesarin:2001, author = {Fortunato Pesarin}, title = {Multivariate Permutation Tests}, year = {2001}, publisher = {John Wiley \& Sons}, address = {Chichester} } @Article{vcd:Ernst:2004, author = {Michael D. Ernst}, title = {Permutation Methods: A Basis for Exact Inference}, journal = {Statistical Science}, volume = {19}, year = {2004}, pages = {676--685} } @Article{vcd:Patefield:1981, author = {W. M. Patefield}, title = {An Efficient Method of Generating $R \times C$ Tables with Given Row and Column Totals}, note = {{A}lgorithm AS 159}, journal = {Applied Statistics}, volume = {30}, year = {1981}, pages = {91--97} } %% own @InProceedings{vcd:Meyer+Zeileis+Hornik:2003, author = {David Meyer and Achim Zeileis and Kurt Hornik}, title = {Visualizing Independence Using Extended Association Plots}, booktitle = {Proceedings of the 3rd International Workshop on Distributed Statistical Computing, Vienna, Austria}, editor = {Kurt Hornik and Friedrich Leisch and Achim Zeileis}, year = {2003}, url = {http://www.ci.tuwien.ac.at/Conferences/DSC-2003/Proceedings/}, note = {{ISSN 1609-395X}}, } @TechReport{vcd:Zeileis+Meyer+Hornik:2005, author = {Achim Zeileis and David Meyer and Kurt Hornik}, title = {Residual-based Shadings for Visualizing (Conditional) Independence}, institution = {Department of Statistics and Mathematics, Wirtschaftsuniversit\"at Wien, Research Report Series}, year = {2005}, type = {Report}, number = {20}, month = {August}, url = {http://epub.wu-wien.ac.at/dyn/openURL?id=oai:epub.wu-wien.ac.at:epub-wu-01_871} } @Article{vcd:Zeileis+Meyer+Hornik:2007, author = {Achim Zeileis and David Meyer and Kurt Hornik}, title = {Residual-based Shadings for Visualizing (Conditional) Independence}, journal = {Journal of Computational and Graphical Statistics}, year = {2007}, volume = {16}, number = {3}, pages = {507--525}, doi = {10.1198/106186007X237856} } @TechReport{vcd:Meyer+Zeileis+Hornik:2005a, author = {David Meyer and Achim Zeileis and Kurt Hornik}, title = {The Strucplot Framework: Visualizing Multi-Way Contingency Tables with \pkg{vcd}}, institution = {Department of Statistics and Mathematics, Wirtschaftsuniversit\"at Wien, Research Report Series}, year = {2005}, type = {Report}, number = {22}, month = {November}, url = {http://epub.wu-wien.ac.at/dyn/openURL?id=oai:epub.wu-wien.ac.at:epub-wu-01_8a1} } @Article{vcd:Meyer+Zeileis+Hornik:2006b, author = {David Meyer and Achim Zeileis and Kurt Hornik}, title = {The Strucplot Framework: Visualizing Multi-way Contingency Tables with \pkg{vcd}}, year = {2006}, journal = {Journal of Statistical Software}, volume = {17}, number = {3}, pages = {1--48}, url = {http://www.jstatsoft.org/v17/i03/} } @InCollection{vcd:Meyer+Zeileis+Hornik:2006a, author = {David Meyer and Achim Zeileis and Kurt Hornik}, title = {Visualizing Contingency Tables}, editor = {Chun-Houh Chen and Wolfang H\"ardle and Antony Unwin}, booktitle = {Handbook of Data Visualization}, series = {Springer Handbooks of Computational Statistics}, year = {2006}, publisher = {Springer-Verlag}, address = {New York}, note = {{ISBN} 3-540-33036-4, to appear} } @Article{vcd:Hothorn+Hornik+VanDeWiel:2006, author = {Torsten Hothorn and Kurt Hornik and Mark A. van de Wiel and Achim Zeileis}, title = {A {L}ego System for Conditional Inference}, journal = {The American Statistician}, year = {2006}, volume = {60}, number = {3}, pages = {257--263}, doi = {10.1198/000313006X118430} } @TechReport{vcd:Zeileis+Hornik:2006, author = {Achim Zeileis and Kurt Hornik}, title = {Choosing Color Palettes for Statistical Graphics}, institution = {Department of Statistics and Mathematics, Wirtschaftsuniversit\"at Wien, Research Report Series}, year = {2006}, type = {Report}, number = {41}, month = {October}, url = {http://epub.wu-wien.ac.at/} } @Article{vcd:Zeileis+Hornik+Murrell:2009, author = {Achim Zeileis and Kurt Hornik and Paul Murrell}, title = {Escaping {RGB}land: Selecting Colors for Statistical Graphics}, journal = {Computational Statistics \& Data Analysis}, year = {2009}, volume = {53}, number = {9}, pages = {3259--3270}, doi = {10.1016/j.csda.2008.11.033}, } %% bad color examples @Article{vcd:Gneiting+Sevcikova+Percival:2006, author = {Tilmann Gneiting and Hana \v{S}ev\v{c}\'ikov\'a and Donald B. Percival and Martin Schlather and Yindeng Jiang}, title = {Fast and Exact Simulation of Large Gaussian Lattice Systems in {$\mathbb{R}^2$}: Exploring the Limits}, year = {2006}, journal = {Journal of Computational and Graphical Statistics}, volume = {15}, number = {3}, pages = {483--501}, note = {Figures~1--4} } @Article{vcd:Yang+Buckley+Dudoit:2002, author = {Yee Hwa Yang and Michael J. Buckley and Sandrine Dudoit and Terence P. Speed}, title = {Comparison of Methods for Image Analysis on {cDNA} Microarray Data}, year = {2002}, journal = {Journal of Computational and Graphical Statistics}, volume = {11}, number = {1}, pages = {108--136}, note = {Figure~4a} } @Article{vcd:Kneib:2006, author = {Thomas Kneib}, title = {Mixed Model-based Inference in Geoadditive Hazard Regression for Interval-censored Survival Times}, year = {2006}, journal = {Computational Statistics \& Data Analysis}, volume = {51}, pages = {777--792}, note = {Figure~5 (left)} } @Article{vcd:Friendly:2002, author = {Michael Friendly}, title = {A Brief History of the Mosaic Display}, year = {2002}, journal = {Journal of Computational and Graphical Statistics}, volume = {11}, number = {1}, pages = {89--107}, note = {Figure~11 (left, middle)} } @Article{vcd:Celeux+Hurn+Robert:2000, author = {Gilles Celeux and Merrilee Hurn and Christian P. Robert}, title = {Computational and Inferential Difficulties with Mixture Posterior Distributions}, year = {2000}, journal = {Journal of the American Statistical Association}, volume = {95}, number = {451}, pages = {957--970}, note = {Figure~3} } %% pointers from Hadley @article{cleveland:1987, Author = {Cleveland, William and McGill, Robert}, Journal = {Journal of the Royal Statistical Society A}, Number = {3}, Pages = {192-229}, Title = {Graphical Perception: The Visual Decoding of Quantitative Information on Graphical Displays of Data}, Volume = {150}, Year = {1987}} @article{cleveland:1984, Author = {Cleveland, William S. and McGill, M. E.}, Journal = {Journal of the American Statistical Association}, Number = 387, Pages = {531-554}, Title = {Graphical Perception: Theory, Experimentation and Application to the Development of Graphical Methods}, Volume = 79, Year = 1984} @article{huang:1997, Author = {Huang, Chisheng and McDonald, John Alan and Stuetzle, Werner}, Journal = {Journal of Computational and Graphical Statistics}, Pages = {383--396}, Title = {Variable resolution bivariate plots}, Volume = {6}, Year = {1997}} @article{carr:1987, Author = {Carr, D. B. and Littlefield, R. J. and Nicholson, W. L. and Littlefield, J. S.}, Journal = {Journal of the American Statistical Association}, Number = {398}, Pages = {424-436}, Title = {Scatterplot Matrix Techniques for Large N}, Volume = {82}, Year = {1987}} @book{cleveland:1994, Author = {Cleveland, William}, Publisher = {Hobart Press}, Title = {The Elements of Graphing Data}, Year = {1994}} @book{chambers:1983, Author = {Chambers, John and Cleveland, William and Kleiner, Beat and Tukey, Paul}, Publisher = {Wadsworth}, Title = {Graphical methods for data analysis}, Year = {1983}} @book{bertin:1983, Address = {Madison, WI}, Author = {Bertin, Jacques}, Publisher = {University of Wisconsin Press}, Title = {Semiology of Graphics}, Year = {1983}} @book{wilkinson:2006, Author = {Wilkinson, Leland}, Publisher = {Springer-Verlag}, Series = {Statistics and Computing}, Title = {The Grammar of Graphics}, Year = {2005}} vcd/vignettes/struc.pdf0000755000175100001440000000622011720273431014712 0ustar hornikusers%PDF-1.4 % 1 0 obj << /Length 2 0 R /Filter /FlateDecode >> stream xZn7 ?l99Hrv$ ?;A /=CɥZIP "ݬ.6əˋ Ya!jU_ȿvy!"LN//Y,6Hh ƶNيȽŝpX470/kj4~r-.eQCx4 |6RIᢾaBZ[F$'%8+[~U[uR[K@L]tcҡú7Ӵ6VgwBu(HqkWiK1uґF[K@o$T'j2kHA6ĢĐNWd#@c6ZJl`)cVٸF0@еXh>NuA?Q`~E[JJ) -b-[yy ƕҀ~L~iiuuPiIn00-ݨJ.jS~#S(^" YQm"PSvg[*C3*Ne ~*=zKek08-RzY cAm3yAF3s),>7l^Z")h&n ٣LIkkFr^Z3%E%vmk(;,*XK憣Ξn?ⅅ3LӷҜ9E#:{h5lg!䰩\j鷣mN1,#QFvhMBp[cl嚢((.)oW좵ۀٷXw";!B%x5*Z-tM^?푉׫[wHδe!]=Wix09Es{kp5 R.l'DodP"!YFh-UdYrB;qڣaJSvR(AT^ -,na&Qr!t  \\UӸDtPt-3ݘslHAVsF@{Tf!.Sڳ 埝'n5n']y<,i|-xѰ&ؒl9ǩs5K( gsņaqRR$+ܕ< zֺ'-]{=`_Cby3?a:H}22Ԉ+cMBܘ0>5 Q 1DN!S=A”Duibj/VZT_f~5@Mx#CkƸF+sG/h<,p @4^SL2:QI'4#w}Ǘ v35 O kڻq:2H/k:o^a{ͣQ'}nLQ˟+?YgX< ݨy:,Ҩ1);mG@cEI7%.`4ڨUҏyB3|SWS܉1mZ@X#d~TƔJ_&endstream endobj 2 0 obj 1891 endobj 4 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Courier /Encoding /WinAnsiEncoding >> endobj 5 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Helvetica /Encoding /WinAnsiEncoding >> endobj 6 0 obj << /F1 5 0 R /F2 4 0 R >> endobj 7 0 obj << /Font 6 0 R /ProcSet [ /PDF ] >> endobj 8 0 obj << /Type /Page /Parent 3 0 R /Resources 7 0 R /MediaBox [ 0 0 794 595 ] /Contents 1 0 R >> endobj 3 0 obj << /Type /Pages /Resources 7 0 R /MediaBox [ 0 0 595 842 ] /Kids [ 8 0 R ] /Count 1 >> endobj 9 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 10 0 obj << /Creator /Producer /CreationDate (D:20051019112228+02'00') >> endobj xref 0 11 0000000000 65535 f 0000000017 00000 n 0000001993 00000 n 0000002495 00000 n 0000002020 00000 n 0000002133 00000 n 0000002248 00000 n 0000002302 00000 n 0000002367 00000 n 0000002631 00000 n 0000002690 00000 n trailer << /Size 11 /Root 9 0 R /Info 10 0 R >> startxref 2901 %%EOF vcd/MD50000644000175100001440000002166612547236615011402 0ustar hornikusers35194353881e299ca072c9fbb49b66b1 *DESCRIPTION e9292b3d66770219128224e4f4997821 *NAMESPACE 3c097b80a9e49b4d417f0e5ea45427ce *R/Kappa.R 059845124a77cda96758bfe96e8fbb76 *R/Ord_plot.R 486d6e0bf1fe6bcfb760a3d3ba08cadb *R/agreementplot.R 00a9c863579ce1da6cc72e59bbda6f02 *R/assoc.R 09d60e56dfbb1afa698177e7cf591bed *R/assocstats.R 25867b3cdcc6858e20cef7a9e67b540a *R/binregplot.R 4088faa0871130598e07ea26430a3c5a *R/cd_plot.R 3ea43d07743875dfce874f4cc067196c *R/co_table.R 1cfff0fdbfa0b20fe4e691b997a5a328 *R/coindep_test.R 6e1c60aa0e8afd51604702791d8947fb *R/cotabplot.R 73bbf5370d2184e754ad4a848c9a219b *R/distplot.R 404c2d7be10c796079fc3e68a0186e3e *R/doubledeckerplot.R f8ce1d406efffcdef0af4078739ab7e3 *R/fourfold.R 40fa6290dea68cd3505166907731f742 *R/goodfit.R cb59d1ec73b001757a20e006a2c2c9d2 *R/grid_legend.R 2c061c5f3b6c7480155aca387cbae2bf *R/hls.R c0fd8b5aeb29007f2df6c344f73c8b93 *R/labeling.R 59efe4302412387812f1d6122b51c5a0 *R/legends.R 060ce547f067b0423d00cb8d24915118 *R/loddsratio.R 75320b6d1294ffdb5a80f4262977ead8 *R/mosaic.R e399eefbaf6b57cd9c0d63627e5e0960 *R/mplot.R e64948c0c3e16187701584d8ca54831d *R/oddsratioplot.R ef50116a771b80f031997e45d94bac3b *R/pairsplot.R f429718cc703e950773811364d9335ed *R/plot.loglm.R d0d1334f8b9a76cd4e16923d70a1a9d3 *R/rootogram.R d15a403b0412ba22d07698e3861da6a5 *R/shadings.R 5844e6cfd389dc23e364496f6d1059fe *R/sieve.R fd79ebf9c8a9b483b500bad1f0b228e9 *R/spacings.R 8c1e69e46e0d3127ca572abc3b813924 *R/spine.R eae1db383ba841387251d45f0d90bc95 *R/strucplot.R b9746714edb811fba4f2cac33bc923ac *R/structable.R 54abbe94cad0a0322a44327e62a810ca *R/tabletools.R c5a4238e3aee9f20325feb4866076c74 *R/ternaryplot.R 7a7f192c82e3a7a7b2f690070f5efa99 *R/tile.R f1f0d3194326666f81dc1ef97623a911 *R/utils.R a54ac332c792d35e0846d4bf45d45bd8 *R/woolf_test.R 48d41048b99ddf0507ad82a138eaa31d *build/vignette.rds 1fcacdd810545176c5dfc8ad4be480d3 *data/Arthritis.rda af42b0e82f7602ef3a21ac54ba67071c *data/Baseball.rda 4956f3321e6fb5582e3f2ba8901012cd *data/BrokenMarriage.rda 4db232a9f37c6afe361051f4f3d425a5 *data/Bundesliga.rda 93e7f6208ec8c8db86401c1afc3320f6 *data/Bundestag2005.rda 17e7a509bb1522991c7cfb168043c912 *data/Butterfly.rda f4e45bae788977b0bfb08529b9ecd604 *data/CoalMiners.rda aa7e80a1cd039d8fc05298dac9a2d0bf *data/DanishWelfare.rda fa3f3d1f315ecdee4398557068a85ac9 *data/Employment.rda bef6d9e04289a1ff81ebe78cf33936e4 *data/Federalist.rda 59c4403257e7fdd114f70aedb279b9eb *data/Hitters.rda f79aa4640d5c581d137d4387b8b6cec4 *data/HorseKicks.rda bead1664e9c96608072ca77c8be5aee6 *data/Hospital.rda 30aa94bd0a31ce461608ba6934ebe5ba *data/JobSatisfaction.rda c8f5e67eab217718fa29e5400dd45bf5 *data/JointSports.rda 94e0ef13bafde9e6fc0ec4bfde48e5f1 *data/Lifeboats.rda e0f2b78821e11917521a368d2887249a *data/MSPatients.rda ba9681b79f4ebe1322cacaa081b968d8 *data/NonResponse.rda 134589af7ec903a3c3e00d4206dd1360 *data/OvaryCancer.rda ee21f828fdb19f117d2664f562f6881e *data/PreSex.rda f0935833b88518d4cec4cbd4cad1c93c *data/Punishment.rda 606c078be414c13d868a820566d1b852 *data/RepVict.rda 7d59f131805db77bfefba7d96ad5757d *data/Rochdale.rda 321cf5d4ebafe556abfc74f83712d3e7 *data/Saxony.rda d9056090e3ef45162e3e61a33e9b1bc1 *data/SexualFun.rda a9971961ea92c34cfa6df11a2702ab57 *data/SpaceShuttle.rda 884d34698f9f3300a7b4e28f7470a3f3 *data/Suicide.rda 645187968a5775ec0f32c58b00fa416b *data/Trucks.rda bea8a6a50fcf0432075299df4db01416 *data/UKSoccer.rda 203346753d583e64ebaae114e009466f *data/VisualAcuity.rda 7f1432aa827fde459adce4e66fcac287 *data/VonBort.rda d6f3f6211deee46a8e44eaf9483de88f *data/WeldonDice.rda ab01ca689716b23e16c6bbc1e095078f *data/WomenQueue.rda fea43b041738222b9ca05543c2103248 *demo/00Index 6446ca2edeae8ffaab647cbaf9badc92 *demo/discrete.R 7eb8e56560704b20fe6ca89df6a37843 *demo/hcl.R b96320b9a646b8fc6c63661f49b6aa6f *demo/hls.R 002ca3d1e79c9d84416d3b4e0bf8024e *demo/hsv.R 1da0bb6bdd21c0b13a1599b2121253be *demo/hullternary.R 32aefed96167152c94cf9f5c1a3708cf *demo/mondrian.R a61a25a7b48e3d172cc6353b956c9392 *demo/mosaic.R 7b08161f2cdc60d9e594f3aa76479272 *demo/strucplot.R baec36bb9bda9e52aa5467bd11c71f9d *demo/twoway.R 1868ee22006e7378323f6581a91690eb *inst/CITATION 45e371ed8d1c5a63e6d4aba5150eefa7 *inst/NEWS.Rd 1bd85dce9589862a54d02cf5687befcd *inst/doc/Z.cls 6d2946ce9127e1b46b04b9b8cdcde98e *inst/doc/residual-shadings.R 602c680f1ef5d2af17cc38d59a8426a9 *inst/doc/residual-shadings.Rnw 5b2c823caa07a5f517ccde15161151e6 *inst/doc/residual-shadings.pdf 0f08ab21c366ba4d4204fae211e89104 *inst/doc/struc.pdf fe22f0d95f4098096281d58c459928f9 *inst/doc/struc.sxi 23a35b9e4ad98965a8b98c760e030f21 *inst/doc/strucplot.R 69cf9db5dc833b6ffceb75aea1905673 *inst/doc/strucplot.Rnw 4a8c03a1166a84805a23c631694933c5 *inst/doc/strucplot.pdf ace1d42555f8fbfb6345c83898c59e01 *inst/doc/vcd.bib 52757bd94ba340a720830f6075f8b0fb *man/Arthritis.Rd 912a44043a40235b1800aae01d50042e *man/Baseball.Rd 1059d318cb78e6586c3b772ad941cc36 *man/BrokenMarriage.Rd 946f82b735010df751088fb117cc84e8 *man/Bundesliga.Rd 97d83ac99fb6193e9a457a0cbe0df7f9 *man/Bundestag2005.Rd d5d5c262a89021e918ad8ec488568ed5 *man/Butterfly.Rd 6ed74b82637f822590003c9ce61440c5 *man/CoalMiners.Rd 9a605318f578054afcff4fbe130450c2 *man/DanishWelfare.Rd a8fbbdb872f26bc25aa776061febbd36 *man/Employment.Rd 5e26cab32f3905b6b243f5688dd11cb3 *man/Federalist.Rd ceabf42729a57cb25fa2c707572ccbf1 *man/Hitters.Rd e559ebed2dae1632aa67296563f05b2b *man/HorseKicks.Rd 8e75757feb4d17a3c40a34a0dcc3ca81 *man/Hospital.Rd c533f38a41280541958fdec1520d2341 *man/JobSatisfaction.Rd df94bd111d97c846f201ad51626a0a97 *man/JointSports.Rd 428dc2a741a2c42b75697f2869dfd5ed *man/Kappa.Rd 0ab6cfcde586f29bb80ba421f7de5350 *man/Lifeboats.Rd 9df8dd04a6640b674d8058f056311849 *man/MSPatients.Rd aa707134c91334b4c6e9ad33af97a6b8 *man/NonResponse.Rd a361b8cb90c7fc63d59a07ac8fafa4a1 *man/Ord_plot.Rd 946497fa005b8f2ec4c6d43e667d7fc8 *man/OvaryCancer.Rd 3ffa16283546c87e5c81190cddd976f8 *man/PreSex.Rd c5cdc599551ae8d2f0a8dbf3a18363df *man/Punishment.Rd 35dd143e4e35bc2b72804ca99e6f746e *man/RepVict.Rd 7c9a39dcc04d539a98407436c5254c20 *man/Rochdale.Rd 250e3176df959f30b160b10b381ac598 *man/Saxony.Rd 57dbc598ae5f4a0b07023d97b9eac55c *man/SexualFun.Rd 57c0d552618bf1b43de02a34883d10a9 *man/SpaceShuttle.Rd 0135b1039084161d9304ac1e9f983467 *man/Suicide.Rd 0b3b7d616076bda3643fea65ec4792f6 *man/Trucks.Rd c4221305498c64d7cce56fd05d38c10b *man/UKSoccer.Rd 43a94ba83e261bac38c238ebc699796c *man/VisualAcuity.Rd 36eba659eb6ae3203f9103a86d41bf5b *man/VonBort.Rd ca83003c80bb9d41eeff4805c4f4df1c *man/WeldonDice.Rd 72e0e324020dbb52d40709c115b30ee4 *man/WomenQueue.Rd b3aa4469900034f4f6ee66d476eb4051 *man/agreementplot.Rd 5a289a29a60283572a6dc749b98c7c03 *man/assoc.Rd e245640865a0d036e5ed49dfc6b22af0 *man/assocstats.Rd 71e4c5635afca020ba5db75d21f7f31d *man/binregplot.Rd 78359b5cf62d25114f272820302e1db8 *man/cd_plot.Rd 09171e763dcdae39764a92d5359965e2 *man/co_table.Rd 8afcfa8a19bab4beb4d92faf331e9582 *man/coindep_test.Rd 3b862464e6f074b0144d51ca3f8bd69a *man/cotab_panel.Rd 5e7592fc356d06d64856881088272df2 *man/cotabplot.Rd a1a1bfe284f6aee41ae6a817dc9cfe76 *man/distplot.Rd feb661d6f2e2c1314caf80e32fbf6a6b *man/doubledecker.Rd b0568cd2e02a37d19c49192d2f3dc6d6 *man/fourfold.Rd 558a95508e38e92b2be107b82827549c *man/goodfit.Rd 24347c086dd30cecb12e4aacb1ec2079 *man/grid_barplot.Rd 6891014a51c9b278fe89225e9d251d49 *man/grid_legend.Rd f3084a15ca398a9835c9ba3eae26f773 *man/hls.Rd f9b406c3111ee9cacaa55124de6c9df8 *man/independence_table.Rd 6ef4c333cbbb2490cee751eb360de9e3 *man/labeling_border.Rd 926f10258bde9d18e8d5e9c869529958 *man/labeling_cells_list.Rd e2f34b28003d5375beeecd272f4f296e *man/legends.Rd 7904c410ad3e24822f9f0d78dbcd628c *man/loddsratio.Rd 6166d08f94e23cb571c4d655eeaa66cd *man/mar_table.Rd 5bcd25dfac84b456b1c45b1f789d512d *man/mosaic.Rd 081e08e1bba6835aa647e699797f72bf *man/mplot.Rd 5b30e9c4f588e42dae6a92ae1da78ab9 *man/pairs.table.Rd 60daf357b1adead635db07cf96569ff6 *man/panel_pairs_diagonal.Rd af824945edd4d7522002a2b87f6ba31b *man/panel_pairs_off-diagonal.Rd 4c633cc89825c87df9ff2f97792a7362 *man/plot.loddsratio.Rd cbba00f8e1c60c89aaa51780b8874db8 *man/plot.loglm.Rd c501827395d3d2d7f5e9146fc66df5d1 *man/rootogram.Rd 4d5595f8b7bb27e89aea41c8c7c1d18f *man/shadings.Rd 3ba77c66041d806fdb4aad0a87c6bb80 *man/sieve.Rd 6e12036047f9ee2619bad64902d7b562 *man/spacings.Rd 9475ef38895fac17d95f0f4b736c6d66 *man/spine.Rd ab10f191c4f54fcfefb7a24c4cdcea74 *man/struc_assoc.Rd cb38855539ead708697ccdbcf043abad *man/struc_mosaic.Rd acaab49c6ccd541b3d1a75383a544ef6 *man/struc_sieve.Rd a3a6de0cfbddae5539fb1b6f234b49c4 *man/strucplot.Rd 540cd565f07378f320e96801aa29bbcb *man/structable.Rd 46c27c579666ca1f114d556cbda0b638 *man/table2d_summary.Rd b054b4cdf8bb1655ffd536fb3651f21c *man/ternaryplot.Rd 4324403cb1c03a8f6c228828eefcc56e *man/tile.Rd bec04ba65f65e48db59acafdd14e3caf *man/woolf_test.Rd 60b5a25113c95aef01c2793f797d69aa *tests/demos.R 8195fb8aa41852a97a5784f036a80938 *vignettes/residual-shadings.Rnw 0f08ab21c366ba4d4204fae211e89104 *vignettes/struc.pdf fe22f0d95f4098096281d58c459928f9 *vignettes/struc.sxi 36cac2b2d77375961d3c9b940d83730c *vignettes/strucplot.Rnw 9139786f5ba08674cb3077e33b398683 *vignettes/vcd.bib vcd/build/0000755000175100001440000000000012547003156012146 5ustar hornikusersvcd/build/vignette.rds0000644000175100001440000000066712547003156014516 0ustar hornikusersSN1]\pKP|C !^ât L\[6䗃K Ixn{3sI \x1(Zq &M=1nEj5mԌMir;yL"O@9ȅ!]Ey*=>uhtA:RD` 2Äk2ƣ3llMk}f[qe&2nk;~= 2.4.0), grid Suggests: KernSmooth, mvtnorm, kernlab, HSAUR, coin Imports: stats, utils, MASS, grDevices, colorspace, lmtest License: GPL-2 NeedsCompilation: no Packaged: 2015-07-07 17:03:42 UTC; david Author: David Meyer [aut, cre], Achim Zeileis [aut], Kurt Hornik [aut], Florian Gerber [ctb], Michael Friendly [ctb] Maintainer: David Meyer Repository: CRAN Date/Publication: 2015-07-08 17:11:09 vcd/man/0000755000175100001440000000000012535320750011621 5ustar hornikusersvcd/man/structable.Rd0000755000175100001440000001223311563233643014270 0ustar hornikusers\name{structable} \alias{structable.default} \alias{structable.formula} \alias{structable} \alias{Extract.structable} \alias{aperm.structable} \alias{t.structable} \alias{is.structable} \alias{cbind.structable} \alias{rbind.structable} \alias{length.structable} \alias{is.na.structable} \alias{as.matrix.structable} \alias{as.vector.structable} \alias{dim.structable} \alias{dimnames.structable} \alias{as.table.structable} \title{Structured Contingency Tables} \description{ This function produces a \sQuote{flat} representation of a high-dimensional contingency table constructed by recursive splits (similar to the construction of mosaic displays). } \usage{ \method{structable}{formula}(formula, data, direction = NULL, split_vertical = NULL, \dots, subset, na.action) \method{structable}{default}(\dots, direction = NULL, split_vertical = FALSE) } \arguments{ \item{formula}{a formula object with possibly both left and right hand sides specifying the column and row variables of the flat table.} \item{data}{a data frame, list or environment containing the variables to be cross-tabulated, or an object inheriting from class \code{table}.} \item{subset}{an optional vector specifying a subset of observations to be used. Ignored if \code{data} is a contingency table.} \item{na.action}{a function which indicates what should happen when the data contain \code{NA}s. Ignored if \code{data} is a contingency table} \item{\dots}{\R objects which can be interpreted as factors (including character strings), or a list (or data frame) whose components can be so interpreted, or a contingency table object of class \code{"table"} or \code{"ftable"}.} \item{split_vertical}{logical vector indicating, for each dimension, whether it should be split vertically or not (default: \code{FALSE}). Values are recycled as needed. If the argument is of length 1, the value is alternated for all dimensions. Ignored if \code{direction} is provided.} \item{direction}{character vector alternatively specifying the splitting direction (\code{"h"} for horizontal and \code{"v"} for vertical splits). Values are recycled as needed. If the argument is of length 1, the value is alternated for all dimensions.} } \details{ This function produces textual representations of mosaic displays, and thus \sQuote{flat} contingency tables. The formula interface is quite similar to the one of \code{\link{ftable}}, but also accepts the \code{\link{mosaic}}-like formula interface (empty left-hand side). Note that even if the \code{\link{ftable}} interface is used, the \code{split_vertical} or \code{direction} argument is needed to specify the \emph{order} of the horizontal and vertical splits. If pretabulated data with a \code{Freq} column is used, than the left-hand side should be left empty---the \code{Freq} column will be handled correctly. \code{"structable"} objects can be subset using the \code{[} and \code{[[} operators, using either level indices or names (see examples). The corresponding replacement functions are available as well. In addition, appropriate \code{\link{aperm}}, \code{\link{cbind}}, \code{\link{rbind}}, \code{\link{length}}, \code{\link{dim}}, and \code{\link{is.na}} methods do exist. } \value{ An object of class \code{"structable"}, inheriting from class \code{"ftable"}, with the splitting information (\code{"split_vertical"}) as additional attribute. } \author{ David Meyer \email{David.Meyer@R-project.org} } \references{ Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. URL http://www.jstatsoft.org/v17/i03/ and available as \code{vignette("strucplot")}. } \seealso{ \code{\link{strucplot}}, \code{\link{mosaic}}, \code{\link[stats]{ftable}} } \examples{ structable(Titanic) structable(Titanic, split_vertical = c(TRUE, TRUE, FALSE, FALSE)) structable(Titanic, direction = c("h","h","v","v")) structable(Sex + Class ~ Survived + Age, data = Titanic) ## subsetting of structable objects (hec <- structable(aperm(HairEyeColor))) ## The "[" operator treats structables as a block-matrix and selects parts of the matrix: hec[1] hec[2] hec[1,c(2,4)] hec["Male",c("Blue","Green")] ## replacement funcion: tmp <- hec (tmp[1,2:3] <- tmp[2,c(1,4)]) ## In contrast, the "[[" operator treats structables as two-dimensional ## lists. Indexing conditions on specified levels and thus reduces the dimensionality: ## seek subtables conditioning on levels of the first dimension: hec[[1]] hec[[2]] ## Seek subtable from the first two dimensions, given the level "Male" ## of the first variable, and "Brown" from the second ## (the following two commands are equivalent): hec[["Male"]][["Brown"]] hec[[c("Male","Brown")]] ## Seeking subtables by conditioning on row and/or column variables: hec[["Male","Hazel"]] hec[[c("Male","Brown"),]] hec[[c("Male","Brown"),"Hazel"]] ## a few other operations t(hec) dim(hec) dimnames(hec) as.matrix(hec) length(hec) cbind(hec[,1],hec[,3]) as.vector(hec) ## computed on the _multiway_ table as.vector(unclass(hec)) } \keyword{hplot} vcd/man/mar_table.Rd0000755000175100001440000000057511150520606014042 0ustar hornikusers\name{mar_table} \alias{mar_table} \title{Table with Marginal Sums} \description{ Adds row and column sums to a two-way table. } \usage{ mar_table(x) } \arguments{ \item{x}{a two-way table.} } \value{ A table with row and column totals added. } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ data("SexualFun") mar_table(SexualFun) } \keyword{category} vcd/man/shadings.Rd0000644000175100001440000002560512535073450013722 0ustar hornikusers\name{shadings} \alias{shadings} \alias{shading_hsv} \alias{shading_hcl} \alias{shading_max} \alias{shading_Friendly} \alias{shading_Friendly2} \alias{shading_Marimekko} \alias{shading_diagonal} \alias{shading_sieve} \alias{shading_binary} \alias{hcl2hex} \encoding{UTF-8} \title{Shading-generating Functions for Residual-based Shadings} \description{ Shading-generating functions for computing residual-based shadings for mosaic and association plots. } \usage{ shading_hcl(observed, residuals = NULL, expected = NULL, df = NULL, h = NULL, c = NULL, l = NULL, interpolate = c(2, 4), lty = 1, eps = NULL, line_col = "black", p.value = NULL, level = 0.95, \dots) shading_hsv(observed, residuals = NULL, expected = NULL, df = NULL, h = c(2/3, 0), s = c(1, 0), v = c(1, 0.5), interpolate = c(2, 4), lty = 1, eps = NULL, line_col = "black", p.value = NULL, level = 0.95, \dots) shading_max(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = NULL, c = NULL, l = NULL, lty = 1, eps = NULL, line_col = "black", level = c(0.9, 0.99), n = 1000, \dots) shading_Friendly(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = c(2/3, 0), lty = 1:2, interpolate = c(2, 4), eps = 0.01, line_col = "black", \dots) shading_Friendly2(observed = NULL, residuals = NULL, expected = NULL, df = NULL, lty = 1:2, interpolate = c(2, 4), eps = 0.01, line_col = "black", \dots) shading_sieve(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = c(260, 0), lty = 1:2, interpolate = c(2, 4), eps = 0.01, line_col = "black", \dots) shading_binary(observed = NULL, residuals = NULL, expected = NULL, df = NULL, col = NULL) shading_Marimekko(x, fill = NULL, byrow = FALSE) shading_diagonal(x, fill = NULL) hcl2hex(h = 0, c = 35, l = 85, fixup = TRUE) } \arguments{ \item{observed}{contingency table of observed values} \item{residuals}{contingency table of residuals} \item{expected}{contingency table of expected values} \item{df}{degrees of freedom of the associated independence model.} \item{h}{hue value in the HCL or HSV color description, has to be in [0, 360] for HCL and in [0, 1] for HSV colors. The default is to use blue and red for positive and negative residuals respectively. In the HCL specification it is \code{c(260, 0)} by default and for HSV \code{c(2/3, 0)}.} \item{c}{chroma value in the HCL color description. This controls the maximum chroma for significant and non-significant results respectively and defaults to \code{c(100, 20)}.} \item{l}{luminance value in the HCL color description. Defaults to \code{c(90, 50)} for small and large residuals respectively.} \item{s}{saturation value in the HSV color description. Defaults to \code{c(1, 0)} for large and small residuals respectively.} \item{v}{saturation value in the HSV color description. Defaults to \code{c(1, 0.5)} for significant and non-significant results respectively.} \item{interpolate}{a specification for mapping the absolute size of the residuals to a value in [0, 1]. This can be either a function or a numeric vector. In the latter case, a step function with steps of equal size going from 0 to 1 is used.} \item{lty}{a vector of two line types for positive and negative residuals respectively. Recycled if necessary.} \item{eps}{numeric tolerance value below which absolute residuals are considered to be zero, which is used for coding the border color and line type. If set to \code{NULL} (default), all borders have the default color specified by \code{line\_col}. If set to a numeric value, all border colors corresponding to residuals with a larger absolute value are set to the full positive or negative color, respectively; borders corresponding to smaller residuals are are drawn with \code{line\_col} and \code{lty[1]}}. This is used principally in \code{shading\_Friendly}. \item{line_col}{default border color (for \code{shading_sieve}: default sieve color).} \item{p.value}{the \eqn{p} value associated with the independence model. By default, this is computed from a Chi-squared distribution with \code{df} degrees of freedom. \code{p.value} can be either a scalar or a \code{function(observed, residuals, expected, df)} that computes the \eqn{p} value from the data. If set to \code{NA} no inference is performed.} \item{level}{confidence level of the test used. If \code{p.value} is smaller than \code{1 - level}, bright colors are used, otherwise dark colors are employed. For \code{shading_max} a vector of levels can be supplied. The corresponding critical values are then used as \code{interpolate} cut-offs.} \item{n}{number of permutations used in the call to \code{coindep_test}.} \item{col}{a vector of two colors for positive and negative residuals respectively.} \item{fixup}{logical. Should the color be corrected to a valid RGB value before correction?} \item{x}{object of class \code{table} used to determine the dimension.} \item{fill}{Either a character vector of color codes, or a palette function that generates such a vector. Defaults to \code{\link[colorspace]{rainbow_hcl}}} \item{byrow}{logical; shall tiles be filled by row or by column?} \item{\dots}{Other arguments passed to \code{\link{hcl2hex}} or \code{\link{hsv}}, respectively.} } \details{ These shading-generating functions can be passed to \code{strucplot} to generate residual-based shadings for contingency tables. \code{strucplot} calls these functions with the arguments \code{observed}, \code{residuals}, \code{expected}, \code{df} which give the observed values, residuals, expected values and associated degrees of freedom for a particular contingency table and associated independence model. The shadings \code{shading_hcl} and \code{shading_hsv} do the same thing conceptually, but use HCL or HSV colors respectively. The former is usually preferred because they are perceptually based. Both shadings visualize the \emph{sign} of the residuals of an independence model using two hues (by default: blue and red). The \emph{absolute size} of the residuals is visualized by the colorfulness and the amount of grey, by default in three categories: very colorful for large residuals (> 4), less colorful for medium sized residuals (< 4 and > 2), grey/white for small residuals (< 2). More categories or a continuous scale can be specified by setting \code{interpolate}. Furthermore, the result of a significance test can be visualized by the amount of grey in the colors. If significant, a colorful palette is used, if not, the amount of color is reduced. See Zeileis, Meyer, and Hornik (2007) and \code{\link[colorspace]{diverge_hcl}} for more details. The shading \code{shading_max} is applicable in 2-way contingency tables and uses a similar strategy as \code{shading_hcl}. But instead of using the cut-offs 2 and 4, it employs the critical values for the maximum statistic (by default at 90\% and 99\%). Consequently, color in the plot signals a significant result at 90\% or 99\% significance level, respectively. The test is carried out by calling \code{\link{coindep_test}}. The shading \code{shading_Friendly} is very similar to \code{shading_hsv}, but additionally codes the sign of the residuals by different line types. See Friendly (1994) for more details. \code{shading_Friendly2} and \code{shading_sieve} are similar, but use HCL colors. The shading \code{shading_binary} just visualizes the sign of the residuals by using two different colors (default: blue HCL(260, 50, 70) and red HCL(0, 50, 70)). \code{shading_Marimekko} is a simple generating function for producing, in conjunction with \code{\link{mosaic}}, so-called \emph{Marimekko-charts}, which paint the tiles of each columns of a mosaic display in the same color to better display departures from independence. \code{shading_diagonal} generates a color shading for basically square matrices (or arrays having the first two dimensons of same length) visualizing the diagonal cells, and the off-diagonal cells 1, 2, \dots steps removed. The color implementations employed are \code{\link{hsv}} from base R and \code{\link[colorspace]{polarLUV}} from the \pkg{colorspace} package, respectively. To transform the HCL coordinates to a hexadecimal color string (as returned by \code{hsv}), the function \code{\link[colorspace]{hex}} is employed. A convenience wrapper \code{hcl2hex} is provided. } \references{ Friendly M. (1994), Mosaic Displays for Multi-Way Contingency Tables. \emph{Journal of the American Statistical Association}, \bold{89}, 190--200. Meyer D., Zeileis A., and Hornik K. (2006), The Strucplot Framework: Visualizing Multi-Way Contingency Tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17}(3), 1--48. URL http://www.jstatsoft.org/v17/i03/. See also \code{vignette("strucplot", package = "vcd")}. Zeileis A., Meyer D., Hornik K. (2007), Residual-Based Shadings for Visualizing (Conditional) Independence. \emph{Journal of Computational and Graphical Statistics}, \bold{16}, 507--525. Zeileis A., Hornik K. and Murrell P. (2008), Escaping RGBland: Selecting Colors for Statistical Graphics. \emph{Computational Statistics & Data Analysis}, Forthcoming. Preprint available from \url{http://statmath.wu-wien.ac.at/~zeileis/papers/Zeileis+Hornik+Murrell-2009.pdf}. } \value{A shading function which takes only a single argument, interpreted as a vector/table of residuals, and returns a \code{"gpar"} object with the corresponding vector(s)/table(s) of graphical parameter(s). } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \seealso{ \code{\link[colorspace]{hex}}, \code{\link[colorspace]{polarLUV}}, \code{\link{hsv}}, \code{\link{mosaic}}, \code{\link{assoc}}, \code{\link{strucplot}}, \code{\link[colorspace]{diverge_hcl}} } \examples{ ## load Arthritis data data("Arthritis") art <- xtabs(~Treatment + Improved, data = Arthritis) ## plain mosaic display without shading mosaic(art) ## with shading for independence model mosaic(art, shade = TRUE) ## which uses the HCL shading mosaic(art, gp = shading_hcl) ## the residuals are too small to have color, ## hence the cut-offs can be modified mosaic(art, gp = shading_hcl, gp_args = list(interpolate = c(1, 1.8))) ## the same with the Friendly palette ## (without significance testing) mosaic(art, gp = shading_Friendly, gp_args = list(interpolate = c(1, 1.8))) ## assess independence using the maximum statistic ## cut-offs are now critical values for the test statistic mosaic(art, gp = shading_max) ## association plot with shading as in base R assoc(art, gp = shading_binary(col = c(1, 2))) ## Marimekko Chart hec <- margin.table(HairEyeColor, 1:2) mosaic(hec, gp = shading_Marimekko(hec)) mosaic(HairEyeColor, gp = shading_Marimekko(HairEyeColor)) ## Diagonal cells shading ac <- xtabs(VisualAcuity) mosaic(ac, gp = shading_diagonal(ac)) } \keyword{hplot} vcd/man/hls.Rd0000755000175100001440000000132111150520606012670 0ustar hornikusers\name{hls} \alias{hls} \title{HLS Color Specification} \description{ Create a HLS color from specifying hue, luminance and saturation. } \usage{ hls(h = 1, l = 0.5, s = 1) } \arguments{ \item{h}{hue value in [0, 1].} \item{l}{luminance value in [0, 1].} \item{s}{saturation value in [0, 1].} } \details{ HLS colors are a similar specification of colors as HSV colors, but using hue/luminance/saturation rather that hue/saturation/value. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \seealso{ \code{\link{hsv}}, \code{\link{hcl2hex}}, \code{\link[colorspace]{polarLUV}} } \examples{ ## an HLS color wheel pie(rep(1, 12), col = sapply(1:12/12, function(x) hls(x))) } \keyword{hplot} vcd/man/struc_assoc.Rd0000655000175100001440000000756212532005563014453 0ustar hornikusers\name{struc_assoc} \alias{struc_assoc} \title{Core-generating Function for Association Plots} \description{ Core-generating function for \code{strucplot} returning a function producing association plots. } \usage{ struc_assoc(compress = TRUE, xlim = NULL, ylim = NULL, yspace = unit(0.5, "lines"), xscale = 0.9, gp_axis = gpar(lty = 3)) } \arguments{ \item{compress}{logical; if \code{FALSE}, the space between the rows (columns) are chosen such that the \emph{total} heights (widths) of the rows (column) are all equal. If \code{TRUE}, the space between the rows and columns is fixed and hence the plot is more \dQuote{compressed}.} \item{xlim}{either a \eqn{2 \times k}{2 x k} matrix of doubles, \eqn{k} the number of total columns of the plot, or a recycled vector from which such a matrix will be constructed. The columns of \code{xlim} correspond to the columns of the association plot, the rows describe the column ranges (minimums in the first row, maximums in the second row). If \code{xlim} is \code{NULL}, the ranges are determined from the residuals according to \code{compress} (if \code{TRUE}: widest range from each column, if \code{FALSE}: from the whole association plot matrix).} \item{ylim}{either a \eqn{2 \times k}{2 x k} matrix of doubles, \eqn{k} the number of total rows of the plot, or a recycled vector from which such a matrix will be constructed. The columns of \code{ylim} correspond to the rows of the association plot, the rows describe the column ranges (minimums in the first row, maximums in the second row). If \code{ylim} is \code{NULL}, the ranges are determined from the residuals according to \code{compress} (if \code{TRUE}: widest range from each row, if \code{FALSE}: from the whole association plot matrix).} \item{xscale}{scale factor resizing the tile's width, thus adding additional space between the tiles. } \item{yspace}{object of class \code{"unit"} specifying additional space separating the rows.} \item{gp_axis}{object of class \code{"gpar"} specifying the visual aspects of the tiles' baseline.} } \details{ This function is usually called by \code{strucplot} (typically when called by \code{assoc}) and returns a function used by \code{strucplot} to produce association plots. } \value{ A function with arguments: \item{residuals}{table of residuals.} \item{observed}{not used by \code{struc_assoc}.} \item{expected}{table of expected frequencies.} \item{spacing}{object of class \code{"unit"} specifying the space between the tiles.} \item{gp}{list of \code{gpar} objects used for the drawing the tiles.} \item{split_vertical}{vector of logicals indicating, for each dimension of the table, the split direction.} } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{assoc}}, \code{\link{strucplot}}, \code{\link{structable}} } \references{ Cohen, A. (1980), On the graphical display of the significant components in a two-way contingency table. \emph{Communications in Statistics---Theory and Methods}, \bold{A9}, 1025--1041. Friendly, M. (1992), Graphical methods for categorical data. \emph{SAS User Group International Conference Proceedings}, \bold{17}, 190--200. \url{http://datavis.ca/papers/sugi/sugi17.pdf} Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. URL http://www.jstatsoft.org/v17/i03/ and available as \code{vignette("strucplot")}. } \examples{ ## UCB Admissions data("UCBAdmissions") ucb <- aperm(UCBAdmissions) ## association plot for conditional independence strucplot(ucb, expected = ~ Dept * (Admit + Gender), core = struc_assoc(ylim = c(-4, 4)), labeling_args = list(abbreviate = c(Admit = 3))) } \keyword{hplot} vcd/man/binregplot.Rd0000644000175100001440000002230512535260710014256 0ustar hornikusers\name{binreg_plot} \alias{binreg_plot} \alias{grid_abline} \title{Binary Regression Plot} \description{ Creates a display of observed and fitted values for a binary regression model with one numeric predictor, conditioned by zero or many co-factors. } \usage{ binreg_plot(model, main = NULL, xlab = NULL, ylab = NULL, xlim = NULL, ylim = NULL, pred_var = NULL, pred_range = c("data", "xlim"), group_vars = NULL, base_level = NULL, subset, type = c("response", "link"), conf_level = 0.95, delta = FALSE, pch = NULL, cex = 0.6, jitter_factor = 0.1, lwd = 5, lty = 1, point_size = 0, col_lines = NULL, col_bands = NULL, legend = TRUE, legend_pos = NULL, legend_inset = c(0, 0.1), legend_vgap = unit(0.5, "lines"), labels = FALSE, labels_pos = c("right", "left"), labels_just = c("left","center"), labels_offset = c(0.01, 0), gp_main = gpar(fontface = "bold", fontsize = 14), gp_legend_frame = gpar(lwd = 1, col = "black"), gp_legend_title = gpar(fontface = "bold"), newpage = TRUE, pop = FALSE, return_grob = FALSE) grid_abline(a, b, \dots) } \arguments{ \item{model}{a binary regression model fitted with \code{\link[stats]{glm}}.} \item{main}{user-specified main title.} \item{xlab}{x-axis label. Defaults to the name of the (first) numeric predictor.} \item{ylab}{y-axis label. Defaults to the name of the response - within either 'P(...)' or 'logit(...)', depending on the response type.} \item{xlim}{Range of the x-axis. Defaults to the range of the numeric predictor.} \item{ylim}{Range of the y-axis. Defaults to the unit interval on probability scale or the fitted values range on the link scale, depending on \code{type}.} \item{pred_var}{character string of length 1 giving the name of the numeric predictor. Defaults to the first one found in the data set.} \item{pred_range}{\code{"data"}, \code{"xlim"}, or a numeric vector. If \code{"data"}, the numeric predictor corresponds to the observed values. If \code{"xlim"}, 100 values are taken from the \code{"xlim"} range. A numeric vector will be interpreted as the values to be predicted.} \item{group_vars}{optional character string of conditioning variables. Defaults to all factors found in the data set, response excluded. If \code{FALSE}, no variables are used for conditioning.} \item{base_level}{vector of length one. If the response is a vector, this specifies the base ('no effect') value of the response variable (e.g., "Placebo", 0, FALSE, etc.) and defaults to the first level for factor responses, or 0 for numeric/binary variables. This controls which observations will be plotted on the top or the bottom of the display. If the response is a matrix with success and failure column, this specifies the one to be interpreted as failure (default: 2), either as an integer, or as a string (\code{"success"} or \code{"failure"}). The proportions of \emph{successes} will be plotted as observed values.} \item{subset}{an optional vector specifying a subset of the data rows. The value is evaluated in the data environment, so expressions can be used to select the data (see examples).} \item{type}{either "response" or "link" to select the scale of the fitted values. The y-axis will be adapted accordingly.} \item{conf_level}{confidence level used for calculating confidence bands.} \item{delta}{logical; indicates whether the delta method should be employed for calculating the limits of the confidence band or not (see details).} \item{pch}{character or numeric vector of symbols used for plotting the (possibly conditioned) observed values, recycled as needed.} \item{cex}{size of the plot symbols (in lines).} \item{jitter_factor}{argument passed to \code{\link[base]{jitter}} used for the points representing the observed values.} \item{lwd}{Line width for the fitted values.} \item{lty}{Line type for the fitted values.} \item{point_size}{size of points for the fitted values in char units (default: 0, so no points are plotted).} \item{col_lines, col_bands}{character vector specifying the colors of the fitted lines and confidence bands, by default chosen with \code{\link[colorspace]{rainbow_hcl}}. The confidence bands are using alpha blending with alpha = 0.2.} \item{legend}{logical; if \code{TRUE} (default), a legend is drawn.} \item{legend_pos}{numeric vector of length 2, specifying x and y coordinates of the legend, or a character string (e.g., \code{"topleft"}, \code{"center"} etc.). Defaults to \code{"topleft"} if the fitted curve's slope is positive, and \code{"topright"} else.} \item{legend_inset}{numeric vector or length 2 specifying the inset from the legend's x and y coordinates in npc units.} \item{legend_vgap}{vertical space between the legend's line entries.} \item{labels}{logical; if \code{TRUE}, labels corresponding to the factor levels are plotted next to the fitted lines.} \item{labels_pos}{either \code{"right"} or \code{"left"}, determining on which side of the fitted lines (start or end) the labels should be placed.} \item{labels_just}{character vector of length 2, specifying the relative justification of the labels to their coordinates. See the documentation of the \code{just} parameter of \code{\link[grid]{grid.text}} for more details.} \item{labels_offset}{numeric vector of length 2, specifying the offset of the labels' coordinates in npc units.} \item{gp_main}{object of class \code{"gpar"} used for the main title.} \item{gp_legend_frame}{object of class \code{"gpar"} used for the legend frame.} \item{gp_legend_title}{object of class \code{"gpar"} used for the legend title.} \item{newpage}{logical; if \code{TRUE}, the plot is drawn on a new page.} \item{pop}{logical; if \code{TRUE}, all newly generated viewports are popped after plotting.} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{a}{intercept; alternatively, a regression model from which coefficients can be extracted via \code{\link[stats]{coef}}.} \item{b}{slope.} \item{\dots}{Further arguments passed to \code{\link[grid]{grid.abline}}.} } \details{ The primary purpose of \code{binreg_plot()} is to visualize observed and fitted values for binary regression models (like the logistic or probit regression model) with one numeric predictor. If one or more categorical predictors are used in the model, the \emph{fitted} values are conditioned on them, i.e. separate curves are drawn corresponding to the factor level combinations. Thus, it shows a \emph{full-model plot}, not a conditional plot where several models would be fit to data subsets. The implementation relies on objects returned by \code{\link[stats]{glm}}, as it uses its \code{"terms"} and \code{"model"} components. The function tries to determine suitable values for the legend and/or labels, but depending on the data, this might require some tweaking. By default, the limits of the confidence band are determined for the linear predictor (i.e., on the link scale) and transformed to response scale (if this is the chosen plot type) using the inverse link function. If \code{delta} is \code{TRUE}, the limits are determined on the response scale. Note that the resulting band using the delta method is symmetric around the fitted mean, but may exceed the unit interval (on the response scale) and will be cut off. \code{grid_abline()} is a simple convenience wrapper for \code{\link[grid]{grid.abline}} with similar behavior than \code{\link[graphics]{abline}} in that it extracts coefficients from a regression model, if given instead of the intercept \code{a}. } \value{ if \code{return_grob} is \code{TRUE}, a grob object corresponding to the plot. \code{NULL} (invisibly) else. } \references{ Michael Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ ## Simple model with no conditioning variables art.mod0 <- glm(Improved > "None" ~ Age, data = Arthritis, family = binomial) binreg_plot(art.mod0, "Arthritis Data") binreg_plot(art.mod0, type = "link") ## logit scale ## one conditioning factor art.mod1 <- update(art.mod0, . ~ . + Sex) binreg_plot(art.mod1) binreg_plot(art.mod1, legend = FALSE, labels = TRUE, xlim = c(20, 80)) ## two conditioning factors art.mod2 <- update(art.mod1, . ~ . + Treatment) binreg_plot(art.mod2) binreg_plot(art.mod2, subset = Sex == "Male") ## subsetting ## some tweaking binreg_plot(art.mod2, gp_legend_frame = gpar(col = NA, fill = "white"), col_bands = NA) binreg_plot(art.mod2, legend = FALSE, labels = TRUE, labels_pos = "left", labels_just = c("left", "top")) ## model with grouped response data shuttle.mod <- glm(cbind(nFailures, 6 - nFailures) ~ Temperature, data = SpaceShuttle, na.action = na.exclude, family = binomial) binreg_plot(shuttle.mod, xlim = c(30, 81), pred_range = "xlim", ylab = "O-Ring Failure Probability", xlab = "Temperature (F)") } \keyword{category} \keyword{hplot} vcd/man/CoalMiners.Rd0000644000175100001440000000420312475151437014152 0ustar hornikusers\name{CoalMiners} \alias{CoalMiners} \title{Breathlessness and Wheeze in Coal Miners} \description{ Data from Ashford & Sowden (1970) given by Agresti (1990) on the association between two pulmonary conditions, breathlessness and wheeze, in a large sample of coal miners who were smokers with no radiological evidence of pneumoconlosis, aged between 20--64 when examined. This data is frequently used as an example of fitting models for bivariate, binary responses. } \usage{ data("CoalMiners") } \format{ A 3-dimensional table of size 2 x 2 x 9 resulting from cross-tabulating variables for 18,282 coal miners. The variables and their levels are as follows: \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab Breathlessness \tab B, NoB \cr 2 \tab Wheeze \tab W, NoW \cr 3 \tab Age \tab 20-24, 25-29, 30-34, \dots, 60-64 } } \details{ In an earlier version of this data set, the first group, aged 20-24, was inadvertently omitted from this data table and the breathlessness variable was called wheeze and vice versa. } \references{ A. Agresti (1990), \emph{Categorical Data Analysis}. Wiley-Interscience, New York, Table 7.11, p. 237 J. R. Ashford and R. D. Sowdon (1970), Multivariate probit analysis, \emph{Biometrics}, \bold{26}, 535--546. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data, pages 82--83, 319--322. } \examples{ data("CoalMiners") ftable(CoalMiners, row.vars = 3) ## Fourfold display, both margins equated fourfold(CoalMiners[,,2:9], mfcol = c(2,4)) ## Fourfold display, strata equated fourfold(CoalMiners[,,2:9], std = "ind.max", mfcol = c(2,4)) ## Log Odds Ratio Plot lor_CM <- loddsratio(CoalMiners) summary(lor_CM) plot(lor_CM) lor_CM_df <- as.data.frame(lor_CM) # fit linear models using WLS age <- seq(20, 60, by = 5) lmod <- lm(LOR ~ age, weights = 1 / ASE^2, data = lor_CM_df) grid.lines(age, fitted(lmod), gp = gpar(col = "blue")) qmod <- lm(LOR ~ poly(age, 2), weights = 1 / ASE^2, data = lor_CM_df) grid.lines(age, fitted(qmod), gp = gpar(col = "red")) } \keyword{datasets} vcd/man/PreSex.Rd0000755000175100001440000000347011150520606013317 0ustar hornikusers\name{PreSex} \alias{PreSex} \docType{data} \title{Pre-marital Sex and Divorce} \description{ Data from Thornes \& Collard (1979), reported in Gilbert (1981), on pre- and extra-marital sex and divorce. } \usage{ data("PreSex") } \format{ A 4-dimensional array resulting from cross-tabulating 1036 observations on 4 variables. The variables and their levels are as follows: \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab MaritalStatus \tab Divorced, Married \cr 2 \tab ExtramaritalSex \tab Yes, No \cr 3 \tab PremaritalSex \tab Yes, No \cr 4 \tab Gender \tab Women, Men } } \references{ G. N. Gilbert (1981), \emph{Modelling Society: An Introduction to Loglinear Analysis for Social Researchers}. Allen and Unwin, London. B. Thornes \& J. Collard (1979), \emph{Who Divorces?}. Routledge \& Kegan, London. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data: \url{http://euclid.psych.yorku.ca/ftp/sas/vcd/catdata/marital.sas} } \examples{ data("PreSex") ## Mosaic display for Gender and Premarital Sexual Experience ## (Gender Pre) mosaic(margin.table(PreSex, c(3,4)), main = "Gender and Premarital Sex") ## (Gender Pre)(Extra) mosaic(margin.table(PreSex, c(2,3,4)), expected = ~Gender * PremaritalSex + ExtramaritalSex , main = "PreMaritalSex*Gender +Sex") ## (Gender Pre Extra)(Marital) mosaic(PreSex, expected = ~Gender*PremaritalSex*ExtramaritalSex + MaritalStatus, main = "PreMarital*ExtraMarital + MaritalStatus") ## (GPE)(PEM) mosaic(PreSex, expected = ~ Gender * PremaritalSex * ExtramaritalSex + MaritalStatus * PremaritalSex * ExtramaritalSex, main = "G*P*E + P*E*M") } \keyword{datasets} vcd/man/Rochdale.Rd0000755000175100001440000000233011150520606013624 0ustar hornikusers\name{Rochdale} \alias{Rochdale} \docType{data} \title{Rochdale Data} \description{ Information on 665 households of Rochdale, Lancashire, UK. The study was conducted to identify influence factors on economical activity of wives. } \usage{ data("Rochdale") } \format{ A 8-dimensional array resulting from cross-tabulating 665 observations on 8 variables. The variables and their levels are as follows: \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab EconActive \tab yes, no \cr 2 \tab Age \tab <38, >38 \cr 3 \tab HusbandEmployed \tab yes, no \cr 4 \tab Child \tab yes, no \cr 5 \tab Education \tab yes, no \cr 6 \tab HusbandEducation \tab yes, no \cr 7 \tab Asian \tab yes, no \cr 8 \tab HouseholdWorking \tab yes, no \cr } } \note{ Many observations are missing: only 91 out of all 256 combinations contain information. } \source{ Whittaker (1990). } \references{ H. Hofmann (2003). Constructing and reading mosaicplots. \emph{Computational Statistics & Data Analysis}, \bold{43}, 4, 565--580. J. Whittaker (1990), \emph{Graphical Models on Applied Multivariate Statistics}, Wiley, New York. } \examples{ data("Rochdale") mosaic(Rochdale) } \keyword{datasets} vcd/man/Federalist.Rd0000755000175100001440000000204311150520606014166 0ustar hornikusers\name{Federalist} \alias{Federalist} \docType{data} \title{`May' in Federalist Papers} \description{ Data from Mosteller & Wallace (1984) investigating the use of certain keywords (\sQuote{may} in this data set) to identify the author of 12 disputed \sQuote{Federalist Papers} by Alexander Hamilton, John Jay and James Madison. } \usage{ data("Federalist") } \format{ A 1-way table giving the number of occurrences of \sQuote{may} in 262 blocks of text. The variable and its levels are \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab nMay \tab 0, 1, \dots, 6 \cr } } \references{ F. Mosteller & D. L. Wallace (1984), \emph{Applied Bayesian and Classical Inference: The Case of the Federalist Papers}. Springer-Verlag, New York, NY. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data, page 19. } \examples{ data("Federalist") gf <- goodfit(Federalist, type = "nbinomial") summary(gf) plot(gf) } \keyword{datasets} vcd/man/grid_legend.Rd0000644000175100001440000001164212535260461014361 0ustar hornikusers\name{grid_legend} \alias{grid_legend} \title{Legend Function for grid Graphics} \description{ This function can be used to add legends to \emph{grid-based} plots. } \usage{ grid_legend(x, y, pch = NA, col = par('col'), labels, frame = TRUE, hgap = unit(0.8, "lines"), vgap = unit(0.8, "lines"), default_units = "lines", gp = gpar(), draw = TRUE, title = NULL, just = 'center', lwd = NA, lty = NA, size = 1, gp_title = NULL, gp_labels = NULL, gp_frame = gpar(fill = "transparent"), inset = c(0, 0)) } \arguments{ \item{x}{character string \code{"topright"}, \code{"topleft"}, \code{"bottomright"}, \code{"bottomleft"}, \code{"top"}, \code{"bottom"}, \code{"left"}, \code{"right"}, \code{"center"} or x coordinate of the legend.} \item{y}{y coordinates of the legend.} \item{pch}{integer vector of plotting symbols, if any.} \item{col}{character vector of colors for the symbols.} \item{labels}{character vector of labels corresponding to the symbols.} \item{frame}{logical indicating whether the legend should have a border or not.} \item{hgap}{object of class \code{"unit"} specifying the space between symbols and labels.} \item{vgap}{object of class \code{"unit"} specifying the space between the lines.} \item{default_units}{character string indicating the default unit.} \item{gp}{object of class \code{"gpar"} used for the legend.} \item{draw}{logical indicating whether the legend be drawn or not.} \item{title}{character string indicating the plot's title.} \item{just}{justification of the legend relative to its (x, y) location. see ?viewport for more details.} \item{lwd}{positive number to set the line width. if specified lines are drawn.} \item{lty}{line type. if specified lines are drawn.} \item{size}{size of the group symbols (in char units).} \item{gp_title}{object of class \code{"gpar"} used for the title.} \item{gp_labels}{object of class \code{"gpar"} used for the labels.} \item{gp_frame}{object of class \code{"gpar"} used for the frame.} \item{inset}{numeric vector of length 2 specifying the inset of the legend in npc units, relative to the specified x and y coordinates.} } \value{ Invisibly, the legend as a \code{"grob"} object. } \author{ David Meyer \email{David.Meyer@R-project.org} Florian Gerber \email{florian.gerber@math.uzh.ch} } \seealso{ \code{\link[graphics]{legend}} } \examples{ data("Lifeboats") attach(Lifeboats) ternaryplot(Lifeboats[,4:6], pch = ifelse(side == "Port", 1, 19), col = ifelse(side == "Port", "red", "blue"), id = ifelse(men / total > 0.1, as.character(boat), NA), prop_size = 2, dimnames_position = "edge", main = "Lifeboats on Titanic") grid_legend(0.8, 0.9, c(1, 19), c("red", "blue"), c("Port", "Starboard"), title = "SIDE") grid.newpage() pushViewport(viewport(height = .9, width = .9 )) grid.rect(gp = gpar(lwd = 2, lty = 2)) grid_legend(x = unit(.05,'npc'), y = unit(.05,'npc'), just = c(0,0), pch = c(1,2,3), col = c(1,2,3), lwd=NA, lty=NA, labels = c("b",'r','g'), title = NULL, gp=gpar(lwd=2, cex=1), hgap = unit(.8, "lines"), vgap = unit(.9, "lines")) grid_legend(x = unit(1,'npc'), y = unit(1,'npc'), just = c(1,1), pch = NA, col = c(1,2,3,4), lwd=c(1,1,1,3), lty=c(1,2,1,3), labels = c("black",'red','green','blue'), gp_labels = list(gpar(col = 1), gpar(col = 2), gpar(col = 3), gpar(col = 4)), title = NULL, gp=gpar(lwd=2, cex=1), hgap = unit(.8, "lines"), vgap = unit(.9, "lines")) grid_legend(x = 'topleft', pch = c(1,NA,2,NA), col = c(1,2,3,4), lwd=NA, lty=c(NA,2,NA,3), labels = c("black",'red','green','blue'), title = 'Some LONG Title', gp_title = gpar(col = 3), gp_frame = gpar(col = 4, lty = 2, fill = "transparent"), gp_labels = gpar(col = 6), gp=gpar(lwd=2, cex=2, col = 1), hgap = unit(.8, "lines"), vgap = unit(.9, "lines")) grid_legend(x = .7, y = .7, pch = c(1,NA,2,NA), col = c(1,2,3,4), lwd=1, lty=c(NA,2,NA,3), labels = c("black",'red','green','blue'), title = 'short T', gp=gpar(lwd=1, cex=.7,col = 1), hgap = unit(.8, "lines"), vgap = unit(.9, "lines")) grid_legend(x = 'bottomright', pch = c(1,NA,2,NA), col = c(2), lwd=NA, lty=c(NA,2,NA,3), labels = c("black",'red','green','blue'), title = NULL, gp=gpar(lwd=2, cex=1,col = 1), hgap = unit(.8, "lines"), vgap = unit(.9, "lines")) } \keyword{hplot} vcd/man/mplot.Rd0000644000175100001440000000404112535317335013247 0ustar hornikusers\name{mplot} \alias{mplot} \title{Multiple Grid plots} \description{ combines severals grid-based plots in a multi-panel-layout. } \usage{ mplot(..., .list = list(), layout = NULL, cex = NULL, main = NULL, gp_main = gpar(fontsize = 20), sub = NULL, gp_sub = gpar(fontsize = 15), keep_aspect_ratio = TRUE) } \arguments{ \item{\dots, .list}{A list of objects inheriting from class \code{"grob"}, or having a \code{"grob"} attribute containing such an object.} \item{layout}{integer vector of length 2 giving the number of rows and columns. If \code{NULL}, the values will be guessed using some heuristics from the number of objects supplied in \dots.} \item{cex}{Scaling factor for the fonts in the subplots. If \code{NULL}, the value is calculated as the inverse square root of the row number.} \item{main, sub}{Optional main and sub title, respectively.} \item{gp_main, gp_sub}{Optional objects of class \code{"gpar"} specifying the graphical parameters for the main and sub title, respectively.} \item{keep_aspect_ratio}{logical; should the aspect ratio of the plots be fixed?} } \value{ None. } \details{ This is a convenience function for producing multi-panel plots from grid-based displays, especially those produced by the vcd methods. The layout (number of rows and columns) is guessed from the amount of supplied objects, if not supplied. Currently, the vcd plotting functions do not return grob objects by default---this might change in the future. Also, some of them will return the grob object as a \code{"grob"} attribute, attached to the currently returned object. } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ mplot(mosaic(Titanic, return_grob = TRUE), assoc(Titanic), return_grob = TRUE) A = mosaic(Titanic, return_grob = TRUE) B = mosaic(Titanic, type = "expected", return_grob = TRUE) mplot(A, B) mplot(sieve(SexualFun, return_grob = TRUE), agreementplot(SexualFun, return_grob = TRUE), main = "Sexual Fun") mplot(A, grid.circle()) }vcd/man/panel_pairs_off-diagonal.Rd0000655000175100001440000000464512532005527017025 0ustar hornikusers\name{Pairs plot panel functions for off-diagonal cells} \alias{pairs_strucplot} \alias{pairs_mosaic} \alias{pairs_assoc} \alias{pairs_sieve} \title{Off-diagonal Panel Functions for Table Pairs Plot} \description{ Off-diagonal panel functions for \code{\link{pairs.table}}. } \usage{ pairs_strucplot(panel = mosaic, type = c("pairwise", "total", "conditional", "joint"), legend = FALSE, margins = c(0, 0, 0, 0), labeling = NULL, \dots) pairs_assoc(\dots) pairs_mosaic(\dots) pairs_sieve(\dots) } \arguments{ \item{panel}{function to be used for the plots in each cell, such as \code{\link{pairs_assoc}}, \code{\link{pairs_mosaic}}, and \code{\link{pairs_sieve}}.} \item{type}{character string specifying the type of independence model visualized in the cells.} \item{legend}{logical specifying whether a legend should be displayed in the cells or not.} \item{margins}{margins inside each cell (see \code{\link{strucplot}}).} \item{labeling}{labeling function or labeling-generating function (see \code{\link{strucplot}}).} \item{\dots}{\code{pairs_mosaic}, \code{\link{pairs_assoc}}, and \code{pairs_sieve}: parameters passed to \code{pairs_strucplot}. \code{pairs_strucplot}: other parameters passed to panel function.} } \details{ These functions really just wrap \code{\link{assoc}}, \code{\link{sieve}}, and \code{\link{mosaic}} by basically inhibiting labeling and legend-drawing and setting the margins to 0. } \value{ A function with arguments: \item{x}{contingency table.} \item{i, j}{cell coordinates.} } \seealso{ \code{\link{pairs.table}}, \code{\link{pairs_text}}, \code{\link{pairs_barplot}}, \code{\link{assoc}}, \code{\link{mosaic}} } \references{ Cohen, A. (1980), On the graphical display of the significant components in a two-way contingency table. \emph{Communications in Statistics---Theory and Methods}, \bold{A9}, 1025--1041. Friendly, M. (1992), Graphical methods for categorical data. \emph{SAS User Group International Conference Proceedings}, \bold{17}, 190--200. \url{http://datavis.ca/papers/sugi/sugi17.pdf} } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ data("UCBAdmissions") data("PreSex") pairs(PreSex) pairs(UCBAdmissions) pairs(UCBAdmissions, upper_panel_args = list(shade = FALSE)) pairs(UCBAdmissions, lower_panel = pairs_mosaic(type = "conditional")) pairs(UCBAdmissions, upper_panel = pairs_assoc) } \keyword{hplot} vcd/man/rootogram.Rd0000655000175100001440000001531412511045112014115 0ustar hornikusers\name{rootogram} \alias{rootogram} \alias{rootogram.default} \alias{rootogram.goodfit} \title{Rootograms} \description{ Rootograms of observed and fitted values. } \usage{ \method{rootogram}{default}(x, fitted, names = NULL, scale = c("sqrt", "raw"), type = c("hanging", "standing", "deviation"), shade = FALSE, legend = TRUE, legend_args = list(x = 0, y = 0.2, height = 0.6), df = NULL, rect_gp = NULL, rect_gp_args = list(), lines_gp = gpar(col = "red", lwd = 2), points_gp = gpar(col = "red"), pch = 19, xlab = NULL, ylab = NULL, ylim = NULL, main = NULL, sub = NULL, margins = unit(0, "lines"), title_margins = NULL, legend_width = NULL, main_gp = gpar(fontsize = 20), sub_gp = gpar(fontsize = 15), name = "rootogram", prefix = "", keep_aspect_ratio = FALSE, newpage = TRUE, pop = TRUE, return_grob = FALSE, \dots) } \arguments{ \item{x}{either a vector or a 1-way table of frequencies.} \item{fitted}{a vector of fitted frequencies.} \item{names}{a vector of names passed to \code{\link{grid_barplot}}, if set to \code{NULL} the names of \code{x} are used.} \item{scale}{a character string indicating whether the values should be plotted on the raw or square root scale.} \item{type}{a character string indicating if the bars for the observed frequencies should be \code{hanging} or \code{standing} or indicate the \code{deviation} between observed and fitted frequencies.} \item{shade}{logical specifying whether \code{rect_gp} should be set to colors corresponding to the pearson residuals, i.e., if a residual-based shading should be applied to the bars.} \item{legend}{either a legend-generating function, or a legend function (see details and \code{\link{legends}}), or a logical. If \code{legend} is \code{NULL} or \code{TRUE} and \code{gp} is a function, legend defaults to \code{\link{legend_resbased}}.} \item{legend_args}{list of arguments for the legend-generating function, if specified.} \item{df}{degrees of freedom passed to the shading functions used for inference.} \item{rect_gp}{a \code{"gpar"} object controlling the grid graphical parameters of the rectangles, shading function or a corresponding generating function (see \code{\link{shadings}}). If unspecified and no shading is applied, defaults to light grey fill color for the bars.} \item{rect_gp_args}{list of arguments for the shading-generating function, if specified for \code{rect_gp}.} \item{lines_gp}{a \code{"gpar"} object controlling the grid graphical parameters of the lines.} \item{points_gp}{a \code{"gpar"} object controlling the grid graphical parameters of the points.} \item{pch}{plotting character for the points.} \item{xlab}{a label for the x axis.} \item{ylab}{a label for the y axis.} \item{ylim}{limits for the y axis.} \item{main}{either a logical, or a character string used for plotting the main title. If \code{main} is a logical and \code{TRUE}, the name of the object supplied as \code{x} is used.} \item{sub}{a character string used for plotting the subtitle. If \code{sub} is a logical and \code{TRUE} and \code{main} is unspecified, the name of the object supplied as \code{x} is used.} \item{margins}{either an object of class \code{"unit"} of length 4, or a numeric vector of length 4. The elements are recycled as needed. The four components specify the top, right, bottom, and left margin of the plot, respectively. When a numeric vector is supplied, the numbers are interpreted as \code{"lines"} units. In addition, the unit or numeric vector may have named arguments (\samp{top}, \samp{right}, \samp{bottom}, and \samp{left}), in which case the non-named arguments specify the default values (recycled as needed), overloaded by the named arguments.} \item{title_margins}{either an object of class \code{"unit"} of length 2, or a numeric vector of length 2. The elements are recycled as needed. The two components specify the top and bottom \emph{title} margin of the plot, respectively. The default for each \emph{specified} title are 2 lines (and 0 else), except when a legend is plotted and \code{keep_aspect_ratio} is \code{TRUE}: in this case, the default values of both margins are set as to align the heights of legend and actual plot. When a numeric vector is supplied, the numbers are interpreted as \code{"lines"} units. In addition, the unit or numeric vector may have named arguments (\samp{top} and \samp{bottom}), in which case the non-named argument specify the default value (recycled as needed), overloaded by the named arguments.} \item{legend_width}{An object of class \code{"unit"} of length 1 specifying the width of the legend (if any). Default: 5 lines.} \item{main_gp, sub_gp}{object of class \code{"gpar"} containing the graphical parameters used for the main (sub) title, if specified.} \item{name}{name of the plotting viewport.} \item{keep_aspect_ratio}{logical indicating whether the aspect ratio should be fixed or not.} \item{prefix}{optional character string used as a prefix for the generated viewport and grob names.} \item{newpage}{logical. Should \code{\link{grid.newpage}} be called before plotting?} \item{pop}{logical. Should the viewport created be popped?} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{\dots}{further arguments passed to \code{\link{grid_barplot}}.} } \details{ The observed frequencies are displayed as bars and the fitted frequencies as a line. By default a sqrt scale is used to make the smaller frequencies more visible. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org}, David Meyer \email{David.Meyer@R-project.org} } \references{ J. W. Tukey (1977), \emph{Exploratory Data Analysis}. Addison Wesley, Reading, MA. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \seealso{\code{\link{grid_barplot}}} \examples{ ## Simulated data examples: dummy <- rnbinom(200, size = 1.5, prob = 0.8) observed <- table(dummy) fitted1 <- dnbinom(as.numeric(names(observed)), size = 1.5, prob = 0.8) * sum(observed) fitted2 <- dnbinom(as.numeric(names(observed)), size = 2, prob = 0.6) * sum(observed) rootogram(observed, fitted1) rootogram(observed, fitted2) ## Real data examples: data("HorseKicks") HK.fit <- goodfit(HorseKicks) summary(HK.fit) plot(HK.fit) ## or equivalently rootogram(HK.fit) data("Federalist") F.fit <- goodfit(Federalist, type = "nbinomial") summary(F.fit) plot(F.fit) ## (Pearson) residual-based shading data("Federalist") Fed_fit0 <- goodfit(Federalist, type = "poisson") plot(Fed_fit0, shade = TRUE) } \keyword{hplot} vcd/man/JobSatisfaction.Rd0000755000175100001440000000224211150520606015167 0ustar hornikusers\name{JobSatisfaction} \alias{JobSatisfaction} \docType{data} \title{Job Satisfaction Data} \description{ Data from Petersen (1968) about the job satisfaction of 715 blue collar workers, selected from Danish Industry in 1968. } \usage{ data("JobSatisfaction") } \format{ A data frame with 8 observations and 4 variables. \describe{ \item{Freq}{frequency.} \item{management}{factor indicating quality of management (bad, good).} \item{supervisor}{factor indicating supervisor's job satisfaction (low, high).} \item{own}{factor indicating worker's own job satisfaction (low, high).} } } \references{ E. B. Andersen (1991), \emph{The Statistical Analysis of Categorical Data}. 2nd edition. Springer-Verlag, Berlin. E. Petersen (1968), \emph{Job Satisfaction in Denmark}. (In Danish). Mentalhygiejnisk Forlag, Copenhagen. } \source{ E. B. Andersen (1991), The Statistical Analysis of Categorical Data, Table 5.4. } \examples{ data("JobSatisfaction") structable(~ ., data = JobSatisfaction) mantelhaen.test(xtabs(Freq ~ own + supervisor + management, data = JobSatisfaction)) } \keyword{datasets} vcd/man/SpaceShuttle.Rd0000755000175100001440000000335611150520606014520 0ustar hornikusers\name{SpaceShuttle} \alias{SpaceShuttle} \docType{data} \title{Space Shuttle O-ring Failures} \description{ Data from Dalal et al. (1989) about O-ring failures in the NASA space shuttle program. The damage index comes from a discussion of the data by Tufte (1997). } \usage{ data("SpaceShuttle") } \format{ A data frame with 24 observations and 6 variables. \describe{ \item{FlightNumber}{Number of space shuttle flight.} \item{Temperature}{temperature during start (in degrees F).} \item{Pressure}{pressure.} \item{Fail}{did any O-ring failures occur? (no, yes).} \item{nFailures}{how many (of six) 0-rings failed?.} \item{Damage}{damage index.} } } \references{ S. Dalal, E. B. Fowlkes, B. Hoadly (1989), Risk analysis of the space shuttle: Pre-Challenger prediction of failure, \emph{Journal of the American Statistical Association}, \bold{84}, 945--957. E. R. Tufte (1997), \emph{Visual Explanations: Images and Quantities, Evidence and Narrative}. Graphics Press, Cheshire, CT. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data: \url{http://euclid.psych.yorku.ca/ftp/sas/vcd/catdata/orings.sas} } \examples{ data("SpaceShuttle") plot(nFailures/6 ~ Temperature, data = SpaceShuttle, xlim = c(30, 81), ylim = c(0,1), main = "NASA Space Shuttle O-Ring Failures", ylab = "Estimated failure probability", pch = 19, col = 4) fm <- glm(cbind(nFailures, 6 - nFailures) ~ Temperature, data = SpaceShuttle, family = binomial) lines(30 : 81, predict(fm, data.frame(Temperature = 30 : 81), type = "re"), lwd = 2) abline(v = 31, lty = 3) } \keyword{datasets} vcd/man/tile.Rd0000655000175100001440000001237012466747674013077 0ustar hornikusers\name{tile} \alias{tile} \alias{tile.default} \alias{tile.formula} \title{Tile Plot} \description{ Plots a tile display. } \usage{ \method{tile}{default}(x, tile_type = c("area", "squaredarea", "height", "width"), halign = c("left", "center", "right"), valign = c("bottom", "center", "top"), split_vertical = NULL, shade = FALSE, spacing = spacing_equal(unit(1, "lines")), set_labels = NULL, margins = unit(3, "lines"), keep_aspect_ratio = FALSE, legend = NULL, legend_width = NULL, squared_tiles = TRUE, main = NULL, sub = NULL, ...) \method{tile}{formula}(formula, data, \dots, main = NULL, sub = NULL, subset = NULL, na.action = NULL) } \arguments{ \item{x}{a contingency table, or an object coercible to one.} \item{formula}{a formula specifying the variables used to create a contingency table from \code{data}}. \item{data}{either a data frame, or an object of class \code{"table"} or \code{"ftable"}.} \item{subset}{an optional vector specifying a subset of observations to be used.} \item{na.action}{a function which indicates what should happen when the data contain \code{NA}s. Ignored if \code{data} is a contingency table.} \item{tile_type}{character string indicating how the tiles should reflect the table frequencies (see details).} \item{halign, valign}{character string specifying the horizontal and vertical alignment of the tiles.} \item{split_vertical}{vector of logicals of length \eqn{k}, where \eqn{k} is the number of margins of \code{x} (values are recycled as needed). A \code{TRUE} component indicates that the tile(s) of the corresponding dimension should be split vertically, \code{FALSE} means horizontal splits. Default is \code{FALSE.}} \item{spacing}{spacing object, spacing function, or corresponding generating function (see \code{\link{strucplot}} for more information).} \item{set_labels}{An optional character vector with named components replacing the so-specified variable names. The component names must exactly match the variable names to be replaced.} \item{shade}{logical specifying whether shading should be enabled or not (see \code{\link{strucplot}}).} \item{margins}{either an object of class \code{"unit"} of length 4, or a numeric vector of length 4. The elements are recycled as needed. The four components specify the top, right, bottom, and left margin of the plot, respectively. When a numeric vector is supplied, the numbers are interpreted as \code{"lines"} units. In addition, the unit or numeric vector may have named arguments (\samp{top}, \samp{right}, \samp{bottom}, and \samp{left}), in which case the non-named arguments specify the default values (recycled as needed), overloaded by the named arguments.} \item{legend}{either a legend-generating function, or a legend function (see details and \code{\link{legends}}), or a logical. If \code{legend} is \code{NULL} or \code{TRUE} and \code{gp} is a function or missing, legend defaults to \code{\link{legend_resbased}}. } \item{legend_width}{An object of class \code{"unit"} of length 1 specifying the width of the legend (if any). Default: 5 lines.} \item{keep_aspect_ratio}{logical indicating whether the aspect ratio should be fixed or not. The default is \code{FALSE} to enable the creation of squared tiles.} \item{squared_tiles}{logical indicating whether white space should be added as needed to rows or columns to obtain squared tiles in case of an unequal number of row and column labels.} \item{main, sub}{either a logical, or a character string used for plotting the main (sub) title. If logical and \code{TRUE}, the name of the \code{data} object is used.} \item{\dots}{Other arguments passed to \code{\link{strucplot}}} } \details{ A tile plot is a matrix of tiles. For each tile, either the \code{"width"}, \code{"height"}, \code{"area"}, or squared area is proportional to the corresponding entry. The first three options allow column-wise, row-wise and overall comparisons, respectively. The last variant allows to compare the tiles both column-wise and row-wise, considering either the width or the height, respectively. In contrast to other high-level strucplot functions, \code{tile} also accepts a table with duplicated levels (see examples). In this case, artificial dimnames will be created, and the actual ones are drawn using \code{set_labels}. Note that multiway-tables are first \dQuote{flattened} using \code{structable}. } \value{ The \code{"structable"} visualized is returned invisibly. } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{assoc}}, \code{\link{strucplot}}, \code{\link{mosaic}}, \code{\link{structable}}, } \examples{ data("Titanic") ## default plot tile(Titanic) tile(Titanic, type = "expected") tile(Titanic, shade = TRUE) ## some variations tile(Titanic, tile_type = "squaredarea") tile(Titanic, tile_type = "width", squared_tiles = FALSE) tile(Titanic, tile_type = "height", squared_tiles = FALSE) tile(Titanic, tile_type = "area", halign = "center", valign = "center") ## repeat levels tile(Titanic[,,,c(1,2,1,2)]) } \keyword{hplot} vcd/man/Bundesliga.Rd0000755000175100001440000000414211223326553014171 0ustar hornikusers\name{Bundesliga} \alias{Bundesliga} \title{Ergebnisse der Fussball-Bundesliga} \description{ Results from the first German soccer league (1963-2008). } \usage{ data("Bundesliga") } \format{A data frame with 14018 observations and 7 variables. \describe{ \item{HomeTeam}{factor. Name of the home team.} \item{AwayTeam}{factor. Name of the away team.} \item{HomeGoals}{number of goals scored by the home team.} \item{AwayGoals}{number of goals scored by the away team.} \item{Round}{round of the game.} \item{Year}{year in which the season started.} \item{Date}{starting time of the game (in \code{"POSIXct"} format).} } } \details{ The data comprises all games in the first German soccer league since its foundation in 1963. The data have been queried online from the official Web page of the DFB and prepared as a data frame in R by Daniel Dekic, Torsten Hothorn, and Achim Zeileis (replacing earlier versions of the data in the package containing only subsets of years). Each year/season comprises 34 rounds (except 1963, 1964, 1991) so that all 18 teams play twice against each other (switching home court advantage). In 1963/64, there were only 16 teams, hence only 30 rounds. In 1991, after the German unification, there was one season with 20 teams and 38 rounds. } \source{ Homepage of the Deutscher Fussball-Bund (DFB, German Football Association): \url{http://www.dfb.de/} } \references{ Leonhard Knorr-Held (1999), Dynamic rating of sports teams. SFB 386 \dQuote{Statistical Analysis of Discrete Structures}, Discussion paper \bold{98}. } \seealso{ \code{\link{UKSoccer}} } \examples{ data("Bundesliga") ## number of goals per game poisson distributed? ngoals1 <- xtabs(~ HomeGoals, data = Bundesliga, subset = Year == 1995) ngoals2 <- xtabs(~ AwayGoals, data = Bundesliga, subset = Year == 1995) ngoals3 <- table(apply(subset(Bundesliga, Year == 1995)[,3:4], 1, sum)) gf1 <- goodfit(ngoals1) gf2 <- goodfit(ngoals2) gf3 <- goodfit(ngoals3) summary(gf1) summary(gf2) summary(gf3) plot(gf1) plot(gf2) plot(gf3) Ord_plot(ngoals1) distplot(ngoals1) } \keyword{datasets} vcd/man/OvaryCancer.Rd0000755000175100001440000000373611150520606014332 0ustar hornikusers\name{OvaryCancer} \alias{OvaryCancer} \docType{data} \title{Ovary Cancer Data} \description{ Data from Obel (1975) about a retrospective study of ovary cancer carried out in 1973. Information was obtained from 299 women, who were operated for ovary cancer 10 years before. } \usage{ data("OvaryCancer") } \format{ A data frame with 16 observations and 5 variables. \describe{ \item{Freq}{frequency.} \item{stage}{factor indicating the stage of the cancer at the time of operation (early, advanced).} \item{operation}{factor indicating type of operation (radical, limited).} \item{survival}{factor indicating survival status after 10 years (yes, no).} \item{xray}{factor indicating whether X-ray treatment was received (yes, no).} } } \references{ E. B. Obel (1975), A Comparative Study of Patients with Cancer of the Ovary Who Have Survived More or Less Than 10 Years. \emph{Acta Obstetricia et Gynecologica Scandinavica}, \bold{55}, 429-439. E. B. Andersen (1991), \emph{The Statistical Analysis of Categorical Data}. 2nd edition. Springer-Verlag, Berlin. } \source{ E. B. Andersen (1991), The Statistical Analysis of Categorical Data, Table 6.4. } \examples{ data("OvaryCancer") tab <- xtabs(Freq ~ xray + survival + stage + operation, data = OvaryCancer) ftable(tab, col.vars = "survival", row.vars = c("stage", "operation", "xray")) ## model: ~ xray * operation * stage + survival * stage ## interpretation: treat xray, operation, stage as fixed margins, ## the survival depends on stage, but not xray and operation. doubledecker(survival ~ stage + operation + xray, data = tab) mosaic(~ stage + operation + xray + survival, split = c(FALSE, TRUE, TRUE, FALSE), data = tab, keep = FALSE, gp = gpar(fill = rev(grey.colors(2)))) mosaic(~ stage + operation + xray + survival, split = c(FALSE, TRUE, TRUE, FALSE), data = tab, keep = FALSE, expected = ~ xray * operation * stage + survival*stage) } \keyword{datasets} vcd/man/pairs.table.Rd0000644000175100001440000001456612532005461014324 0ustar hornikusers\name{pairs.table} \alias{pairs.table} \alias{pairs.structable} \title{Pairs Plot for Contingency Tables} \description{ Produces a matrix of strucplot displays. } \usage{ \method{pairs}{table}(x, upper_panel = pairs_mosaic, upper_panel_args = list(), lower_panel = pairs_mosaic, lower_panel_args = list(), diag_panel = pairs_diagonal_mosaic, diag_panel_args = list(), main = NULL, sub = NULL, main_gp = gpar(fontsize = 20), sub_gp = gpar(fontsize = 15), space = 0.3, newpage = TRUE, pop = TRUE, return_grob = FALSE, margins = unit(1, "lines"), \dots) } \arguments{ \item{x}{a contingency table in array form, with optional category labels specified in the \code{dimnames(x)} attribute.} \item{upper_panel}{function for the upper triangle of the matrix, or corresponding generating function. If \code{NULL}, no panel is drawn.} \item{upper_panel_args}{list of arguments for the generating function, if specified.} \item{lower_panel}{function for the lower triangle of the matrix, or corresponding generating function. If \code{NULL}, no panel is drawn.} \item{lower_panel_args}{list of arguments for the panel-generating function, if specified.} \item{diag_panel}{function for the diagonal of the matrix, or corresponding generating function. If \code{NULL}, no panel is drawn.} \item{diag_panel_args}{list of arguments for the generating function, if specified.} \item{main}{either a logical, or a character string used for plotting the main title. If \code{main} is a logical and \code{TRUE}, the name of the object supplied as \code{x} is used.} \item{sub}{a character string used for plotting the subtitle. If \code{sub} is a logical and \code{TRUE} and \code{main} is unspecified, the name of the object supplied as \code{x} is used.} \item{main_gp, sub_gp}{object of class \code{"gpar"} containing the graphical parameters used for the main (sub) title, if specified.} \item{space}{double specifying the distance between the cells.} \item{newpage}{logical controlling whether a new grid page should be created.} \item{pop}{logical indicating whether all viewports should be popped after the plot has been drawn.} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{margins}{either an object of class \code{"unit"} of length 4, or a numeric vector of length 4. The elements are recycled as needed. The four components specify the top, right, bottom, and left margin of the plot, respectively. When a numeric vector is supplied, the numbers are interpreted as \code{"lines"} units. In addition, the unit or numeric vector may have named arguments (\samp{top}, \samp{right}, \samp{bottom}, and \samp{left}), in which case the non-named arguments specify the default values (recycled as needed), overloaded by the named arguments.} \item{\dots}{For convenience, list of arguments for the panel-generating functions of upper and lower panels, if specified.} } \details{ This is a \code{\link[graphics]{pairs}} method for objects inheriting from class \code{"table"} or \code{"structable"}. It plots a matrix of pairwise mosaic plots. Four independence types are distinguished: \code{"pairwise"}, \code{"total"}, \code{"conditional"} and \code{"joint"}. The pairwise mosaic matrix shows bivariate marginal relations, collapsed over all other variables. The total independence mosaic matrix shows mosaic plots for mutual independence, i.e., for marginal and conditional independence among all pairs of variables. The conditional independence mosaic matrix shows mosaic plots for conditional independence for each pair of variables, given all other variables. The joint independence mosaic matrix shows mosaic plots for joint independence of all pairs of variables from the others. This method uses panel functions called for each cell of the matrix which can be different for upper matrix, lower matrix, and diagonal cells. Correspondingly, for each panel parameter \var{foo} (= \samp{upper}, \samp{lower}, or \samp{diag}), \code{pairs.table} takes two arguments: \var{foo\_panel} and \var{foo\_panel\_args}, which can be used to specify the parameters as follows: \enumerate{ \item Passing a suitable panel function to \var{foo\_panel} which subsequently is called for each cell with the corresponding coordinates. \item Passing a corresponding \emph{generating function} (of class \code{"panel_generator"}) to \var{foo\_panel}, along with parameters passed to \var{foo\_panel\_args}, that generates such a function. } Hence, the second approach is equivalent to the first if \var{foo\_panel(foo\_panel\_args)} is passed to \var{foo\_panel}. } \seealso{ \code{\link{pairs_mosaic}}, \code{\link{pairs_assoc}}, \code{\link{pairs_sieve}}, \code{\link{pairs_diagonal_text}}, \code{\link{pairs_diagonal_mosaic}}, \code{\link{pairs_text}}, \code{\link{pairs_barplot}}, \code{\link{assoc}}, \code{\link{sieve}}, \code{\link{mosaic}} } \references{ Cohen, A. (1980), On the graphical display of the significant components in a two-way contingency table. \emph{Communications in Statistics---Theory and Methods}, \bold{A9}, 1025--1041. Friendly, M. (1992), Graphical methods for categorical data. \emph{SAS User Group International Conference Proceedings}, \bold{17}, 190--200. \url{http://datavis.ca/papers/sugi/sugi17.pdf} Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. URL http://www.jstatsoft.org/v17/i03/ and available as \code{vignette("strucplot")}. } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ data("UCBAdmissions") data("PreSex") data(HairEyeColor) hec = structable(Eye ~ Sex + Hair, data = HairEyeColor) pairs(PreSex) pairs(UCBAdmissions) pairs(UCBAdmissions, upper_panel_args = list(shade = TRUE)) pairs(UCBAdmissions, lower_panel = pairs_mosaic(type = "conditional")) pairs(UCBAdmissions, diag_panel = pairs_text) pairs(UCBAdmissions, upper_panel = pairs_assoc, shade = TRUE) pairs(hec, highlighting = 2, diag_panel_args = list(fill = grey.colors)) pairs(hec, highlighting = 2, diag_panel = pairs_diagonal_mosaic, diag_panel_args = list(fill = grey.colors, alternate_labels =TRUE)) } \keyword{hplot} vcd/man/spacings.Rd0000755000175100001440000000631311150520606013717 0ustar hornikusers\name{spacings} \alias{spacings} \alias{spacing_highlighting} \alias{spacing_equal} \alias{spacing_dimequal} \alias{spacing_increase} \alias{spacing_conditional} \title{Spacing-generating Functions} \description{ These functions generate spacing functions to be used with \code{\link{strucplot}} to obtain customized spaces between the elements of a strucplot. } \usage{ spacing_equal(sp = unit(0.3, "lines")) spacing_dimequal(sp) spacing_increase(start = unit(0.3, "lines"), rate = 1.5) spacing_conditional(sp = unit(0.3, "lines"), start = unit(2, "lines"), rate = 1.8) spacing_highlighting(start = unit(0.2, "lines"), rate = 1.5) } \arguments{ \item{start}{object of class \code{"unit"} indicating the start value for increasing spacings.} \item{rate}{increase rate for spacings.} \item{sp}{object of class \code{"unit"} specifying a fixed spacing.} } \details{ These generating functions return a function used by \code{\link{strucplot}} to generate appropriate spaces between tiles of a strucplot, using the \code{dimnames} information of the visualized table. \code{spacing_equal} allows to specify one fixed space for \emph{all} dimensions. \code{spacing_dimequal} allows to specify a fixed space for \emph{each} dimension. \code{spacing_increase} creates increasing spaces for all dimensions, based on a starting value and an increase rate. \code{spacing_conditional} combines \code{spacing_equal} and \code{spacing_increase} to create fixed spaces for conditioned dimensions, and increasing spaces for conditioning dimensions. \code{spacing_highlighting} is essentially \code{spacing_conditional} but with the space of the last dimension set to 0. With a corresponding color scheme, this gives the impression of the last class being \sQuote{highlighted} in the penultimate class (as, e.g., in \code{\link{doubledecker}} plots). } \value{ A spacing function with arguments: \item{d}{\code{"dim"} attribute of a contingency table.} \item{condvars}{index vector of conditioning dimensions (currently only used by \code{spacing_conditional}).} This function computes a list of objects of class \code{"unit"}. Each list element contains the spacing information for the corresponding dimension of the table. The length of the \code{"unit"} objects is \eqn{k-1}, \eqn{k} number of levels of the corresponding factor. } \author{ David Meyer \email{David.Meyer@R-project.org} } \references{ Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. URL http://www.jstatsoft.org/v17/i03/ and available as \code{vignette("strucplot")}. } \seealso{ \code{\link{strucplot}}, \code{\link{doubledecker}} } \examples{ data("Titanic") strucplot(Titanic, spacing = spacing_increase(start = 0.5, rate = 1.5)) strucplot(Titanic, spacing = spacing_equal(1)) strucplot(Titanic, spacing = spacing_dimequal(1:4 / 4)) strucplot(Titanic, spacing = spacing_highlighting, gp = gpar(fill = c("light gray","dark gray"))) data("PreSex") strucplot(aperm(PreSex, c(1,4,2,3)), spacing = spacing_conditional, condvars = 2) } \keyword{hplot} vcd/man/assocstats.Rd0000655000175100001440000000300012504622200014261 0ustar hornikusers\name{assocstats} \alias{assocstats} \alias{summary.assocstats} \alias{print.assocstats} \alias{print.summary.assocstats} \title{Association Statistics} \description{ Computes the Pearson chi-Squared test, the Likelihood Ratio chi-Squared test, the phi coefficient, the contingency coefficient and Cramer's V for possibly stratified contingency tables. } \usage{ assocstats(x) } \arguments{ \item{x}{a contingency table, with possibly more than 2 dimensions. In this case, all dimensions except the first two ones are considered as strata.} } \value{ In case of a 2-dimensional table, a list with components: \item{chisq_tests}{a \eqn{2 \times 3}{2 x 3} table with the chi-squared statistics.} \item{phi}{The \emph{absolute value} of the phi coefficient (only defined for \eqn{2 \times 2}{2 x 2} tables).} \item{cont}{The contingency coefficient.} \item{cramer}{Cramer's V.} In case of higher-dimensional tables, a list of the above mentioned structure, each list component representing one stratum defined by the combinations of all levels of the stratum dimensions. } \references{ Michael Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. Fleiss, J. L. (1981). \emph{Statistical methods for rates and proportions} (2nd ed). New York: Wiley } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ data("Arthritis") tab <- xtabs(~Improved + Treatment, data = Arthritis) summary(assocstats(tab)) assocstats(UCBAdmissions) } \keyword{category} vcd/man/strucplot.Rd0000655000175100001440000002663712445055374014176 0ustar hornikusers\name{strucplot} \alias{strucplot} \title{Structured Displays of Contingency Tables} \description{ This modular function visualizes certain aspects of high-dimensional contingency tables in a hierarchical way. } \usage{ strucplot(x, residuals = NULL, expected = NULL, condvars = NULL, shade = NULL, type = c("observed", "expected"), residuals_type = NULL, df = NULL, split_vertical = NULL, spacing = spacing_equal, spacing_args = list(), gp = NULL, gp_args = list(), labeling = labeling_border, labeling_args = list(), core = struc_mosaic, core_args = list(), legend = NULL, legend_args = list(), main = NULL, sub = NULL, margins = unit(3, "lines"), title_margins = NULL, legend_width = NULL, main_gp = gpar(fontsize = 20), sub_gp = gpar(fontsize = 15), newpage = TRUE, pop = TRUE, return_grob = FALSE, keep_aspect_ratio = NULL, prefix = "", \dots) } \arguments{ \item{x}{a contingency table in array form, with optional category labels specified in the \code{dimnames} attribute.} \item{residuals}{optionally, an array of residuals of the same dimension as \code{x} (see details).} \item{expected}{optionally, an array of expected values of the same dimension as \code{x}, or alternatively the corresponding independence model specification as used by \code{\link[stats]{loglin}} or \code{\link[MASS]{loglm}} (see details).} \item{df}{degrees of freedom passed to the shading functions used for inference. Will be calculated (and overwritten if specified) if both \code{expected} and \code{residuals} are \code{NULL}, or if \code{expected} is given a formula.} \item{condvars}{number of conditioning variables, if any; those are expected to be ordered first in the table. This information is used for computing the expected values, and is also passed to the spacing functions (see \code{\link{spacings}}).} \item{shade}{logical specifying whether \code{gp} should be used or not (see \code{gp}). If \code{TRUE} and \code{expected} is unspecified, a default model is fitted: if \code{condvars} is specified, a corresponding conditional independence model, and else the total independence model.} \item{residuals_type}{a character string indicating the type of residuals to be computed when none are supplied. If \code{residuals} is \code{NULL}, \code{residuals_type} must be one of \code{"pearson"} (default; giving components of Pearson's chi-squared), \code{"deviance"} (giving components of the likelihood ratio chi-squared), or \code{"FT"} for the Freeman-Tukey residuals. The value of this argument can be abbreviated. If \code{residuals} are specified, the value of \code{residuals_type} is just passed \dQuote{as is} to the legend function.} \item{type}{a character string indicating whether the observed or the expected values of the table should be visualized.} \item{split_vertical}{vector of logicals of length \eqn{k}, where \eqn{k} is the number of margins of \code{x} (values are recycled as needed). A \code{TRUE} component indicates that the tile(s) of the corresponding dimension should be split vertically, \code{FALSE} means horizontal splits. Default is \code{FALSE.}} \item{spacing}{spacing object, spacing function, or a corresponding generating function (see details and \code{\link{spacings}}).} \item{spacing_args}{list of arguments for the spacing-generating function, if specified.} \item{gp}{object of class \code{"gpar"}, shading function or a corresponding generating function (see details and \code{\link{shadings}}). Components of \code{"gpar"} objects are recycled as needed along the last splitting dimension. Ignored if \code{shade = FALSE}.} \item{gp_args}{list of arguments for the shading-generating function, if specified.} \item{labeling}{either a logical, or a labeling function, or a corresponding generating function (see details and \code{\link{labelings}}. If \code{FALSE} or \code{NULL}, no labeling is produced.} \item{labeling_args}{list of arguments for the labeling-generating function, if specified.} \item{core}{either a core function, or a corresponding generating function (see details). Currently, generating functions for mosaic plots (\code{\link{struc_mosaic}}), association plots (\code{\link{struc_assoc}}), and sieve plots (\code{\link{struc_sieve}}) are provided.} \item{core_args}{list of arguments for the core-generating function, if specified.} \item{legend}{either a legend-generating function, or a legend function (see details and \code{\link{legends}}), or a logical. If \code{legend} is \code{NULL} or \code{TRUE} and \code{gp} is a function, legend defaults to \code{\link{legend_resbased}}.} \item{legend_args}{list of arguments for the legend-generating function, if specified.} \item{main}{either a logical, or a character string used for plotting the main title. If \code{main} is a logical and \code{TRUE}, the name of the object supplied as \code{x} is used.} \item{sub}{a character string used for plotting the subtitle. If \code{sub} is a logical and \code{TRUE} and \code{main} is unspecified, the name of the object supplied as \code{x} is used.} \item{margins}{either an object of class \code{"unit"} of length 4, or a numeric vector of length 4. The elements are recycled as needed. The four components specify the top, right, bottom, and left margin of the plot, respectively. When a numeric vector is supplied, the numbers are interpreted as \code{"lines"} units. In addition, the unit or numeric vector may have named arguments (\samp{top}, \samp{right}, \samp{bottom}, and \samp{left}), in which case the non-named arguments specify the default values (recycled as needed), overloaded by the named arguments.} \item{title_margins}{either an object of class \code{"unit"} of length 2, or a numeric vector of length 2. The elements are recycled as needed. The two components specify the top and bottom \emph{title} margin of the plot, respectively. The default for each \emph{specified} title are 2 lines (and 0 else), except when a legend is plotted and \code{keep_aspect_ratio} is \code{TRUE}: in this case, the default values of both margins are set as to align the heights of legend and actual plot. When a numeric vector is supplied, the numbers are interpreted as \code{"lines"} units. In addition, the unit or numeric vector may have named arguments (\samp{top} and \samp{bottom}), in which case the non-named argument specify the default value (recycled as needed), overloaded by the named arguments.} \item{legend_width}{An object of class \code{"unit"} of length 1 specifying the width of the legend (if any). Default: 5 lines.} \item{pop}{logical indicating whether the generated viewport tree should be removed at the end of the drawing or not.} \item{main_gp, sub_gp}{object of class \code{"gpar"} containing the graphical parameters used for the main (sub) title, if specified.} \item{newpage}{logical indicating whether a new page should be created for the plot or not.} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{keep_aspect_ratio}{logical indicating whether the aspect ratio should be fixed or not. If unspecified, the default is \code{TRUE} for two-dimensional tables and \code{FALSE} otherwise.} \item{prefix}{optional character string used as a prefix for the generated viewport and grob names.} \item{\dots}{For convenience, list of arguments passed to the labeling-generating function used.} } \details{ This function---usually called by higher-level functions such as \code{\link{assoc}} and \code{\link{mosaic}}---generates conditioning plots of contingency tables. First, it sets up a set of viewports for main- and subtitles, legend, and the actual plot region. Then, residuals are computed as needed from observed and expected frequencies, where the expected frequencies are optionally computed for a specified independence model. Finally, the specified functions for spacing, gp, main plot, legend, and labeling are called to produce the plot. The function invisibly returns the \code{"structable"} object visualized. Most elements of the plot, such as the core function, the spacing between the tiles, the shading of the tiles, the labeling, and the legend, are modularized in graphical appearance control (``grapcon'') functions and specified as parameters. For each element \emph{foo} (= \code{spacing}, \code{labeling}, \code{core}, or \code{legend}), \code{strucplot} takes two arguments: \var{foo} and \var{foo\_args}, which can be used to specify the parameters in the following alternative ways: \enumerate{ \item Passing a suitable function to \var{foo} which subsequently will be called from \code{strucplot} to compute shadings, labelings, etc. \item Passing a corresponding \emph{generating} function to \var{foo}, along with parameters passed to \var{foo\_args}, that generates such a function. Generating functions must inherit from classes \code{"grapcon_generator"} and \code{"}\var{foo}\code{"}. \item Except for the shading functions (\var{shading\_bar}), passing \var{foo(foo\_args)} to the \var{foo} argument. \item For shadings and spacings, passing the final parameter object itself; see the corresponding help pages for more details on the data structures. } If legends are drawn, a \sQuote{cinemascope}-like layout is used for the plot to preserve the 1:1 aspect ratio. If \code{type = "expected"}, the expected values are passed to the \code{observed} argument of the core function, and the observed values to the \code{expected} argument. Although the \code{gp} argument is typically used for shading, it can be used for arbitrary modifications of the tiles' graphics parameters (e.g., for highlighting particular cells, etc.). } \note{ The created viewports, as well as the tiles and bullets, are named and thus can conveniently modified after a plot has been drawn (and \code{pop = FALSE}). } \value{ Invisibly, an object of class \code{"structable"} corresponding to the plot. If \code{return_grob} is \code{TRUE}, additionally, the plot as a grob object is returned in a \code{grob} attribute. } \author{ David Meyer \email{David.Meyer@R-project.org} } \references{ Meyer D., Zeileis A., and Hornik K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. URL http://www.jstatsoft.org/v17/i03/ and available as \code{vignette("strucplot")}. } \seealso{ \code{\link{assoc}}, \code{\link{mosaic}}, \code{\link{sieve}}, \code{\link{struc_assoc}}, \code{\link{struc_sieve}}, \code{\link{struc_mosaic}}, \code{\link{structable}}, \code{\link{doubledecker}}, \code{\link{labelings}}, \code{\link{shadings}}, \code{\link{legends}}, \code{\link{spacings}} } \examples{ data("Titanic") strucplot(Titanic) strucplot(Titanic, core = struc_assoc) strucplot(Titanic, spacing = spacing_increase, spacing_args = list(start = 0.5, rate = 1.5)) strucplot(Titanic, spacing = spacing_increase(start = 0.5, rate = 1.5)) ## modify a tile's color strucplot(Titanic, pop = FALSE) grid.edit("rect:Class=1st,Sex=Male,Age=Adult,Survived=Yes", gp = gpar(fill = "red")) } \keyword{hplot} vcd/man/WomenQueue.Rd0000755000175100001440000000231511150520606014200 0ustar hornikusers\name{WomenQueue} \alias{WomenQueue} \docType{data} \title{Women in Queues} \description{ Data from Jinkinson \& Slater (1981) and Hoaglin \& Tukey (1985) reporting the frequency distribution of females in 100 queues of length 10 in a London Underground station. } \usage{ data("WomenQueue") } \format{ A 1-way table giving the number of women in 100 queues of length 10. The variable and its levels are \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab nWomen \tab 0, 1, \dots, 10 \cr } } \references{ D. C. Hoaglin \& J. W. Tukey (1985), Checking the shape of discrete distributions. In D. C. Hoaglin, F. Mosteller, J. W. Tukey (eds.), \emph{Exploring Data Tables, Trends and Shapes}, chapter 9. John Wiley \& Sons, New York. R. A. Jinkinson \& M. Slater (1981), Critical discussion of a graphical method for identifying discrete distributions, \emph{The Statistician}, \bold{30}, 239--248. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ M. Friendly (2000), Visualizing Categorical Data, pages 19--20. } \examples{ data("WomenQueue") gf <- goodfit(WomenQueue, type = "binomial") summary(gf) plot(gf) } \keyword{datasets} vcd/man/SexualFun.Rd0000755000175100001440000000276611150520606014032 0ustar hornikusers\name{SexualFun} \alias{SexualFun} \docType{data} \title{Sex is Fun} \description{ Data from Hout et al. (1987) given by Agresti (1990) summarizing the responses of married couples to the questionnaire item: Sex is fun for me and my partner: (a) never or occasionally, (b) fairly often, (c) very often, (d) almost always. } \usage{ data("SexualFun") } \format{ A 2-dimensional array resulting from cross-tabulating the ratings of 91 married couples. The variables and their levels are as follows: \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab Husband \tab Never Fun, Fairly Often, Very Often, Always Fun \cr 2 \tab Wife \tab Never Fun, Fairly Often, Very Often, Always Fun } } \references{ A. Agresti (1990), \emph{Categorical Data Analysis}. Wiley-Interscience, New York. M. Hout, O. D. Duncan, M. E. Sobel (1987), Association and heterogeneity: Structural models of similarities and differences, \emph{Sociological Methodology}, \bold{17}, 145-184. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ M. Friendly (2000), Visualizing Categorical Data, page 91. } \examples{ data("SexualFun") ## Kappa statistics Kappa(SexualFun) ## Agreement Chart agreementplot(t(SexualFun), weights = 1) ## Partial Agreement Chart and B-Statistics agreementplot(t(SexualFun), xlab = "Husband's Rating", ylab = "Wife's Rating", main = "Husband's and Wife's Sexual Fun") } \keyword{datasets} vcd/man/woolf_test.Rd0000755000175100001440000000214611150520606014275 0ustar hornikusers\name{woolf_test} \alias{woolf_test} \title{Woolf Test} \description{ Test for homogeneity on \eqn{2 \times 2 \times k}{2 x 2 x k} tables over strata (i.e., whether the log odds ratios are the same in all strata). } \usage{ woolf_test(x) } \arguments{ \item{x}{A \eqn{2 \times 2 \times k}{2 x 2 x k} table.} } \value{ A list of class \code{"htest"} containing the following components: \item{statistic}{the chi-squared test statistic.} \item{parameter}{degrees of freedom of the approximate chi-squared distribution of the test statistic.} \item{p.value}{\eqn{p}-value for the test.} \item{method}{a character string indicating the type of test performed.} \item{data.name}{a character string giving the name(s) of the data.} \item{observed}{the observed counts.} \item{expected}{the expected counts under the null hypothesis.} } \seealso{ \code{\link{mantelhaen.test}} } \references{ Woolf, B. 1955. On estimating the relation between blood group and disease. \emph{Ann. Human Genet.} (London) \bold{19}, 251-253. } \examples{ data("CoalMiners") woolf_test(CoalMiners) } \keyword{htest} vcd/man/HorseKicks.Rd0000755000175100001440000000250011150520606014147 0ustar hornikusers\name{HorseKicks} \alias{HorseKicks} \docType{data} \title{Death by Horse Kicks} \description{ Data from von Bortkiewicz (1898), given by Andrews \& Herzberg (1985), on number of deaths by horse or mule kicks in 10 (of 14 reported) corps of the Prussian army. 4 corps were not considered by Fisher (1925) as they had a different organization. This data set is a popular subset of the \code{\link{VonBort}} data. } \usage{ data("HorseKicks") } \format{ A 1-way table giving the number of deaths in 200 corps-years. The variable and its levels are \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab nDeaths \tab 0, 1, \dots, 4 \cr } } \references{ D. F. Andrews & A. M. Herzberg (1985), \emph{Data: A Collection of Problems from Many Fields for the Student and Research Worker}. Springer-Verlag, New York, NY. R. A. Fisher (1925), \emph{Statistical Methods for Research Workers}. Oliver \& Boyd, London. L. von Bortkiewicz (1898), \emph{Das Gesetz der kleinen Zahlen}. Teubner, Leipzig. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data, page 18. } \seealso{ \code{\link{VonBort}} } \examples{ data("HorseKicks") gf <- goodfit(HorseKicks) summary(gf) plot(gf) } \keyword{datasets} vcd/man/cd_plot.Rd0000655000175100001440000000760312445056523013550 0ustar hornikusers\name{cd_plot} \alias{cd_plot} \alias{cd_plot.default} \alias{cd_plot.formula} \title{Conditional Density Plots} \description{ Computes and plots conditional densities describing how the distribution of a categorical variable \code{y} changes over a numerical variable \code{x}. } \usage{ cd_plot(x, \dots) \method{cd_plot}{default}(x, y, plot = TRUE, ylab_tol = 0.05, bw = "nrd0", n = 512, from = NULL, to = NULL, main = "", xlab = NULL, ylab = NULL, margins = c(5.1, 4.1, 4.1, 3.1), gp = gpar(), name = "cd_plot", newpage = TRUE, pop = TRUE, return_grob = FALSE, \dots) \method{cd_plot}{formula}(formula, data = list(), plot = TRUE, ylab_tol = 0.05, bw = "nrd0", n = 512, from = NULL, to = NULL, main = "", xlab = NULL, ylab = NULL, margins = c(5.1, 4.1, 4.1, 3.1), gp = gpar(), name = "cd_plot", newpage = TRUE, pop = TRUE, return_grob = FALSE, \dots) } \arguments{ \item{x}{an object, the default method expects either a single numerical variable.} \item{y}{a \code{"factor"} interpreted to be the dependent variable} \item{formula}{a \code{"formula"} of type \code{y ~ x} with a single dependent \code{"factor"} and a single numerical explanatory variable.} \item{data}{an optional data frame.} \item{plot}{logical. Should the computed conditional densities be plotted?} \item{ylab_tol}{convenience tolerance parameter for y-axis annotation. If the distance between two labels drops under this threshold, they are plotted equidistantly.} \item{bw, n, from, to, \dots}{arguments passed to \code{\link{density}}} \item{main, xlab, ylab}{character strings for annotation} \item{margins}{margins when calling \code{\link{plotViewport}}} \item{gp}{a \code{"gpar"} object controlling the grid graphical parameters of the rectangles. It should specify in particular a vector of \code{fill} colors of the same length as \code{levels(y)}. The default is to call \code{\link{gray.colors}}.} \item{name}{name of the plotting viewport.} \item{newpage}{logical. Should \code{\link{grid.newpage}} be called before plotting?} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{pop}{logical. Should the viewport created be popped?} } \details{ \code{cd_plot} computes the conditional densities of \code{x} given the levels of \code{y} weighted by the marginal distribution of \code{y}. The densities are derived cumulatively over the levels of \code{y}. This visualization technique is similar to spinograms (see \code{\link{spine}}) but they do not discretize the explanatory variable, but rather use a smoothing approach. Furthermore, the original x axis and not a distorted x axis (as for spinograms) is used. This typically results in conditional densities that are based on very few observations in the margins: hence, the estimates are less reliable there. } \value{ The conditional density functions (cumulative over the levels of \code{y}) are returned invisibly. } \seealso{ \code{\link{spine}}, \code{\link{density}} } \references{ Hofmann, H., Theus, M. (2005), \emph{Interactive graphics for visualizing conditional distributions}, Unpublished Manuscript. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \examples{ ## Arthritis data data("Arthritis") cd_plot(Improved ~ Age, data = Arthritis) cd_plot(Improved ~ Age, data = Arthritis, bw = 3) cd_plot(Improved ~ Age, data = Arthritis, bw = "SJ") ## compare with spinogram spine(Improved ~ Age, data = Arthritis, breaks = 3) ## Space shuttle data data("SpaceShuttle") cd_plot(Fail ~ Temperature, data = SpaceShuttle, bw = 2) ## scatter plot with conditional density cdens <- cd_plot(Fail ~ Temperature, data = SpaceShuttle, bw = 2, plot = FALSE) plot(I(-1 * (as.numeric(Fail) - 2)) ~ jitter(Temperature, factor = 2), data = SpaceShuttle, xlab = "Temperature", ylab = "Failure") lines(53:81, cdens[[1]](53:81), col = 2) } \keyword{hplot} vcd/man/plot.loglm.Rd0000755000175100001440000000505212214055504014200 0ustar hornikusers\name{plot.loglm} \alias{plot.loglm} \alias{assoc.loglm} \alias{mosaic.loglm} \title{Visualize Fitted Log-linear Models} \description{ Visualize fitted \code{"loglm"} objects by mosaic or association plots. } \usage{ \method{plot}{loglm}(x, panel = mosaic, type = c("observed", "expected"), residuals_type = c("pearson", "deviance"), gp = shading_hcl, gp_args = list(), \dots) } \arguments{ \item{x}{a fitted \code{"loglm"} object, see \code{\link{loglm}}.} \item{panel}{a panel function for visualizing the observed values, residuals and expected values. Currently, \code{\link{mosaic}} and \code{\link{assoc}} in \pkg{vcd}.} \item{type}{a character string indicating whether the observed or the expected values of the table should be visualized.} \item{residuals_type}{a character string indicating the type of residuals to be computed.} \item{gp}{object of class \code{"gpar"}, shading function or a corresponding generating function (see details and \code{\link{shadings}}). Ignored if \code{shade = FALSE}.} \item{gp_args}{list of arguments for the shading-generating function, if specified.} \item{\dots}{Other arguments passed to the \code{panel} function.} } \details{ The \code{plot} method for \code{"loglm"} objects by default visualizes the model using a mosaic plot (can be changed to an association plot by setting \code{panel = assoc}) with a shading based on the residuals of this model. The legend also reports the corresponding p value of the associated goodness-of-fit test. The \code{mosaic} and \code{assoc} methods are simple convenience interfaces to this \code{plot} method, setting the \code{panel} argument accordingly. } \value{ The \code{"structable"} visualized is returned invisibly. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \seealso{ \code{\link{loglm}}, \code{\link{assoc}}, \code{\link{mosaic}}, \code{\link{strucplot}} } \examples{ library(MASS) ## mosaic display for PreSex model data("PreSex") fm <- loglm(~ PremaritalSex * ExtramaritalSex * (Gender + MaritalStatus), data = aperm(PreSex, c(3, 2, 4, 1))) fm ## visualize Pearson statistic plot(fm, split_vertical = TRUE) ## visualize LR statistic plot(fm, split_vertical = TRUE, residuals_type = "deviance") ## conditional independence in UCB admissions data data("UCBAdmissions") fm <- loglm(~ Dept * (Gender + Admit), data = aperm(UCBAdmissions)) ## use mosaic display plot(fm, labeling_args = list(abbreviate = c(Admit = 3))) ## and association plot plot(fm, panel = assoc) assoc(fm) } \keyword{hplot} vcd/man/cotabplot.Rd0000644000175100001440000001243612445055446014114 0ustar hornikusers\name{cotabplot} \alias{cotabplot} \alias{cotabplot.default} \alias{cotabplot.formula} \title{Coplot for Contingency Tables} \description{ \code{cotabplot} is a generic function for creating trellis-like coplots (conditional plots) for contingency tables. } \usage{ cotabplot(x, \dots) \method{cotabplot}{default}(x, cond = NULL, panel = cotab_mosaic, panel_args = list(), margins = rep(1, 4), layout = NULL, text_gp = gpar(fontsize = 12), rect_gp = gpar(fill = grey(0.9)), pop = TRUE, newpage = TRUE, return_grob = FALSE, \dots) \method{cotabplot}{formula}(formula, data = NULL, \dots) } \arguments{ \item{x}{an object. The default method can deal with contingency tables in array form.} \item{cond}{margin index(es) or corresponding name(s) of the conditioning variables.} \item{panel}{panel function applied for each conditioned plot, see details.} \item{panel_args}{list of arguments passed to \code{panel} if this is a panel-generating function inheriting from class \code{"grapcon_generator"}.} \item{margins}{either an object of class \code{"unit"} of length 4, or a numeric vector of length 4. The elements are recycled as needed. giving the margins around the whole plot.} \item{layout}{integer vector (of length two), giving the number of rows and columns for the panel.} \item{text_gp}{object of class \code{"gpar"} used for the text in the panel titles.} \item{rect_gp}{object of class \code{"gpar"} used for the rectangles with the panel titles.} \item{pop}{logical indicating whether the generated viewport tree should be removed at the end of the drawing or not.} \item{newpage}{logical controlling whether a new grid page should be created.} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{\dots}{further arguments passed to the panel-generating function.} \item{formula}{a formula specifying the variables used to create a contingency table from \code{data}. It has to be of type \code{~ x + y | z} where \code{z} is/are the conditioning variable(s) used.} \item{data}{either a data frame, or an object of class \code{"table"} or \code{"ftable"}.} } \details{ \code{cotabplot} is a generic function designed to create coplots or conditional plots (see Cleveland, 1993, and Becker, Cleveland, Shyu, 1996) similar to \code{\link{coplot}} but for contingency tables. \code{cotabplot} takes on computing the conditioning information and setting up the trellis display, and then relies on a panel function to create plots from the full table and the conditioning information. A simple example would be a contingency table \code{tab} with margin names \code{"x"}, \code{"y"} and \code{"z"}. To produce this plot either the default interface can be used or the formula interface via \code{cotabplot(tab, "z")} \code{cotabplot(~ x + y | z, data = tab)} The panel function needs to be of the form \code{panel(x, condlevels)} where \code{x} is the \emph{full} table (\code{tab} in the example above) and \code{condlevels} is a named vector with the levels (e.g., \code{c(z = "z1")} in the example above). Alternatively, \code{panel} can also be a panel-generating function of class \code{"grapcon_generator"} which creates a function with the interface described above. The panel-generating function is called with the interface \code{panel(x, condvars, \dots)} where again \code{x} is the full table, \code{condvars} is now only a vector with the names of the conditioning variables (and not their levels, e.g., \code{"z"} in the example above). Further arguments can be passed to the panel-generating function via \code{\dots} which also includes the arguments set in \code{panel_args}. Suitable panel-generating functions for mosaic, association and sieve plots can be found at \code{\link{cotab_mosaic}}. A description of the underlying ideas is given in Zeileis, Meyer, Hornik (2005). } \seealso{ \code{\link{cotab_mosaic}}, \code{\link{cotab_coindep}}, \code{\link{co_table}}, \code{\link{coindep_test}} } \references{ Becker, R.A., Cleveland, W.S., Shyu, M.-J. (1996), The visual design and control of trellis display. \emph{Journal of Computational and Graphical Statistics}, \bold{5}, 123--155. Cleveland, W.S. (1993), \emph{Visualizing Data}, Summit, New Jersey: Hobart Press. Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. URL http://www.jstatsoft.org/v17/i03/ and available as \code{vignette("strucplot")}. Zeileis, A., Meyer, D., Hornik K. (2007), \emph{Residual-based shadings for visualizing (conditional) independence}, \emph{Journal of Computational and Graphical Statistics}, \bold{16}, 507--525. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \examples{ data("UCBAdmissions") cotabplot(~ Admit + Gender | Dept, data = UCBAdmissions) cotabplot(~ Admit + Gender | Dept, data = UCBAdmissions, panel = cotab_assoc) ucb <- cotab_coindep(UCBAdmissions, condvars = "Dept", type = "assoc", n = 5000, margins = c(3, 1, 1, 3)) cotabplot(~ Admit + Gender | Dept, data = UCBAdmissions, panel = ucb) } \keyword{hplot} vcd/man/Ord_plot.Rd0000644000175100001440000001122212445061131013663 0ustar hornikusers\name{Ord_plot} \alias{Ord_plot} \alias{Ord_estimate} \title{Ord Plots} \description{ Ord plots for diagnosing discrete distributions. } \usage{ Ord_plot(obj, legend = TRUE, estimate = TRUE, tol = 0.1, type = NULL, xlim = NULL, ylim = NULL, xlab = "Number of occurrences", ylab = "Frequency ratio", main = "Ord plot", gp = gpar(cex = 0.5), lwd = c(2,2), lty=c(2,1), col=c("black", "red"), name = "Ord_plot", newpage = TRUE, pop = TRUE, return_grob = FALSE, \dots) Ord_estimate(x, type = NULL, tol = 0.1) } \arguments{ \item{obj}{either a vector of counts, a 1-way table of frequencies of counts or a data frame or matrix with frequencies in the first column and the corresponding counts in the second column.} \item{legend}{logical. Should a legend be plotted?.} \item{estimate}{logical. Should the distribution and its parameters be estimated from the data? See details.} \item{tol}{tolerance for estimating the distribution. See details.} \item{type}{a character string indicating the distribution, must be one of \code{"poisson"}, \code{"binomial"}, \code{"nbinomial"} or \code{"log-series"} or \code{NULL}. In the latter case the distribution is estimated from the data. See details.} \item{xlim}{limits for the x axis.} \item{ylim}{limits for the y axis.} \item{xlab}{a label for the x axis.} \item{ylab}{a label for the y axis.} \item{main}{a title for the plot.} \item{gp}{a \code{"gpar"} object controlling the grid graphical parameters of the points.} \item{lwd, lty}{vectors of length 2, giving the line width and line type used for drawing the OLS line and the WLS lines.} \item{col}{vector of length 2 giving the colors used for drawing the OLS and WLS lines.} \item{name}{name of the plotting viewport.} \item{newpage}{logical. Should \code{\link{grid.newpage}} be called before plotting?} \item{pop}{logical. Should the viewport created be popped?} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{\dots}{further arguments passed to \code{\link{grid.points}}.} \item{x}{a vector giving intercept and slope for the (fitted) line in the Ord plot.} } \details{ The Ord plot plots the number of occurrences against a certain frequency ratio (see Friendly (2000) for details) and should give a straight line if the data comes from a poisson, binomial, negative binomial or log-series distribution. The intercept and slope of this straight line conveys information about the underlying distribution. \code{Ord_plot} fits a usual OLS line (black) and a weighted OLS line (red). From the coefficients of the latter the distribution is estimated by \code{Ord_estimate} as described in Table 2.10 in Friendly (2000). To judge whether a coefficient is positive or negative a tolerance given by \code{tol} is used. If none of the distributions fits well, no parameters are estimated. Be careful with the conclusions from \code{Ord_estimate} as it implements just some simple heuristics! } \value{ A vector giving the intercept and slope of the weighted OLS line. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \references{ J. K. Ord (1967), Graphical methods for a class of discrete distributions, \emph{Journal of the Royal Statistical Society}, \bold{A 130}, 232--238. Michael Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \examples{ ## Simulated data examples: dummy <- rnbinom(1000, size = 1.5, prob = 0.8) Ord_plot(dummy) ## Real data examples: data("HorseKicks") data("Federalist") data("Butterfly") data("WomenQueue") \dontrun{ grid.newpage() pushViewport(viewport(layout = grid.layout(2, 2))) pushViewport(viewport(layout.pos.col=1, layout.pos.row=1)) Ord_plot(HorseKicks, main = "Death by horse kicks", newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col=1, layout.pos.row=2)) Ord_plot(Federalist, main = "Instances of 'may' in Federalist papers", newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col=2, layout.pos.row=1)) Ord_plot(Butterfly, main = "Butterfly species collected in Malaya", newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col=2, layout.pos.row=2)) Ord_plot(WomenQueue, main = "Women in queues of length 10", newpage = FALSE) popViewport(2) } ## same mplot( Ord_plot(HorseKicks, return_grob = TRUE, main = "Death by horse kicks"), Ord_plot(Federalist, return_grob = TRUE, main = "Instances of 'may' in Federalist papers"), Ord_plot(Butterfly, return_grob = TRUE, main = "Butterfly species collected in Malaya"), Ord_plot(WomenQueue, return_grob = TRUE, main = "Women in queues of length 10") ) } \keyword{category} vcd/man/labeling_border.Rd0000755000175100001440000002526311720272464015240 0ustar hornikusers\name{labeling_border} \alias{labeling_border} \alias{labeling_conditional} \alias{labeling_left} \alias{labeling_left2} \alias{labeling_cboxed} \alias{labeling_lboxed} \alias{labeling_doubledecker} \alias{labeling_values} \alias{labeling_residuals} \alias{labelings} \title{Labeling Functions for Strucplots} \description{ These functions generate labeling functions used for strucplots. } \usage{ labeling_border(labels = TRUE, varnames = labels, set_labels = NULL, set_varnames = NULL, tl_labels = NULL, alternate_labels = FALSE, tl_varnames = NULL, gp_labels = gpar(fontsize = 12), gp_varnames = gpar(fontsize = 12, fontface = 2), rot_labels = c(0, 90, 0, 90), rot_varnames = c(0, 90, 0, 90), pos_labels = "center", pos_varnames = "center", just_labels = "center", just_varnames = pos_varnames, boxes = FALSE, fill_boxes = FALSE, offset_labels = c(0, 0, 0, 0), offset_varnames = offset_labels, labbl_varnames = NULL, labels_varnames = FALSE, sep = ": ", abbreviate_labs = FALSE, rep = TRUE, clip = FALSE, \dots) labeling_values(value_type = c("observed", "expected", "residuals"), suppress = NULL, digits = 1, clip_cells = FALSE, \dots) labeling_residuals(suppress = NULL, digits = 1, clip_cells = FALSE, \dots) labeling_conditional(\dots) labeling_left(rep = FALSE, pos_varnames = "left", pos_labels = "left", just_labels = "left", \dots) labeling_left2(tl_labels = TRUE, clip = TRUE, pos_varnames = "left", pos_labels = "left", just_labels = "left", \dots) labeling_cboxed(tl_labels = TRUE, boxes = TRUE, clip = TRUE, pos_labels = "center", \dots) labeling_lboxed(tl_labels = FALSE, boxes = TRUE, clip = TRUE, pos_labels = "left", just_labels = "left", labbl_varnames = FALSE, \dots) labeling_doubledecker(lab_pos = c("bottom", "top"), dep_varname = TRUE, boxes = NULL, clip = NULL, labbl_varnames = FALSE, rot_labels = rep.int(0, 4), pos_labels = c("left", "center", "left", "center"), just_labels = c("left", "left", "left", "center"), varnames = NULL, gp_varnames = gpar(fontsize = 12, fontface = 2), offset_varnames = c(0, -0.6, 0, 0), tl_labels = NULL, \dots) } \arguments{ \item{labels}{vector of logicals indicating whether labels should be drawn for a particular dimension.} \item{varnames}{vector of logicals indicating whether variable names should be drawn for a particular dimension.} \item{set_labels}{An optional character vector with named components replacing the so-specified variable names. The component names must exactly match the variable names to be replaced.} \item{set_varnames}{An optional list with named components of character vectors replacing the labels of the so-specified variables. The component names must exactly match the variable names whose labels should be replaced.} \item{tl_labels}{vector of logicals indicating whether labels should be positioned on top (column labels) / left (row labels) for a particular dimension.} \item{alternate_labels}{vector of logicals indicating whether labels should be alternated on the top/bottom (left/right) side of the plot for a particular dimension.} \item{tl_varnames}{vector of logicals indicating whether variable names should be positioned on top (column labels) / on left (row labels) for a particular dimension.} \item{gp_labels}{list of objects of class \code{"gpar"} used for drawing the labels.} \item{gp_varnames}{list of objects of class \code{"gpar"} used for drawing the variable names.} \item{rot_labels}{vector of rotation angles for the labels for each of the four sides of the plot.} \item{rot_varnames}{vector of rotation angles for the variable names for each of the four sides of the plot.} \item{pos_labels}{character string of label positions (\code{"left"}, \code{"center"}, \code{"right"}) for each of the variables.} \item{pos_varnames}{character string of variable names positions (\code{"left"}, \code{"center"}, \code{"right"}) for each of the four sides of the plot.} \item{just_labels}{character string of label justifications (\code{"left"}, \code{"center"}, \code{"right"}) for each of the variables.} \item{just_varnames}{character string of variable names justifications (\code{"left"}, \code{"center"}, \code{"right"}) for each of the four sides of the plot.} \item{boxes}{vector of logicals indicating whether boxes should be drawn around the labels for a particular dimension.} \item{fill_boxes}{Either a vector of logicals, or a vector of characters, or a list of such vectors, specifying the fill colors for the boxes. \code{"TRUE"} and \code{"FALSE"} values are transformed into \code{"grey"} and \code{"white"}, respectively. If \code{fill_boxes} is atomic, each component specifies a basic color for the corresponding dimension. This color is transformed into its HSV representation, and the value is varied from 50\% to 100\% to give a sequential color palette for the levels. For \code{NA} components, no palette is produced (no fill color). If \code{fill_boxes} is a list of vectors, each vector specifies the level colors of the corresponding dimension.} \item{offset_labels, offset_varnames}{numeric vector of length 4 indicating the offset of the labels (variable names) for each of the four sides of the plot.} \item{labbl_varnames}{vector of logicals indicating whether variable names should be drawn on the left (column variables) / on top (row variables) of the corresponding labels.} \item{labels_varnames}{vector of logicals indicating, for each dimension, whether the variable name should be added to the corresponding labels or not.} \item{sep}{separator used if any component of \code{"labels_varnames"} is \code{TRUE}.} \item{abbreviate_labs}{vector of integers or logicals indicating, for each dimension, the number of characters the labels should be abbreviated to. \code{TRUE} means 1 character, \code{FALSE} causes no abbreviation. Values are recycled as needed.} \item{rep}{vector of logicals indicating, for each dimension, whether labels should be repeated for all conditioning strata, or appear only once.} \item{clip}{vector of integers indicating, for each dimension, whether labels should be clipped to not overlap.} \item{lab_pos}{character string switching between \code{"top"} or \code{"bottom"} position of the labels (only used for \code{labeling_doubledecker}).} \item{dep_varname}{logical or character string. If logical, this is indicating whether the name of the dependent variable should be printed or not. A character string will be printed instead of the variable name taken from the dimnames.} \item{value_type}{character string specifying which values should be displayed in the cells.} \item{suppress}{numeric vector of length 2 specifying an interval of values that are not displayed. 0 values are never displayed. A single number, \var{k}, is treated as \code{c(-\var{k}, \var{k})}. The default for labeling residuals is \code{c(-2,2)}. Use \code{suppress = 0} to show all non-zero values.} \item{digits}{integer specifying the number of digits used for rounding.} \item{clip_cells}{logical indicating whether the values should be clipped at the cell borders.} \item{\dots}{only used for \code{labeling_conditional} and \code{labeling_doubledecker}: parameters passed to \code{labeling_cells} and \code{labeling_border}.} } \details{ These functions generate labeling functions called by \code{\link{strucplot}} for their side-effect of adding labels to the plot. They suppose that a strucplot has been drawn and the corresponding viewport structure is pushed, since the positions of the viewports are used for the label positioning. Note that the functions can also be used \sQuote{stand-alone} as shown in the examples. All values supplied to vectorized arguments can be \sQuote{abbreviated} by using named components which override the default component values. In addition, these defaults can be overloaded by the sequence of non-named components which are recycled as needed (see examples). This help page only documents \code{labeling_border} and derived functions, more functions are described on the help page for \code{\link{labeling_cells}} and \code{\link{labeling_list}}. \code{labeling_left}, \code{labeling_left2}, \code{labeling_cboxed}, and \code{labeling_lboxed} are really just wrappers to \code{labeling_border}, and good examples for the parameter usage. \code{labeling_residuals} is a trivial wrapper for \code{labeling_values}, which in turn calls \code{labeling_border} by additionally adding the observed or expected frequencies or residuals to the cells. } \value{ A function with arguments: \item{d}{\code{"dimnames"} attribute from the visualized contingency table, or the visualized table itself from which the \code{"dimnames"} attributes will then be extracted.} \item{split_vertical}{vector of logicals indicating the split directions.} \item{condvars}{integer vector of conditioning dimensions.} } \author{ David Meyer \email{David.Meyer@R-project.org} } \references{ Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. URL http://www.jstatsoft.org/v17/i03/ and available as \code{vignette("strucplot")}. } \seealso{ \code{\link{labeling_cells}}, \code{\link{labeling_list}}, \code{\link{structable}}, \code{\link[grid]{grid.text}} } \examples{ data("Titanic") mosaic(Titanic) mosaic(Titanic, labeling = labeling_left) labeling_left mosaic(Titanic, labeling = labeling_cboxed) labeling_cboxed mosaic(Titanic, labeling = labeling_lboxed) labeling_lboxed data("PreSex") mosaic(~ PremaritalSex + ExtramaritalSex | Gender + MaritalStatus, data = PreSex, labeling = labeling_conditional) ## specification of vectorized arguments mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = TRUE))) mosaic(Titanic, labeling_args = list(clip = TRUE, boxes = TRUE, fill_boxes = c(Survived = "green", "red"))) mosaic(Titanic, labeling_args = list(clip = TRUE, boxes = TRUE, fill_boxes = list(Sex = "red", "green"))) mosaic(Titanic, labeling_args = list(clip = TRUE, boxes = TRUE, fill_boxes = list(Sex = c(Male = "red", "blue"), "green"))) ## change variable names mosaic(Titanic, labeling_args = list(set_varnames = c(Sex = "Gender"))) ## change labels mosaic(Titanic, labeling_args = list(set_varnames = c(Survived = "Status"), set_labels = list(Survived = c("Survived", "Not Survived")), rep = FALSE)) ## show frequencies mosaic(Titanic, labeling = labeling_values) } \keyword{hplot} vcd/man/VisualAcuity.Rd0000655000175100001440000000231212472413512014531 0ustar hornikusers\name{VisualAcuity} \alias{VisualAcuity} \docType{data} \title{Visual Acuity in Left and Right Eyes} \description{ Data from Kendall & Stuart (1961) on unaided vision among 3,242 men and 7,477 women, all aged 30-39 and employed in the U.K. Royal Ordnance factories 1943-1946. } \usage{ data("VisualAcuity") } \format{ A data frame with 32 observations and 4 variables. \describe{ \item{Freq}{frequency of visual acuity measurements.} \item{right}{visual acuity on right eye.} \item{left}{visual acuity on left eye.} \item{gender}{factor indicating gender of patient.} } } \references{ M. G. Kendall & A. Stuart (1961), \emph{The Advanced Theory of Statistics}, Vol. 2. Griffin, London. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ M. Friendly (2000), Visualizing Categorical Data: \url{http://euclid.psych.yorku.ca/ftp/sas/vcd/catdata/vision.sas} } \examples{ data("VisualAcuity") structable(~ gender + left + right, data = VisualAcuity) sieve(Freq ~ left + right | gender, data = VisualAcuity, shade = TRUE) cotabplot(Freq ~ left + right | gender, data = VisualAcuity, panel = cotab_agreementplot) } \keyword{datasets} vcd/man/independence_table.Rd0000755000175100001440000000126111150520606015675 0ustar hornikusers\name{independence_table} \alias{independence_table} \title{Independence Table} \description{ Computes table of expected frequencies (under the null hypotheses of independence) from an \eqn{n}-way table. } \usage{ independence_table(x, frequency = c("absolute", "relative")) } \arguments{ \item{x}{a table.} \item{frequency}{indicates whether absolute or relative frequencies should be computed.} } \value{ A table with either absolute or relative frequencies. } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ data("MSPatients") independence_table(MSPatients) independence_table(MSPatients, frequency = "relative") } \keyword{category} \keyword{array} vcd/man/table2d_summary.Rd0000655000175100001440000000232712456227164015217 0ustar hornikusers\name{table2d_summary} \alias{table2d_summary} \alias{print.table2d_summary} \title{Summary of a 2-way Table} \description{ Prints a 2-way contingency table along with percentages, marginal, and conditional distributions. } \usage{ table2d_summary(object, margins = TRUE, percentages = FALSE, conditionals = c("none", "row", "column"), chisq.test = TRUE, \dots) } \arguments{ \item{object}{a \eqn{r \times c}{r x c}-contingency table} \item{margins}{if \code{TRUE}, marginal distributions are computed.} \item{percentages}{if \code{TRUE}, relative frequencies are computed.} \item{conditionals}{if not \code{"none"}, the conditional distributions, given the row/column factor, are computed.} \item{chisq.test}{if \code{TRUE}, a chi-squared test of independence is carried out.} \item{\dots}{currently not used.} } \value{ Returns invisibly a \eqn{r \times c \times k}{r x c x k} table, \eqn{k} depending on the amount of choices (at most 3). } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{mar_table}}, \code{\link{prop.table}}, \code{\link{independence_table}} } \examples{ data("UCBAdmissions") table2d_summary(margin.table(UCBAdmissions, 1:2)) } \keyword{category} vcd/man/MSPatients.Rd0000655000175100001440000000351412472413270014144 0ustar hornikusers\name{MSPatients} \alias{MSPatients} \docType{data} \title{Diagnosis of Multiple Sclerosis} \description{ Data from Westlund \& Kurland (1953) on the diagnosis of multiple sclerosis (MS): two samples of patients, one from Winnipeg and one from New Orleans, were each rated by two neurologists (one from each city) in four diagnostic categories. } \usage{ data("MSPatients") } \format{ A 3-dimensional array resulting from cross-tabulating 218 observations on 3 variables. The variables and their levels are as follows: \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab New Orleans Neurologist \tab Certain, Probable, Possible, Doubtful \cr 2 \tab Winnipeg Neurologist \tab Certain, Probable, Possible, Doubtful \cr 3 \tab Patients \tab Winnipeg, New Orleans } } \references{ K. B. Westlund \& L. T. Kurland (1953), Studies on multiple sclerosis in Winnipeg, Manitoba and New Orleans, Louisiana, \emph{American Journal of Hygiene}, \bold{57}, 380--396. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{M. Friendly (2000), Visualizing Categorical Data: \url{http://euclid.psych.yorku.ca/ftp/sas/vcd/catdata/msdiag.sas} } \examples{ data("MSPatients") \dontrun{ ## best visualized using a resized device, e.g. using: ## get(getOption("device"))(width = 12) pushViewport(viewport(layout = grid.layout(ncol = 2))) pushViewport(viewport(layout.pos.col = 1)) popViewport() pushViewport(viewport(layout.pos.col = 2)) popViewport(2) dev.off() } ## alternative, more convenient way mplot( agreementplot(t(MSPatients[,,1]), return_grob = TRUE, main = "Winnipeg Patients"), agreementplot(t(MSPatients[,,2]), return_grob = TRUE, main = "New Orleans Patients") ) ## alternatively, use cotabplot: cotabplot(MSPatients, panel = cotab_agreementplot) } \keyword{datasets} vcd/man/grid_barplot.Rd0000655000175100001440000000301112444613361014557 0ustar hornikusers\name{grid_barplot} \alias{grid_barplot} \title{Barplot} \description{ Bar plots of 1-way tables in grid. } \usage{ grid_barplot(height, width = 0.8, offset = 0, names = NULL, xlim = NULL, ylim = NULL, xlab = "", ylab = "", main = "", gp = gpar(fill = "lightgray"), name = "grid_barplot", newpage = TRUE, pop = FALSE, return_grob = FALSE) } \arguments{ \item{height}{either a vector or a 1-way table of frequencies.} \item{width}{width of the bars (recycled if needed to the number of bars).} \item{offset}{offset of the bars (recycled if needed to the number of bars).} \item{names}{a vector of names for the bars, if set to \code{NULL} the names of \code{height} are used.} \item{xlim}{limits for the x axis.} \item{ylim}{limits for the y axis.} \item{xlab}{a label for the x axis.} \item{ylab}{a label for the y axis.} \item{main}{a title for the plot.} \item{gp}{a \code{"gpar"} object controlling the grid graphical parameters of the rectangles.} \item{name}{name of the plotting viewport.} \item{newpage}{logical. Should \code{\link{grid.newpage}} be called before plotting?} \item{pop}{logical. Should the viewport created be popped?} \item{return_grob}{logical. Shall the plot be returned as a grob object?} } \details{ \code{grid_barplot} mimics (some of) the features of \code{\link{barplot}}, but currently it only supports 1-way tables. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \examples{ grid_barplot(sample(1:6), names = letters[1:6]) } \keyword{hplot} vcd/man/Lifeboats.Rd0000755000175100001440000000275011150520606014021 0ustar hornikusers\name{Lifeboats} \alias{Lifeboats} \docType{data} \title{Lifeboats on the Titanic} \description{ Data from Mersey (1912) about the 18 (out of 20) lifeboats launched before the sinking of the S. S. Titanic. } \usage{data("Lifeboats")} \format{ A data frame with 18 observations and 8 variables. \describe{ \item{launch}{launch time in \code{"\link{POSIXt}"} format.} \item{side}{factor. Side of the boat.} \item{boat}{factor indicating the boat.} \item{crew}{number of male crew members on board.} \item{men}{number of men on board.} \item{women}{number of women (including female crew) on board.} \item{total}{total number of passengers.} \item{cap}{capacity of the boat.} } } \references{ L. Mersey (1912), Report on the loss of the \dQuote{Titanic} (S. S.). Parliamentary command paper 6452. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ M. Friendly (2000), Visualizing Categorical Data: \url{http://euclid.psych.yorku.ca/ftp/sas/vcd/catdata/lifeboat.sas} } \examples{ data("Lifeboats") attach(Lifeboats) ternaryplot( Lifeboats[,4:6], pch = ifelse(side == "Port", 1, 19), col = ifelse(side == "Port", "red", "blue"), id = ifelse(men / total > 0.1, as.character(boat), NA), prop_size = 2, dimnames_position = "edge", main = "Lifeboats on the Titanic" ) grid_legend(0.8, 0.9, c(1, 19), c("red", "blue"), c("Port", "Starboard"), title = "SIDE") detach(Lifeboats) } \keyword{datasets} vcd/man/panel_pairs_diagonal.Rd0000755000175100001440000001300012212353752016240 0ustar hornikusers\name{Pairs plot panel functions for diagonal cells} \alias{pairs_barplot} \alias{pairs_text} \alias{pairs_diagonal_text} \alias{pairs_diagonal_mosaic} \title{Diagonal Panel Functions for Table Pairs Plot} \description{ Diagonal panel functions for \code{\link{pairs.table}}. } \usage{ pairs_barplot(gp_bars = NULL, gp_vartext = gpar(fontsize = 17), gp_leveltext = gpar(), just_leveltext = c("center", "bottom"), just_vartext = c("center", "top"), rot = 0, abbreviate = FALSE, check_overlap = TRUE, fill = "grey", var_offset = unit(1, "npc"), \dots) pairs_text(dimnames = TRUE, gp_vartext = gpar(fontsize = 17), gp_leveltext = gpar(), gp_border = gpar(), \dots) pairs_diagonal_text(varnames = TRUE, gp_vartext = gpar(fontsize = 17, fontface = "bold"), gp_leveltext = gpar(), gp_border = gpar(), pos = c("right","top"), distribute = c("equal","margin"), rot = 0, \dots) pairs_diagonal_mosaic(split_vertical = TRUE, margins = unit(0, "lines"), offset_labels = -0.4, offset_varnames = 0, gp = NULL, fill = "grey", labeling = labeling_values, alternate_labels = TRUE, ...) } \arguments{ \item{dimnames}{vector of logicals indicating whether the factor levels should be displayed (only used for \code{pairs_text}).} \item{varnames}{vector of logicals indicating whether the variable names should be displayed (only used for \code{pairs_text_diagonal}).} \item{gp_bars}{object of class \code{"gpar"} used for bars (only used for \code{pairs_barplot}). If unspecified, the default is to set the \code{fill} component of this object to the \code{fill} argument.} \item{gp_vartext}{object of class \code{"gpar"} used for the factor names.} \item{gp_leveltext}{object of class \code{"gpar"} used for the factor levels.} \item{gp_border}{object of class \code{"gpar"} used for the border (only used for \code{pairs_text}).} \item{gp}{object of class \code{"gpar"} used for the tiles (only used for \code{pairs_diagonal_mosaic}). If unspecified, the default is to set the \code{fill} component of this object to the \code{fill} argument.} \item{fill}{color vector or palette function used for the fill colors of bars (for \code{pairs_barplot}) or tiles (for \code{pairs_diagonal_mosaic}).} \item{labeling}{labeling function, passed to \code{mosaic()}} \item{alternate_labels}{should labels alternate top/bottom?} \item{just_leveltext, just_vartext}{character string indicating the justification for variable names and levels.} \item{pos}{character string of length 2 controlling the horizontal and vertical position of the variable names (only used for \code{pairs_text_diagonal}).} \item{rot}{rotation angle for the variable levels.} \item{distribute}{character string indicating whether levels should be distributed equally or according to the margins (only used for \code{pairs_text_diagonal}).} \item{abbreviate}{integer or logical indicating the number of characters the labels should be abbreviated to. \code{TRUE} means 1 character, \code{FALSE} causes no abbreviation.} \item{check_overlap}{If \code{TRUE}, some levels will suppressed to avoid overlapping, if any.} \item{split_vertical}{vector of logicals of length \eqn{k}, where \eqn{k} is the number of margins of \code{x} (values are recycled as needed). A \code{TRUE} component indicates that the tile(s) of the corresponding dimension should be split vertically, \code{FALSE} means horizontal splits. Default is \code{FALSE.}} \item{margins}{either an object of class \code{"unit"} of length 4, or a numeric vector of length 4. The elements are recycled as needed. The four components specify the top, right, bottom, and left margin of the plot, respectively. When a numeric vector is supplied, the numbers are interpreted as \code{"lines"} units. In addition, the unit or numeric vector may have named arguments (\samp{top}, \samp{right}, \samp{bottom}, and \samp{left}), in which case the non-named arguments specify the default values (recycled as needed), overloaded by the named arguments.} \item{offset_labels, offset_varnames}{numeric vector of length 4 indicating the offset of the labels (variable names) for each of the four sides of the plot.} \item{var_offset}{object of class \code{"unit"} specifying the offset of variable names from the bottom of the bar plots created by \code{pairs_barplot}. If numeric, the unit defaults to "npc".} \item{\dots}{other parameters passed to the underlying graphics functions.} } \details{ In the diagonal cells, the pairsplot visualizes statistics or information for each dimension (that is: the single factors) alone. \code{\link{pairs_text}} displays the factor's name, and optionally also the factor levels. \code{\link{pairs_barplot}} produces a bar plot of the corresponding factor, along with the factor's name. } \value{ A function with one argument: the marginal table for the corresponding dimension. } \seealso{ \code{\link{pairs.table}}, \code{\link{pairs_assoc}}, \code{\link{pairs_mosaic}} } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ data("UCBAdmissions") pairs(UCBAdmissions) # pairs_barplot is default pairs(UCBAdmissions, diag_panel = pairs_text) pairs(UCBAdmissions, diag_panel = pairs_diagonal_text) pairs(Titanic, diag_panel = pairs_diagonal_text) pairs(Titanic, diag_panel = pairs_diagonal_text(distribute = "margin")) pairs(Titanic, diag_panel = pairs_diagonal_text(distribute = "margin", rot = 45)) } \keyword{hplot} vcd/man/Hitters.Rd0000755000175100001440000000327611150520606013537 0ustar hornikusers\name{Hitters} \alias{Hitters} \docType{data} \title{Hitters Data} \description{ This data set is deduced from the \code{\link{Baseball}} fielding data set: fielding performance basically includes the numbers of Errors, Putouts and Assists made by each player. In order to reduce the number of observations, the was compressed by calculating the mean number of errors, putouts and assists for each team and for only 6 positions (1B, 2B, 3B, C, OF, SS and UT). In addition, each of these three variables was scaled to a common range by dividing each variable by the maximum of the variable. } \usage{data("Hitters")} \format{ A data frame with 154 observations and 4 variables. \describe{ \item{Positions}{factor indicating the field position (1B=first baseman, 2B=second baseman, 3B=third baseman, C=catcher, OF=outfielder, SS=Short Stop, UT=Utility Players).} \item{Putouts}{occur when a fielder causes an opposing player to be tagged or forced out.} \item{Assists}{are credited to other fielders involved in making that putout.} \item{Errors}{count the errors made by a player.} } } \references{ M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ SAS System for Statistical Graphics, First Edition, Page A2.3 } \examples{ data("Hitters") attach(Hitters) colors <- c("black","red","green","blue","red","black","blue") pch <- substr(levels(Positions), 1, 1) ternaryplot(Hitters[,2:4], pch = as.character(Positions), col = colors[as.numeric(Positions)], main = "Baseball Hitters Data") grid_legend(0.8, 0.9, pch, colors, levels(Positions), title = "POSITION(S)") detach(Hitters) } \keyword{datasets} vcd/man/BrokenMarriage.Rd0000755000175100001440000000165311150520606015002 0ustar hornikusers\name{BrokenMarriage} \alias{BrokenMarriage} \docType{data} \title{Broken Marriage Data} \description{ Data from the Danish Welfare Study about broken marriages or permanent relationships depending on gender and social rank. } \usage{ data("BrokenMarriage") } \format{ A data frame with 20 observations and 4 variables. \describe{ \item{Freq}{frequency.} \item{gender}{factor indicating gender (male, female).} \item{rank}{factor indicating social rank (I, II, III, IV, V).} \item{broken}{factor indicating whether the marriage or permanent relationship was broken (yes, no).} } } \references{ E. B. Andersen (1991), \emph{The Statistical Analysis of Categorical Data}. 2nd edition. Springer-Verlag, Berlin. } \source{ E. B. Andersen (1991), The Statistical Analysis of Categorical Data, page 177. } \examples{ data("BrokenMarriage") structable(~ ., data = BrokenMarriage) } \keyword{datasets} vcd/man/Butterfly.Rd0000755000175100001440000000163511150520606014072 0ustar hornikusers\name{Butterfly} \alias{Butterfly} \docType{data} \title{Butterfly Species in Malaya} \description{ Data from Fisher et al. (1943) giving the number of tokens found for each of 501 species of butterflies collected in Malaya. } \usage{ data("Butterfly") } \format{ A 1-way table giving the number of tokens for 501 species of butterflies. The variable and its levels are \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab nTokens \tab 0, 1, \dots, 24 \cr } } \references{ R. A. Fisher, A. S. Corbet, C. B. Williams (1943), The relation between the number of species and the number of individuals, \emph{Journal of Animal Ecology}, \bold{12}, 42--58. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data, pages 21--22. } \examples{ data("Butterfly") Ord_plot(Butterfly) } \keyword{datasets} vcd/man/labeling_cells_list.Rd0000755000175100001440000001205211150520606016077 0ustar hornikusers\name{labeling_cells_list} \alias{labeling_list} \alias{labeling_cells} \title{Labeling Functions for Strucplots} \description{ These functions generate labeling functions that produce labels for strucplots. } \usage{ labeling_cells(labels = TRUE, varnames = TRUE, abbreviate_labels = FALSE, abbreviate_varnames = FALSE, gp_text = gpar(), lsep = ": ", lcollapse = "\n", just = "center", pos = "center", rot = 0, margin = unit(0.5, "lines"), clip_cells = TRUE, text = NULL, \dots) labeling_list(gp_text = gpar(), just = "left", pos = "left", lsep = ": ", sep = " ", offset = unit(c(2, 2), "lines"), varnames = TRUE, cols = 2, \dots) } \arguments{ \item{labels}{vector of logicals indicating, for each dimension, whether labels for the factor levels should be drawn or not. Values are recycled as needed.} \item{varnames}{vector of logicals indicating, for each dimension, whether variable names should be drawn. Values are recycled as needed.} \item{abbreviate_labels}{vector of integers or logicals indicating, for each dimension, the number of characters the labels should be abbreviated to. \code{TRUE} means 1 character, \code{FALSE} causes no abbreviation. Values are recycled as needed.} \item{abbreviate_varnames}{vector of integers or logicals indicating, for each dimension, the number of characters the variable (i.e., dimension) names should be abbreviated to. \code{TRUE} means 1 character, \code{FALSE} causes no abbreviation. Values are recycled as needed.} \item{gp_text}{object of class \code{"gpar"} used for the text drawn.} \item{lsep}{character that separates variable names from the factor levels.} \item{sep}{character that separates the factor levels (only used for \code{labeling_list}).} \item{offset}{object of class \code{"unit"} of length 2 specifying the offset in x- and y-direction of the text block drawn under the strucplot (only used for \code{labeling_list}).} \item{cols}{number of text columns (only used for \code{labeling_list}).} \item{lcollapse}{character that separates several variable name/factor level-combinations. Typically a line break. (Only used for \code{labeling_cells}.)} \item{just, pos}{character string of length 1 (\code{labeling_list}) or at most 2 (\code{labeling_cells}) specifying the labels' horizontal position and justification (horizontal and vertical for \code{labeling_cells}).} \item{rot}{rotation angle in degrees, used for all labels (only used for \code{labeling_cells}).} \item{margin}{object of class \code{"unit"} (a numeric value is converted to \code{"lines"}) specifying an offset from the cell borders (only used for \code{labeling_cells}).} \item{clip_cells}{logical indicating whether text should be clipped at the cell borders (only used for \code{labeling_cells}).} \item{text}{Optionally, a character table of the same dimensions than the contingency table whose entries will then be used instead of the labels. \code{NA} entries are not drawn. This allows custom cell annotations (see examples). Only used for \code{labeling_cells}.} \item{\dots}{Currently not used.} } \details{ These functions generate labeling functions that can add different kinds of labels to an existing plot. Typically they are supplied to \code{\link{strucplot}} which then generates and calls the labeling function. They assume that a strucplot has been drawn and the corresponding viewport structure is pushed, so that by navigating through the viewport tree the labels can be positioned appropriately. This help page only documents \code{labeling_list} and \code{labeling_cells}; more functions are described on the help page for \code{\link{labeling_border}}. The functions can also be used \sQuote{stand-alone} as shown in the examples. Using \code{labeling_list} will typically necessitate a bottom margin adjustment. } \value{ A function with arguments: \item{d}{\code{"dimnames"} attribute from the visualized contingency table, or the visualized table itself from which the \code{"dimnames"} attributes will then be extracted.} \item{split_vertical}{vector of logicals indicating the split directions.} \item{condvars}{integer vector of conditioning dimensions} } \author{ David Meyer \email{David.Meyer@R-project.org} } \references{ Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. URL http://www.jstatsoft.org/v17/i03/ and available as \code{vignette("strucplot")}. } \seealso{ \code{\link{labeling_border}}, \code{\link{structable}}, \code{\link[grid]{grid.text}} } \examples{ data("Titanic") mosaic(Titanic, labeling = labeling_cells) mosaic(Titanic, labeling = labeling_list) ## A more complex example, adding the observed frequencies ## to a mosaic plot: tab <- ifelse(Titanic < 6, NA, Titanic) mosaic(Titanic, pop = FALSE) labeling_cells(text = tab, margin = 0)(Titanic) } \keyword{hplot} vcd/man/Employment.Rd0000755000175100001440000000342011150520606014235 0ustar hornikusers\name{Employment} \alias{Employment} \docType{data} \title{Employment Status} \description{ Data from a 1974 Danish study given by Andersen (1991) on the employees who had been laid off. The workers are classified by their employment status on 1975-01-01, the cause of their layoff and the length of employment before they were laid off. } \usage{ data("Employment") } \format{ A 3-dimensional array resulting from cross-tabulating variables for 1314 employees. The variables and their levels are as follows: \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab EmploymentStatus \tab NewJob, Unemployed \cr 2 \tab EmploymentLength \tab <1Mo, 1-3Mo, 3-12Mo, 1-2Yr, 2-5Yr, >5Yr \cr 3 \tab LayoffCause \tab Closure, Replaced } } \references{ E. B. Andersen (1991), \emph{The Statistical Analysis of Categorical Data}. Springer-Verlag, Berlin. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data, pages 126--129. } \examples{ data("Employment") ## Employment Status mosaic(Employment, expected = ~ LayoffCause * EmploymentLength + EmploymentStatus, main = "Layoff*EmployLength + EmployStatus") mosaic(Employment, expected = ~ LayoffCause * EmploymentLength + LayoffCause * EmploymentStatus, main = "Layoff*EmployLength + Layoff*EmployStatus") ## Stratified view grid.newpage() pushViewport(viewport(layout = grid.layout(ncol = 2))) pushViewport(viewport(layout.pos.col = 1)) ## Closure mosaic(Employment[,,1], main = "Layoff: Closure", newpage = FALSE) popViewport(1) pushViewport(viewport(layout.pos.col = 2)) ## Replaced mosaic(Employment[,,2], main = "Layoff: Replaced", newpage = FALSE) popViewport(2) } \keyword{datasets} vcd/man/Suicide.Rd0000755000175100001440000000211711150520606013473 0ustar hornikusers\name{Suicide} \alias{Suicide} \docType{data} \title{Suicide Rates in Germany} \description{ Data from Heuer (1979) on suicide rates in West Germany classified by age, sex, and method of suicide. } \usage{ data("Suicide") } \format{ A data frame with 306 observations and 6 variables. \describe{ \item{Freq}{frequency of suicides.} \item{sex}{factor indicating sex (male, female).} \item{method}{factor indicating method used.} \item{age}{age (rounded).} \item{age.group}{factor. Age classified into 5 groups.} \item{method2}{factor indicating method used (same as \code{method} but some levels are merged).} } } \references{ J. Heuer (1979), \emph{Selbstmord bei Kindern und Jugendlichen}. Ernst Klett Verlag, Stuttgart. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data: \url{http://euclid.psych.yorku.ca/ftp/sas/vcd/catdata/suicide.sas} } \examples{ data("Suicide") structable(~ sex + method2 + age.group, data = Suicide) } \keyword{datasets} vcd/man/sieve.Rd0000644000175100001440000001550612467662154013245 0ustar hornikusers\name{sieve} \alias{sieve} \alias{sieve.default} \alias{sieve.formula} \title{Extended Sieve Plots} \encoding{UTF-8} \description{ (Extended) sieve displays for n-way contingency tables: plots rectangles with areas proportional to the expected cell frequencies and filled with a number of squares equal to the observed frequencies. Thus, the densities visualize the deviations of the observed from the expected values. } \usage{ \method{sieve}{default}(x, condvars = NULL, gp = NULL, shade = NULL, legend = FALSE, split_vertical = NULL, direction = NULL, spacing = NULL, spacing_args = list(), sievetype = c("observed","expected"), gp_tile = gpar(), scale = 1, main = NULL, sub = NULL, \dots) \method{sieve}{formula}(formula, data, \dots, main = NULL, sub = NULL, subset = NULL) } \arguments{ \item{x}{a contingency table in array form, with optional category labels specified in the \code{dimnames(x)} attribute.} \item{condvars}{vector of integers or character strings indicating conditioning variables, if any. The table will be permuted to order them first.} \item{formula}{a formula specifying the variables used to create a contingency table from \code{data}. For convenience, conditioning formulas can be specified; the conditioning variables will then be used first for splitting. Formulas for sieve displays (unlike those for doubledecker plots) have no response variable.} \item{data}{either a data frame, or an object of class \code{"table"} or \code{"ftable"}.} \item{subset}{an optional vector specifying a subset of observations to be used.} \item{shade}{logical specifying whether \code{gp} should be used or not (see \code{gp}). If \code{TRUE} and \code{expected} is unspecified, a default model is fitted: if \code{condvars} is specified, a corresponding conditional independence model, and else the total independence model. If \code{shade} is \code{NULL} (default), \code{gp} is used if specified.} \item{sievetype}{logical indicating whether rectangles should be filled according to \code{observed} or \code{expected} frequencies.} \item{gp}{object of class \code{"gpar"}, shading function or a corresponding generating function (see details of \code{\link{strucplot}} and \code{\link{shadings}}). Components of \code{"gpar"} objects are recycled as needed along the last splitting dimension. The default is a modified version of \code{\link{shading_Friendly}}: if \code{sievetype} is \code{"observed"}, cells with positive residuals are painted with a red sieve, and cells with negative residuals with a blue one. If \code{sievetype} is \code{"expected"}, the sieves' color is gray. Ignored if \code{shade = FALSE}.} \item{gp_tile}{object of class \code{"gpar"}, controlling the appearance of all \emph{static} elements of the cells (e.g., border and fill color).} \item{scale}{scaling factor for the sieve.} \item{legend}{either a legend-generating function, a legend function (see details of \code{\link{strucplot}} and \code{\link{legends}}), or a logical value. If \code{legend} is \code{NULL} or \code{TRUE} and \code{gp} is a function, legend defaults to \code{\link{legend_resbased}}.} \item{split_vertical}{vector of logicals of length \eqn{k}, where \eqn{k} is the number of margins of \code{x} (default: \code{FALSE}). Values are recycled as needed. A \code{TRUE} component indicates that the tile(s) of the corresponding dimension should be split vertically, \code{FALSE} means horizontal splits. Ignored if \code{direction} is not \code{NULL}.} \item{direction}{character vector of length \eqn{k}, where \eqn{k} is the number of margins of \code{x} (values are recycled as needed). For each component, a value of \code{"h"} indicates that the tile(s) of the corresponding dimension should be split horizontally, whereas \code{"v"} indicates vertical split(s).} \item{spacing}{spacing object, spacing function, or corresponding generating function (see \code{\link{strucplot}} for more information). The default is no spacing at all if \code{x} has two dimensions, and \code{spacing_increase} for more dimensions.} \item{spacing_args}{list of arguments for the generating function, if specified (see \code{\link{strucplot}} for more information).} \item{main, sub}{either a logical, or a character string used for plotting the main (sub) title. If logical and \code{TRUE}, the name of the \code{data} object is used.} \item{\dots}{Other arguments passed to \code{\link{strucplot}}} } \details{ \code{sieve} is a generic function which currently has a default method and a formula interface. Both are high-level interfaces to the \code{\link{strucplot}} function, and produce (extended) sieve displays. Most of the functionality is described there, such as specification of the independence model, labeling, legend, spacing, shading, and other graphical parameters. The layout is very flexible: the specification of shading, labeling, spacing, and legend is modularized (see \code{\link{strucplot}} for details). } \value{ The \code{"structable"} visualized is returned invisibly. } \note{To be faithful to the original definition by Riedwyl & Schüpbach, the default is to have no spacing between the tiles for two-way tables.} \references{ H. Riedwyl & M. Schüpbach (1994), Parquet diagram to plot contingency tables. In F. Faulbaum (ed.), \emph{Softstat '93: Advances in Statistical Software}, 293--299. Gustav Fischer, New York. M. Friendly (2000), Visualizing Categorical Data, SAS Institute, Cary, NC. David Meyer, Achim Zeileis, and Kurt Hornik (2006). The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. URL http://www.jstatsoft.org/v17/i03/ and available as \code{vignette("strucplot")}. } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{assoc}}, \code{\link{strucplot}}, \code{\link{mosaic}}, \code{\link{structable}}, \code{\link{doubledecker}} } \examples{ data("HairEyeColor") ## aggregate over 'sex': (haireye <- margin.table(HairEyeColor, c(2,1))) ## plot expected values: sieve(haireye, sievetype = "expected", shade = TRUE) ## plot observed table: sieve(haireye, shade = TRUE) ## plot complete diagram: sieve(HairEyeColor, shade = TRUE) ## example with observed values in the cells: sieve(haireye, shade = TRUE, labeling = labeling_values, gp_text = gpar(fontface = 2)) ## example with expected values in the cells: sieve(haireye, shade = TRUE, labeling = labeling_values, value_type = "expected", gp_text = gpar(fontface = 2)) ## an example for the formula interface: data("VisualAcuity") sieve(Freq ~ right + left, data = VisualAcuity) } \keyword{hplot} vcd/man/Kappa.Rd0000655000175100001440000000556412445040313013152 0ustar hornikusers\name{Kappa} \alias{Kappa} \alias{print.Kappa} \alias{confint.Kappa} \alias{summary.Kappa} \alias{print.summary.Kappa} \title{Cohen's Kappa and Weighted Kappa} \description{ Computes two agreement rates: Cohen's kappa and weighted kappa, and confidence bands. } \usage{ Kappa(x, weights = c("Equal-Spacing", "Fleiss-Cohen")) \S3method{print}{Kappa}(x, digits=max(getOption("digits") - 3, 3), CI=FALSE, level=0.95, ...) \S3method{confint}{Kappa}(object, parm, level = 0.95, ...) \S3method{summary}{Kappa}(object, ...) \S3method{print}{summary.Kappa}(x, ...) } \arguments{ \item{x}{For \code{Kappa}: a confusion matrix. For the print methods: object of class \code{"Kappa"} or \code{"summary.Kappa"}} \item{weights}{either one of the character strings given in the default value, or a user-specified matrix with same dimensions as \code{x}.} \item{digits}{minimal number of significant digits.} \item{CI}{logical; shall confidence limits be added to the output?} \item{level}{confidence level between 0 and 1 used for the confidence interval.} \item{object}{object of class \code{"Kappa"}.} \item{parm}{Currently, ignored.} \item{\dots}{Further arguments passed to the default print method.} } \details{ Cohen's kappa is the diagonal sum of the (possibly weighted) relative frequencies, corrected for expected values and standardized by its maximum value. The equal-spacing weights are defined by \eqn{1 - |i - j| / (r - 1)}{1 - abs(i - j) / (r - 1)}, \eqn{r} number of columns/rows, and the Fleiss-Cohen weights by \eqn{1 - |i - j|^2 / (r - 1)^2}{1 - abs(i - j)^2 / (r - 1)^2}. The latter one attaches greater importance to near disagreements. } \value{ An object of class \code{"Kappa"} with three components: \item{Unweighted}{numeric vector of length 2 with the kappa statistic (\code{value} component), along with Approximate Standard Error (\code{ASE} component)} \item{Weighted}{idem for the weighted kappa.} \item{Weights}{numeric matrix with weights used.} } \note{ The \code{summary} method also prints the weights. There is a \code{confint} method for computing approximate confidence intervals. } \references{ Cohen, J. (1960), A coefficient of agreement for nominal scales. \emph{Educational and Psychological Measurement}, \bold{20}, 37--46. Everitt, B.S. (1968), Moments of statistics kappa and weighted kappa. \emph{The British Journal of Mathematical and Statistical Psychology}, \bold{21}, 97--103. Fleiss, J.L., Cohen, J., and Everitt, B.S. (1969), Large sample standard errors of kappa and weighted kappa. \emph{Psychological Bulletin}, \bold{72}, 332--327. } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{agreementplot}}, \code{\link{confint}} } \examples{ data("SexualFun") K <- Kappa(SexualFun) K confint(K) summary(K) print(K, CI = TRUE) } \keyword{category} vcd/man/loddsratio.Rd0000644000175100001440000002426312535321266014266 0ustar hornikusers\name{loddsratio} \alias{loddsratio} \alias{oddsratio} \alias{loddsratio.default} \alias{loddsratio.formula} \alias{coef.loddsratio} \alias{confint.loddsratio} \alias{dim.loddsratio} \alias{dimnames.loddsratio} \alias{print.loddsratio} \alias{vcov.loddsratio} \alias{as.matrix.loddsratio} \alias{as.array.loddsratio} \alias{aperm.loddsratio} \alias{t.loddsratio} \alias{as.data.frame.loddsratio} \title{ Calculate Generalized Log Odds Ratios for Frequency Tables } \description{ Computes (log) odds ratios and their asymptotic variance covariance matrix for R x C (x strata) tables. Odds ratios are calculated for two array dimensions, separately for each level of all stratifying dimensions. See Friendly et al. (2011) for a sketch of a general theory. } \usage{ loddsratio(x, \dots) \method{loddsratio}{default}(x, strata = NULL, log = TRUE, ref = NULL, correct = any(x == 0L), \dots) \method{loddsratio}{formula}(formula, data = NULL, \dots, subset = NULL, na.action = NULL) oddsratio(x, stratum = NULL, log = TRUE) \method{coef}{loddsratio}(object, log = object$log, \dots) \method{vcov}{loddsratio}(object, log = object$log, \dots) \method{print}{loddsratio}(x, log = x$log, \dots) \method{confint}{loddsratio}(object, parm, level = 0.95, log = object$log, \dots) %as.array(x, \dots) \method{as.array}{loddsratio}(x, log=x$log, \dots) \method{t}{loddsratio}(x) \method{aperm}{loddsratio}(a, perm, \dots) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{an object. For the default method a k-way matrix/table/array of frequencies. The number of margins has to be at least 2.} \item{strata, stratum}{Numeric or character indicating the margins of a $k$-way table \code{x} (with $k$ greater than 2) that should be employed as strata. By default all dimensions except the first two are used.} \item{ref}{numeric or character. Reference categories for the (non-stratum) row and column dimensions that should be employed for computing the odds ratios. By default, odds ratios for profile contrasts (or sequential contrasts, i.e., successive differences of adjacent categories) are used. See details below.} \item{formula}{a formula specifying the variables used to create a contingency table from \code{data}. A conditioning formula can be specified; the conditioning variables will then be used as strata variables.} \item{data}{either a data frame, or an object of class \code{"table"} or \code{"ftable"}.} \item{subset}{an optional vector specifying a subset of observations to be used.} \item{na.action}{a function which indicates what should happen when the data contain \code{NA}s. Ignored if \code{data} is a contingency table.} \item{log}{logical. Should the results be displayed on a log scale or not? All internal computations are always on the log-scale but the results are transformed by default if \code{log = TRUE}.} \item{correct}{logical or numeric. Should a continuity correction be applied before computing odds ratios? If \code{TRUE}, 0.5 is added to all cells; if numeric (or an array conforming to the data) that value is added to all cells. By default, this not employed unless there are any zero cells in the table, but this correction is often recommended to reduce bias when some frequencies are small (Fleiss, 1981).} \item{a, object}{an object of class \code{loddsratio} as computed by \code{loddsratio}.} \item{perm}{numeric or character vector specifying a permutation of strata.} \item{\dots}{arguments passed to methods.} \item{parm}{a specification of which parameters are to be given confidence intervals, either a vector of numbers or a vector of names. If missing, all parameters are considered.} \item{level}{the confidence level required for the \code{confint} method.} } \details{ For an R x C table, (log) odds ratios are formed for the set of (R-1) x (C-1) 2 x 2 tables, corresponding to some set of contrasts among the row and column variables. The \code{ref} argument allows these to be specified in a general way. \code{ref = NULL} (default) corresponds to \dQuote{profile contrasts} (or sequential contrasts or successive differences) for ordered categories, i.e., R1--R2, R2--R3, R3--R4, etc., and similarly for the column categories. These are sometimes called \dQuote{local odds ratios}. \code{ref = 1} gives contrasts with the first category; \code{ref = dim(x)} gives contrasts with the last category; \code{ref = c(2, 4)} or \code{ref = list(2, 4)} corresponds to the reference being the second category in rows and the fourth in columns. Combinations like \code{ref = list(NULL, 3)} are also possible, as are character vectors, e.g., \code{ref = c("foo", "bar")} also works ("foo" pertaining again to the row reference and "bar" to column reference). Note that all such parameterizations are equivalent, in that one can derive all other possible odds ratios from any non-redundant set, but the interpretation of these values depends on the parameterization. Note also that these reference level parameterizations only have meaning when the primary (non-strata) table dimensions are larger than 2x2. In the 2x2 case, the odds ratios are defined by the order of levels of those variables in the table, so you can achieve a desired interpretation by manipulating the table. See the help page of \code{\link{plot.loddsratio}} for visualization methods. } \value{ An object of class \code{loddsratio}, with the following components: \item{coefficients}{A named vector, of length (R-1) x (C-1) x \code{prod(dim(x)[strata])} containing the log odds ratios. Use the \code{coef} method to extract these from the object, and the \code{confint} method for confidence intervals. For a two-way table, the names for the log odds ratios are constructed in the form Ri:Rj/Ci:Cj using the table names for rows and columns. For a stratified table, the names are constructed in the form Ri:Rj/Ci:Cj|Lk. } \item{vcov}{Variance covariance matrix of the log odds ratios.} \item{dimnames}{Dimension names for the log odds ratios, considered as a table of size (R-1, C-1, \code{dim(x)[strata]}). Use the \code{dim} and \code{dimnames} methods to extract these and manipulate the log odds ratios in relation to the original table.} \item{dim}{Corresponding dimension vector.} \item{contrasts}{A matrix C, such that \code{C \%*\% as.vector(log(x))} gives the log odds ratios. Each row corresponds to one log odds ratio, and is all zero, except for 4 elements of \code{c(1, -1, -1, 1)} for a given 2 x 2 subtable.} \item{log}{A logical, indicating the value of \code{log} in the original call.} } \references{ A. Agresti (2013), \emph{Categorical Data Analysis}, 3rd Ed. New York: Wiley. Fleiss, J. L. (1981). \emph{Statistical Methods for Rates and Proportions}. 2nd Edition. New York: Wiley. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. Friendly, M., Turner, H,, Firth, D., Zeileis, A. (2011). \emph{Advances in Visualizing Categorical Data Using the vcd, gnm and vcdExtra Packages in R}. Correspondence Analysis and Related Methods (CARME 2011). \url{http://www.datavis.ca/papers/adv-vcd-4up.pdf} } \author{ Achim Zeileis, Michael Friendly and David Meyer. } \note{ The method of calculation is an example of the use of the delta method described by Agresti (2013), Section 16.1.6, giving estimates of log odds ratios and their asymptotic covariance matrix. The \code{coef} method returns the \code{coefficients} component as a vector of length (R-1) x (C-1) x \code{prod(dim(x)[strata])}. The \code{dim} and \code{dimnames} methods provide the proper attributes for treating the \code{coefficients} vector as an (R-1) x (C-1) x strata array. \code{as.matrix} and \code{as.array} methods are also provided for this purpose. The \code{confint} method computes confidence intervals for the log odds ratios (or for odds ratios, with \code{log = FALSE}). The \code{\link[lmtest]{coeftest}} method (\code{summary} is an alias) prints the asymptotic standard errors, z tests (standardized log odds ratios), and the corresponding p values. \emph{Structural zeros}: In addition to the options for zero cells provided by \code{correct}, the function allows for structural zeros to be represented as \code{NA} in the data argument. \code{NA} in the data yields \code{NA} as the \code{LOR} estimate, but does not affect other cells. \code{oddsratio} is just an alias to \code{loddsratio} for backward compatibility. } %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ %%\code{\link[vcd]{oddsratio}}, \code{\link{plot.loddsratio}} for some plotting methods; \code{\link[stats]{confint}} for confidence intervals; \code{\link[lmtest]{coeftest}} for z-tests of significance } \examples{ ## artificial example set.seed(1) x <- matrix(rpois(5 * 3, 7), ncol = 5, nrow = 3) dimnames(x) <- list(Row = head(letters, 3), Col = tail(letters, 5)) x_lor <- loddsratio(x) coef(x_lor) x_lor confint(x_lor) summary(x_lor) ## 2 x 2 x k cases #data(CoalMiners, package = "vcd") lor_CM <- loddsratio(CoalMiners) lor_CM coef(lor_CM) confint(lor_CM) confint(lor_CM, log = FALSE) ## 2 x k x 2 lor_Emp <-loddsratio(Employment) lor_Emp confint(lor_Emp) ## 4 way tables data(Punishment, package = "vcd") lor_pun <- loddsratio(Freq ~ memory + attitude | age + education, data = Punishment) lor_pun confint(lor_pun) summary(lor_pun) # fit linear model using WLS lor_pun_df <- as.data.frame(lor_pun) pun_mod1 <- lm(LOR ~ as.numeric(age) * as.numeric(education), data = lor_pun_df, weights = 1 / ASE^2) anova(pun_mod1) ## illustrate ref levels VA.fem <- xtabs(Freq ~ left + right, subset=gender=="female", data=VisualAcuity) VA.fem loddsratio(VA.fem) # profile contrasts loddsratio(VA.fem, ref=1) # contrasts against level 1 loddsratio(VA.fem, ref=dim(VA.fem)) # contrasts against level 4 } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{category} %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line vcd/man/DanishWelfare.Rd0000755000175100001440000000230011150520606014614 0ustar hornikusers\name{DanishWelfare} \alias{DanishWelfare} \docType{data} \title{Danish Welfare Study Data} \description{ Data from the Danish Welfare Study. } \usage{data("DanishWelfare")} \format{ A data frame with 180 observations and 5 variables. \describe{ \item{Freq}{frequency.} \item{Alcohol}{factor indicating daily alcohol consumption: less than 1 unit (<1), 1-2 units (1-2) or more than 2 units (>2). 1 unit is approximately 1 bottle of beer or 4cl 40\% alcohol.} \item{Income}{factor indicating income group in 1000 DKK (0-50, 50-100, 100-150, >150).} \item{Status}{factor indicating marriage status (Widow, Married, Unmarried).} \item{Urban}{factor indicating urbanization: Copenhagen (Copenhagen), Suburbian Copenhagen (SubCopenhagen), three largest cities (LargeCity), other cities (City), countryside (Country).} } } \references{ E. B. Andersen (1991), \emph{The Statistical Analysis of Categorical Data}. 2nd edition. Springer-Verlag, Berlin. } \source{ E. B. Andersen (1991), The Statistical Analysis of Categorical Data, page 205. } \examples{ data("DanishWelfare") ftable(xtabs(Freq ~ ., data = DanishWelfare)) } \keyword{datasets} vcd/man/plot.loddsratio.Rd0000644000175100001440000001456612535257174015256 0ustar hornikusers\name{plot.loddsratio} \alias{plot.loddsratio} \title{Plotting (Log) Odds Ratios} \description{ Produces a (conditional) line plot of extended (log) odds ratios. } \usage{ \method{plot}{loddsratio}(x, baseline = TRUE, gp_baseline = gpar(lty = 2), lines = TRUE, lwd_lines = 3, confidence = TRUE, conf_level = 0.95, lwd_confidence = 2, whiskers = 0, transpose = FALSE, col = NULL, cex = 0.8, pch = NULL, bars = NULL, gp_bars = gpar(fill = "lightgray", alpha = 0.5), bar_width = unit(0.05, "npc"), legend = TRUE, legend_pos = "topright", legend_inset = c(0, 0), legend_vgap = unit(0.5, "lines"), gp_legend_frame = gpar(lwd = 1, col = "black"), gp_legend_title = gpar(fontface = "bold"), gp_legend = gpar(), legend_lwd = 1, legend_size = 1, xlab = NULL, ylab = NULL, xlim = NULL, ylim = NULL, main = NULL, gp_main = gpar(fontsize = 12, fontface = "bold"), newpage = TRUE, pop = FALSE, return_grob = FALSE, prefix = "", \dots) } \arguments{ \item{x}{an object of class \code{loddsratio}.} \item{baseline}{if \code{TRUE}, a dashed line is plotted at a value of 1 (in case of odds) or 0 (in case of log-odds).} \item{gp_baseline}{object of class \code{"gpar"} used for the baseline.} \item{lines}{if \code{TRUE}, the points are connected by lines (only sensible if the variable represented by the x-axis is ordinal).} \item{lwd_lines}{Width of the connecting lines (in \code{char} units).} \item{confidence}{logical; shall confindence intervals be plotted?} \item{conf_level}{confidence level used for confidence intervals.} \item{lwd_confidence}{Line width of the confidence interval bars (in \code{char} units).} \item{whiskers}{width of the confidence interval whiskers.} \item{transpose}{if \code{TRUE}, the plot is transposed.} \item{col}{character vector specifying the colors of the fitted lines, by default chosen with \code{\link[colorspace]{rainbow_hcl}}.} \item{cex}{size of the plot symbols (in lines).} \item{pch}{character or numeric vector of symbols used for plotting the (possibly conditioned) observed values, recycled as needed.} \item{bars}{logical; shall bars be plotted additionally to the points? Defaults to \code{TRUE} in case of only one conditioning variable.} \item{gp_bars}{object of class \code{"gpar"} used for the bars.} \item{bar_width}{Width of the bars, if drawn.} \item{legend}{logical; if \code{TRUE} (default), a legend is drawn.} \item{legend_pos}{numeric vector of length 2, specifying x and y coordinates of the legend, or a character string (e.g., \code{"topleft"}, \code{"center"} etc.). Defaults to \code{"topleft"} if the fitted curve's slope is positive, and \code{"topright"} else.} \item{legend_inset}{numeric vector or length 2 specifying the inset from the legend's x and y coordinates in npc units.} \item{legend_vgap}{vertical space between the legend's line entries.} \item{gp_legend_frame}{object of class \code{"gpar"} used for the legend frame.} \item{gp_legend_title}{object of class \code{"gpar"} used for the legend title.} \item{gp_legend}{object of class \code{"gpar"} used for the legend defaults.} \item{legend_lwd}{line width used in the legend for the different groups.} \item{legend_size}{size used for the group symbols (in char units).} \item{xlab}{label for the x-axis. Defaults to \code{"Strata"} if \code{transpose} is \code{FALSE}.} \item{ylab}{label for the y-axis. Defaults to \code{"Strata"} if \code{transpose} is \code{TRUE}.} \item{xlim}{x-axis limits. Ignored if \code{transpose} is \code{FALSE}.} \item{ylim}{y-axis limits. Ignored if \code{transpose} is \code{TRUE}.} \item{main}{user-specified main title.} \item{gp_main}{object of class \code{"gpar"} used for the main title.} \item{newpage}{logical; if \code{TRUE}, the plot is drawn on a new page.} \item{pop}{logical; if \code{TRUE}, all newly generated viewports are popped after plotting.} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{prefix}{character string used as prefix for the viewport name.} \item{\dots}{other graphics parameters (see \code{\link{par}}).} } \value{ if \code{return_grob} is \code{TRUE}, a grob object corresponding to the plot. \code{NULL} (invisibly) else. } \details{ The function basically produces conditioned line plots of the (log) odds ratios structure provided in \code{x}. \code{\link{cotabplot}} can be used for stratified analyses (see examples). } \references{ M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{loddsratio}} } \examples{ ## 2 x 2 x k cases data(CoalMiners, package = "vcd") lor_CM <- loddsratio(CoalMiners) plot(lor_CM) lor_CM_df <- as.data.frame(lor_CM) # fit linear models using WLS age <- seq(20, 60, by = 5) lmod <- lm(LOR ~ age, weights = 1 / ASE^2, data = lor_CM_df) grid.lines(seq_along(age), fitted(lmod), gp = gpar(col = "blue", lwd = 2), default.units = "native") qmod <- lm(LOR ~ poly(age, 2), weights = 1 / ASE^2, data = lor_CM_df) grid.lines(seq_along(age), fitted(qmod), gp = gpar(col = "red", lwd = 2), default.units = "native") ## 2 x k x 2 lor_Emp <-loddsratio(Employment) plot(lor_Emp) ## 4 way tables data(Punishment, package = "vcd") mosaic(attitude ~ age + education + memory, data = Punishment, highlighting_direction="left", rep = c(attitude = FALSE)) # visualize the log odds ratios, by education plot(loddsratio(~ attitude + memory | education, data = Punishment)) # visualize the log odds ratios, by age plot(loddsratio(~ attitude + memory | age, data = Punishment)) # visualize the log odds ratios, by age and education plot(loddsratio(~ attitude + memory | age + education, data = Punishment)) # same, transposed plot(loddsratio(~ attitude + memory | age + education, data = Punishment), transpose = TRUE) # alternative visualization methods image(loddsratio(Freq ~ ., data = Punishment)) tile(loddsratio(Freq ~ ., data = Punishment)) ## cotabplots for more complex tables cotabplot(Titanic, cond = c("Age","Sex"), panel = cotab_loddsratio) cotabplot(Freq ~ opinion + grade + year | gender, data = JointSports, panel = cotab_loddsratio) cotabplot(Freq ~ opinion + grade | year + gender, data = JointSports, panel = cotab_loddsratio) } \keyword{category} vcd/man/agreementplot.Rd0000655000175100001440000001144712472414135014770 0ustar hornikusers\name{agreementplot} \alias{agreementplot} \alias{agreementplot.default} \alias{agreementplot.formula} \title{Bangdiwala's Observer Agreement Chart} \description{ Representation of a \eqn{k \times k}{k by k} confusion matrix, where the observed and expected diagonal elements are represented by superposed black and white rectangles, respectively. The function also computes a statistic measuring the strength of agreement (relation of respective area sums). } \usage{ \method{agreementplot}{default}(x, reverse_y = TRUE, main = NULL, weights = c(1, 1 - 1/(ncol(x) - 1)^2), margins = par("mar"), newpage = TRUE, pop = TRUE, xlab = names(dimnames(x))[2], ylab = names(dimnames(x))[1], xlab_rot = 0, xlab_just = "center", ylab_rot = 90, ylab_just = "center", fill_col = function(j) gray((1 - (weights[j]) ^ 2) ^ 0.5), line_col = "red", xscale = TRUE, yscale = TRUE, return_grob = FALSE, prefix = "", \dots) \method{agreementplot}{formula}(formula, data = NULL, ..., subset) } \arguments{ \item{x}{a confusion matrix, i.e., a table with equal-sized dimensions.} \item{reverse_y}{if \code{TRUE}, the y axis is reversed (i.e., the rectangles' positions correspond to the contingency table).} \item{main}{user-specified main title.} \item{weights}{vector of weights for successive larger observed areas, used in the agreement strength statistic, and also for the shading. The first element should be 1.} \item{margins}{vector of margins (see \code{\link[graphics]{par}}).} \item{newpage}{logical; if \code{TRUE}, the plot is drawn on a new page.} \item{pop}{logical; if \code{TRUE}, all newly generated viewports are popped after plotting.} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{xlab, ylab}{labels of x- and y-axis.} \item{xlab_rot, ylab_rot}{rotation angle for the category labels.} \item{xlab_just, ylab_just}{justification for the category labels.} \item{fill_col}{a function, giving the fill colors used for exact and partial agreement} \item{line_col}{color used for the diagonal reference line} \item{formula}{a formula, such as \code{y ~ x}. For details, see \code{\link{xtabs}}.} \item{data}{a data frame (or list), or a contingency table from which the variables in \code{formula} should be taken.} \item{subset}{an optional vector specifying a subset of the rows in the data frame to be used for plotting.} \item{xscale, yscale}{logicals indicating whether the marginals should be added on the x-axis/y-axis, respectively.} \item{prefix}{character string used as prefix for the viewport name} \item{\dots}{further graphics parameters (see \code{\link{par}}).} } \details{ Weights can be specified to allow for partial agreement, taking into account contributions from off-diagonal cells. Partial agreement is typically represented in the display by lighter shading, as given by \code{fill_col(j)}, corresponding to \code{weights[j]}. A weight vector of length 1 means strict agreement only, each additional element increases the maximum number of disagreement steps. \code{\link{cotabplot}} can be used for stratified analyses (see examples). } \value{ Invisibly returned, a list with components \item{Bangdiwala}{the unweighted agreement strength statistic.} \item{Bangdiwala_Weighted}{the weighted statistic.} \item{weights}{the weight vector used.} } \references{ Bangdiwala, S. I. (1988). The Agreement Chart. Department of Biostatistics, University of North Carolina at Chapel Hill, Institute of Statistics Mimeo Series No. 1859, \url{http://www.stat.ncsu.edu/information/library/mimeo.archive/ISMS_1988_1859.pdf} Bangdiwala, S. I., Ana S. Haedo, Marcela L. Natal, and Andres Villaveces. The agreement chart as an alternative to the receiver-operating characteristic curve for diagnostic tests. \emph{Journal of Clinical Epidemiology}, 61 (9), 866-874. Michael Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ data("SexualFun") agreementplot(t(SexualFun)) data("MSPatients") \dontrun{ ## best visualized using a resized device, e.g. using: ## get(getOption("device"))(width = 12) pushViewport(viewport(layout = grid.layout(ncol = 2))) pushViewport(viewport(layout.pos.col = 1)) agreementplot(t(MSPatients[,,1]), main = "Winnipeg Patients", newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 2)) agreementplot(t(MSPatients[,,2]), main = "New Orleans Patients", newpage = FALSE) popViewport(2) dev.off() } ## alternatively, use cotabplot: cotabplot(MSPatients, panel = cotab_agreementplot) } \keyword{category} \keyword{hplot} vcd/man/struc_mosaic.Rd0000655000175100001440000000613412532005603014603 0ustar hornikusers\name{struc_mosaic} \alias{struc_mosaic} \title{Core-generating Function for Mosaic Plots} \description{ Core-generating function for \code{strucplot} returning a function producing mosaic plots. } \usage{ struc_mosaic(zero_size = 0.5, zero_split = FALSE, zero_shade = TRUE, zero_gp = gpar(col = 0), panel = NULL) } \arguments{ \item{zero_size}{size of the bullets used for zero-entries in the contingency table (if 0, no bullets are drawn).} \item{zero_split}{logical controlling whether zero cells should be further split. If \code{FALSE} and \code{zero_shade} is \code{FALSE}, only one bullet is drawn (centered) for unsplit zero cells. If \code{FALSE} and \code{zero_shade} is \code{TRUE}, a bullet for each zero cell is drawn to allow, e.g., residual-based shadings to be effective also for zero cells.} \item{zero_shade}{logical controlling whether zero bullets should be shaded.} \item{zero_gp}{object of class \code{"gpar"} used for zero bullets in case they are \emph{not} shaded.} \item{panel}{Optional function with arguments: \code{residuals}, \code{observed}, \code{expected}, \code{index}, \code{gp}, and \code{name} called by the \code{struc_mosaic} workhorse for each tile that is drawn in the mosaic. \code{index} is an integer vector with the tile's coordinates in the contingency table, \code{gp} a \code{gpar} object for the tile, and \code{name} a label to be assigned to the drawn grid object.} } \details{ This function is usually called by \code{\link{strucplot}} (typically when called by \code{\link{mosaic}}) and returns a function used by \code{\link{strucplot}} to produce mosaic plots. } \value{ A function with arguments: \item{residuals}{table of residuals.} \item{observed}{table of observed values.} \item{expected}{not used by \code{struc_mosaic}.} \item{spacing}{object of class \code{"unit"} specifying the space between the tiles.} \item{gp}{list of \code{gpar} objects used for the drawing the tiles.} \item{split_vertical}{vector of logicals indicating, for each dimension of the table, the split direction.} } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{mosaic}}, \code{\link{strucplot}}, \code{\link{structable}} } \references{ Cohen, A. (1980), On the graphical display of the significant components in a two-way contingency table. \emph{Communications in Statistics---Theory and Methods}, \bold{A9}, 1025--1041. Friendly, M. (1992), Graphical methods for categorical data. \emph{SAS User Group International Conference Proceedings}, \bold{17}, 190--200. \url{http://datavis.ca/papers/sugi/sugi17.pdf} Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. URL http://www.jstatsoft.org/v17/i03/ and available as \code{vignette("strucplot")}. } \examples{ ## Titanic data data("Titanic") ## mosaic plot with large zeros strucplot(Titanic, core = struc_mosaic(zero_size = 1)) } \keyword{hplot} vcd/man/VonBort.Rd0000755000175100001440000000256611150520606013507 0ustar hornikusers\name{VonBort} \alias{VonBort} \docType{data} \title{Von Bortkiewicz Horse Kicks Data} \description{ Data from von Bortkiewicz (1898), given by Andrews \& Herzberg (1985), on number of deaths by horse or mule kicks in 14 corps of the Prussian army. } \usage{ data("VonBort") } \format{ A data frame with 280 observations and 4 variables. \describe{ \item{deaths}{number of deaths.} \item{year}{year of the deaths.} \item{corps}{factor indicating the corps.} \item{fisher}{factor indicating whether the corresponding corps was considered by Fisher (1925) or not.} } } \references{ D. F. Andrews \& A. M. Herzberg (1985), \emph{Data: A Collection of Problems from Many Fields for the Student and Research Worker}. Springer-Verlag, New York, NY. R. A. Fisher (1925), \emph{Statistical Methods for Research Workers}. Oliver & Boyd, London. L. von Bortkiewicz (1898), \emph{Das Gesetz der kleinen Zahlen}. Teubner, Leipzig. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data: \url{http://euclid.psych.yorku.ca/ftp/sas/vcd/catdata/vonbort.sas} } \seealso{ \code{\link{HorseKicks}} for a popular subsample. } \examples{ data("VonBort") ## HorseKicks data xtabs(~ deaths, data = VonBort, subset = fisher == "yes") } \keyword{datasets} vcd/man/RepVict.Rd0000755000175100001440000000264411150520606013467 0ustar hornikusers\name{RepVict} \alias{RepVict} \docType{data} \title{Repeat Victimization Data} \description{ Data from Reiss (1980) given by Fienberg (1980) about instances of repeat victimization for households in the U.S. National Crime Survey. } \usage{ data("RepVict") } \format{ A 2-dimensional array resulting from cross-tabulating victimization. The variables and their levels are as follows: \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab First Victimization \tab Rape, Assault, Robbery, Pickpocket, Personal Larceny, \cr \tab \tab Burglary, Household Larceny, Auto Theft \cr 2 \tab Second Victimization \tab Rape, Assault, Robbery, Pickpocket, Personal Larceny,\cr \tab \tab Burglary, Household Larceny, Auto Theft } } \references{ S. E. Fienberg (1980), \emph{The Analysis of Cross-Classified Categorical Data}, MIT Press, Cambridge, 2nd edition. A. J. J. Reiss (1980), Victim proneness by type of crime in repeat victimization. In S. E. Fienberg & A. J. J. Reiss (eds.), \emph{Indicators of Crime and Criminal Justice}. U.S. Government Printing Office, Washington, DC. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data, page 113. } \examples{ data("RepVict") mosaic(RepVict[-c(4,7),-c(4,7)], gp = shading_max, main = "Repeat Victimization Data") } \keyword{datasets} vcd/man/ternaryplot.Rd0000655000175100001440000001027312444612666014511 0ustar hornikusers\name{ternaryplot} \alias{ternaryplot} \title{Ternary Diagram} \description{ Visualizes compositional, 3-dimensional data in an equilateral triangle. } \usage{ ternaryplot(x, scale = 1, dimnames = NULL, dimnames_position = c("corner","edge","none"), dimnames_color = "black", id = NULL, id_color = "black", id_just = c("center", "center"), coordinates = FALSE, grid = TRUE, grid_color = "gray", labels = c("inside", "outside", "none"), labels_color = "darkgray", border = "black", bg = "white", pch = 19, cex = 1, prop_size = FALSE, col = "red", main = "ternary plot", newpage = TRUE, pop = TRUE, return_grob = FALSE, \dots) } \arguments{ \item{x}{a matrix with three columns.} \item{scale}{row sums scale to be used.} \item{dimnames}{dimension labels (defaults to the column names of \code{x}).} \item{dimnames_position, dimnames_color}{position and color of dimension labels.} \item{id}{optional labels to be plotted below the plot symbols. \code{coordinates} and \code{id} are mutual exclusive.} \item{id_color}{color of these labels.} \item{id_just}{character vector of length 1 or 2 indicating the justification of these labels.} \item{coordinates}{if \code{TRUE}, the coordinates of the points are plotted below them. \code{coordinates} and \code{id} are mutual exclusive.} \item{grid}{if \code{TRUE}, a grid is plotted. May optionally be a string indicating the line type (default: \code{"dotted"}).} \item{grid_color}{grid color.} \item{labels, labels_color}{position and color of the grid labels.} \item{border}{color of the triangle border.} \item{bg}{triangle background.} \item{pch}{plotting character. Defaults to filled dots.} \item{cex}{a numerical value giving the amount by which plotting text and symbols should be scaled relative to the default. Ignored for the symbol size if \code{prop_size} is not \code{FALSE}.} \item{prop_size}{if \code{TRUE}, the symbol size is plotted proportional to the row sum of the three variables, i.e., represents the weight of the observation.} \item{col}{plotting color.} \item{main}{main title.} \item{newpage}{if \code{TRUE}, the plot will appear on a new graphics page.} \item{pop}{logical; if \code{TRUE}, all newly generated viewports are popped after plotting.} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{\dots}{additional graphics parameters (see \code{par})} } \details{ A points' coordinates are found by computing the gravity center of mass points using the data entries as weights. Thus, the coordinates of a point \eqn{P(a,b,c)}, \eqn{a + b + c = 1}, are: \eqn{P(b + c/2, c \sqrt{3}/2)}{P(b + c/2, c * sqrt(3)/2)}. } \references{ M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ data("Arthritis") ## Build table by crossing Treatment and Sex tab <- as.table(xtabs(~ I(Sex:Treatment) + Improved, data = Arthritis)) ## Mark groups col <- c("red", "red", "blue", "blue") pch <- c(1, 19, 1, 19) ## plot ternaryplot( tab, col = col, pch = pch, prop_size = TRUE, bg = "lightgray", grid_color = "white", labels_color = "white", main = "Arthritis Treatment Data" ) ## legend grid_legend(0.8, 0.7, pch, col, rownames(tab), title = "GROUP") ## Titanic data("Lifeboats") attach(Lifeboats) ternaryplot( Lifeboats[,4:6], pch = ifelse(side == "Port", 1, 19), col = ifelse(side == "Port", "red", "blue"), id = ifelse(men / total > 0.1, as.character(boat), NA), prop_size = 2, dimnames_position = "edge", main = "Lifeboats on Titanic" ) grid_legend(0.8, 0.9, c(1, 19), c("red", "blue"), c("Port", "Starboard"), title = "SIDE") ## Hitters data("Hitters") attach(Hitters) colors <- c("black","red","green","blue","red","black","blue") pch <- substr(levels(Positions), 1, 1) ternaryplot( Hitters[,2:4], pch = as.character(Positions), col = colors[as.numeric(Positions)], main = "Baseball Hitters Data" ) grid_legend(0.8, 0.9, pch, colors, levels(Positions), title = "POSITION(S)") } \keyword{hplot} vcd/man/WeldonDice.Rd0000755000175100001440000000223611150520606014125 0ustar hornikusers\name{WeldonDice} \alias{WeldonDice} \docType{data} \title{Weldon's Dice Data} \description{ Data from Pearson (1900) about the frequency of 5s and 6s in throws of 12 dice. Weldon tossed the dice 26,306 times and reported his results in a letter to Francis Galton on 1894-02-02. } \usage{ data("WeldonDice") } \format{ A 1-way table giving the frequency of a 5 or a 6 in 26,306 throws of 12 dice where 10 indicates \sQuote{10 or more} 5s or 6s. The variable and its levels are \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab n56 \tab 0, 1, \dots, 10 \cr } } \references{ K. Pearson (1900), On the criterion that a given system of deviations from the probable in the case of a correlated system of variables is such that it can be reasonably supposed to have arisen by random sampling, \emph{Philosophical Magazine}, \bold{50} (5th series), 157--175. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ M. Friendly (2000), Visualizing Categorical Data, pages 20--21. } \examples{ data("WeldonDice") gf <- goodfit(WeldonDice, type = "binomial") summary(gf) plot(gf) } \keyword{datasets} vcd/man/goodfit.Rd0000655000175100001440000001217412511041104013535 0ustar hornikusers\name{goodfit} \alias{goodfit} \alias{summary.goodfit} \alias{plot.goodfit} \alias{predict.goodfit} \alias{fitted.goodfit} \alias{residuals.goodfit} \alias{print.goodfit} \title{Goodness-of-fit Tests for Discrete Data} \description{ Fits a discrete (count data) distribution for goodness-of-fit tests. } \usage{ goodfit(x, type = c("poisson", "binomial", "nbinomial"), method = c("ML", "MinChisq"), par = NULL) \method{predict}{goodfit}(object, newcount = NULL, type = c("response", "prob"), \dots) \method{residuals}{goodfit}(object, type = c("pearson", "deviance", "raw"), \dots) \method{print}{goodfit}(x, residuals_type = c("pearson", "deviance", "raw"), \dots) } \arguments{ \item{x}{either a vector of counts, a 1-way table of frequencies of counts or a data frame or matrix with frequencies in the first column and the corresponding counts in the second column.} \item{type}{character string indicating: for \code{goodfit}, which distribution should be fit; for \code{predict}, the type of prediction (fitted response or probabilities); for \code{residuals}, either \code{"pearson"}, \code{"deviance"} or \code{"raw"}.} \item{residuals_type}{character string indicating the type of residuals: either \code{"pearson"}, \code{"deviance"} or \code{"raw"}.} \item{method}{a character string indicating whether the distribution should be fit via ML (Maximum Likelihood) or Minimum Chi-squared.} \item{par}{a named list giving the distribution parameters (named as in the corresponding density function), if set to \code{NULL}, the default, the parameters are estimated. If the parameter \code{size} is not specified if \code{type} is \code{"binomial"} it is taken to be the maximum count. If \code{type} is \code{"nbinomial"}, then parameter \code{size} can be specified to fix it so that only the parameter \code{prob} will be estimated (see the examples below).} \item{object}{an object of class \code{"goodfit"}.} \item{newcount}{a vector of counts. By default the counts stored in \code{object} are used, i.e., the fitted values are computed. These can also be extracted by \code{fitted(object)}.} \item{\dots}{\emph{currently not used}.} } \details{ \code{goodfit} essentially computes the fitted values of a discrete distribution (either Poisson, binomial or negative binomial) to the count data given in \code{x}. If the parameters are not specified they are estimated either by ML or Minimum Chi-squared. To fix parameters, \code{par} should be a named list specifying the parameters \code{lambda} for \code{"poisson"} and \code{prob} and \code{size} for \code{"binomial"} or \code{"nbinomial"}, respectively. If for \code{"binomial"}, \code{size} is not specified it is not estimated but taken as the maximum count. The corresponding Pearson Chi-squared or likelihood ratio statistic, respectively, is computed and given with their \eqn{p} values by the \code{summary} method. The \code{summary} method always prints this information and returns a matrix with the printed information invisibly. The \code{plot} method produces a \code{\link{rootogram}} of the observed and fitted values. In case of count distribtions (Poisson and negative binomial), the minimum Chi-squared approach is somewhat ad hoc. Strictly speaking, the Chi-squared asymptotics would only hold if the number of cells were fixed or did not increase too quickly with the sample size. However, in \code{goodfit} the number of cells is data-driven: Each count is a cell of its own. All counts larger than the maximal count are merged into the cell with the last count for computing the test statistic. } \value{ A list of class \code{"goodfit"} with elements: \item{observed}{observed frequencies.} \item{count}{corresponding counts.} \item{fitted}{expected frequencies (fitted by ML).} \item{type}{a character string indicating the distribution fitted.} \item{method}{a character string indicating the fitting method (can be either \code{"ML"}, \code{"MinChisq"} or \code{"fixed"} if the parameters were specified).} \item{df}{degrees of freedom.} \item{par}{a named list of the (estimated) distribution parameters.} } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \references{ M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \seealso{\code{\link{rootogram}}} \examples{ ## Simulated data examples: dummy <- rnbinom(200, size = 1.5, prob = 0.8) gf <- goodfit(dummy, type = "nbinomial", method = "MinChisq") summary(gf) plot(gf) dummy <- rbinom(100, size = 6, prob = 0.5) gf1 <- goodfit(dummy, type = "binomial", par = list(size = 6)) gf2 <- goodfit(dummy, type = "binomial", par = list(prob = 0.6, size = 6)) summary(gf1) plot(gf1) summary(gf2) plot(gf2) ## Real data examples: data("HorseKicks") HK.fit <- goodfit(HorseKicks) summary(HK.fit) plot(HK.fit) data("Federalist") ## try geometric and full negative binomial distribution F.fit <- goodfit(Federalist, type = "nbinomial", par = list(size = 1)) F.fit2 <- goodfit(Federalist, type = "nbinomial") summary(F.fit) summary(F.fit2) plot(F.fit) plot(F.fit2) } \keyword{category} vcd/man/mosaic.Rd0000755000175100001440000002404312442413710013365 0ustar hornikusers\name{mosaic} \alias{mosaic} \alias{mosaic.default} \alias{mosaic.formula} \title{Extended Mosaic Plots} \description{ Plots (extended) mosaic displays. } \usage{ \method{mosaic}{default}(x, condvars = NULL, split_vertical = NULL, direction = NULL, spacing = NULL, spacing_args = list(), gp = NULL, expected = NULL, shade = NULL, highlighting = NULL, highlighting_fill = grey.colors, highlighting_direction = NULL, zero_size = 0.5, zero_split = FALSE, zero_shade = NULL, zero_gp = gpar(col = 0), panel = NULL, main = NULL, sub = NULL, \dots) \method{mosaic}{formula}(formula, data, highlighting = NULL, \dots, main = NULL, sub = NULL, subset = NULL, na.action = NULL) } \arguments{ \item{x}{a contingency table in array form, with optional category labels specified in the \code{dimnames(x)} attribute, or an object of class \code{"structable"}.} \item{condvars}{vector of integers or character strings indicating conditioning variables, if any. The table will be permuted to order them first.} \item{formula}{a formula specifying the variables used to create a contingency table from \code{data}. For convenience, conditioning formulas can be specified; the conditioning variables will then be used first for splitting. If any, a specified response variable will be highlighted in the cells.} \item{data}{either a data frame, or an object of class \code{"table"} or \code{"ftable"}.} \item{subset}{an optional vector specifying a subset of observations to be used.} \item{na.action}{a function which indicates what should happen when the data contain \code{NA}s. Ignored if \code{data} is a contingency table.} \item{zero_size}{size of the bullets used for zero entries (if 0, no bullets are drawn).} \item{zero_split}{logical controlling whether zero cells should be further split. If \code{FALSE} and \code{zero_shade} is \code{FALSE}, only one bullet is drawn (centered) for unsplit zero cells. If \code{FALSE} and \code{zero_shade} is \code{TRUE}, a bullet for each zero cell is drawn to allow, e.g., residual-based shadings to be effective also for zero cells.} \item{zero_shade}{logical controlling whether zero bullets should be shaded. The default is \code{TRUE} if \code{shade} is \code{TRUE} or \code{expected} is not null or \code{gp} is not null, and \code{FALSE} otherwise.} \item{zero_gp}{object of class \code{"gpar"} used for zero bullets in case they are \emph{not} shaded.} \item{split_vertical}{vector of logicals of length \eqn{k}, where \eqn{k} is the number of margins of \code{x} (default: \code{FALSE}). Values are recycled as needed. A \code{TRUE} component indicates that the tile(s) of the corresponding dimension should be split vertically, \code{FALSE} means horizontal splits. Ignored if \code{direction} is not \code{NULL}.} \item{direction}{character vector of length \eqn{k}, where \eqn{k} is the number of margins of \code{x} (values are recycled as needed). For each component, a value of \code{"h"} indicates that the tile(s) of the corresponding dimension should be split horizontally, whereas \code{"v"} indicates vertical split(s).} \item{spacing}{spacing object, spacing function, or corresponding generating function (see \code{\link{strucplot}} for more information). The default is \code{spacing_equal} if \code{x} has two dimensions, \code{spacing_increase} for more dimensions, and \code{spacing_conditional} if conditioning variables are specified using \code{condvars} or the formula interface.} \item{spacing_args}{list of arguments for the generating function, if specified (see \code{\link{strucplot}} for more information).} \item{gp}{object of class \code{"gpar"}, shading function or a corresponding generating function (see details and \code{\link{shadings}}). Components of \code{"gpar"} objects are recycled as needed along the last splitting dimension. Ignored if \code{shade = FALSE}.} \item{shade}{logical specifying whether \code{gp} should be used or not (see \code{gp}). If \code{TRUE} and \code{expected} is unspecified, a default model is fitted: if \code{condvars} (see \code{\link{strucplot}}) is specified, a corresponding conditional independence model, and else the total independence model.} \item{expected}{optionally, an array of expected values of the same dimension as \code{x}, or alternatively the corresponding independence model specification as used by \code{\link[stats]{loglin}} or \code{\link[MASS]{loglm}} (see \code{\link{strucplot}}).} \item{highlighting}{character vector or integer specifying a variable to be highlighted in the cells.} \item{highlighting_fill}{color vector or palette function used for a highlighted variable, if any.} \item{highlighting_direction}{Either \code{"left"}, \code{"right"}, \code{"top"}, or \code{"bottom"} specifying the direction of highlighting in the cells.} \item{panel}{Optional function with arguments: \code{residuals}, \code{observed}, \code{expected}, \code{index}, \code{gp}, and \code{name} called by the \code{struc_mosaic} workhorse for each tile that is drawn in the mosaic. \code{index} is an integer vector with the tile's coordinates in the contingency table, \code{gp} a \code{gpar} object for the tile, and \code{name} a label to be assigned to the drawn grid object.} \item{main, sub}{either a logical, or a character string used for plotting the main (sub) title. If logical and \code{TRUE}, the name of the \code{data} object is used.} \item{\dots}{Other arguments passed to \code{\link{strucplot}}} } \details{ Mosaic displays have been suggested in the statistical literature by Hartigan and Kleiner (1984) and have been extended by Friendly (1994). \code{\link[graphics]{mosaicplot}} is a base graphics implementation and \code{mosaic} is a much more flexible and extensible grid implementation. \code{mosaic} is a generic function which currently has a default method and a formula interface. Both are high-level interfaces to the \code{\link{strucplot}} function, and produce (extended) mosaic displays. Most of the functionality is described there, such as specification of the independence model, labeling, legend, spacing, shading, and other graphical parameters. A mosaic plot is an area proportional visualization of a (possibly higher-dimensional) table of expected frequencies. It is composed of tiles (corresponding to the cells) created by recursive vertical and horizontal splits of a square. The area of each tile is proportional to the corresponding cell entry, \emph{given} the dimensions of previous splits. An \emph{extended} mosaic plot, in addition, visualizes the fit of a particular log-linear model. Typically, this is done by residual-based shadings where color and/or outline of the tiles visualize sign, size and possibly significance of the corresponding residual. The layout is very flexible: the specification of shading, labeling, spacing, and legend is modularized (see \code{\link{strucplot}} for details). In contrast to the \code{\link[graphics]{mosaicplot}} function in \pkg{graphics}, the splits start with the \emph{horizontal} direction by default to match the printed output of \code{\link{structable}}. } \value{ The \code{"structable"} visualized is returned invisibly. } \references{ Hartigan, J.A., and Kleiner, B. (1984), A mosaic of television ratings. \emph{The American Statistician}, \bold{38}, 32--35. Emerson, J. W. (1998), Mosaic displays in S-PLUS: A general implementation and a case study. \emph{Statistical Computing and Graphics Newsletter (ASA)}, \bold{9}, 1, 17--23. Friendly, M. (1994), Mosaic displays for multi-way contingency tables. \emph{Journal of the American Statistical Association}, \bold{89}, 190--200. Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. URL \url{http://www.jstatsoft.org/v17/i03/} and available as \code{vignette("strucplot", package = "vcd")}. The home page of Michael Friendly (\url{http://datavis.ca}) provides information on various aspects of graphical methods for analyzing categorical data, including mosaic plots. In particular, there are many materials for his course \dQuote{Visualizing Categorical Data with SAS and R} at \url{http://datavis.ca/courses/VCD/}. } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{assoc}}, \code{\link{strucplot}}, \code{\link{mosaicplot}}, \code{\link{structable}}, \code{\link{doubledecker}} } \examples{ library(MASS) data("Titanic") mosaic(Titanic) ## Formula interface for tabulated data plus shading and legend: mosaic(~ Sex + Age + Survived, data = Titanic, main = "Survival on the Titanic", shade = TRUE, legend = TRUE) data("HairEyeColor") mosaic(HairEyeColor, shade = TRUE) ## Independence model of hair and eye color and sex. Indicates that ## there are significantly more blue eyed blond females than expected ## in the case of independence (and too few brown eyed blond females). mosaic(HairEyeColor, shade = TRUE, expected = list(c(1,2), 3)) ## Model of joint independence of sex from hair and eye color. Males ## are underrepresented among people with brown hair and eyes, and are ## overrepresented among people with brown hair and blue eyes, but not ## "significantly". ## Formula interface for raw data: visualize crosstabulation of numbers ## of gears and carburettors in Motor Trend car data. data("mtcars") mosaic(~ gear + carb, data = mtcars, shade = TRUE) data("PreSex") mosaic(PreSex, condvars = c(1,4)) mosaic(~ ExtramaritalSex + PremaritalSex | MaritalStatus + Gender, data = PreSex) ## Highlighting: mosaic(Survived ~ ., data = Titanic) data("Arthritis") mosaic(Improved ~ Treatment | Sex, data = Arthritis, zero_size = 0) mosaic(Improved ~ Treatment | Sex, data = Arthritis, zero_size = 0, highlighting_direction = "right") } \keyword{hplot} vcd/man/Baseball.Rd0000755000175100001440000000455111235655776013644 0ustar hornikusers\name{Baseball} \alias{Baseball} \docType{data} \title{Baseball Data} \description{ Baseball data. } \usage{ data("Baseball") } \format{ A data frame with 322 observations and 25 variables. \describe{ \item{name1}{player's first name.} \item{name2}{player's last name.} \item{atbat86}{times at Bat: number of official plate appearances by a hitter. It counts as an official at-bat as long as the batter does not walk, sacrifice, get hit by a pitch or reach base due to catcher's interference.} \item{hits86}{hits.} \item{homer86}{home runs.} \item{runs86}{the number of runs scored by a player. A run is scored by an offensive player who advances from batter to runner and touches first, second, third and home base in that order without being put out.} \item{rbi86}{Runs Batted In: A hitter earns a run batted in when he drives in a run via a hit, walk, sacrifice (bunt or fly) fielder's choice, hit-batsman or on an error (when the official scorer rules that the run would have scored anyway).} \item{walks86}{A \dQuote{walk} (or \dQuote{base on balls}) is an award of first base granted to a batter who receives four pitches outside the strike zone.} \item{years}{Years in the Major Leagues. Seems to count all years a player has actually played in the Major Leagues, not necessarily consecutive.} \item{atbat}{career times at bat.} \item{hits}{career hits.} \item{homeruns}{career home runs.} \item{runs}{career runs.} \item{rbi}{career runs batted in.} \item{walks}{career walks.} \item{league86}{player's league.} \item{div86}{player's division.} \item{team86}{player's team.} \item{posit86}{player's position (see \code{\link{Hitters}}).} \item{outs86}{number of putouts (see \code{\link{Hitters}})} \item{assist86}{number of assists (see \code{\link{Hitters}})} \item{error86}{number of assists (see \code{\link{Hitters}})} \item{sal87}{annual salary on opening day (in USD 1000).} \item{league87}{league in 1987.} \item{team87}{team in 1987.} } } \references{ M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ SAS System for Statistical Graphics, First Edition, page A2.3 } \seealso{\code{\link{Hitters}}} \examples{ data("Baseball") } \keyword{datasets} vcd/man/Saxony.Rd0000755000175100001440000000176511150520606013377 0ustar hornikusers\name{Saxony} \alias{Saxony} \docType{data} \title{Families in Saxony} \description{ Data from Geissler, cited in Sokal & Rohlf (1969) and Lindsey (1995) on gender distributions in families in Saxony in the 19th century. } \usage{ data("Saxony") } \format{ A 1-way table giving the number of male children in 6115 families of size 12. The variable and its levels are \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab nMales \tab 0, 1, \dots, 12 \cr } } \references{ J. K. Lindsey (1995), \emph{Analysis of Frequency and Count Data}. Oxford University Press, Oxford, UK. R. R. Sokal & F. J. Rohlf (1969), \emph{Biometry. The Principles and Practice of Statistics}. W. H. Freeman, San Francisco, CA. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ M. Friendly (2000), Visualizing Categorical Data, pages 40--42. } \examples{ data("Saxony") gf <- goodfit(Saxony, type = "binomial") summary(gf) plot(gf) } \keyword{datasets} vcd/man/doubledecker.Rd0000755000175100001440000000623011150520606014536 0ustar hornikusers\name{doubledecker} \alias{doubledecker.default} \alias{doubledecker.formula} \alias{doubledecker} \title{Doubledecker Plot} \description{ This function creates a doubledecker plot visualizing a classification rule. } \usage{ \method{doubledecker}{formula}(formula, data = NULL, \dots, main = NULL) \method{doubledecker}{default}(x, depvar = length(dim(x)), margins = c(1,4, length(dim(x)) + 1, 1), gp = gpar(fill = rev(gray.colors(tail(dim(x), 1)))), labeling = labeling_doubledecker, spacing = spacing_highlighting, main = NULL, keep_aspect_ratio = FALSE, \dots) } \arguments{ \item{formula}{a formula specifying the variables used to create a contingency table from \code{data}. The dependent variable is used last for splitting.} \item{data}{either a data frame, or an object of class \code{"table"} or \code{"ftable"}.} \item{x}{a contingency table in array form, with optional category labels specified in the \code{dimnames(x)} attribute.} \item{depvar}{dimension index or character string specifying the dependent variable. That will be sorted last in the table.} \item{margins}{margins of the plot. Note that by default, all factor names (except the last one) and their levels are visualized \emph{as a block} under the plot.} \item{gp}{object of class \code{"gpar"} used for the tiles of the last variable.} \item{labeling}{labeling function or corresponding generating generating function (see \code{\link{strucplot}} for details).} \item{spacing}{spacing object, spacing function or corresponding generating function (see \code{\link{strucplot}} for details).} \item{main}{either a logical, or a character string used for plotting the main title. If \code{main} is \code{TRUE}, the name of the \code{data} object is used.} \item{keep_aspect_ratio}{logical indicating whether the aspect ratio should be maintained or not.} \item{\dots}{Further parameters passed to \code{mosaic}.} } \details{ Doubledecker plots visualize the the dependence of one categorical (typically binary) variable on further categorical variables. Formally, they are mosaic plots with vertical splits for all dimensions (antecedents) except the last one, which represents the dependent variable (consequent). The last variable is visualized by horizontal splits, no space between the tiles, and separate colors for the levels. } \value{ The \code{"structable"} visualized is returned invisibly. } \references{ H. Hoffmann (2001), Generalized odds ratios for visual modeling. \emph{Journal of Computational and Graphical Statistics}, \bold{10}, 4, 628--640. Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. URL http://www.jstatsoft.org/v17/i03/ and available as \code{vignette("strucplot")}. } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{strucplot}}, \code{\link{mosaic}} } \examples{ data("Titanic") doubledecker(Titanic) doubledecker(Titanic, depvar = "Survived") doubledecker(Survived ~ ., data = Titanic) } \keyword{hplot} vcd/man/cotab_panel.Rd0000644000175100001440000000745212472414130014363 0ustar hornikusers\name{cotab_panel} \alias{cotab_mosaic} \alias{cotab_assoc} \alias{cotab_sieve} \alias{cotab_loddsratio} \alias{cotab_agreementplot} \alias{cotab_coindep} \alias{cotab_fourfold} \title{Panel-generating Functions for Contingency Table Coplots} \description{ Panel-generating functions visualizing contingency tables that can be passed to \code{cotabplot}. } \usage{ cotab_mosaic(x = NULL, condvars = NULL, \dots) cotab_assoc(x = NULL, condvars = NULL, ylim = NULL, \dots) cotab_sieve(x = NULL, condvars = NULL, \dots) cotab_loddsratio(x = NULL, condvars = NULL, \dots) cotab_agreementplot(x = NULL, condvars = NULL, \dots) cotab_fourfold(x = NULL, condvars = NULL, \dots) cotab_coindep(x, condvars, test = c("doublemax", "maxchisq", "sumchisq"), level = NULL, n = 1000, interpolate = c(2, 4), h = NULL, c = NULL, l = NULL, lty = 1, type = c("mosaic", "assoc"), legend = FALSE, ylim = NULL, \dots) } \arguments{ \item{x}{a contingency tables in array form.} \item{condvars}{margin name(s) of the conditioning variables.} \item{ylim}{y-axis limits for \code{assoc} plot. By default this is computed from \code{x}.} \item{test}{character indicating which type of statistic should be used for assessing conditional independence.} \item{level,n,h,c,l,lty,interpolate}{variables controlling the HCL shading of the residuals, see \code{\link{shadings}} for more details.} \item{type}{character indicating which type of plot should be produced.} \item{legend}{logical. Should a legend be produced in each panel?} \item{\dots}{further arguments passed to the plotting function (such as \code{\link{mosaic}} or \code{\link{assoc}} or \code{\link{sieve}} respectively).} } \details{ These functions of class \code{"panel_generator"} are panel-generating functions for use with \code{\link{cotabplot}}, i.e., they return functions with the interface \code{panel(x, condlevels)} required for \code{cotabplot}. The functions produced by \code{cotab_mosaic}, \code{cotab_assoc} and \code{cotab_sieve} essentially only call \code{co_table} to produce the conditioned table and then call \code{\link{mosaic}}, \code{\link{assoc}} or \code{\link{sieve}} respectively with the arguments specified. The function \code{cotab_coindep} is similar but additionally chooses an appropriate residual-based shading visualizing the associated conditional independence model. The conditional independence test is carried out via \code{\link{coindep_test}} and the shading is set up via \code{\link{shading_hcl}}. A description of the underlying ideas is given in Zeileis, Meyer, Hornik (2005). } \seealso{ \code{\link{cotabplot}}, \code{\link{mosaic}}, \code{\link{assoc}}, \code{\link{sieve}}, \code{\link{co_table}}, \code{\link{coindep_test}}, \code{\link{shading_hcl}} } \references{ Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. URL http://www.jstatsoft.org/v17/i03/ and available as \code{vignette("strucplot")}. Zeileis, A., Meyer, D., Hornik K. (2007), \emph{Residual-based shadings for visualizing (conditional) independence}, \emph{Journal of Computational and Graphical Statistics}, \bold{16}, 507--525. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \examples{ data("UCBAdmissions") cotabplot(~ Admit + Gender | Dept, data = UCBAdmissions) cotabplot(~ Admit + Gender | Dept, data = UCBAdmissions, panel = cotab_assoc) cotabplot(~ Admit + Gender | Dept, data = UCBAdmissions, panel = cotab_fourfold) ucb <- cotab_coindep(UCBAdmissions, condvars = "Dept", type = "assoc", n = 5000, margins = c(3, 1, 1, 3)) cotabplot(~ Admit + Gender | Dept, data = UCBAdmissions, panel = ucb) } \keyword{hplot} vcd/man/spine.Rd0000755000175100001440000001073711235655675013256 0ustar hornikusers\name{spine} \alias{spine} \alias{spine.default} \alias{spine.formula} \title{Spine Plots and Spinograms} \description{ Spine plots are a special cases of mosaic plots, and can be seen as a generalization of stacked (or highlighted) bar plots. Analogously, spinograms are an extension of histograms. } \usage{ spine(x, \dots) \method{spine}{default}(x, y = NULL, breaks = NULL, ylab_tol = 0.05, off = NULL, main = "", xlab = NULL, ylab = NULL, ylim = c(0, 1), margins = c(5.1, 4.1, 4.1, 3.1), gp = gpar(), name = "spineplot", newpage = TRUE, pop = TRUE, \dots) \method{spine}{formula}(formula, data = list(), breaks = NULL, ylab_tol = 0.05, off = NULL, main = "", xlab = NULL, ylab = NULL, ylim = c(0, 1), margins = c(5.1, 4.1, 4.1, 3.1), gp = gpar(), name = "spineplot", newpage = TRUE, pop = TRUE, \dots) } \arguments{ \item{x}{an object, the default method expects either a single variable (interpreted to be the explanatory variable) or a 2-way table. See details.} \item{y}{a \code{"factor"} interpreted to be the dependent variable} \item{formula}{a \code{"formula"} of type \code{y ~ x} with a single dependent \code{"factor"} and a single explanatory variable.} \item{data}{an optional data frame.} \item{breaks}{if the explanatory variable is numeric, this controls how it is discretized. \code{breaks} is passed to \code{\link{hist}} and can be a list of arguments.} \item{ylab_tol}{convenience tolerance parameter for y-axis annotation. If the distance between two labels drops under this threshold, they are plotted equidistantly.} \item{off}{vertical offset between the bars (in per cent). It is fixed to \code{0} for spinograms and defaults to \code{2} for spine plots.} \item{main, xlab, ylab}{character strings for annotation} \item{ylim}{limits for the y axis} \item{margins}{margins when calling \code{\link{plotViewport}}} \item{gp}{a \code{"gpar"} object controlling the grid graphical parameters of the rectangles. It should specify in particular a vector of \code{fill} colors of the same length as \code{levels(y)}. The default is to call \code{\link{gray.colors}}.} \item{name}{name of the plotting viewport.} \item{newpage}{logical. Should \code{\link{grid.newpage}} be called before plotting?} \item{pop}{logical. Should the viewport created be popped?} \item{\dots}{additional arguments passed to \code{\link{plotViewport}}.} } \details{ \code{spine} creates either a spinogram or a spine plot. It can be called via \code{spine(x, y)} or \code{spine(y ~ x)} where \code{y} is interpreted to be the dependent variable (and has to be categorical) and \code{x} the explanatory variable. \code{x} can be either categorical (then a spine plot is created) or numerical (then a spinogram is plotted). Additionally, \code{spine} can also be called with only a single argument which then has to be a 2-way table, interpreted to correspond to \code{table(x, y)}. Spine plots are a generalization of stacked bar plots where not the heights but the widths of the bars corresponds to the relative frequencies of \code{x}. The heights of the bars then correspond to the conditional relative frequencies of \code{y} in every \code{x} group. This is a special case of a mosaic plot with specific spacing and shading. Analogously, spinograms extend stacked histograms. As for the histogram, \code{x} is first discretized (using \code{\link{hist}}) and then for the discretized data a spine plot is created. } \value{ The table visualized is returned invisibly. } \seealso{ \code{\link{cd_plot}}, \code{\link{mosaic}}, \code{\link{hist}} } \references{ Hummel, J. (1996), Linked bar charts: Analysing categorical data graphically. \emph{Computational Statistics}, \bold{11}, 23--33. Hofmann, H., Theus, M. (2005), \emph{Interactive graphics for visualizing conditional distributions}, Unpublished Manuscript. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \examples{ ## Arthritis data (dependence on a categorical variable) data("Arthritis") (spine(Improved ~ Treatment, data = Arthritis)) ## Arthritis data (dependence on a numerical variable) (spine(Improved ~ Age, data = Arthritis, breaks = 5)) (spine(Improved ~ Age, data = Arthritis, breaks = quantile(Arthritis$Age))) (spine(Improved ~ Age, data = Arthritis, breaks = "Scott")) ## Space shuttle data (dependence on a numerical variable) data("SpaceShuttle") (spine(Fail ~ Temperature, data = SpaceShuttle, breaks = 3)) } \keyword{hplot} vcd/man/legends.Rd0000755000175100001440000000726412547003015013540 0ustar hornikusers\name{legends} \alias{legends} \alias{legend_resbased} \alias{legend_fixed} \title{Legend Functions for Strucplots} \description{ These functions generate legend functions for residual-based shadings. } \usage{ legend_resbased(fontsize = 12, fontfamily = "", x = unit(1, "lines"), y = unit(0.1,"npc"), height = unit(0.8, "npc"), width = unit(0.7, "lines"), digits = 2, check_overlap = TRUE, text = NULL, steps = 200, ticks = 10, pvalue = TRUE, range = NULL) legend_fixed(fontsize = 12, fontfamily = "", x = unit(1, "lines"), y = NULL, height = NULL, width = unit(1.5, "lines"), steps = 200, digits = 1, space = 0.05, text = NULL, range = NULL) } \arguments{ \item{fontsize}{fontsize of title and p-value text.} \item{fontfamily}{fontfamily of all text.} \item{x, y}{objects of class \code{"unit"} indicating the coordinates of the title. For \code{legend_fixed}, the default for \code{y} is computed as to leave enough space for the specified \code{text}.} \item{height, width}{object of class \code{"unit"} indicating the height/width of the legend. For \code{legend_fixed}, the default for \code{y} is computed as to align upper margins of legend and actual plot.} \item{digits}{number of digits for the scale labels.} \item{check_overlap}{logical indicating whether overlap of scale labels should be inhibited or not.} \item{space}{For \code{legend_fixed} only: proportion of space between the tiles.} \item{text}{character string indicating the title of the legend.} \item{steps}{granularity of the color gradient.} \item{ticks}{number of scale ticks.} \item{pvalue}{logical indicating whether the \eqn{p}-value should be visualized under the scale or not.} \item{range}{Numeric vector of length 2 for setting the legend range. Computed from the residuals if omitted. \code{NA} values are replaced by the corresponding minimum / maximum of the residuals.} } \value{ A function with arguments: \item{residuals}{residuals from the fitted independence model to be visualized.} \item{shading}{shading function computing colors from residuals (see details).} \item{autotext}{character vector indicating the title to be used when no \code{text} argument is specified. Allows strucplot to generate sensible defaults depending on the residuals type.} } \details{ These functions generate legend functions for residual-based shadings, visualizing deviations from expected values of an hypothesized independence model. Therefore, the legend uses a supplied shading function to visualize the color gradient for the residuals range. \code{legend_fixed} is inspired by the legend used in \code{\link[graphics]{mosaicplot}}. For more details on the shading functions and their return values, see \code{\link{shadings}}. } \references{ Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. URL http://www.jstatsoft.org/v17/i03/ and available as \code{vignette("strucplot")}. Meyer, D., Zeileis, A., Hornik, K. (2003), Visualizing independence using extended association plots. \emph{Proceedings of the 3rd International Workshop on Distributed Statistical Computing}, K. Hornik, F. Leisch, A. Zeileis (eds.), ISSN 1609-395X. \url{http://www.R-project.org/conferences/DSC-2003/Proceedings/} } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{structable}}, \code{\link{shadings}} } \examples{ data("Titanic") mosaic(Titanic, shade = TRUE, legend = legend_resbased) mosaic(Titanic, shade = TRUE, legend = legend_fixed, gp = shading_Friendly) } \keyword{hplot} vcd/man/co_table.Rd0000755000175100001440000000162011264574713013672 0ustar hornikusers\name{co_table} \alias{co_table} \title{Compute Conditional Tables} \description{ For a contingency table in array form, compute a list of conditional tables given some margins. } \usage{ co_table(x, margin, collapse = ".") } \arguments{ \item{x}{a contingency table in array form.} \item{margin}{margin index(es) or corresponding name(s) of the conditioning variables.} \item{collapse}{character used when collapsing level names (if more than 1 \code{margin} is specified).} } \details{ This is essentially an interface to \code{\link[base]{[}} which is more convenient for arrays of arbitrary dimension. } \value{ A list of the resulting conditional tables. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \examples{ data("HairEyeColor") co_table(HairEyeColor, 1) co_table(HairEyeColor, c("Hair", "Eye")) co_table(HairEyeColor, 1:2, collapse = "") } \keyword{array} vcd/man/Arthritis.Rd0000755000175100001440000000235711150520606014065 0ustar hornikusers\name{Arthritis} \alias{Arthritis} \docType{data} \title{Arthritis Treatment Data} \description{ Data from Koch \& Edwards (1988) from a double-blind clinical trial investigating a new treatment for rheumatoid arthritis. } \usage{data("Arthritis")} \format{ A data frame with 84 observations and 5 variables. \describe{ \item{ID}{patient ID.} \item{Treatment}{factor indicating treatment (Placebo, Treated).} \item{Sex}{factor indicating sex (Female, Male).} \item{Age}{age of patient.} \item{Improved}{ordered factor indicating treatment outcome (None, Some, Marked).} } } \references{ G. Koch \& S. Edwards (1988), Clinical efficiency trials with categorical data. In K. E. Peace (ed.), \emph{Biopharmaceutical Statistics for Drug Development}, 403--451. Marcel Dekker, New York. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data: \url{http://euclid.psych.yorku.ca/ftp/sas/vcd/catdata/arthrit.sas} } \examples{ data("Arthritis") art <- xtabs(~ Treatment + Improved, data = Arthritis, subset = Sex == "Female") art mosaic(art, gp = shading_Friendly) mosaic(art, gp = shading_max) } \keyword{datasets} vcd/man/assoc.Rd0000755000175100001440000002255012547003026013224 0ustar hornikusers\name{assoc} \alias{assoc} \alias{assoc.default} \alias{assoc.formula} \title{Extended Association Plots} \description{ Produce an association plot indicating deviations from a specified independence model in a possibly high-dimensional contingency table. } \usage{ \method{assoc}{default}(x, row_vars = NULL, col_vars = NULL, compress = TRUE, xlim = NULL, ylim = NULL, spacing = spacing_conditional(sp = 0), spacing_args = list(), split_vertical = NULL, keep_aspect_ratio = FALSE, xscale = 0.9, yspace = unit(0.5, "lines"), main = NULL, sub = NULL, \dots, residuals_type = "Pearson", gp_axis = gpar(lty = 3)) \method{assoc}{formula}(formula, data = NULL, \dots, subset = NULL, na.action = NULL, main = NULL, sub = NULL) } \arguments{ \item{x}{a contingency table in array form with optional category labels specified in the \code{dimnames(x)} attribute, or an object inheriting from the \code{"ftable"} class (such as \code{"structable"} objects).} \item{row_vars}{a vector of integers giving the indices, or a character vector giving the names of the variables to be used for the rows of the association plot.} \item{col_vars}{a vector of integers giving the indices, or a character vector giving the names of the variables to be used for the columns of the association plot.} \item{compress}{logical; if \code{FALSE}, the space between the rows (columns) are chosen such that the \emph{total} heights (widths) of the rows (columns) are all equal. If \code{TRUE}, the space between rows and columns is fixed and hence the plot is more \dQuote{compressed}.} \item{xlim}{a \eqn{2 \times k}{2 x k} matrix of doubles, \eqn{k} number of total columns of the plot. The columns of \code{xlim} correspond to the columns of the association plot, the rows describe the column ranges (minimums in the first row, maximums in the second row). If \code{xlim} is \code{NULL}, the ranges are determined from the residuals according to \code{compress} (if \code{TRUE}: widest range from each column, if \code{FALSE}: from the whole association plot matrix).} \item{ylim}{a \eqn{2 \times k}{2 x k} matrix of doubles, \eqn{k} number of total rows of the plot. The columns of \code{ylim} correspond to the rows of the association plot, the rows describe the column ranges (minimums in the first row, maximums in the second row). If \code{ylim} is \code{NULL}, the ranges are determined from the residuals according to \code{compress} (if \code{TRUE}: widest range from each row, if \code{FALSE}: from the whole association plot matrix).} \item{spacing}{a spacing object, a spacing function, or a corresponding generating function (see \code{\link{strucplot}} for more information). The default is the spacing-generating function \code{\link{spacing_conditional}} that is (by default) called with the argument list \code{spacing_args} (see \code{spacings} for more details).} \item{spacing_args}{list of arguments for the spacing-generating function, if specified (see \code{\link{strucplot}} for more information).} \item{split_vertical}{vector of logicals of length \eqn{k}, where \eqn{k} is the number of margins of \code{x} (default: \code{FALSE}). Values are recycled as needed. A \code{TRUE} component indicates that the corresponding dimension is folded into the columns, \code{FALSE} folds the dimension into the rows.} \item{keep_aspect_ratio}{logical indicating whether the aspect ratio should be fixed or not.} \item{residuals_type}{a character string indicating the type of residuals to be computed. Currently, only Pearson residuals are supported.} \item{xscale}{scale factor resizing the tile's width, thus adding additional space between the tiles. } \item{yspace}{object of class \code{"unit"} specifying additional space separating the rows.} \item{gp_axis}{object of class \code{"gpar"} specifying the visual aspects of the tiles' baseline.} \item{formula}{a formula object with possibly both left and right hand sides specifying the column and row variables of the flat table.} \item{data}{a data frame, list or environment containing the variables to be cross-tabulated, or an object inheriting from class \code{table}.} \item{subset}{an optional vector specifying a subset of observations to be used. Ignored if \code{data} is a contingency table.} \item{na.action}{an optional function which indicates what should happen when the data contain \code{NA}s. Ignored if \code{data} is a contingency table.} \item{main, sub}{either a logical, or a character string used for plotting the main (sub) title. If logical and \code{TRUE}, the name of the \code{data} object is used.} \item{\dots}{other parameters passed to \code{\link{strucplot}}} } \details{ Association plots have been suggested by Cohen (1980) and extended by Friendly (1992) and provide a means for visualizing the residuals of an independence model for a contingency table. \code{assoc} is a generic function and currently has a default method and a formula interface. Both are high-level interfaces to the \code{\link{strucplot}} function, and produce (extended) association plots. Most of the functionality is described there, such as specification of the independence model, labeling, legend, spacing, shading, and other graphical parameters. For a contingency table, the signed contribution to Pearson's \eqn{\chi^2}{chi^2} for cell \eqn{\{ij\ldots k\}} is \deqn{d_{ij\ldots k} = \frac{(f_{ij\ldots k} - e_{ij\ldots k})}{ \sqrt{e_{ij\ldots k}}}}{d_\{ij\ldotsk\} = (f_\{ij\ldotsk\} - e_\{ij\ldotsk\}) / sqrt(e_\{ij\ldotsk\})} where \eqn{f_{ij\ldots k}}{f_\{ij\ldotsk\}} and \eqn{e_{ij\ldots k}}{e_\{ij\ldotsk\}} are the observed and expected counts corresponding to the cell. In the association plot, each cell is represented by a rectangle that has (signed) height proportional to \eqn{d_{ij\ldots k}}{d_\{ij\ldotsk\}} and width proportional to \eqn{\sqrt{e_{ij\ldots k}}}{sqrt(e_\{ij...k\})}, so that the area of the box is proportional to the difference in observed and expected frequencies. The rectangles in each row are positioned relative to a baseline indicating independence (\eqn{d_{ij\ldots k} = 0}{d_\{ij\ldotsk\} = 0}). If the observed frequency of a cell is greater than the expected one, the box rises above the baseline, and falls below otherwise. Additionally, the residuals can be colored depending on a specified shading scheme (see Meyer et al., 2003). Package \pkg{vcd} offers a range of \emph{residual-based} shadings (see the shadings help page). Some of them allow, e.g., the visualization of test statistics. Unlike the \code{\link[graphics]{assocplot}} function in the \pkg{graphics} package, this function allows the visualization of contingency tables with more than two dimensions. Similar to the construction of \sQuote{flat} tables (like objects of class \code{"ftable"} or \code{"structable"}), the dimensions are folded into rows and columns. The layout is very flexible: the specification of shading, labeling, spacing, and legend is modularized (see \code{\link{strucplot}} for details). } \value{ The \code{"structable"} visualized is returned invisibly. } \seealso{ \code{\link{mosaic}}, \code{\link{strucplot}}, \code{\link{structable}} } \references{ Cohen, A. (1980), On the graphical display of the significant components in a two-way contingency table. \emph{Communications in Statistics---Theory and Methods}, \bold{A9}, 1025--1041. Friendly, M. (1992), Graphical methods for categorical data. \emph{SAS User Group International Conference Proceedings}, \bold{17}, 190--200. \url{http://datavis.ca/papers/sugi/sugi17.pdf} Meyer, D., Zeileis, A., Hornik, K. (2003), Visualizing independence using extended association plots. \emph{Proceedings of the 3rd International Workshop on Distributed Statistical Computing}, K. Hornik, F. Leisch, A. Zeileis (eds.), ISSN 1609-395X. \url{http://www.R-project.org/conferences/DSC-2003/Proceedings/} Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. URL http://www.jstatsoft.org/v17/i03/ and available as \code{vignette("strucplot")}. } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ data("HairEyeColor") ## Aggregate over sex: (x <- margin.table(HairEyeColor, c(1, 2))) ## Ordinary assocplot: assoc(x) ## and with residual-based shading (of independence) assoc(x, main = "Relation between hair and eye color", shade = TRUE) ## Aggregate over Eye color: (x <- margin.table(HairEyeColor, c(1, 3))) chisq.test(x) assoc(x, main = "Relation between hair color and sex", shade = TRUE) # Visualize multi-way table assoc(aperm(HairEyeColor), expected = ~ (Hair + Eye) * Sex, labeling_args = list(just_labels = c(Eye = "left"), offset_labels = c(right = -0.5), offset_varnames = c(right = 1.2), rot_labels = c(right = 0), tl_varnames = c(Eye = TRUE)) ) assoc(aperm(UCBAdmissions), expected = ~ (Admit + Gender) * Dept, compress = FALSE, labeling_args = list(abbreviate = c(Gender = TRUE), rot_labels = 0) ) } \keyword{hplot} vcd/man/Bundestag2005.Rd0000644000175100001440000000571112532007442014334 0ustar hornikusers\name{Bundestag2005} \alias{Bundestag2005} \title{Votes in German Bundestag Election 2005} \description{ Number of votes by province in the German Bundestag election 2005 (for the parties that eventually entered the parliament). } \usage{ data("Bundestag2005") } \format{ A 2-way \code{"table"} giving the number of votes for each party (\code{Fraktion}) in each of the 16 German provinces (\code{Bundesland}): \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab Bundesland \tab Schleswig-Holstein, Mecklenburg-Vorpommern, \dots \cr 2 \tab Fraktion \tab SPD, CDU/CSU, Gruene, FDP, Linke } } \details{ In the election for the German parliament \dQuote{Bundestag}, five parties obtained enough votes to enter the parliament: the social democrats SPD, the conservative CDU/CSU, the liberal FDP, the green party \dQuote{Die Gruenen} and the leftist party \dQuote{Die Linke}. The table \code{Bundestag2005} gives the number of votes for each party (\code{Fraktion}) in each of the 16 German provinces (\code{Bundesland}). The provinces are ordered from North to South. The data have been obtained from the German statistical office (Statistisches Bundesamt) from the Web page given below. Note that the number of seats in the parliament cannot be computed from the number of votes alone. The examples below show the distribution of seats that resulted from the election. } \source{ Der Bundeswahlleiter, Statistisches Bundesamt. \url{http://www.bundeswahlleiter.de/de/bundestagswahlen/fruehere_bundestagswahlen/btw2005.html} } \examples{ library(colorspace) ## The outcome of the election in terms of seats in the ## parliament was: seats <- structure(c(226, 61, 54, 51, 222), .Names = c("CDU/CSU", "FDP", "Linke", "Gruene", "SPD")) ## Hues are chosen as metaphors for the political parties ## CDU/CSU: blue, FDP: yellow, Linke: purple, Gruene: green, SPD: red ## using the respective hues from a color wheel with ## chroma = 60 and luminance = 75 parties <- rainbow_hcl(6, c = 60, l = 75)[c(5, 2, 6, 3, 1)] names(parties) <- names(seats) parties ## The pie chart shows that neither the SPD+Gruene coalition nor ## the opposition of CDU/CSU+FDP could assemble a majority. ## No party would enter a coalition with the leftists, leading to a ## big coalition. pie(seats, clockwise = TRUE, col = parties) ## The regional distribution of the votes, stratified by province, ## is shown in a mosaic display: first for the 10 Western then the ## 6 Eastern provinces. data("Bundestag2005") votes <- Bundestag2005[c(1, 3:5, 9, 11, 13:16, 2, 6:8, 10, 12), c("CDU/CSU", "FDP", "SPD", "Gruene", "Linke")] mosaic(votes, gp = gpar(fill = parties[colnames(votes)]), spacing = spacing_highlighting, labeling = labeling_left, labeling_args = list(rot_labels = c(0, 90, 0, 0), pos_labels = "center", just_labels = c("center","center","center","right"), varnames = FALSE), margins = unit(c(2.5, 1, 1, 12), "lines"), keep_aspect_ratio = FALSE) } \keyword{datasets} vcd/man/JointSports.Rd0000755000175100001440000000233412214055143014406 0ustar hornikusers\name{JointSports} \alias{JointSports} \docType{data} \title{Opinions About Joint Sports} \description{ Data from a Danish study in 1983 and 1985 about sports activities and the opinion about joint sports with the other gender among 16--19 year old high school students. } \usage{ data("JointSports") } \format{ A data frame with 40 observations and 5 variables. \describe{ \item{Freq}{frequency.} \item{opinion}{factor indicating opinion about sports joint with the other gender (very good, good, indifferent, bad, very bad).} \item{year}{factor indicating year of study (1983, 1985).} \item{grade}{factor indicating school grade (1st, 3rd).} \item{gender}{factor indicating gender (Boy, Girl).} } } \references{ E. B. Andersen (1991), \emph{The Statistical Analysis of Categorical Data}. 2nd edition. Springer-Verlag, Berlin. } \source{ E. B. Andersen (1991), The Statistical Analysis of Categorical Data, page 210. } \examples{ library(MASS) data("JointSports") tab <- xtabs(Freq ~ gender + opinion + grade + year, data = JointSports) doubledecker(opinion ~ gender + year + grade, data = tab) loglm(~ opinion* (gender + grade+ year) + gender*year*grade, data = tab) } \keyword{datasets} vcd/man/Punishment.Rd0000755000175100001440000000274311150520606014245 0ustar hornikusers\name{Punishment} \alias{Punishment} \docType{data} \title{Corporal Punishment Data} \description{ Data from a study of the Gallup Institute in Denmark in 1979 about the attitude of a random sample of 1,456 persons towards corporal punishment of children. } \usage{ data("Punishment") } \format{ A data frame with 36 observations and 5 variables. \describe{ \item{Freq}{frequency.} \item{attitude}{factor indicating attitude: (no, moderate) punishment of children.} \item{memory}{factor indicating whether the person had memories of corporal punishment as a child (yes, no).} \item{education}{factor indicating highest level of education (elementary, secondary, high).} \item{age}{factor indicating age group in years (15-24, 25-39, 40-).} } } \note{Anderson (1991) erroneously indicates the total sum of respondents to be 783.} \references{ E. B. Andersen (1991), \emph{The Statistical Analysis of Categorical Data}. 2nd edition. Springer-Verlag, Berlin. } \source{ E. B. Andersen (1991), The Statistical Analysis of Categorical Data, pages 207--208. } \examples{ data("Punishment", package = "vcd") pun <- xtabs(Freq ~ memory + attitude + age + education, data = Punishment) ## model: ~ (memory + attitude) * age * education ## use maximum sum-of-squares test/shading cotabplot(~ memory + attitude | age + education, data = pun, panel = cotab_coindep, n = 5000, type = "assoc", test = "maxchisq", interpolate = 1:2) } \keyword{datasets} vcd/man/NonResponse.Rd0000755000175100001440000000164511150520606014364 0ustar hornikusers\name{NonResponse} \alias{NonResponse} \docType{data} \title{Non-Response Survey Data} \description{ Data about non-response for a Danish survey in 1965. } \usage{ data("NonResponse") } \format{ A data frame with 12 observations and 4 variables. \describe{ \item{Freq}{frequency.} \item{residence}{factor indicating whether residence was in Copenhagen, in a city outside Copenhagen or at the countryside (Copenhagen, City, Country).} \item{response}{factor indicating whether a response was given (yes, no).} \item{gender}{factor indicating gender (male, female).} } } \references{ E. B. Andersen (1991), \emph{The Statistical Analysis of Categorical Data}. 2nd edition. Springer-Verlag, Berlin. } \source{ E. B. Andersen (1991), The Statistical Analysis of Categorical Data, Table 5.17. } \examples{ data("NonResponse") structable(~ ., data = NonResponse) } \keyword{datasets} vcd/man/coindep_test.Rd0000755000175100001440000000753512214055406014602 0ustar hornikusers\name{coindep_test} \alias{coindep_test} \alias{fitted.coindep_test} \title{Test for (Conditional) Independence} \description{ Performs a test of (conditional) independence of 2 margins in a contingency table by simulation from the marginal distribution of the input table under (conditional) independence. } \usage{ coindep_test(x, margin = NULL, n = 1000, indepfun = function(x) max(abs(x)), aggfun = max, alternative = c("greater", "less"), pearson = TRUE) } \arguments{ \item{x}{a contingency table.} \item{margin}{margin index(es) or corresponding name(s) of the conditioning variables. Each resulting conditional table has to be a 2-way table.} \item{n}{number of (conditional) independence tables to be drawn.} \item{indepfun}{aggregation function capturing independence in (each conditional) 2-way table.} \item{aggfun}{aggregation function aggregating the test statistics computed by \code{indepfun}.} \item{alternative}{a character string specifying the alternative hypothesis; must be either \code{"greater"} (default) or \code{"less"} (and may be abbreviated.)} \item{pearson}{logical. Should the table of Pearson residuals under independence be computed and passed to \code{indepfun} (default) or the raw table of observed frequencies?} } \details{ If \code{margin} is \code{NULL} this computes a simple independence statistic in a 2-way table. Alternatively, \code{margin} can give several conditioning variables and then conditional independence in the resulting conditional table is tested. By default, this uses a (double) maximum statistic of Pearson residuals. By changing \code{indepfun} or \code{aggfun} a (maximum of) Pearson Chi-squared statistic(s) can be computed or just the usual Pearson Chi-squared statistics and so on. Other statistics can be computed by changing \code{pearson} to \code{FALSE}. The function uses \code{\link{r2dtable}} to simulate the distribution of the test statistic under the null. } \value{ A list of class \code{"coindep_test"} inheriting from \code{"htest"} with following components: \item{statistic}{the value of the test statistic.} \item{p.value}{the \eqn{p} value for the test.} \item{method}{a character string indicating the type of the test.} \item{data.name}{a character string giving the name(s) of the data.} \item{observed}{observed table of frequencies} \item{expctd}{expected table of frequencies} \item{residuals}{corresponding Pearson residuals} \item{margin}{the \code{margin} used} \item{dist}{a vector of size \code{n} with simulated values of the distribution of the statistic under the null.} \item{qdist}{the corresponding quantile function (for computing critical values).} \item{pdist}{the corresponding distribution function (for computing \eqn{p} values).} } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \seealso{ \code{\link{chisq.test}}, \code{\link{fisher.test}}, \code{\link{r2dtable}} } \examples{ library(MASS) TeaTasting <- matrix(c(3, 1, 1, 3), nr = 2, dimnames = list(Guess = c("Milk", "Tea"), Truth = c("Milk", "Tea")) ) ## compute maximum statistic coindep_test(TeaTasting) ## compute Chi-squared statistic coindep_test(TeaTasting, indepfun = function(x) sum(x^2)) ## use unconditional asymptotic distribution chisq.test(TeaTasting, correct = FALSE) chisq.test(TeaTasting) data("UCBAdmissions") ## double maximum statistic coindep_test(UCBAdmissions, margin = "Dept") ## maximum of Chi-squared statistics coindep_test(UCBAdmissions, margin = "Dept", indepfun = function(x) sum(x^2)) ## Pearson Chi-squared statistic coindep_test(UCBAdmissions, margin = "Dept", indepfun = function(x) sum(x^2), aggfun = sum) ## use unconditional asymptotic distribution loglm(~ Dept * (Gender + Admit), data = UCBAdmissions) } \keyword{htest} vcd/man/UKSoccer.Rd0000755000175100001440000000174411150520606013571 0ustar hornikusers\name{UKSoccer} \alias{UKSoccer} \docType{data} \title{UK Soccer Scores} \description{ Data from Lee (1997), on the goals scored by Home and Away teams in the Premier Football League, 1995/6 season. } \usage{ data("UKSoccer") } \format{ A 2-dimensional array resulting from cross-tabulating the number of goals scored in 380 games. The variables and their levels are as follows: \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab Home \tab 0, 1, \dots, 4 \cr 2 \tab Away \tab 0, 1, \dots, 4 } } \references{ A. J. Lee (1997), Modelling scores in the Premier League: Is Manchester United really the best?, \emph{Chance}, \bold{10}(1), 15--19. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ M. Friendly (2000), Visualizing Categorical Data, page 27. } \seealso{ \code{\link{Bundesliga}} } \examples{ data("UKSoccer") mosaic(UKSoccer, gp = shading_max, main = "UK Soccer Scores") } \keyword{datasets} vcd/man/struc_sieve.Rd0000655000175100001440000000416212467663012014455 0ustar hornikusers\name{struc_sieve} \alias{struc_sieve} \title{Core-generating Function for Sieve Plots} \encoding{UTF-8} \description{ Core-generating function for \code{strucplot} returning a function producing sieve plots. } \usage{ struc_sieve(sievetype = c("observed","expected"), gp_tile = gpar(), scale = 1) } \arguments{ \item{sievetype}{logical indicating whether rectangles should be filled according to \code{observed} or \code{expected} frequencies.} \item{gp_tile}{object of class \code{"gpar"}, controlling the appearance of all \emph{static} elements of the cells (e.g., border and fill color).} \item{scale}{Scaling factor for the sieve.} } \details{ This function is usually called by \code{\link{strucplot}} (typically when called by \code{\link{sieve}}) and returns a function used by \code{\link{strucplot}} to produce sieve plots. } \value{ A function with arguments: \item{residuals}{table of residuals.} \item{observed}{table of observed values.} \item{expected}{not used by \code{struc_sieve}.} \item{spacing}{object of class \code{"unit"} specifying the space between the tiles.} \item{gp}{list of \code{gpar} objects used for the drawing the tiles.} \item{split_vertical}{vector of logicals indicating, for each dimension of the table, the split direction.} } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{sieve}}, \code{\link{strucplot}}, \code{\link{structable}} } \references{ Riedwyl, H., and Schüpbach, M. (1994), Parquet diagram to plot contingency tables. In F. Faulbaum (ed.), \emph{Softstat '93: Advances in Statistical Software}, 293--299. Gustav Fischer, New York. Friendly, M. (2000), Visualizing Categorical Data, SAS Institute, Cary, NC. Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. URL http://www.jstatsoft.org/v17/i03/ and available as \code{vignette("strucplot")}. } \examples{ ## Titanic data data("Titanic") strucplot(Titanic, core = struc_sieve) } \keyword{hplot} vcd/man/Hospital.Rd0000755000175100001440000000241611235655727013714 0ustar hornikusers\name{Hospital} \alias{Hospital} \docType{data} \title{Hospital data} \description{ The table relates the length of stay (in years) of 132 long-term schizophrenic patients in two London mental hospitals with the frequency of visits. } \usage{ data("Hospital") } \format{ A 2-dimensional array resulting from cross-tabulating 132 patients. The variables and their levels are as follows: \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab Visit Frequency \tab Regular, Less than monthly, Never \cr 2 \tab Length of Stay \tab 2--9 years, 10--19 years, 20+ years } } \references{ J.K. Wing (1962): Institutionalism in mental hospitals. British Journal of Social Clinical Psychology, 1:38--51. } \source{ S.J Haberman (1974): Log-linear models for frequency tables with ordered classifications. Biometrics, 30:689--700. } \details{ Wing (1962) who collected this data concludes that the longer the length of stay in hospital, the less frequent the visits. Haberman (1974) notes that this pattern does not increase from the "Less than monthly" to the "Never" group, which are homogeneous. } \examples{ data("Hospital") mosaic(t(Hospital), shade = TRUE) mosaic(Hospital, shade = TRUE) sieve(Hospital, shade = TRUE) assoc(Hospital, shade = TRUE) } \keyword{datasets} vcd/man/distplot.Rd0000644000175100001440000000737712445055152013771 0ustar hornikusers\name{distplot} \alias{distplot} \title{Diagnostic Distribution Plots} \description{ Diagnostic distribution plots: poissonness, binomialness and negative binomialness plots. } \usage{ distplot(x, type = c("poisson", "binomial", "nbinomial"), size = NULL, lambda = NULL, legend = TRUE, xlim = NULL, ylim = NULL, conf_int = TRUE, conf_level = 0.95, main = NULL, xlab = "Number of occurrences", ylab = "Distribution metameter", gp = gpar(cex = 0.8), lwd=2, name = "distplot", newpage = TRUE, pop =TRUE, return_grob = FALSE, \dots) } \arguments{ \item{x}{either a vector of counts, a 1-way table of frequencies of counts or a data frame or matrix with frequencies in the first column and the corresponding counts in the second column.} \item{type}{a character string indicating the distribution.} \item{size}{the size argument for the binomial and negative binomial distribution. If set to \code{NULL} and \code{type} is \code{"binomial"}, then \code{size} is taken to be the maximum count. If set to \code{NULL} and \code{type} is \code{"nbinomial"}, then \code{size} is estimated from the data.} \item{lambda}{parameter of the poisson distribution. If type is \code{"poisson"} and \code{lambda} is specified a leveled poissonness plot is produced.} \item{legend}{logical. Should a legend be plotted?} \item{xlim}{limits for the x axis.} \item{ylim}{limits for the y axis.} \item{conf_int}{logical. Should confidence intervals be plotted?} \item{conf_level}{confidence level for confidence intervals.} \item{main}{a title for the plot.} \item{xlab}{a label for the x axis.} \item{ylab}{a label for the y axis.} \item{gp}{a \code{"gpar"} object controlling the grid graphical parameters of the points.} \item{lwd}{line width for the fitted line} \item{name}{name of the plotting viewport.} \item{newpage}{logical. Should \code{\link{grid.newpage}} be called before plotting?} \item{pop}{logical. Should the viewport created be popped?} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{\dots}{further arguments passed to \code{\link{grid.points}}.} } \details{ \code{distplot} plots the number of occurrences (counts) against the distribution metameter of the specified distribution. If the distribution fits the data, the plot should show a straight line. See Friendly (2000) for details. In these plots, the open points show the observed count metameters; the filled points show the confidence interval centers, and the dashed lines show the \code{conf_level} confidence intervals for each point. } \value{ Returns invisibly a data frame containing the counts (\code{Counts}), frequencies (\code{Freq}) and other details of the computations used to construct the plot. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \references{ D. C. Hoaglin (1980), A poissonness plot, \emph{The American Statistican}, \bold{34}, 146--149. D. C. Hoaglin & J. W. Tukey (1985), Checking the shape of discrete distributions. In D. C. Hoaglin, F. Mosteller, J. W. Tukey (eds.), \emph{Exploring Data Tables, Trends and Shapes}, chapter 9. John Wiley & Sons, New York. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \examples{ ## Simulated data examples: dummy <- rnbinom(1000, size = 1.5, prob = 0.8) distplot(dummy, type = "nbinomial") ## Real data examples: data("HorseKicks") data("Federalist") data("Saxony") distplot(HorseKicks, type = "poisson") distplot(HorseKicks, type = "poisson", lambda = 0.61) distplot(Federalist, type = "poisson") distplot(Federalist, type = "nbinomial", size = 1) distplot(Federalist, type = "nbinomial") distplot(Saxony, type = "binomial", size = 12) } \keyword{category} vcd/man/Trucks.Rd0000755000175100001440000000313012214055644013364 0ustar hornikusers\name{Trucks} \alias{Trucks} \docType{data} \title{Truck Accidents Data} \description{ Data from a study in England in two periods from November 1969 to October 1971 and November 1971 to October 1973. A new compulsory safety measure for trucks was introduced in October 1971. Therefore, the question is whether the safety measure had an effect on the number of accidents and on the point of collision on the truck. } \usage{ data("Trucks") } \format{ A data frame with 24 observations on 5 variables. \describe{ \item{Freq}{frequency of accidents involving trucks.} \item{period}{factor indicating time period (before, after) 1971-11-01.} \item{collision}{factor indicating whether the collision was in the back or forward (including the front and the sides) of the truck (back, forward).} \item{parked}{factor indicating whether the truck was parked (yes, no).} \item{light}{factor indicating light conditions: day light (daylight), night on an illuminated road (night, illuminate), night on a dark road (night, dark).} } } \references{ E. B. Andersen (1991), \emph{The Statistical Analysis of Categorical Data}. 2nd edition. Springer-Verlag, Berlin. } \source{ E. B. Andersen (1991), The Statistical Analysis of Categorical Data, Table 6.8. } \examples{ library(MASS) data("Trucks") tab <- xtabs(Freq ~ period + collision + light + parked, data = Trucks) loglm(~ (collision + period) * parked * light, data = tab) doubledecker(collision ~ parked + light + period, data = tab) cotabplot(tab, panel = cotab_coindep) } \keyword{datasets} vcd/man/fourfold.Rd0000644000175100001440000001517512531710554013742 0ustar hornikusers\name{fourfold} \alias{fourfold} \title{Fourfold Plots} \description{ Creates an (extended) fourfold display of a \eqn{2 \times 2 \times k}{2 x 2 x k} contingency table, allowing for the visual inspection of the association between two dichotomous variables in one or several populations (strata). } \usage{ fourfold(x, color = c("#99CCFF", "#6699CC", "#FFA0A0", "#A0A0FF", "#FF0000", "#000080"), conf_level = 0.95, std = c("margins", "ind.max", "all.max"), margin = c(1, 2), space = 0.2, main = NULL, sub = NULL, mfrow = NULL, mfcol = NULL, extended = TRUE, ticks = 0.15, p_adjust_method = p.adjust.methods, newpage = TRUE, fontsize = 12, default_prefix = c("Row", "Col", "Strata"), sep = ": ", varnames = TRUE, return_grob = FALSE) } \arguments{ \item{x}{a \eqn{2 \times 2 \times k}{2 x 2 x k} contingency table in array form, or a \eqn{2 \times 2}{2 x 2} matrix if \eqn{k} is 1. If \code{length(dim(x)>3}, dimensions \code{3:length(dim(x)} are silently raveled into a combined strata dimension with \code{k=prod(dim(x)[-(1:2)]))}.} \item{color}{a vector of length 6 specifying the colors to use for the smaller and larger diagonals of each \eqn{2 \times 2}{2 x 2} table. The first pair is used for the standard (non-extended) plots, the other two for the extended version: the second/third pair is used for tables with non-significant/significant log-odds ratios, respectively, the latter being visualized in brighter colors.} \item{conf_level}{confidence level used for the confidence rings on the odds ratios. Must be a single non-negative number less than 1; if set to 0, confidence rings are suppressed.} \item{std}{a character string specifying how to standardize the table. Must be one of \code{"margins"}, \code{"ind.max"}, or \code{"all.max"}, and can be abbreviated by the initial letter. If set to \code{"margins"}, each \eqn{2 \times 2}{2 x 2} table is standardized to equate the margins specified by \code{margin} while preserving the odds ratio. If \code{"ind.max"} or \code{"all.max"}, the tables are either individually or simultaneously standardized to a maximal cell frequency of 1.} \item{margin}{a numeric vector with the margins to equate. Must be one of \code{1}, \code{2}, or \code{c(1, 2)} (the default), which corresponds to standardizing only the row, only column, or both row and column in each \eqn{2 \times 2}{2 x 2} table. Only used if \code{std} equals \code{"margins"}.} \item{space}{the amount of space (as a fraction of the maximal radius of the quarter circles) used for the row and column labels.} \item{main, sub}{character string for the fourfold plot title/subtitle.} \item{mfrow, mfcol}{a numeric vector with two components: \var{nr} and \var{nc}, indicating that the displays for the \eqn{2 \times 2}{2 x 2} tables should be arranged in an \var{nr} by \var{nc} layout, filled by rows/columns. The defaults are calculated to give a collection of plots in landscape orientation when \var{k} is not a perfect square.} \item{extended}{logical; if \code{TRUE}, extended plots are plotted, i.e., colors are brighter for significant log-odds ratios, and ticks are plotted showing the direction of association for positive log-odds.} \item{ticks}{the length of the ticks. If set to 0, no ticks are plotted.} \item{p_adjust_method}{method to be used for p-value adjustments for multi-stratum plots, as provided by \code{link[stats]{p.adjust}}. Use \code{p_adjust_method="none"} to disable this adjustment. The p-values are used for the \sQuote{visual} significance tests of the odds ratios.} \item{newpage}{logical; if \code{TRUE}, \code{grid.newpage()} is called before plotting.} \item{fontsize}{fontsize of main title. Other labels are scaled relative to this.} \item{default_prefix}{character vector of length 3 with default labels for possibly missing row/column/strata variable names.} \item{sep}{default separator between variable names and levels for labels.} \item{varnames}{Logical; should the variable names be printed in the labeling of stratifed plots?} \item{return_grob}{Logical; shall a snapshot of the display be returned as a grob object?} } \details{ The fourfold display is designed for the display of \eqn{2 \times 2 \times k}{2 x 2 x k} tables. Following suitable standardization, the cell frequencies \eqn{f_{ij}}{f[i,j]} of each \eqn{2 \times 2}{2 x 2} table are shown as a quarter circle whose radius is proportional to \eqn{\sqrt{f_{ij}}}{sqrt(f[i,j])} so that its area is proportional to the cell frequency. An association (odds ratio different from 1) between the binary row and column variables is indicated by the tendency of diagonally opposite cells in one direction to differ in size from those in the other direction; color is used to show this direction. Confidence rings for the odds ratio allow a visual test of the null of no association; the rings for adjacent quadrants overlap iff the observed counts are consistent with the null hypothesis. Typically, the number \eqn{k} corresponds to the number of levels of a stratifying variable, and it is of interest to see whether the association is homogeneous across strata. The fourfold display visualizes the pattern of association. Note that the confidence rings for the individual odds ratios are not adjusted for multiple testing. } \references{ Friendly, M. (1994), \emph{A fourfold display for 2 by 2 by \eqn{k} tables}. Technical Report 217, York University, Psychology Department, \url{http://datavis.ca/papers/4fold/4fold.pdf}. Friendly, M. (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \seealso{ \code{\link{mosaic}}, \code{\link{assoc}} \code{link[stats]{p.adjust}} for methods of p value adjustment } \examples{ data("UCBAdmissions") ## Use the Berkeley admission data as in Friendly (1995). x <- aperm(UCBAdmissions, c(2, 1, 3)) dimnames(x)[[2]] <- c("Yes", "No") names(dimnames(x)) <- c("Sex", "Admit?", "Department") ftable(x) ## Fourfold display of data aggregated over departments, with ## frequencies standardized to equate the margins for admission ## and sex. ## Figure 1 in Friendly (1994). fourfold(margin.table(x, c(1, 2))) ## Fourfold display of x, with frequencies in each table ## standardized to equate the margins for admission and sex. ## Figure 2 in Friendly (1994). fourfold(x) cotabplot(x, panel = cotab_fourfold) ## Fourfold display of x, with frequencies in each table ## standardized to equate the margins for admission. but not ## for sex. ## Figure 3 in Friendly (1994). fourfold(x, margin = 2) } \keyword{hplot} vcd/.Rinstignore0000755000175100001440000000002012214053200013330 0ustar hornikusersinst/doc/Z.cls