vcd/0000755000175100001440000000000012767263550011061 5ustar hornikusersvcd/inst/0000755000175100001440000000000012767204756012041 5ustar hornikusersvcd/inst/CITATION0000755000175100001440000000473712214061372013172 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.Rd0000644000175100001440000002104412767204710013073 0ustar hornikusers\name{NEWS} \title{News for Package \pkg{vcd}} \newcommand{\cpkg}{\href{https://CRAN.R-project.org/package=#1}{\pkg{#1}}} \section{Changes in version 1.4-3}{ \itemize{ \item Remove outdated inst/doc directory. } } \section{Changes in version 1.4-2}{ \itemize{ \item add \code{lines()} method for \code{loddsratio} objects. \item add \code{gpar()} argment to control confidence intervals in \code{distplot()}. } } \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/0000755000175100001440000000000012767204756012606 5ustar hornikusersvcd/inst/doc/strucplot.pdf0000644000175100001440000177005012767204756015352 0ustar hornikusers%PDF-1.5 % 94 0 obj << /Length 3250 /Filter /FlateDecode >> stream xڝr6`%T|3{d3y6&U@IԐ=K~} q`F[{M(/n>ɃȤww #wn.qq󄓩vQ>Wo"6>B?&L,%`.MΘ8qn >nk>Kv+_!r-u{enQ&Djגq +NT$&b'~ߓqbl @=}&yQȓ'I>hGФH)vRIZmCetl?Z΂8M9G1\qlcC>NDWXn)zb ˂sSم5u/sU_neΊY#k+4'\9M#r埸xSgvikTO )6a6zHG dWa$N_6NP"6g!:2!-T-̯֭Mݎ8̦cB^>N< 2( t .2#'fKn,HRK0dC>|.\cƈgpyDɁuo 5a#%'YaGGUL &ڱd/]Ǘ02طA/_( U]v+~[@õtZ*uombF+L u-nY@@*Fq>ݫ,;(u-ɓ N2V4ATJ`^wfoAε*^%֌hw@-$4р m|.On0XgG[jFUtp6S9wm3AOtǷ@O7TX\OD*$1 Zr.޻/3nJe|hd(.` ɨo%KMtQ8lGyjJ~@fJi~&$΄)cm]GZnp(LilódPY]e͋qٹi25`4 2mPj:Iid,Y mkVAX[[6ŴksJsT"u m,|6/1EڍO߄ɽ e0m"j+Wߤ$֢RlS+'DSIO6i/Uao둍Z N_kķMu5.й(\ ^W%(h¶6dhVM$ГOdq\4m5)l4(uxAfb_)0F6(U@ kuwf.NwAw7c endstream endobj 152 0 obj << /Length 4282 /Filter /FlateDecode >> stream xڽ\Y۸~_Tq*# C{:lR>=3H%_>kÌxݍ>>4H4I2Ib=Y"]_<{%D$qbriRIzr=߮z*+F"SР6׷"/R-no3{ MW?^yZgqڕo*dDLRE?G{OtI$Z@%WP 0Me\@lj4z?UekP%\NU /| ^N#B4}L 3Rkj^\7'$EnH ꤈f+p~gtڄ"=ŵmco1c:X6Lu^o :(teYY^=Mߖ`?=_3t$ J68bcfVUPiTY'L;n 6.Жg/"Kbu9M[?$BY}_nNYccYU*_݆/.ȵ?#+tuyi!?ˉޖz{"/#9&t>e 8|+- @ cKVx >ч"akwX/{6лنġú@f^aEN rl6VN&`<~5E,*Fv4 mG>S_w+x,;!ֱH% I A^lA(eh*_=a،õЌ XҫZ4ix1,#W'4 mٳ8KGN>M43tq-7LXfG\Dũgeg;;u|y'iz!X_˦T'+82Ţ / ɹ 'aT/Cshﺯ *KQ31 T4 Q)8RSaiꁀM%j! 6[Nӕ(8 t{& @L4 z! \8 3CI@?.g'vŗӬ1Q? 0Akq"\(vmMrfz$-#ѝ C5tL ʯW܌]Q#4e![%%y!pnX5@\^$B}kL2Y/JX9ƶ/]qCFG!j36BM̚+_r5cv{C w^+YTf*O3?D3e.j?z_2;b4S}i_aց5 ݒ 35͚^^_~!(UEJ3odA1̝&j1Q0 ۋtϊ(C'c㢀 -Cha ,E9/2qZ CA*D:Fr!4tChkh siGNW8~(]*I0&C9M5XTrޮA 0fs112N;B`3$;Pnfca7pa7 n00C 4\ a#l=HE鸀i,Ût,8e_EڛtB&LGb LLgjυ6 p4']Oϐ:טY\¼]+ļTj\csigԗ"CFئ_IObkqe 8ƕ$SF`+%lUs$C`[1Oa`gJ8ϳZm)bNdn I(a18A%u渷ɢͿBаx0 rOt<dw:6Vbu .XOku\ $q>J% V>04IYEPL돚q4tGҁmq.p$R;fMۯIn;$C +ՂäQz>NQrDIm'i0pkB 0DS4_38qFkSS,\)j ^ęW|vkW'g ChؘB.ff=1YHȎֆQ.b`"8[{*Ӹ,qUqb~[#/Q4>4-cO8ay O\W\x.p94\ anT>N`0|~77'r_?m)3ɼyq׈2dfQJ8Q.HG #:zrY_׽ ;TQ˸9Kǐ'Yj/o0 BljXozRU>|:A%L:D_܏G/V  "fx+-Mz,t7H[uc!D᧩unּI.Q.rg\eҷw[ՂkMɰoP-Xqu5O~Z7۶DunJMmgՂO*zs_ҡۅvZhT̽MkUcJ/TYSRSJA%nmM"!Z)HYk|"ԟlmQGr+e׽0x)pP[n4}e+)2: ;imCe*/!{0vJglM脼skffG}dUzTƙ^TFRs[!ZW"Q5/b+;cݞjRڼ-֙S#> o]mT,8'0PFZ:^Ȥ;$cm! Png8Vl}>=R,UlqQr.Y󏼅+vjiZKenDmo2p_dneWG 85,XC4ό$ 67 :`f?p(i9C;`P5-3t$Q{Sk&C{P|aaYp+? MMYb8 +O &, R a\D;x)Y 'jhXц"iC0R[*CÀ7\3OI4TęlFJxn'Lzk:I-x7,#1Kj̳Ah7&jS1'dUj8hT%H;4eծ$W7Y20D1GE5{*n|,ԑM%6聺:^>z`w/q0fm-{i6 5r@6T,;@o<ే=lgf{4 闱(dn%<.Zeqf\ }%Lkㆥ+n}<`\/yʱ'iu&d/6XA\n$6\wBHeuYq:@Ŋ}dٝQA!YTqk2[}78MA=N(nYG7vs3m0m4Qi7h> stream xZmo8_X^mqE$B])촹_Pf7vVWC@Q<0L0ˌe9"J1)4I͔6xdk&=A2%1 lB`2k(= NB 12#aKș!PR@qh;I %,@|dx*f  a( Yvg`l0sx<#/1V ofSi pI *R^F PLKi '`L &PUȢO` se0e Fh xf-7s0ac"gA4#fiʈaXs%_'CQ:w\D7>!{<)CptOz Rw).H ILKo(ȃ2.Qlpp7@ރ%r) %E:ed1aFEGY1ie9)딠܁i뗁0)o(S6?e76;-목?Ynw;VW必ݺ,W͚:mܴeb[ ;z7]VM/fQd*oq ,${ϛzYQX.uտ[;RcI-E(q2~jEHZڑM3a_I0۲hOEH۔[;Y+~zU,< 4nE2.ojJͣm7z'pRl0Ţr#8`@nGhOU~ӷz;~ .Ve dN| $Q&yf/>) vn{K;pҏ@`n.?|W붼z)*6'GlG&SgP["xvb/uq*$ )M@Eͱ.rN в7# l Qʇ0SqaK~[_Uը>Pi({A AcHwZfHe> >usժ endstream endobj 196 0 obj << /Length 3752 /Filter /FlateDecode >> stream xZK6ϯPʢ |>Ip# dUrE d$or]^nTWI66i:YW:ܷRQ*-:>v/2FZmLz w0O0L y2A87}dM]lQ2ω>iDIl= +YxKia"ছN@]͙ _^:_m*w +{Ի{̲g8~BL+jOOMvG~ty/2@Xh54_Д-4bQn|Z^-Y%̣vfD~EA hX;45u|E\Ō}1(Y:9x* m6| blE|s7d7LM=յYT)C08Qy TѮ#W󡴭q 2qg71%ٌObSo4г(x=y# ;@ @ᗫ* idt}һYR0oŤHݺ I}=thO?h,ɭUqwbWR34geJ[cxceڎȓ jc'Vc gݚhf 4h9$Stfm#g<56#.,q+:W}GFYe]uPNizvZyf5eڨ&<':)4PhKMiz֧نeglO󀉈B]^}$ vRhZ초U†p/4A&\s<5a{bWwB^4N5YqգzJ-YXt }UQHG%4.H̔(hC]y0WQƹNeזS*δk1q[[T]bJ9qcHTʐkq1<4l3ӓliOA8\0+l t8nf 9˳_j'xBh"L]Xemi&)4KdWJ2MLU(3<֗T FYh ?Z]}L*Yg_ٿ7?-Ucnü *Vs )xڝ^=C3̍Jf` aG0ɷ}I~[e m!3uE0TT Zv|ے9o6Fr#=!Jh#rw0;MExf`(g ~NTF)f,mp"j;JXjrqmJi_FP[(׌%&DK([epM[ :OfTl/Skf[ .zt35[oQinۗIt= }^Vw""7HJa[u^fdm` -gv⋸MRe}ܸ0\1HI~CBaFB3k)nWt Jj7v6j<<_h^@uHpI%-a5B}Z:4N]8 tJj,B BѰ9C1&irZr/sYmFo>wTX0oѧcMgqhart{q(6>7xxZ_3W8CygK?|s7MCRr0mO*vk=;@/'O q>LmE[0SOB֐޶z,#h w9x^0_@ggɗU?R@:zg1PywH-ɡy(,F3ZqSp q\`9a2Sq搭;`#m࢒ pP\=T3ppKyUXyz8D6ȋBs>vt"ǒo)LxN6)CDˑ0Қ2~UG5D)&U3! PW 55 yӓ[ .n-PaP^ $'vx!@k_*HTiNg4 }OJ-L|6MW̥\SBV$"$hyѫ1KQ:$MJwi٣7.ZH^d\^BҠ\dAU;wӷ:L]c& Y(??y9I:Ѫ4%ƢK4C\b_ݮS1\N&L[W)YgeEDլ"E坵ԛm!nlEp Dd$42uT|KsdNx@M%߶kb.U SxpB/(ulBh&dMBCDeuS-8sW[Dy1JV1+QXskȸʖ(^=0O 1| fT_q匤L&TAEHOf3b.,6(W;ϊΖRzi 3Ϯh. g޵<1~40n%tPopmᕭw!n\tŅ\Tl\. ^K{G26y:M->L7[ӊquʧ# v|wXELѠu*+[.qY(} "ɽؚ& ׯTfS$䝙7V.M9.Aהjz7Ư4_(\  svIB=k+ȌlnK`~Y w7vt_*;B-2r-Z ?o6\fC++KD(o 1=uofBqEKZqqvt 膩Dyߓ>pqa[QR|wHsy*m D5!O!X9a)T*ba4ݺ&ȴN{ i9:fx@zˡY".Q[>ɱv5 jOn9ݷ%0%5Ϗfw^>x,q^9K8z&Vyj*mx[#cVL8>`eFiN_g 8ׂ A!}~RvNcj,V LJZAg!ٍf͹|7BW^ZFK(xjBq.U/,J `s$?{uM^65q[~N%)j(r9 Oo%3vOҹoWrXN\<[E}q"aEhfI0LN~/I; endstream endobj 208 0 obj << /Length 393 /Filter /FlateDecode >> stream xڝQO0)=&>aEp@^KQ\{wM96UѠ@B3rBiVMKku?(3s, ʑz8MH ~KRTD関0X/i趶*21uk㮧 KM%9h`I^M#Hߙ+vEtAQ3.A!x#zJzb퀫$ET5aS7WYSzl͌puoosިQr28?N{>o7ך :LIU[yE c7 /r0Ehz .d+4? [Ѣ}&Vz钔ɉ[qe\*XL1ňb@H//# endstream endobj 179 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-Arthritis.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 210 0 R /BBox [0 0 504 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 211 0 R/F3 212 0 R>> /ExtGState << >>/ColorSpace << /sRGB 213 0 R >>>> /Length 726 /Filter /FlateDecode >> stream xVKS0W19DVOwSf`h!3SMZrl``O(8z#R ^rZFѷ%^BP(u 7 * #hJ!eamAA탌'Jۨrw+lk s`)9YmD=.۔6b:=>_%H.s[ r 0GU,Rӫ.~ڈKqPjcV_Mx?oPxqP)3w=5#-5:COxTB.~v}n9ՈiDǣӈrO#MV#}8F{o5@$iD5Ub@K+ iJDJճf_Bu$Sf4YכG+!px&ci5|wDM@X2̜㶽xȗ)oRD3\2 >tTht)dn"@b ].`T"ԭcY{4MWO{Z2/͛ ,)8d&/Mz&=p*4k}Yܭ *!Y<-D!zN<%EW2/gtF NϘ~ Vi6Mb7g>nBwJҵ9t өp)E| endstream endobj 215 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 180 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-UCBAdmissions.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 216 0 R /BBox [0 0 720 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 217 0 R/F3 218 0 R>> /ExtGState << >>/ColorSpace << /sRGB 219 0 R >>>> /Length 1302 /Filter /FlateDecode >> stream x͙Mo8<sI=4iS @h["n`H$-nPˢ09×|"-nS~{R=uJFet-|uK?+~{գU(qiqCCVZ%R04 oew3jP뿄620܆VNHZXoŻ?wX?tu0Pڏ6?@85z`hFM~QaZ@ bmHݎ/'wV^gdwDXy/njiyn;h/v3vv( @kBG K|vM@~Q}d.y Dִ$IxG|nP ;5h^ЁLJ@)~C||ۙFVD-uGx{9pH8K81}ϛU(Tt\G/UGy㟏٣h*?Ga\\f8e5;2q3Q&N.d:ءQT*;0.n;;LʔRPG;iCnn ެb$6(U8OM\{/}жa`'< o3{?;Ԟz=l4 GTG`]<3yph8[ d!Ê*ݑ8w T/'է&H ZG 24|[ Blb-O>|?a =30|1@L7Zbхi(SI hu΢^U]UFON2DZj=VDB`QD7<'4i\V4ig@b攘\j LLDд؜fD'qbvSbg!RQ >kXG G k0=qv:l*Л_Ǐ 垽:yn;hD&2D/&3h ;Pr=N>9q6EBBh"31h#Q b("XFtT)?#s:c%5{@1PL7Zbх0ASANAIXUneT&2iEk%xN:=5a9ic@1YbsPL.(PK"Z#nNy>S+ endstream endobj 221 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 224 0 obj << /Length 401 /Filter /FlateDecode >> stream xڝKO0 ><h@0nCc@qtEUv0iYș 6J ~0&$qJ)rDq$ȭdBg!tQ>%8g &wE| 䩸 P7(ѲLQ5B"˞aE ;o4YawЯ;MHTNJ{Lr JdL` <<$ʚcg`BaA`Zq9ئ$ ٟ 4jgekvWCtW LP"& Wz<7K> /ExtGState << >>/ColorSpace << /sRGB 229 0 R >>>> /Length 930 /Filter /FlateDecode >> stream xWMOIϯ}U)X hwE( & [5ݘ=]_&8s߻ߟvdLفA\U\@g FȠI-|W$6VY YN 2S&3drgu UlMޑϣ6z9N7 +Q^%}jH>;c(2va-:K0fLh:#^g_mޡŞ:{wo|GP\BZ/Y͗ao g{+JV+긷Jb+ve+4ivA=ڠTO70i~JUv~|+^J<;`2m#RR H3Ty"kF VIԉ&j~V*zΚ+mG i#rR($,g;P"# KyI!Z;COd&A#q/TBo )o4^H%Dg*m~'P]ƘזN(%@6Z:Qbnx腅]?861]Đ6k T__Љaje׵" ګv1Z!#&ri,⨝Ia{T=$IetXonC=1iu%zXElhaKOCzW (Y{c^ϑn&Ǔ;r`7{6|y}3]iY˘vMԶ!)nR电upՋdR'{Clڂ6Û ̶ca<Jn endstream endobj 231 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 182 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-Titanic.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 232 0 R /BBox [0 0 720 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 233 0 R/F2 234 0 R/F3 235 0 R>> /ExtGState << >>/ColorSpace << /sRGB 236 0 R >>>> /Length 1559 /Filter /FlateDecode >> stream xZo[7 9Lo`)vk)=6aY>!m(k xN~zݭ{(oPy^&? O]'2(.GSog7Ji,hR6ΉRL7bV_g=P?_^FG+-u'hj.nw |:فw>X+ݚpQY='#8D!Ie$,$!7k{_Dd=9Q=IW kE70I9'\Dk2`֟~9tJ=`Y21H`MJ ‚S#>~&TVo@{.Hc`eȸ'*%( :]Kp)/L:zioM'LFT"쀬tM9R.  \3 %]yw) 5TV ɬ-##uXڸ (.}@cTz%= 73EF/6^`NKnsv:Uֿzߡ-ͫ79lpjjY}ٹ^C,{sa֘ADGt / =K m74f6;iZk_˲_;QXz<AIgy?S7) (p7skЮlнeooIx8}}0 & xFo>C ;Mii7Zpu}V+cPwK|c#};ft t1ώ8!vGa߲8x҈2p^Hu5Ox>=' ;'?kI=0GqaCη ND"8P-?k뮇~l5'4+v)W90|Џ4M&pbbDe^*TiNnUٝZ*]؝4+Xv zMvt yě.3z:iuwX+8U?ش,:bKab謽|!.Y9zG&6_됊 , xƦvt;v?ϻS!>P72޸* piGpMѧ[~o 6.Tn\68Gބd.Fb*2q`xoRnu6q(ڊ/|yJ+0=14 k7.S*|S,w$*aFoMˍR$BNdk >P !߲]ݬ.#wbeퟩwV]݉py3竊4\< Ad'jRg^vEelV|Gܙ endstream endobj 238 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 243 0 obj << /Length 3323 /Filter /FlateDecode >> stream xZ[~_aF׊DR h (4fƍo<{{oR, Ŭ):<<<;*=7}MQΊH8X's,Jqxbb7qaHL3yX1n)p4 1뭊Mӈ!!r{xNl6 z<[5Yghp4)Og%] =:p:) n:OԖ6P5Y,Ɣ m䬇eʜoE Y/0b=J%ϊF- ,Xj..Nq8*ꂝ&h4.eGwxC: *LO\<¸#^LR|l?3VuZ{Կg dCmyGXum:/<,pvh 7EޤuxDM5E;ALP K6MKXߟyf)¦gmtr5]NJOa$kijzM\b8 OCr)Jt|t& dŤ᰼#.#sC9'Tr 4 XM9XlQ2Ҿ aI/d@ޘ3#?c0z8a4Np=^D֊0_sWfNb(hP)&f.keuy|pj2O({=5:Rtq&::hQWJ2rG^3W6YccBd(65R>͓<\vBFa{>JQM3mBiyq |aD熷jQhK[&|T'@Zb_!qlqZE:q";Xv]dY;Jrdvzχ ϟIHDhCP`yD͑!OE2 8֐.xRZ h H<=zJ@np1 geQ5C|k|Vg2X{b+0]jWHZ%OZ‘C{$:6Aw~ @yZIl$c"Jp7!BIܸ@rQ*+*`Sp!yRB[4kb 2ۋTo{ݡFȋUd0f{E?ǐ4ULT*&w\Vas<]9m VTo`·H }yzSEi9MVA=iz, x*p%.MpOEp8 , *U^Zyt]1A &\8Fv .+|Nǡv3Td f>OK;j#vR}C!V%||eՋ\. EUrC. il@w$Y|g@S1 n9:DhIm:6Oz~$Q2O9TRmI}SFrPi5ߓs QJs ][g5ɱM"f0"Bso)?P>RJׇ/0g3,MׄWbj˧)ɪ:q-c.lI.䢻ȉA~+V?V)YZ¯|!ҏ*I+~PcU ~ŽR5?Qt?5g쯹{A2 `6e6ŲXF]+eKy.P?ы2.yE22yS6;|/6~KW4BI!`;zI\D2d )UV+TKT1t))n@PXT| et⚔ \وP)扗vh#l%{mF+ bbu >Vʙ_鄣J88lc{'8ђuIQQQnIMj1vzY"9G[- nˏCn{=IAXXfM >4` endstream endobj 253 0 obj << /Length 2510 /Filter /FlateDecode >> stream xڵ\Ks6W(UeHpod*{؊kRD۪!y/6AP"`dS߇f gO~ *\1J^*6e5YkZ>Ƀ|m<_[6_TV~k@tcWuڏ=6T`V&w3wDddbmwJ'qBpN G JIr\~A<|pN!Oe^WX{<Ln]X˷Ѳ ]yJՐ^3 4T E*҂R [ vcmA }hfU:w~߀4/a^{bV*`g38ƹ5 !.ۖJa c˹f> =z\|.9QL<'$O P$H #Q=$ph1h\&2k(4.mx% #𹙝]Fr\o$Y|JU3tOkWu m:DP)GIIaH #M6,+zu3709IZsIV!Zn$bUH) #}kE{Ávd`ByF׋QʏPWIa\ FPT*M06܂ѓ*@0t=07[I{C=$PBLC f2!v[:C#VG 6ᡜWWeCvoYKbݸPy櫟\4gknOpv(^J?D~'7P"7><遴uO`}^WRׯ~!=bpvcFǹZ6\8-,Z?]= &k[Z満#_k3Էڻ4%N(U1 >U7l#RJ"m>(Xqs`;kCץaUV/Cpsy[; bIJ'!V-018Ipr=r0j{ӫޘ܍]}{;'@ ?xysLBC`\~!=mҿ1~K;d~i !Myî3Z}+3pΡ8gdO/A endstream endobj 270 0 obj << /Length 1520 /Filter /FlateDecode >> stream xڽXKoFW9Pr ډ{(P[(hJBRqC;]lIQ0.ggcG >.+: ˨t:<,MLgUr~>Β Xz<1ƨ[X;gv4=j\$8sմ u"1r:Ұ8  fїQ$I[Җ='u܌~?+ݲL'NuI 8~0G}hxnop3 cf(!uG`³{w^cUx"=%y&OIB2LJBGiO\Isd(qɂ/胈:NSU#6h|?ް}kEy3׭Ɵ? (yO$s!&ҏ b4o%BD-HE.7p!n QHzrטn341jN˘"-m>:LLa}BuR]bE"~VRM~&w*(bqqi3fG+L6F M &qq eM&s->҈| uF:MvK ͆|EHAuťjcZNqe;ސ,V:|_q; !4h8 >s^((aQ$1 OHu-8vqʍ2 ^ZzC J`b8$Z-[p aP 7ly!C}B%i@`^yf :?x67/*#|l>ڔKkDj{VDrIGl;& 3͗8hwfƤ֢zɝl= 52buN+Nv0]H-[, ;Й2(ߘӛOaY[8t= hNU~mz]8?zTXa|:bBC*ʼn Mn.ЭB=vyAc/ !tpF0Y ǙCWG~PJGneѤmsJ'͜\+ЬE]JݳH=,]o@G8rM/ K{˷F'* 2)>dtSp;֎mmۃKjXmeՅ&Jm4 :X]_\N%w cF,`hrW ֌-NwH]yYbݺd[tԐj;(D+w-őĠmѷ p;22seY1%}|v(Iz;(jjzl~v^OL >+>LYZN;@nL/l%A%ɋPY052Fp`҅Ș@[{^I< ەIQJYrM(R>ːXX/5eJ*ƻzǹS ikJ$>W1UOu.t;d endstream endobj 239 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/struc.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 272 0 R /BBox [0 0 794 595] /Resources << /Font << /F1 273 0 R/F2 274 0 R>> /ProcSet [ /PDF ] >> /Length 1891 /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 285 0 obj << /Length 2176 /Filter /FlateDecode >> stream xڭY[s~K$w&Izt-і舴ͯ﹁# $>HG7t>V.Ltq%:QGY¦2L\Β,>Z՗Y6_/Pt%[W34pxNp^yBβ~[_wݒ{ \黅;wXE}ؓa ӱ'H:!we+aYRL`»qه%BEpgؔrAhbb4Yˮݕ߀soU~b`}Cx Jj|jh( M GRxACz'JSM\W%&PGH#dEԳw R8#07h߭E.:@:3;BʦEbx"ّTA?F(4?@_MM;;˘!pQ 9 &r_yRQұjqk#2`"}x|jCl"$qT0ÔLib"q "9b9x*" v 99@o Ո ;)quj䄺sJ,Qr3cvAwH QTG5/ӜkT(_?BNM)tR7|FHm9X|_ |~EǶ+X>#'KrUu|)W)[ -g gBszmK닪a+Jc\A JRVcldx aP nIڦMm$\RMI~cd$g-Nv0!2ej CyfDS?dru|9rtp'ij [_p4Umr( J$p] ʚJ 'IDpK_3!Oq 6#x;ϳbxU!!>B&Wt r߶A[7MtAwwPSc'IA /N><9Wwe+S[vlԋ)\цbUޟTX~3U cto?Nͫ_]U endstream endobj 240 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-vcdlayout.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 287 0 R /BBox [0 0 432 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 288 0 R>> /ExtGState << >>/ColorSpace << /sRGB 289 0 R >>>> /Length 437 /Filter /FlateDecode >> stream xn0EYWgY(TBjx " %>-"N,=sc Wx/0" !`bfs F>ǡz NoN)L iǬH6tb4s$ĒAA'[.${4Joc,%Թҩ ! @#%8+X{VJA8udcmLWT)&ErbD4aq ƆxZ\b(!%0j_Ū7-lq8 >uA9jcYTUm*”N_Ɔrc1kiN]:K՝C2q{axD!m!|ns\ ._7N%/ n Kk}1S~OUŅ۳~ M endstream endobj 291 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 296 0 obj << /Length 369 /Filter /FlateDecode >> stream xڵSN0+hzGa8 rQ7T-iFMQ[EcO2ob pI@ (E.sr Y'rm=C^. \x$'lS5tIQhix-CU{j\96)} =վ_&H4NE0- ["2T66Y,zWS䖞-sڡ!zE EL#CAGyhvTXT>hw1 5rFݽjkP[/ W}Y oՏȷ} Gt*o醁.ğ 9`LQu1wc:Ի9 zOO4cw[=>H+'Ŝt Fff =V%H=d endstream endobj 256 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-Observedfig.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 299 0 R /BBox [0 0 504 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 300 0 R/F3 301 0 R>> /ExtGState << >>/ColorSpace << /sRGB 302 0 R >>>> /Length 736 /Filter /FlateDecode >> stream xŘMO@sL|5!Q+BP*q,o8Y-|o>x~l+jp C J5X[{~6T/O4zV# EAkLB"V4T'-~^' PRnK{PGILug]&M<&͛٦u7s$@0ĸ9Z;n31Q;is8(413<*\6ϷLoHgt2L*Gv.v En-|w@){@3=ov/lIsBDk&>O2DZ۾m>~g [Gg~~`QtGKU2DyGFy'x>wOT_2O\(< Lܔu2jv/K[_6d/v믣ܮ endstream endobj 304 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 260 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-Expectedfig.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 305 0 R /BBox [0 0 504 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 306 0 R/F3 307 0 R>> /ExtGState << >>/ColorSpace << /sRGB 308 0 R >>>> /Length 678 /Filter /FlateDecode >> stream xKo0 <&qzۺ:`MnEAK0tۯdRctxP)l~{XbU..> /O BXXL: |E /S:j(Al(|@0%óg NBN |@_ > /eh,.hϧ9<|sgSLP͵H2 9 9 kOfH&s6PX~m;iiuEX>4UXΫeG)~7d`GghE0a\(z8<{6%թ;)t`sOkFaLaӭd}=?04N];ESu~3e7Q~0{ʜX agzl! 譠6ht,B]8%3cц/|c7n3uo0޼ endstream endobj 310 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 178 0 obj << /Type /ObjStm /N 100 /First 885 /Length 2342 /Filter /FlateDecode >> stream xZmo7_oQFǾzmp^l]eɧ\]ٖdE-6 KP2|RN`|J+^YBeRR L(QDJAq"NBmIZ2 e6 k<A&NQ4V9*)&րB2J ]F3#@zaH3xHkjeep&,tI% ^Y1^sR6i 4(TXl]FZWY Yn#*";-꤈ QP9t/’|#|feM{dwQvAyߨ&"-AQAB@}gh=h29d rd츬/b-!RJR!A!YTXE(FG‡Tt.K*Y#X٪mc +c ٫$Jg$YƐ<ưd4)5-*P1clfP@RZiauX *N* (Z)JKR}a+*v4S3:UE%(p6w^]AGY[f#6^ ִDf4CU3 4ހ0Cn??`Xr[~xnAF>0kxTL?QT e)!\=N`Awz2zҠI/_>3V1[9 ȜZpg ։Hum楟a^ye;nEox76vףq7mq|F͇pV4V EktdGSŷ#}_ƵvuB{nV# VĬB4(j w?Ntz(O~Ч܌G=_5{3:plZ@wVAS'5d!(X7N`ױǾmO OK(FP1aH>k$$ڈ_6'@;1E5l!F؟6zȺ b1T>F)/ແsɯqKdX0c?,;X%$KwTu]8`>.e Ni^dCdD {'oUgӛY[wVc`>H)_08iNCy-} +'u=wC=We۰u&2^X,Z߼ oeHWri=_vDn|h8w{ v.VhZǹ;^'~q9.?EYͦuQ7?[e5נE)&Iqucq ]lxYg׃r6-FakQorSV>|hL_}]X/M5ыvy+)׍Gyrྀ΂?x!Y35F@@vhv h]{-sp^AKy;z/d6?ŵ64g/ (gq= ZZH&`CD;a0юY.DRm3"18q* nG!g> stream xڭXI6W=h%@ dOZЎOMz-yx$GgɡoD6(`B||:^]X/I2OA[< JԤAo]zWKK09_\EQa3jaW|[^  ]rzoqT$1O){(zP0 =8 Q^dASo{ mgDd{,~WKT W Fܓrg?[RWHDSݒyxF5=~diybSe{M3Vȍ|)^#/3dlLF% "*r9~z[:`"E7NxsAf+@uy+ 0STiu˕Nj+쫒Qu4+- lN`gt)񪏡 ax'V}cJvjHuxሲÌ@&cU^ܠRHc%i &?ǞEPlN#db*VrMhe'mNV{U"iW:c5Ҝ5p(%p k璒1DQq#T1\eގҳ(Tj 'dp\xbHu.*$;Q~e1-r,-Cvx8om9{>NL?ùaI*2Œ1s  R+5 ps:]t 0lR#$`m-Duոbͅ?6 @'7Mfa_ۜq55f"{8\" "A' `ñsqDm#F,Jn&H"$4  pD b"'Y2nEJڀv=ECaqB}'BD21F֥nmojQ@`1Ld~aڵZ^>7nìE<V d@ϔJ6 w$u%lg T#iBbq1jéXnk}E'(pXqSq-&tP:;"lyֶDž۴oQ3]2N;P7:R#I*ϷPJLbxx)L yt=Wr~j2SgN1}|eZ 7FT-ҘjqZGے4uAZpƠ*9\\}b5Hu=VHWiʗ_IRg 掱ON<{sv|$W4Sfjyq'N;FַI*.G(5It~OV+ x B}?tV~E|-faɝy)Nrb˿T-og ?̱rk~%u-wxITwH?.Cb΀I #[ JS`7ߚ endstream endobj 264 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-sievefig.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 317 0 R /BBox [0 0 504 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 318 0 R/F3 319 0 R>> /ExtGState << >>/ColorSpace << /sRGB 320 0 R >>>> /Length 2902 /Filter /FlateDecode >> stream xKWrHlr+pX31`E TuYNz|:v7]Ejq˻o\y|۶-mWذ|wa[S^>,e[/o)tEs]S5]tEkZk1]tՁ18_ep&t(#uPIС 3$p(n4\%C=0`a0.3𢡊˧'/P5PւTRM}ܔ ^tAyhetatSat䣹F=y.F={*O c0a07nF[ .A 40"0 S+t~u8L h:h۶5{34.̡ P [28}u;8Q1oC~€Af0V^S :n_v4%FR銦@n(9Nɠޥ!+ %}s#VP9z%0B M_)k618qs(f`e؝c:X@q6 gmZA9pD !<߅K"ܿmD$/Ww€ܛ8 chK4TzSXC2p܅kUQ a;!V;fJql `epwaؤ94qٞg57L{c=' wARk<{X߇<_Cz>FBjP;JP{w4D U!<_#R2@ 2:((D4(4ߡ<-'AqWpet6bǻ"ߎw/ C=IM~++*t]t "R6 dJ]]uAwϑ날uAkXwKp-R銠 날&o !s날ӄzu_aUOU=Uoӫ^[EIˊTuAI mVs* sc6d踻"0)l[sЪuH3g >IPOnDuL[>y^MfHvA$ښmPWF?ykat(_*mat ;HepatTuOm2dqA ^낰C}4Mw\Tp+.P8D˓XeOt^7Cp׷^< -]pFcŬ: շx踿m Wh~`eWxVva9 1Dv( W F|Y4nFoGȹG)7)XWFWGyjťU& ' v *sAO7@]~(Z^|_XuAKQq #'A7,z< N464 o>GQ{틯iݶ̑]7|z< Vx8p%~"*5Ûn9D$r_?t}>{&˱ܥ^~U}N&_kb𗥜;m:G OQKwrZ5y *67f=Y;g@;gzj#gVx{e~~nq?E endstream endobj 322 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 325 0 obj << /Length 297 /Filter /FlateDecode >> stream xڍQMO +RRq3캫ѵkw%V!yO\5JVBh6\dUЬaQ&VkO$< "+Q:PGV{^(!T57ow.]OsEÐhĒNU{cҡ#bRz7];Tpѱ[Z>aDQ W5MD=_:1?= v~.ֆĉI@G/| m0yqh'Â#E~ȓ#ԺJte+k'߃ endstream endobj 279 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-Residualsfig.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 327 0 R /BBox [0 0 432 720] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 328 0 R/F3 329 0 R>> /ExtGState << >>/ColorSpace << /sRGB 330 0 R >>>> /Length 1078 /Filter /FlateDecode >> stream xKo6<1t H{ r0 P6(JJbv#pHPW ԝ{W3Cz>*>usAz(OqPpо<CgݓvN(xR=לjJw?w_;2m=82)HYmpw5'sHDmq3;guXHۛ-GStyBoxbypvQkxr#9Ynxh=*^Mޥ64܆J㹽=G9Z'=k΢x-7$ ^97rgwjH:Dv4r|&m; Mjh)U풃m q :[^  qAN>-zL^'{*_ p#SmyϚWqw0de]MGslQA^?8ZՃ^ȳ@bS8G>h׬hGkP\ &99jБa^с5*Hq {rJt)9\^q͵^YsΒWr7=M6\&b˪e.qGu^(S7~%\Y״\nO܍Sm"WO[1ox'l5p帐p_^*Io75QxXy<|byI n"-¿>[?PVf8>/Zy#BZ@X{! l*~3G'H? ;eu^@xZ9?-qZEozx:=|;էhA endstream endobj 332 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 335 0 obj << /Length 345 /Filter /FlateDecode >> stream xڍRMO0 WJ4m zqnCl2i?8&\Kpˮk6FzRH (uɍP94,L)> /ExtGState << >>/ColorSpace << /sRGB 341 0 R >>>> /Length 732 /Filter /FlateDecode >> stream xŘKOA )|pǞ5T- JAm?}=% "1]%d~߯ |k>mpv4`2VWwsylꃧG4zxl`!8릡8mE6`, s3f ;ǓV#*>ety3U<=>c0tS4h-PơJO3˗[Bk?S=$e 1Zp V#r6`&U|Mx"!x ^~K|Ez~IxVEzsQ~W )5#y4)X1|iL;HӀ"ǒJg#d^!QD |} U~0$Us"4@2XZdmDoZ]|eJ)C KT pSw,C`>5d؛Ϧdu5fWws(L>[=Ks,֗wr |6Bct`R)_*nv*+?[YQfHX;db7m8FSTw۞^gob~e-zJR)ퟘK/Cɬ95:jȴ=I Jݶe[jllvTƋe?*'] NW_+q:mG`KR-^ƒƒc%X**?7>j endstream endobj 343 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 346 0 obj << /Length 1687 /Filter /FlateDecode >> stream xIrFW|+"<TlR\̛DPc `%oOoHPv`f{t엋Ot2*.TgYgYŅMfjvi7UtZĹ -:Z xv񯉮湋_M5- _" %\64e6He}9_F@p!aJØ$`|W~x!D5" aI>I/}#yXJk/ s RΚ'-vYx6~DZ]X>Zq$J~O[ Q(Y fq ~ \J;;Ѝ w rw`>_͓4*IֲWk}Q4jX&bи >ApFdVV{Y>rV H CKR;'t8Jr ˓A7[ں ?5;rwDL@x3ptfV9+ J*y#%U@"gBeƆMiC <( YJޜ}m}!x |w¾>,x܈˚"W+]I+hq xWV|1r=r;1I|DQ4 ^9|XO>{6U}5y. > n$Z4]vzr=WK.z$` MYazYe{N=<+7m`h<Йl;:>&i N$ǴSgE^ā,<]H@1Q$+fv4+F{t`@ t  {Y ^'^ vNstjLV+(𥤓n7Uc6ťJ%q[,{JcH):2jvbh<鞧O4*Hߊ|:PQE2v$E Xk2Sxr:\~d ʍie:AAy X)W"X,r0v,a"1Xqi@+c˒iN"jP>[|3P::9I9eMCv37O)|5 |2J>z?+z0%M>M;8ŧs;`njצR~"He} 9-iU\cC696-[t66xXv}e)M&|@IB 319t};J[Wn"۾7lm$;ݥdiyrͷn}Or G&De#N`]=S1o˽#ͫ]"vrM69Lq&> stream xZoBҨ#-pI㤏C@%ђr9;%Mm68\cvfvv7ËfY4˻Wy9xvw?3 |VdEX%n9{*+S&I;h6L448u-Sw< oq6z7<#v{Y^ƙ`WaZᜋHzu[4g7Iy ~{u$ F~Dg w#5ݘ2| VD`YZ%@6-QZfE_*xa*csMp\]YuPǁ|-w? 꼇fq[ͤ?*~Wan8pغvgj-I!`دP y|Ɂ5lڤDrᧉ j[DԭvDwL$S'P(L0Y͜i&a=L╽%\ZOobx}+Ci_r#`trOs|LU^P^T{ExL4θ~5Q,^_4(|glAH:s/ߦ9V!~KI̕8e/Vm1uI̥O^~<@8@LJǰn'әZc> stream xڝTK0+TL}draM $wƏv0gƟ1iILEXqI&,X.R4Q|Y,S=iδА8!MI)w0GT{l*2Ԋ"խ"`Ą#J,vπ%On㘞6&[?´M`utAY~m+f9:%Z(PI4%NB-:!*hc0LBHX9;Dկah1N6 kqS' y4^Iټ%FyUȕ`> /ExtGState << >>/ColorSpace << /sRGB 377 0 R >>>> /Length 667 /Filter /FlateDecode >> stream xMo@sC';3=T*!Ro(( ;kpJ`}fdzS X˕ר*nv_?qW4@{|*n&v5caB*>VHPo50֧s1`ת: qKv Lt.;H<8S^@AW~C?l_(&IASoQ$OZ~="|)`Ku SA# Ey9\}yK}w>ĪZ j YddCgmWCUXcbzlc v^Ց tYFކPZ`>>,PM1_"gZ#x4M}*@ؓ =!&'?~a\܉sf;sݜ59IL^"XץvW=mWve>X`2Ie> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 350 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-cotabplotfig.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 380 0 R /BBox [0 0 792 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 381 0 R/F2 382 0 R/F3 383 0 R>> /ExtGState << >>/ColorSpace << /sRGB 384 0 R >>>> /Length 766 /Filter /FlateDecode >> stream xWMo0 WƊa6X.=mQ8l~HK,)(RH||!V]q ֕¤4cٞy[)y>O (.x> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 390 0 obj << /Length 2435 /Filter /FlateDecode >> stream xڥkoF--pKm!mR\hR*Jv]wK}{FbH\ݧZ$,niƶXy6_ܮ?DM\e__/џ`>_Uaxia[1Zwx# x?ǽo}!qD)* YEeI<-տ$YJ,3cgӽ%[c"81O =ggydˬ 0D'7Le,=7p B\C"*\?"?^p͢mAߋ -2 }$}MKs$)aAråq.QvHgRGglxI豼ɣ`o3Q EYXVN x =?/D/Bj0H#q(}NNo F4҈H샐8 ?xb5x]o$!(YZ$, ]9<) |CyeYשKc.Ӓ ^)[;y΋Q;,+2qH~$ ăCb%…;Q{BxBGXQٯ!:0Āpz$Oy;c ,u]aSU Aq?N$=0 /`7%:xUXKq?2zy૞ vGq=v=24D^NXɁ!rKC̅B,-5dZяP%=pSc o,-bS ijrp r&5^"h&g?Z6Omyϯb@[R' J< DT[A9.oȠ]OT%Wa:-DJ߫!ZmUQoB˦+f"Zuf !O`=O[} >3diű?c,[!rē l'km2e͹Ga@+":̨;o0o^܎RW͉਋igԯ"jTÞaRc'ɻoBYbIhUSTm&f; IUK(sH o0 JY|+= o&W =kPL!USiCq' JSTEZj|CfhuؒS➄+ e1.b:ӌY'F6e.y9bk3^+Qs]!i}<[t#31vJo L5Gz3owW\O \{d<ꏾ !ek{9u>ň8H~vP~ wsA|W7F6d e\IrF8NVnygҖ+*.M"9ܝ91j9`M '%.wVʍK^AiO׎ss.lg0DI|mnxuR\7 #Sυ;M"6UC P8epn QʫuWمQVmeT#45Ү}MmDYi?ihplymPTxN9@30֫o߉Ѧ H=jWOTyQ!qKu#ߤʤI5v|)B6xQw-񌢓1ARO9 }YV ^f4[]psutp:6k]7Ɓ 0D }>̾;K`*{ݓdN miQl7ce䁵pl%{+&e~Z%datw\þRY`#)B;"|oz$.a_$y#&M^04B&z9ӸoEQLy6,΀.\}dsyW,A+ y`HVT*XijH,6 ,޺U7eA. tOu'ֽ IX}k!щA:X F~1,sȝzX{D;W 8jZԮsW0M"XgqwHy9)ry,/\x_-'5 H PJ~p3.+{G"C"$$hylK4b"pm\[L(͋< Qu|N^MB2}kXS>g4$|ijx{7,6Y>LM\YT6Nר;k„Ls~xK4S*pVRi|\ BK9$"{EeR 6ϭ_^+ endstream endobj 354 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-Conditioningfig.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 392 0 R /BBox [0 0 864 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 393 0 R/F2 394 0 R/F3 395 0 R>> /ExtGState << >>/ColorSpace << /sRGB 396 0 R >>>> /Length 644 /Filter /FlateDecode >> stream xVM0W1: *RKnh~Rw'-If`kU|`~腀{|jÓ9E8gx. `Yx /]Jŕ (E5lW0΄Р}m|5CLXPR<уH#\@,D@H_"|(mP [JsZ:ou1'mW͔OoqڂEIPmGP9ZmU6#i)v+R$#>J/Q|2r` sHd`7yoS mFG2 ]v~b !mIIRGhXtM$M֙SHܯTJjpe5xn,5 endstream endobj 398 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 403 0 obj << /Length 1987 /Filter /FlateDecode >> stream xڝXYo6~У $ZQf}-vBr%;I5ߜTEin͕#&uZ6LTeRC&_04/Fv9lk,l VVFV8vMN}`(BMQ&gۥ2k#؍2>jF CƇ ^cKp,͞h&XR&_Az]{VDiUuh3 &XERy~9y] | A$ łȏh<~>h߀fndwz9iF,uCJr{X?#5m=aR/-zZWy:DMWS`╈7fdŐmD\8q0*3xX<8 _mV6KIJ֞[1@g & &ChzAG,c g1]$^z'[Wl_IճA36/3*Y½( ?_C%G#7؝:K2jB y85 LK?k LBAZNB0ribLeQU+Yx+  GDfS/ȚTp1U;n&z O\!Z"0my{e=qgOOCQKoe[:v\ǟ9tv䡛 QY \\P*[-A8^ag F) =4arΥooW F endstream endobj 387 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-pairsfig.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 406 0 R /BBox [0 0 576 576] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 407 0 R/F2 408 0 R/F3 409 0 R>> /ExtGState << >>/ColorSpace << /sRGB 410 0 R >>>> /Length 1132 /Filter /FlateDecode >> stream xݚKo8<ڇr8|) Ʒ>@]t?ΐ#vރ۲ygT7 գ?~}{>: I5w?ӫ[>Vv3ݽWZwnxPu!xeU DG}PWxlL8€D!!)& ˣ 7ʁ-hVoF鿑 uJ2̿/ZP,kD:'M^Y[0 ex/H>Ftc>w(ĭkIH!&FimyFB]oKZ'vJ #(6z8,7Q1vfNKԃڬ@O/+"L/2\6* {J`O*㤞Neԇ!|b\-} _?ܧNSo.pl']{Icopo|#5e"jLhخ|gY!II%ߗSQ5H5oNv-&:@gcFX$Se(:['3K tP* endstream endobj 412 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 419 0 obj << /Length 1571 /Filter /FlateDecode >> stream xXo6_!I"FE}~>:3,;A(>HQC ";K8x>{gE cQƥ   ׹("|:a5O\g9Rf|'Etfx I+&o |o@}G/y.;;WPRdQU%b6(TҢ2X|XXl _=l!L()zo;Ck|˴%|&V;h>It^̥yϭv7]#Qp҈͚fj2n,g8ҁKCƇTB%ΞwsGhz:(Xogt,̜K(Ha+{n&ϫf*HA&jw\A*WdX{xk!v@{E qzgI,0x7=#X)*3pbY h!CH" v-oxG~jaBf mnQaOSB%/Wk<tj]1Tmx]S=Z5XQl1x@fei[,c|>:1QxC\|xӿN=0w|GK/h|cݧكmo e)/Q^= f#s^d2Jۈ[ @0.W KJo+?6!َ Xl`]U&5'tMm4=9x-e͔W'63^= 3qU Ny "v(KD4j&ob 17ᡔ+]iNչ\HXn#MgC19; i/ž^3{srǘsb vHs6K> /ExtGState << >>/ColorSpace << /sRGB 426 0 R >>>> /Length 594 /Filter /FlateDecode >> stream xn0 ~ 8Qdk`VMC=(J4-64AǏ(J& ~V_OP>noXn+^)z˰;Pp_̤*sU X{$ Z4BaAsv|GTI<[gq&{}q/Ub%kTЄ|֌dρPՙό5Ɇ8B@Yd|Q٢xw;6ijӛ2o&dW~Rov똂$FBQqH&|a{.M;V+I0"E >HA;.۞Ō~kq"b&׋)ob\@"hMOisӝ%,'7'zSXªxHQū >]yLOӞ'vNn;oY׋?ɬfЌyM׭z@M>Sgc{|.(FO')Mu (_XƩܿֆQ35uCtF?51An벒\! endstream endobj 428 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 432 0 obj << /Length 1864 /Filter /FlateDecode >> stream xڭX[6~_!F+I"Hvmvybks 9>]-k8{qqqob?'21/332UPц9|wbrde\Eo7H۞e1ȳ-<zs|`n'w B>$`Ѣ-bVPQ.xo ޓ7rbEp:Bh^{dB?D`9Eipp;hCKy},m)`{:ǎ}nߑŰa;cыV?0`Qz7s + 8cB}@a79w&S)vfL3>κJivNA֦qoYQ"z"QD3Zq K">x߱iLהЎgAuA)Hڞm#'I 8Nb$ X4*Kk隆3"!rG 7=!8Md6c6B/CPs>MI506){hŸAB?O+iUR#j?IK`x"y1K؞{B8޳G^x,c<[HY~G%$LWil*(h9[g`|C ^8etI'~rlUs$u8dVީP$w! ht&vNZU8TtHcK"Eލ&0t5mүꨕZOKP-Xh"),8Cg$qr4unÉq1R8>^6c;IV 3h}0I:cS|֖&*06_dO|S"#{= uSp׌m|9qEFq6Tl.V)*CjßGO>-K{Cz :=GظrFOrI4s > W̧s[)Z=R.3Sg\8v57g2!z78I10$n顈ƆT{.(WL=Q t 5RʅeT4BPKC%&r]`3ѓMNFksJ>ޖ_eySAG2v (f xJs̵c$e.v'=pqW=.y@L6V>Vߧ/!t8/s_ 5 endstream endobj 416 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-changeplotfig.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 442 0 R /BBox [0 0 504 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 443 0 R/F3 444 0 R>> /ExtGState << >>/ColorSpace << /sRGB 445 0 R >>>> /Length 678 /Filter /FlateDecode >> stream xMo0 <kE X[Cz$ GGl@< C!Zfn'۫%\ R0.>ɮV[2=FKA0jYæ ouuqGKUWLqnXy\SUoa?u> stream xZoF_!6][$#.[Yt%H ؔ䨴i ]6{p #D'M>jQGXA}9&F ltxAd&0Ɓ^$K:R3B Ldg@T8 9:LrrĐ5xaaga@yHu[1]a3䐆@DŽgaݡ돎0D@'WPSrO.P52^kLܥ"MǓ*WGZ1 >iW8r   Ft``&6WB u" E膀VCpFHltJA E:, j DvG$g9PV  Z΂B%Ȭш^< ưJD2\8Arxkbñ1 %R`EҀ *FK6Z/Herp2 #=Hl`sL7̑R{Jl**%(#>sPd{:[ƣ5;< DL8rtpYfrT<{Vq/C_ CQ&g%<_f;fފgτ:K{FSz[5Yzupqa5㏋fjřP? ؊uUEyQ{^WfT.TӺ||gXK~/I}~^2l3%VjjVx \bQYrj+5z6e9Y4saQ]FWC,륒:W &p٬nu5(YjUs̫դdy˫rRxf?=u6iő#i2䍽rܯnj}=xU%ؼ0᳑B9t#'a}Q{>-d;|~{etwpqw-g;_+I p}a<*~xW^\?AZIh7r m]|- ־@q|Fn(>_ M3A''%'>=LҤ} 7dew N|AEp*gY Iibi<`o |7|$P9QY :%:"exL$F63Y|2pA-9$_׈~Nõy&I7{Ԡ},aN0t{'+ݔn7<7k|3y/#7O7u>{Io4=j i0Ml063 \ç{ݱނM-pğQpdt8?KtƁ?yH>!YEVoQ!ƠbL\!)Kßdn,v'vA PY?.ܽD.a۷q%{}0 ͭD)H endstream endobj 448 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 457 0 obj << /Length 2985 /Filter /FlateDecode >> stream xڝZ[s۸~K噈!@i:l7ݶMmNCK$=Wisp$ZEIśo22I\%n#8ͣ"+*͢et=ӥ՗}>y°9tǤjy p?O=eOW?|k܁$5Hsȁ^O4 |PCgȃ%8jҹCR8ܴ&}O{CL`>Y\o9p)\\fb&KȀ]n)#"!&_4}X(427ENt_-ىlu2YE$vޒexx+*vSA,w%؞ ^@yKβCCk*%yMD-[)a$~nQfPpi/70H̉)[\i7[~\tzx:H~jHI>JҊP" ./j짽,6KR:^<ִYiKRK2ɕ YK/`~KX?ű?dBq"ɜ{-~,oAX1._ޚ)k3ʤ} u"srzę'NrNZkFfhLl4/z܇, ̊f Nϱ>1iU:Op]Uy´f,LD7-,$F* I=;PWGԛ֎W-zoۑZ[shHj_|ۯNVvJzl.NdK("n!9T8˭g9w>8ԣ(=kZ]w#ˮiwL"6y:<؏"^NS@*y߳a42C{+pg(.ѓ⧂O N@`b3bzK'[sҖf5*r¾mK|ā| Dcny%׮Z |inʹ:wI+z2J;TH>!̃s渦Ҿ]˲x*=CmMkfZKN];Q'K7Co )F}c_8\$rwleǂU4ۭ (Dy܁5|3BQõT}n Н;MikفZM9h"3QRAg!OUd**=jKx"!Ri+G9x1>O-$~=O?)L4b;qC?jxQG[uthoe۬zn0h}שuEz'YPdO=#79wY\\GUh!/Tbd+=Nb2\H\a Zߴ^f. |\8{b:Ѭ*>m*.wj G1Z&,XLQLM7_^xdx\?\]; endstream endobj 471 0 obj << /Length 2149 /Filter /FlateDecode >> stream xڭY[۸~_a23(QR,RtK7Ege+KIf}ύ"'mQS9߹WU뻛7:[XqWwUWydՏQy7-U:cL7tٞOO$]iUGN`ʸEkh+MuYت$V7*K)!}rdͻ.Voo{Gq7t0HD0`Ie}p.6MUq@I#X\`2s R%44Aip!0Z/9%":)%(T `RYL_jQA"*[uGNn$aRڷbC꿃I VrU5G;宛Pc =ZA>X|E:\$s!B%j9k|&:˯כPpo{JG8彟yQF=;Wjޣޏ杷Z \ӌv{>,UL6s h{$O|2_ZH\;`sMm*iv/yF)^T@j[YK,P#C#R b זJ%dY,t 'J b'Fm~82.Xx P T\:jôF P(Rޔ+ _%c X&a0U FuV7a ど.XKka9;Ap %}{[}{|vNj8$7[\{fx$w(b]5fFu]=c *j,b'\M1(Et&p-'DS˱%\XFES#ƙW-< Oq:Badu?T3't1(6n:vԅR乐bCx'TnN 0w|y7"䅵HLX8}CybJ1ǡo)(TyG:9V KH54blb7xT L=LuFsHxKEM HO!)[9N4# 1 c3pRỤaGs,mB]LƊ/[Hڌ^i LM.M~YFb>rtד uHM7/@P \-@H-uFN}ԋRy6)YH$u/.1J Bq%2Fb'hv4f.G[ j¢{BBf:RaNU?0CKun Z/mhim/P1i2j斛,?]|6/totD& K YX*$][d$J ^S!iy)B;n4&s^W=Ky2O/9Ax0*G-|2'.lvI/B5NS&?}\,(#eq_܃.ݴYК.ꬖNKGz endstream endobj 453 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-ucbfig.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 474 0 R /BBox [0 0 504 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 475 0 R/F3 476 0 R>> /ExtGState << >>/ColorSpace << /sRGB 477 0 R >>>> /Length 283 /Filter /FlateDecode >> stream xj@ @wFgr컱&t(b@?ġ4$#ޓd1o6lDR mι!+`΁e@!GkD69"B, O?th s$JY0mqcQLO3H/%|bx~ѥfQh 6E JAQ%OE+ h ȹXDcYO=7!޳ߞ|_*v6H} *]#F5]@7(c$/v endstream endobj 479 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 484 0 obj << /Length 1533 /Filter /FlateDecode >> stream xڝXF~'">,&mC! BdY~$H%׿Zi5i9dcvv7 ց ^8}VqJWQ&Yy\4/;hlY"km4)¦S5E7"g?p6Q4ϸ k?zBVqd(s@hh@:+c]Aؘ47nԤ%&Mu2p^wssSyZ K $smr5̢$/C]~7rov"xXL…վ!4dSgDY m I \xMFw(qGGܿmkQCYX8MJd.fs`).$;.,q 'IDVVA$M0R8x%ecߊ5Of8xAd` ,8 :r7s"_QeD, wB@gq ={:at~Ej'SgV;P6Â(+ wޓ9!J vdMuI,Qu'00Sūv~*=ӕB4Nu62€BH:R8Ga48c>ꪽυ `qZ*6l%d Bis!un`>9#o$<6P4N4X$6Up]"BF6jO:I6y}{=(Na\' Tʯ A0R_O!mr1ђs宄 |4۽[G$e:q[Ot-{[3hgx+) ;^\;;O +olEݩjH>^R|>q9$(aj]͖6L`N̙2qF)SĹ5|wj:H4;4#U;k u!R+iڤ(|Tn 8 `6*(6Ljk[IBP"p2/'(㨆K%+t3<|m` F̴IMQ$2;gN-XjZxQ YB$)c@~U4^E:\{ޙ*m>EGՒ*cP'z>ˆ f%C/_A\ ]toB1F%ӡ.\~XB UQ\ZK7]^[D {c g]fb,h4ɞp(oy쓐4M3\>uvuZLweY BYDFd9Ytدj`PaOAqCĥ:uzb<Ţ=F8"QJ㘡-/-ĭȹv2DPu^F4zKfYbe%ى6BeQ?6쿧?VqEߩ endstream endobj 464 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-recyclingfig.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 490 0 R /BBox [0 0 504 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 491 0 R/F2 492 0 R/F3 493 0 R>> /ExtGState << >>/ColorSpace << /sRGB 494 0 R >>>> /Length 965 /Filter /FlateDecode >> stream xYɎ1W0ry;D H " (}>U3 iЭ؝_=;;z5tZTFc~xɽ_2u]"(}3hԦt =?/^J&ϫ83%-@w4/@C*72QgOta _ p2BE4ֿ-T_E+yB#z =",8bTPFg ;mA zO<ʶ%!AskH yG`f=gVjy-a]YF](?vs0ok01ױ)ԼSXlRhH{h¹F#,rH֫b~=aK^˯5aXދ{ k}v9G9->eiĀؠm w')W3sf PPKFK~,/s'7 +,S^۬jz` ^6˩._ !ɫZ8?` endstream endobj 496 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 501 0 obj << /Length 1584 /Filter /FlateDecode >> stream xX6 'ulQlVWl0l apαoER~v= _ )J֓ZOILy*/1Bmvホl~)3 V~0a_{?kzum~kM ÿ+Z]]@)-xAhDtk.7H]Yωw4zBȻgq~S'`|R[+Tg W2/J(0H q'-ωw4L/2J$$quޞ1|"y|p-yg(xn%Rѹk7{ƨTPxFO,:,tehDZ" JD:l?kk0Fn ijٟ? 1=-D2T}0MD ;L.xZhѹ6 Uk4(ykKzd*%~mѤG"m{v=N7*bZJTthN6.t\?fW?n)0Avɍ#ǜl!L# B]":ќbޱyEXA,åt)cLba\5x?w\F, KNcuqR ԜG:Kb)JΡl9 M,_03֎#zL{ݒw;ґ c3c{Z{//x .ϮˤjQiS(wƁ;[&6qV{Ob0OH6HbEtHc#{&W AoSEО:O.-B ܤH J"s4)OH-ih?lRE'C֮WHb\69Μw}D8*p=F$: 'Uz~hVr?djg /1 r"Ww%rLLT &C m,v 1dpTv8BE8} }HV#ET~F+.1'sn8o.;#e%uyV6'Q-,eG~3P%M~/rCQ)lP4HՎ1֞ApPey/e[n*AGZԾTcdoj(|D"'k׳aF> /ExtGState << >>/ColorSpace << /sRGB 506 0 R >>>> /Length 316 /Filter /FlateDecode >> stream xj1yITAPݛx()tBU7q]YT a&L&d3j|qPd5dK[c/xJ)trwsoZCYZP:Ƚd49X(.Zc0%>e}5EkrR{h`ttQPTҜ\[])WXkbJzCQl0mvCx.BC52')Hǡ-+'"MY:P ޥ??'2s>Cmt! lob^L endstream endobj 508 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 512 0 obj << /Length 3245 /Filter /FlateDecode >> stream xko{~O\>WIG>\]hp%V#:RR(P9;;;Q2%~}E53I\']$m1+2m>^Dek km'hq4]{Yk ?@]d׿C" 45lefy\x v0_dΡ]14>0yRE88Ez/;. 6G&^xm:PF!q;de0!&CmyV3Mn8<;UlZP_'&{/^=1q~ަEnIsjw,ټ% ! 68Im![g í=H8d9C"g]\=9(c\%ՏRWEh_&/.PSuU#΀8iX}"ߏy'6BYt+{7gϴVfi;JX*w>H.O2q?/9o_@mDAA Y-?90]FGz  ַld\ ۰#~AL&LXUU㐫rveO`B\eX C}Dgy\ZyTTGvKNNegUSNŷc[:q{.qS,tySS>P 8)>9TG^Jm鍗3Pe6_L__~`̯P& @AŔ+ud%uvAޔ]n(`9ZihBth/;-Ţ*k܂5^!h`UqE5dQ]GfyeQivv I]g jH^46znVJO2t"),d-)Lb[e_2r-c'_Oc,Q\_gO.YRsΗտ"2!)E $cC9:I0\gN5evli8#8L!].c@\Zuù㉧3yoƕ GgeMe'z=t3BB'WUm-lQ08BڻGF/B24fgq>뱚^>! 6&7*wQKnGjBS$m`|zn_,b$"FbQ>F7DRp?XƭD2 8b._ K|no5D~)Wd.NXGjF J1X!SW i '4%e\SL 4>BYuDӬv`&W]sT<>R 0r%pj-eDl.=ף1aURd"SANӑ*bu~u\'+ok8,B`Q θ!%HRz/SEkʥh$sIl$=O-8dtIXj'!†u,JF-/8C4aIknm{nppt ko 2ߊ7U@Qſx?MeFFs_{:c^-L(}f5\^Np<#x JF x :ȆѢޙ# HR\RutqpoC\Z"-HqRRP*HxFmzP.uZAzaBMtqZf';xÐS^jPԧKRqC M$2mVCn;aYVv*āVv+R; X]ALK͐+hЖ\KVKŜdH.vF>3W6Yqe擃\t9\(0N71.f rjiMCZsfiW818n ,OVURɧ9Ly>.^O? `P`X>"i=Uv6?/Ҟx#)ϖr_ɦ^g `!ΫQC{_v endstream endobj 529 0 obj << /Length 3447 /Filter /FlateDecode >> stream xZ[o~R 2oR#Z}h [.E].:3\qe9R֒ۙsΙɮVW_ޙd˜zjU]֩$_\ LBޯM]ϬxNؚ'ﮛ"9;?2Ꜥ6eTÉ-\'|>7O=>($g"-ғf\hӊv?K&xs=+WR0Gz]'ꎁ(kcISiY8fşh|u@p&Yz{slO1O{3D%. Y^x0uBՑCo{_pY^%|@'3=O3+J#!F ҝaad$az=ˊ6k'Hd\9ecuȿFvݖnpf5 b@V|8lq 5BMv["$ţRM:7&k?V(N(LZ-4v 0\ ;ץUI:КtJnH gyYUY1GڗSAc CsזuԱ=A 8K *jDѠv&!;9xhƀ33854Od3yɂKc ڲѩ[ŏ(s G6C@7űNRMcR,/8XdhwdYD )mʴ.J]zqjGQ+M=X掜Uujƺ'BȞ{㤑cU~@y֥~2m#3Vf zl;9M6E[!n.oG#_{̈́Vpת PF(؃'TS0ϗXV sYzTr T3`a3fSݩw~f| *S?g+?V q&G K&\q~Spa8̈="K< 剓G˺ z@}օRN,w}BS\0.uc$.A0ŕeWYjZFߐHfum Tam3~Oex$hV8y C̫*zbR:bfH0tYyNU Qr"cwy&1gC%=jթ֡ð:_-t1ZYaQ2@}NڷneeN m{Fi~L u[W꜍٢`3k<3eARC!6ϑ_pGI}tlgE96y<줊UKĻY?XX*9HLR}:7!ɀgԭAVs4`37e TD$j?s+dG5jҫS¨Ӻ2ϕZab%\4_B (@qol! *ߚr)6ZE7dٛTYN!"jo}xbd?5&5WڬJ9;!f'm?=O2gU35% 'N/X{i w @*viIᅪuc ;MrP/]+@ {TQrx8"ԷlwvIj$p)K wVV97N2^qŦav78rG_oh.C{/QZ\-w;hM =%UKvX->إ< %(㳐sݶz\PpI\N~GQ`΀ŵ^ocP'8fP`s/EvN* =Swphp?)m :*^t BMT巅q=X-T +?#ga<,~#虺S|e G"-JH?HJO@NzDiJ՝|x6m2; (ر|v&TZ+\[QhWgq:@DW\kwk<12qcf3,pݟSQ>=] ] 9QDuaN YA]SĆUpYˋh _!d7Ӹ=75/<-y`s @MU X?۴|:!&YI$lT")U,\c?+СrpbZ #[6:kWې/< 9~Ѣj͠*TtI+'dul"h"OVI\5eGo fӔ=y)UV1% Mx ۤVtbTYSQtX B5q[mr 2L<{σ?y9j#E'8;`0*̵F+<>SȍNK6h nSY* Dzd'9nّ-GX7|JK)) d@+/R a eiUL!}nC3_[zH^&΃I cyW' ߗ Ij%#)1Zis?#7J'M-Mg-@|qӎ7Qt4 yA*I{nS!vf zBٞgQb/љ) (+t{/֗.h <&ȐhgnܯkfQ}4m endstream endobj 534 0 obj << /Length 494 /Filter /FlateDecode >> stream xڝSn0+x搢H, =t9bԖ ;CҖ8=pVL7ec X}˔TBW+6^o:?(ij 5b+ǻ-ȪB)_;7t=]wGn6s/)K1Lz{SgdP —> 픋'bp%m]'MJh4,ڋBQX"(X#*bYЙ;#Wp^mcy? ozO}FśoLu u4pRcsab&Dw!A٤ܬX챱%MLcO0 *ږDp%Fz ͵",| J(aFhaJ?Qy&|/2NLeǸxB5D\}B;=H%@O͔~wtFS||\l[i\]J endstream endobj 523 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-haireyefig1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 536 0 R /BBox [0 0 576 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 537 0 R/F3 538 0 R>> /ExtGState << >>/ColorSpace << /sRGB 539 0 R >>>> /Length 846 /Filter /FlateDecode >> stream xWKo0 W‰dIvIѵ(aks+zZh[~(N qY<˳>N3B{z;,y4 Fw+p?Xwr!s|70$ vӂ=m]]y@N#J:Z@7,f7.#1Z|m &+GWYТ5ዸ{ Fz5yxOY ]ooui'Z=kVr{ک qYTt%HT~{SX,+Ő_Ku7[G7RY)~DORcuҒp*'L*aͨQ `Kd HF[T1&G9e, Jř:H3ט>YXl4ְo0I$Pi8DQz[>p|9~\Ͼ':2{l2IaCgTK9J(8Tj^C%QYl=>LǕ-7h$.cd鏞w!O,Ƣ=Bߟ> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 524 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-haireyefig2.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 542 0 R /BBox [0 0 576 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 543 0 R/F3 544 0 R>> /ExtGState << >>/ColorSpace << /sRGB 545 0 R >>>> /Length 866 /Filter /FlateDecode >> stream xWKOA 19{DAHZ q`D&%da7?gX ŏӣ!\ QP-y]"ZN@ Uk0*p-dYEy{F60ɣY`DwCܧv"TM']zSƵtR*o#jPF uph||\'E׶`PG}V G-ZŦ_g]i7+b7p0-Gt3xE IhbN@c /[amƿ_GB2~;38d|X#߁3| yse:/)Sc) :)/R"\_Hkb"Z֓\eb1y y{^90:\jU>bZnǓ-Nb+{~ 7pyh|Zm> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 525 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-haireyefig3.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 548 0 R /BBox [0 0 576 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 549 0 R/F3 550 0 R>> /ExtGState << >>/ColorSpace << /sRGB 551 0 R >>>> /Length 870 /Filter /FlateDecode >> stream xWMO@W19ϪQRrC"04@wk'N0w޾7c@ŏ\ %oMaTV3y@f%\ "[I^QC /SP3Piӵpj"^A1FS_4\]$픉i1w*>}1 Шz"Y/ڨ- JCcYuănŌ7VdW+n7^ی Wxre|X-߂#>Vp{^绲|}/m"[=XXE>KI5C8ԡ]" _ e+I6! ߎ^[AR<}W؎uFt7;̝[Vi>&kje[d7تJi7)0he )vYSQfBRhvoS~vƦ'9)H+\kd5ZKOCz>_b,T ' {Q+r t sɉ?r-x'|tљٛ5llbu"/Urwȗ[՞^k-XiUZtGzA KbB8 hzw^4In,F템sM㲅=y64ٛ\"#R XTW7 kq\eaQJ,+aMiaY78z\+OlͿ[ endstream endobj 553 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 559 0 obj << /Length 3796 /Filter /FlateDecode >> stream xkš_CܧhNaErEQ$E'TKZE+پ oIi D&xh:g4Q^$u+'y/>&TGn;mB\4 In)+Ms[̺~qB̨ٔwyR9깋hLGe$]lAmsK sď*vd,N Dܳ[fmoGKNnx;Wʚkea'm+ m@wDnIz/$b!H z !S2pt-~!*VPԉ}jDw6"móv KSB]%YM{\4MEG hz&&f~31! 9 )F''ˆHMj:φ[%k&غ<ꗝa[@lv@ww_,?TqHMd l2)mI2N 1ȓI\AgV^D/VeGڨn/(t`(ef4+pXĈ8vR'58 ">*z٥BHpEa7H^}z#[26(SI/ m&3хBc" ,E.8 ai~Hc60ҰGqsnc%x@y0!7Z-Zp̕=FBKZP<>^*^.Ek@nJЪBy] vNEO;N(XF^dbVR.)0DE֪Xv:lNV F2OܽwR#^|(;znz׉-]s  XgM_ |N"Px;| KR-K3e`t%XW(450Q5.ian+g BN%ʬ̦-hehTB6IxK]1BiW,'~,B9%'N|0ydN_G:9#4}\ s7:mӑP!Wr'>e#3aĚX( Do": ; ϧ,8?n[ ~_A+e mK4X z!,plFlmzj^m;sYwO/X?SfbTˠuPEѱd*B[wX6nbͨ˔ah f$+d2)Qh:0?)!#[5.4]\nVvdRཹ5g=]ttZÜ2 W`xn-ǂ3{K+?N2p> r#x-!%\(Cc0x1QQA>)h;\ qVxp nzń*#HEؾ\_k̇MN B)zE*w:/Uz gIB˃B -du.<:ג.Ĕ ?|y8!(ۓ, fbCsMқm{o7Z-+Ql`ZtMdQHQ`}MdwrT$U5`8MVN~y' |HQ`[u69*'#Ҹ06@JPuB5FL3QNdj'<*ktvHXjd79 7N"k]q >/$N6l;A'Wߓ$`y-m.sg< BQ4S^̓xk ihp5U>Q%Dϖ̞?.qU; ͨ/hDpo)FR$hI3+TL&>6 Oe_PEJ P,tء5vLU7|VӤcB#ܧ.Ln5$^F;~c3?qhSt5 ]@2qĞ6}m7= {ȓ.&>݁`{[@oF(.ˤޜ,n!K)9"Go i!?,ڂWV;$ /)M5_bh_ !~!ֵn>.ծŊn l7gL4tXG5m7-IA (Ñc}PE]!,K *VІ?IH!K(wQL+CaMqR[OI/g$+jHJNvqdKZyD;m۰ j3TG)P'e G`K\#5C)f4S򛣔*ru=]$ X4oRd y|8R7zeIHLdom8k-%ݭ*/X ۥP ejVnpLb 7lk [9D]c*1,܅z+o Cൗ/;} Fed>\rV'}L]}X6%UNĦ$k3ntI5⣸c$6UXhp7'izcܧB+ ?VѕS||i$KR엿Uh(Zxwn5_Lt/[/ҟG$7gy>e{hĔWRdw܌DÛ8L(_}92krJI%_bWTRA^w|LuV]ׯb\:z 0u?瘨Puuil!T㲍 ꊆ{.Och0B@X_: ?8f.HEC/7)6Em훩 x^׬ -7ye;0(oe;-PA/WZl_jO{ԫU ET) g_y=kҀGZQf -d]8Yl0q5r{4*_鱕;wr .PFk>&5 Jj[[݄O&?^`#sh_[FfPdzT O| 4Fi媚@-> stream xZnF}Wc˽_ @b7M^$@yF&] R)ےKۦ2{vvR&11)jʹ6̨ȴLif$=#Ke&Rzf}s}èF `RzLjp4&Ìʣuad=Pij w\k ^0I\ jqE')I&"ʑU+0> 0i ] JV{cG cpPfT1Haӝ JL;\n^124huRttX-T ͬ00jג"k t=D< (#."^ANN XUbˡYiaN%[`r{fa#^J`y `h z Xؐ Op0|-,GO6;!(U0IdAE`WSh ƉZ=eo>_$=v-=Q4&a4ڲȿZOƣ쇪euֹ`Fe̵яVVOiy<=MM4e켬fS]׬n$pWv2;k)ˋYl$}r2Ny^4u4 2El\bi9xUt5;+ҸL?fY'곺J"yӪiG@X1{l!G_\t ƛ+Dj4pKxbx(c:2w!V|kVl)axԆ(ӂL` uwSZIuJ*@Px>7I:A&j(ZYd_zE(o?T߆0Ӧ]s|S)~v~L߶6~wVv W*}OS~m,?5eƓe{wr]d"}BR#u->pUwދ\ ,Y?eph-ZQ~Kp`hݟ *!ӷ6AB@5H,X fyU*Ifsp7݂7w!s}*w P{90~+>Ww}eV}whT9νVĐpO +w:$g,k)Fݵϫ};n& Jy endstream endobj 576 0 obj << /Length 2509 /Filter /FlateDecode >> stream xڵY[~_!J!xkiƋ>DiJ↔p(Qu`p.gΜ|0&O.^^fDafrȆq6<,tr|<~,Ь` ^qLԟj|lt@iw_ӟҤ>),5[✋Ht@#Ia&-äL&ůa& xnkOf@o$94, <_VtNgiW7I'/bNetQG5ȳdn4/_|$QZb0!c[VTg@cZ121Ng6 Vn$= "ОrTZxhO5 B#g9f6 %6Sf/0BkJ\M(<)6v MW!os~%M\@P%g/D`ݲi gFx7$z# U+w91wjPOB,L 5VLP4wT' 85/n^骍%?+㴈Q +|# |h (;ñ[>n̗LfԪO"f_d `?̨W>c%V3=? _tv2o#. tcHakU;\{ s5{[$6%0z'o .P1stͶ a:iWm]N_5IƔ$lF fޏa>ފd-\91#r eЃ3_VHkmµ206a 3P6 HZ4 ;@ -_[]m ۻMrK=.vԿP7AWjV^# a6^tsۧ~yǠ {!NJbc>Əij)l06,JyE.<?)L9 @8# Ydw0>lb@OwXТTk`!"LvLY 5";m{Yo£6'M[QtQ{5/=Oa^) +1>M2w٪;ynɅ`]GȶǓ4-BWf}tcf=QZ-|q ɂI cK¢߹z,EP0,%[j/hH}aF\&Jzy[_VmhA™ D@*_.Rk~dJ#9 @9I_GǤyCyHLzQj(}\x<+nTBag搑=dv qp_,E.]$g ]yoF{\:`WYU{4(*$*[P*~{bXԥL ;RcUep{Nf+r+r=sڎAe8typ:_w N>_+}A&iٸwMHO m9^?+WJY{ (yxU/;Mj%_T*kO"FG^H1 /h}6ZTqtS>YlʯۭkFTnt5G2^zзiuqpl99v|n;@Z81FKEUB0`71IX$af7U ep4Ȩ_f GriA JT`{r39SE(pH TM1\.* ~Kr>zZx'iw7W&9P endstream endobj 555 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-interpolatefig.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 578 0 R /BBox [0 0 936 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 579 0 R/F3 580 0 R>> /ExtGState << >>/ColorSpace << /sRGB 581 0 R >>>> /Length 3217 /Filter /FlateDecode >> stream x[KoW^xh7 ZvA-q;yp8Ù齺#{0͡^z0﯇WjL&j4ۏWNѨ!QAQњnx@ M^bؑA,Aa-A֏K t9E8(rJaX.AIVmAl8-N!oj91n) 8{5ci@!020%Z/L/1Ok  2@+ͷ%\wWzx >\(j$!&%looQqNf2ܼ4!Uᶳ?8<6xrp z\<*x7:ۧC`y >ªyx?j7FGxcPCƙ13A3>yO7Td.yB_nemsn/{!{p{ѣزڣ=p=Vje6Isn/{{p{liictVxnzU$=jӋ^><~i2  $wotQLտ_/n? 9FrUϠsܽa%qC&c jQ Hz8M!7L;ՃIzbsQ;쥠2>^QmVpv4h_f gj@s7?TBX˧9 h )o hcD/g nbܨ{)5l??!;!:i; 2spSwK"žLM;+ӿSb)n0H-s^BTaW!@-?XΈ:l( 9QwFCϏwŘE[ ? h~AݾuuDʀ,)|d~C#|w,@ep_^˲^:/J, EXHGt`Ā10r鐺D3j%Z <;D+ޖ&&="%=PC#&=bU3Gp2Q+1EjF=n 9`ԥJ-zԄqn)-P >oOYCa)o0ʐPԥ[ dk" )5Ig[ %{`WsːH&7'FC %Ąb|!`[lܽJ+`5X0H4Vڽ$Vް*G]+o6Jֽbhnы:F37Psq4v\bHHO}lK.0A:EK,5'gg*F#7[yb' ?VsKcu1TMF1t;Zaife{\[ⳲaDV޼զEV[1QI.oh KΑG(UAВv!g 1u+AH7_ !gSqeGCmƐ=+;^m1\% dʎFEU;hԲ.:ٸ~Tĕ=JP0(DFҹ!{Wv|oOE*(.qeG>+; A\QH D]0T䰼ѓHUZtu.R|t+א~0cf .1 QHeswZţ~`6G!6c(Kx!'9Udqh{!.8mslU`ۻxo+o0QہG ߖtd1NJҹrhA(풕]S *;m>BpɶwF97`췧Y[OJjA%ռsXo{P r[چr@oK_V ے.0Uψ iVho;!\w`l0?0+@$s$^Ir9-Ź.&BR\`H:Y6-m:cemIjh!.Xm'ks$?i:ט,rK Wl-JTȡh28۽3 RI *t}*d;8D%WW%/VYWUkW LB"xJ_԰sj!߽Z00Qڹ}{WwX } B/މ `e+FT/J ;b-hYpbUٹCT+XJ }k&fRͱ^ qp/ZNTgs Jܱ9 }V>-QVh|Ox 4~{Rr} "ss3:,OY3| 争gn"о $T7? JGAk:9GHmn/z>ڣ=l;^LK{#3-EMڙ'Ay3 uٓ2!O~X_ɏT;wrA>Op旳O`gg7u1d%1p xQ9TDG?y[e@<)w4M!Bp雎d G2Lɯ~F}W?J~~TsCN~7:&|w?ŸxҘ>˟繟6_Oa<$ > 'f ~? l}㟫$ endstream endobj 583 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 587 0 obj << /Length 712 /Filter /FlateDecode >> stream xuT]o0}ﯰxJg8A!}cn6뵴L led-Ӗm#"t%J掗'<2iLk|c8~F?U%4P"+JD0YZ* VWWJaS2#aQY_}_e/[8̋Uye iaNC݉Difm !JS\:w0䩃2n%7jvGLsYf̓~gqB;!M:+u~ ]`BA"9YqR%%wNl1(~KlwX!BiÁ"u؆"+9^CR#5C<1!T "$l,j›I8kqOW>6 Wr6tk/=H~e endstream endobj 567 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-bundesligafig.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 589 0 R /BBox [0 0 864 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 590 0 R/F2 591 0 R/F3 592 0 R>> /ExtGState << >>/ColorSpace << /sRGB 593 0 R >>>> /Length 2367 /Filter /FlateDecode >> stream x\Kq4ߏ9x > 1Ŵ7cߧ/Qj%,VIh>0>q7= W _돿\ IE`2peX [Oi^pOZ^¯Wl:ȝ \?~7e> |@-uiJ n ZѦo`~fRҐ3"{8w{Tܛ]\=ritcU<|aY?ڃCqfpSgyi+gk/kP`E?2ށ#"e.%-i">Y_^z{ѧEH~BxE +ufaY0n _{Ǥ<V .]['B߷-q_AW 6ek'WA4Xe ?>;"L|(2OYi˼!l_C`xa<+<4?_kT^= q֫=55fWtx7t OZn }s*Rw{]нPϑ1]у1t\~OtLt7kQwP&ؒӕjvD2zۮ\ZE x [Eo$DvTXrM*I$D4t9*55?qcP؋ĩiuJM1_h~D4؏:KM-Q&ԘE+M5׵'j"w bQ oc'?^$#<ơ~\IIR7,V\N:%%7tJ͏Eڳ{8͎Qivc;?1R`?ٮ[|z&-Bu~i~g/ϯs]Qyש[.|ţxKY|ij /a a |iQ!PNl;I ~ M,0.B@>AH3[\ď-S~+5-K R"f%acwl$g02s8G5e1 U~g<OBڭi9A s!YR7+vrqҩE)A o^R1WC=B#.?Qgw\~#(eG0jˏ`TWW/c@[__jꯥ:!YTrL#2H5 sm;(׳;BDϴ;4r rё35@8+U GGΩfRpt.Hrn?z_2.vZ vHs8;  oG;2A(>x/fܻ\0 +Jn<:o  &l=E@jry1]çMhFF>՛Q'C6ri r+K"2j'Kw K..m%SD[ @}HH%˕3x[ ,boA,ŕ(JDn`,kV8EzOLJ-^ĉUZ t&YN4"vj@/2'đ (9PګxM$ސPbi`tX/|Ob 6wybUZB˅:^nNǬnǸ"N Հ^98O18&S{!ssU 0=un& ,'#%DU~482'ܜ5ܜ5*E h:3`=?dޏd`& RP  RP% ZP YyB0yB.jrϹ'E-1Oa' s endstream endobj 595 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 598 0 obj << /Length 358 /Filter /FlateDecode >> stream xڍRN0+Hڱp+*%H9A96m#ڔulZ$PylϬwgW\$gU2PR\RifF)TZ@Y)حg* Vo PFgG_p| endstream endobj 573 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-arthritisfig.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 601 0 R /BBox [0 0 504 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 602 0 R/F3 603 0 R>> /ExtGState << >>/ColorSpace << /sRGB 604 0 R >>>> /Length 709 /Filter /FlateDecode >> stream xVKO@W19dؙ}WVE7!#A^;qM6;|s xŷ#<'_NvU( A!rRT:e XېV'.4Rh0ht.H[yfj>rJޜ>98pT1DuAZEm d1R|TBo٥-)o@]Ap.C(&SqqZMA|fyy%8dd #B?T&okB-FmG)~,2x? I KB[ԭEnEw,_[4EnEw,][4[4c"BFӐR 'CdIBWC dŻ7P6+ɔ2umdGRxG/CiL|?"D1Yhc>m:HG|D]+,Vn {F6n'ϋ ~d7WcyQykd*@X(=w}݊ }j@E[1ѻBLr<_gK^ѓExcͨqI kJ2yU󧵳}n;9]DJY5'qCډؔ,IVxU=A;.4,u#ۥ/fǧ?&b"6p=z?pM endstream endobj 606 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 613 0 obj << /Length 3634 /Filter /FlateDecode >> stream xZY~_!%`E^`x'y(bIDiO]}Q̮쫺;mgW~|[UT5yfYfUQe)fs/ߖu\KMV:JOj=,1+[ ۇyǟpWH[̔͌-5 gEU-Ec Kzv-Km<-ɬm@#+;7xo)YSw:wV(;+ ێe6M6+4[fG]ZTcܴ6qReծ遪Ȭ@y5!/rQST*+:%װ7 0U) j­(%kmIS /jVN:0u1߷`u|eU4;J7XrЮdĽ >?q\\s@ =v-PMg_ zuk+/"r'hV`j;^| _q+50wAz f>I?[/\-g߬fTeƞ Y{^#R`~g1qYl}Y 6:g`3+)ga%E ,w:bW–Zi0#x O,ޏ.컋hl/zjS`)KS>p+FhW \ҟH)ZESrF9)tQhC۽ԠplJ|\m~1u]eѯ/&B+iWVOf"c `.gyS8h#j 0[Yxs BUV-b"uN#U+ykXow!>4v2[ wck d,)U$W*,٦{Ww;PYfւɖD'$y꠿a0/*9njH lP6/=_ )[VZD=U>mt Cs?ndFL|Tex63P8vP~S2YcOaoT\tٺNcZEe{3'EIJaتTf4kNa&Z^}ꑕԪ;d,0fZTeZ"1DDfQE=o!I|0dZE{r1W:Dž/h!+L80U;tjȈ{ bpJ %uZgM] i'*3JA!3#0uH4W !r j}\Iq)](GR\ a 掀̣wV{|/Ρx%[wRGnt4 $1^O~y&efgJɜd# 8yi*%q9JSo\&_},);xtN wu^sG xk3!A/n °7%9,LNu)b;HiA u^{JY1;?~ͫ@əC ?*y5nQ񲃕*+ Fmaw9n Y[0HY LSQS]+Dn?8x0yy-d1Tq ¬%LCAhj'\= f2!}`և:p ]=:Pa DU {gѩ6TMu0M/< 4Dm˫]f֖q,q4f/Č`Wğ.~^}Ի)|rCGw7;j(B"7t&]ج${ pzEw1E7_.C8GlRO`K9$LQҝF.ipSapǺROAUs@=wٵj[3&JmJN7Fв,g])qf!MgHً y;C,UG|d\\^19n/m|c1}̻1}@db_<~ȸ7>b):s7Kw^z[e~`2c{gxSqe|}l9 endstream endobj 628 0 obj << /Length 2401 /Filter /FlateDecode >> stream xZY~_!X4yHl ]i#ȱ<J5q #0i:Zi(,RG:a48=GߏUPu|xqh/c]o͐t!k&g+֑ 8?4?W`0K}b-. /2x$j4Ӱ2$1.J# :x$oxtMeO+!A'x%;yoyo襬߹uwV' -ҟcz %r[ ނO#xfE dDa,_1(O+l?z2H{-4'q+suwY!WEYsigR;nxޟp12Tu=ug?Rߜ݈"P/KQ ĀřƇq-~T+ =\33)[5"6&&y*JjIJ5۞`,HiZǤ0(K goCٝK2t2QXd{=%I=1!≆Lݒ1̠PV(j!CfpY)|miݗ'n NR6xʄ`NX\瞧su,֦QE{b[3u >,D ^I]kDbD&.kL=z\ީֶȶFDr% *E'J@x[Җ%SLR2$':+2 5RzʠpȚ0v>F,SWx,Kd[Ea[c "J"Kc^d{7ׅONcj:âJxju;,{.~D?r3ڭݙPt9v%,@r~ݛЯb%l9󃄾 dEq½ip=ī&9[?tA ]qnG C-[W13OjEtr|&Lp4(")b1KX@kqˣaɮ+ ]Pe6cisǁ+K4Y#'HRlQմ¤92/`{J'e|l`"+`r-9m<>b2|Qv @ՋLo&:FlLjJUB/J*?Og ص w?V endstream endobj 633 0 obj << /Length 603 /Filter /FlateDecode >> stream xڝTn0+xEqrkиhXZKe;i3\"0(ooތ ɇNKYWkRrbaPnW*dXuʢ$ToSN4B{0gBv qGk彍Kb}h(YL+AFv! vW{;\&$ѴB5B*-W9l%N@9x#v p04/l13Τ) Ud-8 }mpgDcMh_$bY󙒅`{zx,/t;x&wY #}X05qbFANh^٩iGe3@-6<\K&L_@\Uݕwg'RZ7tbR74d)oz{hwou%Un endstream endobj 619 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-label1fig.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 635 0 R /BBox [0 0 576 864] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 636 0 R/F2 637 0 R/F3 638 0 R>> /ExtGState << >>/ColorSpace << /sRGB 639 0 R >>>> /Length 3185 /Filter /FlateDecode >> stream x]Ko7WQ:h $,# vvcH^IoYdۑitE"?~=rz7}=y!f!}{Ň'1};x}X`B;|JQLU4悴A___|VBK?wM"l5stys5]O.rT{hH_1kUZ'Z1}^o اd0G.I6[x`ڐBpF&?jh.OVcR $(M HRsbܙjA+`Ⱥlls*kqwPІقN*(q'$\unk+Y~cXZNa)ruz <^oՏ.~I <ٷWsyIj 4˶U t$Jvvr40N/aT4 ~v &٨ Ǝӥ^2i;wCW2z>A<pi@v"a xpy9 m5 dm5O%D  ]8]CN{6Pexԛro.Ofin,%[x؛v@yӋ0;TO&O1jO4f'9RYݛ;uQh`XA9WȃDCh| {lôOz.=x07,,m{_o>ѮGhz]-9^\ '=n&K`PC,MagCB$s|ͧõȠ5.^MC-|#dZ<G[h9+-W2l0{F(OÊ2cyd3&03V"VF&gj$0o-p&g9`^1g1`^5 W[Jdja~!UAE$PLim{"m FSD$BYLëg#:bw!.& KO昴kg p@82z9M)?dGf_ 0j'J}5q&|DwO?0< endstream endobj 641 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 644 0 obj << /Length 723 /Filter /FlateDecode >> stream x}Un0+xX!ERzKz(SbѲQJ%'h3ҒSY{3`:/,"D%Ya3UҔY [ߥ7i^g0viӕRIsf'ׯ=1|#!LYT =4e'koD!dV\LW)t?!a>nH_<[A"1V .}y.]VxM7(ڑ0ƀ a7a$5n.}(vx7&ن/nMmd թU|x˸M {ާŻ YF+2+@;Dl2?4{7Ѫ9dܡ=x+=xt=-Nn_|נs!/&Bc<{\[$`"B8S{Y]O<o-&z3xtygvA{?o6g#w$PP )+K~"ے6(Qa~v4Z=B@:h!fOf@m^Xo\<ɳ2F;Zl 0l=̆Fg1v*,.kwyqⳁra9W9>4='m^d;]Eܪ(m k~9 o.<$P`G"U: endstream endobj 624 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-label2fig.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 646 0 R /BBox [0 0 864 864] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 647 0 R/F2 648 0 R/F3 649 0 R>> /ExtGState << >>/ColorSpace << /sRGB 650 0 R >>>> /Length 2972 /Filter /FlateDecode >> stream x\Ko7ϯ|H6 H] XBAƐXi*f534KV*~|~> r2𷕟OC੷1 >__==*1GoRTb b?|n(?;o?Jg8Qi$/k>0\ݿ_nmbçO?;?ZUA: 7< Q ROѐJa{yS8pl c qԔ HoEPRڍ&$,Y,)J_\ƎZ7D14سЙa',)MZV,9xlnͼyۀ⚗;%\1% K02g^rz "3NJyR}#%ed2a^r!T)fW0Qo1Aɝ(l5/4}dkDm9\8HM%c{ +%Gygp[)G `v8Fa˥wvЌ& % ,ŠR̋Qc{E wJ0ζFcb3n\,T; plOFJGiV_p"Ѷ}* n;m42R%5HMa"lRMic_:/tcnk.ӵ Y1:wx]b P|(&Ep #ygS. ԢcE5;DtWu7W \' {Rooo~gj*W( >@XXQiO5\'殶%!TgiwD(\X[WNRĦ2V#7W* il>wWuMI \ Z:ӡvVZOkDwh.To~@{YԆrCDLO21+/W3rVa&#r4K7g#\TxlDS&45O1//@`pؕlŌBNh'6N#I!$f%A+'A1"%pLH U( M8c1)#)xI3&Rk!%b%O'}NVEKbi obbGh Ԩxi&Z""k^ -/i`3^K7ļ'%Ą-r>f[~vf"h6f"(V1 02tcThcX%dsE U4@j*/W 8%"zIQRD+*JsEVUPqcT(P%֊L/>Go)J\TdR@QTy>EUQB%850*JyFE uWH|)JS/yaDњSQ%UIx$ӓL=IF:.0I0\$UNlOUOg&ˠ_H]&HحiQǰviCsTzq> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 665 0 obj << /Length 2287 /Filter /FlateDecode >> stream xko6{~O2k%QԣE}jBX2${wSw^H?.Z G9͍&h7c=xrs7)ITzr3lͿ^]g geX$ !4L)-7_$iW+8M=ҸWEj3"˘7әNT: D)x  ڈ @bw@qltDYR:JYW|/I= G\?4s&E[J i<5QD#FNmPa9jү"B^I )aP%(a*APaBkf:VCf jEM%OZTݯfY44 he$y=xuQG"f,B#Cjd`&v?<98+| di8n?jpjFZ՚Γ+;]9*-(O@jJkODl%NAXQIUӒ%oQ8;y~:&p4vbgDЭ~G3BF\ yU Kдl_ E@(9Z( j^ӈg&31_'=ze~GNre. 2m N8#EH9s[9_"K~\;Y\yAvZș^[T` j ;\Wl# Yc%bU+ҝKJ(®7۞ 7M"k[ /[rDB4L w@s;I|4Uqs}|"cՙ!rx2PJ:sX0I_%Rg*g?ʢ{IN~qt0P_&&0sp;ue"(iiR*Su:aIYgQuDgh$z.][GБꎒse3|Gۘz7LHNSb" k'fQaQm8,E"߉ԫ֑bɘ[bGBUal`_G(8V^@r)/:j)~"-.4)(D8wQoQYj.LKVuzDzУ*}odYti;'Gĝ0өߢ.fr-jAeL, $݊yJ=S= :1HϚ Q&$_`QlP~N[n$<-gIXt4_&N]v_nc|8! o_^z춿3 O4կ5GM߈,Ϭv5?yKpˀDF.ilK}::_X>c$rx5p=H~> .|wtz%)Rn :}K @ܾE(PPlE|D&X71 jE|P .t^C6T&lԙs)Zsɖ 9 4hnJO?L'9;nGf| 鿷 `؆wfo[V<3ے~Ōs3Ɛ{#knwm_IX?Rr/)Ņl7) ;>к3j=* 8W$(sᙆ*إ*T4̧ٻME8>t fyanک8Ms0׮60*tK9llM8pn# FZ YTDjG9Ȃ3i }̭/d*nW?iwb b/-ʌjGKTqc/Y[9$zVޓ~+~8qaNZis[ 2ӖWkQQW^P_0oWU> stream x}UKo0 W(n I%Qj'Rb8$aL"K&EZJŊ)Ri [%cU''lƉ֚qbwUɻމ`W7 {`g'>H{?ŧ[it`LZEQZ&x8(;U}wp8!R:G 7"-0vGudo;`iK 8qvKu 9_e3]{kao^~|6'=Bn65oQYTNVEH7{?,:%@pM}K4۬&9/.`VeZKNMVPsu ŷ!\wmn4#֡vDo6Wcvwmֻ~Ypv'II@y:~CYFtg? me{F`HDoyh9*:d0Lֈ/u2y.nO/jo,~l|ækEL ƆWm %& 5ns90pb+WU*2>x|ѺYJ/+Վ~XHfB?ͅAy =W^R|(?~ /d@fŗp7}Kf0' \1>p.T::fBW i>|zϳj{ӓw;9zz endstream endobj 656 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-label3fig.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 676 0 R /BBox [0 0 576 576] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 677 0 R/F2 678 0 R/F3 679 0 R>> /ExtGState << >>/ColorSpace << /sRGB 680 0 R >>>> /Length 2209 /Filter /FlateDecode >> stream x[[o7~ׯP&0i?ǙFc[GC #~V,ן^+1j~ͩ|m7??Q+RoyEzrVQ&"NNn6uux^GC|%!ΚIӈOy)os^gY9:fX`EY_2mѽurkFQgW|͉Zˇ/߾RzX>uvY? dI:qb kD?6Ny:@w:,ED L8Ļ t`ņӉTJx_L^5Cȧۏ V@ Gh Dx X]H4CLЄE_5}^\ t&I˵Ia(⎇BAl+k'zdӎ'%Wuiяw0Em|Q1靖j9"29w8˪5%/꽬?.eYo%K ( V8)p`$zL_zf8 z HgFRHI\GnC^R(KSF j ABB,Kx 49L\P`bkp[$ (AHd Jc'm,AAqFvIZ6F-!E ʾ' -[:u+uwP2aߌF 4?nJ]M:M=g-2*C)|_ѻ4"%U ,ޡ6,Gñaoj@r;FYCㅝ*rpK'EK!) 1LD}%M"&sXz:@8 'hF) ѝs/4纜29lQQ+*Mp3}9VU(<[a_v[U3:\pd=OhT_\ea)3$^*iВ+f7zOZV䞽n/Ǜ]'|Q1^XuRM9aJ S;>>قm~=n%]j|\?qr_nFݨ)2tX.Gؕ-M$=S$Cp'F]܁3&t%FtӚqo "ʄʅDUF׽2> &OP&_rQ&^@K%y,ca/x[LZF;[『/ı?<}:ir $b}S7E& BsD)%I&-5j:1e(QaVe|fg.jwU'E|*Co S ef] e۵D&E>"oڦJA܋R;iCxt/a•/9 .="Dtp2+ЄNޢ /C(1%}it|@zxFݛ]CA'UI*\n^N t:d`~ l1ov@k|¹Gק=;?|/o].{F~:=~ 5T&Y~ ۽&;xq2[ ݿ{q6,0ގ+~7f<5EonEY?G ZN8aűNh]wǓ杤=BwOKEVS+AW9#-+c:Ƅ=p6uOZJi|]䇍1$`iai,,,0S^+-oUba1pue`= }867StRMuR[$Ng(ӮwA<&d7_3HQ_hl`Z;{%ر!֙AZ@9-v@^u\@3,$9}rJ#JY)Ƶaxͦ{p#X;EvPy<* BGsw4#W(s:o?D< XKoD_,z<'Ft?Pe endstream endobj 561 0 obj << /Type /ObjStm /N 100 /First 887 /Length 2234 /Filter /FlateDecode >> stream xZmo8_,"9,-p{[nA>ձs\XNR׍] $ -FyyRpN+K^㌖7#U AE~6mV8$Uܖ:zeCxZl23(gE&Z(#r^Z=I6<WRVd fQ@+" Q&`Nb!'(`ad {r+ZNge}NЌ@ *Ks|NR> Vv~6v">J$0@ұK8*LCbXxea[{sa ,gL TG8c"U0c7Ft|1YtȐd3cĔӉI x(LXsPEO0* v}P1(c N8J1˜0C6RIϢM1c[Q/{g/VUlV&* 15'̃a9ˎY1XǽO{ו*FWoGzdPM |Ӝ/mUQgb5HGAc L=}7uvE}9T#/=E ڸ֥u !0hc6p.0qBÚY᣶$86I_<0NY@2*;8ˍfRtkgQNY(iYct`{W1+Uŋjj~+:M:۫{Ux8_YXn*γw̵_=MI}qQaGΐz4"jX]4:XeTEgWSAU\xTT-ec)51 bg}pX\s6,'a9kxT}(^ҍi a'P҄dM?>' ؜.QjJvI'dBZ䜎 .`aZxJlW&c)MVJ:+[U=x2? `=8wŠCp3l-ybV薸(Wyڃݠ{nyk+EK:!#wkFC _,g` 3z=}svTJ}IHNntp$\Eۍ0x00$!tS. dY3PűM(ZYY۠ZѺG E:~'n*/^L80oC\o8vߐһzm,v*esŋ^lRV^^> ^rko0n-]1)e= tTíNl=/_}_\bp?/zbV^^rdGs+m|_dڑLCyz'ɥ0'_ȻЖ~_7=p+|*6XP(y7`V DKAU"P(쒢vI}v(}هDpҾ"o #&ܯ8WZyr.f-/9̆V\⋤[௕Q-e~ [3aaGb+$I endstream endobj 683 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 690 0 obj << /Length 2592 /Filter /FlateDecode >> stream xn_!F#5h EN $hHBJv݇|{纻(_rp Crgvv3LfY27W_3$qfvs7̬˸f9xWT.SqV6_[k0W=W2o9_av3r} `5u]<^R .Ia-ѻ9a`n6W& t`]@8#EK >YYKd`(IT@/iTjF&8&۝8mb6qR:-N(,Z ې9IX531sEc]d|_b27ֻmpLc˸%'. 2Y](>oB^ʊr#bbTRWPW.H8cʆ F(H-(<})?rUndE.[]Y!a eBÓU: jo4lx vQ?I\R]2s+tE[QTCTKKz+2p&5i0 ]qw'rNďe@ۖ% r&Kp^-0ۏk}L3&βR8o_[It˴rũl ķdd&:JaR#1"T^ iF%E i;ktGTNp_yL7z`=^N(m4QU@vr!DWyb^6'g8%= `b~߄G2O8!!3q?՚BTw#ޟG +qAkOoBdo=RQpN ۙ?ss]pHW5tDNߊX3@k7鶴}DmVӭ h*!R*e`w;iJ)KrWHp7QJ4آ%F#s{Zc?ލI9&Cx&H,oP) 4[vas< GfT7;jsdTv Vg7eX&9(MtV.bcnbYa]?ZcI66f endstream endobj 658 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-listfig.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 699 0 R /BBox [0 0 504 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 700 0 R/F2 701 0 R/F3 702 0 R>> /ExtGState << >>/ColorSpace << /sRGB 703 0 R >>>> /Length 927 /Filter /FlateDecode >> stream xXnGWԑ:{&V60 랅ñ#1dNk*j#N"-fk)kz(g:89}jk89ВIUŃwz#r8MAWvSiem1kĽ,7~uzIjż"g&3z&f>}[-kHo0aVMEl~eĝ;KkŇΚ`C ̅|wE.Ɵ쾐$]|ξ͈ 9*V4iݩ FC9|^U+6ƞVszl:#?i endstream endobj 705 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 684 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-artspinefig.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 706 0 R /BBox [0 0 504 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 707 0 R/F3 708 0 R>> /ExtGState << >>/ColorSpace << /sRGB 709 0 R >>>> /Length 370 /Filter /FlateDecode >> stream xMS0{,&i+:2ЂK+T@8l:Nw4= ó8[^v`#P_EZb4 3A1$QJ %1h*dV tNwuXM6ҥnѷ?kϠ~ll~Y'ހ Y МȀT5|$҃R( Yto[PNjD u> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 723 0 obj << /Length 2764 /Filter /FlateDecode >> stream xZ[o~ϯ$Ù5h E.vP`((,)q{!Ernѐ˹:7~ʤ3Ge\ͬ0<ͣҥy/vg [&4nab霛\[|kW"=\|oa &_YxRO[4*bZ7ǝpupUpmT~XB;^3ȫu˯,3;\yF+\GeVhpٞPʌ~H)CųMԤ#dQ[ ydž(isyD,I? [qґ Z&uO[XLZK賖EDc z㝷I=v?:2("Ҥ5+nXchoxL=27eh[l^nX E)m?,t^5bu#[pԼM#QDDdMY0bW5Ǿt֢of?Qq 8zA Өuz' F=!rMwrvOGxșWW#3[9fm_(Sac MUekAx2ƗFa[QF9E-ޣx, izCwU Oe]M1$r.52nFњB-8M΅2 O x_$"-K7(mAr\O&7 9楻xu`I# Zq MfM ˝dAZ^xjayɫ#=JVC40`z~KۆSVML#0vq3F6yˆn_8Sw(aU*|*džH!D0'Ec+?5̀H ׹UAmy}X,ͷ4@Y |I^*g`9eT6'Y`Lܝp')|HX{+)&5E7D̠17guGgӖX1 ;F `*; O Wh#cNph F7! zmPM#RN؅09&,QՠNld RQOE IPuEPJ^|hI6E|f?oD/AX)1?kwSG، ٰЗ[ʙ[JPetы&V0ii"}I^ mh;iQ6 EI::t5 {K&&^q>&%Ör`? Is6OAcf\|(B*ۡZUmA#slR *YchHX7.}^\eia넴EGIl&M 1a;`exk`_"d82[L%8kF <͔9-"k?A1yq|[ޡ_#&^q 2Ot+£V 6рb U1|0CfDVtCvq){_PƦll{OgȐ{E5>۔y:i6S'~R|/ngPwJsJ,,EղEaG-\A~0$hN0(gںݦ`TW\5L1 zlQοA0zB܂$J Sm[=8DbH^6qsTl) x('Xpi!Y\dG8d%ס'>I;؟R(JV!(&+ f[E'E_t2Pw68AUdL%YZ &-wB:QC*}"|06W&x4cmNy%L%QA6")h Hجo&#PR"d#Sx|rpװ 0AY:,ViݔO݋K<&ueT~w%j4f$=4DM5m;1ؼׇGY@1ŠW`>㨈 ?ȱW7Ah/꫶zN&qoOU(/o62g\%Ɠ5i[V[BdFհV颼ȆK;.+S:U?%3H լ}T&S)J?YN(o@`PERkG_~M9M"pDB1瘸^ysY횄WkHPaljǀbNhc.q!ϳƂ94BK_/3\"/<]Ϳ$ endstream endobj 729 0 obj << /Length 481 /Filter /FlateDecode >> stream x}Sn0+x&-Fn血C[^r$@oHږ )ٚI%Ud^LbՊi)˝(MΪ%RT;ecO{~BTJ7tJ_!mC}M_*Eafj7s()6ULk'\^>yKD>9>ujɷM~se4/ ^3Ɗ mm<[m7mwifwAu(a1"v7ASuq!~P-ye#R` HyK(E."NEٻ0oOz$)#r[}TlY+!|tÔgLSuBX+ vg'w>۸I 1uvV݇+ᜋ@&OGÕ7ŘRJ';(pȚ[P-,ˍ=DxsCF]˼ݩTK endstream endobj 715 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-spacingfig.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 731 0 R /BBox [0 0 864 864] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 732 0 R/F3 733 0 R>> /ExtGState << >>/ColorSpace << /sRGB 734 0 R >>>> /Length 715 /Filter /FlateDecode >> stream xXMo1ﯘcz=DV@Vp($xmJؕzZ'~3ϼyA8k>|qwVAk|-e\O=4\ '2L_E9БBUdv GePK/4momP=Ee*g 2 cTYO'k~ BG-M_TYȏcV"+4nr}p zf;nlAy/fVn@aBrH &/fO9^'_\4F!Jtr>x:a%O2 .O߬:*c'.0El65:rG"S7)H6H6'dZ¶ⷶ1Yiq*iWi?PߌF=҈, BQ$qTCbO!n(E!E'$EB"UHA JoEITp)<2/\) endstream endobj 736 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 741 0 obj << /Length 1990 /Filter /FlateDecode >> stream xڥio6P` TH:m@5l> hBǛm4{%ъ!"}I ճ eeR:(T<.S\6?< Jee\Z:J4| #< [qU„}Gî_HcW,EZڸ2ɽMAj%ÿW*Muu`ЫuD`  O5Mnxwů[ mbSO,mУ<*xCXS5 }v(2_5 DljY'_#Ӱp?aÝ3;f]C!๖gWBbx4Ԃ́.e/L;,[q[k]\u.,,?zҏXJ*(Aj).#tP)U&=GB_C;MʙpxXQ GNd`:䷜ID 3S3בI(%HQh& K8@, *{栝^J%rAcZAS4x0 {6neF8Gm2" {z9OqRc ;΍{S0lZLYIyrNtyK>yK1yK+'9[ l# Q|wFlj3;Us `B'RitUbK$F=UKm<%Jvdx9g4B6,9:,s&RCE:Җ"AÃ*5J}4Ae*? BYs&AGɅȦI#(:.#ƶlT&e΍fҥwf SF7.ၲ)_jhmNS"lt\F;TuUbbYઁwwYU[:bFϼaAj޶ > /ExtGState << >>/ColorSpace << /sRGB 746 0 R >>>> /Length 1539 /Filter /FlateDecode >> stream xZKo7 q}*Jm-7#v kӴά?awMJ$E[EB>]kur2:zV듫~lc{ b2tE->+*Zmu6A(x^C5]6glewe#eѸYWߒǠ&~%g)iv[~#g:-ׇwج ƨ_VsB/ËXV#dX^0fm촡2L^~_mU1#&mVwӘVSs*Etfշ{ pnN°S۪ZK8ia`=yEi Vp,(Ʒт|D2KTz&aш:7I4z.X&J%&6' 0|X/L1BkOKP3VZG ׮P!>x<>kqqگ>,X\7 ?Z(`^T EWa#ڪ}fP뛽>-`O%,}tH U87A[YQ 圐 uiM})~ŕ4!L!La=>n:5[!m\Tg-RFd(~cJA:^ P/z޽>TT445q}<:4tޗb ̊|;!-iq/;)oP+r>(AJ h|SpWro}Oy %Ax+X g˂E,-G3m4={/Oq[+F 8~10LKP#~C>6_"տd endstream endobj 748 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 755 0 obj << /Length 2384 /Filter /FlateDecode >> stream xڭYmB6։^MMڢhA.Eklɵl6;`E<3}FۢLim]dS"*2]6ѻ-gX:C}\*nO {mj[!=0w-~q6м3?u2߫^5yȠ3uRd>9I@2LtyRSZ,2}jqvG  9{`3tm[nojmw{q뎷/ײr7; # AzT"n,tɮr.qePHfdIN I@NLZEK'C\FBe5 5to' )߳ VGToIߍB0M(]2JQz- g!yhKvEB +)fUetPU%O' jT[~YU|ڞñ<E!dCKֆ^`Nxك4B*!634t*xwt ނ(,&IQ5Q6s>e20ڰj1S󜋥.))la-d$/"u}f܀d_sgxUWjPǼ#rlA\ I[]NfPӥV]VBXC7`yEVj΄] J*tZM';hv<iܭ h6a+YxOGmhzu#qf3hPU cлpj,,_h|aj(9Kǽ&xUJCc Q5I!}xpq EAo9~㈭5gLmxi!!>Y஑r{J!cmM!FMoNO|+xEI%8Pӫ j e亘BfKoeLxLl]ճHI͆ xg5K|6);9֫]R{l=C'x5v*N9UkFH֜D1MZm]kZ 4B Nf ec|$V4 a{S&Z-;h#-;jvч * N`$,d wi&9 h:$Fgo6W448Ж}4AJ H[kH̃z)X͌7'쎀ѲWϦ6<0V(Gv+Ϛ v̺+NlZxgƀMNg&px7fց?^FDEU"Z!L̲{1Һ %|CA}RnbSrNUqC|d-J; ]%^u|TY#qAv^esT t J@Xz;%vQp=9陼iIZ1bsoj {K)F$i]8k9"9Dgey2LVTUE31x9y38فTc([UI[5J4e-W| Ͽy3 ?Kz<Ȑ'U$LQa+,t&Tr<1ڏt?jm8Gm'ϟ_A|]ʻc,dKab˸h$|i%~I2UIf8[}ye/ܐЧ |igDvWJS&)0~$h|CEJn:Sz 6W5,/rN*Bw8 L_I>ߩ4Uӏlr?9;-ȯgnK;XAXᔵʝnC!m"/fU0cǛv\ endstream endobj 749 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-ocdoubledecker.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 759 0 R /BBox [0 0 576 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 760 0 R/F3 761 0 R>> /ExtGState << >>/ColorSpace << /sRGB 762 0 R >>>> /Length 906 /Filter /FlateDecode >> stream xXnZA ߯MVJm@@+3v@1CE>F( o`hHRC\fK)}^k0n\Q QVX &-D)D0:)z'KSǟwBP:d?tCɾ`,hc`IB[V O47t3h QBc*0g!tRvNDt(P* eA(l '*ކJgZ0 |0"<%|Q]`#DzuDyJX(ky:cP o$|W>_>;!mC N&na0( }x'k\4m/s&XMÇl8#4o. {OKWZ$ tjJ`(kaHZgF2RiF---η2s:n7"B#x!|pvC gjD,t՛8hx [b9BKgD8񰬉C B sSGͯ[_FwuvR kڵD?Yl5${rޤ#'k^3`m\ruaN;^;S6S }S3LYzT{Y.ͳ972{q7w/2_5c#ml8wM5hVT^C͌!ӂa8ףb݈kvE|0qP"Dz̀- F;C-[_wflJ~m&`mݼ,|ֹ]UPae 茥_Fv BӘ#p+H?s^1 ) endstream endobj 764 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 771 0 obj << /Length 3348 /Filter /FlateDecode >> stream xڕZ[oF~ϯ0np^ tI)궰],DAYos%I ̜9\lqo;3I\%9=+Yኸ?o}M^T&2-a"L,v=m >7Fz~=^$!KSmsm=3Xf4$U:Cvp᳔kMᖶ89Ϧ4wyn3#m&iQ-v*MW,L!#cyLkx&NNZbc^#[9[[Y`Qؾ,B9e?v2vWM<ڼ-$&.Q$阠H~O~KH8`((7V@G[2UԌʖq^yqρDgrʦWƁ$8Quo Zk2;gDcQVMU-d%^R%.yc[a] SlelssYg hwk l`~=?> +ʧRu9mݢK<)]x'i'/_(5{^q+|$1}%bC%gTqOdLŬWzGO<|͗Ezho|y|XMHp<,dt} ׯOpn461;h뎁b"L59W$!lD45d &ApN'ru/ARO6KVꬖ5o#aA;=r4WcQ`- 'uG,+|Rg+A@N{oгv'9cRx:ttl0wXAKnQ )q9uw $ hٻcM5~ !֊FE=D*'jMTv2 ݓx(֍O3iƧ^xs4FeE#2Z*J6UY2>ͧSJ$j͢aYmg͜aqFOpq9So7giqTt<߷e2N?^^>i1ߩ QerPM(3dkē/6<a)gsF^ڮ=b/5@4ؼ ԑ ;B'r uɤU-_9z V'EH$ PSq'tDb|8~4Hv-pקYoghIfG/7:@#[GReXS׎G,W'R0gSyYx=k>2>.Yr?ct2BgҜY ۞ `.X r ^ݤ8<1qO7{'}~ ESp x6huoC3Ơ087WX$ey6,H[PeV_ ʒ;Ly޽᫔Φg^ =pZjS6&[# _&. \ts Hx$l8kA/Eoiz#tuSMe0<6? =Mw\ 򂎶p_ly%Cb˼Tsx^ /zr>TIv08"qN"Vq~Cf*頤ꔅ/njҙ(z&$ĥIf"q B뢸Jc2dA "/6N6 \,AN3Ikbz,6)҄j^ R`'Z ]K6>hR@orϖXp!֧ "PbJ4E|k=« ;T ={TmUL`6ũG9iF[ueϘըih~~&IXs3 C'Ӡ+KCE"y(_H^FDZ4w%!`/#8? X}K-a X<(u1 2: M(eJ.*E87VX=v deldw"ɽ4k<XkQ(QkY>(–}#Qݙd26֨ii1k,bc a/aOfUi§(Хu3ܗT'bRsɗޫlU"EgAcH.) ^^4hA~< K ߒE%^a lfO^Ez۠0=Ru𞤇miw҃1sytycplKqӹ.S%_RLef auXoCUoC(Ɇ>k{<834*2ٿ{*4a#0oHoϚ=t'nCa$=:,m3-Պָ);FCB'%ڙw Bgh{c|.xdb$ٗr'-b 96L>yL#ާ~^r땶K|k7≊@4!KC<X!_*yԇM7BV`W-M $tT)^=:w2DO8 Bg_?\ $40fP<X}XT x7ԘrIRsI]" "Ƭ3iy e}YU A[HoͦQ14T8 hF4#FjLd4Ɇp5>­v:N(<9G?nJqKM3}lHn^ug endstream endobj 781 0 obj << /Length 710 /Filter /FlateDecode >> stream xڭUn0+x7mn(>]%/-ߙ!(iCP,o9[I^.1*$[ʕ+m)*m٢ay*y·I35f{L3U]7u]a0o0|Ѕ؟ iDa>A3}<\E"șdҔBZɬT*4[_0ʕ"k-f3|Q=yC5-`y M+|`̄1 $^rJv~cuoZ4Qqp)(5(lEwA_!1u&H\ېJ.oY=!o#5]h.o\FDŽmpVaBW65,# ]5:=hP3!"΂ʨ{BCX0t+uJ^3Lk>Z|L><'_کπPNKz=П$13@"ͬYxT{.\=G$EN`f ' ^c96/?xաh endstream endobj 751 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-ocmosaicnull.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 783 0 R /BBox [0 0 720 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 784 0 R/F3 785 0 R>> /ExtGState << >>/ColorSpace << /sRGB 786 0 R >>>> /Length 1030 /Filter /FlateDecode >> stream xXKO#GW>tWU )Q|[ޕ $|56Y0{zW53r5*q$L VNS*2Z$k}5E+4)P{mʤD3bp x'Ǭl"EU[Dֱ~BTZ z|LCxE]Kbp6*2 VCY>dh)Zz#&pQBvM!b1 ~/^5/6uDݷO86i爼l\ތ>~u9[ͧ[+|;y{N3D.)͍@?#Rg'&v*b؅ %%(YKzpNA[cc&*ebKѨ`c_LP9 smNAښ (Wz+qP 5C=:憽DmSc*Ow*_AgUogXJ@I#16u[СX% \LK|$ݳ\B^c͇$Ml;X:l9U endstream endobj 788 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 766 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/strucplot-ocmosaicstage.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 789 0 R /BBox [0 0 720 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 790 0 R/F3 791 0 R>> /ExtGState << >>/ColorSpace << /sRGB 792 0 R >>>> /Length 864 /Filter /FlateDecode >> stream xWKO@W9d؝}WVBjՖ+ UPmxI}zNA*wBa֟*PEДPrMcH}кt?Nwq~ FS]"Fm<(ϊGb)6>)-P5 qƲ$y 5l5/S6oY}aE/|!n=W]@Ƌ8帚/nf H#fd>^LFwtn^٬}AYM~lDEB1Di͎I! >Dg`ӏmkMDIHFoa49&mA#%Á |!q-*eDt |5:9bH W^xlGLdD7v ")@A@IKnvS3~ ^5q'PRIe> 3 5tl]j4I`ɋO.GMQ9 ^vK#D1SoUb(/c8?s~Z+½x1]ϫ qW#c`M>IFzSVnhv?ZUGiMd,i#FTy>qGQmh2l¨d2)b<ExƠfVmCx^D3> stream xZKs7Wh@ *UJ\,oaD$䌖3_)z1c&q`!0xD' ",Lx'a-g> ƵHF6i0o!A&G2 rRB#$`3M΂Bp"j-(0j'l egа`A`M{쫃0&4"x =`CHR'fFƂYGA4FX-86=6:VXOc/ F قCJitŸ ֈ5 B5n艠X%-fe=Nxx4 7Ahc(uIÐXa# >q;+DC r<SJ CEcAVZ]؊YO)# saf]0je8FlbMNDoDpF$ h+`Z;)/ M#HЀ y,9F&h?&+̜ٲXPlv{Ⱦhxnd#*fLpNvD<8V_M9,"`wwvY jX@1՛P? YY F t\nIy"l:JU mp>=T;J5-R4R eժ[4FɪnG噚ao5,GɤWl>VuUWÂk.ay2Nq`BH,O?"cFBi|2yKµoU+vw:lM;e Lp~,ŬS'Y=<*[T98]׻-l8/j;CG hޖM=ACUū8fdJ v+`{TdenOZ>^<[gmqUFDkL [ rIL 2 q[ˋtZN^Ra-*GIKrtR@3i9d"tư/ eKBV NL(1BXdžWKs/tA:ʔ [8xAm0dY?+v\WE[/&$lѱwc([ü;lN^5wbl-N'i6Y]rlbp}2̭jǒ%񪞌^w崏MZ k|,|)} lߋKo?'.Ow.K`縻Yw5;{=^zi`|f{eIuR A,s^nwgJE7wSpP! JXޜ,}#I k NJ=)cXaP{7.8ɵ$ jow@u7Hk{qѶ/,M[pŴ)[Y5*ZOQ+yN';O k ،9W`K \SAW6 dO3´h/o\ uPLVKwl|E/EF" pB:MI/15sF^^d#%$kk_Xo_I/OCŏ^ntgJ|ҙJ_S|5=Xե587yYi{w endstream endobj 794 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 803 0 obj << /Length 3283 /Filter /FlateDecode >> stream xڭZIspPU KKvw'ɁhӶR;6LL$@=0ٙ$;>{J.qj|P;ctF<}UV{EZ bj4ZG'P]õm\5ѫQaUyoFi-VPsua7\$Q LE0Wlj3 EAx~-b£oY,Jκ$mnrσعA޷Y1Id·R St0pE s1oHAx ,LK]#6c3s(K|"@_5 DH%RgIgT[NQlA. ;M-+p/Uz+b|}>/RWm߅dWZ[,t]܂T²5S ] V5i81 "E@*z"N~!sm*zsnZWk.\632֛.Zϱ8f!Z D%uM<\TO6DF%dEwRM\y@-'\48h9[\T2VlPpw$Q4gNT>1e}&ǏuKCz#9GVQ@G&ZoS!pk s k [X"eD~cB`],8tJqޜm&Ks&~]ՇbCVvCF0/$j %>5ր ,o*[D`vSOҡSܨn#m[NqxD?w*[&adډ|.:x/-dEk~A`mt;2kښXŃv͚`נʫ`ٴA1m^{. 2`?Z7B %> p1 /p di9jEcFxtKF &4^y-Roo.e chitRioXꆝqPRFJ,eH۾l|r7c,OAV'ΰr )f`OaMbl>d>~A(y /3H~ f1V9yW? DCtV+s!qm20Z)2Vos/n*Js2p䙏IH˹?-Sr^GL| ]`zIݝѮ_⁦[;=@wһ'I!QQہ|zRV qNY9]#; kQN`Zm v[[YRZc{MS\S%qo'QzA @֘``;ik~чz `&ςpKO É4ԒP0g$hrmG VHKB^?KbýYfY-*o\ԎbDt9>ŠmitRMtI;-0XW{35'o.=S$מ_qfMa2tފ>Asmgnn[ 5$q`hĦoO52hy"Ny&i:v6ldk*}rG4ښ=6V<LJod!i6ঌ6-3k,8(2f" r#Q횛Rl N h%;=S>~C0 094Ԋ9Gܔ+losͯ( tl2u.uuPHNrz bQmm'f$>p{J/r /I8磺v5-$Q#)Ǒo$} щou23t'N?:| tJ!a_5Jn+F@;4-X@3mG'}{;,}$AO1z;m2PmlTO3Y3@/QU9Poy Foi&6P3ˑ ֓`]'/>zx<,,C\yt]!'x, HU5ҧ1A8xiOg:t:F.Ce1'g1> endstream endobj 842 0 obj << /Length 3244 /Filter /FlateDecode >> stream xZKs8WTU ٙęIfN@K%D)'~D+r2=4AG(=:>z¥#Yr#n$b;G?Uu|~$7hwcNf(z%+o78U# ;f-c䅲* L2"P:F؆s<_; N=FM~ׯ+~|KPns/;N1?OD"إtuƣ@ЊwCǒQ4Ew$Ps@3jtܒz`~-k~I,a h^Ƣ_΀Ӹeu+9Ҟ>~`#p_) {xK<}[=U9&(|:CPNA~"NX#c%Y/P#WV91ɠ;p)Y 6v| 5sR%wJ$< WSk]MIFZwD`n :fK6A{2Up,umY@3KCTC:%b]ml b;ZmxG$:.H7BeM"I>nH _&qdTE>%N7 .Uox*Jΐդ 6sbս"BkрoZ7o}.3aL(Gz}iohФ丁)ׄ| !')|qsZ{j!(-k>Ǩ{`< su:Ugd 8$=-r@ N%](i,٦r3l [7[!=l`d d 8z3.Đ,vlEx6G}d Ba8nqүDA瘼,DA^t:8 [u}e!~ Bc@z-!3vw.sy#Ӟ]kmσ-bP!>bKa.IuS06'K.v-$߈FWRb +VА2+ȝ(,P\zi3͍IDۮWOGk_Vt"EMdS@^Rİ 7koD#ƥ-}^OR#Ef vmp̢X!Xxùn}7[A2.r( ̴3ݪNyΫ!.za&[< l"9`̈́i䎯~?7h*`7Rt8r;þ "jӎ3uP\QVTYu iPcwi_P+uO)0]{χ3q8>b)rIukakC -wDAyAJ\ǵ[3*D6qQJ|jJ_]? a2 $f9W76|"FKTťOA{` L|TG`@PiC`8t>b'uehS|R3uh# mqICL+O';뗃CZmA^%-M:.2)Y*og_ŗ6VgW^}Qg- : nnD(sm>-<[hcN=Q` #IrMNV lQr=QjV,|׭bB(- Qp}tʂdU_O]U lf&9qKNVpؽ$#U]R oF\3,v,<ϨE/qJT j,;iJ]{ڊ2B9 8%gkKwB/P}N_C,qf8vQ`PkŊ[SIX)8&?šK*x)I[74m7R檃2hK|@<0W,8]0?26x6Hrb k1Qxt~L+VtTjk| 7c8.'%ݥafzq&iLϧ՟ endstream endobj 852 0 obj << /Length 367 /Filter /FlateDecode >> stream xڽRMS0WiNHet`O T>f;%;ُM$[0"0%NY2 +f'6|+zyjU*u4E2T|FZk PXvG<mr_a] 9IzvL)ጉ,j"mMS9WR^HZ!϶^n%aH&R;,3 eyc>-L|Ѧh- IVz Ǹ] #Uk: @#p͹jdw/~zFDb"-19EC$h A&pUS̏Ԥ'6>9vY75v[j4ĤceK^ċ" endstream endobj 864 0 obj << /Length 155 /Filter /FlateDecode >> stream x313R0P0U0S01CB.cI$r9yr\`W4K)YKE!P E ?0? J!DH" @ l%r38 H.WO@.E endstream endobj 795 0 obj << /Type /ObjStm /N 100 /First 904 /Length 3711 /Filter /FlateDecode >> stream x[]5}_PTڄ*a T<6k{=J{&$qf&E2ݭVKWG^YIũ^lQŕRVΠ>BPʣJT1$bT)Ϭ$E3jPƨ 2&FA![^zo4|5&De=(GGBfc8g%-Dhm`tg+'@TBNge^9bp0 2.9A Yy SwLG“rN ne0" *9~J*x"YIEJ'^:sNE^姠 P0qF C2%&fT<9<&A5(6Eˮx {@/q~C~JŒ0hCA=0}INPxÌD&dQQ3x(iY z",R`u)"Z(`=:̩g#K.Q f;&(eAL:ʉ28, NEĄTT 1\z˘:bOn>Au-|줻; 7}?_YnOa96;/6gnAwv1l6zMgۡӳӧn;_̆t2]ݓ62N嶛1fr O5lXLϖ&lۭtBz_&' G)08T>@Iz ]-lj  ]29k9k|ܪ۷Uw̤҅}CEh4Sa^w>8 ٚofi qc B,! 4!JIngn'Mt .q k?>> Vc@jZg .=قd|swm3Ρ)<Ϸ_nu݋/f;3(aO`pr@Kƒ @~pzc4DW:Nz{bl;#{ǰNxhe6W@nΥ{N\NPt)?ћӭ^úvk @piw⎍68;6"N_>eUWfu>m7Z-@tʅ'C=$k#\##۹f,䂎iK>F6i󘶡k\ۘu@}T[5cX4Ҍ0ȶ}GfK:Nymqmz:gqxj΅M*}{ .bчc>}YBswۗ"+_-b>X#:7f}lI"."-"-kӶgk]F6zѳk\=F5zq۽+E~Đe2yMKYjs6C6c5fLM,oo_ 0}`WNCӹ0a+j뚨#t a=p}щ[GkPuZ}R0;LA:r5}gls (`9`,Fa\;X>xmޏu~!EhU7 <08DK`Wor^Av\*H[.!a1`Xt7xC\!/j8̱G6yF30{޿0O׈+u{z]0]qmqWU0 q-ËEܟ7OO> stream xڍP;0kBpw.!xpw $Xp 8Gv_^MLGt54*,P3,.R`sshmAQh@N`(D_R SgPtpp8x91: M]%V"rB{8-g 28pH؁@S@ dhj P g A/ll/jj ue`j '+`;S;П4Nաn  A=\ Gsr[=?  pyl BM!`%l (˾euvwfB:AM]Mf + 0}.򜀎`{g'V'~y>eqvB?i#|lެ  ,sEسiB. LE(,Avvv>^rZaC/{=d 8;|oB3%Og1O~|G;@8?  eSz,g$%/^N ';9=èƿ| P}>k8kA܀u(& ɺCQځm=2xnZP>MA$u Φc N`w hg)=c`HX8G~6! /|Ni/|i/|./|c>_/ #; #; s>'r^.s|i?^ADkn%HXGEhSXa &1Te:^I$ ta-m_/?z#~NPm~0SnE>;(QCLʢ!oӮHsMνtq8dv[u C$Kf4'BJg2$W?1/^e=+1Esxqx.kp:uQ^KV$*.Z п-~{BǠt8ntG[-;-yW0MEB%@q&)L=^ƜK뎣v&6[Yq FZi= N%,e{y:a gleik&Nᚇ.'X!h0%[a׃MN"W ^4c .h5$sjTVGؾz۰9ٕ0'x̦o]]M y5ˑ?Jyp}6utʟdwr:;iQl`4;*$P:Qv#^]a-Wd㚰\J7M ͋;59'] 2;v E̐TzS$4 A+_tr7.aǍ;辍^XRNX\F*SO|lF EZnsD!r:eKɟ&WRU[ ?SN>6K m=NaXg/}y&M:ΈG2DMQ[|>eNљq ?!|t6J,< M0;ȱUj8a ; +t rZЗbt?-괗*'`]?(-e-3fX9cUz *~i*zi<&r4z@`Yяi*ݝg.~ ɴG r |*[w_`ƈ e9Ɯˊ jGqkg'\NEBo boL'xTޠ48X+}[u )= ;H?pٽRAy%lC\-jZW^u:ͭT/FYޡp1 A[t:LXR~/‹4Ul`vq[S|8qt6c)avw|t n{*]ZeW!E HsKٛ'7E xŦ|d\6k.K ʥ'Md+ǃ{n7ACڙS@}@Qp;OZBo.iԵS3WZm8K+frxjƹa*aC,q=m>-۩qf#ߧrWI52\`t+fEd.O2~!*6FšqukIg-VbDa)S"h˰qeiPIDLB+1--1exŇˏS?~-U7tW#j߉S[ɮW"1p>xϾUZ@cwt=ލ3Em Be'UlH`V'Js_G#*\JR+KHYQ4 oW^31RP\˔NraF;L(d˥`uKU8 QaeC](^wi!e|!X=XcM=;K<'Ɣ_m$tA=qG-廩Myݶ(Y65OH\\5&LwI54 />]'/?ZEfS WʝRX}CO"Xlt怂ܫGQ4%-w YX4p`Bq 'lDz_瞩YA[I͉@`sRNr͵γI?!siPײ- E=+H]>icr1_bku qZ{UxwGﰒtG{"^5z}/#гaK]5G k׉nrgeOF1Ln\9fzзN뻍Ьع[8j"*k|Mn>wk)++5၌ W@S$ںZ  mqa)C)qWX/qq!6`{݋re7h n) ryJqKƼ#9`Z-[ᶼT> %ww(<1jQ̆ 1wm'cDEq\$ @ґE/RI\ռCHdGB<$Ŷ2ʡo bN ijPmJjE'4ROZKDsĥK+3B檍+?z{`M)?.iY 2*G 3ZOK*Gۙ!,){F|`TZBeV(&z޵0qQC KpW7= Uzz<:xbI4`5xa>b#;Ӈ9O};Fr~4-D:I^s]bܖ@P-l)>đh1SJpP~<ten/ (K>!<ĈwX{ A *}攘FN,є-^19XGطi;șV@s,M *yGNj$04p´#yfWT :|=߮a ޷}݊QCQcًˁ#¯zqS/bd*Y\bة-$aɞ88o&~68m׏oMl5lpS׽sGh Ē:$D*vPt@j`wja,,&lkkMUmFodX?Pi†_ 'N ؊&zZO ۄ!6K1 >ĉb>hS.5:|p(%x;yhWey鶷o=%B Q2ή8//M<Յ82#Y'ݿG(ڴv$t٘FWCɕp+:&DGõ,:vT/jk"g&o5CsIcBk3eD^|{]T6)_!?;TleW_͵' "(Qk(jvCIF­ \u2\J`j)|織ysk;~-1C)(e9Ҏ0GQ k2 މTl%Ce0/Iw'>d-maFr3r6e8Bi8}>81e X@Vᄝ~4qzڧᙔd1IS2k\V8aa0ͺK$-i:J-2+I_#m浢FqtO_O톾}rB^v>"DxyՆp&5Djɓz/QC%4nlBi5sykF,6^H)tw 82/39$K7쇅s5k8,̻;'աÌ ` 8R#"n:ɯU1 s^\;tn9`eFj't*\3;baX 2nDyzwQm.B0TIž!ű>Yaʩ2uelMin/?)[tBCQ21j'h| ͤӟsq{+{@J*+KivKR{F)9AMKv ՟,HH44y/.= ,Gi8Z5Ç #~P^8ûZGגYd=1jX^ |~;}k@c@p 'j.-B캸k*!=%wZv@]Ѽc Aط!z2j0N#[X&gM'{nSTEy#߬꣑<(kݬAWhK|mNв؛q5YW^0V$% K \J8ʐћpؖK^s_7' bQ\,$EnGT]d`IC&?Kn$ҢاˡaR N{1(=|t^wQ4*2i,Iy`X6|@KM${v6D`y){Mk Ͳ,Ǹ陬xAR s)5lF]eF֣5lu1,_vwR]/> >7I?oGvتwn d:h5I fPckhWK_æQ`@ƈ@ w(r MC[PʇG=[$x۠:FR0ac?O|0Tj[ ̵~*W ƈ7-ҥD>IׄHTShq+"&4Kٻ6IJKnjkf=j*F'$#yth)eA9$>O;6W'M…m[Ȭ kdBJZ1ǙMy$ŋaغ0$'VBܻ9p!)-ǣWx|o!2w' mRt 4"տMvHۄ|mK恇cF:8?o81PU)W1ʢh}Td<5'4ɤRX$ju,do&: hOKCnmǘ=%3XVSsZ$e,L7`}ys?P0T/U> }Y#\%>xPw3j Sa7HXFX" 7h&U -YN:aТ0u^_8!**MJCGxF'#Y9<, $&oI̭v+ Cƈay]ѵ@ɭ}9M`rXA;)T*!N K`AL^(2Mܶ 5!X[Չڷ-̰AΘ]b}YSv[U#pDJP3x7̗ơt/LBsO-i_e% .BN䑰GɒlY肀yƉrǪbP {*q$O\4E1.a+Z4e<L}@ 8kν_$ ogz 5a}CfQ-Pj)1pL $`hzuUPGm%(*n.͡4;r2L_O v/hvտ޶@coUp}FReJDpZcec&5 gזM[C,Ռz&u]5ԙٌKrW'z>?(u$9ȷC1ޛzKW߽>-lX~햊' j1tɶ\c^ Ƿ@yS@e&{*K}th@dJʎ\]nM$񙜅˴ 葷nl$bIKET-:ED# "N a#,BXۓ^#ABQf]C$EZ}QZ~c!0d` gɥG8= [M^oXe=ZH08 -^Ȍec⫭ɓ"dbF\}C'(AEОCȭj/$fՉǦˢF@djoh#hIKdO>PWTwY ]?mt@n|c>fߦd͕e!R=:"ϣ}^83 AS5毉!*kwGA#g. -JE^#ĝ^5qCGkϿ6yK%Y0  %]?v8O45DPrY]ҍ=wF}WUˈh}4׃*3ؒPzNR 뤱?8b;ىܹçy.Q:U߱pQfB:a"ׇ(}߲m)*sLխ$NkJ?m#6T@c/iIy剄ABXSZ HOMCkĄoJ<_5}9a,!s %Nr.z2]/ N^5X?VH6'WN wp۰,8j% UU@kXL?9gC2OF+@caS¬oVZC Nh*nFk9͹[)*3+܊C /0J$ƼoQ?PU-(\\;`xZlks52Ԕin%N|H^Z$rNk {Dsts} )Σ]m  NM/SSrpA(S!1"sLޯˬ=gy.;GxGa[z]+^ #ZGƃk? j||R_G@QbkW@J2hJ]`V SǪwq51~H]*mmqȈ%1wO#D"Mښk1)z9 eJQSK#qMj"2W\5k!3amo] al,:Bg:&guƎzogi$>h@5%̅3^SFB& =PӘƒ1{5@:KMbX}oS\ #$HិE }+U<[.h'BИu: ng Ѩ=#J*0U$_)w]krQ>A;<)j<7l\a-ZFFlAkxC2RhA tZSJt8B!XLR&_< G %z&XxcU/<_-a/߼ՁCvuNy1vܽm'!HA^aݑYH=>T~ރQ*?ie #?/rS: /7v)dGIi+gF{_L`V'2sF-YF,O||맍kkV)Ŷ 0AE}+ӫ9 1؂d͑wOh>+~JxmS*+brf9I8 Xr*Wfs\+g;.sWIlM\ȸ}o"Co'ӝ։t>Ws1> stream xڍP\ [;!$8#szjf޽k4$- 9;0@ZUʀɍBGcNq; ! ^e2@W* p s sr99CC2@[K*;@ rE;{Clm^h` Z@7kD @la r6nn@GWv0Zif  K%ԀKcGغ[y! jd ^U *X7_w[Ocmd uTݼX@'?@W=h4%: ' Vw}[g7WvW[?jke, '7W?򓱅,^pNAVNVa̡dR*BGf rqrr @. tA* vX=@7;ߊE(\\K[ 79 b_u[/1q8u,N1%W)%ظ8\\;*:YBڧ0} L~\E7x?.HO=_=o溻^*/UJ,N z NmRuKǡ9:4Zl\Gz]םSz= )dʸ_' @(C~E|_syv'۫ 8DB".zeE\/|͋㯞WలUv+_5M~s8ckM_ԯy  _^鮯k*5 ^u5a{mk<>@(` 0zIRO7tLl/)Lu!ɔ>mYk%'&Ĉ$͎Ƿ Z3( Sǒdl:{~O.~zmJt.^w5Q+}ԍ1 .NW`3GDFČsf'oR)#Owݜjk1-95 AҘ7?r↗4 aloTqi{<- zSjzF$pryZ9dwO4ډЖ,_z)zNt㈄>O:Rܼ CȫXA,|.qTk;\'캩SgW{q4z]l652' zk8߻kl滵4T\Vm Ҏ‡jzrbw a[m}NBM;/~s,~lQ-P?aDj`yT۪$2fޔa(+N/ N[AM˜riHfa&Şg$16>˹ݍ١O& Goo*p-z0P<~b` {MonǩtLV @dE!CA ;hBǗZGUM~t$Z3"ڡrieǒp2{ 8o$ڋ lպĒ"|(ʈb,32+{toͫ <^С2 8t-XBy S"7A)ڊL-}gAk{ۜξ,(<\c6>q3zm9>=)hS> -T>夎 PN;Xbhj4Yd8o[Px̄ Aijۘ'?2_SRk%.-ݱɓ?orJ/ےM ~4uvLcΎue{.s򻥑܂~'Ck$/1b uAսwˎNB\lw+aOп " zon]HkiHي]L,{D͙H7o`e Q"d3#tG)hz tD pd"9Z77ZE|=e޽^[c,~ΝTLcϹ:vFWY|V<>,¸ 5K3sI&&Wƣ4͖=~ZAKsDZ_$0yq]!2d'B;a9f߼V'1`ŏa9k4/,Zom{1ZE[aN5*x$wX,c-s ,UYK[J-*y ^KFumV_j;SZA=[ 7on!]GkFj_oLGJ5 MgViY(±EqHfWr]fD d3/ٵaq,l|E!f 0kQVH&QosXJ.kU.Yvn( ɣ ԣ2.4y O!}ؐK`vx֘#:mNEGKiURѱ=}}#Sha+`i#:td[X}1phjWjjo*dcM \h3i\(E&&]K1SJY+A^-f2࣐vqkϴoHYNUwl%8,nhp*P̕#U]H v|fBjZzJ5 _N t'S)npۢ.nR&"EE פVD#~ xGuDǁϪ?Ѡ\-l`O1bMx_ÏOkKS<95Ø<:,[TBpQ+('jfKMtxϚ94Y$1`Kk0]'+u(pGtM>¨QJG?u00?oyиGK{,1*b{9 d>eA(!YuH΃rNEz#e|Y&/;K`}Hny.I$2g~Pɚ-gSxoYFbȘ=;/很Bj71㢷pdUB=T'z6wDtE`UФޝ#b~2TB8:5[:wĶC-·?QoYǃ =ghvN:~o[,F3L$`<pv\ kBKd c, 2ۂ#_`"vNM` W;=! Hw\vl;q9 E RE\Tr؛N hs,wi8)gnMCTdDc&k񮸞/u'U?>DF?mEr&-C: z!TNmfʺ8Ib,pg`(qi]1'gmqV[;7?(cwo L;}& j]ca~&`Twh[Vs*OGB(R閴& C|pvw署\2UTn^mGe+!]r=剺|q\;ڳq] e!L,r%r>b "w@^{TgIsK~tSᝣ!}6%=K:nw\K OI|1Vlvrb<:dxv]PgՕG1U5]&ۭ}2WgXl#Fʚ^xYG - Dn)ꋂh$ *Ͽa\d0aT*C$hek2g84̦Sx9wV[gakU |e]%-YU9's.Wicr)/%w c^BHi`{! PtcV2?O>dG^O ᮧE]#UvznO]~#!-{>yluAԮ,40 CPGb;7Ȯm;'".ZH@m' ެWmQǍOLSL2PB9uVZ7ܕ3mmH4o|Hݙ\67|7H<6'Y2^LH'HIti}񚦢VVYo\)WUP-w)ː|}ĸ+Zh@4OĞs@9p؆Σ@9^w!pB3FjYE ͘D(lfLCY;]y2O%sNx!>vC/jFk bH S?J>*@#%M.y&fY "w`:W -qz:B^J4Uz銉;ʉ +za Q&BqDMkAI7:NgsRϵu暲E@Ѹbb8x0U+8i,X"yǀP}L4y}; ]Q M8N/=j0cqd]JO1pvxGL_RT`;M=x5v -Ψ|1NA0 "a Xhy0(*{ٺE&e*_pPT4Mw%X !II2@b6l+> *s?x3[s$/ TiDm톓-=Kk i`Ѩ=7+sJ[#,ݡg`:ɰ)}Ziivʹg۱t͢ۀ_msH^,ko5"V>0:r&1=ڏj+|b_"YmXp_ַ%Y%5Gϓ |sy~\E*S}quNn\|!d ~2o齺̧8s`ry"}%ITgVM g_caEߦwmh Ѕ kebB'X+ +PNK"m)C {eLq>8GipP XLq:%P=8ZmSʣEx+H" h½.xGЦd7]zq5nKoޚ~ P{&?j0wx"T`6b*+tYΎ/sD3TX/tb^xr|QFdY>K\UOs`ź1`#]wt_4Em1%rwƯ;J%8K-,cSяdGQ^1IΓq9˟@C"0F:GWq,ZƅSe_Cgԕ.f/O O `K`(_d0NiiyT:?c)CFT u'o@w]MAeHpN j@YE r|]n6MWDro*8d\-oIKIW?xMp&f462b]AE|"ɉiron*9tf O|߾I<E":%Es7٣mN9U5!+˜``Rw@ B?vqzZc&'5KغC*ݚ 8Xn}V$'_ux*M.wʃ(R;!AKoܖSy4>{]jl?lm0S]s#W8ل* m1Z &q~0ia )b5-@՞MD@U!2i2z> bic6%4CWd;r(]Jڬ~\Y2Ԗ,){pAZeDU[FpiFYvƁsFw1gTL/F-g^﯒B,C( `N2M{qM>6tv"ciH(yA0T0x|Fu+} !j]d)F> c_~1ةզnIR}Km1 ؼ5-a&>I@=.HFEmk [W]= y8X1Fzg7I9-4T-Apnt` 5[ċpTdJj [}55$e&K,D=Q>U/ XHkqg}AxǚI)x!ɭIVKTu *3F]w~L~i=wG0t=YCU+!;ZQ8:NVzX~/^ꅰn_g%oBM]ύJ߅T$8 ?vVh{87>D/PV9GVl꺯 lɊL1iI!|**'V"en׸Qg7]sѝw\bd-=鹢쯵Q`CfOK< Uahy&vjk' CAjuhJS*->[NMB RԄo3ItbH0J^\ÛD`8ҶkP]ޚ{5ה2q{ɐQo4h]5>BU;B:?MC-:pDgtҷ7v%DeO ݵ1SA Ȟ: r0~9w͆,~wQQ1L޳ACv՝lp [ ܎aWlۗ(Cjנ{n Ҥ;0"tJD.bO V1g-B)4UZ Y&:d@UxrZoSk f #JD ʰ@͑xq`B߻tZ?œeZuII|RIbSk`ѓfj >?"dm7-Bs/A~wI hJh޿rf9 tr"LfOw ]8Y% QP01w'LdƒIH ,/;J"$6-R-0T]#H[x;bX]GyV苶2#6NDS @[L)~9%`:#&P*yH D>ѻ2$-<պ$ bRgUY4>Moc'nMfZ}J@J8$94Ћ ~+t]/14^_|5>ظ7Xa ~$oE {XS%I>a{L_`ϧs`rm1'ϊ!~缟q.A'P!IΥ\UD0{$ߦG,NΤvMևWIMf%-g98Xf̲ 7ݧHt˾ͻ+,2kI׊ۡ(j=%?+'h>W#ewVJ &k♈6 PCö::)KCcBn^ILceD;;4!czHA-M!}ZU;}6341`U2ERRA`GWxs fF ߗBvyUJ|XٹN7ʑ|$S%Q·g2NnEwz F Q/B+*d,)4!'3W.߸6^46INA /''r-I)ӕJ%vϿ!x~c(&%w]l!3W*/罸 X2!;5C\_7G={Cnq$Lf>M)^-佝[Y )ЂGV0TK2F;7D_PL &",u}-Tww$7v`2dU㘍˟,cXMђgoVH"49@h+,d%awapu[I_K-yGc!c7|Dۘ>'*z4#=Wm@-']2 '$ [[(ς5ei=H͚mo%[.ܣ}Iȯc$uT??zWj0>aߞW> LJ5x#ٖhoα([~Qrǻa8;ے%1sU N$xk, uuY@ܘs5ZG,Yך"x;(q=]Z-e#tZrQ/IA7alI9n{prƋ}&`4 g&ÐTc̷Hv^y!3GYK8˼Q 6٠wTCanƃbR&tݧ(w^ͺGl,c݁o:fr-^t,7VTkIk--:Q:,,/~\ud?L"5؄j61HW"F2RؓD[&5zjr{kq6rӿWC}#׺z8z83yh KEwˉ=^bE QOKW£{}]e <\lQtd`4[ "'. 2]gz!kaqYau.Vgx#.KuwFnC5rqSh3Udsqٹz;9fQ@Q \iZm~w9’t߆( avMx^F촀o=##A f8ڶk[:_#Xf -Y:8Xz܌3"DMJeK^&]pbL IE6 OamCZ4nAHdKe?r~a)*hXp+(G҉LJf|6HA>)'Z'~'S43Ζ针Q K5"O:a&As+3-gfɣU[U`IVW D-Q~#ax@^_3OIV֦xb|H[=)I r>\^fRn":zG]-qqUa%w*K=}z.Yfې\F-h")k)v] #nEP̚Q{d/T Kʭ~Sk$t"hlw2 z$a:.Z6o+i7F ^)PMj=*I9 :[dw)#pML Tw͐e :=ڝw+Ih5N@*dQy~ś5[IzUot"ISmZ!bKxޜg݂#0W{Kk&BkLuu / .E걲o )$2wBBUtO*ƍ yq trllQx͝LR9N [4)ͷ-x6p:BjΈzԅcm#q'  jr>9%9IbJ&m'2Z ?nPhnzS&QvGI?:لy2dǝan-*00X@+(8&^;w a~NF|H:ԔAU!+~.d1y65v6/5CN lS=/}\fdzb-LmQ>/! endstream endobj 885 0 obj << /Length1 2173 /Length2 15430 /Length3 0 /Length 16726 /Filter /FlateDecode >> stream xڍP Cpw @pwwwCnsޫվzwMI(jjg ufdeb+鰲XXؙXX))5֠)@N`;[X;o2 󛡢-@`ccaΑ trv 'DJq;{G[ИXyyvڀ&@["dh P3='=3Ɖ\v@ S_J@п1!R4,NRۙ9A75dbk re*A2V27ܿ hbbgcۚ 3hk! [ .U#ى lG¼YTdW}`G[=}Vvn^Af`[Sh3kڂ\@y!,,,\nbW {Jֿo|fo4@>`3pvtxS` 6qAfov豼+M󿏘YY\K)W)&fbd0qXYyܜ,?fv֧74]o:")k42mx\-P{k Y_3mDmͭFdv6׸KעYmA*vN࿮#+ ѽm6@o)%mML26N.6Jl/ַu4=f&[;79#_' `K/ `x/Y򿈛,e vA0+Ao E15AނWqa\B3b&4G iג@Q_FhS&[bÿճ:1븋YT;q=?W̦; X9}|M# yvH;w˫H"q^ݹϏҶzWO4&!Ɂ#YN2*1_ ߗDO)ڧyd$l(w/ncAc%xѴT4j'c =*IΦ[{1X"d]p-wU1KMf~UtB7Q?U2˴JlCpEʲ r S֌2v턼.9&\Ybd c`G|rA$ 4&]˞dmħz-Mm%&iS=fv TYQ k#tPR3u. O.17*[CqJ. .%1sCK9=* |I`gw'<5W>lyk#Ag:cZ&5S@W k1S~e6r C#cyB$BI.$JI\3nkKJC:o?n ]pXM\pMDml}g34GyW_񓘴n4H(~`=o=f5A(O&߂$ y Fhъ['rR(ϰH'ɈW/yܺ>%qG|-8BXNK_$tz*Sf67j+ձėӨ9a~Nw}cl-Ւ3c^=J0cֺ g_>'0u!F{e,H/b<˔ol3b,ȶiӱR!/.asw$sABFaT~M^2Vbc2.9) bǪOt/3Q5zHq ^9ʴ\} ,ž%rz. :-G+еT+O+]I2 #A}C3fl:\{wUcNq?:8U|(NH[r:qR\vYXh,tRM($P3B-O$>urNm7лylƴfhuUN7Ee* 'Q=A^pMWlZJN?c/:)ł-.V(6//~[&Q: h.cC/禖i\qc8wxZ[CMŸ6@jchw~[ieQ٣kol5V\ 9Ǟܜ9x"'O bY#$Fe"Ub#l-A,\NfӦHx(YU1Dv@zLgOF )c20;f;w9W e`63pKgf感]u[Oƛs7q̅1ivXbGKܕLٜ%bj^ )6;^QCU`Rq#@=4}MF2uG ժ*2?Alw4io>>nƀ&to֚/<-5 /R7c] s):iv%ўyT0& )w k~#\Xiu@oM;F+S4oR}l[}dy* C´s||J12fm:7f" b15eqH[}OixY7`5-& d=Y :cNE> 58ee3=5Sc/-ROY럩r}Wس$,>Eg9 <7h'e4bbu6S-[jJʗ )SF})kcmb.߈0z'!\H8d_ZYמzRNR6jI+3C`+xT c^:t,esC( G5܃J<'^ !9tӒ f lv#f ◕+i!/-4̪5tgCLp?kB3Zp(r8$B<۴|qtNS!G o~ѶmtV8ܟQZT}mJMHUܧt~hwq۱iGsTu[J]Ӊ !5C2o.#m/a戩1:u0O)ȹƝyK<:_4/Q}i |Jr kD_7@ }ׅ֘yPa Sݢ+Xw2|%/h4TB_-fٚwe]5w="}lPzR .^4^{otΑث۽>:tSգ׍ЌH߲)tmcRVLXMJ#jOoR^qkzEHԓs IxK-(l MG%v3nV1 YMQQFd]z>0ܔ)VlVEnPcb7ރ*Kpn xtD?Fc̀E}IpP6Xu4*Ɋ(\+AZįDb5MYsiUf%`+@of R͉Zc_ӶcL͑Srnny)K^i#;LOz5}%`Dgwfli碶$ө0..䓪B^9=i,T"nldϐpL1DO(|ʼncH|QDtn :{P|*Ts>G&4XN-#.:z<-ʄh{M~&_X 9U@I<7c# ҧ^mfޑ$7YOq\ ?+Νr.IZ'\hW:[Tn`\߱qUNzC z{ 21RUTpQcJgdhH4ZcTEC=kf/!}Nhؼ~k# ʰ"T;t;V}OٱA(}1:bC;g'#V!' GS;E.x95.*r)6!oZ@Bd>ȺC,4=ThG.~%p*v*腃B8‚]fT("#I9hr X5hNnNRI:C60Ǻ{J.G<{slX'ب oDs(9ܾ])„&Coe {`*J1)mұF{s[ΓiG.ڹ>\`_uh*i j  9cU~ֽC94Rate͆>ϸuR_Ye#ֆr+X;QO6n'3Xzo2%o0Y %khAUMܻ6 ~'KM尦~g=:%2:?l ~6-a@^ťI|zBۏȽV#}Cf!! j"' qIAxX4Li3_"S:m4g8.٠5(g$\g={Fj+j,qǃ/<}TR pwgv&y'^Zd9tΡ"6DxCnI 0+ %ѥ[񜆔|ɜyu[.(1y 7KjU [LLҚMl# g~E`@nboj AGHO=0Y:xtaqI+I2?/j IN"c0+Cc`b> eGleRX{l#'c=)5fH#9{O&xf Vp,*ŵ`AD;:F=i5Сp9eBk$8r08):5g 8ޜ̔/o|,!0ݯo[n=jh5!L=;dXiOjЉ!/3rvC9f ,Tۓ{ֽ(8v܂ZLjQU.5K/P}Z{=$AbGikIe4Bu886XkLe g]4f"{>n!tKanS[ $1fA:ĨI&h@%:#<0{j@^#YPoW Ϫ{V+LyyN{eaιZF=CrbB}{Jw_5bѺz:rᆴiA3G`o|)]Q)yGlFŠ*;S(YTD W mD2CCA6 i)ב@9m/Ӛ3*f}LL)C9l[xc_c%`:ߜ2z2ˊs\-!Ӷ83QZmGUpMT߾{~s8/9 K_0Y 52OVilỳ?k!Y#!w<ᧇi{_"Rf.>n]ryZ쫬likw͟|("i1Zw=hǩP| 4jF=cw܏wU&0g`1VFP[)wՈZoOyE4Z&D^7\I qږx٤g9E:A0ݴbW]# ~֞d~@)s)RqR ]~ﳛp1Ǡ=Eu2=yX-שac:D->ӱ{~_ f8޼[G52֒VXq, Ǜlf+ĥ=JڕlBUgbjtWSZ' A0TJ$V->gF"% ?A~)"hlg$r aW~66X%s؀J f6Vb/ ˗g8;+A-F\AWFD'Ey( "ԗ4W)x$ggp ~e,b s+v4hazpUO@=Tk&G[ŇnA6V_WXOQQ#x!>˰!Ŷnei˩=Mnٳ4˥vMѐ#):KmV8&]*ԳV$uUƕ}p<gR͌h0_@ޓJp͎gZszv B-#]c=BJN]´_\%@z{}HC:8i{O ]TԒaIĈ0Dʗ‡ ڏ"/`5ׯ\6r܂VUexJTP+.8KҳZ(7V!a~qٻ]jn(.!RQQU\joWQ/ǚG}&7+.>T,4hkit{[ DњJFdz'¬ʝ$ZMԫ]i%"sNTё^iŧwa@a(JM˕ͻg'nj _'؜rd1 Z?qqwN_C q?ʽZ{|MΎi .:@E~}ASJ94- zHPVwx  ^j;#y iR<FyM? I_U(B/\ SJmйh唶c5.Wj5R;<1'|rI Oum@ naY2?hګ3Z/jmcy_(4gH(F}v)n<̓.T븬7nZn4`sj-EwŠ|-"s@kT}n޸mu!PϸA+(9xHx J xLH.mmy"Y JP%@Q)G6;|~%7_]'z{&}XQqߌE}S͇ŭϬ<)Έz1!4HGS^iC"+CIq%4yHx fTnӺ Cù>9|V% '.Jg[a^-dCaS>RߚA=G:QH_{Cl/2=<[ ݖ`mdH"`>BCUPy¡/M O"*EtlS% W8aѽ]]m$ $AEj.q"_ЂoT ~Pf |>__7jϜfUdh<-g9$IhGk%q7&UëHZ3!8bQpGѾ ]SM!4)B %T:*Fؗ챲U|t1@.sRJQhr_ی`\w>(bJKc;~xߨVb;.,߭$bD`Gceh$ryHCysXP}\Q8FG:WBj"%;Fsx:*7۶))𱘨|"E%\iqjk/uwYy/U m!s~Y]̜|Vxv&.HyBl\KG6E mvr Dտᆱո~[uZamXx%,nH~7hLE%ʉ6}L"*ͱs]ѻ5wHQ;:b n .v~f6L?sh{!~@gܨ2*H$D.EK9ꩁ%?^A\b|<[RCU|q:Y=?~TՑj[l%2tSͮ$Sg)rQEURZ!:BeOSM9a㭰5y%c[_2<>퀌]Rqo1GxOj`<~vUlj%L1\m .2ehmݎtc.XN%hKW/G Êj67rx&{uA\L!I+ y55XK&&WDq6vm b9YzEπ:w#>)P XV+9B:`︽<9_(1EZkPɾVK*!AVf#ephD>oJLD!*Eyf"04iؙx87 ~\cdޢBEAr}sYFNYO DVys!*ybA&~"GNwMMSJ+xK}+Knޝ>-c[Xg-SK%zŐ5Zp[DC...uđ ]j!}^{3"HEY[J41u?43|Sn=DrBe5vK_0 1qYrIHDեoD9$LֵvgD4?y95w(ûKR4q7(tg\W <m=DspW̸9 [US4Z T Sh4dХ.;l\i~sj0$˾pw!2.Nh$ը}5 <ڢ,9>UPO1(Ffӕ;@!r X%r|7ޘbD p#bR%lL/ޑ" rmm:N6fl˙R 0ixW<ه{e;3"l' LͽND=1`8|*'H[[0o+J̳ JRqL̔,Yv_SqkJ`ŲrX RV!&C:lO-UgJ#:>ȟ8iDsqCdְܦpzеgZJXw[#MqC}:ya'Ua)q{5ydvOW/MqY18'8TSZm I3~RAIfH/_Er U*L F"?}D`.5E@~c n^cf@tsPдE k4FC K;- FܐLː|-8=WPX "xⲝ endstream endobj 887 0 obj << /Length1 1466 /Length2 6811 /Length3 0 /Length 7795 /Filter /FlateDecode >> stream xڍWuTݷK.$g:UBFJBD`qf IAZ$RZB[R]Z{g9s~n}C-A!@qXvWHS %A`?7a\(?0j݆bqл($@(* 0X?@FpPH  퉁;`q+ h#Py mH]( 0DaXTrb bb c cSH:\`7-]c_Á(Fp?B(;; KrE0CM@A3W!8w2 Ez‘;8Ѓ耰XQi EpP7(~7@T P܌Nb. 8הb6ZizĺP6_GD#H[_غŌpgW?Q8>{ ee0gA"Fho7n_o4 Íp/ o Ÿ|E!.`0{887 ` ƑPe- uE* %q Y)ߕ?;G&aNi? P1`܏S/ qE ~#_c8O îXp@7UQib8U qKR.Vq9GQ._w . Nl6NG!NK^Wi%: izRNgIq괅y&4@ Daq)܄;ъb_?M9oG[1?L &. @ W6 Nل?KPL~F(9՟W>IHQu<;"3]Vgu[3TS~(1<}nK"Ɍ `edE= ݍ-WU&GH[{ݏGEWR7(].>)rJ*P $A"''IIԠPZ22ڨri'eGbT(>|%&Z(ufz5GVuAk~".OZw>d> YӋ)b4+Qt*ũ{L)uVT?]>W ne Y`K4r^X]`Hi$981[~`q)'P%iCW`V_̱{ޯmZ0tDEh}2%j-m "e"1\LCƺ/'@>;8 _$lk1Uks;cPo@8wnG'O.Y0@w{WT K}'QPi}}8 $۩!q$`;s[zTUI>>ukPa/ ](nX[o-㔹'\ʬ: bs|'_==^aS*v]L %qfG[1+a 羫mAͤOuk͋RvM /8,m{EmѩI}dUyH嵜PuM#+\Olj?%k7V d f\#^P">E>NiqT"[&d(a7M꩜q-:N*yvG07 !;Q]M)AUG0+ڞdGj7oLCEի{PBН߽J> >[vS.Kl Q5zl g $ALJ_nV~5' ^ZIx]}wxt}[iԍ]a_/t>GNP߃c4_ aPKx,ÚַGM 4dTy)^ -V(7"q]tN4a1K*`&#<0%D)f1f^+QdG7Ahh'"yfDm=j~Ҽ:.y-T_oTqڛtRjҟ(DΪ͟1ū|#7hsh6I8^ӆvUoqjӒLXހ~ O 1Q 9l$+I9ʈ|#3:+[{fAPX w:ˉ=I{a7l+W4 n;ϞIG1Q;=ٺ8:_7St]~ dCK;HZk}|kگ/ <~Doi-^9%:ѯev+׮a,GVg jJ]o:x-}8L#O9U1!,n.5LuJŏ7G[jMeyrTӤ;ڪ_vHnnۧ,ٛh6t3U~vh;=]uw;?K`s5\e 3|3j zsK1)lHߥĻ%*bܴD#dOJ>.5j# 3Cr?0s_g))ow[4!ֆK{Pͽ3~SxlUo!eE,(ѵڸ,"aLFӏ"Q6WWZDF>u[]!nR<|]ruiV5{\XP*s>P)<&OGN*3B\B2cm"ŅmvYL_'YȴVhZ~yAL0~Fm/繟y{,f>d$z]?bIp*d-トv^ /X)Dڟ7tϘzuF4f6&ؽ~g[㑦$6&d_%3}+ӪuSSjG_c ̡=MOrZˮoYz*b+w6Wݫ=ʝ횇w=.w>owȪ=pD;Y(xx+Dkg)Ŭ|!Y9iVk ifV?|mK{|Q%;69]mD5iKHҲ$|]?R&LI3}\tl) G:'婗! B.[#% U{YۀJ4|Pq] }Hk$?B>؊5כ€g?s*L٬".|)P#x~ ϶nɝ1pn◫DWjV↵f}D|Y2ć-o4S}KnMPCb" C[l'TǍ!!C0:`߼^@zK@Ef6+Smz5u4߇3L P O%TNFs iOUgřK!O03YqKѠS9-],]̼"nLF޼s>"{ > CxNOO|,R?pKlؒ }wojR_Hc;$ ԅ_ϊwW4O*8Ơ#KbE`JP@OMwZөu6A#Z"-G7ZQ>Jm'7MB.xWdf\7L ayX@ ڒ*g͵J*ZM\U~d|+{4YDR`_0~I'=!T w^R@#;&IUb8S9kogfWIаq|bdwU5S+<4n%H'p`a=15~)wD@wJa2S,PeK[K4]' ܾq1eT)sIcN ɛ} h/"[9@ڶβ̧˲QX ) :K $4?tf'}=~S8})"{wACHTo:1ќ,|iKY2߭^JaBt5%C!6K%:m~T &%=[줝*k1W{fjJq ADb{a.G|lSއ"3,鉗]!-<;9&i.gz J5!DcxZv4*'^'td!n@F˵qy+w&}Q :>z<췙75nqwF0K:DYDG÷4~t|Ijj*%gjlO΂D1ߌV/>1WmdG _P|IqAK\}H8鍩H ),s&%j)g ;2` oXN/]!nhI4u!@C `re&Ebji\ 5P-=EFz8es?y[nV/bw zyKް- o\9?je[)?s?n(1 OBJ9\6m(ܢ%އ[ XֹLQ?/^tQ%z«YcdSL^ Q>>izȑdGq5܍_P)iUM=>l\Hk%BII#4)Վ22`pc/YJ5B M,ځph}2eNQ&'Q9tXMAV@H1zJJ"$C}Nۃع 2B.q9Q8] 8(:t}. gN3lX /+UE_.r X-d*FNsܛ#B<'?y\տڪ&J&d0)ʷ}ņ!Lz} ?<ւI,QX֝|Ƴ6i;-7Iv#ue$ KFJ ޤ+͵6io2qC^L9JLnxJu۰V1w4K2ws& P7{n^K9_vS>2׍C'UI\^awٔDHL_ _[Hޔe`lQJ}~GlTj>cL8/8)6Z7~b PzHJzh=ƗiNπس.j`yӁ+jRYW=:5PEd/g[=<6J-R3WZx<d]yδkiHUpߟ>gKpIG endstream endobj 889 0 obj << /Length1 1414 /Length2 6124 /Length3 0 /Length 7090 /Filter /FlateDecode >> stream xڍtT]6 J Cwt0 0 Н"4"J H}Z߷f{k9us(CP %[¢"D0;89 CeP715ꆨ PRFX ",,70@Opzq"<0g><$t =q#0AaP?Jp˹P2BB oAY CP$ M` 0A8|AH(&C7)>p ` 0"E9Pr'`';`P ! woM> o[4 FFPn+,. yz*# w8_y0n냺 Z@oT2_ րA!0/75wj vozn# &".! kY7@~  $GnR7H_w*% D" >`I}<<~G`$ƉEr߶B`iX6ʵ>G_Q<sd<5K匡^Uuc,;-΃.͎/Qng"d0U 2wnQ#EfXL_Cw1F5:If'9PL~&O>Pf(x7I4zY$l*`TĻ.5=1q@{t3eO'Y<5mNLQn>\$j!]p;slo;w+U :1VJR!@;dfR _MiDyM|.3tB>5ZridaS;dR2&urE&~Frz{bQ;Rgt ?>d ]yp2شszG㞥mB7dꩭ~q Z~R"[ }4+reaVOQxh}gVa^piӌ,^ϳB9cˁ \Oa縠5{~. n?1fF~9(0wVsnɌȻM1>Gȼ|]( M'q6YBՍGdo%ɦ Hphй: 9E jJ( 7z-DqM"3.)N_ OXjuL/6K}fߺ T\ Τ)$]P`)%$&\}޻c6U<\H|`X]{ Vzw/ڰ3nvj{M>.fSiD6CφB?H@ܯP?gsk 0jԩ̦sۀyb$HuwgAJ*3K3[x龳}(JhNQ/ 0GP;'g-ѩ3?(+zgMN y*rܮ:ztp$\U`HM}P]cR[}$[Wt/npu+1hVDtRO^kL1GTJH!x"N2TJ&dϤ˾ܭKU΋E%"+YؠǎP29m(_<];89xac1H?(lmdz4*B W Y#APp<<ϯN^3o= h$7qy >*jgC^{_a vHnQaަwV&h]Qpn|zD Ȣ ͺ.+EqLJmnHaeNnL6ՙ~ \~1=Z^BɞS\Vƞ%%=m0(3߮Lދ]#-!p!KMzh35 )|;b'.-;Tm6=PQUp뉚f kawʧ%䮿 ?`SrR/"&qW([uD`ݶ~?][u2GƉ’Bg~(y //A p M͖7ͺἚNN/9BFދ^47vIj ; O֝YsTM`}Agxwzh&B́-Gw ϕW֗5*v`}qoaPٚHv(d/묣j᷂cTFk$? <rP)O|1 U9( *^l?yZ"nMXCkL4s^LlVL;/9\vE:bqGL}%u2o &A|C6<@s-i#Yv%mqA5iPCbQi5Ult8v?E苄i]+5~!1_Y > 8F$ UZo5/rLTْtx9Bv*'8rkHw@NƩ_HW% "fgI~rs mof =oPJҧ{`h#ym̉y_)6K@'8(lmФAD?SnzmNu ,뭬WCҳnΘ3a/0_iϒ@Î:vH>cnJɈ*AYۙ_'"|ە}|(I^ @VvUL0ZhEyR>sSӑzZI+n۫ޝ~5~lfC]Oo3vy;+IJidhCs'~Ͱɘ$Us JNr4v1pMK}f{=%#vC>|КQLߢl$0 zxks`[eV'3.,hqZcD؜S j癴JӸ5B9-}aTTy78Ƴml%Z_@U(C٭C"ŷ %^9^Ŧ T];Cd:鱊q ;H+*ZFB d=DGCkm;H.%O(V ^1oqi]dPukß-?FO粁i ]M*%>O @Vq ٓ,p!Y ֌tGOI^ } 5v7-Uڨyƙ#u33&'hIXum?]r|y S]䀮cלmS@TRΓgr2ַB gXSx] ^A^l^MŎ, (WT6 CWܓUo" j \.s?XDV8_ ;>P{-ʴm?Jrln@q9WtlKԖ;TǪV'xI a- zeY_]QGbˁ)isW(SmLXB}R*8uHf:Vt$<%8bC!=aUup>B/1P6gpFԸ,4/e|^ )X8j!NB0_$w"=4?7ḻ+N ԧ놨/I6. j$=z\9D'̻}Ɩ[ˡCp&'ݣtjtX'ʵ?jzU'5Yօ8ߨ XA4z,1zr&kl+V%:vbO#K<)RE<q]{У)xKua*kM6w5pE0sQ'Ytj/IЇ^b+L.H={)J<`O; -GƹDoLc} "BYr^Fj,!j& t7@NtfE5kQ%sb5pW&rfm|ȼ.8M$ZK"5C4ߡ!krۓX- Qo\[jΎ o 7}dStY' !̙bu&4\z5~|P~b*)XʜɁ*݂[}Zy"!Sϫ Nyv6_cz7[ f/T=TPO@6 B&2>!l @U_=O8: 2S_|l"]qߔ@ dRA^lj;*6OrIOmhꪢho&G u# T=tx%pacw|Y<S7jŠor ,WaWY(@PƜbA ӷ󁙺2>n/Wq)MoXr~ b`=yfWY3g?~ar >”l,G=ɣ2CLBwLp+(ԡN9pEg?$JB7qe~ԵlɲmD2~meq7[( ;Ľ~bo9_H|Ei d0dq٭63mOLTae ّ8 &DC]48 .0̩pui]mu^0pgowDe> 'U7δ1%ugFĀ2ZBXhV1#uk)c:GđL׌lp+_uԕ\sVqSU!>>;Ļ˸)RMi?=䒰>tiKVa 7/d깪 endstream endobj 891 0 obj << /Length1 1736 /Length2 4784 /Length3 0 /Length 5849 /Filter /FlateDecode >> stream xڍt<fQpNC^𕜻ss٣B6D_%#3٢-%TS}<~=w||Lĕ8[K(ڦ@hMD V 'qX?LTH$SI8,$I9EIyE@ %IT9{({")?p@ }wx4aD{)#Lpp4/Ί`̉ ã.w4$ nHp4`sBӛ `j&И0< 0h8K bH<@JhHc tI _~zBc;p3 Ƣ;4 jI= E0Cc`$ ecFjg8L$HИ&GaHsV"TqNNH,@{T }8w/h"A:a.HmF$o Id!<@H=(3RHL ؑA퐤Zo H_?F 'HK;:II= $Jϯ7H$C_%OϿ**8U\JZrP9a`eᩍՒOn?Ip犈e#q Mu+,N?GQw$ W  iB"+8:`kzc}Di!(%e$ 2?h0B9C|h0h,G@iCB Q IڢUqu`x<̓Bb,I{@z|'3$Ԣ/`;@Pl )tfT~#lIwDn\QH8 F`(Iq #)CM? U&Pf;RY'To(Ex<}1ҳ_M$ }_r j+Wt+&w7W^( ٜyc!L֮BBQҿ()Bb8գ*Ǚȵ9V%.(o8߷i㈽Ö١装e&-=˅ECjNG9%4Eg 0~ƊC t:M5u,jV?142 nWa5IKܴ(W|$oߨ{Y3(7"SxaiT??2{.*sEl >ZaӲ!X=.;YI.c._Ybq%0/D/qwr ntDRf>azyJ=#S_Lu0PoսuYy){Q-6l (LV]ai;Ewr tmKM^x1ܔsOn˟%A)Bu~oI_bs?ɒyg.$Zz̃:.d* Q9zzmIoP#T 614Ju;Յo1ʆTCF'.Zw_.*3`MUD!.8.,6-fPω#w7&cw%"xԄ,ePV^4Ehq;̱푼d CF>&QqM&)~ok Ǐpjr$M%hB. %lz@lGqA>$yEn,D@lꗲ7y;:];BxwQ/nr`rrML6R^dy{7͑7Z 2)O݅ ܿz3K*JA?+RtFArtzVO/Rk ˞&+_!Nv>`q'kSP;wk5B;KIլ<;&Ac^ÿԫ=Sx[k#]koȫ Rn/rBPS?̎4qxt[a8es@GQC3lr>Kj<~&nSmȇMZĖaaWFkNp2v=hhLC{I֎kx9MhW*( rДjb%ZθTb:9kl)0c_jkթL coĮ= e:|1͌^fya]SLP'bnrJSucfwx:ݮ`ө9-W qxX5Ks2=Om썛.M~u/ڦE@FR)C`.#=')gz*k;jzL>` ӃJo^j !R#-g]_8SY<ď"}+eRa\s5܂=aUo0*>sC2{WY]II'1JvJku悇וWSdU|RŠMwH8x76\[e`KZWd ۥnŭ cz} Ny^ԕ f{Wvn;ΟYȣ,4A5w#Ͷ^݂mN_]^BmoL =,7ʮQii]aLwEe*i;ͪ^9ȍ?~:bE5 [YhUHQᦖ]1w憬OJ:I-e5wlvL] vbK ~_7ϸqtAfw&u2Cxnnל[h@xg_٪MyH}Si;F4*ڿ[ f mf3 \K|BeK}Ak&xtiٳa`zSMJX+ 'Y3Ng:Kx𡬿.nhS07=Șqo 湿2Qj  6_5, E}ObYЈJFUCL- 3_Yw_@87K~9WʘS2X^Ϟ A_́ndj^Im=O\dlHd2:(DW=Ԧ,JߕyFtE7/,ڝ:!!˖)F]tB\KҒ:<$FV|s"yLՌᾇ3`K(:.g˷b\^r=]:dzvtKK\Q^H[d;rd8Uh߃ow7SkJ>}|Il or8畵 4=LP _*nPEaJ߰+{*rl{hSgp /DmPHXO KR,o/l=&V%7`"ߎV]-~}1kxڨ&&R+ch |mHٓN.Ǟ.6?)Sh>S]$78~ %߼; &zN,g"$ [Q+o%hڛl)?{.—|s9hZn_ne˂NۤI^IFVZVfE!Ѱ;pI`˄p0wcIja0 oyzd(rs?J;7]Wr'эE 79B1!Gm$h$9Ҝ7%lAm݀uqz%= e6)i<;к}HO^ n|[tsrWkMժr! { #BΟX/2GpEePHꍭT"hJrJn#Rk=_-+mgR)g |o(ꃠzѵOکV-jA7r_dˆʲ+_X^d)Y5]HbS1jMtsXKyCE$yxp W{R%pj,;Bw7ϢDqdzĚ'm= KeOPfpm'+G M~ZP!)1ʼN9vQ'$\1NaM1C#LXɭJ>[m)Z<߮1-Bh%ӎ;Ұ51JF=ztogw3"ŭ:PۻSTsǷ.*R1(U|΋z%Iv{j.C-ƹ@!-ڗ*:Pi_2 ];OQި:#O'W(^h&TLx`n t߹<ŲhI05FkO#,W "(oM'դ1v}s6zwyCsr'5i;ɲ)g&'cR1dKCqCIv,9exx'r]|y tbrڄ 0r z %6Y2Fu endstream endobj 893 0 obj << /Length1 1552 /Length2 8418 /Length3 0 /Length 9460 /Filter /FlateDecode >> stream xڍT.LE (݊  XBŭ]SXHšPw(p]Y+fyGyZ mv)+X`Ȩ*rq89y889t X z` $  BNAA>>@[P7 X?X~]@n`  bXm NXGPx8ìN1P를6_%(- xpع8\ANP`}hrvLm3Ԡf1'3p(WoFؙ G_"@ N `+Zury4;/'z<lAXI?ր@~_1^c{2Kk偛@.+ceR;9'Kp'$>7ÚZ=`7E<jXCX- V) KB:A0[5<K[eu7w@| h@r=t]Z  [b@-E.k(ٿ^pb z&⵳2>qɛuI;_f/Ϟxo4xoXܟ?J𾠤kFO."iPEwaJXj3H\"/ҦUSBB)b@;)ًoo֣#RE;ݫW >Q} Tr{>A '2@)Zoݓ_9n/$wzW/Ԏm7wMhl~z]QSV a4(.\z ˕ߨB=zW*(3ƋUlmdhqEn}QL!Jɼk!k)dJH0նMGhQ(5 Zqṷݻiy(hE.˴h/wǵsj5~GhoW#,h0&t3285raSurRZni H ˭$0zv9kB+x*7iY|H5E=@QsVixIZj↺$/;ĚAoۤVO[r'k)pJ18JdP<;{BcaFsoq5{z(MWrzqӱ>9FSVF*xJE=98=ZC夂!BV\aғZ.WUA6%O;,:Z2@>1 ,9 X=fdGtxZ*_јȝK`olS7 au9Y zVMM"Vu ݈֯[*eYa{ @Z9+rx2"2}'c$zh$}2٩# ~: !gW:c\_;FΖinF[2Յ5h%>Xz}߸".H4Ѡu>&Fn9cFnQQ~$#k~؜7xJ'p^"Od D֚4H$%tiKR7m[ jgy->̭.q|e̓-Z%$|l.[t( ҁP5,{#BOdir&zO1 jrܛRO Jw Z*S 6yOFi<mMY>*(~5p'j|)ҍϗP&@l_ĹoWC2!0o(^:>a_=~`GaLMa;o<;}]1-SBɶ]A,{ 5sItޫӕ{;) s0Ͳ:L"C5420I$!6Sֻ_!WWEd1pȽԶVӪ_KrJ\8.bU|g8'Jbֲ*km4:lG".7e_PGkۥtRsP sQp" 1TmlRx.U1&=K|9%BW|3&H_0kἚKU[ZAXp`dP˰ɮj?#N=سىT5[oR9:+=($׈kq:60eZeȚ\ Yg ?I Әm49uR3%\gOBL ߯IltHT4$Id6Uϧ!ӸIO.¿|?a{ߓ%#Erep8J?f"}SkrW2G--|%#x?|!rof\~lh\o%0OfzW<^<1FaINMaUpۍC8ҩMSW 8YO9oB<.ҙQk4h1u˽9tqT29~#Rk*븽 °D\?XoF"")S1gJ;2=FZYz PJlU+P˴eJ~=[7?Y)/vk v_ƨA>3*eG}VPIW{*4 B2ld`dfi3,cKQ.W~N@$ZޜbC[v-}k7$ ^lvj"`c:NTt# n~dZumǗtVS6˼,z%ͧ}~.~s;a 62)ҫwE ,_O7DwkDP*{!eHURT_SvޡC-,wXWi@,ٵu4 Ѽj[n˚0K7L$2#͔s`#|P1^\YB# rZbE;$ÁÞV&M8@h(_{?q{ݸC/>~ah` ZL]J^z %SMoW.OtLk:!૱c=u#lxs5NALIcѮb~FT**xo7Z`[Z+܊&sl:zZf)zmL>9,t]T. >Ӝ,&>bi`zRO1S/>@r/C{˜CڑRȶpps4;rS[OBDUIYBQPcIN'Wgg,/tEBƟ}I~бɷQW;wbxOegfbʌ/> brqխܦB&* ּRHټ`_GmF5Q/s fIb6 rJ|xg0z\wy~ԲKsG jLW=Lvإ-nL6/B!9\P?*tFF]\Cc36?Q vLK7-W)ńg;aҀ+DLrX]K]D*Xh*D9 7W'V~=r4Y1\tvvܿZt}.}v?+mڻ)UOVm MM._}7{KUq Pvz0kR-]o=[tWQbH#(G;C} 4r{w!Xr-djc 짖3vxKq.=BRa ul]x]PfDKeEb+DXЊʝhn'`0ʊ||2ۅ]ʍTM˄5H>_pBХui72ҹkQ[5bKqcLJ&n450EV"g=O WiL~4bKrW'pcznLzh in^sZ# y.Pz!]+ eP^;[H:i hE;eGp{V5RR\ZtvLN}0+{DΒ;!GLl;Xsrv,'Lqyے ;9sȖ~[H qC QIl=ED s9.9E@twTH}iop`p:LHՐQU6nZ:ޔ{~4qDf|)4^R;G Tؗ-qMWBV9`( `?a|ŷ_ >&!OסRT=_BJ$RԼ|#f -K4*h?H y.jqk=,ZD 7傿 6ZGa1"XR N&%~>XI=FP L Pf^q_> /QWڋ5lW>5zB]{0Y1)Yr]oV1%B$|EGiS6q~x(};3*^es(ex$7=%HM w%Coϰ=NXIX.5EOɸ\Zt/OX\'+ ׇ |wԚ^;et Grطưe2mz|7ToU>*d39j[)fdTm7)HĴZo.aŔru̗ߠrЇ]=3 O{VMu#e%`-#v{ >ji*Aξr=PʗrkW";wĚ1XubNu:$u l3|:]+Ies7_mA"GsMG)ML_&%՛-&V]Sad1ђW-] Y벞_AvBC³(hSKh D#<|Vwk4ZiSb%ۍGQόG 0H潞m J|ϒpK7z6H ZY(f Uہ~:3k n+Bkn0* 6JT7>l! ѳ7&*,M{I%вɷ[w2Uxy}}~ZOzɲi6+wW;[ fqfW>nQ|utO5_~hx>ҘPp35\)W!Wi?CI~O_3қ>YhI݋8X*wM^SgN,_h+|f'':_FU1(x RFv !wntIIz1q 6Bm$<8Z=Qr5( ӢɗS LI Fs%/n:n4 UZ,IP1S2oʹYUkըb eȂ. NJM;M/ YMG+i$"UZ{B`g,c.m7c`SYmglP]y!^ ? Ix>H3rƥD0MRtHjQC%~')|F*\:s#R,0ܪ@0f2.QaaUp4L2ox1tt Ƚjx17@Ƕ-E:w*6v_G~2-1Ej#/z0`|Ys I29p݌ AM d$7ѯK <d>~:WQYǾ DNԤD2lhX:+R~'H-#*RLU jw#FJadN̐O>:6 i~D9]x> x}m^F5WӋk}A١o/˓>faicC1:^T#S7#Eg/ ޮ} Fb9mhno鶩\Yh6؄QjWKgy6ĮId5g8W|G,*x$L{NZ1;L28~Ti]}!ffXKz~OyE$4zG2Tr7ܧc;;eߜVO&[(CAl-"YB+q/s+x.Yr( 2ie#sy9 [6/zifh9k IJukT*^Nb>^0{zt[_<>5t*Z%O8`RƑn5_/QC:5ܦ<'-\}ѭ #ǰtIsC&n0NÂ%AW0rTUCC[4->}Δe `#}OC}ǫHO)'~v4}f.9s QzCd3]8AL8FJSG6zϖʈ@"F9nlt6L[/ZY.le3:پj?cT(b%$]߽$-Bzl RE%0|4M߭l`H Ŭ>x壋%@]WLs򘜐#^EQdӑ,r"I']x@ kVFV9)ק7l~QԟIqe&6rG(M&7bUۨQBkhc!|@eJF21uWgDGToe/񛻂T]gr3ڡ e{mya|!t?ҙNrGA ޙ6OɁb1M[xN )9aUYZ~hΔ/7{fs @WV endstream endobj 895 0 obj << /Length1 1416 /Length2 6536 /Length3 0 /Length 7505 /Filter /FlateDecode >> stream xڍtT.HIC 0tHw 1]"t ((HwHHtsw]5k}߽< .-Dy 1 YXhg_7!G"@Ec|P4DT<`XH ,,A by' PA"`(B9;9_vXTTw:@"Ps >(.FyyyB]PHw{InЁ`0[P؟x Yzp.u0g dx la]e5+  {70/f*GN ]\8`w4xhna uF!1PO(j P@1ewExQp_#*e@'w`݇fH/_5+>S 㳇y8* rc&sE0Cv0 =`~;O mk=A7Y;` p C/[$?WԖQT3cHo `@2ZP6@UF!v1=2:8,`@ URpvf?P_hԑ jZu-忣h(F 2{ y ?~8J Ղmp_֜qd@ Aa'EaԆ_6 A?DuwbV ?0F0"hL 3?NkͿzkB|e 8o`Z[07̆$F@־K1ۛd/;e*MͭejD /YBr\B̢52T% z{g;bUICTh[(ld6xAbT52> vn[{2ܸOq'qHJzejOdO_]Wg[U,gW;0Se1g&=`谷T4sY9 |hVprºos\+g~v^ջÄ~S>xž)ꚯf-@W˂^z?zbI'U?k}r3:*Sέ2n-0!˦e Xd9 nAR(1I!OeC˗/&V&*6߾/4.=:=NYЭh{a嬴h4}޷6׿yIg:Rr{ڞ c >-tJlcb=tO::nCбlqUu{|ܶΘ1[hyhď#c{ dE2<7yNuNޏƄ,c'ZMB̥TM:tGuϫƻKƯ٧sqZglÓtG7im&qF'm?-,R%a5s1I3W@TEcw'(f\?D(JHq1ު5HE$ˑxrl`&&-bm>p#.Ω}0x[+ |xC~ܝ&F-ax0O fYMSAgJdlq}<9+W[IAF|faV(Txg4c֕YϣӦ84'%diȍ & nG8; :8Q\z=)2۸"s դmRL1nņz0‚EiR]silL7m"9WӚҫP1C);d#GݷG\iqYVÈUoKK'"ɴp^7B9]-K~iVLz_ }sg~3z:_Im5oȈIUL?qŒ7F\{cYZ"ܽyEK+˾tc ҜsڤB#,bq#mʰ"LnIk#gg#g$MԎO.OS~p*>xWB@[r̪nUBx%$nm) bU"~4(6 7=a&۵6zN_ћ3jǁŠ|aA܉QRSށs ّf$%]}wn%TP]0w*`ic^ge[UI?~| Z۝L(Xj-GCo)SaQi=_]DRJPzKU{lZ: B&q%ߋY5.gÔj|7f/  Ӱ ܊vP>i]H{622 A^KA:~\sHyyT(de~ /F7xlo*'|;<3S"/&Ǻ,{Ɇ0, ` iFu hsZbhvͽxs Qj׋.P- oi-FRЬ~xAFcA͆FPSB; 酕QJQ<1w]C*R҆D_T|)w=$ ]3O' N|SCi_LLd粁Uc$p=*O7ygnvGEV3l xg>yxY-rjc;41'2tUz!S=YE]bIlfe%Z'2%-Dxx ׬NyJ`_ -9CA[qwtM\F+i c+RƞytfAbWӛw~}bԆ~gZLj<.OXhIX@C->Y[&Q*l?uyqM=jK!"g@3U )LX|@ş NG[1`<,C_Yvn]V}4-%jg7ZGӌG{אc 8/k6L<e߫(xW#o=3a9Gg}Yf蜄̪I=S={cYӅ#F8< ~k@AswCث%^ܾ5D*cNY}#Dͮ MYdxaR 4 / _cmz͒n W''H_d̷ ' H>d)-m.b9V`s\:=f_Kp29Vu/XP] KW\^ Z0 ژJAGjv ôI &ϛY Q|m8 q$f`)rm]ۤ;-b,밭]g\RD2qIjqUIrc/) WZ0=]1V:b,=X>B:!4c2?(Bo%Eqk= s NoŸ''ᩜSp Z|ݲ=x3Qz1]fW~~ڬq4llBLfPze P=D~v{6O5mV@򟙮Qqu8yhǭ/'LOwG3 iw>^\N`Ec k$F-f<4לJq|Lix7ͶD#ss{\.pylߌaCdYjkdnSo;zr~'tw bs>H^ l kJIjS9Te:SQ]\ٹ+s{ݸ_b=Sjb_qf4r#π/ƀ''wtN,hl|/reՁGLZ2?׻yL<'NZ~^Cѝ~-[*CZsBTѩY͠fxo1M"#Ust6FZ[*35|YUŋMtJnquX\ avrp3yiƼʱErwzKY1/SpCKeP!SHw;="c(˷O (6ݎ F4ய u)9/vw>`IZ1g5`A!q•u['`lKyE9nBO`bD ?Gv> Gݭ̦yyP!ٛ8tyzku1SAIvN`y.8rKm&yӉC5p <8oc% GWʱRڴmz1sGz];vw _zw+_,Rޠ ;jNkI{ W"΋q!һfm'FysbQuCD@tq[FYZD m/t[],,{nhS#ciQ:3;eO/Gaȇx? qC bz;VKK&(˓H6ZT~R # .s۷DvEʝJk-k[\Xe{-ia;ή:^K>O RvLHh &:lW!{Q4ϛV_>ƫΉ$5ϠСF~0僪XgO5&* G==TB ϢU=Fp2N$M]G_9B.d0r;ãN3Wn^,6{9fRDE ʏ+KGg[bu%"~j'BHj뛈-FR,=0%lo{ je+I */1-y}Svn-PVeT,Yh)v|8?8T߶IX(T%aqQϗǞ}is;wRPnexEY*O{0C.!kj(pG73a%zg4p> [yLi;5:wq:)W*aeUH8]ߝn<6thGYBc[glݜo2I3hhm^7N:'HVaov0lSD&nZ}fv&\MUp5nNq5 /Kq6g[UOho%V?_f~ endstream endobj 897 0 obj << /Length1 2781 /Length2 24028 /Length3 0 /Length 25578 /Filter /FlateDecode >> stream xڌP\ -k]wwo, A[`A[pwww :3s'{E.kP*2ٛ%\YXb*,v&6JJ5+?bJ bN@cLd'ooqXXXXl,,ch7v23dbNV.4@cJ `f b t25XmAMmV@tqqcfvwwg2ufwe[XT@'7Wc[ߝ1!P,ڛ; )jgtT@6`3+/gcSS{[c;O+; (!03ehll7v316U1@BD` jM\l~+ hmmv.rfٻy̭5ang $B-8YXXy@GԒWx5O_J_bPsP@_+s  S_ 02u-~Gc<, X~ID/3{;YML[YSՉ{9Xl,_$}o%cWw1On7=@op~?S/?#.H/5_i]]@ o:m hfV[+b :; h,a4Sr1-]PcZҁN= _* r򝝩ٯc;9{" BoV-="1 0wBQ.N/߈ ,q~#o `~/f0KFf߈ ,#oE7"j@(FZEv-o^$y>j -IϓaN 8N#^"xBF5]gGe(s]yP1{$=z˖fwwd&cc)Lgސ0a{NNa|{%IG=e/Yg{ZPcsyCy1p@48l\^=Bt0nC;$/]%SbH4DL7 mc<ǭ'w2iqJ^pyn/87lm4`HYh+qYKm/j^`s#[?&(m*9z16 Ts[Wkoib^̣VE.dN׎DaYGKV ^gr7IV9ծbXP?}iC2Oٮ # o۪r69tnA F7'zП4BS]i#_ :5˸ j5BO(KU77@񎣙Yh!9 w2 x  @{eѽTD #lbVRW۳Y竹!kp_d  ]q B~lP`!z2v/ϕ$z3C] *竔KeĔ?SbJ5dzov99Hu3 錄9~5gY#*yR1͵&yVq0drڤ,ӲAN\!Yo1Qɜ6b"%(Yn6E)*.i% MIo#pxsTl&^w2x ~l=oV]sç2Z芐{'^y &Ҿ1vwnɥJt+nڑ{[n+EXSE1BM6}GR9ɪ-#mV ѷ5׏',y^'w='7V7˺UBҖ?P]DmO%`pYQSJ<:WD%!o8U/ݩJTHzݗy;@M3*du{[ )f:c mU_A5@&|h#ܨ9Vs %B4ݣQlO^ZMwM;<>b ZUQ9]2SN2l*4浠$`BxU;{pi 5!LD^e} 1gR5^ڐ=_sk ]rHY$.H=ӷLQ%{uWt!m+^yHcؔ=uV5D5E }4h?@-,Y1`4HC)e3AMxC1҈@VέFVSzq }@1$:,;[&=6%\|1Ƈ*~06bǗZS2vS6iOl?:^! {l>Rg_C>u$b JI1g݊|8;,[d돲jy&?5lhl,:M&+cWHfRf~mK,; ja$K KDp;8'ӥnG keY6.G<{2)%p b/Y:)v9?=gw< MIwU#I S$6hEl1'NYy\\ONP"طTz@9ahJxN燐,^lb=4 ߕW;_q8d(H8pUοQhR<i5J(V/ffsG@d<;P|JlQB{ `mdwJs:μF[N| ɅS7ɍ$0HYD+Tl6^lg+}NJ&;dE0F4$0Wܒg<^ 3oI׬iN".t [ޖ 9ߜgb{'x"‘D{1i4!8Z8+Q0NVNgR 8|hBDiʳ4ؓ@o>YLaX+U5)Mmf.[ ܸo-BR RX{ xmaOU}O6I$)n,QAH+k֌u#<8Bs}a5/Ibic^s.\=oHMܳr*9q˴>_;3CF5X\z`+3Vm$I:6PsaQE\LS*0:(prk>|hWR*u9\c}u_`&Hh<>{ )'KoZg[хai}U;7tKa]092mƝ ?UOcNd8?1/T,>T6Nt0g@ >}V bvwp㠸ux>ږ3vr .SluuԪE~jrŌ/^FB[Ҧ`ªRT)ЭP@7;0l B-2+JRO-)zSs 1 fs_̣E[d){$ZϾOM=s#RgъRp#q$ ᵣ 2Mny( eKbB!oZN~|N| a\5+]4*^vьVr$₎tXvqocŮp{oxeB{dK(-u7!<  hҷ=W}b~Yo 7r8&]gEpʜ9<h9Jz4 h}]NA;~'11R׮եq.ЗAQ;g а;vqi,vt((6B:^W0xNH& ~B Pv䟮|t.@).{YyhD<~}5$Ǟ >vXkbx;W܉tnLGϕqGVW!-6%R#sr@ڬ4+?qncھWRvr Tpx0<_?8|+uh^P5:sHqq ix7̒*7JǢ6q5>2Ⱦ }n8E7) y;\njKoR_9FO2ƨo%p4$fp+$_>07:~Exx! /uFbbdd~ڗд4ږo||h~;Q,5ۧ6 2h" 1Yɗ:lUv|4A-EQo`: ?P ,:`AG~E:Wfm~D",8zE䤱؅UvSg~M$};^޸?U 5Ui^r8I߉+"V K@m,L`yxe|*#q3bB;q1;DmXh`W9{BüˋQD=f=V[`Fv[7&/l^ƎuG,juGflND"Q-{\z9|UŌ* 0/m-a?=WEdy0[g8$\C\Ixcz&K5D_ȞKvUD ް[,8б>d!=e*|]^P# Z\2\?QhYU -!ɪW;h]60)셃YĸTbG$m`):Uvk{ Q:I1G"0Z~\?GerӍ2ͭh(ETIR,?֍O;cRĭ&>dx'01 LR@ywo`x`A?bYDգ!=S҈_.UJ['8jVe5B;EϚ\eLf}¤{s"U{Ub.ó-лMȺMy#R&S,$~ʈҡR'%Z;,{=ؕ6wQ,uqĨz?Y}yy|uY $`& ,5<͒iI 'J >??EZI!VnhdģF-1 Bn-)fUߞ6j [bA&1P8&u EƳ]X6ߎ{v.ղ4@v'ۇґQQsXf^rHjc߇S\fб&7zT!}CR&ѐ38JMn8(.ؖ$j`ʏ6KֹiQ* Xrǯu[l̛ӪW8O\N4"R-`mֲkdbjCDo5=X f{癈U7SG5lwXlwZ=1~ut7_fUE7g!]՚xKrPK›5etu@ܦ&5_b "E8@n13ލ|l{!p"\;s*LMn#~|#X#V^BV3QpXF;+TJb}h\]a3]2Vu7\®` mő9lOS.uW=2jM֕Kr*bDIz|&7f[':>t? ^u5c0 tlT=7ܽVFܙe\bP^)pLtn)~ىN8QaĿʁ-~#߻6Jt9: 1 _%[7Bbk(B*ݎ~BVLGS;EE4dP'Έ0>} "da EYC,/I8OB/=bR  .(p45; ʒw$CCM˲PX֜qMܽ΂HDh+QQz'"xM"GF#w9Vr:wAE$Iԭ\!NS׌_?F[c@3 9t~JO[7r*OEܐ] ӗF;Li̋>9O/ү%@E Cy5:rqx뭏G^VwKzB '8~oT"8_fg~~.u6zSE3ם c_0prə"G7&G?Z&hyfyS荞=c^[)X@[W3zDXVoA;?p"2}1~( E~IS%4Èr/w!86qj'S[oX$#@k-ik!{zn}x9DVٓ ;D璿 eXq.ƚUEQR?o<-7OiM7H=o*ݙh;- pőUpB wȕIO,>'7h~BOئB?WlE]=tdQ{u4?$#DfMBNT4F#jؘ1Ώu+|m"+Xenz|̯|`. YU\K Z}sUs6P@)ZUf(4!o6&a؃bմgRqL m+Ɇ1긷(v3\[ܒ˂v zø>Ķ(GK1Dւy{c6}7W %bʺx_'+vocqjTX&Ly)R d{Ӷ7e;, FzjZ^;tAt2ҩ; D렍m7by(O(;[lw(ʽ4EB9C_B`;E2(@dxj,RsyFnC/)0[ op]"C0.ZEϷ|TsRq뉺7`뀧CrZy|HZU+gT~}b}Ħ[u篝z=JiePcXn_ Z4Wnj,@p,t{?EWVgg8v\yc>2~I)2<"#Qma6Bt_Ѧ^uF2k! jp; I M67҇o.6WjCZ̹4bBcI Y#vqzduDs}-cCA4 ~ǭLz{E~%>\_4{$ʁ-C*5|_5#tM`:RL)?UA2ќN w^H^2"Jnzk<ԢF"9.dlXLjgO3LNkwб]$G1#9WZegfcsk*JSSTPb EWM N,gW0S: $*aÞKYaCD_MH<@8Gu(CsDUuf+"OY8[qOb8NdiyV/ L%f*iDjrIUg,YgzJTE.>/ pDuP5TdϾ>4D5Sa7*ܨ*IE+^j7,:f~U9ݦhrAI%4\=ư]mD 3rܑe~({ڶ!`i'p5%n3}Iи޷7?bZ' ṫ#ք&q T1vdb?\u@ ސx eN)4+,}a0%v韴.MWx{~ćۼ~GE"Jc:F0A]~l%hd_`!Yemm 䞑J")JO4/}Gڌ BJ"7jh t-!?_j2 h;-O7 ~KQL2aSsnB?PlvK[2sKk+kH3տ4 Czt V< tE7ƵS}Sä**)o?<`ِ|fo%~]LgJνŁw}7@ъy9!nҖ-bgv>هE7JLkzo>c`*n7Pw:X035BC w+a H&^DDQ(ć'~?ڌUrPyUK Di~&R'0Xsx]-~} 7*dK]$=j:ͱ^^}bE B/6O4&^lh # r.ÑsFF*l7 m5QhC,gmSSx;cw{WK~D/|qS='[U\ޘY*DNEy7i8L.:F8\s[~bS?ٝgF;޸M,IYI YvJ+w.K`ZeqQ!#'آ@H%͊@#wkXg2 =Lj+2j[ .m}ՐFpŹY_(/m#$`dWlT7:iԇ| asVWqIVV(Gpf T'l\, uAǛ * BDTʑ;/rژҊj &?89814'˂ %šKҔx S(kc׺[٭φf rfD[TO6p0 ׬*ƕ[,-ǣqF&ϰzs!<}Zp/TRE-97O<臦ɛD{$v}u[tsT"h$2zu*܍Hveh] z }%w HL'K6p[S_~n]/u9m*l?Syx+t|MqN MwUpү gvהk+.cN2v / zi8~ANc7)bxCgTr[`[?{D~8B?r>UmtO䭯TٿBϚSE\Ps'; mLԎ)( &|ʀ,̧#*uʞ{x8R[3p[,vuwŖYͱ!lkq>O6\Pajha*Isd8?H=]HMN/6;&DХ5ܨ_+Ĺ{:{ħϪfzoDz%9t\ˣ|Cl֓:_RVd?[-0g"xy5rC&4(5fAį~A}*w hҫ毗sM)&} %oWCXK*ii(뵍?3H)OXu%Q ]/7ygHI- nwQޯyBv R}}ұvE^ v["*TQRrm0t_Nˇ3$UMmC&kCX4ʒ$zʫfPnY,.d[a$+ 4*Oob>0h웪]5%~Øe9䦥EJtGSj[P[5T%#|읎{ g?߃pweSo8ͩ>ڄ[a'33Ƚ hkXə(5)ޅ QE֩5 [<j{^ d[ad:JN8R*|1[ᄀ )V#i,ċWڷ\a ]"/xU;ݜu0:b*j@"MТ7o\.W,yeiylrcM %,znw;U\oD+t`X5>XEIBf᫽ COH@m(_h^)@p`?yA4hM17c 41_$OX.ѻadہ?W0l#}G%?vAX_hήBo0k`ov5R3Aƚ1-\9Ghf\aa\F "a*`gE0 sq" OL*)wRILϦ*E$ @*Aѯ)w% x#"W֛B#BΐՇ5^lsUAM 2αxiz0Gnnk })mzͲ ,h.C N9CU,~jA#G=ݘaq}ROhj𨚔PgD_&<0VH+AVW>;G{;o)_52͢6~̭]jQT9Y?CݙPޒ 9Z,%j2cqo D-3!oxkZO?a6'poXG:Psоg{7ɵjjJ\lBA_ƾq|ң{̪tf%x#i(|=Z rgAߞV&XI KsF2ww gbhF8[p{ H,Q1C"|VXQ)g,؍t)X g /- ps95+zǽ gr;Xe{ ;XC͘L_ /D0kB11p$9-oѻPaN-8 N?+HBlt943GZ;Pekrm>`W3my(oƕ_Ɣ#cLNp:=ŬMbǽ$S1GQ絡kJ~g {{(R"YI6[}lU,l:F0Mz9bU=GhrCYҜ@Ao0v3I9Jv* (p&vK>*}W[ԺTSy[NEE/ZtGNA-L"?I g֝JL`:ɩv4+TT+n6qa0|¼Ut 0hKMo&ٙo}*_W`2 ʹ,n\P_3[+G#J.2ҹWF$䞎d *:(ns5Q^ $7IAi^pKT9Qle*ӰG 2:/ʼn^Ku)z7f>< <-*5h)fWZ.hŧS.k>9aЗ2 s&29/s|.0%2ۧW},T(˻1zYk2̕z7Q3hJg#Ms8ȑLEք0F:9\ U*z.s^O&ĮJѥ* # o:3;cNUWsdsLiGj/yV56]0f!_J&$e RaGGws4T_ `BeB|:#zxҿdGcA(=fH='Ǯy_cE0yr}1egs_+ye-qcdMЅYO.r 91 j+ӄ_#yf|*O'8g+^+hL'u<\:PF|7qpبtqhx(d WoêS?G/)va)'՝k퉹vW`Go,mv%7s$p='Lqx(_wH*Mn6Pz6E"*OjDcmgc4"ZLP6zS^M&;ാR]}}ҹ—?KF׸,fB\!Z_ ky,ccP'{fXJ\E67I`ڭP ίbu2~hi_+Ouϟ;*`}g1ܔj.evGI>d:xpعbK/I۬~:j rhOquھ8=T :XDgW.c8bO⥞xBrbCɗޤJYLҼHg<>ӥyNu}D.(ì"]",JicB:>q{X{}&Ρ]#zXPt`Skj,>FJ" 4_mX>MS\VfﯠQ[Δ.ODVWmqBEs_Nm5|K/F~0{xp6L?]Ʃ.;NF2~n="`떒jmlU\s_6/k1%Ah, K,,}%a$x s+)$YW 2.YXl1WuB<ͧ/s@<}Ey_$SƆe7-*Z]~owBH 򼸂Ozr̟ҪY.}?טf\_q Rkh,)Z0ELW![:s d|f@+@ʠdRqh[_3XJae krrn &IV-b0Y%L# IQ>[В27ơ9Y<QogD1y:n3X'ZE#`tA.i Yܸ w8=IUQل;{ǞAjT+?⦀ 4a U}ʪ$ѮÑ* mf֯Hعc&UkfW(WV< OnKaUH^ˊBedtvNw? ~+I2}X2H$8.Ycd#SY)b鱴%z}PEE3*>\3鳧Rǭ@8-5Q.9~V̂CIH '"iݸ͏8)!_(߃Щ&*nh58`̱j6XN2B\Y&a̢/‚+[b;ȅmXt)^u hQjՅ2rK'.ӰC`LRXGp5%6tMsɒZ|uo4K 4ܬ:-Gҽp|0O9j~wv$8h xމyl.0:vv s@1$dvNOѪ26wkT~![5t-1@pBU\0OG9[eڭփX E2ڌbv+UH ze"61%o.H3U1@9mP>FOGCZ*ԽXh2i8Cjkqq+WP/B9`錁QEwTSq%2?7/=f>Vb1=/`Y?v*!mi4 6¾9ekf'*Ҍ!Z ;fgYL;_=^M <mgZtUJ>ܓG;kx%@^"QJЬP$. B{蕻C~=xG)bgd<֗Esi)DHGcUQފ;;eiClC L. @6HAJ[zW9n^I*C`_(RNHh_4ʪ ݙ~ͣ&  , ̳VbʼnG;@hT98(-]֞e WL,C 8=-i0e=zk(_@9`S'cw4AN!ڱLfn27E}4ȧOnLb7w^jZ4b}~ZZ`rD۫FWxy1}Us֤r+Gi&Sye'I ) {;Q4sI/ DSHǻ?$tq0 "&4"mr3K` ݧ<Hc@I ?#"\I{" oC⑇}&hK[ܫy1K}%ОMn0\Vt8 b?@\B%@*n{ⲮNӂCr>qxUY2C\"9:64 |F礴 9O?%@{34A6JBMX/>Y oG}R$H"$>2ΉSM<]dfy=f\W.S"`ﱌW**j3&5i`2ԢڕJap<|] 9aqPۦA\N2J7ќW~rJs(Y8qOB +#| R+ &㌼PSZ ^l(.^F8U~E1K qqu>/dgKkDž3F::;#2RA,{?L"$xcQ%y!Fg+A0 ddlLyBmEQ84~MI4r-uRDd`6_#۹gr]~?B|]x~c:{dr s"oZ|1㜒K6 Toc|/%a/xT PHU93v(je^2"\BVoFRؙdzO4hzľ9;lW!?ې5cXx;ڌ{F`Xmnk `ue (čC̚jy;Jiz)nɢhO+#>Ȓߝl1)3b<0P#;?W- KwEǨqVfߗ ^fmlC1O@'7gZ03oJe$vqEh*ȩt&!0/[cIXolxwoZR6J[AUgBru7>Mm=Ys6{{Ft)R*3ґL/LyCxw=0~ڂ쫤?7?mxŗ(a$hkYI^_\VfWr#FbLʑNX,w*wc$KĕVbN$iҨ[7-7iDE . >68Np, rCV6yR>j-8+mS%UV6̵OA o%$`eja& ۥD'1HٿDVҼuJa7˰&iwEL5AO鋹w zPʾh7hQI峵O_كo~nMQ'*EKd2CHοBgLbBc6sKI6rzc}-P-vDɰ]z_PLn2 ?ΗBtS8pie8Y MÃxpp/'uQr[47~w"ו%B60ZOkҊPU>"Agu͑5.ǯwN;5!y7 0{q%5N}¤?k}o̝^m#tnmٴ' =2i#t‘e,pfOZ|IG{2VzkZ~$|AN  #Rٽ0।(>k+[/Y}b9-Ȳ&9tE›Zmkt| iYdeeyo9:gO:Q)h.U7M_+~R޹Wrh0ʳH"&MTS{oRjDLI/-&޸[0ӧ0k"H,orzgEϚ5Hh>s']VL;xSPA7`eB8gH^=;C'扇3=܀Q{ȱ#߀$:4,:[@wRMlLԥ O(#=Gx[쀂 ,Gh# ; HFuΆVwJy@lD|oC"o!7T4ս3}xzop!|^!bÖm8rm+R$#fn+zϙX/~z\8d*S/a %B)Yyt~GCwu-{*dƏ®FO/Q@wJ;Z 2=̵]ϴ+,]S[I@)b,:m=@(R#EZN*]]Ve \!J.'_rȏzM='쪜:vݛPWLt9N^Ԋ">@#e=8U:u nQ!*F1h96߉G6DT?'dM/)qo,yLI9 |Y6RL)crgaVmp^Y܅|Y(jxnG4V IFɠa4Z1tbRik>]04C4P?\1숌@(qD )4 )4x:3u״8at!׎s7XqђXX')2^SMoR]Dt') ~EcAnQ&˺&: D[8:%9,g0#_5:{bׯу klOuu2$&Z@Q-W|Js\`$۾wK: #GFo cB3Au~VC%)*Xq~WJb|4=:rOuӁ7j%\?M\|yF|LiZ@!׏)]mNIbU!eHyIC&r-[_*ܩz{4`^v$WMvb!DGHc+R:{)^c˛Wi:aXQ/n0V7'c(hXLeնo> stream xڍTTk&$;i:$4afafJ:N);D= RH(=kݻfo}65Ua:($VTB 4IH@)1 PE`8 {c/qF($H*J)I P_@FCFbAƧB`.6zB r7~a8.0ˎ0`aXTrbъb`w1YEu`0 0orz10H( l07a`߀?gw??  F'8017`$'@]惽pkr0@G \z #~()k#(wwAs>-8|u3Ё`PS8,?E#a(ϯ @Tإ n_KF .ϖH Sa20!^IRF'q)E( q1$ {\/Q98sqߦĥe)/Z\N/a0 B6; s 8Qg]ޟR2c$0śb2/𰋏-|U[@"#xX˫)6:[Lف8w"X.yͱ_N(Iد{, ;{n3:.΋`#N.R ~nZ)8[Ms@;MPE3S|w0nLtrV*l 7eaCßEj+]]Y?c4AߝI"f}t +3rą`ul\6W-"G [iTK>M;O֚+3eĶ" pEFwn>:+<~BX1rW DbT ;q-'=,>R#jAe=݄m.֫ ΨGJ>2W;N!Pq .1D Mt9N.u .]~"d 2c ۶\ʍxg4tLҙds^>ܢO.{4%PHDR~#{CO!Ȍ_<޿6IVd/gedjpeb2p%Ev%S.R㛼DN;^|BV-_ۦ+s8hi;d2zds %?&e5JHOs?f% f ʐLg^>/壸P&Wc(-!0;"~:*K S}8L;%EšbהX0(*ŝ9\v׹4vvsMƖ`j?7x`R K kJn$7S+SAsz2ϟMO[62La~FH4̵d56xs]"z?ocw>Q[jFȘf|Tf޺RA?nvCK[!^HGX[%SXz}9š vu/5%aT 0 5EGñZ臉u<- dax+o1':+-$N寴-K2;o2F+Ն\D>R\U>l մ4۔nj̳ZDҁ,þ@˧7R܄-(ms{de@3w}V7P$ ~|W4LAtGŐGX{MŮ EdO^YW$+[ jp/2+*M龵lP( ؑ+N>˖ZUJQ;;Ϧ[>vMsLu 1Jիkj~Y|Y}h?򠩎Gk5bkx̛4y9(Ó혞pw{kjǿl_dIK;V_|`}|DxkGjfwo6e@}qf}])WD0;eJj̳Rpm rC;A2w󉃻6̫tn3Ɏ5gVv4XҢqO~ fYQDa=WDYEG9EUuvfn;}lH;˸m}ߩM52PlG㍊&h6cfַw)|( t6Ky<~J{˟Tԟm6tA0LX1u*,T7:3u E'EnUc$4D _NҟQm9@ƄMIeZZ, O'YyњY8E[Iv̙~zl.x5h:̊ yz[]_`+9J \ф+6:>~|0^Gg9ܺ]P-R,Z=jNO"~D p?ȓA}\,gF^K$9>2ׇ{žsABG#xӬ#àIq}G(IU RZkT8D.;΃gwyZLQR5/M>h+x;yk&Le5p7fJ:%(:-^q$`2Z擬Y%(կ/!m w%ۥÑI8M4EWep#ÂD\@Κ9<uq~֫G]%\]/ 7wHնrH`OܜN7c̳ئ/UP.6?_[HIgh"j[.=-m ɡ `Q0eۈo %>y:^V[_gĨI .<?G5AOO脑Zi 2xlDѮoߍ!dgd2UU}C#F\\kO\d1Ryᄇ(`>It=x)G^TKL77SFN~3t8HSBͽZ6٧5SqhPYQ:Oh=82joW&jۀSNbC&~o 0ZtcyE|榌*«T*fӺw$O#~TCz#*5xZwNgY 7ZV; /0 C>T)gdFD׍fN$B P#U C 4Yr>qx]ٜt?9Bv"9cO5E|3i /p7c?EyzW=9"RVaig^tWMlL u7*/WԢGV/? 񜾞Ɍ&R2Qrn\#ʎ֠-Dd3(x,-H8icպ#`b~{YES~L"b[XAOzLߔb'hVӼ~Mec!ls &WD+X 'zxW>ΚEbٖ)on:? : [Du^O;>FhS}Nin  D@m Z6\􅹺䭜Fg֣a'Kpм NU}3]iNzP@=BC'uBAy4S4{`k7 |lmcA&1pɆ:u/*l2f\.)q{u^ / hisj'?s;H+tQitOǕ>p3hzBE֨kH5 S%xѕrC&mSb"<gnInY*vu , 1e'4gW\)Tzn<7UourZaZq:ea 3uIPtdIQclƱ˅!ȟ*2do1LDHU+cX$ʉ\-Ir:ĦF?JI.)/?YadI4qǕU0ּgqۂ|bbG{װ/Rwr7.*< ăٌr^&F6BFy?$wM˙fl9wb,UҸd6&4Tb„Z[? J.ˤW'n"+;{=]+LJ_%Jm~mTQ[C>wrWY*=iAv+'44. J!L2A;+z/y$E}S$F^4&w^  Et#8{`jf׸ҚV]֫tQxZ'IO~wy ,F͹!3T,oP(`O2G^ބ;72jC[6Z'2w2$:;ƾkd# ~ȰǍJYP{1ۥog#za꿦ޟ%OYnسm2 |SΪ&tMFg_{JrϠrؑ>ZyH#;Sdruz(/@'*u)3]Zkau݂"MZpn C2Tbo}ǻ.p&F/ѓHʪ{ 䖌&UJ>Wj_L{;¯z3By%%6q ]{;,x*"Ymr^7aAWzr ޔ E3L+\j-Ӧe)y d^΋oJt( MIɱxv(Fhq`uU4!UcZ)O۬2i+GiC``` kN]n>$\#ObHB"7}B臵SC 4RsNzX, 6/c9Nl?uSh endstream endobj 901 0 obj << /Length1 1391 /Length2 6189 /Length3 0 /Length 7143 /Filter /FlateDecode >> stream xڍtTk/]J H!݈ 10CH7HJ HH4"-%-) J7y{ZY?=Lzv0  H B|F`GKjraPeWtY#P:%kMhx@@!PT(&) #]d h4`PUvpD%$x~]@`[k(@rAU a`_)8:"^^^|.p> ' p wO׸kXF`!e- Gx@@Tm@ǁ|+;j C`Ň@"xP_8 oi X۠~7n PXk:;烃!&uP;E O Eݺ7:Ca^P?g{0vPH]/@n֑Wr#oWoo5_W+5lB­=A-;-`rC ɎRȨͻs_OOPزA!^.*6)(_^!Q( &CEWĪCa?͢n? {} w. ?E}0C,w?*o+/avC@a_b]Udpo:yKUHa*ƿCAz08׃  *[gԣG "ͿK*Cmav%(" vw&@%|(ځ j<=̝>E~Qa ?[FUGx~*m"oh dK0= zTR΋w}Hzu+N^i "Ίg')}HV9f}57&7]]Y%7|B=\MHn$M5CH/̫SYU2;6Q!yd78"h5&kˀEv$?>#{=|˨M+lI0|gHƌl`Waƽ)7T-./-u3ퟖlÒ41jI.ELI8YsHb 6p$.DȪaU \Tj#^jPVjm}? YQS#J1Z'8? .J(7V!RjD=~Zit?{c 6 tMSt8~zm)T:*MW;9 -I/9 VSx>9V]>qݓݔQla`Չmg9S!5HlcDh e)?ht.,pB$V$b2h{aNu-lx%9cS$AWPH|&}v^lm

jLܑ9崯uVPτ{nÑÙJՎgDJ%+ɳ3 T1 ֯;;&+I aM9?Ƅ>pYĊ-|HD\k|bf8DyE/~Prᕿvd^aߖj!v`Exh;B+a 1uEI)EKd'D0LZXvO"IЗq̲0Τ *b }Ύ{Nњ߰RLnB2m0Mzt^mDfEw j:?JFI_amj&SY,Sm5=W1w M624U6wvcl8$2M<7b/UC$Armť1>Zz(q#ID뇻+u|٪^͆'$2MN>4cۊҸt]8O/_e!L?iSL.ښF,1S=BqΣ%.jxp&53 "3@_fp-Ge}\AMkQxqR&θnx*ebI՝%KEq+$"'1Qjg߿qnfy B5oYg11~fv}YqnuۜoUBhyS: -q"e<7L1̾+쇶(}L!bQOÆpE+}dW' Ijķ,e9슧x[l+WuƲK gULoVM3]لO(hNt-Uo\=cB-S(:;qcg ,qC֐I4b+4@CQw mpҢ[AӴP…9Fv|A@F+R"ȍl ne3=i}e{V-fcix?RϬJ]/\;\}\qHOC{䩾nfr=KvXgPC5fQmW:0bq<=[SaG]H R3zηomofa˽9.[U>-d"w5]s۳54L.v l >  />M4uJ8).MsHTa1S)%y]=bj:hV?uII2T G~g}BUZ%0\ZRe  f+pvYn=iGٹ/=zpTjYx#x#'SNP~W`uDyԐE\̉oDu5rwJJ]bsM 'tA ٧_/N#PclEst´}Ch&{?}h4rfkɹ+2DxhyrLr ؆cD~Ѵ[{A|?`C16:$yLx^It 2ɺ,,ojT&~eN޻{앟xӍذ\-<]JD*Ҭ&i Ioy3UOHc20ܣk3P|c1Uܣ1#+2y6Z2Pi`ڥ2g.?F$su]a1 !WblŽ'MI.Z%8)SVtأ>lyZR){fqen<0?;L(|݀s5<,3 dKwߑX*G kmE( b &n=ؑmqMdhO;p⻎ɦe{N2j#q ?}2wd8*.63#pܒ}z( eӇC#{3~:)NSɨKŨT b_z:YV = 6[)"H\ny, Izm%;[d-(۹wL3 q\ N d]gv$r* մ﬑Mu:PO7w4QT:!5p=m{č' w?$nLYniHm*S/#SQ@tuhx_^yH5wEh=K'mKƈFm O6s"W6F7r%cյ&*(=ީޟۍ;5oDkďѡWy;ؔsV:%_z f L{>+l<9.`>wу䇆-l1wzfD}>挪mo[ N:i Lxh*,u9xS1 ckY=UM}t/ݚIdҌ-OSS"D7`]=I]QOQPCb6 wVV԰ZO".0 Vw$9 ؂r!XjpDSY3=}qܵ=V÷eqa {LRTENO2~H8[g*z! 3Pl.IGi^:;BG?hD5Uxe ;-~߇<.WE߂ U)B?̺eI]cg'~0ux?O7cJdMk(e6[SA%ܛ6ZTHL͙4P坃cط%ݳQ*]PN>AO|x!BjX-d/ 4!o(x.h'CHZ\u]$@v9Pȳ 0W}8BUU1+8ԋ's.FӀfQ8W]{f"t?ޗuGM!9h׻ ϻ[U"}:_3}Zs.dA+HY4aWfN:UnS0!F겏{72i"zNSI>4b-PT;HAhq⻁%USwƷ&!oTb/˙ct8EMKH|lc75 YcK/>2,+\[k|^&)ݷ@w֩t G4f})Iܭ( ( hX./iSyxx5 xԒ*|0@T _mdiWӻKȟ[;%.q}{c>O( W}w\w5޿\=PӴQaW~Sb}V\%YykcDO3-[d=RD3%Y%?l]wu;4|_ms_uq<~K᧠赝lP5lHEfZiW( Jn~D ^Xi%7mtae7:= "{m/919 婨\l/>dĖ*~IQwHi[VduTEnY`mdZM0,<d;*Ͷ'"9y xD)W+l8dvJSwجHUkj}Rq96k㎛ť&> stream xڍPҀ c  lpwwww`= ~r{kfާeuZk$UVc1%v ,̼15yf33#33+"%:9"& #M&nfȺX,,\VffyƮ 3#@ltB{8,,@mJ` b t-oMmj`Stvebrssc4ub;Z@ΖUhd-) j`sg7cG M`29ؙoj2%{_ #@v:m<@vs $)L03 oj 16y33uc ¿s2u;;1:le޶YL lk svB#?q#m=>\k;dgfGf.Lv 6o"d@g3337Z2@[ >^`{[@9pvtx[0:L ;Vw>1 : lgG$+EwU^ Vf +Q6ǿ|e}ۧwP= 4]Kֹ@?lt7#I?mA6[u(fj]jeߦA⭣x9$A@3e_M\qN?. 3ѽ͘%֙o#a%Lf+'߈6f@?{hv~s0;"q&?D7I `XLЛ?`R/q!vmM0ޮٿ9X 2 BY *ߦ_/| [\[\!'_˿- [n [\?s6?e M|V ]?1N _F^kH_E-EobZk0[lxgD,5u37I=!p$º'۫kfgfsަ:v-;iv[U0J:kVWl_;pu5X>j̬T+OL(Ԕ"QBXukVۍko=DD6J~(b"2ŖPt6( hksqGO #- yhiXpwa@id Ӱ sd投Qao-j{UWs@ Tсn}yLUe(*?v{.^v5kf\?^gGsq5 hA#[0롤OP7RfѸR>7pl?VW֑e/Y]jhᮄbxg=Nk^uxp* #p>sĩGUM!:G#hU2$Os_;D.FJǹ)>[ ;2}ktSbW-fnX\4zL9v>^C,41ph#e$C2L8\r̮%O_F^@FQӌ, _\s3ZsKA'1m|P_MuHO{dO=J'WVHF ;~CTWoH|U2KШ9 1@a)̡N*El|j _VTv/vUrHpS\*ٹaB~O RbzA\(\k6wqj,7.E~uFhb!hLZV`\erLXVԺ|9#)sǐ3cLk1A\ԜAxr(}ʹՋR~Vxsے\G:Խef90ݿq5to|WCN2)֘d-t -N =HWo:Pi\~M͂qDT6aٖ%F'H䊆g`~f3i$O)kii|6*$)YhN`GH.{K\f h5i#ޔ3vl_ F gZǧ[W_}qbHŒ&Kb"ݪ Ȅ;,M?'/k_]1EV+R@:VNM)ߊ4bZL(ݽw̰Jo!V- ʟ&@^+sN,Vt[I tsĀ؎j%';*|c@ Eߡd=^#GfϲCT8>oD I^CUzt1l*Y6𝻣4Xe=0$ߐkC@"Zlم]چQf[xLH(bBaжSw'nݕ\"d~KjITb^5QmhncXъ_xH)^ R6>=\4;hU"x =_ *ka;!m[- Xh-d#''[3Kl,t4U7 Ȫ;b/72&e brC5;y7)P= cv#<3X]:F'{(~N -Yhl@Z5,szr{IgհH ^1:oևXaݠw;o$T]]}M_쮆1{#ɟV#YOyX v{ FPlaTX q q~\,Nد>M-͜օf9l>㷔zTh>5*/^oWr* b7ܮ#UCw\+89. nO~WTe}Mʀ{)QKQpte]尐&GE/\ʟw } 嗒%tDth ;CUn34c6gΞr~ckwv/#glkDdrHI}]p7JϻÞUq6ŧ9xPB O5$3, $ 8KăIr737k&^ul%EC2"K*E5S@J-; y3MmaV!mst Ε=W]t* 6,]ғW!lt\_x|UIVkc-9x ;j qTMJz&X!RQY-h~b,}6b',N%tAC3#:o9@Į~gᄑ\\J==Tb8Nl%՚f)qG;ZR^]$1-zX4KZs1{STΈ{ -L6U:[`d4SuFxH+IK,UjnP+&$_NMjnv7jEѳT՜ lht\꽑I("5KrP=9%F$kSRR&RHSz~37(t23=~=LPMrHa$k[B~0l?b:aT hrY#taOɊHM4쌻W74(:/JF%c[^X;E (Emzp;Χy;TAc tW^`ܭ>ב_hpUv5YcM%3&'J!n/%8nw60Iu(>9)-bQLJ{2Qvz{O[ӷ َu:>Vm\RI49bsKS|p!rbEx289U[al|\fv`gy"yڦ2万3ѫ1uKN35]x8%Ze^_^Xؽ%4m}O˱!'ӝ+|WiI}MNf 9VasZ֭tozx(\,x`D>%ڎ}d3ZfZ9;^J2͌Y%mߘ=I>;H:lE_0ض!Wvi`c~/s[~X}5~cKb&YN'0y밗[s+Qo0.c*]XO' p׺UD*&۟G6z@-n!MfnîvjƸ6@]%܄+(gw;|1r"*xH =x8!Z e6`gΖz7DDŻNp!x jyȝsQr b AD. eƧG`$Y/{ã& {JxMQfX\& %_m$"&73A3-^| ذG{jGR)6=_ cf ; h[9U@@y!|nעpReLWvy>9˷^r) }M7I&o9/i*{Zp`)߹djЪ!Yo]E7koa U%^ccSxGd4[\%C]D(%Z2<_Y)9-؈H퇶rs'r`dWh֧qS1w555=w3.l3jAllFj~t4i/_a,T_rѧ"羸|^xILOAQ{jSpQvr TeXҙ sg8tNF)9zvrɂ:h֩13KJ[5]9%%`{ŌIQ~Úv+ޢ,k 27pQycI %W LPRdUR^r%W}K҆À'#y8`X#k+@8^uuیxJCW Yׄ5p4 uvϳkrjy;P ]xnAƠ ]@v1zLx $,f?8DJ茅YejYK)Іj0G񳘌N[ hN'xm)YU?vd;lG?B:X{sΘ:2x̴ eN?jPɵcSz.A12fQ_Erܸ'e 0^Dpy"\4Us۵Y\rDi4ޝ5b7l6]K`;{k岉*h9'NϞ Mrv855r`*aґ,$)R -6i}C%,ȧ+)}p\hf,~])i?zH$+2ec<:Ν-{#|.KyE 7/0~Օ,)7X(I5nASDYbͺ&ʂR(q Zǚ"orzWГ?W} е),ptg3_S9ƥQ Rɛx1Q˭j(x(kC Q'\حO,;jU|,FL!F.TOkAoS(-#} f/ƗC D;jǒ-W #La}d%Gšy~㗭'4=Ht4D8A)e6TgV`+fO\69RZTj'aYǔSnP ㇊76G|8aIC{ ^ (ت4e "1s&'plD|*ie7A5^e&Yyv&T)ZtqAjj򼷱CR%s 0 M+iu8͎_j޵!e>w:ޭ^9=gyv8hl+~Y7Lܘ폪ѩ|/{ܰ=Π;ADy;1}hs3f\N(ס*xd2+Td{nw!l"c'!ǒB;|A1lb>ŸTm[jti}9I]_^=$4ƞ(hHL*8.#K^T0ÇҰa"`OZql(jk23_ 9:A|:1.!47E^K(#hS&C[%'`?Ee IMw0E ^S+PiB+CE֡rĻuZv/^[q)&=>Nh\ק.Z[tSc2GXaPb׹ 쯐 өm!ŀ# {rk‘1yrG}2Ž& 9ٸMۀs5jZ,Lde;ې ٜ6w 8("+x€!!| vZ&iyZVSlnw_|r@3Q1b"ewG0R#+Q'8 Ⱥ(LwM &ZEtml/u`Gp%0ʹur=& X0*WF~ q}!F{mֱ~W|`q/#`-_,P՛va3:h|JI{LbeLa֊\4,I&[baB;~/&z>/N2bI^pB:ht2<.|jjxi!b!qԡ[L^OԢbApȔTӚ|F\pʍ~<BAfE-foq6B-@_bdbƘ5 Gn4yC=HOju >TAZ3D9\/8F#̤O[0Yb#ɰ5DM7[̐ɛA.si}/?؛TP]h#mq'Iheȏ4Edalf~A s}w̔HJf{V}n 0"mHRUhv 9=b9h o'_7Z$BIV6^\8En'NʁB "Lj`b81Q7Sqļʧ)*c1xVCl[j}ȢZa4q3v:%mhԋR+Yj< GO*wv@W:m刀W wD;ݻnk6|!ʺ6oN*Jʙ1 vw~^RyS[3Z㏀v֏GBdj݄Gkj:ǚp_6HEKO c뾴?V^2 j`i⬭9Aw8ə)VL;%Shw8qԋc)[S`pޕ,Lڊ!x.`KP"rXG<-2h}?&ܬW jMޚ$>`6 8wNF0=@E\G"&߼I ,2g*$zCQ+fT@7-65޶yC .>{7PpفFW 2_Qݬ2ZV@~>lF9ojoFF]EH+h+$|ot[1hH8EwxSQp\Qb5n7кw!!ղU8')Tj2í= 4qFxﺄ2lX15t-ڇ*a'EYĎH<,*|N'Xf N}p:StۼB OcN2tt>a/ρ4ioaҊ|O}--l籨䎧üd!;ljH(z C n0z4=M z(JL^E{*,"ަ<X1E:Ѳ ?Hʗ2u-0rEֱ ™(ij-wY٤S-L>xia,]\(47fhnhb3Clu~Bqč +aXe\ҥKQ{{. Tuk&Tf[Mpx?i^5C^y, >{Y7Tqa܆5 RO͗&ީ& vmrc)׈{'~WfaV tq -iGQ- ȦSnf8CIt1 q3]Ӿ kPE4!ݝ,֝SߒǠd3O({' GUc]B9 gXBx<5G2/w|nΖ[jHQY޸eyg R{ :knǒ"`^},d!&O(chxAUg LdTU8 zYS7olr@QEp/_d\9Ap5[ߡOIjZ ?DdESQڧMhAA閣Pr¬H%gմT?H6u^Qgd$6)0B3f <*gۧ>(N(3CJE/(3r7*5K]67狕ppsM+IŊ{#^\2i`&CJ_( v'"YKeNt,J -F8 `P=Xq5b#Pt(]vX6Ԃ ߹,u)x͍)ypG^Fn>'p4&H2ơKUCO`~#h`+;'pj%[WʈKռ)ȰļK4.Lnca3)4^$!*-fRqI׃DS | r@aửp%(M"I+c^[A901?\qSϢ 9.x]oD9"lVe uޛXY^#d%k0YPٟhժ Gǭ!n%eTxu 8~#*BޜOUݾΐJezu0i5YDUt'kxgz_Hs "҃|bUHiMۂmu*Q`)lr'(u8|E0 oL^<+HzhC 'C(K13!E`߷$Z遽EM3^什 =3z[v s+)EG5/xAL JV$M4. u7lj)2Q8#aUpX> ~m$ ǔ!v+ p'uW%W3]HO3X[azWCg?+]~}^;5&ךW#1_?]Obޙ Qjm-߄pHZr\=gzK7+\Sg,D#eH%YB0"E`H% Nง}|5-|,okY8^A]'eV=XwA}Oz Z/ M~h(G|a8Yw&OO3= .iX>Z^?}`-nV&u2M k˓wlkh(3d˗=_b }cX 4jԮ5~Oۊہ3dIw >Wf,/ M4މ4χ([gL#XF!FSXr.+fM0-kcz'(8f8Hyez[ )u Sg` m6 ;66MX 5L\6"eBt:NafϹx?W[1oLHGcGUh> vu^8o`.>(H_lJu~ p租\!ihM^JT 7Ÿ1 fp&~D=6L&@BR+lHduV(=l:zQǨ/20;B-nTµfzӣ7(%/qkz>3[ #9M>spàZpƛʔI+&9n=Wg))&a, lͭk)5u6a8tZ^S%ɰ]3`$Qsz $5 tǢMp>_+h >aSAϤoHƒ) 23I|qiXF"dHjyӲ(x̃$9m_aBGZIJICBWd'cCʰ˜N}z|QSڀ6B'6 Paxb = c_qbw7/Xܔ[^U ^:T*ɏE3W},#PH8Tr9sIBJ'X ݻ2IJXՔ1W~wC#wL[Ne·OK6#Gh;-*M"f  9e$<7|&\TCဒ潴%*͠b¬p { endstream endobj 905 0 obj << /Length1 2605 /Length2 16784 /Length3 0 /Length 18279 /Filter /FlateDecode >> stream xڌst7hؘvضĶm[ 665ll765j;{sv{~q׬5~>CI(t0I:ػ22YY,,L,,lVDJM=2b W0M,`uXXXXl,,tp[ LY{ "+4fV^^n"v g+3{%`fr4-]]=<> `o[F3IIlQQO#  !e򇪌xo -m):=,,f/SװeǼߘ$lmK?2vsx)-V/W"fel"i *[Y=&5Z;[+{_G ff>N\7 ^*aok8&&^,b{L`8C?3_0EqE#no`x"no `ҿ;Y7~#?O_=F`jY7gkF`:"^p,&"V6S@пtr Up&:lA9Cgu?8'83[x3_;?3v;GxE 6o οnm̷ S Űr!Y-f;b.po>Jv!dl~EpXYi.1phGӿ\*'7W􏦰ԓ\8B ? wmu ~ >ę]-A `n˅.k6{ ;f%o?ϱh o0_!,:Z7v>ԉx0Osiܽp B2A)ڔp+Y A+@C'Hq{v1AC?cj|f?)7#XkHNRPl]-+AI Ahgw%i[>nq $ٞGjY]{.tQd΀p)D׆KSrn]rݐ_J?R0ܯC'S8s`wDRK%'>)8zNӅ-ʹF0:-]~:5'Ms>c5;nL;@"BlY+zX:L 6i_+Ш Ai! pf!9 ZIwXDܗ~&{Hn{_BR]3uzhl`@+qJa>\l)} X弄B U`zo՜,-(y_4_n/k8W'` YF", 5ٲ>>p9U;$xrE|e..kiۗ:dd-Ev<2J3.웃Y du_Һ*O&FfjoM((#|QX.LbDcfZb^IӋxBJ+2 s~1;cјJv_[צa5(<8}Ѹe6f£Ucۺ|@ay&%- gDpc$wOH&p4k Ϩ͉Pz,5ƧKS@L \NF ҇nG 1x(p6m"Ĵ L(:sT֛5w;ED]> /v  _]32OӸi3\L"! Iezȸ(-."pљH򮠨CC_e?Ë$p@VL;4r6Qkw*U',O7]흄9B-/𥑱.]v1(zs%w7 M,q ta$&P. p)w*3w=LW6۪yozٲNXE't~5D7)Ke&Ez9ʰ?Ѕ6ZQQi7@d7:ΪB iDBHCK ]o ̵n* <2OxpoXO Ăi7ϮWx_63:>yeP0rܟ2y/`B@$\v7>JxTFԈb"vWrpQ%\xISlA"\n)+qФ 4C-WQ/O_p NG&Ƽҟ 88s=yk*7~ԳkM-ݿ7-]eZyq- ^IO/Z?ɰ%ҴyHGT INػ*ޔSOߏ̊Ez)xgUܣ%zA!E(s\FMvX&}Eآ)T%89;ͨp@ϑ8:fVQ:{8w׋` 嗠sE(9qz렋^=Q'Db>,8$ 9ܱm7yM CL 0T]پ,Gl&Fn:erh6u܊,?g zR<-ԮdMD]m~beDv cwxu0=lcK zj }`j3}&eBڄȕ^ISEyD;f̽E wB,m1Qr`S5FH߉ڴ']2:AG")RUJ,rU`޶\zu=4pf\JewE;?gU\2>B %Yqs#j'AeX~:C~ HUfrDMr! t,!Vo?J!i=.1qnHwsj0nBOw3))ڪc ~y4b 2y1Jv!$Ln>[l0r:HX9~i6- WfiLjNf/Q3{.jMFm2MAhKof<[g00Ut,@VQ7/UR8"?3m!+78iw24:!f+>&tN-Fz2+kix?$!fv(tiDֽ!No0Eh:0gnԝroaÙZ I ыTί#Oofi ыTL%d0:0p W o8}%]Y qh [{>L],{!f| nVAo"Ɠ=v-ߋk7'^.}T$$5,NѰT2k{2}(这]"B$HJrE%=@E#9ZMTH U|8մxD\#;ԉ䆊t>\p{N?YNնbr\" 'L&ܲ+BgZoH_1{eQɨܾ䑹Eˁ疴j幘wp9WuaqmW&1yS1I(2%2A }vG&ۗI#/,trśeFU-c{}Uwbnd$+i*$.mZn逎KGܶUۄ!Uήn:A-8$o@Qy-@~ѧӾuP8!wY"Y}[$3(8d}$4oƄhs~ml,0wZP:DǒHԇRtN>ZwLvcԭw9BJ'Pr{u˪L$osvQP> .!D1+!&gT쓯]o%\X d_ٜS Y,p·N?k{6M,Sr5RޕexXcA1lز#} _ ԸEwr^":u{vJ5J8WE? uSQQurr^Qy)[N_BQS`$gC5ǥ&8[n|E<2(8ĝN1 9ln]g/EwSzO,-iϢPutxM\9S1HܕYSR2AtSLH+ÚQ4lH=q{7yXӣҡ2#_aILʌ\g\xw3X&N8&/+gQ' 0_lԺ0WIF*R_\EbmR%y:RpfXjjA+i(sO2ߨȍ{}2f06XZ1Ru)Z @Re|-)v~6sPwoTjuGk ܔoY9 G܇v䍝4 \BK ܨ7ݮEz rP ((ӵqt;&9ٿŧdFsu=RjCw9dT>\t ]|]Pr&z3c9/W}^֥_𚠄ޡ䢦Uix-MDc|S} >厬.q*d=Λ݊&VRp} *ǖ6G< #P厍!7a~‡k#. SaD=G`AKSOFlsxFGDk3"d^ëlI:ίs4grɵo҄1u9>uNRo㙶&*I\crr" ~)NpaFm'9 ꂞQ%c´*RmAeh&_bUЊM4K*<9qդ~ya=j3C"ǩW*4?Ed^bnVl2UaN)f z3i-pi3 *o7A#/4ScfЎ'EZ.pw_ m5xkߛ|f2J-*+bLG&E%2w]ʚ˜8 ȟSuc57Ȫ䵲г>|Q͒|^us!/D[x)jgO~ 먍PHuFjR]9R_kBg77jj1蒹4Aj3ԃE4c,,Jﻞ:#.򾊷QkArk7\ wEgXpo5d(_Π{!R~q%~܅H=eaU+ߗV=0!L8PY?zC"3lJȳ!{q 7̌[^^1>Ss[gjKGJG4moaIe=qO8Iib\"B~Gzra_=W MnP(gf&yV'ҾJ;h1NaWF0|B˨'lXVO͆VS1„٤"I .}֜-IyMIrJrr~F U'U C8%kCdECrCzt'%J{@@޸Ї0XB'RddQ٫| bq k.p4^z@_Ek8;C/0 M+cM_Y]=;q|1X>41&Y #ޫܽ1⑷t+PgY;(蓥 lE"j/A XI`?Jֲ}eH/=EF}2hZFUvjR {fh5K-*/~$ AD1[>n06DmK/|3[5Fc6RedF^cJ%c~CV`ƖvrznS/ApȲC@\"2F2%ռ?(ʦzIm]Duc^ɅTuT~7%`bTpu36~:H,`n?w瓼?~\s1Zz;,QB]hB\{MvB}y[5\~F/;&*(Tw 5JdT_vJl㟦^j>ocdd9V?v⎲,BQ$. 2'ePTmT>Q4TȊF6Ҿ50q/TG 3ūS? >ɾ~C;}/UBk7sOF}|%UB]Km`}R-q:aPOUMx݂wԒ5#ΫZ?[C,"jM#-;|Z\$jo;NSrҹ9L%JI_f&F-4 ]ocZ cp.`5lV&`z%FnpwWgi63`)j-*н47ę72ɪ1by _,:@9JtA 6//+h8;E5.Í*ODى͍IL#/#϶MbAIUT W4_hHq]ZC'7,RI)/ W59}~wCbPkc=u{??@}Rt1[^⧏°*}OWF4\Fd>DYJ;h1c+$";\ p+e}[CmqpphgGOb"'؀/[6h ;C!Dҟ0 Qf_p-=%f*Zvw Zn]:-TNj ӺR<i zZQ4vإ +'rFpUy!+>β=Ճn={pݤyM ;<3瓤q1ᐅ \N@gUe}Dd$x >,NwƜZ)>mw-3GuzSuoYCƶ&B&dԩ(An g/;Q;'H4-2O"L0ڪ(XO#Mhs0&g,QS;/FJ }=b8fGF4WuEx ;OιޙD:xDr,zV&x%0or'u^g^ rsnzP:'=j> N=8i =j]9Fb]x`A]b+?4% ԑX/-ː.|UhY`5%ħ@!WIw[Cϳ:B(1phJ"A6;z>!ya9DF8\u.Q1Eޥ>h&!sX=#%/,}4LL.I1HIU7ٹոm,T~52,270sޣ!]0)wc#g;=UL^<L 6V= f:T09ͅ#g IQ91=UH#GBr3tenWV(3nv򆧐O0 uBQm22xeif J~L뫲Ѷ,/In{5p@ʆa<]0O3yj8fN8nW2w;=Oh: d$ŴP^$,# hD*al$-;p, wªe(I00muٚKBӒ)]}蹿#)΋DǾ^IP4aǻnʾAH;Q3IG}ũ&m27U a81N:Tʾ)4\A$)1Íd1v|jm%jLɪSNp igb[iG^)6cGȥ2wjN֣o9ʹؑ&J 16E)>Tx=}Hꮷ9 l3 ŨK~Q y˖ȺSjqd+`O̫qUO݋9)Je,Xo 0fWÝ ؊%LTuKlCi2gL 'OGtƫo8%:yVm~I~;J?Xy/u‚ruyhۓX:n7auD~!>L,6a[KjÑ(69+ e9#b8\w =y2J_{7dCzS"ˮ~)թ봟U>}S*e(y1X*A<.{Q*'7bt-fDM"@8/ݯbK1/8~_r1``hQ31.uf/^p˖NybDP5z.Jrԩh)Z[ oM$)@]nm$8E7F+[foX\3 Kew ROT۾;O۶^cl{eIY\p%xRp-}Vvv8ȧȷ3]Rb!@%( 40D$S։R*kUŝG˵1 W=1dD6u-3HZ7nӅ|Y}ŠbEsw| Ⱥ0}j".캑Z-'1*Z.f8i˭OJ'9t'c}Ak}XܭW Cj1ߋY0*!}IWA@š~m2Tu%ʇۡj96VD֊2]}M@K|;w@M 2|8߉Z+(}nj=&|"a=yrݶ`ð_ Z^TSjH}#H\ YA$Dܹ<&{# l*ØzokG1OdСejMԔLtӸdz@"˝m~7K<9tх^EChUmjT5'SRZYjqz'{jO,8qx6[%'2E$+Ho(k|\8(D' eO嶮պYP8J9.uNcmh5 zoSЂcԋ 3 i)K/MKc"=k]zH0n&p?Õ|5-k37iY[E}ڃp^jdsˤ΅W|S=&}-Rۓt9X,1zԕ+ђ͆why::O[O[f7n*0Of~-/={ODiM|kfCl;1NM4`5ds&&ij/QR [KrC}s4fS>̢gE nBe+K;RyOC o}?r4>K?% M̊L|;hM܍;?Օ2h3Gb{:,^ԂZo똇!peILaN\aP=slsQmߏ>À>Ku-?ԃN=kqy? 1uI hB7&jױ:E}|65ͬWGLx )1:#~BcV5R?HXHzqf:c ȩm4g_ +F[4U&·HZHtF?b|oBkIyda|mhDf{j:a-4]HʟݘjӤVR.) zrK`,S&,"2A-ήLڴ:c,~TX؍%DJ64)2P^B sJ{2.]xUIvC9Ya>ꅤX/ƋA!ٻX\5_H,Ǜd%5o{ݵq\eZ*^KtEx <7^&*tZk*]8k2o;ֺrTF?ntA!KDcN 1_iT?G=QA|K''m -}XS{gZ*H]h *T㗊}Ƀ ?9lKDOX1]XmƑcw2Ol S":xe೘IHcUͼjYж%]iYcOT@ԖjoX;6 1o?tWXkp{ʔHOLͰ* a1|>-B(ۋw{^w)KKt½V$]6ѵp?)_}2k {|LQeKۖnPj_3gccEۓ.-i5m)eI}u[7Eo#. "sO,y@5'j7MabIb#˺]X/iѹop? b >6Ο xFM̟/h=7i'C*0cma[!#;4C_Ɯ ]^ [Gt5/0U$5>^KTasB\es^ӷtwFۊk}U~348ւ.:і,ö4߬0QjU1Du!u˫[b/Тq>~[5i"OǶI8o]XzQnL&[xsN^& qVֽǷzʢ3Ƽ$-6vW(bpVOɎ߅}iH_6F17,aaOk&3lKU>b)Ag2CZ ѽR75A(ylT,6'o٩_9:Phz)s$\fc#u@/$]tE7l m!wxPln^6=PGH\$xФÝC# [e@-s`fJTahC>՛>dȌ?)w LCd] y/- P2d˙Nw$]S/7-]Q(P]?h^N̄rY BzQhK+W\r ]aqJ qK&;K捱o3^Τ8$X~_QDr.DZY-KMҒ7T~a ww~_vT,MDFCcciiMg4o7rN򨡘#ʑ A^˵f|6ܛkDbb݊z(N䗍[c"! vED#{fH2ҧpC>~` 1pI Ud :f|Cc'կLIesi.(F3[L~׈(K>XL /հGKYA 1:r}?ڠ9-$o$30(O;aF;6>BjS;\ 8s /z]L)JQ :\|WnV)]0 r[( pI>f0jH~0p0v7X$1D3dP9Z!It$uXSI|nb)5lF<`"hC=x!`[.FsvE6a`ci4$鰡*?;zd^vLI_'G{uH9x5,ю1v:~>/aEكc)9]펤Afg4)vd-,\i!lpT'g]j1AlA\.p0ׁ, O ;ꏎϫ V*ۮf`H䯗kTmd|>w$MT'G nJ2twNC^<Ů\yw\Qr]8aBˊԛ"#eNv{uhG}"L;;f} iJW-?z2ʚK2π5a{9]qM ׾N32cTEG*OE uRkDg'J endstream endobj 907 0 obj << /Length1 1725 /Length2 8595 /Length3 0 /Length 9689 /Filter /FlateDecode >> stream xڍP.L%@n 6 w  8'H]dwUT1u}ק ZJuV1 He` $9 DC@j]1$APM #*Brv.  C8 $ME6F+qt[YCau`c# fr:M {XEsS;: zW ak(Qݝޅ l%pCj e=h`?K33؁A.W 3V.Pv9IVk86;`Sss' ` ؠPo of 358)@ZL` \̝P6YBbor>$d'_kqw;XXnՑ] 3cA<@ 9@ hx:pr6zv8,am| uvz`6@V` ?1} L~߿ a 8yCٵĘjo8`|<Nb  u<-lL9_`k?K . <@sg'Y:Igڃo?;_Vo ah {alAXr lEE5O:XrG;Wap6 +AXe?ݜ3c`k yf!B65Ubd#˫mq

{%Mr㹮6؟כu/][G%G= A|\ 8ϥDiT7\ >jjVBs=W MѨiFflĒؚB3m%f>SW}KHz@˅_Lt^8|6x PI% %F; (hS.*fHXjR&$ixsA x 0徲DywZśJ^Hv;niT9{Qyɼ+4(Vf]4gaU^7^ϭBg ΐt,fZ*+_M[{n;wJjh/Wt-x>湕G >cͤ.ՏU3= ЬelXE4[sl>Z٠U/{trh Gu<Kd5a qc6۳Lb@9 pdLVj~jsN9&7Po<ø5bȜꔷE U%:ehgfL:D,qXk騶z.|:+sܶk-A>JMB~@\Q=\KЧpmۃOL-m]&}u>'sSYzIfXȇ0~7il%*w K$##R9~S{3$:!^%#?Б3"_5x*z#X='͍o(dJqF |eWsK%(2}_2.(ݚ7ß0ht$!o*V = zc672 yRuY3٧$pEڛ8|'R~w/>psk<1<Cb}8u7Z{}Lj+AiDub~ńǹI~¬,>%vϒt j$׃p_ }} ʕxO}mmۦ[V]5W ":!"IsY&6 D*9^/J %o/_,3'ovT 7J";}UMwLeWy{ Z>ߌq)RsoOWdTYF|J՗Q7.}#>r%X_kC%4Df(M ;6Qұ ={ ] QǶ~>] zcsoMg}ElVa-4u0AM:dӫ~w.1Kb%Oԏk1Isͬ̉ {':qƤA/JGfv=qn} {<̯hM~*QV=X@IJ[JCy1FtYz(I(6H7sD~vMz6k E](F kkC*񳢅8Z]#*{QiCZL}5{&厷e4STi5čE:̋ywq^J= uu5z <=HxS4QOk A1QNaķDET/E&ƙlGBS,5u oR[ѨA\Z`3H 92kWQM"G[12fe{ > EۿB8+\$ (6ڻ56EL2, SI\1; -Sl .k7RlQ9^dtWNVΠI#z ]ndڛ}3, /ͯ̊nq[LwvїN% 0U|sL_/{rO{<ؤs GUŘ6PšQǒU123SZ&D HۼEiq2n֫?-xY&a5A#Da?TZ[zQ%[HYət.B55u@V;|T7gD6\M\WMݲ-BK@%6vZۤEzv U'Ah,~z%UB<-۵ 4&#[}r|S;1҃ӉBѧJrXSl]i3'Ṏ6ҝNSn3Zďy_8shQP$mMjT,\&ب\TXӧ>o:C\Ҕ( 닕|_Hôpj;>GF\D6Q(A7>6R,U}Ԙy[__>*.QnT~%p>6󚮍&K"0f&p\UϘ G:CKa=2@F%B?>^0gb+J]ka3\mU5+uAOn~9?lt=Y+;nYU]QX_Т e0E2JW|Moblu4ݲ]Ζ,">;o)3JY<і$0$bE~~?!^cN9Nx/s^]. #ٹK4*O#Ÿ:ZK4'QǦ@VQ%{%bSʥ0Ѭ8^,xIp50LZ zӯNʳ* cAMEZk0[P C3gq.=K{;V"w/"J]J 9(=|P^ZWsaom/oG~~]ew/[ +^uNl aL6qEҘQS@;plu@e!$gO${ކhuh gP^_R2G|NY&9J+f14J$uÈC&糯vnӜ~xHb8ghL=0#wqpXh[wU_6\f|%,?C8⸻qc"3!ҶɻټO,"ƊTvq5R!nۼvFz/.O<vq5C1e ixqM-SpZ2_\*JjɄR]&糘l Fߏ_|lr;L>cWtAtǁI Č|}qV`l֠v޲Q vvkkRE,U,espuInJlbN¶Q\έ..xp3 + =?VxkSUsB)EUKU T |҈NSOYz.JK2lm57JtE<3vt~]>V}-Vm 9Z[_%M@@-F t-%~i~ka&Jr}v‹TȾCM˃8%5 ֩:b)o^bRLhʲ?gBA\~!a8 uATrw_Ch[Rdf&%LE]/΋4-֑3Wųpj?gq keF ?ͽ(*W6ey){/\gT5<]S-sxT͹ilOSҾZq"gH X!Nhu1I&*]r* ՝)JL0"kDcD8+86++>D"ƑT^i]dzNVS`ZHZ0S?"os'Ql&8 ~-*|'Ϡzb9 n!{g] $ !{юW*wpXM>!¯-u u ^Rd763ne^5̯yPUd1E!yhkoكiI4Row]iڏ%=.LsɳTZ`ݲw~p>}cy~CL8"۝&eOubG(`Ժ2֘S*ֹ#$ӦEE"WRѺÇp$hFVܴ"ͩqڔ<ǎlM8[M&oZ6˘sؼ:*LYK98XPU3d#2[iv=+WcȤ[ &泓3})+Nաw"wqy'.DZ+3]#_d%2WUH۬YGl0TQ PZm}޽qf oj`q!\rc[v|X62޻׸ZV(ZE<4o'%>IzkQx@> ;XVI i 8uVRj;!] xʐ~?Zd׋"%}CTa|BYa%zIh'@<06bq̷MUo{LvWw(.+nx MD}y__y8)IZ4O| Di _W!>Rmc195OcR/ky}x`mևwcqJ>&rmuXu<">~ kҡ#lmԀ_&vuQ}^ȱS77% Q-xQy=#},Šy]jrچݍ:/\@>2j@yË.ŏPodUǗsu忤6i4VͨEizaJvv@񇕑UH ><{!~/8W,QNd>T[T![}6鼙(OԆ~vZ?sr@zqYT^A*RYAh S dBDrŸ́tzdx/cZL!{Q=ǨB5דsoҤr^T?s. kbNEKgRoj[RΒ"l/g@ )mb(RPNTec |I2[W=%Uw 捣 ^HȂ{';0#&U)v w{PĞ5hЎ#W' qsMi<.xzsьw{s"F6D(XmoFl(>5peu%HO # TڙT+q(eh7`1.9Ba;$KUM&`1A" .pa't-} endstream endobj 909 0 obj << /Length1 1502 /Length2 6869 /Length3 0 /Length 7875 /Filter /FlateDecode >> stream xڍwT]6!5t0ttIw0 CwHH !tt%>>}k֚\ 3.-!x@@9u]]>zPo"F m$Sz8||" w[{Bm<@U8 `Aȅzف|bb"\Á27(TF8@+p0W 6IEˋٝf E8u 7O-W@ kg_zP?+; ;X|0{ T|ƒFpaNpd5I]5PQFhlnP;;W Yf+wv_C `uOap/ Ո > Q4C@!$!`_K@~;~]]vF P;n "< ~7m`bɎ4CH A _̑"Ü|>e^ CCCοz++ q@@>PDH DZ? X(Gȍf?e琰KT/@B 0,!?KRprM`N>R@ GAS ! :^5r$d`HYsa+B!ZPa5qNPD u C@! y#ANѿUᶿƍ_Hhf@5 si -f / @ n_*,eDOF ?ȫz dN 98 M"@^w'kwߖpsCo! K o0=K;o:^K?7,Ft+X~OΚQ+USplՐu=Y<[@W#xMaOg?qw:wF0APo*K+^֍E G־[}T q&'b;?t6=zB䬹?–_Eid2I\*,}#i Q ]g@*HP bU̽ƿ-|gDx۶lJuq2>t"aqcO]bH=1sNS[8.Ȭk< f"MFI(;S|@jꕖp$^uVdϩ h{%I0186aS˛x-ȐoRqn&|jǤٖ _dk3#$ُO gl%b?mӳP;}[/nt|նb<`;%^*H;^QFO/Oٲ9\cŴZax;~M_؝)9 /9]ɆKSYҼOZbZ7S:\= sa%jxTW[^7JdDWHFLxvB\Ӌ$.4]K"] xOySnFDKQЦ/R}cw^ya\:Ln@N3:+%A gьs$dkMz_Ç-0J= <=Tgc~:w5{z : l s!OEM4?oFz1&2xTv~BҺ_j2_!ڀsَ9m j/z4 ՚]ʳARA"9HGk`ѢZ)tlAP^uh2'rdHpbDhJ Y CD]CͻO`e~:fJLK[ $, O={!㳹Do1oY_>: ݹ&72.O8hJtՔkIv\f3~l)|\ˏN`Ì*0:ÌJVZZ?LD3XQw;d(ƨ/A*>bϼ$RVhp-чӟGr~\UxyV:S|CFZZ]* swvlJ=Zrڬd^V䶂O&Y7p*Cch~:.l)gJݑlbE$ tl8/)~Ac|8حi$s*kyE"ڹ } Έ6~𦖔`Uڭs%u"F.MD4XI4u5E涳؀ҁ5Q;#Z}Q&[5G{ik>~U3όRa{QF8䏤vN-;s$(l/尖eIÎnyeOu8dA󌠉rat1::MW㺟9^y3oOBg: +9t_tRO[kF8Wcedh?) + {^ύ5Zx4uBtnlܾ mIEgÙCQUy'H|0{IfJ5.5u~KZ Э&r8Y_sGqSowC(Hƭ7h?-wNLv<)V}T\ U|fa)L^>4[Cf˽O6ӢZxi׃1 jk>$NoɷeVeFB$o;:բ4'BAn͡S񿾿5R{H{l"&(Wn{?]>NS%t 7',0W$v-[tp(~NY*D*.=C@VωعGŷv1i5-.oNu*O asܹSKwӈ̶؟ZbK rJa%5}%7ؠ<  蜐tnƩ;q.1o,FFN )ei!]Sh4gopƕeR*dKGq-4ƌ{\~0dO% +V<Oe']]:bԢ=x|vȽY]o>E Xj!'FL>OdR9h\32|$dPcw ~bf%\d⌋jpWA+T$+>Ixn:9LMD᧏EG23Tћ9cӗr=>W8^}P6S-GjGŲAj'{$RupcJy*ܩcr?aJf1#aPD=fwf/^Fhq%Mw~Ա!>&ăFXstVpo[vOʇll/D=|!~sgba$!5MCEod-F~@ κrWܞ77tĖg4#rϮ *-p=>O]ba '*[_$֒&=uܒWQp  ^,x(rCPoЛeNwo2Ix &wNwۭ=EhevV Ҳ(w7FFIqj/ ކ @ߧ3{O,(/r~q"˩f@ c1W%Oxޅ-_-Nʪ)g4㏦[<ߵlŰHZDw{,qnZy鑏)p}Lf+n~a gY $2OxCPCQmLѕjխ[ZQNⱳHzhٿ)Q%xe> kSR|uc⑱._%[ n^7Ć ɪSݪ3$օw71p}fxէwsWh)p''W6{܇?RTt$E"W$PN F!4۽mAk7OOR,8@X8a$S96U9zz?Nv0>HY3׹Gf}%Uo./{fq ]WB.`VHAbp-xwĆ@_u'/Ŷy2Ҿ]?y9Yb 'ʱ'1${Fni@a49xSIs # aGj7sA\<>j>#Z|k5<0TdYi &m:%+ {k~ ^gtGf6&ޭ)Q S{=Hc-,đ'm0"kx: Ո!׉L"7Ѧب 3Z+)KY2 "]j\5铦&wT~*t=C3 U4 ή@'c!NWR/ύP0! &GSjW [1 vf o [dP[~\vx8e*N {ney6R} {&|t+K9%E܇9`q!T P9/2|GDD-?;)a!'avIyr `2Ԏ-g'ܛ3KXz^ŕf [:RP) K-ˡky[TY2QGE #R)6HDYo3i`~xWmd :ZűY%ou^5o8LpH;[Sq'GI4|J%Rպ''AF@c&LNns辫Mݫ1w]~ĺ}oM$:hg*J)M䝌BVU)O L .Mba?1alu^WQOsl["S VCɔ{J a/阄i%]7Url &"x7N'UFSx Μ'Ff⟰'QcH[r&۰ 2¿ <]\e}傐(S {+#WJz}M%&qX TԋPgkYD*VoNDdZY~\T2NmOyi3:m]|mHӻ,,Ubgʮ[a:@ q3h.׍>KY8$rvv[s$ɂPo ^_>.P3f뼲Ykn4TN@`Q\\sYQB3Pju;Rz{|UsJ9? endstream endobj 911 0 obj << /Length1 1426 /Length2 6404 /Length3 0 /Length 7368 /Filter /FlateDecode >> stream xڍt4"3+Y]^{o^+ruٲCF!($(;3DH"+w볾w9~>zesKqM%% J@mKKI) "-H Zȿ6H Q6 Ó|:0< i }=@I9%Iy%((─:0?h"4b>X;W . TTD#q(8 4ݑhRG8h^J`0@}$jb@ @ q~H@Sn@+wK!$' r|1$Hj40y!1<U ñh/&tCy"fxA<}| s%~j^H+H<- UtP BF#1x_pH8ݯK6PۯE^`k i'wB II 􇻃 Bv"zanEA(7$鏖C8_d?hI(8芼SFa(C!$J!~]# x}`CP]ѿv;R@IP^VB0ԟ@5aK:f?E" w-S,H ;Ad!pCL)?G 043OxL$A`jC&HQ<$ M .0G/y0HsGW$3CC7bX/Ia8,Bb,(I%@'I ݰ8_(~~[i ?&i 2@08IB/H$vb WYjRA|ʹ͌};)ˇٓFOt'%uo6jy̌muM==3J2֑Q*us3Ш#ntX 2޺Rf< Z+oxiSKeI1@f}_e$q:)SS},>#3Ξܭa~KP. 3 Gֲ.]X,M)YzTe:ЩpDJ;."+VM%*\3LOG$d{1;_.˒s:NxM88J?"L-sE=h!+|'jO6tFZ%{كs![*6})z־{Xb^iz a`5<פnðdY17~NYä_N^ֲ3^vfcuz'<0iD!7wp,౥βmr1 /dVI&?_R[_rثNv;'XkJ|$/@\xdkQ^U\V"G-;&J$rFLT@%G wM)C>Rm^wJu'hv[>z"s}.BZGտibXOצdXUT/}7)ʥ ٷWcsSZeᘴיǸ {7a.4l)"p"[&;vdBFFg>E?=+I5Sj6#~ @o|.6p8>^'~Ebɴk_%B-PX27(!_chr?ыDT`0ỶKh!^!@P _uc\~'N͓e,Q<'&F l!1T"Q =Z @t~@FO||!87*)oq ֊K5J"pNE+xԜPT [tEz3{B#mI(6Y&Ҭb<**5=zI3jH9RP9Y~Љh%$FxZuqsh[+X>і}zqJtd3GL}MϬ*f4Ul\e<xYyvQ &lx\ +ؼڎw}07< Seǩl雝 /?4׈99oSWz}աڑ}h1EK"fȮ=Щ]!^U]'?$8}}L؇d5{ȖΕ;u|IwBB|QY ;3dɫtSxd"Eﬕ@.3^"2~҅Ttt8}ȫd$cŭRmA -#Enr^dok+vwt<-΢"w/)5л U=\I ֡HYnZ+Bh/RH7 wǗoߑ0v9m5ZF4P[ު+uR_OӰ k#׫C;ͱ-MYS2e}ފTR2ŝ6%mVPntj]&/v/~9qY[cjjl9&Ŭ'νrP'}̇k[d#3#|pCݘuvR..I`M.6e-m[Qio`cc"s/wmB6]aJ7;I23V|\Xi+Y~gZݙ!4L kky<(c6 }y<[pC&x_8}v>ZVS5x" rs;MД V2O1A,P(v(~kۭ#o>p+ȣ<]1FrLmT S YdC+g~ƓLꑖ|Zv}L+WZ9W< IzCiOfG o>yq~hnǜaPQ~П:M4$їeT%;L崏^]B6Q}Ry 3l(dݎt`@V7L3k1 ̦R3xһ(ƈ5 Soo^JC!-qR]P1#G.Tp؄:T_Y7S6dbҒk%'еħw?e? ̊&6yXC7%QK_OE &օՖW$,PA,+lyޥuk1n='0 6,~UitgmϖyԵX>4\Ypכk u6CNvb7œ7w'& rS(hup0G&8x}(3aiPrBH[ì 4+Eo۞ p01+}d/a>A`QSo4I4 xLxmgBȅ3۳@?jsic}eCʽL7w|6,yj.wHf)(:r}~\s7mkfdRj8B2ۏܣHks3ۤ?u#AhoՆ&z|W-$|  t?z9{X9`עѹc'ދ tE7@t&0s&.:ږ4K7r5A5sFjνz@ KBfx/r/frx][oW`Pn]ł;QsBD-EX5!t=U3GW 9C#@GI:T W{jbT{KZ MY0mRЉ엊,'dƐw9")n?RVH"(6;9oeJ1ͷK})ߝ9gO}t|%-lq/^Dx1DlDLS%<b{zR.`7~wutěe^nyW+oC0(;'%T+ <(#w6ŸQv╋;Ycsf4GaF~}SMTfI}# wߨYY1k;U7vo.alGS$cqzA%iװV:++7O,lrӁ;,K+ @v:+q֯k_m[3Hz]yӯ,_7N.UKɷɭP1s4i\X}zX\q(jVN5%0\̩(u2) $;ka Ϊ}Ї,GzޯK8X2_|95R4H{6@UV;:>a5i*X|)*Hlo3~Y80X.Zj{JGf^=c3jSX0#֬ySs -Ϋn+yo㵌'"|wE/ԻKGl|Im_3+iv5 \#Y-`"#Mb%RY4sƫDݱ1~F&:EFB>̡rCZ㪀Z^Z sڦ1 vL)2˦Pk!RsNN]oGٳIv&m|]0roԠ*% m\Xd7o[aDlR6cAP)U- 5(@kcS"ox^VR؛#frPw ߂aAhРVx6\ m&7~_{IqU%xȶ>%b5R ^ԒaɷC"Y̸. D0`rȏzBP;cpQy,eۇtlA֎"F=Li uU`}٤Z0FD(S*]BɅ+uB{sd=YL)8zOdB4[99fX{̼{5d8 ֣s]6i"VHv-]`BQ'LXMg,w[Rz}=q~OQiQl;y=0]=m{%-ձfPGf02Y]uYXX웡of8BussihāDI4ڳ2_OR7oCg \sy&5"\; _g2L!9AʚH-Wgvә D+B;ZŖWq s}CF9nl*.Qs=x:%Hs,t .v?u(2t}Krj;ږm1ɇY;;n9/wtʎЕ1|HɾS* h+CL-Ź\0@}w$FCvfa.5?0rGU"!qEY»Bc O4|;5 +u6­jg2cntv:q,(ȻM3D)}#NPYTF0BHۨ2'5W t:m%u ٸ&jSw^RE㌷> stream xڍxT}? t@-%  hN.AVR@ZZAB)ATwz{?s?9{v~θ M!H' z&V Q@TT\XTTCƉ̡^(!^PG4SsDc7 IY( &**"KPsA=aEs"=`.hL^0m({@``Gvz`"  +)+"+Fz( 0+` EA|WɀOi\+ uC(70m]KY/AOs0_XrC6vp0-8" ($wt(NP61yQ(W"`ڬ"=<4W~j0/(w?uG }a2 ޞ"f=o Do$De$%%@ ` - cjDzΘ20g(8^D  8A]`{PΘ{Q @׿l1 p%TQABb2($)) ~ a[m3+]LNx,O_H s￉~WTBy_^WwFpo9_ a7zH. [A!0oj1۠p0ZtKX_8 B ah_ 7opjD~0+Qa 쎹EPjA1;ϸ0k$$G//Gb̬1' J7a105H/_D<`o/7 h'&L l;?#F0$>P?(xy t{}٠+n}7.j(Vͽ(U Os~$S4n]7gu,"FhSkPs}+zrb5v,V,Ğ"oIwZ>Y*7Z2fCdNby6a'sO91ӘGd5YS0MͰnY;WKֳ/$ [av-=USQydķBeqIbCH?KS:N- \[:+%6)jz0ld3) אc( ed_[{LjzV+N)K_X~۲^Q $2fB^gc1S8)?H>ƝgI{7DUSyT@ T(/[%dqGF8O5_kGuv!Ƶm=)^*"u Fgص'<{m1{\nO9#J7/+箛=* (QF%'Tte\_)ľb6TsF9){էCbS\FAkᭊ޻5_Z3f|U3p \ Gh {ܩh;ڗvMyQw^x߷Ѱ&cfM΁:U(( C>ϓl;-r+jEDS^3Ix|5'u^pլBO@q#ݓ!RʇlN~ $OW*O;ό3}$ 0DtE6֊Jͽ""$)fy/0fڎRMφ Qb_WUB WVC]eE׈^&|wRj"2sV08}^6-%(i捰p׷hzvt{W%)kϽiu`we~NlB[.I=xGrŇ[ F:i"R'Q}RZ:Nzt'Mo`Qs͋^6Tm?Д &)@zDPTh*VKy!a>i=^.dq#`ͫP&G OhK=~ 1#CYȠ8k÷ȿlz3Z|m?Uو%mzԮ m^le懚+a2o~V%;bг^j+a9EY~5 +Nw ?MZ=Fgo0ܫx:ƐzqYg5wk!"C9xHlayHzCsj?Na"AK'PO$p5ݏF8aBYIiu|%YBTXlḨRdRVj XN9zA&R륔82L,e?(tO8cO$ Ȥq; tM( 4Yc,[TfY#BO]o7ΠMY՝\'sdN VݦXuv~O7bce"ayfշd/1ShT21vd 6:㱅9}$ }d 'GwbJ Ya?gC+6hTXs˨tҦ?UjvۓK_i5zAjөqrgk3ZYcJS@O _՞ . Imu1?*I}-IwKD MΟELeS_fUҽ՘74楆=wf?S-/?g,ɫ /ޣ4ϭ]求% L1I8-OYsUˇүSn_{:fU F7 ŞR+k]iha OMKbI+ao_q^*;eapDn_bBO㴶I|7;.mKCIzRh h-3lR sҘo2 99moۋStZd)~x7n>7iFZ#f{3Ҹ?)F~x$rݞ+8ٲIm>(x=PkmB*1)糎̍͒K[\+LF"ܨu3y?ڠgV\ ts~|*mb>DIGa+^͘E?<ů]rtLFG tZBEkx3 a&(6LBɱϽ5t\n$ʵyq5}}m3~|Y~bߝ.4 I3Q|3:Fs cs53aP{k~;/}$ ?( EHPoW5 R=bo2C=Yy76N`Z*qi?H!39&;;!/~%}z|=wnt芈uT aK (TX2IuD6t9Hn7 Q/= f#?+MnT<ޢνŪ[5[_CNP`Z8sp 9-yu]G|}PZFBE׎ X DO@dT<.sfa0p9#ؑUGg,LT=lH)[|u/+xzRN[@N۬.ⶊZ$Q ɽ)kc Pj<'̅$Hٞ$xt<a>k1 ;*/ғl/=W}𡔆"~j͐\f#KJÄɡeã39;dt/}*ś"]8md? ?^p>[w1,{ -T\z>2?r6m|q}3Y 6S wT(rj푢[|#2v8m kЌJp~'f!\PL_cZk~vUGqT4?;JY .Ӎw-Ni[BJHӬHBvKo2 U;,*C7qZqZr> CpmDš* g=O[Ř|k_wղqۑq:kqvf!#>+!c(ﮉ:W?ۊ'2j3-'}R[N5K*oC5L^q>1:{VrNK%J}->GzDtP.7KzSCp(vq5zxv`*r:R|(B7s SտQsuAO 5ףCR 1[*;h,6Ӯ0 ]|Agd([:n+KKS2s/_ *K ƴ53E ^n:wv632)?'ZMYgrz.yU@y]路!L ląȅ'jNGWK*</{iK^WZNa*˔$ z8Ӄ}+-ly`> rt=C{vsx/ 諎؏Qmɹs$]w/J ix3$s˶jLzF\id$*^f-~ k&YKH&BsW 0LDӏkSVGS}+I~>Bmab[ Ѕ aѻĽdƧ 2j_{JLȎsvs5'~uT3A\M5#w$XK(Ҫ/;)zzFMt El%Ie endstream endobj 915 0 obj << /Length1 1376 /Length2 6196 /Length3 0 /Length 7143 /Filter /FlateDecode >> stream xڍuT6-Ni=FZBzm 4 Ht4(!!Jw<9{vu羮8Y *P($VP$, Tջo!  89Xg_3 PHPE!XM PH3PD (")+"%+, A<0B1NU7aŕ# TvP:]pg}z#*+$ `@(u1p50g2hGa=!h8gpF@H . Z@}W8X@n" +;\\!Hohpꂰ^X  8cPx ~wU6BpE#\kD_ip\\H,?5]П:!QH߿;fk R ñ@ aIIq :Jo eMrᆀ#/bp "!X-'; s-q G/  [hi>WPL((#!JIۆbv(̟nq=8xuc-[ KCq_"Tc,/wCwݝy~7#;'=NVCW Ai#8HX X3 7@a-(au½?08^vqg]u$3Q I xqtW'H7B $ fڡЀ_k 9 q HuGq2\kCS(\㛰 e&Oo$_,$\/|tdhVnAcʱ`au# Ns72 A42x/?ξJ(,ffKa}]R8T}%k1o]BG^$1Fp\J.OԒ~r{^5Ŕ)n.pC"ob?Y%E_;91%v6q6]`u'c1e\ioZʝn16jdT:ύ6ɂ};&=Er $'8{K1rd3YT`mqGw}2UAs$ I=c7O G>_r58%X6wK8$v)Ko ~xbOK5o&DȂpL,e"m<`m鰃6xEA:k"WϺˣe)bp ͝XG;l>r*\d>PD+mbZ(C|2<M7LXC4.1k*σxj h(' IRC Ґ-&ZÏQ SDgn n<;^p |,-lQ=XN=Ĺ3EX|?S̭iA m/Ffm#`*eFRWMEЪCN1s:;l=YV2CgFO,_,A蛎Z(g)i}!O;]>f,җDIwzc6GzGH ݸ!`v/tTc*$W3eJR&Q/C~f5v Gc~Lۿ)i@U30" w>Dɡ_<93,0D_y~çԸcU>ϛZe2OМЍòy%O:]PXfP_|K^m}fcĘXv5mםψ ~#CꪣF!KnIئIeﱇ6LP4 /%3^WYmO\fSDD+a&Y۾/j/^Opq` };9̸XI `9#W^|I ecWJih/ȭ|F T[AXJ6E ^F;7^C*u{ة߲(PYco1q$xi}i>"0l6W7?"_!BCn@^Jp5^d9dPmLHs*]5:) HȻloҝmiYXo= 9%ϵ0L.]ƭ:a$<,=v49;M뛮G%Bͬ F.<*ϵpz(ܬS8}]GYNRUMP>=i]k>C7Nj*~ ;KxAc'oItq7}hx㦣U糔χᷖ![*)*E62^Ee/Re/F+[e5F{TL+Q@NuXSJ"3sGtZtu.rT=5B#֡igE{xV7 Hlie)#.<[oRϬYˬ&kQm*Y(8BQEtHZ}VQ u~N vZ%FT*){Ҁz(!b>l9"0Ʃ d(u>'n}X*ܳ+ۚ篌OF6"ob^&&kӚϛn|+T?m_]K,@8>8 Yri}, nxfڬTAuwZNR#VQka.4&* rȩh/g|j4[3 fU=DӥyUhRicu'{_" Tj\ӑV_ }*lPCu#&_GJGɍlrMpx}RrQlka$s-x^,+#bTs ["WGOI p%0(m|-9iqTϒ(IuG}ļPJMGѶ22pPqGj&#p'M5ـO:ķ%uS) sT|z9t^kc30\LvlBJrM̪Tjj3U]o _xp4,v &hZ 3Z!ByB}Li̐4ZEXece*qrTY; W"!ӆtq#[*9f{t9Ɇ/N\IH4bgP\CyļvTVO `ξ0|BIChoCWRs4JX_g(X \'RTF ;VY9eS1^2 .Ѡq2a7R'6(? @?'|V+ݿ^]DZQg%:)ny[PF.%vȑIRok!j3TOVN(38ׁR@9[E4 !iƐԽ#&t6̵$& J#RNh  ^PH~Sv8'#-ncWqt~KYQ󾇈i9R10_p㫵ܗ.0f6&d' Ҥ+BEtTXVf !JG|>ySJ[ -͸Ijo~V2B[Ȋ m7U?ZHXu=@!%o'&*skt50Ep>t}T!YDv>/~ αTL`w y'GKH=։}g瞄fp*4^Dʝj&'cO Nަ}fOE"cB[pB˯Q?NEww;ϙ'ewH)7T\f%n JK1*ϸt Y.}N~ ~mYQ| Lh>*}uP/clb7lo?YnŨ4X >N\kh^!CKUTW Vσ=֫OUJSF_0,V4{`Q Ǐ*72KUUXǠi А) #P+:jRZ{HTsSg?6t@[š$F1_$ʕ,6b?v)'.e1d&ү@>$GiVA욍gq!{>qTcyϒM/VN]?X'FA(!cԵHßgp0ӇiNƪm^:r׏ Р h$jrVgㅎ& yJFle-N [ڇzfKv~e_iuRݜ$0 Xve&^;RNƁ|@Zc9j=tEYQasЉ̚v~Ĩv!> CFo *?})GF=5By`˒*C[w1XARߛdeOqi0ݝRvFkMu3yQT\6윢BiK'C+iG]dWlT{mٱɄ^+rsñb]-i1Rb0'nq;ՄIN2lLRCe81ad3;% ?0NPۯdMs?ZhaKyo AITKkYzHW?J H( O+G )vA:e}5 6%AkiQ7.I#*xImMUtXmO+/>g&l6n߹$}Dd0vVq/RyʷMY}Sy[iUeVӎG)MCT-~z[,yMb= zcr[;u+Ă6Y1{^[:Yk29oQ<2mb5>Uo,_ ڳ!",Ex_ ۰گ;rd)K=`"ŹZo "Hڟ`]޴wִ̘ztI_~̑Tyzӎ`7r]gvU56UU͓`,u0l (9 \ZRqct sv1t]3&ݠ@d'awG4u)܋H·3}xaQ>T^^Ě;hcʘMgK.]}~_ #}m P^b=sWvvH|wK .u<ߒ]BL .?)!s+`3ϺBcqgy h@Yexو"#N qgF< XkͻD–q eZytֲ1 gTZgH %?fz7PLߜ{SPp eP&`X&iP^6+s ]e-%sPFk+cRV{Z־ﵺY*ɱOB2 FȻ'f:泆yjzMfFUuK;‡'[vsr ،a7oǾD[tAI=~_b[VC+݃UӢ JH F}9OW֔qUˈ!L rv~szzI> stream xڌP\ # kNn 4n%4Kpw+9=\ QRe67I۹0032DդLLLL,j` 'g?,D@.o21c7Cy{; `ab@ lgہ)D<.oy60sss9M. ۷6U{S0BPY8ƶΌN4w%@ rr P0#"@/&\\@NUi9_r29fF_v;:y,`@QBÅ`lg1ҍ7lvpqftW6ۙڂ\O 2}'߇kmgnd33P ͛`gbbb SK_ <@+qvwAo_n +E3 dCM 2~;'@mL}6afv6>bݿ)W)"bf`e03YoG:+mgnWo}On/ c)ؿM.@gؙL0]M_Q_V$jc_?zc[-&m vj 3JmD3012Kv{̔.7H toKfjv8*o^q;S{`dvof dwysq;!u_!PE .P8@?@?-Oz'eP/b Pz˧S2hAo4ߐzn_3y;Hfo=Vǿoٚ;[CFGFO?o>oaxd7 o\ma]0?\79z?`o/";ư1[?b{۽aono?BVo{f~??DB v- b'7o}s|+loݷ1= yLMyj~uU廿d͏Z݉@?d)~mb6ŃTcnE3p,ʲ#٩cjgfuڤ2~%4CMx{.c_)U#2xt+2TppF{Hl4q<}j RzHf*{٫ۨCqC^yˁ>͑(CyĞjcd79RchՇ$"<݆0_M!o\ĒILi D<;v`jgMi_5yBF3b^qƒr!< EY9+Gkdȸ/z_~M/[Iם{M/fʶ[K 7mʝ%%G_~.MK)v)BcI~@eҡ&ߟrã}eɮREߘSkpN>kWjSm5[`v#f✜o.XASp[J w*gG |nͭ=Q|)X~`:5Z{.,|7x~US!cVf=шJ!#fCaLP=1Z-X$vlq_hF˗a8j3Mq9m *ϲ2r3O1g݄&u4Ou|isͪ62{}Vk(, )U뒊{ FZΒ¤[cɤS'|1d9dpj.D!,2g[TTYV|M}z.b ?JT-=j 3V}H;oJ&56+Jh>DZCXX+[ù(l$ q6Bўes+B$,~<OnIˇh`T Dx Cw <ž ~}dul.h [)L./%Vg3L b}&InigGY  `))+rƯEW̜ѺszX HJ=JK+W Błq\*؈ d fM 4 S}VF^T-W[Z HN}m "XQ:k'lYdȺ#i]y-b.۲^m0N@"j h^U%jvd;Ib'zΩ4sθ«=D P>R^ynUݹe]XLNڽqRQ*w_ VJK6eA+:;Y?Λy{@dZzp8\'r5gX~f#]b{>Gߟ\U` G@+@F!gCb\esSШP0YZ* ​#=LwWf%~?$8*E^y +0惙x!w|r x"Pcάv~Edw ^2H4p@!S%ms ^w  MݺXe^w7:K >C5"wW^܂u3OԼ,իW w~߱?\;p^Dۑ>%,e>#OnK9Sx8JzKM07(u1;:QqhȺ[2h# ~TQHz%Lcnwc}-hWh+^K5λXT%`wIJ&b|Z_P'o;fg/B/pg)7I]:Y/s{7tLXϚm"}[ X|֌ GFk6o}8" 32-}662eϕ1;uvf)+,͇ {@e+XᲐ!3r{M 3CGLK;++j3n[%3Ib`NCUm& XʼnSG!0j$. *LBd]O:Q-DjI~ݞߑl+Q^@y:DЍ+Dvv#Oo]dA<é凝GjAНu@vJOQ2ōf5vW:~6ύ(;V/NKZlxd"C=A~@p#@f:?@e+@*U8,&(uj9Vڙd}"kاfWݐlVҋ@3 EA].}O1G>$v-y 7Al47i,m_vC?< 0Gmsnaq>)~i8`# l_jz.\]QR u/Cz->*j)8CYǙ{ ]oKc'ݰ="NDmK-Id\5_5~<펻ӚCp?)]n$ˤ_E| <ԋjd̎hbu '[ S NGW[+q5 ]~V` ovvIM<4x\-G&bl 38?kQkP1 z/8&#~EO]3ƌOGZF0|8 iR=x]&|aZl۽+7R{iMq*Z NJ;ș@ X*uF!5ooL 9[|rEnihG,FY7vci{03Z9N莹";(h ֐_7<=~?5R{<;;6cLa|PR@ I[$鋜*/~/p'm ee9ӏK"\Bظ;ޣGa&6lh݂Z⁛UnG639ч*{D\ѕO,u=?kBf"8$vI`eU.oǴn¼09ڰFjjUUj OTn`fgo9po1۷ױe"XNW{XWzI5 Xu(|x' >XMQWDˑ̴*{?HV˘>ŝinkpo@r;zuKO}s)g^O)8) ܫK)cH@ID:=#+Sj Y'j;҇TDΏ ۙ)2^k]# fbU0ZRzf+qV4vT6LYŢJ[ 5iv0 v"T󯦅xw\B(O!7U(I=Pbl "][.^CE 1I=qSUU]5ʌ] </"$Wqv\tRnWkyIS6>+t 7]NѮ]{ds|[dQֺ 9:Wv+T鐴5΀[oD|:4 4WǖEM@5T}B'U;rFi>ph+0 y 3=%xS\9K Ok͒JA$.J k-.T(OWNiuG;Gd2DKZe3&5q!lWen nj_vggĠ#xB_XpRߝ?(En~߇tj1AQ:;(m:Dv4e>Lni i-*mݲ_gF%Ch @;+Y$e w˛W d#me @X țO'n|i.QEruL8TS 1_ϒI(˛\ W2x/3/f=u,o`/< ʗpgūn7%IQ̘* A/M{lS5l6~-hIis`\qd@} ];t.}Jz69HaRZBduZ:pJHY4rsbzVOTU!\M"JKWCS]Q7 .ej%nFVEIBt_Êx-YQ7Mij>1_G']:r/zH >/,_FMzQIu_J6ԳƿLP?̊y-W~1G@90[V=[;Om7$ԄCMTs s$$['يJ:helmb] );j*s22^;p_KM|^F%w%oĖg3&scOٛ9|n'^Ui|mdˁ݀Ud9N Gsa=oz5sL5O6B&"\D0OkE:r ឬ[aȧ9S|oJf֟2BeJ;-zmxK],bP9HUBH-uT@9`͒EL|3:&eVۂXtb"[!ig6d%S˛VW y|ͬW_r_X>}v0J1Dc䌍@=f]K{aX;"At#۾"ΆkNq{}t(ḯdw)I PX4%U264 7_ST8R~L^ݹ`*U.Ӫb!@{rrthgeJ.+L@ )WI{<4&+41AbCBjgr Wg'* 8QN\,)8>PHtxo-$к3 f)8&iħhdΪfv7m0 JӕݏrdFAIm6P9akZ"9lD*oy9>Z֘Azws" ZLܾf$9jD{GV+9x?eYؘX _?qvX}>Ț]< (?o ntE%7yv$ʺ -}@\NCq{{X7Ѥlv` J2Rqퟴ]}[sIaJ"y)(4"k`p܊sC2YD%;B"2>GyfY+ZuJP(NHYq/kNiZ 3]2̴2SpR 5 2~'2II{I<096Ų,41o2 w.nTt.GohB:˾}X$REEPWiWLy͈x鑪KEEqwxٔ33(7dž!!L;DŗE0ew5T>5X.I׸z"q}A=Eu*ZOq5[z=]L)I.{*Tgm>J_9:ĥ޺4@kOw4 n t8<9ƕGc̫9dP%i4D/gLPjĎ:PVE/ԟڽǶ.^ p'ۤlɯ t~[Ҟg.,G JV[['5 9x-iOtCW lfQ wW^.EJplKP5@jtG/AZpˍ0ZUxyi3ϒfF`^.[1֑%Al#6j;T NVǘy]³D^]ɂ_ot#UCbU](-l\D93.% +Cz)p&«:z;N*$U射~v[J$򭺄Updu=:[grlETˑtcXW zrWÀW.mRWFa،242 67+Hp:J\MxLnPAb2! t=PU\׈EJ.7<ڊιev'?o&[u!Nڔ~\gjjhoItŠ7Q;}:VH5QBNK;Mp{6zFjc0F W5 a]h3"++NܞĤX1SX6eHTgBkP ]_XZܾEj0 ^M'J =SCNEyΈ{vf.2bۋ~<3;h&~=G!V5E9t1$㭰B4%c 4yLƮF?awmt]N*_檛<+K\wCbe&Kqfv&}h^،W->jLG$G٠g)dJ\8ZœSج=ChEGmC)Ywpd6nL1Lҙ mmxsf-}g 'dz6q׷9.ȝ-uJf~<{^at٠b_9H'V"T}|~8+NAa@,-fkXks*hqi9_\:jK2h_$}R;d H. +r0)cJqxզ#G]!+.C I}g1|O`?!V`ٜcfv&T?8 MjѷQ(P'Cr]@1Í5IF=2WE^0`f/E}zϯe6)|Fޱ&Yf>oZ,Pd-! p&(iX2Ԕ X,x0<e⿢h?/[P>uqfVy|=֗)9/C:y1cV'e.(݆n>,>dU.棿6c5+x&IӲܬXP #SpnBY#:!) 8l rmB=\^tskd6lp^RܷYw LX,n470~KuCOTujsR~ ɴs['G^~Ez;KBCt6}}"@mP(eD qǓII\buӅWd;8݁>USbj+qG1J?$*Pht 6V44ȮemhXʆߏCW#h5y,5'CZEXY@a%6]| dKIcXOQ)J5DkoGM_(P},=3Vif@'_Uw3S{j FV /A 2?iq}cYu[G&\w,MhҨF3 [)!~>u_BLWl!g♬L‹܅#GS`#XӲy4??]%95Xʦ(V# `ܟW15 P%( qKT;7)fft MguĘ]9Tjq4&lrYUa ^(,4iPAG0k~m2JKGy<0Ȉ*m7݄dTC"5(<ӈn^m u*R^o|>ު6xQHƩEU}+6ʦ\YXDP βܭƪ<1e`8q& [>nz~%CG]A.`E,jyzHbh\skFY&iy;Byjs`2l+b7 qU\%wٕn_ũ`W;a:T0Q2' x܇UfIy͡Qb2^e<kr7e ( &\׮nįMBK:N ltIL\*:} i.7yF1dtNlmiCt?iZJgYl?c)':׈U>z<a_&w'FL=kMwb/urK0!WOYfQe\27UMZޮ7s2߯f`;3`&l~'(PGrk*ERzqNFnL}&DK$GWřzpJ/i@HG˼5!! vѳ 'p! u>oZ3~!|c9cE;&Wײo+mn r"0sfpՀUY)'k*@ki?II7ut׭R &xU YZ"UN󒤈 [6($᪖.Fb5Rq4N=dCq|'(kn ϐKn ̝C؈b̉i:rkrB3d 㭦ލ5u%n;u:C`/;'N'S߸~fUW͸P)g?u.)( 4NGhI2N0 i$,ɷX7d3}Kr(OA}rLtD}6V "g#%B`Nnv1t%C#OεR 5w8)IiB߽\Wѝ2RBߏ~B΋-У(#8t4_zBp2[ G-RwP鼬c ι6aB׼Մd5`0X%@p4B? *2p44N7H+9B.XQ,Om{E$xp%A∘*yX-\VWtBˬ J>xk>td!8yl; BomʭRY9Mg琛JybM֯5L_/ ]fյoʿcP}bj*ؑF<&_9hztBa{tw9! :WqM<$`ppw|轞tk;"ِ]PP(Y' %}e8>foWvCV͏8l(_J{{='NmƏtNSy<_dt&= u p{AbIt}3>I"P33U#ăٶ*H2bq6JriL:w8jyb;WXQ;cGj FcEsok[%Iݴ#`UWz$(ZDCFJUѧK,m2q/-&T{AQ }[2f. n2M[H~<`[3_<vU.i3.Q7MBQbt b~<t>%|HHpK'aY{Gk}52FWh"G/q _<̱bWqﱡx?I̫z>[̰WcՄ*[at=Z5b\CwTa!9u~:'|VwARCI-@Ē_zNvؕ/gnAˈm^ {lǿPԝ_P_tv Jʂ6θn/UU=5Nywi;M< /Gz.H0d+Z'>/ZPl+@tg-þ}3YMcncoDi oV5Y7^4CCK^Rsl_N AXy<*n^{p/Yn(BxxZ ]K<6«w%x\+ѮEA$U/:7[3U͡,}юzCV$MBZ0t(8)s`]Çw|,ik\kqN4uA +cztU>tyg^fS:AbCq,: }"vR@Ҡbp97"܋[;B8Zx)eS †hו-cr vnpw]qGHP8mKޘLk-o洦,oag~XW!.~IBh:1, 74[jq#'RFQr#\s6,!7U6E=l=zqzc:$_I8H'YӠfsjm{PiR`W=G}9r* e|gzY*_t4DUoYJr|WsOTjE-nE7Tl;H!~j0_>ty:aʆ9ON!|x c_$&LL/6ZuUGCJҏ]DqK"±ztAH0ǑCNJE?<8wR_PwʭAF9 W>$ѭ

Pd2tec,ZɄʯ2TfI32|l16c| EFte A P lt qŐQl=LE'ͯT˅p qHm}cc+iG+2Nۢ+U?e( F^]LR: IO_Ms_}54 /lXx9< ϡ d3F ]٦dQ}٠ƞ)0r/A'!ސzD>ąx*c+LMcf<n8=^\OҲX(/>u)1y(<5/ޕ".*jtb/|SwES0_i1Ozq-|3H;Z݇O*9flȯ{X| Gksi%q%`䃥:/*4#;"J|('e)42vO ۇs-ӣ2>aa}SUfi'ڷGs=,驶KQpXPJqNPFIbiC9+1&ES3#v\OHٴR&#c+6]ViIVEYȖȞ"R%z-V}b9Ӹh%},GPq"#K }AQ)39_ĂfY6,^. Ne dL͠։xPYv'ҳΊzːR[#b*r-GPGx'Wטk耯{>!/qMb s;՗dw6"ͽ=5:5,_#5pxm{N"rUM~E" IT,+#ӈU'5r27ubY}qP (MX1;b^9t(&au,O^Ν: b=˪ '/;EOCGlV|оKN K#iݿcXHw)I j넵A3JYG[[pژW=O'k\%?{=}~.@DF&o4_!o,ik(?xXNa\Ԝ3x|'_N> %~[أ.o+m_Ja KGl!/Qe]MoBbQ '؈hX7nZGcy߿x7PW3d{].!Ng=vLC'`lv5uL|=%B?lg̡ ̢o]b^&Gxր _<$9޻_83Mꉫ^s>dn>BA?Ag'eiJJ3 fVtk<׽o@_F,F#HkrYk*= k[E#^t! &Sl˹Gvl)5#"EEtr)>dD6CJ,0/tUN=A׼[ձ)S*,^N;7} ?>_5GJ T)  iB NL̓zMSL[H-S3tCA\%-BbL@ oѶoJp?j< K48 @ \]`.(iOf/aoN9ЇʬЅIdy Тd^VazwS2A]QՕl=B{#>ghE"$ pcQ;BWpY+|2 &lC LׯRJA fL"Ric5F~/R\!90 'ao ͢^OﳟW^ 0qPG$/+Vl [ܖ"d|A۬˚ޫ6]gxL ͝ڶBG>~V-%#x8*7τcir ,aCڈu:r=df 1v^ƧoL#^Iu~x`jY|tM?SO٘ OvRV.&Uyh/ 3-%`#02xE}ӝ"_bZMuu^O4(㣕kqH ^ f)}hFWyݨ2s=,LGAp,J-m;Vu%vFz*}* I5/EDjeE+wN *.0^sڡ7)({'Zw^N\Jn?'C?2G9o R# )t!K׷G_TZruUWj㻸: sNqDo|uAX:~e:4% /B?"$kFNjnj*Gb#$ ːdTVX@"oQap={IGb! 'I@*vegQT6`g!+#t鉪lû21b7 M6ocs72Ё:86zz if:8`r8}ѽGاaK,&S4#L|ƅ0yi?0}v2XS5|k~#\YF/x3bÒV뜺R*$#uwv64MLS[fj2 endstream endobj 919 0 obj << /Length1 1739 /Length2 10752 /Length3 0 /Length 11867 /Filter /FlateDecode >> stream xڍP\-k݃CpFi%@<ks5-P !RVpppqppjQh]! 'п,\n/2isC'0@ pqpm*6YTN` VdcO%#SPw#di_2Z;,A@7 b,fasrcdxl@h2@Wkl(m[O+"pYw Ps4VӀ88/߁@?-- *yV  N/ s?J7Jh_:?+ 9wc[I99:nI\/pN`߿5le +wgv0 ͋ !%^h{;Pr ~iP|!@;ߊF(+hE 0x'/Y91cZR r;9:8U[;,./0 \ qrXp??%V$O s^@ek suUV w*lѬݡ@9{=+Lv6owAt/Gd6N--CE[X0dDK䋦f"rJUggyn渝%s*^ Ω[zک,JնM=`b&/a|eYa?~8|N:xv_9nrc@NیڀgY@p%K*JTaNTI/etfNlP*LGK6dKV }bB֔m:.s]۱EazmC57<1˾_S~/T ٗ PiH ܄ q2% Z2ђD\E!XeJmɏ81e܀;@k£Vؾ_,1ҹt(~bY\,A)P2'Mwd^0- <{0NdY ğlzMכ|&NAĿWrCW MQݫ J K?lWqW#ƾju R: §=Vи`ECךs)Ѡ>bk{Bh5J+$ s%9xuDQ?j녟[oD /:htBJD#XEM -MjW,wLM\K1<Գ͚ER$'k'9isyȇiڎ38} UDn:O6''A%F'=UMI;\/eI99p'#TlL:s13[vaʼnPI,7_YclJT鬷2>7=+ `݋b,PA6xA,%ir).,R 350Jo,ZV닽0mH28r"$u;Ke]hlU.3UȠsVBIQcHd 2,hcARaI` h4s(mG |@z 41EmZSR3 tM5b 8 =EJQC%ʼn}#YjB 263R(bmX,_I,tf;'M}hW('̓+}UI dṹgW b4+U"JKAfQJI5$A ssz7:h[i(ϼ`ثhZa_6Q*cİ ڍhcPƬ3*Hp4>v/@ EjMMW`G+(5gC/&8q@#sz;Arh2nmqnKa{uUVIK >J-`D \+${Xq{ۥƐ*s ǪcD6gZ&c!Vy^mp;AH 'Xh]bH6h8eh)E<ڃajTLrɄrM,+K^muWkQ8'Zxؤ>w.] h627g?v\ uwk;a4O0v"!0aqh{b7'4caX D<>̱߽Q`GzG 97%ȘmfS?"+,^Up[Q xݐ v'' +:'QfcsfV;u]#bClX6”jL$h-"ۖc <%;b.F T1Gu(≳9c'π$hAsi)ʕcoiM6$c%QŒLf{748 (0F4*;>E+ 4Q|Lj$coho1TJBI)7,F;&9wx pFm-bFB%ĩ)76LOunmsF%v$<΍\g}y틫7Vr)>9?x\N&.51rN,%'|}PG!@ϲR•̫F_5պғx+ =TLI2mxlsnA=n4,ș(.yw.݉uFw|n%}f)NDgjѠ|-~EK<䢕ˌ2fdžG?ė+P*^[^ُcb$#$=={&eTYqFƂރ  8}rN,C6!L@<19X8,YUhDG*<)zC+O2L}]E2F&BFu='q"xfKIk7W7z@ c;rv Z" L`^/pf [0T5 pwAZC53YKJ&VXie(~^vGkg4r/5t7e[ V=U!ǘsJَ6kRaYAw1.:փ5ÆI BJeeKTw9n5ߔԢ9RE^)r ykGcN\ \T_7eW bArlGgJ&(oC#ؙv%BC,cϧw>b'"fPc뇫g9:Z:}ԚU0q).<ʶ+e_U-@ 0"F ? D YivNNDKdM&e6~p 񯔼v8W1ǂmbv6ĽWh#6-#:*MRpv+^i w8pDO#tiharw01#5t2aT/>R,3t@u*壌%Ul淪uwn(EqA*ot=/b"aÀ +x*gbqҏJ1ӳ޺_ IX(U{rcqd]~IGe+IK7Z'gDvΘPɂl.b!;ơäloR^Y.%J"T=|UK|'Z$CY}wuXz^+ g$ )t+: ٶwHk6N m[V=N+Eꦛp^Q/yܲ^:]Q;̬mz00Oʷ!+tp~ެ2j^~d-]ЂE On܃uB)$Edm>G%!njcSrRN5*ڥ{ݿBD&k5u7ΑH,$ ĕAjz"@[H{rw9-Ouثr1sT3}g-Q%?e߿zn;ov-`="$8%v<㭋̾ 6tnOg mC<)b?BmW<*\~tJ3=.m.A>͟OvI^%~'f}5[9Q2'rXT\ 5Qw%"wǑabe]1L*88lz:B0)9|`67\8ҵt:܅ QPs8l-e'lTSO4./F( _f0Y4Ѭԛ*39:_~V1cx>l^ES0%,*WBw9.=iI#ӣ v&B!#Mm\.A {DNVl] 3{3m\{ڝZZωI Fߛ'9?v>&F哖'9xXyGUnt8Bxͥ4\&"o״Ǘ$>iU1Q"<]E1~궨${n8څ|$;lY]jKj&Тx5@fkd_"/pSN}ԨtV`@P1F3 d](iHĐԕ؝"֞"I%wasU}z92n.d^̊n]o]vS7C?64Y"K0!gQ&R}7'p迎up)j>:X$p{|;%盃 KPe!蘧=DÎNr0?ùo c8 ίh9oT?sYhj7drY՝U'J:o,09h>= ،sr~P`N/_nsfr/Bv"]3X1 z@ngU.lg{-ٓ_sM:Er_GL/&Ë.qKɝ<8uyk(0Ba]'Sœ`.W-ܨx6߃;I16|.J5'IƠl8 "iƓHf,8AL і !'B3\"OUsV~Ũomenp\I1˧m#NEr0i %9Q3>HץHt!oѧ_t?+y{G]|\}0.c8ݩ祉á]6m&I^W4)K9 .EF˯o;]_Ӟ}øډ>J%ͧ|dIGUب =%)?*;EVxt\W,F/V0գL(7=OPE~e@lHh7E 9tX7 ٣RM1zY(;o, ⺿UCԔ q#(WjLB]b7>gB&7+6=6]Mv]?6q:t:aP,mBG%j;[P&hlNe#&">,EnԐ%e.ukM@ bhX\8jۭ9BЫakSmZx3w=~ВxB f}Dyx\hO޼f  }LR+Q$d?oqh Qf wr(4;9K7@O=\oJc *>x7_aJyT0`GO!:8UK|Sj)41ߪ]L^92h 7 @y$&CP[a͸]_*myĞ?h)WSz8oe&>mۃA?[R" Sj R02NCnz֎ڝW\UJMA29,.57SvLosZù?jW`Agw |d,4\Ef⾠ղEgnj H$ ^$P8N68[>z2js }Ws#hmS۟g3En}^xKjS9`c6 .c|n~v#Oe/DdRU g 5jDlP F>׍+m~]"`)ZQq\IXW􄰈&d8-:ČX3(yt-UZ'/Wi| z){ (Ao>}!t>iHAeCdz\G)aJ}NF 9Kl'|TqX^M)!8)a_Bedn Ӆ1O#rUsHD3(bY2x!ЀyW/%sJfc-q`Xʉ{>^OTl6-N$;wFySM.uzt^cjT(1QՑ_ x dWSDHPV+O"ʪM$͵LGvbv.rXIi[Bb__mH!e lbu:qj\j@mYh+[Q&Q_ /S_4 WBܔ^~((XXhΥ0"Qxl>W6 VQ+NF j]g*5lj+|`Pvg;Nd@( P>>.>'%W* 5)IC(*Xu"3ko&N0)Emz(K| DU`DJ]V' ҅ iӥZ>{1(=Еq&W/)Ghw2C2TJtMe/;Jhª:oDj$sLe6{VeS~ ajKg|]Ty?KDN5_*+ŷen^rV#1yqA)_;5s9h'pV¡,~-vSnsnp%  3O"Zhpg>Q%c"nڥzxN2{&ȼptI`~65Շ'\Sa)5lpAl34oU@neª $C[i)ks`Ѵ޸Th?}rJ{g { V|V|"wyAxL72<^aLqIBΘqژӆDh9p,nljl W$:@ o-;+~rG{ۛ9-H#NI)}]\ލٿt]Y~^Nµ[ȅ=q[מ_ _NXY+3eR S"͎ 1 {< #n_\XOfRc=TW(xV&V.D++gUr0=\i0. !pV<c'x%>_H Mfr "V9%-)V_Lʥ0,%E=LhF_QfX(I.rk`i=Pg0-;)bQs5EbU{2Ey]^LtgQ:g"n"Cg a&yBFFs nrko|taNnw=̓+) Rl2o#%:3|nP,2yb=8ny.$m,Q%|p?&)8d"[&<1 =IT:ȝ ĬallQ,~{^dө!)Q*wpד׫J+Rt brvt ?w03FlFzrk ^ !MU X14sr}n{댥6XA()өͬkgӹ=z_@ҵ kS!7oQ SQ#ɬJ,"{O:6G3`nk򁮙"um,%"H endstream endobj 921 0 obj << /Length1 2468 /Length2 17521 /Length3 0 /Length 18955 /Filter /FlateDecode >> stream xڌP cݝݝwww'wwww N ,H7sOrzն{w %2P֙ "`aagbaaTpWOttBh : el.Vv++7 v|QCW ,@O)bghaf O1-ow  kl1Z-͍ٞƉ#-t:M 3S<%@? e;Sg7CG $0:\\lM;@YJ o 4o daarvwfښehhd7t564!@\H`-읝,06ٚmOh ?kekf_djakbW&.̪.@)l@"233 tݍ͙"PdK ` *ca }{9Ύ.@?YY&#- 1?tmXK4a&v>bfay1 JW),lb08ٹ\\`hOxJٚx,KM g=hK4@1ad1a<Ho= 6XvM,,j A dkfo#--܁& Ī홵-P⯛t2N[2ۙdl\CGGCx$qrXAht{Lv :#_G `K`"Y70Y+Y7b0KFf7F v.E< vħ#obW@ "^PLAQ +AFx#GCc+ I1Ê_v_'(5h+Kbc9a6(#.joPnKmJwF{؛m,,ZAU%6!2cj ڍ?~'r5jP0{Уg?φ=薲۠7_j3XA? B@? 2w]҂Jt6t2#(y.RfgsG'*P Cew2s7ƻAs @A V? sE:']Au_SW[w"pcܟ0OF L[x'<֏+Fs+Fu֞42=%vxߧ_dFnF_xi$Ԃ֗0C֖TuH[HINM]~£¼Dpl"i)~;=\s{+Ӗp9,Jl~3Oe S o(qEnw' Wuk}&VЬNŜx丏Qoo"%Xqs sM,ӯ%!c m֩q6F[/_l7.*4-Nj-VZ}W@dz-9NoQާl!M[e ΑoRy\n{ŮcpEK3$7ͮ/lγ_S o#[_V (M ") !!|dWeeުseѦ8MοPLRKr?TffqN'h.<<|KE PauW]?ocMr ڲ/4Ê7PP/$%uv0^S4![osqnN+{`ŎN-7Cϓ9Vcڈ˟Qb'~l-v1XcMHeEyN!.啭D%\?Q=[\P{-O U*(3yD߮&vf{|ūKc~`Ak@#Q'W"{͉E ngG v2A^I)\HJF6)zu0W!rD5$WSCۤ?!|F3D1-KlKAO+R]M YK'gKrQ[#ѭ86y{M'@RUjU Y:=}LiFn;N*_D{!Hu,: ގ ˠ` UT*l%#{h]Scr 7v7ԥ4*4Y*"rU{*KߩSPz~c9ě.9Ĉ#I1p]bcIm4a"yO=چ~2E2R$}gt` c×n+}eik Mʅ. 1i:  TZ kk,e< +'Tygīn?C'qJqD)=wšHȓVz 1e9ЧN۝$VW!ybzUUO"C29K;$,ӱ@:|< Qb&Fwnftdf?F *3à3q-{9IB͓%H["8b,}Ev'p+6nX u2<{ӫF;-%:{PY]᳈7ZG>U7^m޵[vxŚ۾;)q!Y$˕WL.FbLnBzpe>5yš=3[{WPuE5+X q%_oxƭzf|75 SFf*2>qX}tMm,Mm -Cfus47s|N_?ɻXS HE_daKа螲O`$l+m F7橿QNj$BQ6dO/I+рsi3 ͊3mzD1.Q D>lBfJM%O}(=(6r[&:x%`NC5,ljtHt"?źIEοjouBQml3N穸(ٵm\!jk(UbaJ쩉eN`Ds\ z}.zXUxkQr$C٨@Ā]#᜙eo37.t޷K"oCoָhLCc沒 mamb;la P'G*=3rS`!>MsG3DHK3`.[OxA !8 F oTHRg'qxqkm`XOM݀kRW .>IFE;+.Ub~iif-hD߷sQE= JYhS~ۯޱ;Ú)c].ЦۼΒ*"/3ˀd;<-v2H^L{+)⿆|n(袐M3E<;2J9%|V[( Bt]]#'OQCu/Ŝ.U%ñyJ5[m[1fgP:=f;}Qx>Kr/voHYW"̈́5nN@TrCyݯh*'Mt5s+^eUY[޲' zs퀾F8T&E[+-gLD&OY/k +lPQɤb2Ewq|ccW oEjfͧW&0N[OX';QVj.f{~I/yQK>ɳI5=Rmx3^zP&SHy]$қsKW{Rxzᵝ5[)*$ؕ" FR jR*g(",=c=+< KkHysS:H]Ydڲ(4lj8&ҵ|m'\oz 2+YJ#>i%tGOIŨI m7M=R-/C,~r.T:5V[]!dVRnL lD~`9O}dh1Jr6Iwc=OJkif4fz 5 zv/mi>jN$jM0m&N]Ak1gw~ECq+y z<?yd k+猆G97ijO X˻ȨE22+=SV{|voOmM;ueB4cZ7Lʬ#4yX9Jnam#bUdc 4 uL">=8Ey) ѺK8hlbYD+Cd:p&y>~?f{3 I/X:|bF0#YhiL(%nǺ1`H~58)5ϔ7O<]cLv3M.ZXˉ:e .5M |GZHm$\ci/<-2Rr$}ECb$ufB.{N.B^2l6F/ZW5 QtI7Rl r847Բ#,ij 鋳CJT8Cjneڮ՘.FdZΊa=t 1d {M0]CGE[`VNH00yųMCi}-bc DcL3#=t=2#F=IŲR >eJΩ۵-][NPv @~,C9W~\ZRkb6դfJX]YXSJ-"N C/ 9N :_~Q淝hX~F1֠nzs}qQFfea_vh4?8;ISTg6bT @q^&rGز8Д ^sH{yqW2~?!= aqG0e':"|dl]q|QӞܢg1:)pg=aj[3{ګt=_oĞ\ DJ-t@eܜ>Fq<[vUO_`c2֏DPs:pf|r?)KñaN{Ro;rpt=wD 0*c_&NHuh[PdڦPL5|,m:. fg\>.}= 1L?>z%Y1k촑kf[!b$Luh\sviȏA,2^F*)t܌84(G|> ǏKPsyR֮ 7&Đhsn{xSj5yн$ /~Ѭrjptx ; ݴQT\@ڕNj0o ]0Lf G|ہGő &ķLD,'m.dos$vU@Go;z %`BLm:󯩓6;}cӏp;#'2NZ4kȯZUB$ӁťFʨrw81l qfPTS91y)J?KB;Oo}<hU3ȴwό^$BoKh/<5UGGC ;?!cV\KGnVV}1Zn=ov:SgUB拓f5[RVPқ+=VRfm_3?Oմ5ym6S yĥT<=c \^VX_7nn+< z9d ,~|34+z'Ȯ>Q91 J=bK vtSM2#eXր mPNط )겮~\@؂z2vRߎ+LzV$"tz6:c ZacrYf=]&2 -U)7ȝ7U oPAwW~dBk-TZx/XMQB Wjq7ZL^I7eVo }9ű{SHH.l8%. b\U/ă1bzbbɋB Fi2M֜79XY/|oIT՜K+Z 5k-OpZHB$-G~<т!֊aF@wي|E=3b>Ix*vB' -!3~F Ͷa~623Ar9n[U}Ç,:1[R6`sfbCGސ)%ьk/VmE (Ks?(ҺŠ7H/ RqP IKKT4~zI1ez2[A5AӠv> sqS-*+ Q97rCWR2WĚ~}rV mz/!92ucɫfƺ-~0y`>hQh r*}XutdEڔi=~#ID8&%3 MƼ@``L[La&hFffC} q%cod##HW]BiH]tNi8Êfuw-K9F.#é"%!h 4jx1:*OR_4(' WrL~TpېcYPBB^D 1UUW=(W+Jî,5޿&h#zyS.0qBqWד*/]*eYMlwӉUrswA|aLnݟqW^Rqf:Vo`Щ Փߨ:-|"Jh=ʞ/6w j沲nO[2~@qL L ,"3EoM/v'@5Q}  6 `_ Bi~"[.BhH _f\ $f`h1&RA(KKP~*6F򕢽H!.ۈ~smC(O:jX b FkpB^ƂTRy /C_I`ޘ/ pM%u4~ꇎguɃ]MN)xBC#C/39`-7aWSDmBOw5k%(?85h#b"ӘsXTK Xp;~8]w>E'A:'͵ca:Uy/~!4O 0'i N6b֔Q_gvzMiui^BS3mu{45^:jK\'0`ۣ`x{$~" iNND$vh}I duRntJ уuW 2,`vod:>N.'Nnj}dPCo؁4gw?6#ұC:ZRo}BbL}ob6rKttuJ?KK Rpm;̭{*u- ђg0M+rM%]]Bَpv8*GU×I~fzIlZj#+Yc"gb~5q#pcL!pr$]~Nt 29<"J:S&GbpABR YQ> .2qKguº7]Ie}NY[/j_ERK[A} w;6:ӛ )7и'[>;jH))y6O=/ݎd( SJ`x.s&<Ml9FNU\-fa= C3T*_tYTΤoBɓ\׫icA9-;X儏- IfiOQBSZփ# dj[dJwgÉI"i1ֻz1 ĜԒ!$E I#n&:&3r9^34[˄wR^Bn3n 32q4OD qxv?05j-lЮл`}%LE'woB3a*]$Y1k^Ş Ed'w3*#vs$K_ nQHf2+<[e;g 2Ԫn xd3gC&zH:4r4@miK\?70{u}1xˢm 4OL zic3mGK .mYQFgR6Q`'r~۵ KcJRW;v!Lr{+h.QuqR6z;핓[!* |._NNyzDLqhE: D j-`$Zϴ٪߻yOL*CǼ!jԿR ÿO޿cc!)Sܞ8ca睟3!dt+!KITi6!S{=mMQKH hA [~7.EǑOj:G3 i2N2 T/dDMbqu>EIeHƛ 8\RL\lTiT5ukg"B[J :#1i-IYO\>fh0I.ٓt^iJ,߻<wzp;?"v1}djט $e}?qlDJkʏuŹ%%+^*ǰ=?؋ ?46Hu~xS[܈MH $P|4Bx 5pkx֛BїE7Cz tR)j׬ d5G>FBmsM< }| 4կ\]>f]mcx8H8 U#kKLy5󊌭 1:":GSVwZ«1 y~ysz YrIrI}}]b(*IxntVE#2Ӎoo$"x5UQ2?fg_}yWB ҶJK"o eS#h^xLb'fVX^V(2JWY`&T,hlH:cɩ[Zn?0lg~6 A_DN~!4_A,E}}^`'׏+^SL!]12wG|k5S!խ*TχZ4&+&#?/]wcyΐ-qGDŽ%э n+6Onc}\~>7 {Fni!mYWVZAe{t_Wֹ1wC.0N rv́p 0@0oL0{ 78C_JD^T㍟):9]"chsU ^8Z9^+Wsa=uz^` Od ij-_%O<,Lwmv ד4HfEehhCs| 3:=9.,73jV^`H+́R%5[;TtT̰QtJ')W1)?t0}k$Tbcx->y9Վs\/_&p"uo3QKQnIP6.n '}fMhA e: Lc`vQhn~pEafȅ`.x(娬fWW&FzȥҸ S}0tY\veT@mIb!oքR*J,x\zs KO÷ |oz}fu!e ë nL=x?etë%´Ǜ\̟!zA`kξ=)s3dJYs`-u8.4ɲ '/TӞk?FK `=AȟoNF Zİ(j!q+<$؝0BW8g7sGXLFLx䪒0Ql`Y H5H)KZBr|DfR2!GX8b 3+B[w6S0)VDܵ#4k2yeƮrRTVYW's8$ϑD+2qṱ]-ͻGW[7B7omtw0W/E^tI C~QAS6yl~H{SK+!36cɢ!KϚPCv3BcSv /U.W6ÜCTw3]6 '9ѿ8syt?ThIV(Oj]B~_& %s'7R!g5"d Y#D ,;%} V<U͜'Jݝ&ԇ~c3SӴIWipGlx'r 7/Fr SQ1c ~.m|`"Vovzs<Нur5|@{IOSQ_ 1=i L*ԭl2ΏOpk| =#K aWۿk'T:yB4tXɽejO/G.̘ A򝣧B' ңy!ka H*gzM-MImlu 9L Wh|o$ζNM;o |Y=曧٫s>TN;S%6TbuNnJ1Ǹ_CP=llE9^|'︕>CMc%SzL3Y&QGgt1;Ȏwg;\)WѴuw>˴{zwA~Iߎ巢iK@s2$LǜUT-tP^ ƣ'z=_*+ku- :\5P{Ka8ȶMCNHh<?htZ )EDUyD`ԉknypeM~%%ǿ%ל%N|OY#1p~z_3Zw3%Yypȭ Za}.0q{\7Ny1d\ՃĻv>w$R!YnJ[q "Iʥ(]1ϘGv%vcӶ>`>fIq1+D [D+kb?jny4DѹLVUGusy"CƯ!qq{hE4 pwT1Y2ݡF/ӏD'J,Rɯ@yo3'_F tNs$5+|6#d!M9EWBªt)Fq-E_zc~L<.C 3"#\*"pߕ8pKQCpGzˮ%Cwבd+XqR/DQmdODN/4l I g]=Pq}:I-4LY,5O\nIpƔ/m,vN]eӄ9~[4 kZl!OU/FY#@ZkJӁ~)lGsF;( *p orZ~fn! sd\Kz0V\?E\ 2e17y/C> &ϴj\I.)5HYTQϋt;{-re-NcվU% %l.Ff]Hْ}il2[l -J$Mx'6zF|t0i~o\9{Xitz{c DF9.d_@ۤiYzyq cSԜ; YGQvU'Eb^qGpW *xBNVVk50O'P,2TUk/YMO4/^EHwmu?W#lg V(;aL,6JFnvú0Rr}ޗ\1Rs> aԙ!\gOw yîozJfn/?0'&l ¤M+3P∝9]@o1gH%#9KZ"L|Wwsޱ֌5 wX4xcίmy8BlyA Ӌŗ8]%ͮ0(x 3 %"fc+eJL$y0%g4?[OVbP7"\kJ{m;oa=ˮQ<0gZܸ}rSHրi&ˡO4 G~OY i^y\SRߤ(`uY+[XQ?ݵH\ u062(XXHVaὓGyrgZOXf 3h$ڃIX)QB.1NjsZ&?cleM 26?;!23EMR45 ڡ c#$D޹a Ck(bEu@78arpjD០l wpR%zD;h`K~4qcǶ4ւύSH'4wYm" xK3$&k X5"?Z%sW߈lvگ{4쑗Ѻ3ި(Uv_^RQ U]%7}k-PzF c,JS좴e l̈"t2 w⣝߈ m[閥aEVʹ4) 4pV; :GrSC9әB_ J@2Cof/LN$qm.xk͇0lufp5keݘG[:11YlnD&ayW>=( Gю˹fL:GmAdvg1\rũ6ՎVNlr_GJ,pSءaHlW9lt+^MYZ,SCpgƭFnv)&ꉕb xӝ5[X\eÝ.F >ʇ|hX. mh઻kj"DYGBbwn}52F+v _'7?ޕj-&ΨDq^\%%x}xWK*[?OL;6x =&Hk0S6L>zg iwDlp-П1"*P̫]RCHTqe 4#Nw?("VlK\<ҽ{"xE()>|i-5:ľY7%yHϓq6-OQRWpD>͘ s~cy#5:K,rkM* J2昬'QM9LigtpW!VX Zwe!^ +o(99M{@:e 47>|fdpl.꾷7"pRTUx߶uZ 5/Ey'5̡`סZطr_qD#4?uɄyB`] sN{tcc"#XƳf7~JbECG[S>q0`L/"Y+ endstream endobj 923 0 obj << /Length1 1584 /Length2 3174 /Length3 0 /Length 4171 /Filter /FlateDecode >> stream xڍT 8Tm/-4^m*[/Gv1}G} Ř9ÄfClF,,%[lQYB&wH_]9{w?"VZx+!h(8R1F$RDa""D'C)T" .I!@(ye2 Hd2e 0$@*LDO!Ӡ]"AsGlK D!}蠁 $4@D*k u%jM MP`BXP(OWЍHAw ?8"!0<|#V7Z&(@-# ȡey%9 (XF_$P^,436 LoA@͝rHBd_w8a螞zG"zoX@Ӡ0!C@}qM@cmo(RUG:.fij΋u BryXv/3gl^X \L5/.iم BZӗ_?{h"0+g)3s  Y0}Ӿĩ?{1mEa>CfjΪw-ҎO.0(LɡyT_ ]AyLJ`y۝"w8*N3L [R{`+Ȭ[Xa&jvҥ7wNs9~DgS=YȹI}NC{H/LS!WDt,?zTu(+/ oCƴO^ZZI}l,wLv"L +}WOC "w զ6Q-k{;eeFXD֭;EbO?]65F$9ԅEkZOSE~lcCA)cd-e~[F!!2⭱GF=g+0$i hTjq|ܴ*Y1]wDR+|g6KЙxΤ_QE}m .^1l9Lҍ}Rѻ. ReѾʨOe^g$:#V6 9t~Ϋpj.8j$PoU2YqEP(fN-bOc^*LW"v~#fr-qԵ2^vRNMۇW|f3?/9R7{&Zu%PUټ8V]˾7vߺO=ޱɿ }M"Hxk>_-:YleimDgμ;k.h*Dh«{k]W0ؙ[s,fljʉ}: -g;w59.f/ڐ֢49VlU啠ddySoP|`}ím}sM0k\PZQWUM^$79)?]vC)S^jn[" m1DPZ'm>yIߞO~;'3_%$w`ҳl/Ɖ:p[9]_+* D5{}98}x/lT=칝!G^-#\,0@Lx|q z__1~KSuL$]>ĵL'+ F{M9o[2fo3੿=>{I>V4%7'vM{.<ϷZЋ]KƉ$Œ (TEyrYz5俿YmwvT8BgSwf|,&?7=jEsţ(}2j~h.txy&:.7TH|n[Wf:G<g"VLb\ӈK";N Q,ꀘCJ|NgO^ 6c]L=Sx86sElḰE\P)usrBb!]M FXCyJqvsCY ̥_VөZ2Vi #w;͸-|*g/ο[|%b+PW\~/0-ޞ^~CLIێwAΚ F=z|Gad˴frQ#G9bȜX)lʧ/,`S"L$5xlMk,=gLDmQbCg#ʦn] a2f gO]vo=;kh&ݧⶍ=u3nǢA\ԥyAS܂ CylPsY||$턋[JZuvrӻyDMu۔6sv@Y+//ty!V-*,ɲp\DbJw2u#`%\K%U/嵄Jo_˩|zjIQvtqy)yy#F.a!u;~Cqk8aZ[8[ŋE endstream endobj 880 0 obj << /Type /ObjStm /N 100 /First 924 /Length 4649 /Filter /FlateDecode >> stream xڵ[[sF~ׯۉGImml.[%[yHHDL JV~v 0"E`ӗ2A1 $ O"\ bD!HRB+*c(` <`R TEp`D @&BI &q DLv4AgM@ ]@8|D$P~*P4J1@\(.h+%b !;Ł J:#ML͌xJeA !iq)X?@ F3kMYs!$"A#n16!{%:^jJbiЛH\ȐZCEE S#Vd(?PyPe_ ܂}cD(>6;cU?GR׼.&DKmTs\9+fFV >p,Pk!r8`O*@р%%c$^LSt)0%7t`n._/}r\4\ 52E?O@K׿y]3ٮX} }zIeYu7׿v«yi6-y6/gÓ/.^yD>I[ׯg?=(0Xw78p˝=Od w4ezNux2-_ |/ës70ix,p<,2|صzf=DǝYfh>FZMSy _c7 Ix=lX>ͦ)?"}Ha0qa8 i>a`sڃ Cl6B1`9$< !B.*JU g'&fn,4-`O&,4f>)ۇWl/_?xNz >0a^10 |FIuXvЛT00m8p]ޱ+r'lk#I|6Z QV'SX, ,l6|3&f;3OzJGa~A&yo;)ޓs[+od=-'mY_禔`25 eՋ(͋,O!x荪ǣw/w͚n؊Bs~ d>N8k&Uʷ{5n^ܸ\4OߞJ՛]{>&}{g~GVS?A_7cHE2ˆveiYt~0ڏtL:zʟMW<өQ\Y5@SD;ɢ Z)fb7v[E۷3k۲4 zz|⃉Qq;*8~lT}:>;;Bcz#!_%{Q.sF5k0'|8Tҍ] 11k6&zַ!Qz7u4s N>-9mnkG`*`E!֠pye ̍)O*3{ڑk$(\}38;B l"o뾮;+#!TbifLl Qy|Te:rjQ}z1Bq/*R%XLymڨ|:0G>M/t@3zΑ3N/S{^t Ʒk^$qp"oWkw+8mV qm+Yo٢[Jq©[u[<-"}n_>oMۢWz[]ٖv5j^>5h}s^l1h*mrB|{n_yQ_Cr0K8}s8=FEm~ l# jyP;2<xʊg%ٯ6b?-sVz+¾%XST÷am"iuϪ{neJ?+CW[lRGhkW[,cd0WrzͯlM 1  9򟝎I-DV^UYnZt('TGPMHǸ٘p`xTR|ӇUjRZ> Oԇ|Dw|O5R w6р)]c<fO.OcoR{f+A]JVgWE2ٻãuiCt}!kK]*,ef̶Ȱ^Mj9˛Y_F:6t21(F7$+ʥ=+QvT2p?? ZӇY__gqr9~%ZAW7i==35y:t@7 R(2"Vv۷BCwe.:priRl:t2tg1G(nKշ4yūY>;؟|&[ͣ] +LܿDO0<)ȋWB񢨁m>M)Dl@Bİhnݢ0 6^l=U?BVؤ :Jylrw&Kt nWmW%B&nGvx]'5EeI7~ f7iS9ˇǧɫb8^d8]1ij8L %&]&_=fqOM>zE/z(MZyoEɾ~Ejᤩ}R um}mG(RG~J5ig8jhP)3_g#Nqf;wK'pǙ&"=z:xa$-0XvRGƬĪTb!SEGDJ08[֪DOMr+`I”b,-~h\ɝHݧXfM*9S]]e ` Ubq*Lgo4 (scfcz%U^\S3Swap!4)y4xO1)u*RnX<0\/azǀk3'ݭ]Ru녩'$L> endobj 955 0 obj << /Type /ObjStm /N 10 /First 78 /Length 446 /Filter /FlateDecode >> stream x}Sn0+h#ǒ" @ (>=9(6kPdÒ ﻔֆc9ܙXPV}EK* $[ NRU\ĥ:wUq}]Ywxªvr -)=[BA)B ϜPx*/%S.<77 =U0Mr VN~nB!ig**'|~հQ1jFݮ>}OWnCn^Ji,c KgoBl~)sÞgȉ!'BddS%<噴ó]<r oaq.%醭j2{hأa"|Ώ6z:jJV?_wOu_7MQ>P8QrQ~? V2?^v_]86Ӳ]h?£?"v0 endstream endobj 966 0 obj << /Type /XRef /Index [0 967] /Size 967 /W [1 3 1] /Root 964 0 R /Info 965 0 R /ID [<1CE136ABBDFC72E3450C59BCF40C33BF> <1CE136ABBDFC72E3450C59BCF40C33BF>] /Length 2403 /Filter /FlateDecode >> stream x%mlVgu)@ N--oJ O[Z^J)-/mP|ɣ8q_dQM̗l~.ըk{ %:`̜u-Έ/u}sOمqőEk#8JJ |5C +- bq IbC ,ʈj VEĖۏ[ [Olw XJl>PGqG;rbۉ+&w%XE ~&ևbn#] ^&6sb=͠F ` 6:vt h -U"W: F7`݁n\OGl+wϴgbw]㪌JZȪd!H\GQ0F8$8 pLs<f,bƻ-Z{xԵX3Gt?Ab jOuNUQί#fѫY g+3~倞 +ᑀG x$i_fa]e7J6A5:9~`}#XjQqqO3Z@ ΢+JA>-FohU.R,<ޢvhu=u[,L8O|%3UJ|E%GǒӰ~ξע/ti.*N.ZO*v=-z uz鑲FW%}(/X ?*Yy4G,zOH>XE?i:4I nw4wٻߗB墍X: >(E%$Z/h =pp /e눘2-^?]Y@1oh54Pl8 Pgxo2 U@W]3G4zLs9 Tie%Tb9KVP "Cx:6;KA׆5d&TX/)e#`Qgëc١mJg \m?dMvu` tVؠm`Se+F^= }`׿.0@ſ `-+8h8 `w`LXR'&-_7vy@eqypܒJ>YR .G%OR1˴ J1K^~ y(á*\@k2KJQsGUjȒ}JANp֌PkɞKCa:JKQNg]kɥC98*ZKN}Ty.me?鐏Cf9t-oIv.\%m~uJy,~Kb QКCk9,-yI sHʡ&Gݰ%shܡ+ഘrHц;cuQÕ|vey^v!hӲ3?ÔtZ8hn(O[uX8,sT=XΡRMaM?t3tkpNye? x' x b#S*FKro7# =08 XN8C: 8rqp:n{\tTU,lt̂j"+ܼYMJfKb}EVbg)+gߒUf7e-wwJVZ^UneZ`e.k][VUidUY~zB"暬j_}]bˇ&YK,ڬY5V|HV. ߻S%Ft7X^ҷ/,{e/%}:1%,,{IWX>%$^bK,{eϖ_ sI4>= 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/inst/doc/residual-shadings.R0000644000175100001440000001654112767204756016346 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.Rnw0000644000175100001440000031176312767204756015350 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/inst/doc/residual-shadings.pdf0000644000175100001440000067241212767204756016723 0ustar hornikusers%PDF-1.5 % 40 0 obj << /Length 2582 /Filter /FlateDecode >> stream xڭn_AB-3܃.pns^m@n@Z]lhgPD[xY(onϾػTI{V n} 7wo<fzY j3$q `2LGEhĜ8 ty4Ny0f򗫖РtDY?Hx^5/jGLTe:ˆZmh: "Կ~۳LYx9`T!8ulN7w\X]qz3]5oe" %PHoGThodA'*wL>tߥaa7x@fhH֔п!Q[G"zls2eBC5ҩ(J~  PC\*g!OQGQA"V ~%kWe hU)&ɏ0YEo6WXPj 7݉@=;|甓K7Q/;9*؈b[Kf|IVM1 5177 =].ioO:/)6C9^p¿^ӯ81 ~ÐS$ 01/Lt#Xf#7:]D5ɼs^-rSXDlp­mǪ& >:x+qQ bbsm7 S稫 I^K;Ub;KMCMƦ-&ؖ hOJ>$JGqBPsm}HpN̎>x/FCc_FITM ȯfD-F#০L ~kCqVnbc # "%I1 Fe7Z!Z ".9+s@+l[.|؛YjW񞶂BPp%[2, Ѡ_vrNYOszQ)GW5Zt}j*E29/j{ .ILeLjnN)0<6Բ7z%iP3uϧ<\Zܺg l^2x ܶ—Z~7" 9mt^=?ց[sڍtXՒ=0O`f ,! M|̡.Јí{<1)Jƴ(NӠiOS0:@%AF. B$ەw5.Ŗ bcʬ= Ӆ> stream xڍX[o6~ DH0`ٖt]놁Gh,4C΍%(\>wpfuuVZAj}s:Kvӛn~N1sA4n NVۍEHϮ4,!$aj%:=5 XUך=F,'Qn11|imqzhJк.GгWĀv]wF5I[B'rr9ͥ2?,#>w=@ |/m8+sZʗVa%] IiPV_\uG$ѥΌ1rm代θAJЈ2pN⼳ ZA'k6)z: T^л<r. Wil7.g\DQ^ȶqNv32o*y%!C8 d:R^a*V(AȦq@Wlb`;w*^u_%mhۄ"渂w϶N3 [?>) v#R‚O>IobrXG-P壛^:^5$U NZ.HTZ&-UXvLYÖʻTCck}䍒(u{PIÐ?佻'"$ؚ(nEc-Ӕ, u']fvH 8:wYf:Wa%?7qAV1Q; *mJ^ݷ?hfE/ÜV {j{~qyR0 AMp!bv endstream endobj 63 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/residual-shadings-Arthritis-classic1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 75 0 R /BBox [0 0 792 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 76 0 R/F3 77 0 R>> /ExtGState << >>/ColorSpace << /sRGB 78 0 R >>>> /Length 597 /Filter /FlateDecode >> stream xWMs0Wl֕L)3ɴ7&JL1 >HV~̀` ?ħƛSX %jSmy[6-{ f<ւVJY.i<:_p ]? 05p ]"z ~Xx'1 ~=YʟX*|}RXmS&gPj!}(\mˏx눭0Vt qhB1C8|T䛧&kP,ȦEImRq{J G Y%:IABna'Mf-zֵ`%ۄevl3zZ|BXK)ؘ8GJ@'5cpV%squpF2}̳ޕ~}!ogj]1%1 Y_HMT 'pǚ8=Küå̭ImLnR zjx0w8j\9_B٠Ȝԝ YUȞ+LmKW61$dlKׂş]z-+Y endstream endobj 80 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 89 0 obj << /Length 2199 /Filter /FlateDecode >> stream xYYoF~P^^"Y6{H<4i ZDdE|咢bMT4{εߌ`>P'__A\r6UGA~%t2 So1 %<("W}#- \qS '+kh_TF~yǰwWSN< ݹ8(5%ai-%6ިD )0y,d52$}yqsJk++w)m%PCnv'~±)a]¯R.;̨g5\b+'Ӈ Q'#{Wyǘ:[Qa:g r2x]lIwmO+[D1:b"=Fڊ)6ƫX (YW3 fEnoi,v BH>9ߨ sq^ʖ!HX䳒A%p>%>F|k&g7Fҵ^kYnOn"c%^Z""vwh\O"QW)rފ$e1e{&8B˦MB͚%Ρ,!D8>1&("pû ! žEFYżq rMi7M'̛˰dP#:'״ h!',6 mY8+> GOV"y,?&pqeY^O h5}(Mjc\%Z5qoq狕m+]Fr%:q.,[˙xdY+#A Q SȨ͢^IYY.+C"BBL|O0NrϤ6Au)aHdɘug[xB!6Ez)I`BߺI[%$ qʃ7uK: 67agD 1z`x,X`ŔHWvi2($<^9 CkFJs+-#^/_qt.=HKYeg!GSsw3Kh6]Aݤq{7C"psKK.qZfI\bo(AzB50Q>pVS"aw ^ltpЍv+W钋 b1YN`+\=-hOƩG'/&uZWQh!ce!-)Q~ْwm) 2=#c]{H K]h4&_EX>,Tظ%X,lP7uZ w ?;dObmv`x<@a"_\ )z{%)œ9xRkxx0dQT %'JQ6L&^ B4MEG#!D7^6csh{^V[Dbgn7-8LfufY%fyҠLjSէdVxG8(r_B c(>۩m&P}iv->1Bڹ2KXG%g–1 "社ak7`<;iocDbؒF;* ޔ N}<AnIMvdv'b8cp s0z*E/a ށ+gLָ3)7.(CZPش.$8ZԸ D\o\0}͗r4%WJ$SK)넙Dr:C۶T*v9/}֌okGd2Të("p%BKMK 榄hk-c7N?ئ-ݭ]˽ywRB[iR\phL莌A-]?C endstream endobj 102 0 obj << /Length 2015 /Filter /FlateDecode >> stream x]D~EHgH8j(r_58ŗN|w-HЇ>8^wrMɕI&& 0In&YK&׋i<'Wio2qq8h󪝙~ ߔ8Y-fsvb VϲiG050. m 31_΋Hr @kӰqy2$R; 5I`\or<{iih.H}O+L3Zz!鈓0sfH"1FEo3`% 96"gb7-9&=˽coS,Jov`n01JA9-ATJmR޶ _x@k@js!Del:G%,M=x@3؆'W M.#J"z.H"6w 0gMAb*,-Qwc& :pGƺZ!]&ɑ7x|H l"ڎ[dZ'K #D^g{=ZnSzM)k(؍U1z4"&pNgJ$zxf4ʯ؂[1n<<Pɳu_2#F's,}+9PС?h' :CK>חJ`!ԡB^ܥzR:iM c`!:1]1{,Xx$,0Q}hQ?:CnD2,zsqH"AbzwUTTVHJ; 6?*_n41~3mwi2UU2P08h v0ͱ:-K\/Z^neq9 r I3AM[NXn>81iBލX~{#^.IA9.jڄsVSO-v򞠁U7 _e-M\b* + =!^A[ ~m4ImHH͑mO}W3ɩZ݊m{DQ#V!x+AķxzӨ'~le+f׊rs$Sw! RG&wgf.'jgbwWC;XLràG$ =E˥<:Qp7nq.Lo=7(L{|O au'#=LPEA=S$ Q4i0 $,}77Z"V0_L^4À+f Vؒ>0+^m4 Ӽ}~ʥwӇqJaC#tdEh󮥨-$I0 Nݩk=vؾtۗ1r`paŐ<儂L[.刾u?0{ީ=;plBQW _)$8R0ˣ5hސ)o2[NhbСQ0b:kk=K|yDn+]9%uǨe[`oo,GU@@CI5fxRb35[05t3%֖c[5?*avLwLp 4֞[u(QZusp'@CnP ֻZV: RTEʶ8^TkL\КM9F1::KxP!@sf$H6SBD= ΤYlƏ \u6PY+BXho[I0;63Tue\">V(KˮV3$;Ai^zd=SݹJlIS: -{BP~D8N 9YVcՆQ(yQvي AFh5GDk-~ dHU16=8 p0fўG5S/$" endstream endobj 109 0 obj << /Length 621 /Filter /FlateDecode >> stream xڍTKs0W(`U%(NC<y N㔒>DO+يI.z=NfEɔ/Z3UyþWX'i/-zO\# ?!뒷;+ЏV'lG}diuD]]9B"/o瑲dRU(e]t[r0*) "d\!Nwх'-Qʓ2y3ߘkX'T\Lykm[k3y8[̂B=tɗÎ5[bBmcnv,.3B qJY7põo2vMJ+ f릻3p;_Jӄߜ?lTYE7RC_dg3b mC \ غK,M >XgQTTRsr׽ϿyxF{ogsElĝd@#>aG6Zz8NH8q"xh Tޟ|f]<a endstream endobj 94 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/residual-shadings-shadings.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 111 0 R /BBox [0 0 1296 864] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 112 0 R/F3 113 0 R>> /ExtGState << >>/ColorSpace << /sRGB 114 0 R >>>> /Length 2246 /Filter /FlateDecode >> stream xZr6W(`_RUI*ˉtsؓђHih3C*\:  4#O~_= i)cϧw;iUh(s)8<ɯoJ`_^Xg|^]ZMٽyKy%>F~t.s~{q=`6`,W*Mۊ j,Sk9Ԟo7aN?ַFR9/ܾy'Y" k,ՅDj0R SÈu&9+9<>=ܟ%/ rѭnnƕg95 -06XMs/6@ֿה -61P!+pa ֿe{'ߔ3,;x3>z<'CQN 3uΩ_ (雏w؜Yg} M='ZJUErZKE8#!cy8]NK!xzpF(Eᮾɺnޜxkrgp;:ǓppGc֠T:^qTR8U$%g3Q)u‰Ms=Upz5B9Hnh5k 9'*$\F}1G߭BIrGC$8߿#HqsD;fn]ۻB"$Q$sHR"^"K D(Q;k!b4"lE 诋ϐe!~ړoIqNoFpzZJB%z.B?Dk[a ˪FD׊Mݺ=Ć]{_+]A(]+M¶F-P|esSqM 00`\xP=TWe<? Vǡ!.J١V >5:ƬBR΅e:X س=\(wٹr{{ ۳ ,we 2L޳ ,,=Te-mhf̵*xg"Nk(~Y7<?|4 ފ90~*\ U;{2wVos Cns@<|?Aw"c?tBϽpO:<|G, $=Jgi-Tr&윓s=QʵT+8Xzp@z>t!u=[dY~݅`pu%BȃO#<|fQKHR"^" t8Dj$]Hm%R8+]zEjSzEW@_zE8D`1FEVagNո<DF#. 삥cڑ]CcCR/֑m" [@#DN$( Jf<@wQw2|g<T2 *1 >Nr 'zlije#}v&TiJgWpgVY#wT|pVND!إhDr8'v {5~dwxvؠ˙3:KUL+NP#u,tmNmNlN'JMj+'[JoRzT̵ޢRz[ mm6 %ޢDOoDI(%zz$2ME (QަbM=Go'[1^%7,5*k@ڕkr𝴮 Y\a&Փvyd]&0|2nvBQt{Z,tmll NTؖp''wҘr'/m9wKmކt[46,Dɐ\$Nru[A՘q\yq y Xg*$uhWՄziХo_L2s1p4g0c fOQ"p)hxAez"2LAų r,ӓqle :egʄ+/k0lk%G3U89NƂƩx(y,( dl+V07 DZޠVAHr1o#2V!̇|{ b} gʯ橈z#n*r17O^s-7JlAi 9.|/[} endstream endobj 116 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 122 0 obj << /Length 999 /Filter /FlateDecode >> stream xVKoDϯdq@  dHX"33YzI#lWWWUʣ>ʣ׫Wrʳ:U*ju7E )[eɼD>-|W 26I78Ѣ>lC:[^Zt^qբ*AE*lRЭ5?ORM+7sr!ze'lދ[+x'Q/Db'ƶbUD*9[/ܜ}KL$_;A=O2'bN썳",ANe39|vmVUğǼݻ&{G<`GY^Cj^%"|dzH{͒8b}{J{7}t#ETfYHn'T.VIZb:?Uݗ%(T+&Pfej6WDZ?0<&}HEMOU Tf>eb~*)//*khR|-oqN*YIq3)S %h&P̽Lq&^wG߶LLx092vqv~# .inXhxUiځ{Ot'Rw%'s;&߾^E*V<)mlt2كcY>\{Up P-(]#v TB: WJGf8pCs i?Zyy76qJQ Jekh+jmUJ H*81W̥}Efuɕ@@Wks PˏB: vW{;v9]lF,H͌=`"왦Nr%fٿrwj#!(3SlPvcߢ\w)` endstream endobj 117 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/residual-shadings-alzheimer-plot1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 125 0 R /BBox [0 0 648 360] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 126 0 R/F3 127 0 R>> /ExtGState << >>/ColorSpace << /sRGB 128 0 R >>>> /Length 832 /Filter /FlateDecode >> stream x՗MO1+cRATmrC"B( *A_ߙMH#`+u̎wN~_f!\. Xyh$1GGg42,/UAp" y-Ep&a0@ Uk+߀,/uXpb(ao5)[r!i^b1>_wKv#I_mf(j0dEn44%Y)gj S=4ݯj:v"'g}~vUͪt=QW5z~^,նRla4 vwۋeOq? Sڭ[3o’^V3Bԭ$M@\#Γl|hOyׁωg[M)> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 134 0 obj << /Length 2060 /Filter /FlateDecode >> stream xY[oD~ϯX!zEx| RPhQq(^{wCVvq│(HU9swfbP''_d \zq^* LH4M8[-yezۥ.[ WD 3m FW4,^WuK#vurgt$Jaɉba~o KZ\ 8.^[,6^+HsQ4 톚0Eupna zS{R+,oa`r4(0x9|m8I==v iҀHʽac.9ڶsC@ʥϜn lW{>}k73G+K?:}Z.kRZI0sJ)۝ݱ?ՊEjl=;W[5Z>{W;Y W=ÆN{"8t׬}XK4 cҞ^q`Bv̆C-jfB-Bw@-0tiK?+>*c+~V+S?{El9b;gTQFO'ѣ8RҁКWtSyE֋[D8\>KlA4PyFb`kg,Rհ3;O6؄vH12$9Tcm!L|;y{v)C?|tǩyc_Vzpdw J$D {HS&9cLڢ*kج D3:\L`v*/,V.p3ϐJOj~d t@P$ N l/%f7ılwf݌^l)DMdxGx-͓l <{:hK{Ys!JBBՎEZ9QL 6Ll5#g]XѹfTTKݲr Cn+ߟ7"<tnz8[Q6ZY <({@Ѭ6y@=5mf)EWZ6mRAn< utO~vZ}JׁC<~Y(Y7WBk&r,:&TAKL W`9#gx A^+綫bk3OM1 f7LlȻ߼5BGDŦI9Q~}^1 71?6Ƿ;ʃ.StƶxH3A  TƵ#A#? 8S1-v{7SM_Ȃ&1-CZ19(ͧPOyOH`{Zq;R:p jUxyr#.' 4ex W pB8CE'/-H_k=-nzO{=ygd 0_]o#u %"אkhD~ZCe;AfK״ځB=> 汣t#!-N}s8 Z}0R[ؑ;N|M;ݼ/aƸ5KJݾEME'_~,} a/IKp6Դ׉@D;Ѓ|U#?Xz"u#Mڻ''f| ::P,:i8#`PI9(kZBx2"v1}o?6[m8M79XǯÈwk2^:HT" ^+  rmysv'l~ endstream endobj 143 0 obj << /Length 1222 /Filter /FlateDecode >> stream xXKoFW9Is]>$@E{ Zݚ `DJ2"SD%ZrIQR@ڝ7:V^zf~vq ͗^dao^yr4wB`d]Sr7%֕$IXT(y xP] uӔ5_z.i.2^;1 lD{esv+V|+~½HUb*"T] `vXK$??;? J ˆH=O|+>Gru0ZY:BT \N-GmD]huPU OŰfz2uBbd2&`/:BUP&Ti|7mnȇiB uN9EhY)~NRɟ>RځϺ <ݺK#iz,D!I|$Mv4=C%9O ˩{$ւ(>~L{ Z&u/>6]6s`}!d- K~tV~+CLPmwY/h斬'44ѝ: r?uؔؒf&ZM,G{p֬R@)wRbum#k014?. ^#-FP۽4X$Eaq62O^6K@՝I> stream xڅVIo@WBfÆH=4m.V>u9PLUä`emeyۼ{ E#Z\g\(Pb}-ԩYUJ F|^T^EXE;x81D_j<rt %j"u(<{z|w٥UK _,oBF %r%tSůEes%VP񄳷+se_pTkZȞljļtfG`9{+LHmL $ttp>C[Vo=jXeaĚ&dAAo`Mw[ne]TTp=N~C} U2if N@[ Dj3nܡ.kZ<0|GQ^[j΋7Uv+ U(Qg]jte">z N⁀0K '6DB{I^c5)p`? =fhƯs%X$W,|u63qTҮH&N=&3 =o;DKYUϘ*W摒hD281$ٱ+LgyCU &!-_by!WCoڼBp8pllЍ~A B뎪;!awd6ܳ77;*>~|c{wF[%1OG~i&F竅J 3D,=Q򓢚A6h tWb.\y`y ) k{@p]홳QyӨɸ-d4H( \jz7r T8ȩ! c"gðhߤǓk]6܅f˙BCp~*Sݒv3Б;:W=ANOxD2T-5%1~xfKP$ݲ)=Px$=G\^ޔޗynJ/ʁ>nӓ4 E endstream endobj 139 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpapQdUi/Rbuildf4c764fedc9/vcd/vignettes/residual-shadings-Punishment-assoc1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 152 0 R /BBox [0 0 792 792] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 153 0 R/F3 154 0 R>> /ExtGState << >>/ColorSpace << /sRGB 155 0 R >>>> /Length 1996 /Filter /FlateDecode >> stream x͛n6@\& |?$h hY4dl4vP{tIɌD,F=$uyHIyK_b~}_ !Xyx[{&F7\lpu떽ڼSkDyeHK!>.{qa~evʼd7]bOT݋ͷ뫇OwPv}uZ_goU;ԓ_E׾0 s' C3-h癣6}@[m$ۘ('W8mxuzv~䩴\)̓fÂqׁ6JÁXy9p SDTk&%q |NC_>'MML>Oq>{:c;?u_P d|z0-d6Je]w8qu%SТ&\a<)=E @lap?5k -,~БEb%.oe Lee;岉L2*S#v-,)2 øqCeؔqUႏW#-^sRi0 43bN~C:Z24䲶K;v: Ri +gzy|RsYl|d,kkq"v+mlŭ5xl]C,;ܖ79i?zQ,C6@FtBY(S2R)=2Wzb (S0~08;(Kl )}<.֒G=q]e:^[ f}>$ D*lat7\E <cD!&jc%3&X y^XTpJ]TBjceɩp,K I.c0@ff׵scz,uT{zH'-zyFԁ6&!G{:+LNLpjD\Rqxx= ߬Sܩϧ\oN!~,Of  lջր\a]Vr768N+k;z:@/ s56~ cS9G!s&Vd#P.xŋ(#ʹUcdKђ S[:a=i a1q>wS`p 9ODy.&v6tt6F6¡9ϮUPokχS|J;mF];1s&Rd9_Zar(#ͬ8]G! Bn褈-1+*`Ux.=>5}ejyb༦&lUtܶ6ߺ7_T'۴ԟnw94;M͹v/?}Kٵs>coSlg{ja+1[PǹxmvwT\z ni9uz©1#`ŃD^ucO}I<.'u;Q͖ŀTlk϶֡n.+lo| 8g׎tH^glB賟Br6`:( v=c3DtKu_^&8LYc]E05fF$D}z=N>5pďq/y&X6t6q, lG֢CAz& ) geM0-ubqvʚؐůGsoxd6p"p8 3k 𝔵%W|9!Ld*sc.OQSOڙfRZ|u_5xMcMlk&+k-ζ݋'5Gule[ endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 813 /Length 2432 /Filter /FlateDecode >> stream xZYoH~ׯ4>cǞLlv'sfHmRTc[] N(V}]]g$2ccNȤ)Ϥf20%0x=a*R2H)#kfc0gS!A"X#)#"2 5Xi2IFt썁8 H#LjY! ^3R1kʃjϲ,zS=zMQ\eSWyw+؏?us^M1L&_2X`v*fMUuQ`Խf{xi~0y*.RM\rBzW$ < ?˪Χr^T6tWb:JuKz&f)[ ,1˞ qeo>_&(;Lfb"eiVqQHhL"Z}boFB0x2PXQevo)dv;n@d7n뎋莋ʼZ](ߏU=Iu;q=^d򸁦F҈E, ;`q\4Oi*f_ϩ~%oWmxF.W?xK eť$gZ9õQ#wpY$.P?%9wL`p`TV`.mڐ M#„^IRN';odmD^gGMs$>~ȏ;loEC4""UT)My3ijuX/{UCrVQ=y@mk[*w4{|\\NgBcC巄yFZ0 l弮t:0$! QOH< !!+{ Yx \!*? m'z6*t5P@ؽ8`"S"pȞ~mu YhۍY\I1vq-]>GRkJ:RF)lWBtƯ3I ߨ]ةvL!t8uSvlZ))|y7=:Htңu"Q5ݛ1/ϋ2o.^uhV{ Y=ڻZC9_;?g]y~HM1GO帚 9Nm𐾘IOҒ:(Y~}T&,-[bvQZ_ItPM*(u6+:|e ]Uλ:1,#1+feLiF m6UM<47YuV}6Ή2ڨVMP!6ݲx7`+-®:=fIyޓYO>Bg^(g:-6 ɠ.vosnd6CYzs$5>dNPk,s{VL??AIlĄ>E_򴋛T}*Z-)+ZbB )麟)u;j[/.$szNY=tpB7vb\ӎU7B AvWDHB5Tk@&RJ{4Tȝtw{(T1cmqD%?}Hu4!9 F'7 0cx*BVdkr>{ůWN*t1c=vvފB A!?tR7ȁD"fh:6TZb)0n_.Ճ<9pyx-CZhMc5ڋ w[(^Gz".a]MU2: 7F۾G$՞vIˑV.{~:V}o:֟f#3el\UڿY+wsu3۫ݲ=o.6IwT|8.VZoߥ76/J=협tTV (t. n7aOIl0|kfCLWc.Q]ʁۚ6>JSFkBz [fDa3A({b-WXotVu 5ܻE TpOۢw,,zOFݫ!a)߬p}Ҹy% endstream endobj 158 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 162 0 obj << /Length 1185 /Filter /FlateDecode >> stream xڅWKFWpIT@mgS͉nX*2#>֬\[nm^{{=y,Ik}RYqJ&P9ã- :DP<5x(3bJHǙF],޿Sp=胎bxUl_D\dE>ޏgI! ӧEŊ~Ā1ۄ4W~{:ߍC-Lߏěe.p+ӾZ},rO4_KA7\.8˲(0NQo+oǁK %*Q"dn.A~􍇪aHGӏw.rsY-,s T쭐J6H²*,#Z CH(4 O ؂$i.#J @F4xaZ7=eL2(@He2ٔY[-ŋ[.df2RŴNea3"%H\-OFXK7X)cSK"7p[$lpMC ~12?rYc9 .,C_JXlGJ$Ú`_!8@O}'*\a-;UI"&1!A~iv`N[E.)0?*m)b#n*S*e!9DeO!zACMD7& :ONC6`(n$B# >l~$<>qVd \x?v߽hz9EcBǶPt)W+j4\I9]ߍ"wr4s楶+r'$nVP8XȊCVb5SiMBLLrXJz@b @ڕY1c v[S2崪10MӋve`+ǛyrJ5 #90<s'Nc!m[Ř bΆ߆K!Ʊ/:ڀKIg0x[^~M/7z>/<ٍvCז`˿E n]y\:ۍ,-7fa:mq)&~iR ߍi 9v$?Kˉ?AV]%/IC`ͻN> /ExtGState << >>/ColorSpace << /sRGB 167 0 R >>>> /Length 1664 /Filter /FlateDecode >> stream x՛Mo7<?$h hԾ9D6;(;~ɖ{I.| k1|I9/;w>~7ndTZLwW7RJLoz+|(ހxG i%mwtuVټxNwMGtIu^õ|8^r{Cmmwۛ 8yQ\g 8 8%O IS %IPp:kz# ^XJBxNLŃj;|&[8:H4!T냢4"R'DQxM3Rrz;[g?/mXņ򆭡auodؓo4Q=9(fTih+Cbdϸ J!Dr[`(H'qf\J0s\hOu F-ƚXpΛ3`0R0> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 180 0 obj << /Length 2615 /Filter /FlateDecode >> stream xZ[S~P!50M_⪤޵qmgS $"ש[};Af#='ۯjdumF'#rŨ ]NFvǶN&;b;OS}2p#6{g`;Vt M!}k߯˹p<ۯLHwL {}4Of{oF * =Ow=ŚKss< <-6H9;Žd5p/DLyqbMOG-v%;Fl@Σ?~d acLBs8ɂS܏z:,WU/SHG` 5) 7 Jb؉HC\ %҅"GoSzk\'I .ψ'W6fC^N]҇k2&ӢUgӇ5»R҉FYeplJVY)k@擠v_U !g %|vgɺfï_L.)"szZ?T]_qWڄX~ Pɼ̦,6+fⅲ t^<Ə(?'%MQolyï䲏:%vx&Y%[R8+>!BZ3X^*55<&\aZ7k 7]UgaDϭ]M19Pwyq۸drh!6~ (RP`j3M֗ng] !ۆAUdˮʇ}]! 5_!%pe>0W1io^rH6*[-6yP?'.7&:jp$1 ݥ>K†$(4P*J/(M gR/[[w?fs)ۥf0c{UoT.,>LwSë-(f ,xlXT:3 c+7شE?ldg(_eC%qY l8OBٶ%bBjCN+55PkՅĦ;ɣa/ȈsF[HwɟLgocc%%6 ˲wex-Zf>1Tp0H_oDۖTG {b`\ꦚP.gm qrȢoD7L]D^}qef n#$xAJIu.9j<[YHDH}LX%9o0wp088u5x(?ut#{NBQl~ !ż-{]fߡl|yQ&<$ChȨYm(e9\@wyyN 8}+aŶ\!]^yHgN2%Go^ehI˦#a^LRwSo8ކս`?'@\R=1ضV+WoM "bv#פ(~^l$Dꛒc]~rM,|<{_n?j"Ou^<~y俩ڻh endstream endobj 191 0 obj << /Length 313 /Filter /FlateDecode >> stream xڵR0vvkéZ;ۚ2#/хvLck]u-`cx3P[l)HnE3|TTA\ykID H @L.?pPpkTAƨpףB})F%k9^:.&=ϱ9 ;..U endstream endobj 208 0 obj << /Length1 1582 /Length2 8571 /Length3 0 /Length 9601 /Filter /FlateDecode >> stream xڍT6Lw CIǀ4-] ] R (HK) " %{ϽYk}v>]L%m+an\@n^Q ˇ̬ q08LۃLN C@~PP($ !! Ը*pY썀ٻ= bED8 Pr;=dYA:p_!XܜEyx<==\; 6N' v#<6 ԭuƍ е%ׁۺyZ!\9 z7_7{|&lܝy`w&"n^^^!A {y~vQ?t w>4؂~p|]<7;F8@ rX 0DmxLxd@/8 ?ˣf$oW\|.>^!hZA.0[8@j=&Xւ!)/ L?. F-H f P Hj5CmWf0;过qUxm4!n \A!0&QpyyGX LJT0 +o+~@_&ڀP =8SP#[ =pHo$~Wc> x>xx]"{53;h@P`37 :mx'Mɵ1|y w~E6'xq&E&z*5OwTќrwc=т3;F3Z# .]~.~AM*̯]܅ 4 I.3 o|$rd^߸ԭyS%1q2у"2ZD:ॣ-MzwP:2no,ZtڿZs-759˱|J"WL,Saz?ZF7c<5gϼo63AFA ]˕., aw\pu^b|yȆ1[CMɂJ +.LD"`/O2;5INdd`|[q/|V}ÕnKqY\&[$|Qy߰@3itg r(RT xq5=V9I{IÅNzHLPh,}nEE1HSNI5Q IKy 6.T"wm ('ˬ] rR`V\w4[넎M> iWnoKR^sE)Hef`Drt(R֐<ƖE))ѥ{M9JقE~ Ya |z6Xկ~{GD!^55.5SR*xZR|˰ַ2_̃moL%b޳"չ.$PD v0}'j5~ jݓp8DZe>g>a:OO =JHp/. EF`c TK&o0'N5 OG7|s)l;j_Tz6fcs,4;V8㞟JH3,޻G;lp~f/}#a Q3c 2%xSH$zEݲq?I tpX+1Hl<<ُ+#{>3}Q܌H@E:9i4T0yl7zA ΓUvU u=\I*.͚ޑoEєɦ|@WxD3aŴ\UG#I(cvUh~x||8ȺH:~/4+fzHs^Ld2:+LLSI(L8+d: th»g=Yїxg0F':tT[*mpe[Uø3ގxj+hi-\1íerhPs}.F"*ФI?Ks: 1qx#PeNE߽ZZS=[͖z$hyINmgjm& PdQ; ܁<y21ۋ+rc]b)7] 56K(]їݟMTU rE2\d 9l.ke?}IUK'zfQKv9o&Uyn">ieb~zξe^ :RKb{b[zW2VENd9/< MV_NC}ӏ㪑QX=+:-jiOӣW\:y.^Ji߷.Ȥ 5ByfD |;KRn Oч)Dƪ&A\zFTڑ|^QqQtwՉҌFC~}#3Z4EWL(@|0$֫_ܽןiSyM<1Ws* TAcd U]W7?*WG$gIy (XJ4I{ρ0nsA=O睟O,?b@5=eJ@ݞd/&&Ċ8R7ş  ?]wt;f vF ٵmwBEXIvl&M55QTREh!8,=h^o-Bs1?ӽhb1nzWXs{NkQGbA-Rh5[=c½e"4`:9m/Yf,9 =1}Jю_ 6vZ<\\9 r,;n9UfEqDA˴м7X7~yiJR[Z.]q;7a^Y+5sWTPϹګV]Hr(%ظNRo_*͎VxT_-,mK&'ˑ 4O)4DZ #uũ\^iF{`*rp6aKwXeIDVGO0tP(7tEDPyX#Hiw%F=S-tWm,?Ȧ1SM'kdһi$c׌d?W] Bmco!WH> d'yj^R&>fLdln`>x~w%WjWqfhOذNT˗7Js,}1臢<ːmSη:6}cI7"I?o3moV;0ng IX`&WT(#-\^7oa$M, ˧p)2zl2ʠ.]'{.\Q+7VF6Mÿ1dPwm,p@nQNh`5I0BZ 9|JKf)zU3Nߓ Gbpǘ#hR.FI0Rt+u9LKZiF D +?S}Kq~ZzaFqF]VhlQ7Y?HbG枅>)]wn2؊e}DעZ*Os<ηF^N܍ Jr_.FdG]8yL [ww&tOamx=I6 I&K^*Z;U'MoI΁Ձ7ORlį|tQuZ=\\BǮ>|v,˒\7hjǻ/G/ĻOעZ3yC_t(?he-#RZL^Db:${.l/R<ېm/w2~U715=]RƊFik}Id U$ܶIѢ5iZrcڧȜ~H~cYHCHUfx}z3i *gF"} LbSQ ?No>Hm@`Fe_d<Km|(FuךE;N)8L4;I%>"pߗe `憆Zxnj;:&mÏ\xĥse ;w3\{1nXyETG&y9Q!/7u<%z"ٶK=}#acjOѕ>v4IPT34҉ڄFE|RfI]_j_8H^7i.ɔ' "Ln5BmLÅLJG"j§LiQ]>AKHF8oJ;f_H5ǭ +0l"&<"Z/e<%"9f;ۅ/ r`3I-iۘ:MrQnNS_97a^ dFA uiߒ}eYVJq63߽@C2򨐤*)pqުҟb%'(LoO n>%3gh`Fcn , Tam-¤FH#<-vrTVwf';sj;'7pIic?c nrfUZ$l)`:M=c+2$[! (Aab^o?X\(ot^;RV,K݊Œ43rqyD ^F϶<'/芆O ?a}b=|c]0=[VL_ou‗G_( T:tL}rˬ0Vg-~|E7>OB2#kH?XACԄ\D G65/ W=;.M脜qIʫ-Naf2C9c>,ZVEŭ6٬( wCxa+,gLZgިvb/NZ81xU@Ύ͐Yi *}VmY;Ft=Y˔^[uV%)SXcP'.f (PmyD?r5+ z]ǝ6"DA]6TeO$T pn\$~^h2OXh{=֪*ܬa0zP_<zl|Du&o'ԡ.o4ƪV}+ET_\juGK&U{6b"FI?j.}?n86D/6k5mc(vXA}E dXzFaӃo|u~䷋TV}Uz_4P't#N!ClckOcE3`-gKA8hV9fۈ%QQ~_ O8޵|UғsoP4QKH0a9^n4Ȉ`:ƈ6Tл<^d/ˮ]q}ĒŎ2njn!Pu]Gs⬉u[ J e&0AM<] Z5Kܭ'\A+4Bny{"@ ,`tlŀ@mƪ$g 5J毲yԿMa/޴+{O}Xkh%)a3N$D9Dӂ,z ~%ʡiH_t,8TB}Y8OBAxJ(ʹe!/N_ BT~9Zɹd*jL8Y(5wV@ڹk+X*:2̪91 q)4Vi+% qe9i}pM϶\ynBBCD-Ef!&, `;un#nĉNz|AVtԾrY;<u7źP`+Dؓ I (X Ӳ@JU 2Wsԟw`@p6zf}pl wGO2;4̟GD:t2? G{rK,(c1;Ab5ߐ!)T V;g[]#(%_תP8%<ǎpܕ ,L:_qПx[/VC܏@#S :6 GdjB?cw@5"$?y\_IFb #]xfo%F^r[<~1ԩ6K#m6XoȮ݌1uʬ#t=}7D#ӣpn>B` rFJ?+CYK3'C^$۴m菧O1}Q^ίgyl;m`r<ߛG3 Pڼl8Uw~]Ѻ8E)ԦIa`cfDke2$>GmDpVM|]xsh7m;D^-!MX'|l8W4{z2*(|Z.kš e/xo;߾07CsI/DDraC9/tw|m ]?E*$|'#$=.Kf6%T00\MH18'.$JMoh9;MRK/ocSeXQ;"XiAlܫ&'vO ^)b1ۂ/[\rtLwu2 QaF*<#ip4Fڴ3D=iXܘ+fuDdOe!x\^[:c໠ D'J] U7sS$^ԭ{$= 1j󫤸k@9 aͩhEC(gX (uy/e3OL>3c6IUODIVxsfk{CǗb.p33||B|"(l/Kko:]X=G `PQz8M/c İ{畿Nm*/M6ɢzeJ)g)t% endstream endobj 210 0 obj << /Length1 1595 /Length2 10076 /Length3 0 /Length 11126 /Filter /FlateDecode >> stream xڍP\-Kp4Cpw`ANp <; y{WWS5s{ջRiHX-`' + @JERΉBK8֣]@`'@H!/:is PPtwpp8x9is@vJ]A6<?-|$ Ks'9 !^qdcd5wtcڈ20^~e@_g3 ?f@\݁io `,6 '/ Џϓ ìN8b6YY=}E)Z() X8yfUp,eNZR0F?_IfAyuz?d^.˒Jn/yƿ/G/'^ZY\PeU@eil)bWq[#Aɲ7.2C1:݆Dp/ 2œIkbX[zߣi^;䫁~2dR-}'?].j}r^e+yP˦YbޖYdR!@XȐq.0gofpr&~Q(3plrUhqu^NJ(,~*Y0җ0CDFR"܅Kӝic9 {MQJI:zi)(L3Aڊsyv_BAqGά;r)9edkue74e4b } d +8 z?X5&{*ꊳ6l2ߙp>s%6]0+pHb|+RL`st#ՆѝT;$ØyV&~s %j<ɚh:9F*v,[|$جM^(h`n6d88ϝ{(aDY8Bch RzWvUS n.TOՃԏqn'x@5xW 2uH6XUNJtfj\LfQ JKFH.: weuڋ=#!-2~>] lZ7JlDTHSX|bTYӔaO!Ʃp.TYYtI{PMr~BNS13h~Aˉ[BzoZ"MtנYeS_jat?D|e%0+iY.t0v<&Ŧ0Ƅ 6Ge;lꯔN_]h~Mi|SFLJ4-+1u*Tv)ylyea-[VN(J:΁f56ٷT)T\fM] ן*գB1Z{y-;w\\2-*2ҧ%6dz-I=}UqKzqKևuI1d2oqg*Bd-<}AfuluC08 Ӱ1 f7&G_jޔ~MhxGz ǣ\FQXpOpܟ}S56|Kt:V+YOJI U;j.cdzv+k;ӑ]_oNr{RÖo/o.Q [)0"3=X{ ^H 2=Va,@EԃkdbRWvN Txza$hM~ty_EAYKXPx^5'b$j:nY>ɏ{r3h–M>RV1xRF!F0ƓzC6#\_nl䶛A"vkbvEinϑ)ʇ5Ȑ:HEfCjʁ:lWP޽z4rrnb.]Ŕ̖H~waV$~9y;/]qtHg _j] Ď_e{ۧ8dyKY|^OM$z;yRt~#;g$ak_ Nk䇣@I;?gD PU V(i-&L:xxp)6:}Ԩ֧B .xԯ,Z:5ȷqQ&a@\mXGhPn}VQ.`N z$SJ sbtHk$|F8 U"$/Dmp0{ 5>nՊU )rmF²ܱ9Tze;dx>~3$ MM[V~&Koc⭑~Fwf3=ֆ_WwFc*~[ s[kήI 㞣5=gwʻ/MASz*5+qKq@(αiQ hkWQ{>|D b6-ڳbVvwQeߡ\T tgfN瓊fUJʆu3+:jfv6H:ij(^[\J+N|Þ4km!"稘l"u֫H0 *:%-61^wmDQi*lu!68հ dx¸X.P(Pk Z#վiZoUNCM)^L.ZT8h{g>bAr4¨S|Q􄢘#@e))?6fהtNNaKopINevwٻKmy48e)hiA' E{>Iv<&}e:|@qNu[5Cpa*]Pħ[xǂxkkaOoo?y<F͟U.Р:VZ71M:DeǣR#=Æ0saxi-` PS#هGLGć6_}EuGw3Qz7x1'5 K]%lk $u0 `ѿm#!Qe@΃lZYj=y ?;(V/饁w]ڟ])FGmHвWKG ߉{XSNxb4V?E0ݷ,#Mntu"7xSs/UOv^vGMR b_,ӻd.>0F%~M&o{=`O۶ܾ˃[q0GIm6/rDEP;EiNpT>gyY_OTuk<܉5mGtg!%L?CP΁O 0v; \pE0Vi22wan;G}+=>b ܮ4&0dIshu2AҦ׬(cO\ p߀Z!0| "* ӥ\9HiQoIZ2=jj=d2#ۣՁf*#i{KNr)7NF>f̹l1 pu{Uj^p[yJk3eŀf@w&EOüd3I vdo}&`i:܍Ԉkr.aaO"bI+vj~7 dO߻3=}YT*+It6 H߉Ij*k {G -:~Ag #EYuGwI}S$(#4<Լ@GV5 gy^k(:'59 ;֦/vGt#@ [z? i)v>w/NXx7j=0o!OB`sNIdxڲ1p`!k!ŤQ+:AR׽j| _?h0XjoiimAg3P4=(X6tS}֌bU/ˡs {"Z̸ϦԉR\|vpu4Rxݶ 5uZH.nЇ wWO7W7(#Dq72Fmu#}EC^T/U:vG15˦ԚyhqjS؈4hA/R7He ?@AKr3*=ߟ=iq`+ɍ RDDZk(.a\5`aZ7|\~%oFO|ǚ4aPeߓR2J58/ 5f{n 0&yWp;= ټdt͘.ze8[f4&9$W ĞUouf^0<:R&!B~\"BVXp_6$^1{{k`'Mܚ ݕPLU׸-Dsq_\N|3*Sz%acpL`! k8bk SJ9:Qy\C ا'L6%1C\0Lj-/j:7wO].]U 6cI^0ǨFK QhĪVnDP8SU ti4gUJfD JFqHF{hJ* =Ob﹓ա;U'sa9gy$j\ТHfe?=a+6ّ\[ ?7wt$%ߖ*dc7IGOz;c)  = 3Ռt5j2%OQlus\gwK%1v,o _k G\Z`1o1h}t~l<_~' ԁX-= UJt=FG]%O{XYIc<{Z`Rڿ6UxN@8I-S}{vjUʗO"z ~('Ñf>:5ҥ'x0Gػt:*X~Jwk5s|OeƊ&t-=n6~ń< 38|02DCsZJT6NB= =Š'ebEGG -/#Ŗ@Q2R^\W#7ρ7 ZFcdStbc ]mŴL^7^ëtag^>S~b  -lc؆;~AFs)9@溘% XJⵏgUXۈ83֌C@4SD܌I4n ټB+H e50(FrNi}tUh3?J"(w tT֗/(JN>sQ4e| )D*P}n d?]k= ݱAF5BBo5tV@30U4hrZ@!,3%+ z ' RSd5#F[r!0@m, Jx5"0"G8k,xR r{F=N=EsiTne;e#_AXw1GjOh[yɌJ#潖+I~!},)vC cc2P(z奃q5ooپ+:%Ig| e*(4X ;h[{xFsl.ҝljЭf]>O粗 T WkVdD0y=Slp$< 6 9U>q}^i^JZKC*pKF˙"z)P`qЪ8Ȟ|T嬚>+pNSXRqі\.h"&)ֹPSd$XNƸ=4iP\sQƼہ_L̚gA-0 p֥)q#Ykꯪ UҾI+Fu{F̸nSVLݿQɣ{^^Yt(qw**l{7U"T}A|R@ю)HpMˈ#UnN6g=V W~!)NJ协#:)\Y=1t<ي.[v>'{sr ?h%E^6qnVΐ̿NG۬*/42{[_8q G?~ 7bА%bc.;YEi{wH";7V+m=I/5>58|Ǫ;:ոpN碨< ciسSQĔ.D:,Dewؽ>x(K)'$&<3* n24[^s򉈖neHW{xJ~hgBh>_Yх\IY8!2EPoRS?p}`>zT'N8 {2~:>`+:T\ rYU#ܯk*'6ǣ~U Ni &mOtBoT[|%/mlʏk ٘́ITk [h1p݂-.(ǟ쉆j4u0T|$Bݻ(L)k Y%dOmE a08dˏ 6:#W9̣x cFLKb^]5i3_mnbA1yw(%&[ -/mECCxȂ+t9< Gi[B=TSy}_m[Y`( z[#ejŖ}<.ODVNBDJ8Q5zj'6>l a,7F†3e!n'X#_g4XB+jXyW?lwDQbAYfD2uۜVp8HcZlp掕 [ wW8@S`G~pѥɌ>{ijjτ&G:7W,- 2iIvܒ,Ԓt Aj o#!6ko. u݂OM$Fcp(3Qm2uHt!MQ,*.Jw͜%$rk#Iǵy&h;d\'ѕ%UHIc%3`ea6Tƙ+GGsn@r]{~;1| da;1fJn41+}狙ʷGL_j>0u~ M壗U;rbv%'ם}ZV_PpW-˧&y{G5;M+{&`BO=jkf-IS[ܰk6`_)~B}uAB0 <,F|qI {f*\Ί^DclV/M߹7I}`TJߥjWq}huPkQ%#FTh |XNK ;:Ю\Ь?oj7v|qU(VR=HVe7d5bI - u%٢΋MRfx#T7mqjq?]꼨apa^J&s~Ǖ)3Ac RU JA~(ԘkWF 5> stream xڍP Capw'ww> 6k`! A[pww}so꽢 fuݫw(ITMl@`#+ @T^D †HIfǎHrp!B^lb@ Q qXXXXl,,!:Ā&y&-H)jk`afy9?4ƴV^^n6  c  l^N4ZTm-@IAo130mlh.s  2 PڀƄH P3pۡjk q:/k c% lrP(ځ&0iW0vL-AE 9&+&m_@ k ҁ aeE?, Lֿ52Nfq  qD]n\dj61-ɎYlabBc3A,,,\=jl57;_N ^vv / SDG3qpyy`ba ,Awp谼+?L-+fRVG""FNv#'+iefm+DblmWh`|/el|8_.`c[[:8Y^F& ׿^yLm('Yo`̢Y쿈 ,K"Ezɢ_^ ^Keƶ/-O2 A//ᦦx)7_ ^(f/s7;s_ſ>I/zm@-J09/Kv/WlwjoRK 5^8 hq^ T6vrpxyzy^?d87mk>G`M0 M$ZF9&;TxڲW} 4B$uUc= bT6gGqG Wv!bT|z]"Caăy)ZUk0xzSyKp1B_$eQmj#}D& =C{-v}Xͱ_%N G~nLpx)O&4=Giޮh!XpH߮jz3FF%w#A6r#{xWn+ȡۧ//iw>$pguwzSW}ye3ʄy]Q_qߜzH\}<P"#3<]l%MX1JrbYC۾q>֭{MYBXd%Lf@>M5\'n+MCpX6wY>=!4E޵1pXxҮI1ѣ )}yҢ1kZflvk(y L$1|Y@ ~TږmWY}IO.eϧUk L94 [[DMoQa'Ϭ  䃕~^"5GN0u"RZ.Wprd^9?+6t@J7.Z~`0fLxK f,(9ogn3 z < x7p6Ռt+Xsqbڌe mɓ veGY5jN9'ӊ1Ť~DT*n۰w[>jHowXu!Y7`o )?Z{P&[N2t)MF--E6 9J6*ޭ4y<g`_ $55P+B^pU";_Hz@/w{o_AʻTZ]-ƒ7- /nd:#A 'Dh4V(.%!5%mhh8rXJ~W=aL-osV-n`$x^m\i%-BNLҨd-Trw2WE?ug'2U>YN}$f 㾊#]c}y{Y`}`FʀՃشgSڴ(z5AU/7.dK9uߓ>d4_5A` ez?ekDJ)pXd:7NRwN1\<}6bb?#?j^ 0 =^>f䴍/2PlMc!fa+uM J4ga.Qx&Tԯ$"/V|kݛ<-]j]R[!I62JiSF-4U '4*͏`g~twmeB}m=+_t}Nr| e NH3*VwvБ335eJ>aXjׄ]#o %rԠS333Ska||$n]բe <5-5`+)Up\?Ci 7|ha\ }l5"u5%=K"&VWx(Z@0OML3> bW!+W]P(4g=?Yj6h9~w /:H{ !=3ţO%V ȎѺʝpEN $=Nދy甃nU,R@R-54Z]rL;$͜Kpɟj)?]ʔY'R" HibSe5/O|Qָ(s\!|],4m[=Fh}8ұ;U56fB&xo V]p sa#(cs]2}L.G\dFiÅ̅Aih~úHFK8p^׫35VN.en~P{IKvUlb;閪pEDGS a91+ķ34Yk5Nn>JE ӗL9$xlw - "$W?-1d~M bW? ];c guT;~VCY@W :}mQ'Lh|h+a0llu:~C6̺seKevh{FWR@VǬj0Ȓ;Ci{}+knh DO$)PXn%>}XM$YA~jt]z $ I=P? yX?FZ3(:3JW2:jZܓLAƟpaB͹y8F޸VZ>88_*]D|@0u=kX7nLGr+ . (DSb0W=*2oE蝹]w%-{>}T)o>5C/M١>бAJUCOHcaS5aӖo*Sģ'g$:I2tȂ\Yޮ?"%_j{xGt\,0! Phj2Rx7DjNgA_e+g]1HFAGo_Y ړ%<6~>ρFI+So@(2#vB^AB?VpRߑsFykl%5KnktBĖLPHL9-r0-O*'/r8vC!<| ꬗@]|(+zVyneRsB&]`1>\fdL6'pdfxE %ػ/D(2NK aPH`'Z6?e4d5J%e8}aŀT*|YVh)D"?=sӽSLe ,\sQGm6յ JoC+Dl R yŅL0zOmzY5洃TS)B`_~:˟ܻQpyvL>鞷pF$Mζ@IN頏cV rkd C`hRs5K^0#QxGVyeV" onC,P\ WS\gxk޹1E=ۢoKO:Dz86 -.Eml옏p U}\ڛ8(9BJI&`&LpM3bgBڑ-lp8%7€kҚPTg|Kc^R&o}ܜdZ ?Z·H>J#_>'WÚ|۽IݥQwKv+1 )`6wrޚb&\?Xፊ8`e%s~wqmO1:ࠣpQd0WI3yCGNA,k玾v1r=o }ldoo&L_id`:!Os]ώ\j&R^Scsg4G/,c 3*uvxߴzQVMXqt=ݞ^ )s`~}#JB8g 4_5vЗN3 \v/-\>[uf2R/X$UgVYMpXQO!k&EάCF.걸*gw0[?[:M4; '*m[c$yN$X% ~ybss3I(2(MuSUD9H㙇~<!pVmg/jVoAF|QgW\b>oj g@1x}&c&LΘ"lvtpq,geI?G@VO,p%h%33߲1b@oFe=fۯdϥu/.CܤCHF\;甊q?:ݚa ?}^$MmcpI< NYKtUH E"sdSxܴH{vb3-U7A2oD 7<,aSw,i j HCVii̦ьAZSzJ{0 3vgd{9[X"_ catG3NQ}..˜IeۤMvQԬ_.#((p#X:z=qgVbkaiUO;׿HbwÑX[`!SUd&YÁI$9r<^[X#"aoب XÝC޺@*cī輻~t26zolB_&nF8H.zt1{c3+ L%/fuiA$d%ۣw vDIi>@/ӵ|Kd٠ܑdf al XE}U.#N"<3#>9IiLOI ۅbO[ =-FT!!;WMl7d.@3d4qkU;+׃T2|-l$Ooxfr, EW0}dQox\[B<4>*NߠGnio6NFj^rw,Jp:"]HǒfGmgӠ6#Kjsܳe1~isړ1K}Cs.ɳ 6ݛgÏ9cfō쁃"*íX N0='J;[cvC+Y0n˽QΜ(3%ЇEg1m[ %n,EGC"f<$1רSř'Xw)G0)EyNGY ] ڪbSQx0I!fv t~ ;uY8r~ĵ^!LDuirJ#kEa7Eh.ߟEC7c^Z_3A/9akzWvSD,U=&{M/k֊E:#ʈCKVLY槃80]"'C#$řEƜ[7&i(3K%{4!%dˤl;>SXe֒E N=/߽ES'v"f3]B_j*dn"Y4IO4~)ܛ&; ~&.yLˑNb>AIZZ{!g+r*Rվ~%Q~)nphܯe>t|w Ɛ/o"=ΘϢӣrψm$>~;쟰􈿂.ZMYcGT*U['&e7ZE&ZbBD֐/>|ExG %넰S Ȇ:l铿?Sn =>GGoo]]='Ϫ+w W%vGپ6(EcQ߳i2cL!JQ؛3G1jgPx> !'n&m2)t "TZ=5l}P~ýDsl =e(.-:`dBd/;oE]׹QqUE@KoCCނ-ߋ>n0w Z;wbab 0{݈8~k"Ujf/y¥t8Uvtyй=|=XtL[ECaN{w qsܽ &O|$M(^nl0YCH xpw_90(bUQ#(\ᚒ4D{<ֿ@{Q[v~>v`+V6}ZQ⇞t4g5IԗQV:O+ DdqBm LFK./_Owa̓LIܟ*aotfAq<hlEθ:Rӧ%L hTu8,tG9t3|]MŘY/`/$&Os*a\oVXwű_8R\tHO'yHDPgj|٢ \*nUB}l6o&~=QG-JC KR ӸL;O|M}fg9~ܽUq$RTY7D:Ξ0;'-@WGui;/HYՐѴfs6ڥ+DDA̿pvzemc)Be*~0UW6-^Ujݍb@ezUE'*)b<;J'S#M] 7ӳŇ$u4Q'&GbՃx~L{h}%,8Jw0XF)p2FraІ0YbI9o7B,M0$98=6pZ}Мqe`ZX K1㝢~/ӦI+1ɓ\{P4vs:XU09^T%AQ3m\[[yxyólO͸Adw IS͂iB{Y&.MWc72C;&W b*'y#T juB2s(PaN&݅#-q0U"Gp!A'.:XJ0kLLq®-AZO3w5 m_JZEgc@^溟b+ cخ2_O]pq@QY{㋒ N=*ڶP`~b|-$`O1Y}֠t&qsŘYM- %3nLzvHy!G`;HɅ_xXi˽ƈ+08 #([[L`ے_a囒=i"kQU{4c;=O`͕ %yU]+#8a/?m59wUfE!*A V}PᄨJgu]-(-{cqZJ7qoDŽ2^]7$L3^f%X soG o#u>uuԨc A [ҝ;4S@U=P,uׯ?uSw汨" ]ZR*xԇ\dDBOghh6H 1F1scuyx"lsRAw5)B•I8CY E7̆'=CiJIeGY;*'|] |6l4FLy^8E><\`: n@-B|8HBES(j`<-8|Mr>e1Pr c 3Ȥ@XOMw# r!K'> ZYOmXw/GkfQJWB"q?s6LŪ`HȖ%!L"Sn x:֯g UbR5F!4|֢/*_!?#eD@r6f)LjgxݿPڲ ЪN^߲f2֗I^_\fm]=ߵQ =\݊GNDhZU<7]ufnX r)a~&7ШZ$wFU2^׿F!;$EEBCU h%u`UᲘ+wHlS$ut|K?ԡa6FM+oEK7b_B:Wk/ʫ6~"Lr uoRvKӧ~6L[3vgZ:#T'_O3+]VgRV(z5QRq0fDy0䒌E޽y--S٥+|^ 5tc8Ztp7!IާÍETKAG$#Rb?\VgEhWg +O;ጦ*='31G~`c&sX3Cs6;\ݮ;bMQM-%l!=K$X)@#*Edَ'iVwK+[WA)WVMcՎ(bPެ7޹B\E&CM6gA4;tUKi3̥[X(Fxhs#_KQ`70MlfSf-O!<"& Ʌ\]A~B</׵iP0m *Hi$d:ϓW{JKI Zȫ,W϶X l:#.J[Q$ӧ~q,ᔑܸԠJq^G+mps^=~_1~pVɈk|] :v 6E¦YL0@T:TcSq?ZY%P& O>K+זS1a^7Le 0ԉP)dT'F 1m i }F*7p6wÏ܈r9Z9 ˤS0{]l?a&S@n,ꎲ6ُZHEѷǕEy S8EC, MO9(wqW_u[ x~$Ƹ.W% Nz@X~>7B9?nL<}mD=vi!GQd 6g!p!C{\ML-tmȜ;F|p~[∩+8slq<5?|ژ;_g/mE Uů}\cIPm'ՄC<iDY.?V1/EPIe3IO_})OG@dYIh~nmCP\VJYɯCPаݳ̝ z%Gz6 ׯ\]\r4GWiƛ:.p#$kP)<\ ]@:t=rs*yկBDoƞvQo#&Crm?|:-mZMPhn`/n7k+c0?0ٿȄNG=|\Ź0"KD¤dyS?uc/)w:.^2s@htvN8!jM+ء{H#*hHOk<}N _ͩ6}F#ٚʚ=:CV%ITF-$bF,.7*e"ft&YNXEȴ)I0d JᇅƢ~5'4fGQ#wOُAx5&Ԗ* O, o%2iMpO߮>D'c\C3u,݃{:-J 4C1 ᭫u`/Ύk 6jl8 .G eϪ@0UhBPA.Ʋ@8@d@]ɣ!|6[%J%ؼPOenCD|;! }&ꗟ~?l! kMt#[}!oAfHm om[V2wL4ޣ2ZGՏLo9>БG[mAJvW28 <'̧}kEf& 2Ư(w SmMHbZ꯬~VL #]1#3ޠA,hײS=r\=MIY3Y?z[D<:zl3?B<"2C'Fjsp۸!QWtt|' lxL{@] Lqj-fvo{𗂍cML&B2֐(kw$杀G4rFz j*W Cuu~9Mo6!\lIY8(:}Xd{Bj!Y~me9ӆ$P/ |<5>S >KKgP3_k wW.IBRH67-UQy"~1YQmφD aCsqCE2h6 =Rl4nSu:[b=94оp\>l ܣzvܢm(23 bvrpXqWSҪ~j!\wꑵ뎾9!@]Њ`(ގys,>We*}{&!A A`[ujb|:ࠩpv{[-O+4\"oug2a3%I% 7h/o;p#$%t%60uvHQt> stream xڍTuXD-=6if#6TnA@iDD[䛾{w8=uWy>zG05$C,*k+=4 $ |ppPp$B?0(Sx`H3,K%A 0$@@mA}$TFNy@t B@m q"pJ:xxJ y{{ B\({y^~7hs`_ku .p8" w<~)!z Ým) UHk>8 ŜW@z#vpݯUl=]p7Oʟ( @ :j;vE0v0=P0?m`-|#TǸav>@s` 7K lg/ZTIQT+)!}h 1J`^]Is@!R 9 < Z:H a@oA1S/ Ϥ! .pg?1{z`ĨP2VB:wLQ"l)AQ?pw5Vu8~!>5@0_1֠Nω;C0VEҜ8BA|Xb@4#N[o>HL Y))k!L$PPO #L[0 GBe+~+2x 9xytdYkM?PYP$7|Rit5lbKG4 ''4SUu7-?;r^ll4Atz)elܓ)=-q.H[RR'^1TBqdA@;Im,GXl;~lB*&QƦ|z8 psEE OQ]3Gz!1,*`cǫmgg r1BA&۬ٞ ;K"w{+QTrJ ?a3"Trǥ_W2 Hwt6EgpMgpܞ闅;x`zTX%B$M=VA7`d B|X>hms*2l<m3v![8ԈmS;YGoHɚ._8_)>x};b%M/RMQTnl*0VEm`H tG4֪'PEYWtmB@bY{XE9@{Ǹ ."]9ذz1@2^JVOW'JYcN,|O3m+w "̵e)Sitil8U>m.-0hKg$=Ŧ<,eM,OK$2"F9?{ / h\?!EWd6Mc&i"jZe:[p -hfhdŠbw6_~>c"))𧓺K18i ePԻS, U:6,uD_B:Pk+Q2eDǰ5ŋƢ}KlڛŖm,FGǮk 9Z73D=KDFQE[Odhk$69Y Qg%O+nEIObULj Y"^Zd&q \*8Уl"Mp.tV j$ٖ!Mya_b滪΁3e̷X^hfwqggtߝ2]v݉` f6Sm~EاF"20GϷ{ /3޵cɈ|FfU$(8KڠuskQ/|3BFN`RelQ2LOxfc*\47J>SCtYX7:FXU [|ۑQ45ᐴn[8AlRlm>$w[󄕢)WE;k7M,n}Tks.áXi \%8gԪ?~@&Ur8iulbSעC]1y|@@PnXm%|О`إ1} {ҞCLm g6c 2a-UumYoJ$W=X'cwT 8W0n {tczgпɇj%5bO-9SQ#-s;Ѕ4}8NV%X:Ǒ>̤ͶCllW1wޏi_7⤵dIjP~@K>*Y& l! ذ/Bi9@;Γ Ps#2 ߭umȋ{=ضS.[h҄(kj!FoqSzh>?ݶyW=)%:aZ'MC~_]8_<WUy$ge &T"r=efիFatS:d ͯE7'ltt,tN(|Nj LQJ/;N;H$_{VƑHWqM0NfAt||1,MJ֙-IWL!x#F[DSL`>M eZ$z "C{[1ѣo]m[&R3}~rƶȝQ[uFOQ1lY\tDpUYXלxbZq(/͢SiBcLL[:I2 aWE=M~3&/{=h.(.A]\gh#/_m(oa^}N/XЪz0֋Ʌ7K=|< $ ,^CvG%)dn,\I7LƿU {"A^'I>:JJA[J, Iou9YKŝȗ,_8kJ#-i-> ;s{;XQ۾@kv},LwT$ X*'s5-P$>KuNQ )*rU'O/]emEVb>ѩPe_OψLzίy~<vtO6yߡ!GS+pk9bϋ4*y+~H[p~aFSo=O |q6_.IOcMQ)]JJѝ͟l4O|e8}LG|q݄AX~38?ݎ4=.閟6`^5NzmpJAzJv6O5mcQRçiRj2͌/}JP2uH [}״A};qrPiሣcj{_zJ ]W 5m1)#Uh.tȸI%"K: ;nR(NvRuV&+XI:[mƏrMn܌~8=f}UӰ)/ 2ݿ˺7Kr~ c(۞ jɕܵ@܁DavTz-M9~QǓ~WU4UTzbGN{swO "l-Hd'vA}&튊:zvun,n(+2_o.; %m\ET̽py>+"~[XE 7HI8dg+IBneҍWΝ*=ߞY$P2\*-M]א;|~WcU~#.:ԆNhy5u]oTxgä8*lsaIT*(LI/g&KM=-X)0I"):o`'ٛ'!7)9R}/{R0u܀ vo$Dd&ITaOiUhh>1$Uvc&~)ŐB^JGm}wk#I%~ͪ)'/dz}ꗎ̩h6~ji}+8bWigZPi"S׷{ƥ"XփCE.{j,J &?}N#'ogսk 7H{s[4߹f\v$V闑yX7riZ3&z9-&<cs`qjò\Dw>oLlNF7f%km7U̗@{Ϻe'&pr. ktau]>B>ETx!fGDV AkNǕ\Y>ȓ<Ӵyƶc,Oj݂s⒀c-e\m"{Ά/8h@f$#/Z3ĎGhٹvɾko5ث]JJ37ȔtujkEM[[iV@?I #OK'[n]=LӐEAӈ+8#ј◕_ӯ3zZ#J漭] 5+. b&pSjnxjR pWn,K(n՗Vh~z%uHnYeO„l~`J9) aĤo XW-oy98Vڟ|Bz)@VOZ^T0DqAAS#`iǥ0F@mh-s*ID:+`6QAS2vR}ርsbc胹xb IQ<}?xEJC_pW_ 5A~ogZ'*Te75d`1wa4_< nI0]JU2'j:]. Ҷ I Zf7|Uɤ:FbΊ_7f.2%:E { eсRoq5b[4p#7YfPFӭG. B/R>6'۟HϓkMkZiҹpwN]񷯞>0 fNW#+A*\<"!> stream xڍWw8m۶*W)j&bϪ֦6 DBE)U[kjը)ڪ}w8\u^w$<z@%; Bb" ,@E[P] @`(!!11pR?0*hB86 pGD""R`0@ BTp;6B0d<*(Wo4W-?@DFFJw:@Bm(h E Pp_%XWYaaOOOBp#> C{@]`/":1 PXO(9p[KrG\@@D@"3W!8w2 EzÑ{8Ѕh^X!i E`P| J(n?7آX GRWA!TP..0$Ck>U8f;yo`DcÑvVsw6Bap.|0,@ KI`n&ޮn(W=n? @=`,[d"";-`s#sq,@ý` E_YxfB"haSC= s5;Ee@Q 0@DTJ %!w%=(I#Wi10O&)~kp !&?3A u#8AS&?dBwL ũB c6PD@^0;=87; Ca࿞5,0b8:'=`8-eKt( &6ΒiMh0R (4ٯr~M l)" m;So~&-{ fK65 qi<.Sb~:xzDj챮"P,;rRul-Ͷhe)je,Te{e!!'-w5͖sk1=GBniwoՖ(vJ[DN1:IZZ I)D\itYsq'&d>Q"!|K- Wͣ-74<+՘NcCl0z/57R&O&_j߭z0 +kC+.VF@(37YRbJ*6O3yΆBtG8cW$c٤.m/$E%nm-&(_V}chi9/P;Ա'v_7wg|imY94DCzjV˵zJA"EVr#d F:5 YC?"Pt'Ƚn}3h+Ih=#%^9sU٠tvoa ER9=M Ndā_"i'O>٢ϯщqqV7C%G037O0 Yv6x!ޗI^eT|‚x'_;;ZR%JΩyp_D[]C)j ifR<1N] D)C39cqtaOfD{{sWOWEoQ EӀ=xL-.+iJ3m!\>RKvfufvr/gS2arCHTTCNef(ètĿUȽr|rga3y•yu[|\N~mK;Ú|wOA-Zoaa'o-ZGWw}c^W xk) W;1:'ޛ|)2i%L r6ꇤ-aH9D)IRo{$V ft?sys !pTwBKffݑ9(’7Z%JQxT"V32K?qx|{:TѰ;ȭXvKh T6|//zAU1u^ [OfK8ݿ(X +5-ǵ+7ϪH+ջWxh2B ӈz͝1{ R9|D"F5(oÁq4O@0EO@|"Bq=QXںW~xXGeD*\ZvΤ TW^K)55MhEWTKLu4Ǔ &Ԛ'(}jtئ)`?8xpܖnMwiz˂TDQvO{g7 עXɫ}}.sS $h+=6_Ǽ#jzg`GV3MEbrOA0]3ݲ+x}S'e׳t% lbQ?rG;`l_Y b@B /u و:C*6x8dB57v ws BiIow)?a۽Y?)QRLyó7BʤH<)|jб;ȌQ zB|F)`tfT[7s|y:e /˜n:N1k[ $kO\{5yʾ #W{gnN)\A{]bZFfN`-yjsxѢ]ݨ6rہ6,X8)s9m9q)raw.K.0[։@Z>^ T&x`^[x,WqTJc۶1YLyli={B&6t112>0L[};< Y6S%ox1i> }\U9>YϴMz<g:n r%H.&ֿ'Q/oya6HZ'Pvj.6ȳq:6{Ǯh Ez$|RӄzɚNYlzZYEf1!v 5~bnS}VυrB%2~;^@/6Tzx5+g ^)%ʎc]ب9Wkfת8>u N/ؖ RH9i[H̢$xjN) m%U{KH [N?t57-ǜr֬԰g&!P呤 yb*L$@'$4n.pxY<TR*`D۬- xσVqfS>hD2Jsq"=jXg?yUhb~}r:]jw zㄈͅ3]WwDk-|:7e/fͣ4yY~D=q/\?ZQ80=-^zO-iiߘI^ ]B&m-ᥞ_ꔈcg*A|zo9vR8HvO ң.ut}#ߓ4'}T7^EI*I%5;E$ҕ xT6! \NҊӯ擅پ:j,B? Xn<'_K=G='64B: 'C|%Ɍ4׌>0s[뺊<;Eûޟ7hodӖ )_q3[lwZ#Po_]N v>|M5(OOC'zmhc -:)hą#׷bIYϦ8Ca>i,'ɨbߵJ}ieDIkπJg9_Zi 9-~Z4ۂv|J:LJ6[ 񐵝UMhIlM:6}yB{:8~RbF{u^M n>վJjCOtK o3_ {XSDdw3ӵmUhcˠyǯ'8#<<^ػ< kߤۅκ} N0ŜXl="xV"(%k DVlOg0 6u,Co%Jy1|~g$cjQp-uY" ܎v(DLClflkvSjIZh,.x F3HٴJ؄~^]Y] !P(]| kX{ k+\)n_ԟI\jZt9I,("NjnkQ6;hqwGE F,Q coBk34*7 \|3Y4 oR}@E+nm^UL6=4s*=I\Wn*.xm фI rĹiy*/J$FYw0ffXoe]pu{GST.t$1.2p˟_ɷj/K6khʃ}ou O< *S\;JX͝7%>)@L<ȖV@VW"S#KE<~f%^Y1[/,8~5D+jFbKļ:Ӳ1of30]4]D*Fȣs?(`fsJ/ۻ_)YRCe&}  *{}-z{76oYo>?h%HQTP*'_z;?c7|tVztO6xWi]ހ.B;yc Jvܖ-z\Zd(촟v?R:NUd}ZNF_S)2ց%Ivao 5 ˊ4vMe46#}3N'D:ѕC۽$`ؐ tCH*YI78xҺE3l҆ +> ^+om{"-f"rp~>\ɨ6bI>2Mx'P5hKe7PA#K!\i47_%?胦W ON]ZxKoD_c$݊._1r {RuD \h0g1h^\L@N?"]l#@rT%\^::kjö́Qܦ,6_pWmlLRhөȯ"5#w⻷gw8P=?H4]2>TTV[\FLnf;3g_βHf"Z|Y|\Ilj7l9nƧ]0D58+-ȫk\N 2DC rQycDpA+J>b"Ow\AwSKDܘtmNR87~;~ZM#GL&.mwRUS޶SI' z28O΢E|E}nF?mCK#Th1cƈ`@۪ 9=` #&s㰼D=<WU^ ڊ&MuL>sHakER\Ymc535_ //5ǴK;J-DtLK+3QI h> stream xڍwX}?RRSi6JcH1`0Mb ]Jw)) " HH((ݼ3yv]9=~ad*ri8!0P @1a P !`멸a,*tjBt# 1HRtGQ蠐0,* 탁;y>x|_ew  ̝ ALQP8 r.8ZFDKFa^p a!pq5GP Շ9U!2ҙ@i!0PՀ{8o֛\8 3Ba?1/ l-#X7 X~ #,?PGBQ?OTB` >T$ /0_#Q8 г? 9hI @3!AKDп$`b_;yàTQPךփ*eV/!9ʹBCn RO] [v۾u>{B+Μq{}n_i"zb!S&2bTtt6wccV,=&6iMp}%۹/XGdԕk;J𪤝bp;WN]MMb'Ş JgRj \mn&uqOr}ӡU0yQ9$ Xtn:᡺>cs'uS 'ȟ-~~Fr*nQ])o)i"{j7tBJ*ͥP4%xNLVavYKB=_6 hd,} ~v/&H:hzu*}~ϯ{FU_ou6Q Jl=*$Y%fBW.Gq#QA 7=V"1*ϒu:q ]'+5*k>,XT@qwe੉Xx3?coSEziPIJW\&yhYqڀ^fES/.22hRS 蚝lSA 7eş |\8d}?5.+{ݘJz<ZWģAr }bͩAɣQ.& ݎ; mPWp57SiF wA yhL:_:}W7A7[zhh~VA1aba1:/CΑ kޤ٢lYag{sH^8nywM$Rb_#%?RU Y+u*~7jxЕIA}̭&'fU{ pX9r39?*NeEB8l86ˬi I@Ja"IJj> >8Iz{SPxW?>tHvKpd{!Dbj|Dx\'u٪콘g 6onQ'RZU^#~#>(JTGtMۿpX"m!^gf˾=fUl)4J|}:-A뭧]9-iA; ^,eQ5ޔȼITlg1XO13U$VτHN^^ . ¿LYz 67URJG,EIi0>'P5gdt_hJIhIfϝ-]Rs*D9'ŭp~.G{Ҍ]ZF;)L`cjV$老#N%*J+?~"ul3L>P҆mKĢYt90]nգY?Y I^{6WjkDjqIZnPYO_[2BvzuB%3ұƓ1K˖lPT֯qZk79E/)}ᰮK$erO*YޞMV##x&R lakbt A )Rǥ^N7{m@ 7kDpnJ~z7[kM..*3RJXkޚaW֙ 2EoV.h0ZrA6LVa >ZB@j˳6U+<;yN2kgb^ZO6~c3ax XEe{աƛ-acnO8iy?/|BI˸7gT>01\}rt4^"jcz^y:}30!K`'/E,W^ow0P~Y=^%IxSvS[(ˮP[0IE֪Џzy!<ۤhm!NYЈhby*b#zZC wfL#nlwsa[s]3:XŴܣee LM/hEED{] ~Ȩp"rMzQHo\Xrԩ۱Ȓ,p*s(!Rtֿ{Ȍ&!O_sAMY%n&>O(HiXT%%{m,){ZuAӊ+ecl[1?Z"Igw45*sPE^kufLFݣ>̕2ٕˁ#%g@!J%bCa7*ʼR`Srq ^>6YSXQ3Ꮕ G{fa<#os[r~.\Qh`:iZ6fESN~mEYJ>zԧ$m$FRMP{X_]<ݼ5w_ϗ: p?2DjՃdqnc3Bk d%,\@l[˩w=6uS,MEP鰰#vCjR*ﺚlkUW'CQ,#ӆc:07Qѱz;U٪GT1OcS弢60lݕ$`-W4(emleƫtF˺<ۑk.QJ.1"h6ϖfO<0gfR=ݨ8~4!z­A i,=(kIyVŊG]spRcr2m^9LPzβNyb^%3ޜIX#p)EѢŲ G x̤Sxi!i3PƃGwLCV<]I@Y1:rSa7xQƍ3 /jF [ˊ~ GoͻݚIP2;ӡ;Ѳ&e%gL4ST Hٴ)<-H~=̪^WdD`myh )&q}v[{Ȉq4 CRn+rYr#8di2I5'K[y|e";.G.~vowp;ͳX؇u.]N|҃Wi~BUP=ZҐ:0)]>8Uz؝rM{*1ճQkM` J*霬={GIN=u,#Ux#yOqfaE`ݴ S{KDxLrh4qf 0c..lǣM,yeRvA|EL/Einmk83G8$fbmK/G25=\ZPN{1FXԓ|ΤEf3|c&(I4JzzI90^ cayަI4ѻ* rwm-]2U(:)'*Һ-,qQC>R{VyO.'J0'τ3n4~K Ш@>^9Se`B'O3lb"p˳V>6KqtጸEYܫU: ) 8_;?`o~W~kpd- .ǭ瀿N`CĽ7} 3}U:< HME_u !4fzad*L=#OUŵ,)'$DQ>Ґ J~+Ma3.)={Ԙ5:pFˈvBξlq5f O* "t9xTp?=$iG\ȫd@Q 8%kwfFI蚟 ǫoh hgvMi$'o8\hIN羭$5h.<wM8" lE@?%_Z/WU6^u̒|orb{8rNowjl+4άq#nܙ[=b7#|+ZJ, ӳ:1"Vi}XhP׽DLoYtxBW2:Nw!+2.e?,z"@:?l:!_36oǩx `^ endstream endobj 220 0 obj << /Length1 2566 /Length2 21918 /Length3 0 /Length 23385 /Filter /FlateDecode >> stream xڌP]۶-܂/ݝ !K !wwd+ukۘDYA( SPea03123SP[#Z;:a 4qM@v Yw; ?.qks#@ O!bmiG ow=`f1ͬn Aohbb)HCv].@s_ MdOPvGhivf@W9"c@Om,, Y;lbfhdm` $ݼ&ع:Mj @CZG8oS-?K4vZ7"8X֮^@sek73_[fgTvtZ0Zt2][mο)%Z1VN7< e9!01:8\.u$ `Lb7I70Iq1$#o `L2]7F vĮ_ S@ A7b0F >ħ~#P~:E< >di_:h%kFhfE #agKbo;_; +t]@  77qC*h%c7M/@&@)~`dt$ fUÂ*;:A8f9;K :o5(`]GvH]U^67ˬh0݀vbac74,,84T3zQ|+e @YkO&DZn?VvBܠNQb-+^_L>m5Z5ơcte' ;Nr]y fmQ [-BtV&`g`Q(yuh;]xZPvVЀ' ^2oaTxP~3I G<"ff]n>QSr04 5?غ5$ғT#%B-ܯ-Q|< a8 slۡYCBڐZ^zalc/YBCBW\GXFyPz:Y&-!#qf4ȹ=ejjv! 0#_w> omcWb 2i-rY :a奂g_uy>gLR6\;i99_C4=Rr&bRDHrT}J3i52vOU z8GAw U8>kIym%So<]eBr)Xf48#w疟ݪ)ʷ'Տ<;ŚƗn'XIͧkvX4b ]?0';</<)zXH]_H75Y6$t)l̻wܾ I=;FZ"r~ F3iZ; oAyuw&nİJ,GL9$/Syel!+(}YՃzk Cx$B.h&hk|\QlKVzՌU&7Qѡx!9uYc7=xuWvOrz] q J~lNvǺkLg{Th$lɆ'l1僫1iwJ"ڊ8ASp>ՊQj6MM$D%F kvny0¤rO鉝vv5=9Kq$ss#/&*,_F<[Κͥŀ$WCۓW,$X"y\\x ₊E).ryWdKM;NoYIK~9#"xai{ݟ Tﴖ&wC( Lp֋pxb܃>"s/ZVXDܫ+r;L0-zЙʋNx8V$D;|t\NE^h:[R5c+ɘhVZR6D5Op3^ӝn/>^  5LQ;ծyA`Nw:MEkt m`j}Ӹ:Cj@VqكCq0P"EЬ#V-Va.LvWnV1b6F X _ad`GjhXū0bתާjuh%C+ \Kx$4 6:)0U%;PC+>vN)9֍s2ޮ&B:s3D, m>ېPk5a|U s5[.Rg1>ZI4UcX:ȡ}O+Xq[sB㐢p5 r\ tz.Y?tnOtu ct"%4$ ^cgB琥ctUǑe7( wRh);rP.~Sﻠv ]`r0r!+K* _72 _ݨH+'ٸ|nhe+Xv٤H#e9cL~}u=%<^FKuڌ6aכs, SaDyX11_l3XF@ogD{Na SYN]hvZSYxyoՋ G|fmu~3O̤w>u9skWNG[ "3xFaU2qj ASdʇ돧&z,؃0~h=7-Kc蠓^s,^=oJTA߳gq(T8 rɶ\52AF.TGrԫKrh%V%1Ġ|nč:*W5$T5:jS'Cr}t,=?ɦ(lc`18HR Gμv 9z>LQu;\9E JTc^XNm7E(yDԘ4!(5,CeKƀ\ |qD_&OD#9zVkST* ghÿ<4_2R7lqU5DYjosY<|0V</3Ž{Kv?c / 9gtqN̤]7A2K_p\u R6Uai8L#9,Q+pHeIC LGӷf-Z2S5пw]"It, ng\9bc,Q 5h;L+ҨJU5WoT$dd;0a)jR} <"L2P0G aȗ jL  @C;G-hwMd?'t|m=k[d^7Hvof{}S %jƝL l!sNWs{\^}r7s yY5yĿ>FҠtˣٳ敾T _1*Jjv:OBc Vl3HFn^eIS$hx,t#B6RTj&S}!n!t0zGhSZxcDȋm*Q͋UР=#՘vx袝31W2V{yj9`YJݘbg^7F7أX",*,y   [n8*< wd\D,D>ZW]vLO鸠&-CEP1T|Ǡj5(jښћ-uUK EW+7&J<R )Cn!_Z!mgEM#1ѳM'Jwlh .p؍?f~/ YuL9yАp){<b^x4tDna'^Ա |=KyPl4/COѻ^{gZߠ`2v"\әh|jt}b> 6s;1OQ(|837Qv Vz}7MœQ,S4[n\ u$[,Հke9fѽA2o*]{j6AG2̱=@twII\4ߋ2>悷Up3( ^?=h_'YgOAlM<ѡ/hK`I=GJ+ƅԽCT KpufHH9(r r/ m M&U1ӣ^ O]5lF>}t_(]C$<=>+fkц!SssC-UrÃ.QOx{; ZfaA~-+HCoMq9VmdR18@yO/LJQ烊&i!OTkB{{3M ă@ˀ (>22NÔϋ9XmdM6Ip8_4Es-K t F NII>zE2*th:EKٱIn!u3}75U:*6 yvI&eƅ4jPS Da/b`׵w:qPFsi}o n': ؒFY^=q!~1TIR(2+ϼCFOCs%<2X3 glK>/w$- Fnˆi$>Fr#x(~9Dt0!+n]qD(nwuDdhNJ&S߫x^}/엟kPC. o/a;K?WC`Mj޴,x 'zĭӆe{Ⱦk4fMT+G/eC'͵ӟTBV5zy ?,- Rl(q߇|%jy~ؾchZ5 L]OK?M3P$q)/vI17f gq]"Dg˱ю1\*VU _y:9=*qƺ0)Ճ]Kt5P/9& hgrw*-{[{VDۇ_ ɖ}K jT;+F)9h)qV0߬&v bW/P"G2:F׬Ճ׌@|2{ִ9 ׸ L#iR-]>^L)I>J&=(/6=n嘽P}(> 1@=貞QR]XaNRdHoB͵O|״ҏO.3؀;Omr| )H^9 )VVћk֙&dr#}8B1L5m[Ͽwh3}n}63ۀbxg :\NvQڀNw: lrފ9P~j=X%q!XW)i"]Y0^u(d2J4D&wkz"w̌nJ-=KI͟SزTHDrJgj KucǮI?5Ag~Ž0&UTŶ7 ݒVjCKpM#_o^uJ[S)>6ap>Yt <& A:*)[ennv> 9Ӟ(pP7xK?UwN"%l6[?0lk1ZMp90UZ&FxxO7d̋L|ݝ yMuca Em4?ZE|4~OL:Q?Sxa{ Vy3=Mfj"kq%ϛVH)R.IM98EQqU*/0brLuH*?b_5 9 (oeƬvB'f_gui%"PbeQ!֏1Nƫ.*7V(,Ufœ(4q .-i.^:kI m+wL$8ЩHU ;OE7V)yQnl`p5l+ ^2eAE49~DHZѓl{lչ{9MBԤPT:pB|&Xr%_!ܨ~Ev#9I&xgq 0ۃ=(wG a `dOm2A 7IyڇKփ%7DPťhrIi"'>xÿ@qS"jus"%,{#݊yHn%RdVK^U8h8-~~[1V,Ċ2 {lQ/dJ# At: 7iw/ *qsO45jkѾkBhnP&tkFM< {R ٴ/%;e^{}4`d>tvEٟdE&_ʃrTSQnRSTڭܩ;tRmmuSΔ1܈K&cZoiud 6ptCד?Q'kS$yGoBޱA6laN4!|CW9ؚy*_M :ur}.a"ΪV~?8`ʼn-O4{^خYiW8cXuqp$ b`fXל3;W/u("xzyӟF(妈-%ރ D׉%K\ŨZ3{RzuE_CfCA^ź2zwK0s2?{UghVMg+YG1GM KA/$q+NK4xqU9q .a=Ê~(8g oۺ Sv XlaTs)**E1}LsrA$jWQu AUzmP:t^UbKO vӼ]=ߔxLChwE LiTUcW(EbY_M?9]# OU/Q 8Mt Sɇz7;wbxnwѢk9ه뀥|r;Zz/McP8d%:8SF, d!W|ZРuO5¡?J8;qn@GI[LbAyF?·xi9.GGEYm6%ųQ+Jʉ~ݟ%}ߴz.wb=>"#زGɏZҘU._Uȥ]0tweTdžfXٖ$>0AlfžJ&0[7}s8*˺jҧY)3P]v+m*=##ro5 )yf3&K7A73 Ml T3wh%N:4I_+0_ .z{YN6e_{ FMM&.$۠p]hϩN'ش.dw' :1 $-&Oq(T c4۫0wiHpTcL J6q~*:$ _èpGb+\NI =o%0N0HK1 J y&%w_p]+(smƿ=؛BHNr75G/`#?M6[}[p+&Zw!ѻ&1ӑ N(F̧͊52w֏_ j*Z']\&|MlM msMȬ~u"<;Ÿ[xŊjR]2£*Hw_k5#lR-9iHH}S+ GCyuq{wQ1\Bݮ`+}vKѨ]R$ɌGg~~NolSc]^Tr8wK8C0%5ֶ 53cE\hOOtZ>?N{O+2 L bHBDy0 Q]/kX+)+$-O8 J_uz[ 9:֐Cymr4XhDƃe{mBܒa@C2pD".(0&̾&C\ fGn!Wɨ i9WR u&#[gM#O:V'"T|Bzls+T+Di7M*jbݓ2q~Kڵ؎,zK4ÿ},0@a%ܧ@3h#Lzf=KhK`d=FaL79oAfuKzBy TǶq Q6(HoN/oltl]KCG [VFؼj ZTԽƾ!,9[x*63 5/;2.*:_|h T:;Ex % VjzH$14\ kܼ.s=~&41v qCy/SH852Jmv,0&GLXa^2;f_-k2@:sWQog[hoZx^F5WH\ФRƑwMmÿ( 7`/UUw@5*.7@ I}SR}y& MHaLcDY[U7l* -q_Egc)dw!qCبfҒtoŒB5 0" R# &+DҍINY­uŪ?bG}]<+0 *A^+ Us !}<4jU]Q\^eA6BY+ɟq7eu4tcNc&=_yr~4+0,kO:ƌtQRd="e^. ÙlmSesF5QZ\Ej|tQ\po]4uy"e`"ݹ! Сć_,9eVh yIĕ=aiY5KTw5)*. ]agW*Xn0g|7Di$̛+"1X/4LP:K{cfZ%\!gΛ{j\:1v|q4oEFujLAW>sI0SgMI,:=wd.Q sDBһ~PxA&0ԞUAiCu'&6Q +JF^c-_tqr I++򘌹sSmggsIGԇ))(,b#~D8+m]"`A>D][\5y"6Q|6ZākKũ"ߢ;ZO9m>YbԍN̈́NrU~-4 :+WW1rz-Nvw;P[eZ!]4[;^ dP2~/ګ| O o8i`8&BcQ^#JM{fț0+D] exjnA0d>mݯJʇnck$EM*rLѭ7mmH|UȟhΌ>Ek_׀_;j6oʯ;\lRbl1e7 r&Փ#>q(9S.ĦB {Ю(A/n[Ar 4YDZ BzTSaT:Փ^fN7(p+_Oir9C[*̆PCcoPj0):q_fȫN,OżCjF'bn<8%pinFySFFgT;yfJw H͟Yu14Wf1lRYhד&t2xGc*v&4Rz2XT_1~2"14u+wi#B8c~C6fNb~KW`x paOB" c۾LV guwa^1x3k,9s'd,s6YIB` ykTFYœgN`<B[Ɗ/C.:zǑ:hʘا\paUc``.CnwQ~4|k-=R TY&8@+ `*SQvY}r9Usx}P{̘3 u-ntiE`dfhjHW%8?}LG7rAIt>K^6q3grRlIsR6, |ĕ"CN7CMeQO,oˊ-'CK^Q;aI>뒌Pd #߻3wKHE:Z.!##Js^X1=Ϧ>r#79g6sm7 k҆ ~A/3$+c6R/܄d=#%/jtJ3"!,k M!^Pȳ@U듫 ;[li Ok:9YWXBA}(JHBa*n9ahvW|*PI)W3T慄{,?@|p2ig6=R&jd.V77^*׆3 ZJJ^ƑC vn'( ~bJ1 _^NO?gRL|0}x="T"?4ru l?lٞ͡'DdALcC:Ba+_Pt xXKj7+iJ 8j, 'bw&Q=Ɛ2p+sԲFPDž"0` 6tZ D~Tr{'3D|~=yߢI! FHOۃKYqpl=S3q>~{ \myRx J+*IE ^:.EgFNuM 80Lȫ)ِM?Vd#]p$hED.&K Ol0ۚ^3}CLX<-JִRz0Y;>zJMɲGLsJrf6.Ь K^CIQ!)L(3 #dSn|?R7o:29B7)o?>;.~L-^ '5ڃ{Cv/^j.v&z&Ks ׃@E'eJI'^9ӄ&bb@=ISTSpw[ 1(7O;->fEX?8~joIP]"Puu7H(0%N' g_Wmi 23 衤F*PFn\#=?YJ|1%jWX _fI77v.4ʌ&#N5ͳT<4'/Zgi*hʾZ`n)1)X_fmGL!ЪFidΉE5A^" Yuk3$-Ce]l_LۏS顉.#E7+!:J跜SykԤ}mOX.r/y] lŌ%wH5= ?%Y.oC旘|xmE@I@em}=aN|><%OX)_;JWb~شbuqRO S&&(4^ws5vĔ{Ӥ2}<"`ڬm gJ 5"Xgf0RWdѼ#֯>C彽כidd@O$޾_hvLMըvn^yao/g &Dl?@,v)vdJ~\]p^*s_gZem(=JdzЅ=OEl)1T${ID'۫8Hlte#;zLcDyLfrN<##Q@|ӭ쬖4̤M]cc:8L e potڒ,k?q:\$#8C bԜPAbCh͡R6yC8Cv$9rlO3})IAXOdDeg-wBG]C}'n捠$ [{}2nT0x7}p[qs V5z{iUFm9|3E`AtND2fn&H=gŌ;6 :|YرƊޱ Ӎ+D"RENk0.| Ҽׅ=} ݚPtpX^$-/a/!vR>&w%5& 4.~J6hR-5r/И?/ 2A kBSjMl#o(i2ݲ{Ta~n=ԧS~{>KH.9qp4HoZ,@ǻR9A'Ux.`"£eP`,u\j0($:u.L_:}zH8NUeNy3WgvXo_=rKb5 Ӹ*2%OJ%v+`UThiiϴ\Q$6)IXpsO+{R TWe Q0ypwLEG3m49P[rom v+' q#q FrGk4¢P[L! ~˛%#╪/VUgl-xM޷f K}x P|GYV$P`дG񩵮ECJ  nz$+Jy6ͬ{ $x7&8JPnz;51~Ӎ'/0Uo-v;:w!MW赗33NsٛOk:He&H8ZA Ɋx?&:E߰1g c߲A!3&{Y6DՍWTZ~f37]y~~6g#{l6x1Ae W:%D=΋*D⽷x@Ϟfcc[E^HPzK|a^88!1 yl#Թ!aW5Q )5nIO{d+_Op/ <=4˹-ʓ-E&>t#`yWEsHh^ӧOYjP+?L!=bŁ82[C+з0$Xhh퀨ZM+wlƐnu9CRFbo b[UvWNnbMsO4;ݑSSAYvlO򖩻}&kWdvhh#W/#[x:>@>9O%0_nZ{+ջeW2PĮ&1GwV>AYnœ>T e.>6%TYuȳV a+!dqSl]ɤ[GZ$lJ@T/ceqaތ\>!qs\D1 _yfU׆Y^Ke )c ?,bXq~JO5Ar;2>3ͦ}6w3pP̩s CmtDgAQtK6Kik׈W0p%*mJ@^TW>hꦲ|7u/-&6.aR;Ek 8 f]QźSƈ^i >jj啣Z"WXٌvx5_Sw-# 㪳S׋G~oU,rz_Q{VB?O/ccZdӁ]S&.U_׻`~Ne +-d/eըjr[āI)D:BDUwJ~y_q?Q"YKNJdۨkX@R˜ ?ߟZuYo#=C3ٔlW{Llkx>ך@ZcEbOWTacJxgg77&߃C%9ËnRYk!|Ҝޞz ɹ巈kPS"v 7}"4%i$mV ?ܼeGG WU#~e{G+z`'`1Lyx' s s|ꐽ'2ȒN\QKLn\/yMn$bHynYx \EÿVg5ݖܩd Z.,\of|}>r3J- RJgÍ]HnY-Ώ]h. 1NZmEź&݌&GGmw`4wK= Ͻ"uה0(ٗ0\L:m1RA8.e?'t-UbfET{,nn$Qb]%FײgY^Fng"ٜ閎'1&:$/Vp2dXEHB]5"- \߯ ~@E$.HaϖlZ]ؐrp=GǷآX}l}0Ǯ-1q! zVzrvՠ~bc2WӢ>Wpϫʢ.|Sk)|c={rE5&hNtvT Vcuxz6%ʖ~zAT\i2%c߅}{n:/?Fa> ޚ RӇ&[P~譹kUx7I>m$=g[k8B8U䙙Lҭmy# o/%5 'ͳ/-n-EHtqC6p[XojY%v,E~b8*iBi?G߳F괽K r# XSwu-n>JT[٠ԮQgϏltz:$;)c_={%N£[PtV xPoZi\,d[6C\ڄZD+o9۬L_U^1䛺g2Gǿ6Gv ̟!̩",kP7OKY0bDYv\̳:-99\ L|Z[+9aUK u dX8Շ;͔s׭";TL_a54?)|iY mɽ:.Y]j(Cpy mMi}@e.͆glyGuq"*9Yx?8/RF4mN$=Ì[@q>@XNxRP=TS히;8!ՌѮ|)hO0T9!T[PƂTC%“)ړ^qeb;fx5s࿧>VJ# EN-Lk,e@hg!JV4`ՂlيOnOYрW#!>A2jDo,0H . zJp|o劑o/T9߮S!Xӷ#<M0DFbiGc4"B":J!gP[8")0I'L{@"rğda;䐫{e: R骙&#@!Z&_b= 6`RCŽj噦-$m$O"~6aصْ}+ zlj]ބ╽e*F $1n5_ <֐1z0l:>f.z3]_ ή1Jg]WcV#^\m.ՌE_ETRe:R2Wy xdTJ ξ w|NV2q߾ endstream endobj 222 0 obj << /Length1 1392 /Length2 6355 /Length3 0 /Length 7303 /Filter /FlateDecode >> stream xڍTTk&$;i:$4afafJ:N);D= RH(=kݻfo}65Ua:($VTB 4IH@)1 PE`8 {c/qF($H*J)I P_@FCFbAƧB`.6zB r7~a8.0ˎ0`aXTrbъb`w1YEu`0 0orz10H( l07a`߀?gw??  F'8017`$'@]惽pkr0@G \z #~()k#(wwAs>-8|u3Ё`PS8,?E#a(ϯ @Tإ n_KF .ϖH Sa20!^IRF'q)E( q1$ {\/Q98sqߦĥe)/Z\N/a0 B6; s 8Qg]ޟR2c$0śb2/𰋏-|U[@"#xX˫)6:[Lف8w"X.yͱ_N(Iد{, ;{n3:.΋`#N.R ~nZ)8[Ms@;MPE3S|w0nLtrV*l 7eaCßEj+]]Y?c4AߝI"f}t +3rą`ul\6W-"G [iTK>M;O֚+3eĶ" pEFwn>:+<~BX1rW DbT ;q-'=,>R#jAe=݄m.֫ ΨGJ>2W;N!Pq .1D Mt9N.u .]~"d 2c ۶\ʍxg4tLҙds^>ܢO.{4%PHDR~#{CO!Ȍ_<޿6IVd/gedjpeb2p%Ev%S.R㛼DN;^|BV-_ۦ+s8hi;d2zds %?&e5JHOs?f% f ʐLg^>/壸P&Wc(-!0;"~:*K S}8L;%EšbהX0(*ŝ9\v׹4vvsMƖ`j?7x`R K kJn$7S+SAsz2ϟMO[62La~FH4̵d56xs]"z?ocw>Q[jFȘf|Tf޺RA?nvCK[!^HGX[%SXz}9š vu/5%aT 0 5EGñZ臉u<- dax+o1':+-$N寴-K2;o2F+Ն\D>R\U>l մ4۔nj̳ZDҁ,þ@˧7R܄-(ms{de@3w}V7P$ ~|W4LAtGŐGX{MŮ EdO^YW$+[ jp/2+*M龵lP( ؑ+N>˖ZUJQ;;Ϧ[>vMsLu 1Jիkj~Y|Y}h?򠩎Gk5bkx̛4y9(Ó혞pw{kjǿl_dIK;V_|`}|DxkGjfwo6e@}qf}])WD0;eJj̳Rpm rC;A2w󉃻6̫tn3Ɏ5gVv4XҢqO~ fYQDa=WDYEG9EUuvfn;}lH;˸m}ߩM52PlG㍊&h6cfַw)|( t6Ky<~J{˟Tԟm6tA0LX1u*,T7:3u E'EnUc$4D _NҟQm9@ƄMIeZZ, O'YyњY8E[Iv̙~zl.x5h:̊ yz[]_`+9J \ф+6:>~|0^Gg9ܺ]P-R,Z=jNO"~D p?ȓA}\,gF^K$9>2ׇ{žsABG#xӬ#àIq}G(IU RZkT8D.;΃gwyZLQR5/M>h+x;yk&Le5p7fJ:%(:-^q$`2Z擬Y%(կ/!m w%ۥÑI8M4EWep#ÂD\@Κ9<uq~֫G]%\]/ 7wHնrH`OܜN7c̳ئ/UP.6?_[HIgh"j[.=-m ɡ `Q0eۈo %>y:^V[_gĨI .<?G5AOO脑Zi 2xlDѮoߍ!dgd2UU}C#F\\kO\d1Ryᄇ(`>It=x)G^TKL77SFN~3t8HSBͽZ6٧5SqhPYQ:Oh=82joW&jۀSNbC&~o 0ZtcyE|榌*«T*fӺw$O#~TCz#*5xZwNgY 7ZV; /0 C>T)gdFD׍fN$B P#U C 4Yr>qx]ٜt?9Bv"9cO5E|3i /p7c?EyzW=9"RVaig^tWMlL u7*/WԢGV/? 񜾞Ɍ&R2Qrn\#ʎ֠-Dd3(x,-H8icպ#`b~{YES~L"b[XAOzLߔb'hVӼ~Mec!ls &WD+X 'zxW>ΚEbٖ)on:? : [Du^O;>FhS}Nin  D@m Z6\􅹺䭜Fg֣a'Kpм NU}3]iNzP@=BC'uBAy4S4{`k7 |lmcA&1pɆ:u/*l2f\.)q{u^ / hisj'?s;H+tQitOǕ>p3hzBE֨kH5 S%xѕrC&mSb"<gnInY*vu , 1e'4gW\)Tzn<7UourZaZq:ea 3uIPtdIQclƱ˅!ȟ*2do1LDHU+cX$ʉ\-Ir:ĦF?JI.)/?YadI4qǕU0ּgqۂ|bbG{װ/Rwr7.*< ăٌr^&F6BFy?$wM˙fl9wb,UҸd6&4Tb„Z[? J.ˤW'n"+;{=]+LJ_%Jm~mTQ[C>wrWY*=iAv+'44. J!L2A;+z/y$E}S$F^4&w^  Et#8{`jf׸ҚV]֫tQxZ'IO~wy ,F͹!3T,oP(`O2G^ބ;72jC[6Z'2w2$:;ƾkd# ~ȰǍJYP{1ۥog#za꿦ޟ%OYnسm2 |SΪ&tMFg_{JrϠrؑ>ZyH#;Sdruz(/@'*u)3]Zkau݂"MZpn C2Tbo}ǻ.p&F/ѓHʪ{ 䖌&UJ>Wj_L{;¯z3By%%6q ]{;,x*"Ymr^7aAWzr ޔ E3L+\j-Ӧe)y d^΋oJt( MIɱxv(Fhq`uU4!UcZ)O۬2i+GiC``` kN]n>$\#ObHB"7}B臵SC 4RsNzX, 6/c9Nl?uSh endstream endobj 224 0 obj << /Length1 1792 /Length2 12183 /Length3 0 /Length 13309 /Filter /FlateDecode >> stream xڍP\ր"=7@c{@pwwn݃e9{{7t9ǘՋLYAl :102Yl̬ 'k䈔@Gؖ_b@#7ӛ l `app23XycvL Y-R l2pzG Ow dbd P0rڼe41M@@' Aodhdv0,@G GE#ߥ1"R-@)fNF@du|sq5:޲dJv@ۿ29F@ ?LL6vF [sPgtrsٚahd~7r1Yt# ¿s4q992:0o,ak*:9">qmݙ>\+[ dkjGvL {g6o"d@'3337hX0@[ _}0S?1.%W)* vx2pX9,,l/G:+ckܷ}ϒ]o Pz&o_,O]GF+tSOd[:;MmlUmVmDl:/1Q4U9X457k-P003یX]"o 6BVlǬrpߎ8,oCi tL`7[_f`?Ε$/0Co_b0ICo~rIfK<&0m?LB__oOZYjX@·X ߪ-|3zl&-ÿ-moyoy]Aַ|5 t .̂M,Z*E]vFYQ.]kmK_͋tLݯ?b-|ma2XJYm13ޢ/p(̺+ޮkfkjs֨:z-'Oi'%FI.POB``.wmF#H9 83^_ߎ̰a+m&%qCyaa6lo'6l^_T}B;,jֺ8{w6E:ߝ. l ]iNEvDRn۸乾*}mf; S)1alCeg]ʺq2/ ]T1pUuJ ?bƻ OP˿Lq%̤ܩ'g \^ZESdqrYK w%D;rRJlZYދ3% #7U .. QH?#U-ڊԡƁnѧǕbƆEVQ{0A+lj,+0l >q4NWFT1|VV2(hUw4}~fN7GB?UٲϱXӻ@{< h1X7_੧g!edܡuB+S dyәdɴSeܣBɥSt<}N#axUj ÐdҮp:S? "t$⛚G&&l.7 pDkCulyc^-Py^C*4R ?۟>Gl˓Csl]HY 6Ú9o}P`:Y8^p_LZ-`t萫рE?&Y(0a)*2enM`^cv>9TC 0P:hK燤|,7%'`\սdk[k8չ sn6Q~QpsIzt4 DxD:W qÞY7W ZV9O#㝣:J 1ų K;HC]+Ncm T>qR'iX* 5͋͵\|ƂXj\Eer{?w*}~C?u;W<1i'#JmGV+Q-(9R)iy1Ku"sc(Ia|\.T@?I\~ߞ耷HIE݈:|wȀ؄f)'; W6wH,yfZhP㭂9,p|^26]q#%zt!l*}?[vh"S`bv;"Fӎ4Q߇e(WsM5V0+w.o0]*#ECߔ9h1j{<p!\YhP(lU(Οwp+\2 zX%åAbNͽCV-qINc1eΎO^(ѦfW\IU?0gP3J]Wŝg=גU!\7$/mQT\KYH1i?R25i8nϙXBЁ=nS$1*ojE5<^koLp70΃\`15DDDR'sr|~IgZ=O6'^48rw]-2A'Xښ~Yر|>0Zm{5k!kEXf{k.Sn!N%,opF y+&O*R:׌M pY s݋?j>(/ \/oQvE+ ^Ė }Si r*Kpfs-,Dc\pz|aTDzVo6.'}[uFBw vlՁ;\BԻIX;T!P?%ŒE\\IsKXF+.fƺ]ʜuyP`DeǛs!h_qh:cl\D{VƘtO(ZS{>p #g`/OW;xWI}&'JA[2ZS;TP%1<_D~xiz#:$}\"^Ua=)*E4@EJN M~Ѝ'7Ґ6|~%OO Bt NfmWtDLEY.ϻ^Q3!{b=u,+xJ8FZrCUdU_dX#q{DΆʤtd=7;IH8E ~6=PIZƋqcm=L)2^ K{yE%T݃@EC$R VJbSXh~q> Y*0`f>2>V*r{YqXҩS#8ɂ"3`)%OR4ɊZƙrjRS a,& f ^Pگ=# qwF x˻ ٖu">[H<*o!ҸڞJtŒuɩ>): 9P<aH*jWg:QTHi@3Cy譓 Xeˈ`.<آm~l5/LG7«v/G싘:4k21_6L5C(xKku<*.ɡj-b纻;Pw-jd3zfR!^B"ͤi9MǠi>H:|6^_0Ħ>5 [|h^Jp^܌\W>;5N# \&/ON(³V/7fgzGW^`\Sj(+O@ .O@${_N %b)7[gz@-kn!MYuV=ܟ[sKUtcppS:7QNo5sާ ‘BspxACj Ne.0݉Ep!x jy˝pPn?G:8 l<"k%L)5 0ĵg7W,G"Ƭ4=2ɯO?yg~Y#qQ9grp]*E|NwhS2&t Vf~%lx;yW6+`Mqq|QT0sŠruo=jneLDEf{LyAV:\S!02)0cNK}K/,̉/}1'E2raSCH<$#65_1#s6WrPWh7 a BSHdgQ1;::npDwXŵX»/dOYJ9)Xw DrrhV6!bfNL 9a6@Q.le5WG_DI7 :$W6;L{cMoby\BojnA[rCտϨk\8,69VS # .u~ZuyJ~.\Մ55q9 ϳk|jy ە?SτOM~4 cPՆ&j}3Z?,3BmI*Ys QXqB4dZCӱdHƸrdBa&pbRlfؗ2t:ɻl6ހq8ʶ4JBx ?'VU$ƻ?Q=C6 ׍w~Ȑ}ytjt[6%yL oQq14[A`Iwr]('#0Gč5Uaprmr/7Ak6"lyQψy:6Vycv>)8\EF.2X wqm#ӑytLacΕw,eQAp܃O 7]6A}tԣ0>\B>\NJ8S֝-Seq \"D8H$saKnv3kBjdz֌ʡXEiޅnk.PօOb3"D8X\ ԓ$[`4*"̑ 귽d^KNvl-.qu4Wku4v$&{dɺhN #g SaJyˇJ6K\{%]STr;U,Lxlw?ꚧ+c&5WR6s0F! $=B٫㷹?åkQT7)?BcnQAMW$O[Qy{\ʪ|1ka {8ʤ7U 43`TWD},j\U} F:~ hsC#@ܷ3SEqwξ:P{˩>evfj¶ݯr1ʔk6;ml[vS7`J̖褫s,(EYw3WP<+nja!hFIm#o ^L⛚ [)W&4-*S} &״ě~^,TDjcw#AdHT}dŐ Yl4šTPF2Jh`"N,oDx(G#1Ӿ\[M2%#" >7h da+p#>ۺvBt4UyB҃Z d YPx!h&{WC۟MPn)AtL 3V׈U6/PZ'Dz~*6<"(GΠҫV5KTڶG𑂷p/ixv*nAvOwzs 6Խ;ҷsJ5<:wu(:':gVlGp3&Ybv$-5Ext2:t1:>t4Q2,PZwBmWa9.6jF&oE_6:Rw7\FO<-̔F~q0 ˈmr&]FyLY ^,aD&[aUn?u@lb+ߓ7Ik#?2 ĮHZb!g޸m}M\Vc@$nj]dCb5B|.>:}?U?3=~VNQd908 @b#lΜhBR% "b}-8L;J ,jįl949BOOe0艢cۻQ^텂E^w_a׌;8<'y{Ĉ*YE9hZ\B*0nEҙAG95wP맸nJ֥bx N_]n,s%ȗ5 |Uw/KS^6z:P)Q3_H1CИAјD\F2I\Z&sC}I,}<{EIv\h 2uOnE+4,9A=ao"(06ӖN?W%;N'3^PlpB峌NX ]h8`~7ǧ#VY֪>~th G-d,U\ůd+hޟmf!{̬Ǘ8_0; Oƨ`JLNu:43O>4q~˫E_5T7(U:6Ȇתfp E)n~HPsqY.9)4 sH-D"c A 3]dpa;+1rʟ/k -Z{A.(8hXg mOOުgMJGpqujo`Xڳ7¡]9aǂͩa| Gt4:Fi2_S{S3$-GC "UfMa oS /O@Oxm/CHR.5Ŭk= |H{ݱ$.lYK-v5+gQsF7U&NmAfN}lrCIa =̱߰$1I'Qѭ]&Y?});L Bٱ*Xd!W8x/Ѷ)<*I8y;b+b +V'% |3KڹQHQN];AwHJ .=ȎX+N0>5 Q2+ߏٴe>:<: Mvg_/1/ 2[nN'M= X~k?K& K'Z Vw4]RE&T,1byeH@4z.Pkd@J][ب̚W`Tb8Hj} 2LءyӐzax'2?jC^914aL"Q=A˖#DZg\j #nUH9 =L53h:BùH< vd?[[z]-;NDw#>u9ۓDuT06ЃS(=2m#h׾˯to?^/[P"f1z%쎺ԯ Z2VD\'M}DZ4j}cR 5TQvF1qŜqo%L#w"<H 0looښRsثt쌂Z6_Xj‘rw!R$F|rMk UQԞݤaojL+D'>8UbDs ^fgNFo=%X|#[5q1w[Z'qWgl5͡[^dj\ٶR Jj2ĨuLJ,#b,[aӔ#{Y,X m0\F%(FW0_yr8!?nN4dCJǤ08B4dEy ! Wx&& ѣ %ܮ&a K[8x&HNC ~u%dϥADGSC,c>b jIU $4;ߎ&ݽh,-j`^Od | <'zoA<2wryOGPs<|ZIhx'`Mh䎭'a,!W/~}M01mw7 @@dcukJ%~];lI?âXt$0~s}؜84dHwt$Y`Փc_)j|r`2ϭB1tXrBqKkҠOBv2_(˛2G;8< Xxlk~G{X$o}X j|.zkGߠ%fcᩈ'Us? [4Rn!j . U@\dS&ѹdv3(OEKw0|44Nz}XX'kgA|-ƦGd=.1PNV- :\N"n4T=i<р@ʋT `ςU 01f-f-[E? `d%~!ӿ`zLp Qz ;XREt|A1vJ+ŨMtߧY:U֮Ffx%z+&lE+՜v!{@-Am#X.qQL0U b[VKW nҢM)cTOgb)Ҷ?g埖fu"WC:E+ 5e⧉bpD;@{D ߌ(eJ_OICS<y2%pLT (Ew>o}yuGүN?t8ŝݰ̬ͼ$UukРÍ;Ok!iǙX ءCjj.2Z'!2Ox? endstream endobj 226 0 obj << /Length1 2356 /Length2 14578 /Length3 0 /Length 15979 /Filter /FlateDecode >> stream xڍeT\ӸC\6݃C !@pd:~3?fZ94joX-@2n,@%MMv d9hh4m@4H4 WGl$]@n`Tn`  ?.)S 2+@D#bce>? v~~^ sS5| B Y9 yzzڻ:X00F^ rҿ pgSssG{'So+* 0umhj7035)@F\` 8w0 7WIٸ{=|`K ߥX;i98m!Y@ X3enMo'?JbpNNKp) Kpsq_1wlDA)pCx,h6UY_`xyH߉*`W`ǿ{X*̻!hb= (?$ngL_6vxKMu@beʻB <,\<۸x,ḽ~HU`ak׉+x:QJ;;Z9n7Ueo?`*, o&V"V7MZL5/ /_\yE?z0S ar_zpՎ;;\58y`t#e_w`Ɲ7&pqs+[O8;,;X`zD@>O໌WUy:fϨ#u5wt 0A0U ,8_|_L|@.nsw0n\?32GZs4 k'dѺ}u'BbB𮌘/-WJmZ24dDt<;~Vx,p,(hcz!s `8?(*nhD$GD8;UU!1= vJmC"3&ﰫ:Lfz%Pg"d͈x:G8;:!1]1-(A'PQ ܿH̝rǫ9y0 ̡d"Zz[˝& Lџ}Ě겙1ځ+Q O)93nu . zOnhHA {' fdXhUiES"? }ō9iMv^[t ESFݕ_#Ǖ'ٙޗO6ysWQ 'cMC=^L+0(0pm7{4ُNP wC{È|A6ϨDb}X571$Xy> 3-g1o<׎Xޟ,ATCU"5NazjQTzfh ea,h#YkFCT@" `_K(Hz" LKzw#4U% ^\:ڕ/[5BQo\վQC{"ot(aMhzf Ōkufgg6北b!$kg ۝ҊI0Y+إ'*p' \/47'6پ4}}:Gu#Ie|_b9N6IhpZĉYь5Nڮy}3J5"y#n Z}+[nQPOO #moLJUY'zu1 *lO W qV j_ųD9-;SexKLE$#ѻ`.Seu)߲Sbǁ;V;/u_4ld.ezfP-r1 O3@@&x0O|PJg%4{V.VxF_fE.ysZA븮A(C3WEY_^dd/w|% b ­H?o0rqzНTX S tE~gILН탙!2ln+C6\ d`Bg)ƬyX*PCL&{v9nHh" A-Y)㙶FɆ_Pip`юa^<2$!(kE^<ɺNnD\OJ/)G\'UĻ'?jy"m0ڎzGt(tƼΜ܄+59)/]fZT+4.ޒ/'c72 ^Rמ"\k7 0t1? XDCP|~9DZ0OlDp? n\xnLڐ` Qt%fd as'FuDRRC'9{zh}V2ԚcG}¥m7nI[I(<׬tH? |i2oH4 9O0q c&=flœ[*BMm`bL.jNJ;勏+7ە|60{dhں}Ɣ,g5Z_l=O@<%mk`ЙάSWWq$LxY E ,2 ܊\&D.򼅂L6ۻ 5tǩyu]se7|hVH:2V;C{ǨY\ѩc<}6b=k+剝>Yd&B{Wܫ!mz< Z,kwl]*E v7°^hY_nKH օ+2% /$Cn ƚe34DLiwyCA)rc|ݼˋQH[F@1"L %܏@"S,WgeKUȑEm1 ~wg[[+T cNh9/{MnG\J[X9I"&ܖ`x!Kۮ%{]f<Ҫ70FFOⴭ^/D[Q a#c pGirE~gJA4J]tJgKy1";4ίÅeo]vKE^p"Yg` 9a ne>پ?)0!va18T|m)C[;A&?lM]6 (kt媹(ٱfq|ZG,OiN2''#"dڠxge5uLiJ!Őbbz3s b(K/\UݞA_y 8ٹA@/i5V#㠢TP>KT9*ԐK>L˘dپd7 c'ʣj MXx>sr^CAgp]2h|qI~\%5j4=Aq NFBzWGޟWKPsk]˴>E?!v1} u/"՘p={W2QukI2ZEM}Eyq ]^ ,gUp ayTq\;| gƒ]$Yk=.Ro<Eܳג+j];!y0nS?#YT>#%g 2١Z1ZH@234Ej~rmZUvD8K f~ &˂>QDM#5K/n7bC3gI$DLL=>v`PDO+wi9MPX_FimxL_az\Ǘ x5\#*_70] p" gٰ G-ohJ:~UfZf}L ;;t%mϘ5q>0IIך||FEy)[QGZE4hOcbiy /H iTRZ>[6;SW0 ?l΃HFoACV (3A9rB=1deϛ\/|ӤݽߙV#^r-X}d.T;1gP kXS,*F ֯3k3znAph.}Qn"͞j`J$[ Z2Jk'wӉy򣔵C"ɩs靹{H܃:#bZTEKzk22Biǥt(@&< )굖x}\bCev}(I@;gJ\_jBEHCs1|003)YSl%(oGľ8:l?ܐgfyپSkjD8$Ϝl/ bZyVd:ԎeOfEZ@^ݍFײLIt#۩9YcON Tz1Huq7l|0(w<= F;NV*:R%`a;0ڸv g$m&d#i$̮-/`!oe[tE]Z6߭XMv, ïV:dx"A9ܖ 0.rz˙ ׅNz M1@aT8{hmO䊄j8 Nd]ŪH~_>|Ǿ^?7LFo껣¹$Ak_X ;Lxiy"-DRWRz⮋3CwT^/joMBXeˆ+K ;v>["?*V?^΍\Cl$-0[*Tc(.TJ3U#wLΖFyabqpФ뷍rrs.%LfF^wz8I`&mu9EIBwt̽jTO gGi66ㄧyh;^09`y!txGQUb? uAMZێNHDuJvȈWU_CS, :xWco43懠 ͵M//[?8`3,nSB.[lԇ R73tr'oCfe pPKP[S&,W)+t>@ykd㰯&sA $s-g*y,|鐆8,3 eS'C Kc=[E@;,Qu7˱wo |qwVFYo <&0`(-E3u='"6A+;5qJk'€b;#9Tm#Fт$p\s mC*Byio='7h0{~18Q6M's|G.[[+21mB˨8;UoTIMZ6 |4敦 fDrF%t$5Yoi(V0QFTAUR'<"{pK-_(:I(q[doCbx2Iӽ} 4wZqG} .<ŧso4:Ili|1 Vew6wE)okؑI7sTq4%\'%\ӗtZq-1Z`?:Cf +$v~"Lp]U''>u zs^urh;rV>338\s;#/O[c1. Vf*i/r~mD6h{adj?A|Jr]J[amT)1,=E`Z3kYNUj='TR6=!˽~AUvV`L{NV&NjB$ϡcjfCPvKh#i<)b0LWCjQi*c"+`:*( Alj0ēM;3r{xarPHs[g y>OV_(^{<7K2NdI58}ķ<>r&9w@ 7,e}f[־Fc!Xya40,K2oٶFl QQ':fBEef`IKgRfPh8dp;' x4$$U E_6 ?c&BZew俷)|oY9Ol]9!?:B9#gT8zgN;BOXAˣ"pBN`hDq1%̺|RfݗW?=wgϚ2Dj'дLs6p4QCCx{, !Wrp7e]&]FvGL O~ԘbT͉ Ӏߍ$@< [YYqB5}( `n#O~x0u},9q@\IV_Thz+)Z!^nɗ&~e'X˨&WҖiZc;?`"~+Y Gр|2Xac-T]g"lO*Ռ=buPCzh~ *˯CfJOC~<ٰǽKoz.a[{hCS#,:CermaǪ)pyq! ·o|UJ g)x0qP)!;BTlx#rv!lgtS /B9 M8)* Ggbr*IbH?~9,h)KReP9} E]!kӗG$v۞,ؠÏ+߾Pg[ Q\v J"BtUC"vLl oZ"imDN 5x&y_5xc2k""=^յ (4tgN>) h†y`kfSڴŇb=&&tK~$%~c5%GHgYCƒа4{:fǘٹ +ΪsHv‹<Cg {r<0b6<*%ZW A1݆v3䀣lٝ.!r8;ɩX5/'ͦlL\|c*ק{G DN*lp/͌}3Xp% $wJJͷx%:~QVQ$nRrEY+74I)Ot:R1Cz|qH1@+9}J;Ѵ%F bikJL%"?XS>|ދ.$2E[)=ٲ(2vlֈy_$ 2ARh'{JOaRqJ=FeRSK@٣ʆ=50[ՒfoArV}q-M3љZv/\~YO?T.-N՗nO]ܥt[An? 7e \R{ؔ4{]-7s Q? n [NTOM9֣mM!Z{:]^Rr2"+E>^ Y`w^۝; lGkȑDJq>S1jWcjrwyP uo\m\mAmZ×Xj|,QvF^_ʓ&fk?SIiމ\uiL]vU;;kp:><Һ[~)3q\oO{1] _> 1 kUL";og#AthC~Q. DnͲ̤ɨp8.EmYq 뭃ehOY.פoнz,uio%yi5n<8+Ro)Nw!=2<@ Zu)_]COB(uݤhUzi/qi 1괐狅.e_QKvoё Px]ʐR,:*D_xhK]{n@~a#S b#~JtO;&R,wd8[k8 e^D03ܺ /֣rUaMhF'_-lij ti fNSMڏ~Y{E@(4̚W[oE^?QoחeZO3£t f\e%Ds2RC3,(U#Mg"R~J;F}bw!Z|d 4%ux;ۡMe&eu:lQtFś ݻ,as~ș+_18$jv6!]Y9q޵P#<_՜w՚}d:&`,uu^t9eH-rfK KFmpz\0_uȐڤZuqn~Gw'i c> Hh[#*-ܭ"aJNid"݈ewB5ԈTm@5)r),l{j5muAI̤b; 6r源8Wn:;)"Ty1ԊH6+nbQuRVβz1Gz ˙>h cvB+NB uN"J)SrCQh-Ÿs/̶Hwd7=Jm.Pcĭ{_Ŵk<>V^ WB)W/̴{h6{8Fogp]R&< U]Nm2Rc4 AiƄC.EHcJJS]fۡ!5穠c~č ,ՄÏRSC=(6jeTxK4G u2 ˲Ղ\jЊ$l2drVgMU0em8+^}}KEa};x5k^.@:}H_+gʋYUwty Kt,S“5Ŧk*4 ja|%/FNBŜuϧvT>ɢBe@k<)ZB1PN܍36fҝBL[{vNNn TҐT*:ڻ@nbfp'=j`6\[Dh@g6y 7d1Nf'[ZQ/նp?6߮ Vhj|T%BXaow#-t6;[ WE w.2hY6^SPw>'ggcnt ;% LG2^E1Xjϯ!c}iVQLΦ,, 0s?iI gKUjjM['bªQt:AD 3%0%DtyRd޹qiF9R[$[AdSJ7\ ;݋ )GK>ևŷQ&uM6b?Qҿ, GvBswr oҊaʰe_y#?y#@1ƛqgޠ"Vos+Ds?fmS088dC>w[C.KX(,~O{m._<:$-۽oܑQC3]nhrx\=^Oe,Bm?qQi 3$wvߩ4-W7Qg7tc@ߙFlXtLEq)3gл5oԠ½⇣\~H7#,YoAI2[%*khTVOz>\oU^X`w  !}Cd|L*QnC/syDi-lCGkyWɋ3Y$0̉rzѯ7}Q?سRHb})xa UKA(; DA^u27刟@rPߑK&#Nl>GP?ЎQ$˧zk@upW.R;gz(JWN]־4.|=!̙]d kO B L/ץ[dБ]*gMT}לP1f8ݰNXMF2Qc}eܥhYSU aE$`p$c3\9zZ_YZiD.ssnCJ׸v(h= .a;$d}3W|!m# Gz젟G|2#QN"q3HiGE> gL% \vuI׮4i߹! # {vk&"5F%X s4UH~ٹ$*Z>e+es?1=5T{%* D\7p݈CJ&|@[V>z\lƅ^ɸ.@*,G!B$z6c~NHF7UTLVWʋM26t_"Y,,eE֐1^5! q2d[ZPjǼkKD OӐjӫ'ݤ] W!Uo*s NOU}s..=o-:Jy#LjC~KB]|̾;_bfO&)$OאlѡDb 48yK`i!,O\/%>z Jk|nzߺY1aZ-90TԘ@_"jB|ݗ?ħ_` ;Rk>TBq)Z j|Y{(*ߧ(j?KR)'#9fllR%(}lcn!vAYhyY`$%QglYɠo`J>Mftv%|(tǸ_0/NNGA;4 6O|PDZ'&V5(rZ06岯st15$I3>DSL(E : ,8q.Zo%Gxs& _Oɣ|~xU|wL3{P̓)`tZ{vgޯJ\mŅz>^_vk+gR3l$b|O6L+qL'R!AJMP1_6@4Ń/ {J4mLѣA7r0cN3?! ?6OvJ՗e >׫l1il㤓GŠ4@c=4B0hA+WɝO&oǒEcZUkvb&=t=U;k)jTPt$ZկBV#6j~e=K:*)akΊH}F-}Z-v1jlr.H)G]*'*?y/WA rк}} endstream endobj 228 0 obj << /Length1 1370 /Length2 5960 /Length3 0 /Length 6892 /Filter /FlateDecode >> stream xڍwT6R HK7 tw03 ] !-4()%!ݍ}[us]ZD%m(aH.^n @ ~nItma҇!p d `Ma @$7&ȁ=67 A8Lpo7=ߏ5+**;vA0@ 8V;:pk(H'7 wd؀R AC$w񃝡NuGފ@ ~+C )W buwo|+iӿ E(@ 6P_|ˮKiNPDz\ nex@ܒ rYm~ɌOPq@\|yohMcGކp7_w*h2#ۭ~_mͿϿ xAq&ա-gUT\˟0[z"_s}U?q)'Hќ, b92 KVA,qvAhlvS&hQ[$L\ wV\"VE7g脀. +ݺmDǸhdJGfꮫ5w*Cqd۷ޞ|Jp" be(H2(2'c](1G[iuiexE}gmF_CE)"W`|d}hF/jN~0(.5IҪSPbE,f촗oC!vv5!}Yw_,a!o.oqهW؁G[U,JLقdOhBS+B>1| 3^iAK c݇'EB/=${&Q%:(wDq"F4g]L21~by*WH 4:t8|-0B ja)-9'Vuj:0 @{<=- mE ݖJ6rJeCޖ7FcsC;۫MAU-gi@1 ELCӳВe # '%EIP?I{pC2bo7j9>B ]MbeFtsWc ?mO9uJКoD^):4$Fչݣ 9x)&UTǾi1 טmJrHƑH)z!%_B 2~Xrz]Z^|.̣8*oX!YI:4DF:ɢ85鵣v]E+ %r$s۱s(e3C$vol6 Gkч AI9*4Gv;?+$GvoK-$Y-^ayr+!@Yg)ǡ%,gAt\ZM~™ԴzgvQI0l72ʎ_9 LQ`gYS7޴Fwt~n0#7W&DX%/KRTH#P71v,3V\hj$\ۺd`8 XdM:$w*@^EWk'銳#], jL|1܋3iwcݹ7^݈n/Hn>}0Xy'A `?->P*t.WtPD:xX-dL.Z{|J Dr^x@ݻ@Pg ]h9sēSIa/ Id?A9[IP >=~fMk0#(3uVHw BGfo`3ZHڼ)͝۝R*c9kG{?LFOokw-qaKP_з fVd=џoK#3df½̭ eԜC ۂ.pjRUpY˻LXkP~+h;+ӱð<wE&\ǫ8{X͍pNX]ꛃW .s Ke6@FqO 5YH aQCs;N)v x8aN˕SdCЭuop,a2jL@GR+=_v7e2t=3h18P .Q̛dݲ:#cAN([ߦVV=>EN]ZyZL.dk*ƭٗ d:ep9xBr;֋p3V? O&-& |ga0$_/cY##Loz#< a~ɠ?IUD|GֱrwE "Y[7@f|,Lz2͜ߪP dΞ^hBOhggs$t8@6\AubTWj<,Ue_޴ͻ#p_ɂjͥ־3N*C&F:9Տދ:D-XW`/q.R.+DWzJR̾i}.zv:~P/F !-rMN *,P~ ߞ jV_ Yçb4%7h|}Z^O/=+ʊ٫O9XӕnegM^Э2KYTruÛ`T;e U"o6o)cSh4&l&"7%"a wã:mL*yloIkew͚XU@fù))o,].` gmc;uM) _0v! KҜ%G Z\ݯ7GJL|pu+!y]>KR,IyCUrUMӐm3[˲cV-CRJ V>Ԋ Dy>mtU >CH:\wX}s-#5{(^c+)RE;}two$P$$Zڶ膔E0Zq? 2⦓L8uRI1mg21oL)˴R|îrC+`2?,KDIlK-9.hq,ܩ}fjs˨{sS<*{۟:#AZ؏DrZ+nt$% 0Pe+4M+?qbdJѦhi#IXԹ> &CP8vI!Cu3\CVݷ.У&%B]ϓ'>‚^ &sFt':z\͵srKO̺o(J|m=I!Jt.e6 n"V'Gq*OR{8O`̚AYrVD0EW1lL'KVT,IJDlεQNx3etr 8z ;I9kyW++mC\+iy63b6 = ]졯{xlPǽ l+Kz|,G^c ԟ2.j8$hF$\8! d)/de[ o r! mp Ű\2PfŸ4,*8F|Y_WmdL|;+fVll]Wcb$*F/jdZ%̄j,*eHFoTl֙.6ƃ<@;zB~tPV A>/zMY@i.[>wW/ҳ+QȾ: 3𨟿$r bj`Dz0Tq_~0=T$r ޳7 }?@Li eb % :{&22JG{j:&_Q:>/` 5uP]̰q>`}ì֊*Hm#PjV;?M2/&~N6fXHJctFCMʻ,n(ZRD^H3_hI(NY3sa^=nq0FphOLZIL&5Rpv]3S+7a/~Mg%S?Q]);"J^(SJȺT0V HH}<ϗ4Mg@Z/:.{,n5ܘU ?4\0Pb{2# G::6 >[dbAN;zv#&]zU>ص> '^ HDJ~F`7 Ҫ!gC?ʏ׺B7ǭFLZ Go`2*NZ[*&O4J_3֢pؖp]cF+ ajƼcuXameđMAl]5v]2I?T6WTa!+kY7lH "|~1-fv֫̀.b9(&#> stream xڍwTS6EZt H5t  ;"E@z"""tIGE/9s[Ykg3μdsv0U$/$*B $" 88hؿDHD 1>eA".@!4"Q@e#D"`%/ ,- TpPA;\1+B!.@0 }Q&-(-q@pCy쁿B\a&9=DH7b.p( DP@@6P ;@!+W!8w2 EAp#j }|@C pwPU׀P !w52}VA+!]]aWp x_!G;Mwi(¸9@1$ɂa>P'_K~~1S!݀A`p (OXip(hs#q >@KB@ЯϿ0$G"\| }ʂff"/%@@ 1)`? C5$POghHİ7@PEL)?[Rtq p߿ z1RAbo)쏀u`pOj!I( 1{}`p4k)#=2bAb$j0**(܄ā 5 atiMfƤ1(s rD?zP&|`P(*\\ћvƉ0+kBtʠ͏$IbՉ6!Uk&]E왱},G,+,v GǷFjL QXL1D`ΊdE?66eiޖ2٘7Du-̙w :]7M^) ɻ|k%&T+liNBE붲(AKҋBLJ;5%jO/ / Bg)L>֛Zd6u63%4|, zPG0cƧPR{s}H{7N'wvm`C>E|Ѿf1}ݗl?D=1\hd013l\溝ɲjfm:L!~vDdu˸Q_?g,PVh+搦sBk񸟼^26 eDZo!x!.7^ͪ2w>TKպZw#TG1Riӆ&}'U yI M.b2*8ER/mynLYF)ٚJiIŎ%bZMtSĸ/,׸ؔƣ,i^X%v4+lU<5a>8"PNլS X2 P<*,\X9P[MJ}Hzv[1W%: w<ճR/ris#үش%)C;csݫCeF; eCYWr9mpR5{z>. 2y>KGBEn;[y3e?ߙ{kR:1J}&L(֐h[f5_4N*U0)6ۻ0&8+cC [6p7av]˻ҀVI&"DsT'7id$A+Cqn^~=<(tT"˘ƳLxC5S;J kNF:Ӳ!7'}˭jO~+QCbѕs0q4;e6ʽs;̑6xjE&31):zIK8ћ>~[$J2/w|'uDqJe*;OBՅOI@]ҩo?'tt ?4/,Ҋ |.}nJ+*F8*pnk[ } ^e}yT՗HhjDX]T RKJ|$u.T]X")`N zuE2GQzTn?(nBteeqbU n/MOR6m|вNȑųgyUUJy+\QE7UT^>{(vk*lq]-x#f뵈-Ìg!#&_S?1;!3#)3DktV6=^,oY~^gCgJrċ Oso4ԏ|*RiU iyW Y?jVϔ AI'i@"w4c(kp8x:;/Ͷ٩}R80Z{Mzihͬ**~\l"NI,wMS%$_u{lzziJbpRLcT ݨnJ_X>X-g$6Ǹ>+#H&26C0f`( M y!nNۺs!7zd.i\9SΕ)Y@9?L{e\LzXű9~.ݴd[|GCŘerxdWB?g,רL6t4%=aEGsACcQC[&"3'h!Cg1[d4+j"UvgL B@Rz4"Z8 1EYchd!ZwX-a+ \6˿aM\u!1?n ~@5=I~4S}8|`!%֡\x`=ydMP`EQ&KMߢC[ο*2JeNb$brzOq H${БDs_xHnw{}dVv{4n-.ßS:.q.eÞ1յ:_v1%rw5J!>~fǶ_!-L§u1>jjIzhۇ<4-&ݔt#WsČ#j_og2 feGhԣ5cFϾh^nhdk u Do8 <ғU=}-a@Tėx=Jg")} xZʓl>21Lq*}ymamvO B^R~w/:tT(om*Ǫp2D:Es|BVFwˆIHD'%W|8qwRWd֞?@#z}!u'yA _~5:=aM>vw8qE5ƤcqI+ S|У״ikNsa!܅/tTV>#mmYݴ'\Õ.B?MT:[ƒNz=z~B"؛~~+{n}s+gWeĮ۹$DSe2kNv0A-b7n_d6JqX~u;)+nQ* -#"H(RA#WAu>OՑw^gI~㶪z*iyV$t N)S{_KpDžg(0^p$Ն r rZ4cW(o\`i;̳ {9iF$">Ɉ`~11wl6e ^f}xjk" :{D3mW~җMfd4p49Za\sue"b9TrIa\Ϋu+m\oWe3a1Dlyҟ+a:>k4Ojز^@:v=D)a[֝g%^fJwN sllzWMz{#X"jrZїoyG"||u)MSXJl⫓W]cհ Z}rnU,;N>~0,ݮ'YP}+"^ ē+o2!:jb-2uAa/N`Rmg-v=C~ˆ #ӗT108 ) U_Zܤn4xu}u+)xJa_)띮{[Fj"MգnG|_p~<8yT\<4sڞЉ![J _NY5@x3l_ǓFLrܨ)ɹ(grAE_3\I %~f1"X)zz&bubC! m'R=/Ӥx{ZJTF}؏d"~o"c9NE3B]w/I_F[b$nNV/2р.4kǶ[w`œ׸9D_U[w ҸY׆В5|bPNֲ2k:'x6e\I0_(/7]:|1Y8U@1ķpIQ(915G [ou*sDzE+vu87!,/#8kQ QJD93`;(pBtqst6XtWCVs^s]q>3͹_Z OnzmK9E nS^ntT.:Z-zr\۬/huZ +jS.H7ؿָhhxy puʗm;Iy'kyBXVȓx[2xA&rƪdF-&yz[[ŒQ A^o T7  Ÿ|ON[dQ{ݻLU%=m˝f%/~ۙg &Sp nk nN4x#LɡތG:-tedE <[yEsǬx8!oKv|11iH֟GyA$3:X8&o8Q?/68 -v⻆ 2"Y% /w =NW endstream endobj 232 0 obj << /Length1 1387 /Length2 6135 /Length3 0 /Length 7086 /Filter /FlateDecode >> stream xڍxT6R= !-  3 )%! J HK#Hw{y}k֚y}_w}]{f 3>="y|>>A>>ff0ێlraP@ȻlH- ԄAj _X_D '7.P4yj0(,sq;:!u~bb"\ w0 дE8\> !|&c 灹;Js'r~ вu`Ї9 lApd@Vj@п6t%C0W7[pC@m% 7 ` ax[O[0 ݺ-@IV`|p; 灃!f͊P{y+O"݇@a^PW`ï1=x  U? 6G '&,,=N ~;31@`n  =@~ `"v G0ّf_k|H~dd= 7(hp_N997[@ -&GU:bܧ[?a3 \D"tc,+#%䷟/uC| @ U CjPc_ك=\۫EAd47cp%7^:Ś솿CA:08 /Rd@-GR ?*B0_bغ #UiMf/@3`8Vz OG;Rn,A ogas~q]+KŽ5h%`{礁EC`;G=q\$#z$Iݜ5x&\Gpvm|L ($dHFu>7e`ZC Z?t70P5E}눥a5܁ BbJ_5AJҤ\f8 Х|yZ"#ek ʏAAFG->4yÄf%zVh7s Q$G;qf01أ\gB{]K?5aeWMB'(mⲓ,$!_ @FouTѴg;OB4[1LG&|(4Q<ոذh}PZSI'$go]_~7֢VL=+9jMF WIfAN)KIxg$OPRÆF0 t<8H9V-+\#6 ?K+Tľ~cѝ5bX"×AG _o|`+TAK:F,B$˖TK3,Lɷ 3<{S%Rs$G6J+,+5eOԓO/FUp¡ğ$%tyHgّUֱBZ&.WRua^ zH >6QwS+StzK7/h1Oע] sɊkګ@ϤF'RM70O9r%~x2ALVթ`ZVC[G$2U=Odz{?;L{+s= +"'~YYri#,X}Vk_O҉ADRnSy-I~tW)3kH.[p}ҁ)>_!vAŁ/|{=j%v̒H oe {ǛnŞ`dwVu0QFܩX va#+t%,'IT ]2J` *' ɟN|N ƿw[s-m4L*A9qb;έilnU-n vۖg[^Jp! )NI?<{K1>ԋ%ttݮ%R_ _u(7Ks!'kTIqR8SNYV}ʱUfd}*bحK)enn}3^n=kUV75wk{^~ȅner\בB | qqjULJ6<̯O8疀>i9p5?pc=4¸f,G K3!E'f 5 r2n4}{4dW.>}ϥ~sUmqfJ`U5%v` ~XRw:J¢'gEt}oВ5x/ih7*=OFeܒCcYH*O(q(BrYVg*K3M07TI>=.ch:F0ey۶{b۷ Wyڒ3#h92bgTk / x0F9kg|Ú(h蚡 _5pCagO&L;W1@܇"B2#,+Д}&8^P;||4ZIi̘! U*j+LG宵Š0xp(u^6g]Ύ"a 2u?OeKuI.1)%:K<T_cM $xUt8]\fΡlYõΧoOGW߮L>nČ,J8@kV?_b>KROv4#RfOV?P:CjsxhV*.;)D=z  /h=66پxN^-U׌OL޻ ˌA2Nɫ^B>tum*~qYg?O *B/ "EV2\ Ipi*$#+a*v0(BNq'Y{bn ]_7YKrNgJulx=4R+^P8 Ժiţ{Jng&Ÿ ʱkhԥGs :VKPZo, N$=駘L:\+xr-hmlj {dR𽆰]8]l 7znht2R^{/i Rv)M[%wCu?b,tUcx2ӝza0Np +S {3X3^,rWJq֚kGl56̋~Ԅ t|,U JΪ''EGmu8WLߙHP}˕޷Z VP̠0shReIۿZ˼?IYO|DDE "ҎY-ѫ/1r鳉 fZ7>li{:T3|%%Ҥa2K"w^=~Q]^`BL , 1X>)Wl΋e`hzn9#JC7Vx_ _r,,uQ?Sk'QEľ>3"Ȅi=q~u_M/H)K$$͞TSQTk+>Vԯ,ֵo$僁/ysTMQ#0L/`n{Y Y}:/Da}:bgՌ9Sb^Ď/_HY&h~{ XmGcj^UoCv&$[TxK'=nph&eLi7^~NtCMOExn]Z]Lfjq#4bƂncLHtOꖀCz@y3p⺯BT"ןa8q'pȜtZ#)5!i=$o S*^qӎxf:6y#OحNI.!Qҡ(k|?A,ҷ=:+YA*uϩ&{8߷ ZV-|"{ts)0x'ޗ)xm_鱹o3͘xq3sߍGh6`X޾L˄G#iwyWV0R4zd*9jfgTX$u_3?E龡8ՇtXuU)&7WCL-AN~A|,Чd[̷RN%(~VEc]qS6^nq%럸*Ե1qb"hT]ω+"Õ]Iy] v`\3Ra1)mJ3@ ceSb':5]O,9V*h${6֨cʆ849x{\z1]%8Lz*Ө軣Tnv7jVBŜicr70e“DD<)>'nB?ʨt>gl$wٞ^ř2z`Q]\$84 2$_e^lt).iXn=2p嗘\ikq,n&i;*N1w %ݶL׵"|@FSWVB%۞MlCi{SxJ?,>ݯ?|k he,.L3#|`.P`OYO*aq(^zhr?]a?5rfr?768C endstream endobj 234 0 obj << /Length1 1951 /Length2 15569 /Length3 0 /Length 16775 /Filter /FlateDecode >> stream xڌPd۲";;[H޸C84e^"#3ǟsdXQNL΅ "*`ddgdd%'Wؘ\ho'3#O˧@`bffd032r7@ h Hۙ9Ò;x:-,]>G 5_![3'@sG# tqqf`pww7uw০],ffNnfJٚ4zXr% *.FNfO 3 ;@EJ`fog;rLLMldbbo`d m ..#;ӿl?܌6FƟnR}VM.@jd+k35sqK({2ṕvaftt5ϧ o `00dkUO-2e`Y/ jυMLLS hwOc0gx#fPӐO]xӱLL̬G3p[{n 5璷\3ߍhs+_"qWSghuu9Yf]93S]r1!;ώcbgd,03UXkmWklvfn(F9d&֟gkksbv& 3;? 9fjfgF__`o0Mѿ _`0HMɿ 7} 7dK,3So̩_i7}4>k0/}|u *e?Z?%Z?5{?cU?SzynO)NO)222S?S׿ue{`fafdolUX#Nw8̊0tyq v(t˒"ԳpZZ'-sxg+Lw!e<5b/EK՟JK(ʦszx((lNNxN*Z.)2 Oil{Cke433ԓ>v\/1 hGH,Edɒ8<'ӕcY7ܴ zP$hgFH9Z>y±^kρ6YW)!j?"}sMhC+."U$du a҉~*y rS^^ZZ2>eZ_GXu}_K:)WeNoz3?Rߎ A8[ Q>ϲ4T|׮+_y$Xq!QqȦN5pj|w}ծ R]~ЈCsx J.Xr[u)ު(I k`7RvQֲEljVHI\ޓ%?s|"bAb=amO޲2p-Lp&,zfcNIHi O=*툄mч>QEኄN9 3E0#9W;򄷟H^,BsbvnL-n2? Do'MkPJanSmKkt x*@&"{&5?htңǒ8)OBDY_*PV\,RJȆ%hRW^wkx@q}\]Yrm=Ԏ"Q ?1nMHa&!P]@ ӎ7Cd"rrjt C0 gRs&Y|gЯbUJBa`~`1̛ CH{շH&2ƺf`Ψ4g2fC+;֭ D$I ]t5:i0j*ڶǙN% ˫|$vxpa02'!^r$;C""V+|9YxZXBpª:,yGc'b]ȝbTOH y) p>뽚2A Pg7&)Ju 』t6"t+W5qv7O\"rje1MUҜ vx"KFGq1%:"Ido7|,XϦZS1• Mw@7hޅ704p(/7,i5 jOPn jPԬK4$(]h,yJ T-e4}3o|e}v7AQ5|m̩B)iQ+cVHN/|QHC0 vte|-o|jGUNP$=: QhȖdeRh:C >\,*MjXՄ:1P0, )W1 {q< y^g w3ZNdKG˟=蝜 ܿ0&a6|l|PP~3?nPQ1+]xy] OIC7j?.ZHd"1=YDzXX8ǖdGVV D 6s94J#Ӛ>#x6GBiD UӅ?EЉ8mS"f]WtM>a]jTd8 #6-cGm4m$N<\,$X [ B4q3h︸aRw%<占pOYB͇0A)KZ=f 啍WfG4{tDEϔ{C;íU ǎl`h2~`_ SMcQGSmFr%&9.𯍍 eh022Qc{ !ڝ"-3DRGAW@K4+) o~%@LJD`ơn0C{Yie|E\gр@i/XᲜ)b,zO++i+j;ꨨ8d8>Tuh{gTZ&(FՌҴX5)z؍d!\B]Rxg'*Ti|:F'߯D%ٍ?m,\ r !@O 07(^Lt jb]{.mk%xq\qjڜwAOr؛,(2 ֐ ['?/!NN3$Ě\1x!7ĜE|6n[`>u#Ws%^RP5*@5K|MxQx{ד,3>sY!o{,}1Ç )x sz\QfA3VSCn~!;gU ͏uZAՠr? 8?/jʼF:w0ϼ@oZǛy _gj(I!St2oz.d>O(^8RQzK8e>C{Rj~ʗ#7`bCyCӦkx{~S{m>lH _/Qb[^i#ZdNPȁBCTAg)!Aj 09Yא6P /h=Y0'AǸ=3Nd4Iac]]ܩ^Wiahu '{Ckh[vzo<򈞒j $Ԅ.-=@Do3xOMxc.J84$4ބĂ_*L7F\^=Ӧ5КϨYV],vo6. j[etM)6 :A l^rshCkNA׈QZDdѾ 0_e7=.H3^z#ʼn$1} 6:6踨~w^8iܵ$6:yHSv`n@^dNo~݄:Wc%{ydS׻;:*ՈW (wIeBt?nwp<=_y̘aj()D U۠c2[?]mm¬Jr"0qhݽo^Ԛ]W.*)]@ߣ Bƫ9aI)@Xe1SNr6G,:ΑW Dx90eUy~c:xV{=钫?N) ܡÜ֭aتi_.haZ_NN!(:a0jTxŹLFHMLRpږҺLe ǻQҷ,ꔃХ_$cWqyD(lL4m(+ayKi{yb)v8_%?&BʂA N4|`exRjJgUq /Oy1prBi <V#}?YcÝJ6<J20WT؃CU?ZN,XfXmz5if|̍s-r؂th3|8Erh:AGIj/4X$Vo}5lx]*T  nϾ]]CۘUQuQ0)MRcX}{ p!zhr))W4*~H٠7L%B *j{?)VꁻjEeV`ߥ[+* S:e=)JmmU(grq7= -%TPX~2:!VٻY(uK3`BkkMĢ0u&س]Du* ߌ_9 @-5%䩐i0RTsrLڏ\9E.̮΋Ӷ*먹EN, =10Ob2vѝ1lZp^K=IN+aM1V~@jnTDGMgJ/B"䌤u>~/x ]K>񳁐%1>Û* \kamX}gX |KٴPeSJ6 *3C0X&& v\!RaYn29pa0]})<*RcmT GuV~8gsBPk:v$~Me@F vdldHX<#-!J$#&2._:_Y1ʊ9R{hjd-ިSW"X3R)g]e4bi.MGIBBDtşL:wOw Jш-a; AzI zCꌕnC; Ǣ2+67JQ .i8y;Iaݎ\i݊ ؔFtҸ`Qy :1|ՂK}ɱ x-n_ {C%[Xk WH]Y !aU/[JkCU%XǍ6e kW?Ǫ &}#S(pPes[Q.4os}I#5G.? OY$NbgҎJdNoAfvVqR֪]:fo]Y˿a.w>os" o%>tO\]/yW1 -UnK0i!WqۨG72!? x1`bb .#Ik|$7?63lE$(ɵ&WPZJvFq z >lL*(;DZn \.NOhmb] &5BD0f&(MMyx]v1nĬ:MwT2HTHowq 23|H!,L^L*<e`Im*xu8 ?SVBWs;*vB[xa$Vn~ANELH_O/4֞5ڰ=@A,(.=%:*4ߘ/d@+O݋??+iլZ(fZaFzG;CO#X":)LYW23'D(%l\e"9+TaJKOuZ/c! K .IJ<5#u-]j7i-ޢ|V=1ᰣSlST@SG M%jCYiN I^,WT]\t6d/cUT@:9B.I ŏʴ(()M%?NkZWj@k9MB|XaoAXeS],d#' ȈmoM)zG*\T dՍ}Ek]qQ1䛻)oR ۧ m?6kujġjvk藠ɠjaͅ7z-%oECqY\'×5K^QP]HZ3ǛáqFr%q_,5n͘ \'T06(( ͟工Pwz]osTQsHc%4̈́/|g|C.LT\!B0P`NIȜ4Rph6hG~QGkYV ry;nkʎ;z֡Dktek5V|܈կ$eyGѯY6!6+Iy/:*Jr]jѵ"T#g% on~nnqm ű+km{dzm"*fi21guDȬv\ <zVD/Ɍ}W.8860$c®6 Qm}8 6ѽ3uvjS}ylX'54͡ 4 ߮`,•%I0FCn-7d_mDfjΦPi+(9}]8ēcUn[Z]py7!jOr;bm7D*&AQ\=2]ihxZ&%2Rأ^ dIhF^!8۟芟_/ӀS>3A풬B< ^ bǟ{:'=CjQmhiTT&-"t5$ّ}āpx @؍(:.:R~ nHe7_OoVNV3 ."r) 7|g<rysa_ } Np^G[{Un1P*J}'SbMrKA~qt$D9h9"g dwWi`yny(!풊c1+[i(ZkסN.&;(La\4]zK3\anUisE6`TR\6uj%y(iAzKw<|Ayz-Yl:ohkCU/b ʝ;)Ƕ*#٥of+ޮmM1*Lq,6gfHl݄j&ڂa{"[KbA7G8B/4h,"y鵱-jo<9(1s V3E(0s-GhV4\ 9O=5JΪHP0.+T7!1Baf*$EHuڿ0M^4Bqf`oGFFyykpMv8SLXzGuR$P?^/ \\̍G; RX25xޅ|ylRȁ?6{l^w9kSv|dBDa5J r #&VH&ZԢlra]eHiV¹yMUj؇qc?߸ UlnΤdhѓc{·/r̟)0=hm,7s[ku PK}Tpˠt+i;Z87'#:8.ɯC]/q̔)-­!ʚAH;cx~YuH^jUC\0ka^9P$1rb郳wo|d)|p>|{l_#\M* Ԗ>(~c;,@Tb!a,¸3ueФ०j&CIiiDT4RvhB/R\%mMC)3;%2g h]UL_vẍieNVXqfL)ɒ)^lsr!;޻C)đ Sg(C߫XQ$7X(D<W6xݏiYޠ~(/ÕY&>2WptsԷ*6mݥ*6|&o5 RS\NRc_#GpTfU7,CNcWoh>ĢAbʍ VᄊK̜J&j u 'A1qv?3JPgdaB|}M tY($c[kZd]@YW\=h1T p6)o~[lZnKɮ,S|11Tw"myN6IӸ5xI1IL@.BTn?}. 2sCyg5۩y HwwxGt❿tk\|LxGdt#OD[Y}e o&@Z:J착>@Ʌmlp?q]Ö&+)*3 ǖLCqh | 2b5pIn E_7RនlKbuK6fj `NA S05H=,R!hp< Ae,p\IJge%z߿JV-%zI|\y4(krU^RP:soٽǖ;jߢsP\ì{C~G5eĜt l2Srayqѳ "rON9ْ'DL 奝hy~cG=͏Ҟ?㭼8k6-&ue܁M0% pSiΦx-w&r--tg{`3R6s  CbXOAEay^mwhGu蒟6?a9$t}IZʭ7+"R3נBVGwبQ!rM <7`NF×sh0'J Ji2a t 6l[@?@=n@68_@c(ߢo nk iJ;?. =zUP?=$hLn|%@쩹\e`ravVY^,>KwҸ5_7rѡ>C CMbȯgBD ZV_2bTq͢{#Q#эm ۞v~K`׺bT$@w~g/md]f.q& &*1ljM.:D/j }wbi%(2I*żBg6MwaV%VJ |Z{6GN(g`AW9a&2VVvDf t yJ=|EXkӮ|>*6 ,((td($ɓ|*>w`a(G2*w6]/GN4f|1K H}ށzWG=k c/-"6"f~=m<LceBǵuP:gxZXQW<%Fc",J$W#!=kayH1C| LOK{gySwAYΕɍf8Y#zjy|w"VS7JkAP+"oMiy h.}qhy'ETGߢb^ (szǷvޱQzdߤ29=Bw;Fj I m&R3e"q'kbhqYD\\_ǮmB$be!NnA20R`2}Nnز1<ԩ ϺWӄJ^9,?Sr.6^W b*vJ"WꟀ>F61ɖVR1H5>x?Y'|3$\g(tu7r-+ k-mgt!  _Lxyt<9hdȢ,~> ]7"BG|x ^brz%/4lkEQ;ӽtkHYry8;,cg{Hb&Y&s.jի4> B|n4͎HK+Β"+hȨ\O[!qNWDFu*e3]uP,nSâ_W=ގgj"{eH9xKC"+G]or w^7 ɟz9xPԏ^sLie@!.b{mbwLW Ot$͂[y 1P܌=Uko\?Z$ZH VK ̦\@dBlaZVJg?px.R *a7{yx%{{P STL-Ix endstream endobj 236 0 obj << /Length1 2364 /Length2 16671 /Length3 0 /Length 18062 /Filter /FlateDecode >> stream xڌt]k Ƕ4ٸٱm۶mM5il;r΃1o1^5qy/rez!c[C=3@DVE GNbd\ hnk Ӈ싁Ӈ @ `aab01qց :‘ڹ;9}+ʈI;@`nd`5p2ZD42(곙#+#)?5 t: 348rʶ&N@hlc t|D(K62030l`ddkmg`nnc 01dܜ6X9~[~@LH`Qs4r0srdp4Fƿh>,jc,bkm qr+/@3p-ml]mbFeEYe)E_ @ `gppsEYSd?]=T^jr~-@g̿23}:uFDBF? 忈 (% V)}pAr7Q#AUxG"N?#?}8Q~8Al>N?6$:>F@f#{t/qG&.Km?zӿ?|$j'^ۙma!3g1GVG߬O(. pGEvdv,+ɟ>1[?e(ㆱǑ0a(O!?:aq #}G+GP|Dct2s>Rvr)ut/ ?GTy 0rvh߷ǽt,Xt<N͓盛P{8t:?!A'RWgo: %R z6@+?{*.8$%WzRo"ϱwBRCpw,9W! R6Gկx<0sʉ yn-{X*$Sk%qcBű W mbS I {ٳ(bo9dsbkG[F a[|̻O6cWYߎiULāX%Zs ĭiݴǘ6,6Z`{o Y(=RZ~y=7Ρr3g$8Td&NZt _{GqWT2_NhpI?{4[%LI5[ŞjaV!sf,I<|i\%8.v:)߫Wlɔ阯8 bA+39Y L#L]quVPAAn`<(dEN$|bo$d3;K9 r,ѱj>STzɘ -=|e+:5Lhjps S;Nָ۶KM?kpd::.Aܸn{0=:/paɎ_aN;H6&#PԅE gDWLmѱ ԰Ì_o4+`dpCad@P?RRR/lr/N( }9|>MgX#Ը!* 3!xk3b1 Nsyy̸ubJIW}EXк$`4̦,=lE9-݂_k8=~x2R63l^\kRXtlw.B-aĸ2#D]2=ճMt/V+Xb;{ 7L( x212 TsV,%W4/zFmX~\q0> \ ^MNQEνRzHn5+_dkGquS墤Η+[OD TP֩OҔ٨[ rt<aʬ,JH_/u4")}a1؛Ckg_=[NUMWVlrBÐ23t%NFpSKn?ʣnOc>~PP Aۧe Շ-Yn# ݔ9wuߟ~{,! D(dnݻ+Q힭(a<T#ק8! ‘a91vGw}Y`sc' ٍYi{ K*6޶b47\Kcp w$j]M5}>\0fc=F3Й ya0|Vm+ rBt)7(C/@EjEB@A+ѝ[-z^evɖx!dCqݒh"]3Ĝh:h '3E:\#Qy/}[ Zc(w?_+_(I6yh(כOMդ*| 45$}[ xo[o5~* H'/S6WuЏ\Л)_d;;cIV>媿Oh$B6i5N"ZRЦW9e#Ɉuѧm|>E/W4dBjBA !O~(S>)a= @0梘d6@1~Ox,y0\ ԣy O&Ů6'+Y[-_*K2x`ʳ~wM(0^B<6>]żA o$$o6Zhe+h[Ab$8]@zfݎp2O鬍mp6CXB6݈50rIx0&`9}" oO4 Sj{e'AcfO_N-aN8\n= b Æš5 ;Dp'@D<9Bƍ^mGCdV>R6$; ԧ.諼Y :NDՁPBәRtH05̒7a>/ `K&/.=p[ԍ4qH氭jjl٨pWYy^$op=a4 8 z4UQin?҄#==9;ay5?ג.:zPvN 5½;oI\=UK`rhjƲiA|CxxrzVx9Ip+rOZW"瘾6f>qc a+koHK gE 9)ƣJˊ:zȫ.yN=hu cZr8uCJutԥx:WIs+')f,tنtt ^$VljϦV"ϓc5w/uC |%o0',֝L$/xSY%$ >VwKnrO3zBx;L!vN?qJm.]>,7(gPf{x6Y*|ǔ[P4避#9_I%\lȿ1@dۏB4>uEU>-]ƖyQf+ &mllMs6~{"3AɚA_t738qET P[걆5@5)Fb4]BBB, JRlRעz 8 4 W2­^q&v!!<E~m-'2e=lqk|o"^jSyJ.ї*l<х J^·@f,@NPƘ%jd4wWeN0T?n"3~LdA4S/x| E/`JX8֪\ԓȜFAM'V^ h T~MSTӡyU+S3 ErOvpޚ!t]B)J  U@w bCCҬ&Tv\fيZ:O@blF6K KԵZ%ݔk%pB AuTXR9bq mxИK nbEUi~dow 2`#Rq>r_2<,5Oi(W6p$B5; -\vWD&/*i! 1}JYjo} Y{yA3 }3Y L†,*$=bs 4)3ThOAӨ&#vaTPڒJ51u Yi%MTCfJ}#=SYKv-u%Lrao/h< FɩH1BoOo"ǨoU?}b^4KŨ= +R cqB!"ux_/'\EdV`y΅@;p5=M3-#{_1|n؝P$+lih+.g3`ۂhJx׻eO(zQNTd+uHxަVމEAU[{Au +l94(K\ix|yϯx"7,iM(zkک!`y)㖹=?aI:^_pftsfD=m :|[Ȣ߄N.UD$We̅H7_BA<Έ'ӓx{X̞sfN!l5-Z<@ã2#&ѥ^ٗj?ܯlbMx,~L_pi#0wjJK!s?)[U;'--0g+5jg)3.DcO-A*ԲO%{s, a`HTE{2 lj udzIA!6a4D*w_GLD*ӇKVgAxR.;ehZH@A$]eC\$t"TǭB '- ڜ y<9_FvĿ1Ӑ/iRpb1M1w Ĩ;PA33i1SBӱ́6)5x:zӚ"\F}BqqG3η/h:v2!"J \-;vIP}kgPFHYэ1Yp,4&f]7ձm'[7Yֳ[4~clkv]xzuǟq}(~{t^gHNM.Rj\V}OB~t+.D4WgCƔ BwDb96COFs;Qg&7-afr@K@kЪinϟ6S_`-j.!8ywH#a}`: ( ۬R.6lɏ;ek] AeY㹊!?(XQLb F1/,ijњ4Ώ7Y$8 ? &uv)I6"x=:K7ʯʛQ@pjvh[a~mۖh*i60n`hUJ]ϏzN1CHg&(ચe K"9d/:TkT]iUPbOЌmj5vd3Yfg0UN`VАX-l`:OM @rl v<|EaY-Px0ua3/,6vyP-$WEěo@0i>Ku/P%5J-G4{hq4ެ憪#q?t(2buݲG4>~o4H|^"ux %ɑmT3]SҪ(-Kct"*X9%KfKZWM䀟ߨ^ 1LD/c}h8;&ےCCAUr`b! A5S E^]MPB_ h+מ桰 sS\ ŧ@Ed8JX&[u)O_t@FdZw(zثK.!F#G\H:Ll"Hkƃ{-oŲkv[w"wtQ:EVS[I(?aD@ai68zn N/Nwv`[XHwyxr)YV6Ad@aHʱĿu3vl{AЫW07TDdj=r":mNg$UE YN@WKBk9xKZ5E>ds*/gK+(U|' d,GWUlz lX턚4w2]srf`S#%vm,H~dEmcÈG]VB~{Q}X$Cuޥq2=í|ʥSHbqo*3?- _58X}=7[ ޅbs.Ty|$1>˱\i:yz'Wˢ}p5洪=< ~LMy`d/Î֐e։勤,?)2PlHGm$#8иkNyAmPIkhVǰïV2jhZR6i+#zR*?Xe2@>Wwk Xe!Bڃf5gj!wwGYa 3"MW@b)DkuH!^H UN~;ZLpZNCE ]`\hQ}qz~1= !aE L[-K^HY{B+P +F [; B4ϚʳUp2hq|&A1M|;D q\RL$eĭ4XNFeӃhY%zŜjKKYcoyRFRwS\jO\dxMJJӗ%7}. @GrEz-SأK1b{qqAg=%҄xlۥ\i!XZ\)2p #sUheV 332z^1*]@%{w4R&k ,I(4+>_/< { F"d?3zcZ޳ڬPn4vl#u#0^QPO"LY]t =#-q(?N=\FJ Tb{+9N`eJmD e-"Y4l!Eڜ)*7V1TͶ e}+tfP tb6SoaN4cDtjc袌Qdípl"@g6 C~۴3•mCdȮg qQ|ep29$+95U4ׄq`tϊZ؁=s+/yOu2)rW*t*^Hڒa4}꼐 OAWM sg}ԍ1+Է,Rߦp C #qc#HVi5*5<+V94mvŲDZfG8ȼoӥ&Dfļ+ kw<۬j;AV⭗R1}[iXT2|;O.`tr.-qhVyVaeL ̍H,s#]dyiDK^ Σ㯺GMlb>Oj.WR-s6ؼߐC_X_>mGu"(8٥fCLm‡-rl$1 7z!DKM8Bt4i$So.ZQe8o1}KUP=J_ ls4ð@f:|0ʇt '-ҸkO\BxxzL9ߖ,v<<ȅ8a7.i5 /{"ǓO`OfV$nnhM\㗶W">15+Du8{(z nX^x Y7e; P;|#+ Mx0N',•.Pr-/6'ӎ$|4zK~ljFēvYBG /;)97 ^>feDžF 4=$!*`ڳgRt2dzi-$[&\ 7-rbE7jF8.u}]7mTd|GqV6ȔtmT!_~Nά;I~oZ|K@X$p7Ƙ0\DgͲ`p${B vQy\L $PGR\sgc o@sQYI #Q}#GWp*qf'ul=h? cP>3EZ AUF[zKH%i)dzɮp#OBݣG#ֿ]"KF;: F=+)K 6d6t+s_Bh'""%-S"ϕi3fkzEU1T dJtX~4DAf-Eh$ߴ%ptwu- qOTcrPʢ8Ts蹉7 8QrLDrGp;!<;\zxRIe 2܍<(F2E@9?mo !&|z ɓ%1v5\RJr*D"&Pʋ-VG=ԗ@72݌NOH0{lp81ǸXX:ɡigeNi2wŹ,/nA.Vt Ѐ}] Q}C3wcבɀT-'@Cr5SC;w`R(wzI3iN`dkIqMs95Z\s RBXx.H_~ Ǒd, "wylAs3d wNN{n2ݡ^aNEO6v- OvpA HE Ii}YScTP9%kKj:[VMOf?&fku QJ=?l_.`6;e 6}J "EiGlhн#Ւ-9cwji5_B% U;x:fXpP!S) \~dK4Z4mQ.+ UAyخ.ߵBZPD 4xD1LHT|Mi0c(Q':#2HvF鰿bqrɡuڲh{3h, tn5\yM'p<=tƀXz_:+v-),%  9uF GZid/hNv H|9+`h,V»KKqFsB=P fZ)Ňͱf̡0m~pdbX832 a.QB7xūfS̹ )މ5콕>גY 4H"uiA,6&uV?vBE1Zj#nZ#EaS57J%Fsej~M*aZ*rcjk~MEOym')&.C’'\pI>ZS,jd#6O~y!wi`Ŀ%UcoM& ;lC_3#[ 2Vb-h<)u喉steg3JW6aح&8r+͆Z+w ;hW2p~E A&Ŭj6N.'"ö0o=GO$42TZd~TFc-gK*)C[ qtدwWswzz@XfF6;ۍjS)H,Y+߇Cp}Ѿr+j6^S%`\|ׇ{QNÑhSb,_k^b[s.xoRSȋ?<|I쪖AHϕ))YH8ځS-8ڀ<谧.*T5W漤ޏBLר߱2 #.Q4 k[G}|R, o,oֵ1s6d7-'f߲vscrxf:h~„ '{n.]5Cp c&pdkލ( /j9ٵ^UiT&OIOѕܟFc9,@T @7S4ē9whk EwM'ε&{ʺ*=nz9r]tS7ߥ{[z~z񔵆9.vVwͦ^ώ)no9Qv;7Yk*}Ik@ gAfRPo,!]I`-A$eEs+w16:)tw$ߘ" xHjww ߲"ThvJB˭@ѸO1; 䊉)k<O@q[^|i7Q@$nb"?B'GMu!ÿ:-ꇖ-Fb>' whDZ 2pOLx;UE팝TtujSiy6턿p(%i S[IEX|:uH[%!h -" Thx2kj4xph 1 Q~3!qTF`TW*Α]34C$hJU =7:N7e ǰ!)z}#T؀BSoF~.ARsz_GvV΃9ݓQ~B, ;tvRڬLHRR30o_ןC6|mpLyGrIX>>tv'X(x:#jZ*Z+Jw _w)9i-`qs#(=1Y Z9^R?Xp`^!VluUӧ,KO~k+oޱ>m& 1dJdM?]:bř{x)83xr\t7ڤPVBTeOߐ9\i B< 䢈Jb;ICPE8&ey,ON*$8= la|ޯO='BHcv A:Zx F|VM͢pQW-"rA4;̿뮪VD#wE\.ő4J&>l|-_Z7AAђrXƎTmީ#7uAU oPd)КxHļ;=,y*5.aȻ+E/3dHzb:nHЏ8Pik}=F +ՆD2XOG pvcfe_cQR:liئ1_ms^ s0g:u_'O<_LP_Drk@vlgo9NfA3jOfƹH`40r~ަ5*#XS4B1q`Z6:DZft&m;Q"P3kVIٳ+FvW_{^䬨n<#qgYo%fZo #TAֆt m&. ,rgF=}@W[]5L*M|?r@ ݷ{o7JډK^uM,u_4nzCdd97Y˕<c\\\9;8lefWU.66rYDx7޹ ߟ1Ha}-Ƽl%M/|PzҜI+KXA9WL!-eL6U;p9 O@LreEJ%c$2H,xytwoLYBA|TfX.X%QuBBIIORfTzTPC< $er?)n4HȈOl [ki[6ytI .#/}zCJ rJ0 WQX겟MߖG+~dy PYPM:0Q^'鷵44TQ/67 qe0f!׼o* [F:vAgGF- ڱYOcgud }bmvQžVFeKD3/:EvOZh@ 8V2>]"Y FSC$`>òsѣz(/eFQw%ŒĴ(l0wrߞߏIE:!NpHQ/qW39Ha:\!)HꑷcMR?'sri!1Pt.,RUO[umN8}+kbi*[J,6f8%{͑-B*?7=ѯJi3g"9;nHӼr5 rf&4v<);Y *JYB{Y4>]]1)D+ٽW)Z[[. XWƁߕ{qL0|g;D;FAњ`m*fw' F[ȮwSi;3.WAĨO{ c; A]2~ Vαd1fRX$76Rf;߽7u] 7‘Gc,<$.3.-KgxUlްJuj{md)ۆOyʦ6 W>Tj!|Vb9?,kyYE֞~69wҧUa+~Bh{y(+HRA/Hʹc??f:׼ϯ|_vO}d|AŪ+QOE/Ȳ}b.N>K>@1ιܯnNf2tO~'3 LorW${NrDhʬ"ǂ[)*=Gp<ð?M%9"5Dr`>IgI5e5 a3֙Z"HhfF/V;\,VkBM%td"L:ZʳOO.CNzGgFq3E$? )KJFQڅyONKZEH^ }cAɹħCyyȅ u\0Rv|LpTi,P#V@X[c_3,]kIXU\epwEĺQY(l`i-ʏSӶ==sBT AY_6۶~ FO.X4vkK2>YU'sIWGUKOT<8@3 Beh}j$eړlkI>Eĸ.ݲX5s:paH@0!$H:lp@2 ,vK_eѻ;q= [z/!8 P7+/S; %10WԴc !i bK^dq &uNOyq~\E2AF(TM:֔ZBVO 4eD/B)It R~!$cY endstream endobj 156 0 obj << /Type /ObjStm /N 100 /First 894 /Length 4254 /Filter /FlateDecode >> stream x[[s~ϯ#)ZB & C Ń;IN8̃jZj&/ˤLF|ˌD8f- d^a;/!zN5|Q C|/=f ;CdB_#jqpm mO?fd{t^]LGea3sТ Ds}A c&l=v0&3~#Py/ `Z5 \| `䁴>!&c08FV67 hUaۇ˗'eǷrbUx1$=%u Ym6*{ہO4bowTv&pי/d'#R"'Ǡ:|vR٣#|Թcf:N'zn90 Ok c4qMth'4prjC+(BͰiWG FpFʏXlQ{U^_緃m$?j1FV E8+ҟ摑o?}V]~dr EoX@E 1# R u-"@?TΒ7f۷oIg2O_X< %+=Bgr,4mtH;QV^)ߋN~p<ȴ0iRmk*OFlƁBSZFYЙE;Ҫ/^AHR"b_-m3PUOlw/cYjK>xq9~ͷ:ƊX$u6~:AǃFjk :Xk q\쬧B *y䶡CYl)H[/ {lOU3jRDFy Ed]o^؂N5îY8p_heޓE谴fy]H6fhR՗;"&f#Y 5p\6BfkWE0glv@G2sZ}:s7Dw"̾1ğ,Jdkx@KSٲ^b; 5_~IJ^n5T,Ͷ)t#j^J!]ykyC0f?{ݏMѦ ^1(McD¼u7\k Βi[tep0uP܍Чi&c0 ަ# Su;As" ŤCfFS"k\-w %G*i|l~n,A?ʅJgYC]_)ȗ+Qu=AE=ų{#13yN:zMNq:"yrw>oCr4\Re*Ф uIƎw`t+ >^]u+W_NGpK~%S/'k~]a/eRߔ/kPm;^$ ZFFʇI+QJHY i6r/?f89X%s(2̽E9D&L{^zWJf~d$D^5Ҳ)ï%| $:Z%3D|@uq8}:|_!_!|{!s 8 z {QYay/y9H_qs [Djd34Og7y}ʝp<wmlƿ܄iL|d(MF1]ij2`Ys!r^`Hsw.e7l33+JN%),+c#}|~RJ@t]Tze )Asm,qg }qK?wF7cxӧmDYZMvR^F6r9 Ц;wFFn+Xf'7a]#$hYv^&IVg+KV/p%yFXv;*Ȏ?UD z]_7beDBaY`ȵ&v'U0.܁9S9OTi\6Ut.FhzHG+d(AP^IDٟe^7 D=ͅ h^>\ڭ-ÒA߰һ,h> endobj 241 0 obj << /Type /ObjStm /N 12 /First 102 /Length 650 /Filter /FlateDecode >> stream xڝmO0S%UOy0BH6m`6&mEh"u*E>y(I Mmw\RB *H)\%I׈0*<0Q[R(*¤(aQ1b-7"E:8+]f݄`VJ5̝.MHO24G6!bĺNWy2O%Crf1`"<),Az,3_UC4tiiץ 7FWO/u[ `{/zݨż ko15az3h1a vtjZ8J^ޡ67BQ'k@/7S=LvW@5tue5E> ێѽ^l,S+"\Xs' +~ vM1E-HN۷qN  =e'xXMj'8>f"+urRL&*=JR M~+aCS]0q]E<лwA>).2xYeFzFd?yͫ^b{:\Kl.2̾n\MmQ0o?/s}m O8 endstream endobj 254 0 obj << /Type /XRef /Index [0 255] /Size 255 /W [1 3 1] /Root 252 0 R /Info 253 0 R /ID [<2A9E316EE7CA88540181306B5E510ADF> <2A9E316EE7CA88540181306B5E510ADF>] /Length 652 /Filter /FlateDecode >> stream x%IOSaUЂ Ts PVAF7ƐqE1q ]hN. q_V\L\D6O{;Oȿ DNaWH h6G8ˤ`v3J P `-X@5X6`#` & q8LA:9jiv$ @Jp$U*olp |S ZTn5^(vp'@Zo t *K> @7ȂòQRDBJƧ` (d y9FT >e #LWG&Uf^)aWcSQ_*%/ E 1%S/Oq[KzBGCGPykxjXlXlXlXlU*>555d5<54lʛ/s'!r ͥ5C3K,~egXgrYi ,:Uޏ]*ߋUCj旧[O=KzU|WS+Or4,4! <4|멨zGH46E|">K=yD#ODˢƮ?-opcA endstream endobj startxref 225662 %%EOF vcd/inst/doc/strucplot.R0000644000175100001440000010036412767204756014774 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/0000755000175100001440000000000012212345476012214 5ustar hornikusersvcd/tests/demos.R0000755000175100001440000000015011150520606013433 0ustar hornikuserslibrary(vcd) demo(discrete) demo(twoway) demo(mosaic) demo(mondrian) demo(strucplot) demo(hullternary) vcd/NAMESPACE0000644000175100001440000001264012562622410012266 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", "odds", "rootogram", "sieve", "spine", "tile", "structable", "loddsratio", "lodds", ## 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") # loddsratio 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("lines", "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") # loddsratio related methods S3method("lodds", "default") S3method("lodds", "formula") S3method("coef", "lodds") S3method("confint", "lodds") S3method("dim", "lodds") S3method("dimnames", "lodds") S3method("print", "lodds") #S3method("plot", "lodds") #S3method("lines", "lodds") S3method("summary", "lodds") S3method("vcov", "lodds") S3method("as.matrix", "lodds") S3method("as.array", "lodds") S3method("as.data.frame", "lodds") S3method("aperm", "lodds") S3method("t", "lodds") vcd/demo/0000755000175100001440000000000012367374474012011 5ustar hornikusersvcd/demo/twoway.R0000644000175100001440000001521212475147056013461 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.rda0000755000175100001440000000113412767204756014377 0ustar hornikusersVMo@|B^B"B{Ԕ^r]GvrOf3"M+By;;v2L}0x#Ho8D< 'Xf) jսX G>S.%a{/hϺϺENo"]X~E`r^X*B39 fN; |pFԹӱ\؄,iBgnӬɔ .NFU'/CQȦ3NyE2G?l$&⤔CQbh-#~;`5V&"o [:3a]>8p-cr#c&۔0,\*E=WxnDT.f\Jk+ⵕ[j5q"砇u0x}BD/ڞz)s翵="1LeQK t9iUvtY}*WݴvqITֆ7j_Iq\%a'܌܀G;s,dA+e&' $gK vcd/data/Suicide.rda0000755000175100001440000000362312767204756014061 0ustar hornikusersoTe3ZM]`fs^`Hi;R)2mmh0@⒥K.Yt .]S}4& |so挎?m'yW=fO&k鉺畟knio϶GQ.?=+{\aO|QGZ.WYuY.~syPer)9)?|YGפ-韓yyyf$o z/7+yȼoWtǤ9 wA~V\$4dw~wy\OgT.wwe멯nyK+.;<W EG?Ǜ_F%;֩;_XGdV.UO:Z.IuTO=pΎOd,U| JzN{L>mί5IX׫ ]גz^NI~9ɾ/>R_ԗqVzz.reޱIYuOϿ%DG޼r璜׬5Ӓ_ qJ_?xUIZ_^g+X _SGϳ)zK_$X~NWj?W_vί+?[VldRۓr[f3VQs6S׊qgjzM6Y_h4ۭ\=#ꡞ{V?,)jUxsƬ7hnB8{fԟGz\yjQNOz{>\0s[FYxwD~9ԥ YrwR7{Ƀ^wVw];9\Nm#GjwRx,<~[? .y?q#[(oֳVc=f}L+ ҝ2H 6Tʿyo=5EMQS<59by?wڅoy6=_\/kL@mJnM59 VkzmЏM6mȤQ+k Y+VbZưc0c0#0F`1#0F`1Bc#4Fh1Bc7Rd1"cDƈ#2Fd1bcƈa_QJ1bcƈ#1Fb1c$H#1Fj1RcH#5Fj12cdȌ#3Ff12eJMMIOOOOOOOOOOHi 4@Hiiiiiiiiiii!i!i!i!i!i!i!i!i!i!iiiiiiiiiii1i1i1i1i1i1i1i1i1i1i i i i i i i i i i i)i)i)i)i)i)i)i)i)i)iiiiiiiiiit %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@tI@tI@tI@mmPlr<k< "gv,6vcd/data/Arthritis.rda0000755000175100001440000000141011566471044014425 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.rda0000755000175100001440000003602311566471044014171 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.rda0000755000175100001440000000027712767204756014570 0ustar hornikusers]M0FhH J^@7څ roO@E̤sM [*W ȸ~u^3wN1!ĊXsf"gdxv+Xa2M eXre˲cٳ,DdKH8F?~ou÷fJa-vcd/data/OvaryCancer.rda0000755000175100001440000000054311566471044014676 0ustar hornikusers=O0/i6EJt`F"&*b1u=%.&@6~2!wJK}_}?Z`8BT(ݻP˘%`,SsŌ'拍X(&302 #3Q];ఒn8/H/g>nx lvcd/data/WeldonDice.rda0000755000175100001440000000032112767204756014501 0ustar hornikusers r0b```b`f@& `d`a\9)y.ɩ |@ntpBl[!Gz^ BO9+ t6bS2s/Xh-4P:/17ja:<ac0 a c0a e035R&$e-ILIfU vcd/data/NonResponse.rda0000755000175100001440000000052111566471044014727 0ustar hornikusersJ@76 ^*xYݺބ>Oֺ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.rda0000755000175100001440000000056011566471044015351 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.rda0000755000175100001440000000024712767204756014555 0ustar hornikusers r0b```b`f@& `d`a\n)E9% ̼@v @,  -``9%3HBѤ9y@j 0!ac&0)af +0Aϳ^{?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.rda0000755000175100001440000000035712767204756014260 0ustar hornikusers]0ϦT.AE  QO[HS_7rl $wwo-@ =5Il,R{Cqs6zP Cfl0qB;Baq?Ĩ-IuEkVKVHEƅ UE8I0L`TQgyMlc'_]%dz֩ei{l9tjP vcd/data/Trucks.rda0000755000175100001440000000071611566471044013737 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.rda0000755000175100001440000000070412767204756014045 0ustar hornikusers͓?K@϶b-(;8SlW)(xM66MbrV** "~7W?AI!rs/tf<0,rǠ C ^=iaid,2ZR`xv1['^%X:'`~FB,5XU#^B]6~6n/=">?߭c7?7x3D<&8<|% F|){D%p~U~UhQq=y좏 $aWbp\ t-Cin M9}\N5,S- OM 1  Cx.=5:oVQ4<5*ҌŶ|F3[fHj#cVLeFO纪ovR.H~~@p/vcd/data/Employment.rda0000755000175100001440000000045712767204756014627 0ustar hornikuserseQN@JiKnIDc0*I]鮟ep@Asyܹd4u̩IDtj;r!$xu̓H;=&'McGxKZρG~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.rda0000755000175100001440000000074311566471044014762 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.rda0000755000175100001440000000024112767204756014532 0ustar hornikusers r0b```b`f@& `d`a\Eũޙ ̼@V bG bfjT]) %)it^bn*H&a:<ac0 P&\RK2@'$g-ILIf`ϐvcd/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.rda0000755000175100001440000000101412767204756014205 0ustar hornikusersVKK@޶ƂЃă_j Féi՟t wn k68I?7VN{Prt3Ϙ= A^B1};CekxgCy*D㵄W} h R (RTυ: A ̓]ܐu'}:2U1Wu:6k{<%I_,N6/h_k, /mV{, ˨ 3_SE,5p?:>C7xYMA% 08ŭDY> ȉfj8-< CB vcd/data/MSPatients.rda0000755000175100001440000000041212767204756014514 0ustar hornikusers r0b```b`f@& `d`a\%y%@i>3884@h(J@i5(ePz(: T{;0ꃋBU7WMVWA !\ b䠘 MPY^bn*(jj!ΩE%y0EII9p~~qq&%4$4032 Rӡ|nrļb4B} GRZZY\E0Ufvcd/data/JobSatisfaction.rda0000755000175100001440000000044411566471044015544 0ustar hornikusersPMO1MHwLHL [&+{Se`vvu:}o/Q2K ҈ڍ\ϟb*aVlY %zc~:7׀)x|_p>zN[6mFY݂oxal"ܺhg@\dY0oHHƔl{o,ݵ UZkِ3l~d%PQI #0NWjҍK\## ArHI*6\ikۄ/NqIvcd/data/Punishment.rda0000755000175100001440000000074211566471044014615 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.rda0000755000175100001440000000065311566471044015106 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.rda0000755000175100001440000000075111566471044015067 0ustar hornikusersR0RPOpxmx)E;ϧR7On7KRgƘtl[LØkz[`,{#2Q/2 ͽSO>rnYTIŃ̝D>bF L|ȿt; w%DD"GCKD<8yp|ߔN3vcd/data/UKSoccer.rda0000755000175100001440000000032612767204756014147 0ustar hornikusers r0b```b`f@& `d`aɩE |@586@h(J@i[(U@i(&ea5h(̀F ?S2s/8(X!5(JsSJ 0!ac&djBq +`,0cyb%19'.X Q&vcd/data/DanishWelfare.rda0000755000175100001440000000212411566471044015173 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.rda0000755000175100001440000000535411566471044014111 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.rda0000755000175100001440000000034111566471044014370 0ustar hornikusersM @/RA:wdҩz_ a3;}qct 9΅Z&0hxr_{R&HW+4Ҽ@b#R׈,3WQӈSsRx2 GX}N +SJ[q^ VVA4Mwvcd/R/0000755000175100001440000000000012610700530011237 5ustar hornikusersvcd/R/fourfold.R0000644000175100001440000003657712515204774013241 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.R0000655000175100001440000001446512466747452012362 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.R0000644000175100001440000004367412264547560013571 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/lodds.R0000644000175100001440000002514212566042766012517 0ustar hornikusersodds <- function(x, log = FALSE, ...) lodds(x, log = log, ...) lodds <- function(x, ...) UseMethod("lodds") lodds.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) } lodds.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()) lodds.default(tab, ...) } } lodds.default <- function(x, response = NULL, 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") ## assign and check response and stata; convert variable names to indices if (is.null(response)) { if (is.null(strata)) { response <- 1 strata <- setdiff(1:L, response) } else { # only strata was specified if(L - length(strata) != 1L) stop("All but 1 dimension must be specified as strata.") if(is.character(strata)) strata <- which(names(dimnames(x)) == strata) response <- setdiff(1:L, strata) } } else { # response was specified; take strata as the complement if(length(response) > 1) stop("Only 1 dimension can be specified as a response") if(is.character(response)) response <- which(names(dimnames(x)) == response) if (!is.null(strata)) warning(paste("strata =", paste(strata, collapse=","), "ignored when response has been specified")) strata <- setdiff(1:L, response) } ## dimensions of primary R x 1 table ### [Or should this just be a vector???] dp <- if (length(strata)) d[response] else d dn <- if (length(strata)) dimnames(x)[response] else dimnames(x) R <- dp[1] C <- 1 # shadow matrix with proper dimnames X <- matrix(0, R, C, dimnames=dn) ## process reference category if(!is.null(ref)) { if(is.character(ref)) { ref <- match(ref, colnames(x)) } else if(is.numeric(ref)) { ref <- as.integer(ref) } else { stop("Wrong 'ref=' argument!") } } ## 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]]) contr <- matrix(0L, nrow = (R-1), ncol = R) colnames(contr) <- rownames(X) rownames(contr) <- rep("", R-1) for(i in 1:(R-1)) { rix <- i cix <- Rix[i,] contr[rix, cix] <- c(1L, -1L) rownames(contr)[rix] <- paste(rownames(X)[Rix[i,]], 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)) for(i in 1:(R-1)) dn[[1]][i] <- paste(rownames(X)[Rix[i,]], collapse = ":") if (!is.null(strata)) dn <- c(dn, dimnames(x)[strata]) ndn <- names(dimnames(x)) if (!is.null(names(dimnames(x)))) names(dn) <- c(ndn[response], ndn[strata]) ## 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") ## reorder columns of contrast matrix to match original data contr <- contr[, order(as.vector(aperm(array(seq.int(prod(d)), d), c(response, strata))))] ##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( response = response, strata = strata, coefficients = coef, dimnames = dn, dim = as.integer(sapply(dn, length)), vcov = vcov, contrasts = contr, log = log ), class = "lodds") rval } ## ---------------- Methods ------------------- summary.lodds <- function(object, ...) lmtest::coeftest(object, ...) ## dim methods dimnames.lodds <- function(x, ...) x$dimnames dim.lodds <- function(x, ...) x$dim ## t/aperm-methods t.lodds <- function(x) aperm(x) ### FIXME aperm.lodds <- 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.lodds <- function(object, log = object$log, ...) if(log) object$coefficients else exp(object$coefficients) vcov.lodds <- function(object, log = object$log, ...) if(log) object$vcov else `diag<-`(object$vcov, diag(object$vcov) * exp(object$coefficients)^2) confint.lodds <- 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, ... )) } } ### DONE: ## The header should say: # (log) odds for vn[response] by ... all the rest (strata) # Fixed: clash with make_header in loddsratio make_header_odds <- function(x) { vn <- names(dimnames(x)) resp <- vn[x$response] strat <- paste(vn[x$strata], collapse=", ") header <- c(if(x$log) "log" else "", "odds for", resp, "by", strat, # if (length(vn)>2) c("by", paste(vn[-(1:2)], collapse=', ')), "\n\n") paste(header, sep = " ") } ## print method print.lodds <- function(x, log = x$log, ...) { cat(make_header_odds(x)) print(drop(array(coef(x, log = log), dim = dim(x), dimnames = dimnames(x)), ...)) invisible(x) } ## as.data.frame #as.data.frame.lodds <- # function(x, ...) # as.data.frame.table(vcd:::as.array.loddsratio(x), ...) ## Q: I don't understand the purpose of the row.names and optional arguments ## DM: The generic has them, so each method must have them, too as.data.frame.lodds <- function(x, row.names = NULL, optional = FALSE, log=x$log, ...) { df <-data.frame(expand.grid(dimnames(x)), logodds = coef(x, log = log), ASE = sqrt(diag(vcov(x, log = log))), row.names = row.names, ... ) if (!log) colnames(df)[ncol(df) - 1] <- "odds" df } ## FIXME ## reshape coef() methods as.matrix.lodds <- 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(x, log = log, ...) } as.array.lodds <- function (x, log=x$log, ...) { res <- array(coef(x, log = log), dim = dim(x), dimnames=dimnames(x)) drop(res) } vcd/R/binregplot.R0000644000175100001440000002546412503645152013553 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.R0000655000175100001440000003503112453520672012655 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.R0000644000175100001440000002453012537041354013200 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.R0000644000175100001440000000206612305101202013445 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.R0000644000175100001440000000737412445046670013175 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.R0000655000175100001440000002777412445053030013446 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.R0000755000175100001440000000344311566471034013215 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.R0000655000175100001440000001661312510525066013414 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.R0000644000175100001440000006014212554434324013545 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, add = 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) { if (!add) { ## 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 { if (!add) { ## 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 (!add && pop) popViewport(2) if (return_grob) invisible(grid.grab()) else invisible(NULL) } lines.loddsratio <- function(x, legend = FALSE, confidence = FALSE, cex = 0, ...) { plot(x, add = TRUE, newpage = FALSE, legend = legend, confidence = confidence, cex = cex, ...) } 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.R0000644000175100001440000002136212475126622013420 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.R0000644000175100001440000000471112445041730012526 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.R0000644000175100001440000001365012610700530013231 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, gp_conf_int = gpar(lty = 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 = gp_conf_int) } 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.R0000655000175100001440000001125312475151320014263 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.R0000655000175100001440000002325212511044620013024 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/0000755000175100001440000000000012767204756013074 5ustar hornikusersvcd/vignettes/struc.sxi0000755000175100001440000002162011720273432014746 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.Rnw0000644000175100001440000031176312445055730015623 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.pdf0000755000175100001440000000622011720273432014713 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/MD50000644000175100001440000002150312767263550011372 0ustar hornikusers8ff0b7caec123ad6b2d8204ddd5060f1 *DESCRIPTION 7851595c1038d8eb33d0e09cc59c923c *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 1d404a765bea252806ae8a094d5be2e9 *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 d73189e85cf671591cfffa975e807ebf *R/lodds.R 7133c6685f8c6320ba17d284e0f3eb75 *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 5f9e967364e17834587c263fe213b08b *build/vignette.rds 1fcacdd810545176c5dfc8ad4be480d3 *data/Arthritis.rda af42b0e82f7602ef3a21ac54ba67071c *data/Baseball.rda 4956f3321e6fb5582e3f2ba8901012cd *data/BrokenMarriage.rda 4db232a9f37c6afe361051f4f3d425a5 *data/Bundesliga.rda 93e7f6208ec8c8db86401c1afc3320f6 *data/Bundestag2005.rda 1ebd3bef43daff5fe3ffe359b9af887a *data/Butterfly.rda f4e45bae788977b0bfb08529b9ecd604 *data/CoalMiners.rda aa7e80a1cd039d8fc05298dac9a2d0bf *data/DanishWelfare.rda 28c892035481f7558c9366341dff48a1 *data/Employment.rda eb1464ec2424ca562f341c7677177820 *data/Federalist.rda 59c4403257e7fdd114f70aedb279b9eb *data/Hitters.rda cf68a4da2d6bc811edb92ea0d600a87c *data/HorseKicks.rda a4bcb02b7aa5587e5863db9e44a9229f *data/Hospital.rda 30aa94bd0a31ce461608ba6934ebe5ba *data/JobSatisfaction.rda c8f5e67eab217718fa29e5400dd45bf5 *data/JointSports.rda f8daa920ff9eb0ed74876c7304c2b9e5 *data/Lifeboats.rda 97a58a4626dbc40e75cf30049f327429 *data/MSPatients.rda ba9681b79f4ebe1322cacaa081b968d8 *data/NonResponse.rda 134589af7ec903a3c3e00d4206dd1360 *data/OvaryCancer.rda 5b926391bb235731e83741399fcecdb4 *data/PreSex.rda f0935833b88518d4cec4cbd4cad1c93c *data/Punishment.rda 33ed940fc4217075815a3c72d284e952 *data/RepVict.rda db23de7e70198eb79e834eff4416fe8c *data/Rochdale.rda ffdfb13cb78ca8cc19ae031aa6c173ec *data/Saxony.rda d9056090e3ef45162e3e61a33e9b1bc1 *data/SexualFun.rda a9971961ea92c34cfa6df11a2702ab57 *data/SpaceShuttle.rda e5d1b54f2da1b4366258d1e46893fc12 *data/Suicide.rda 645187968a5775ec0f32c58b00fa416b *data/Trucks.rda c42c67941a94e28e08ac4478a18512ea *data/UKSoccer.rda 203346753d583e64ebaae114e009466f *data/VisualAcuity.rda 7f1432aa827fde459adce4e66fcac287 *data/VonBort.rda a2abfe964a3f5fe4056688909e2c4636 *data/WeldonDice.rda ef9c4fbc444b0b29bd1f4b9a8ccb7d10 *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 e1cffa3ba8987a9d5077ec05ad1bd58a *inst/NEWS.Rd 6d2946ce9127e1b46b04b9b8cdcde98e *inst/doc/residual-shadings.R 8195fb8aa41852a97a5784f036a80938 *inst/doc/residual-shadings.Rnw b9c55a96e3adf2e1683fd6b3d0d3700b *inst/doc/residual-shadings.pdf 23a35b9e4ad98965a8b98c760e030f21 *inst/doc/strucplot.R 36cac2b2d77375961d3c9b940d83730c *inst/doc/strucplot.Rnw c7a45dd8afe3d753341f6e2363e21564 *inst/doc/strucplot.pdf 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 bb5bfbce246384f79ff951a6b63437f4 *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 38edfa781bdfeb423aa717b6a0582555 *man/lodds.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 ed140a424046a7e4cc86e10e5c38bdc3 *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/0000755000175100001440000000000012767204756012163 5ustar hornikusersvcd/build/vignette.rds0000644000175100001440000000066712767204756014533 0ustar hornikusersSMO1]%#O~7-0qiI[_..-P%@̼73^ (# jLR9e"QΞ(p/ˏqu9|N;Y{_ d@ HAruI@'0 [X]NcG*6H#g3)0[n`f?S {9Oj "sV߭/?DMݳf Fe3B)pD]H]tLkStjO? JfMW/7/#bs-#57_s9vcd/DESCRIPTION0000644000175100001440000000260412767263550012571 0ustar hornikusersPackage: vcd Version: 1.4-3 Title: Visualizing Categorical Data Authors@R: c(person(given = "David", family = "Meyer", role = c("aut", "cre"), email = "David.Meyer@R-project.org"), person(given = "Achim", family = "Zeileis", role = c("aut")), person(given = "Kurt", family = "Hornik", role = c("aut")), person(given = "Florian", family = "Gerber", role = c("ctb")), person(given = "Michael", family = "Friendly", role = "ctb")) Description: Visualization techniques, data sets, summary and inference procedures aimed particularly at categorical data. Special emphasis is given to highly extensible grid graphics. The package was package was originally inspired by the book "Visualizing Categorical Data" by Michael Friendly and is now the main support package for a new book, "Discrete Data Analysis with R" by Michael Friendly and David Meyer (2015). LazyLoad: yes LazyData: yes Depends: R (>= 2.4.0), grid Suggests: KernSmooth, mvtnorm, kernlab, HSAUR, coin Imports: stats, utils, MASS, grDevices, colorspace, lmtest License: GPL-2 NeedsCompilation: no Packaged: 2016-09-17 09:16:30 UTC; meyer Author: David Meyer [aut, cre], Achim Zeileis [aut], Kurt Hornik [aut], Florian Gerber [ctb], Michael Friendly [ctb] Maintainer: David Meyer Repository: CRAN Date/Publication: 2016-09-17 17:55:20 vcd/man/0000755000175100001440000000000012610700606011615 5ustar hornikusersvcd/man/structable.Rd0000755000175100001440000001223311563233644014271 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.Rd0000655000175100001440000000756212532005564014454 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.Rd0000644000175100001440000000420312475151440014144 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.Rd0000644000175100001440000001164212535260462014362 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.Rd0000644000175100001440000000404112535317336013250 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.Rd0000655000175100001440000000464512532005530017017 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/lodds.Rd0000644000175100001440000002472112566042766013237 0ustar hornikusers\name{lodds} \alias{lodds} \alias{odds} \alias{lodds.default} \alias{lodds.formula} \alias{coef.lodds} \alias{confint.lodds} \alias{dim.lodds} \alias{dimnames.lodds} \alias{print.lodds} \alias{vcov.lodds} \alias{as.matrix.lodds} \alias{as.array.lodds} \alias{aperm.lodds} \alias{t.lodds} \alias{as.data.frame.lodds} \title{ Calculate Generalized Log Odds for Frequency Tables } \description{ Computes (log) odds and their asymptotic variance covariance matrix for R (by strata) tables. Odds are calculated for pairs of levels of one array dimension (typically a response or focal variable) separately for each level of all stratifying dimensions. See Friendly et al. (2011) for a sketch of a general theory. } \usage{ lodds(x, \dots) \method{lodds}{default}(x, response = NULL, strata = NULL, log = TRUE, ref = NULL, correct = any(x == 0), \dots) \method{lodds}{formula}(formula, data = NULL, \dots, subset = NULL, na.action = NULL) odds(x, log = FALSE, \dots) \method{coef}{lodds}(object, log = object$log, \dots) \method{vcov}{lodds}(object, log = object$log, \dots) \method{print}{lodds}(x, log = x$log, \dots) \method{confint}{lodds}(object, parm, level = 0.95, log = object$log, \dots) \method{dim}{lodds}(x, ...) \method{dimnames}{lodds}(x, ...) %as.array(x, \dots) \method{as.array}{lodds}(x, log=x$log, \dots) \method{t}{lodds}(x) \method{aperm}{lodds}(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{response}{Numeric or character indicating the margin of a $k$-way table \code{x} (with $k$ greater than 2) that should be employed as the response variable. By default the first dimension is used.} \item{strata}{Numeric or character indicating the margins of a $k$-way table \code{x} (with $k$ greater than 2) that should be employed as strata. Ignored if \code{response} is specified. By default all dimensions except the first are used as strata.} \item{ref}{numeric or character. Reference categories for the (non-stratum) row and column dimensions that should be employed for computing the odds. By default, odds 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? 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{lodds} as computed by \code{lodds}.} \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 n-way table with the \code{response} variable containing R levels, (log) odds are formed (by default) for the set of (R-1) contrasts among the response levels. 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} or \dQuote{adjacent odds}. \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 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 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 related visualization methods. There is as yet no plot method for \code{lodds} objects. } \value{ An object of class \code{lodds}, 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. 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 oddsare constructed in the form Ri:Rj using the table names for rows and columns. For a stratified table, the names are constructed in the form Ri:Rj|Lk. } \item{vcov}{Variance covariance matrix of the log odds.} \item{dimnames}{Dimension names for the log odds, 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 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, and is all zero, except for 2 elements of \code{c(1, -1)} for a given 2 x 1 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 \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 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 (or for odds, 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), 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{odds} is just an alias to \code{lodds} with the default \code{log=FALSE} for convenience. } %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ %%\code{\link[vcd]{oddsratio}}, \code{\link{loddsratio}} for log odds \emph{ratios}; %\code{\link{plot.lodds}} 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_lodds <- lodds(x) coef(x_lodds) x_lodds confint(x_lodds) summary(x_lodds) ### 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/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.Rd0000755000175100001440000000414211223326554014172 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.Rd0000644000175100001440000001456612532005462014325 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.Rd0000655000175100001440000000760312445056524013551 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.Rd0000644000175100001440000001122212445061132013664 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.Rd0000655000175100001440000000301112444613362014560 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.Rd0000655000175100001440000000556412445040314013153 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.Rd0000644000175100001440000001526612554433622015247 0ustar hornikusers\name{plot.loddsratio} \alias{plot.loddsratio} \alias{lines.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, add = FALSE, prefix = "", \dots) \method{lines}{loddsratio}(x, legend = FALSE, confidence = FALSE, cex = 0, \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{add}{logical; should the plot added to an existing log odds ratio plot?} \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}. The \code{lines} method can be used to overlay different plots (for example, observed and expected values). \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.Rd0000655000175100001440000001144712472414136014771 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.Rd0000655000175100001440000000613412532005604014604 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.Rd0000755000175100001440000001073711235655676013257 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.Rd0000644000175100001440000000726412547003016013536 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.Rd0000755000175100001440000000162011264574714013673 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.Rd0000655000175100001440000002255012547003026013223 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.Rd0000755000175100001440000000233412214055144014407 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.Rd0000755000175100001440000000241611235655730013706 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.Rd0000644000175100001440000000763012610700606013754 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, gp_conf_int = gpar(lty = 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{gp_conf_int}{a \code{"gpar"} object controlling the grid graphical parameters of the confidence intervals.} \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