vioplot/0000755000176200001440000000000014641730542011754 5ustar liggesusersvioplot/tests/0000755000176200001440000000000014640410551013110 5ustar liggesusersvioplot/tests/testthat/0000755000176200001440000000000014641730542014756 5ustar liggesusersvioplot/tests/testthat/test_violin_unequal_groups.R0000644000176200001440000000122214640410551022560 0ustar liggesuserslibrary("vioplot") context("unequal group size") data(iris) table(iris$Species) identical(as.numeric(table(iris$Species)), c(50, 50, 50)) index <- sample(1:3,150,replace=T) while(identical(as.numeric(table(index)), c(50, 50, 50))) index <- sample(1:3,150,replace=T) table(index) iris$Species <- factor(names(table(iris$Species))[index]) test_that("list input", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"]) }) test_that("formulae input", { vioplot(iris$Sepal.Length~iris$Species) vioplot(Sepal.Length~Species, data=iris) }) vioplot/tests/testthat/Rplots.pdf0000644000176200001440000176261214641334174016754 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20240704084533) /ModDate (D:20240704084533) /Title (R Graphics Output) /Producer (R 4.3.3) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 799 /Filter /FlateDecode >> stream xVMO1WukVBm%H= (  ;C@@ಛ}f< X;u w ^hu`3߰VlN.|ngkvzHR6 ox0:@ڲ+KvpӉrYC oc6al8&-ʯ8WV0Bl/ vθyɇW)tgIj.g1ie$ c|8]Cɿ듎=j^V=B$~ϧDU)C)cAes^ Rz׸ܣqZȔDp& 0Xxr[`a5FtJeT+^n: 킈;;Ŷ2^Z'i4;;uve+X`.<*J`(4 A8q<.>u8|`K l4]v~82-/ bO!`Y7vy9<|t4Z4bhzZ>a0Z] JB`L %! 0$A$ddBi$x%> endobj 10 0 obj << /Length 874 /Filter /FlateDecode >> stream xVKoA =0عRH8 UЪiA;i-dٳgp ?s > q: 8*4>95Z/^3X2 z@wC1ppq fN5'Jv qd'P6>UMr[HrN^m5(| aC V[8ǰ^G) fĬ (1d)# -pr3k@A PH;Jv{6'@@t U̺w_w˥ , 8>>p~w? HoWW)~޶)-j#s&+l]*򨙝q3f; 8D=FߎƋ I}b]Nm.gOh\l!>yJf%=7A@l%zn@], vpxPcN; NdUj%&u+Ulgv"IIWXm.FZu?з :#eT5 |-86H|- r8{Uڵs 2;Oۂp|VXԍ$)w~:!GV$::KGM~'[lHiyIWZγBK\Mg鈭^uBm|zl\m[aؕ/%q[߽lh^K+˸Ѥ5hQ&9-m"s*(Q]ʋR,s?f\4JeEy%md;SEWVc>Ÿ^%i"Ҏ:<o| .%endstream endobj 11 0 obj << /Type /Page /Parent 3 0 R /Contents 12 0 R /Resources 4 0 R >> endobj 12 0 obj << /Length 874 /Filter /FlateDecode >> stream xVKoA =0y^$h$ Z5-4><6fZ8d7ϞE8+1ೱ"3#OppBݻgbZ 9~O>¹&Tx=U(@m! GhLA? 4r`gM@# 1ZBIV_ I}& ;ʰ‰?|Ul?H\0 rx2s4r|hR(ʩ+#'l8=YjvOA Hl.1!!$uQ!6?ow*l&) |8u*r}{}{wV3Ƒ4}4.^\yNNH[Q;39`oReg$4̐; lBF@ JGoB=j&PEWA[93vl=҇$1a_Odo8  du(1w.(glϢttPcp8 d5j]%&6.Dtl]ji^OgA2Hhg5 FpRjH2kA:ciYW9Я H! $iE:j3?kggFUHκrۮT;uǸy;Xv);kdնվ]mPm.XwF?&Cܿ&]'8/Fְ7FM)lSEJrYdZi_z6خD {]&ζ Uoq51nō~l>S%]…&"|KoOjs~.endstream endobj 13 0 obj << /Type /Page /Parent 3 0 R /Contents 14 0 R /Resources 4 0 R >> endobj 14 0 obj << /Length 878 /Filter /FlateDecode >> stream xVKoA =`ƞ*@F8UBcc3iCvYs [>q-:F =Í MOw^ɠ1ų7r=>|'s]MzH^a:K.L 9Xg0Y@sV-n!fzl/ʉ#AV[8񧰺) (G+[Ѻ8b E9ue i؂nOhd4@#A`L`zȅ(f]Tjݧ ,`IJ{N~ ds\^ޝ~ÌȚ>_w_/o.s@m''taB7vTA3;@9$& W(8Z )Xd &&W:|Ћ KCj\IL)τKbg^D#F5ˀ91cPŬ;F!r+ YNj,y'4Y^rFtV@wD{FUEHn֕-+UmWߝ"mc/[ WleNZ Y`-8ć|*-`J8Us 2;/uY:Ƣn$9̥ OB9>Kp1uڨuYQv'@mWJWߝ_c܏;Xv);kdնվͺڠ\XIw/m?yE17ͼ1 nJMOa;Ȝ.\z"kmԺHΏ]Qvn'yemlPUnWVC>lݽK̬uoy-|^mn/dB.endstream endobj 15 0 obj << /Type /Page /Parent 3 0 R /Contents 16 0 R /Resources 4 0 R >> endobj 16 0 obj << /Length 995 /Filter /FlateDecode >> stream xVKoG >x2$yu0jbò+H~yF6vcH. |u8x- w*4^&k0>Wׄp% U~ (@k:FCnV'hLA? 4r`gM@#vi}\ 7 .Gϋ*'M v0a3u,er$,Ѱ+ʎI( ;d#FI@ ?4r89_1 N YŬ Yze$0I`ٷsmכz1vz3;4nrGߒIAN~ɩ&@E;$:b:+a]רM ۨjH ͺ2vzw7Ofd$MI*&T^uW2FNZIc>u% # }m\ +O˵/uCWcQ'ROB9>s1qڨMZYQv'R򀳮+Uݝ_꺣ߵgIc}zi_y+Z2qlecW T˾ u2Q!_Ld+N˸ѠխhQ;GpS2h{DTfQR\YKh6Eڗw~,躍*t;ABUvw7F?6)m GKDuoy^mx n>} O}-0`\PE^=-i1/:/XQl:ԕMGv.H55(dtŘlO|}G]d3MӜendstream endobj 17 0 obj << /Type /Page /Parent 3 0 R /Contents 18 0 R /Resources 4 0 R >> endobj 18 0 obj << /Length 897 /Filter /FlateDecode >> stream xVKoG >t2$yu0jbò+H~y쎬 ]q1E2/ೱ"3#O𲃿IAӛßۻk-ϻjX{BÄ ߧ-c4d& o Κg@@ c7aem)Kϟꫬ841HP5l7YIXѰ+bcGѤPS7FNF=pvXj hbd.*e5Z$oB.ڽϏ/`s{3;Xv~;'4~rGߊEAF.~ճCL`rQR(Hh!Ev0D=̈́Fᕶ&ń${ԝc]RQ^tl+rI,bTǾ4r1$ \s={&Qaԯφ쇽P{US]+u<%,@b]/9bۤ껠lͶ2Jw-f;潝nu*8t,5पՐ5±#=# *`eu% _..TnYȆAE^ 2>LHR&m :jIf}mT|Wt]"mRE]_cޗ#v>xu?F@6e:aV6&z@ +laٸ ^ϫ1>ye6i)4hRGTj̭LDsM/XmT|Wt[FŖhgE[^v[٤|qݫkD{nGm~ ;oendstream endobj 19 0 obj << /Type /Page /Parent 3 0 R /Contents 20 0 R /Resources 4 0 R >> endobj 20 0 obj << /Length 894 /Filter /FlateDecode >> stream xVKoA =0y^[RHHBiմ L 5pn؟=p7cz?gcD6΁Cg"G4aNrZ pO`˄p! UL5+[@h-4yk YA cgv!7˻K- Y}C eXğfz(dL.8m b6vM 8ucdmXg%K)42HAŽ9Ġ0`Hz8 U̺7χ*p LR:xT',.# ~^ 󶞜v9grߤ"O.'3Hh!Ev0D=لF&ń${ԓ]]9RQѸطCf>$Q2;r${$puGMP ;FQ.XYK,-p1- g)g||}Pg[rP\gy2L},YanmU}ΑVv[T]cwy˴َy/`0Ihr FpRjH2±t`Wd]9@ӎ ؆~p=/d*.d΢n/a悇C'$mԲhG-,ٶQwծBV[ߕ5v׼x`^ݏhHCFlgmfE~3U0@ h}ŏ/&ɓWˏABv.uMl=rdeoe*e27jY}ADǂnۨj7 omI[;.TnlǼM9n׸{tNP///W?o*7> endobj 22 0 obj << /Length 881 /Filter /FlateDecode >> stream xVKoI 19`ʮ5h)b #q@,$$AǮGwMWJLo .O;A8rl$ ;w*4<}&^'0Dp)TG`7[4{gF qh Мv1MKr{XI򰽛^R?E}G3lpas3).`lmDr|)ԕ&tAc6,5{$ h,@##A`L`zȅ(f]Tjݏ `IJg?\p{8\oo?ild`×8oɋ9AN~$шQ 2G|E%{Lzd1Qb~ ,3I]NOj,y'4YrFmtV@wDn"O$I7ˋJUwHvň+pFR'U ,C\ "1J ظ@Α`Մ~m\q 橃smKomΫ'V%:mԶHGM~gۨbJiyYWZnەw׸s;oe#{5?ֽ] ٲqmm6}VwFy?&dۿ&,%O^p_Ǎ&aE3o:RAS؏'22ZA-ҾcEmT]ۉ@.MmJ7ߍjc܊|ʧm{t N-v>›ݗ_En/endstream endobj 23 0 obj << /Type /Page /Parent 3 0 R /Contents 24 0 R /Resources 4 0 R >> endobj 24 0 obj << /Length 916 /Filter /FlateDecode >> stream xVKoG >d2$yu0`jbò+H~ydrr&?rp mgcD6΁Cg"G4yã Mwqon&k0>o)XgB*͡c4d4ykY,A9c Wzw$qzl U}& ;ʰ…vUlL.E9 VvM E9uedmgf R&@=4rس9\bEƿ|}>VH`bǥ .6ϻ'X]f#iK4?=ޭyNN>tΙnWI3;@9$&-U(/L !P 3 &('z(dDIׯvѕtЖrFri!II4bTþ rQ$q\c{&QbK|֊>4K *m= @{1" !OvޒI@ tW gQ"/1ۨjHIͺbRv-Ҧ;ƽ~P$1 Yk0IUC!h,c>K Ⱥ@Ӟ ؆~p=/ח.Tl]ȆoAE^hl.xO$Ӟs_Z%Y=6خDp bRUW>,ipȖͬhxLvA G’ ^ρ q1~򊀗sФ`KASmi[JGsY̍Zi_6خD]ζ Uoq51nE]=k\&"K*8=Rendstream endobj 25 0 obj << /Type /Page /Parent 3 0 R /Contents 26 0 R /Resources 4 0 R >> endobj 26 0 obj << /Length 898 /Filter /FlateDecode >> stream xVKoA =0y) 8@UHTIJ{vv3Y۳Oxu8xF׻.Ugϲ=_¥:T;u1zf&bc@Avք8T1-YMr;n^'mv[I 5s=tf%IIXËaW㋝EBqN3r2Xg gU B@5 yo Lb[4m &$5뢖-~?n1p<I-q=i8fGw[nPoɋ_IDAZx/ԳM)`f򾝥TԈ8HY E&K&({wp!h0Zo$4Nd%eI]dzI(0\6)F5`2M&#`9ԨCd" D/30J5\Vi5TJ><3|ݩ7j.r{t%\ԳTAW#W$^(2b)Dv Iőn5 1;{UDKÚ$!<~;q$IPw=~ְx}:H77E[.Ί{U<=gݞE݃8ˀŁ_i<ɯo?[*l$)OkT_mcJ&BWN@Ra༐Th K*?`dGPC vEzBz*v4Ҧ*͋WF}}TbuE8.Ro]E:C"c̆"`ZY=8{G7͏iendstream endobj 27 0 obj << /Type /Page /Parent 3 0 R /Contents 28 0 R /Resources 4 0 R >> endobj 28 0 obj << /Length 799 /Filter /FlateDecode >> stream xVMO1WukVBm%H= (  ;C@@ಛ}f< X;u w ^hu`3߰VlN.|ngkvzHR6 ox0:@ڲ+KvpӉrYC oc6al8&-ʯ8WV0Bl/ vθyɇW)tgIj.g1ie$ c|8]Cɿ듎=j^V=B$~ϧDU)C)cAes^ Rz׸ܣqZȔDp& 0Xxr[`a5FtJeT+^n: 킈;;Ŷ2^Z'i4;;uve+X`.<*J`(4 A8q<.>u8|`K l4]v~82-/ bO!`Y7vy9<|t4Z4bhzZ>a0Z] JB`L %! 0$A$ddBi$x%> endobj 30 0 obj << /Length 874 /Filter /FlateDecode >> stream xVKoA =0y^$h$ Z5-4><6fZ8d7ϞE8+1ೱ"3#OppBݻgbZ 9~O>¹&Tx=U(@m! GhLA? 4r`gM@# 1ZBIV_ I}& ;ʰ‰?|Ul?H\0 rx2s4r|hR(ʩ+#'l8=YjvOA Hl.1!!$uQ!6?ow*l&) |8u*r}{}{wV3Ƒ4}4.^\yNNH[Q;39`oReg$4̐; lBF@ JGoB=j&PEWA[93vl=҇$1a_Odo8  du(1w.(glϢttPcp8 d5j]%&6.Dtl]ji^OgA2Hhg5 FpRjH2kA:ciYW9Я H! $iE:j3?kggFUHκrۮT;uǸy;Xv);kdնվ]mPm.XwF?&Cܿ&]'8/Fְ7FM)lSEJrYdZi_z6خD {]&ζ Uoq51nō~l>S%]…&"|KoOjs~.endstream endobj 31 0 obj << /Type /Page /Parent 3 0 R /Contents 32 0 R /Resources 4 0 R >> endobj 32 0 obj << /Length 823 /Filter /FlateDecode >> stream xVMO1W̡r׮WP[ h"q@P@P 3@!yf3p rtv^3X׷#B`<ԟ|-FNvVBN/ H[fz7p @)04G_Bⅎ'U+/O,"RQFh~d(uFJuPHQe_O&t%1`Ո3?x./,B]M&7gȺ1w5;dLD5˜({5%MoQá~[2ckEMY2ȪߵvO1aziPi:z>FM0&vM`Z'T8;[Wc4OF0b%mb+U3j*턈͹wcbg{pklMBL41GY&03YeÊLGz]lC\_ .Ԅ|xQpq` nŗY[ 5{&mqony\Ĭ75J5Obh{j9e갆] քP/"?B`X\ք2!^0V~L}ͮ\}l,llhEcF;wn˪~ V6dCgwØ=N6 hH=Lizj[bCʖ`MQ{> endobj 34 0 obj << /Length 900 /Filter /FlateDecode >> stream xVKoA C{RHH#LԖCvYS ܂ xFcA=հY7JBÛ'lPyz ?@T~%4$/a]& .Dv*$; T`I@uN5q;v޼R|uyC蝄PGXbxȶ@Y=[#쟭lrhXG#sTI@%;=NO ˅J5>A6ſ]]oU`ހ3XGv5^_^oi.|uy[FHkQi脮mȓfg3iBf>$ H$8<*,2 U@+*Z/vtHrHh|1<0/}}2lu*b%=E' ƘvL"zn ], fNS1}؝8JrYԘctKLӭTۉ$i&]bqgPv5Ҫ='otZp,k!y0RUWkevׂa$ϧLNgO@\6IqC׎ۂٿɘOIctL|lRc)Sg'JeEHMr.T.ty:oR/wVϖV~66A3`Iw+Ps`.9~ yܤSX^MLKp+Z DTvQԹw1/ZJY7ϸhʶt=NW&N3UʯqU>OGntyz6#wjf9Ko$+\7?/dDwendstream endobj 35 0 obj << /Type /Page /Parent 3 0 R /Contents 36 0 R /Resources 4 0 R >> endobj 36 0 obj << /Length 809 /Filter /FlateDecode >> stream xVMOA ϯ^Am%VAIѿ_3k> l67k;N ܫSn&@:6G;9f[etru;[3`}Ci}ˆ1Җ^5\r &0ƀN*]9 (,^LU  E#"%|`4Z|[yA X:drI"1ʾN]ZJxse1ioW~\^_YUn/ޅ@OθW)\Ks$5dLD5˜({5Q>]tQ#~b#dM7Uu2ߵAX'Ƙ|+xK0ucp^ȔDۮ,8k zE|}4FtJQ[˨hxm1$ "6߹.u$&AldIގe̅'W fK!GS.?C^:\>K M4]vp82-o fO!`[7vy9#7%@v{$=N} So =xߧy=Iy4l1P#~`{Y$wK}z5ih \a?W[agqSRendstream endobj 37 0 obj << /Type /Page /Parent 3 0 R /Contents 38 0 R /Resources 4 0 R >> endobj 38 0 obj << /Length 886 /Filter /FlateDecode >> stream xVKoA ==VTRI$Zj =ͤYYg\5< W. Z , &: +"4m?=ŠP)sqO?/@pɿDװ! nq";* ЇI@uΗ5q;vh.{>|U% ,7pNay=^fRcV6&Y9lurld"ZU5{"PI;Jv{6'@@t i%A +oW_*0o@3Lb|'z{<3AKh~oP?o ZL FDA <{|Jrqu3(`#Dϟ d\uFaOF`JR|1ԴO^m*5f$n|v*t;$[,l.FZuf#.H,Wjݵ` SnV6'P'XU] 0ghF|7mKoMxQXć)w~:"SV9:Ԙ$?tvҭT] Ӥ-7;ۅ*w㗸n7<ҁZ睘^/rgl޸Ҷö[T> É[x<"jӾ&Kv ?IZ jeB_\AR'<νKyՂVj.CEӭT] Ct4q"]}W~q ncON&v(~5W#o\͗T,T|gs5 =Dendstream endobj 39 0 obj << /Type /Page /Parent 3 0 R /Contents 40 0 R /Resources 4 0 R >> endobj 40 0 obj << /Length 891 /Filter /FlateDecode >> stream xVKoA ==VTRI$Zj =ͤYYg\5< W. Z , &: +"4m?=ŠP)sqO?/@pɿDװ! nq";* ЇI@uΗ5q;vh.{>|U% ,7pNay=^fRcV6&Y9lurld"ZU5{"PI;Jv{6'@@t i%A +oW_*0o@3Lb|'z{<3AKh~oP?o ZL FNu;t^ۡ\‹ո^m*Wq5_R|R-V_oǯ g= endstream endobj 41 0 obj << /Type /Page /Parent 3 0 R /Contents 42 0 R /Resources 4 0 R >> endobj 42 0 obj << /Length 911 /Filter /FlateDecode >> stream xVKoA =`k+@ ‖ЦjZh籙4ԔC6Y ' . Z , &: +"4~~wAR #@|?aSZC,Dv)$7 T0V@%; 1-kv&x;~l˟HU'0xۣN;fm?KY[?Z٘fpʱ)hUL;2@%= h~* ٜ\t}]].`Ŀ]=mU`ހfĸ3'z?ˋ3AKh8fEmg¶W\gle?L c,Hľ8b\UD*'$ds:r9{~"md0>1}vy:e0ߡgP$;F?ȸ.r fNb,iv'$bӉFUjIt+UlgvIIX.T]|7~qˇe1Ơ9yi6"2 QrU}!] }>hes8{U۵sƁfd00w^{fЄu^H|r.2e JY:H?Ig'JeEp=Mr]"]|7~qGLNw ty'K6Y=7mƖpֵ;(Oڴ 咝G'8F6FЗ&WP6 )sR^d˽oqt+mz7;]-MlgHWߕ_㪺}܂ =!endstream endobj 43 0 obj << /Type /Page /Parent 3 0 R /Contents 44 0 R /Resources 4 0 R >> endobj 44 0 obj << /Length 760 /Filter /FlateDecode >> stream xVMO1W1jkVJ4z@4A c;Dro>{X;xTWݠMulсVwK|,v"nqR΀A 6ʦA H[Wz\01svU9:oOe`xe3T.h3j:kK<!lVI$k97 u: >B "FEb0.S=)g :86c"4! n/ޅ@_θyɇ9wn2&MDaL)O:Pox]&~:RTU-C1r8/oƵ{ NB3ҋr4˜('5SZ+68p[Oc(N4ڊXFEؼX.؜s]+^YŇ&ޠٛ~hiM/Ӏ5'YhPq|$!7F#:B &ڀ$L:^ ip0X&6LJ>#7%GvI~|v{ߑݧO =xSOcv%x<* 8> endobj 46 0 obj << /Length 4357 /Filter /FlateDecode >> stream xZM&ő?pvWfkw%$[5 dfe}GdxSUYٝϯt}sWcWdwKk\?|u^y~:ⷿǯ5_|畮7 ^[n< &-xNv?}OxLuM`.'<'z  jgMmOxLN;|f^/ѽt%_,fXuכw'vO7߼]''/w?㗗_ti0rU݊_^ӵ*. ݍgD;xmn r˘ 01G\8&[8}&CJ߿ˇl}?O/'_~yLp{5}oׂN{2F\;":h6GU[ժ %cI]ϝv|u,Mݡy1*hSTT> DŇSg&poH;xk5Ձyl`Gץr;ę=bJ0zw\iD-Ÿ܂xb<ݖ/>&sgޯ-z;x/L24xlF?5w-^q ;8.n/߾zN90yyB+%hv[k<IqB4eubQqC声fJ?||Y fœ@u^դ6tCÚpCqz1 N9s9r͹rx`*Lxn>a(FcGtom_@zM8'7zf/0,!!S G@:EPAVf2C(nj 6<o<nvYx.L-r훸pR{dz(xVd7hD\=<}D N1l 0ڈHG2@G2Ҧ3 FpsQ=d5`P큠n2 -v0B`$C'q!ѤA`O6ڙ F@h|Ff,xBDt00<_ؠ_OmEq_ǸN #oY\cv\bPEEA=5= "xao`kGyA;AkGz##q}T39/_Y\o͞Lӏ{+Y38[>QY}D~o=ymvc]so_LZO@js0;`. &1weԓ&1k1BjJu̘$'d$Xe`}93sRu5q}NQcJ&-{zU# ßzG/E6 `?qQ$DA`'=/GN.? ぉ"xEɎߊW>3Yh?3޹Pݓ٤|l;|TZ|LL0,'_ 1LhXC}I03OEcbk5k&w*+1ش'ub|DG3_#)m;b՝sRZYηބ؛D#_יωvy>S'z 7#<޶^A?.=N?tɶޢS( ^Su?حXCFI"n\N=ӣ|S=@^zȢvMwS#PS;2z;O,^G`z|N=>0UhzE~;l'VAs埠g|v5D|?ʿKrƄEWAs{p^;3˿ s\}@1;=c]s[)>6=1݁Y=&pgУL]^A{lm]{*'܇w\U=xa;41{3\qr ߟ'e33(J.ĚtCJ‡t֫%pr!SA?T̓ V Atbr(ULAaa*[yxԴ|D<,&y)ϑf94H6~(OQ)%˼GٛL!'ev{Gcx֟׼hO/u˛S$fzDZzO^ǂbr,/~}P<_e˷) =/eAq&d1j!WeQ=oE"P>eG= CdÊ-F !TmEQַ(o]N GQ&Q1u;ˏm`ڣLy"1~ wJO/ gk ަMV Vȯ_:T 2zU':1Ũ/ ž qLZ_,=CVd|Uo?KeEƍ] $938O/aWšO\«@z8Zo,XگQ>ʶ1bB/{3,y_ywi ϛ`򗱑O<׶Ȍ4 gbߍ/+ҎoǬxO&{W˺<(W':"xA2oa7aGn2-1wF;e|koo1?b?xQ{|r O }+_ߑϸ~;̇?ۿ3_^ȧF Yvۑy,fyl{jC/П\5=&[o8#}Wb ;/x)珺i1Iӭ_s;#ȡ(/^?&Xz҉niNYz7:Sw葟z^zKwח[/wozzyxxw[ןQT^>Y>Yk)?Wymx,Qה^<;*ȿNN X@o}Gvv w.9zt%g{-c]s,^<"endstream endobj 47 0 obj << /Type /Page /Parent 3 0 R /Contents 48 0 R /Resources 4 0 R >> endobj 48 0 obj << /Length 4300 /Filter /FlateDecode >> stream xZO1KXdKmkDBI$bKY F9Ul|]]uT+^_?=|ytqZE.rtϯ]87!\O?~mW__C"\'P@TĻ/x(r< m pxqW F%Yʝ0=`N; nKNt7cЗ(P7z'cc\8[8}&@F<7߼o !z|/^\<?ӯg_d%`}ZI{/Q'{ 6W:y/$BqȪ'$7Ǖ}^#&EJ1:_*pv BOjt?%I1QDž׻iMd^zݮA%09X/JDZacvб _@j?-ぇb=۱zqzWtp^imS/y>or0׻E?1tW`,VL\$?x&x,?+^A;Qf3ދfW/@Ē>7Eu#`,d2g n;>,7_ŧNV| g>]| ,'Л)ڑ;_MT;B= #M;Ck|?W,z;3|tc`GBQ|^LϬ|N=pK/ơ'Gz`ꓥg;4̩[/?O=E=VQzYz ^\zN=rIk:&yz5F;*0ҳ8HһE[/OKOcKn%6K 򢤲d>4".v *4V!׬`d֙P2V9(-=ΪϿʊ8Y t/g=*s^Gމtn=܊ln_u$|{%H$ _w$IbҍI(hLN\(VnK$G`KcZ0^0 &a$MLY%MK~FtL#i [o$zvƓ&- AٳB&AMB"$hبIU2LWVZITqy>@ Ϸ8k q{iJt{oA:!h*z0N{}A<>/8v:㼻6ն?tmmZdnڴuaHr=kSe3Ic{עfO<7OxcuwcWCxZtxfu؎xD1&`!|.#$B6_8 'ד8ɗzӡ[.| /tχC; U;_ Qs+3?|܎|ăG"3zu AL#?@KP]o=CǮޡC?mD;5z ǺݥXz5_m=G?".P-=)GVԣ$uKvֶmVt.۬p'穧ɯMq|uY,Tz]ugv=TOza՟55SUU o7(W?dz~ʠ(NzMD[GTHCih(oK6dk{C˿ iMդxC̞ U%ĉtFZEsgpg5rsb&T1_K'NBKF,NLᚻj#tf(=4Ú#XI{=(3!]zWn.Viĝy.M #{M ;knn:J2 htDU8(=ó6ݛUѫU^e$Noz k3LUڷWQe|av ԾELٰ?FStM3|JK-}3;{~{Yϗ{O1;!C1˗,?B*FQ^l=z?-2ңcQ:Ús4@}a睋l<(o<ֳ|u^<9ުzb}@9n?1KN;b]\հUڷj; U˘ G2aM|lNym=˓ "a/~T㋦gmNFqgD&L~Yfi=r>1E'Z $NU^rcL>A W7؟O/Ub')9_t%BHt>cJ]+f c'F`&yBG{=eW7~$jyW~_A X⍱m{W5,y_y)ʳy.'o(foa?=1]"x>ϊϛ$Iu7In#:URYXG(y=vd-_I<"/OEa[m->XlL&f>|.Ԥi;ߙ/7c+]ߑϸ~9lC/i~S;<mOzy\Xz@ 'Uͮ'JXf;S0^{Kw㩧?[$ꧩH$,^#CϑlGI Mԋ]QzS3w=*,֫|g/^rMnTo=ެ\zF7]M)@S}{뉪/Ͽ e WNyWEXɭǔZ~%_[G%-ѣX׵]ushXv{hknG6Zs,Q|+WWPpp)gO=/]|?XIendstream endobj 49 0 obj << /Type /Page /Parent 3 0 R /Contents 50 0 R /Resources 4 0 R >> endobj 50 0 obj << /Length 4412 /Filter /FlateDecode >> stream xZM?bp23uH(Dp@#lMOU|F33=սOx}wzUU/ztIwN׫g??gp>;~/p}'GoB xTE>̈́x YDŽ0Pׄ {sB=1A4) z{>~ ~?'ݓOWLO?E#oUz=yqw~z'v?tuĞpx|<ޚ/>&x3Wb gkăk7>^-( M>+Ǔ̚\W}<݅}gI h߉F90ZyB+Eh6[K<QpB4uddVFa'M~lY fœQAu^DVtOʠb9qAqr1 9s9 r͹Qrx`,mxnI|Q88%|9q'7zf/0,!"cuG@:%+cd?Q$lBo@h1`eD0#8Xe0BM0E'c,PT^# 9!࡚mg!8O"Aq6B6ڙ F@hFfHXVƅ$uL30(nSl 7k7NQc|5C=zUX{?T~`m{AzZu^*y3wr?H/ue^Cd'fڋyuuڛ|?lۢ+ṅAKߊNEr(hpK`u)" X*TdK+/⃣S2O(8RwVpv*u)Z8g)lķ1 3 5`,[nݰ%X̒قz l6\2.x(J5vŢYI$o*TXD.(+.qeb]m]_Y\o͞Lӏ+Yӗ8S>QY}Dvo=I0m==ǺƵ纟>>͵^Qb/GH\ A8RKtBE ' WShe$D*F5 W:[cF .W'$5I:a-[I`3^X-i!)t[/M-it[/MQ6;<;d%-  x$p<$heI`Ժ=8mټd"IH.J"%!2"EU/Ez8Vm`)[dq&v]bqqS.2E16m?E % we^6L?SOTwyS쓤z"n)jqOѲݤa^Oj^ppv&! 'A<?E t`LLdKa7{B<4CV!V.$!WhBfq+ROb%+pd1'1Q!a20HOp8OP7㓟HU?p>jS'G$^dZbF'5HZ\w'[^Tpɏ0ܟȟ/2OL͸T/ׁ@tgux1PMc{~5x<Zⱞf ~X]c ^ײGj~Ӟwjcj(ٍ?y%н D߀{9_.ȶ{ x`Gcc;xa=[Q[&x$όw.Eb6)&_ێ7G4 WlBL>$.;3P7 &_&`ɷ^|LL{M2M>hBe:63_wD|Ch~+z3aۺ|G,!q;_W++xؚ0#[hk>:9\?g☶^y'h/k AƶϧWx~ЏKSĭOhQޢSu/ ^Su;حXCzI"n\N=a|S=@^zȢvfMwS#Pc;2z;O,^G`z|N=>0UTozE~;l'VA{_Bn._j~h 2k2zjhx^v0˿ s\}oG>۟=}]so[ >mzb[>{LΠ4qvw[v둳'6w)[R1݅: OF1{BO/wqbg l/'a3:V/ϊ.Ět'K`;/,W'ʅ^OgK'xH'os+X%8{ss9=hȡ^T1=8ݲqlq&YSbuxqS!lf#rh4$[3lT^ѣKYR5]Nd{lmd_tOT X֟WhOֱ/uɛS$fzDZZO^Gbr,&y,o= =ןʖܟ>ұMfIO;c6U]i_Fy 7q('x^6y- 6^6P|.SyrB;]D)fXۖ Ų/J69;'Eؚ G2,?i2 DuD|Q-/K 8_T+_ak }o&I+ub iǯtr{|Q*TD!;b)_0hwJW2X&_tn\ٵ0읬O/O4>c*V52|b^u?OYF(kZkJ=^r}ٓ7a;σ:ϋ>Oe}H,h폊@fLa?|Yw7F>l}G>wۯ3rl|I{#*%dnG>yUts/˳5WWKzdy n=އYzo,aP?M2K/1ޙ2[oH#4z=Gca=M:rE 1ғFDuMvң:љzxCһݿP^zz[{ӭ딥ǫszJϏ޷oNzQO+o|X WNj`{w) ;*ȾF 7_@OmEvv d.{t%{ =ǺƵY?AXW߱w?Kٿ볗{>ox~O>Xendstream endobj 51 0 obj << /Type /Page /Parent 3 0 R /Contents 52 0 R /Resources 4 0 R >> endobj 52 0 obj << /Length 4399 /Filter /FlateDecode >> stream xZ O1K{/2P$UTĮXPllB^?H VKGGWW~~~Uj$ҕ[K|ToA#r>]O'Na?9׻W> ʦ%'-#8<sccnb id_~zo|W*ףo޾x˟Uc՛BW7nRaw ,Nb0i8ը݇CQR FF[Wc`k۱ xy=v`]p@Mq11n׮{'9.̐e0?fl`=щ':ƍ08.ޝ/Hۘ7y[tpc5*1ii^BJ0c0b|?-ぇz<8c=\/0 دm"Dڶ(_n{y^$})}`w(o/?Bc˟Y,13K; I~\LXXV#Qf3ދfW/@Ē>7Eu#`,d2g n;>,7_ŧNV| g>]| ,'Л)ڑ;_MT;B= ۑϊ&ڝv>ăȟ+_=ȝOV{:1#_c(v>/gVFx^Ek `#x= 03ErCE蟧z(o=VL,R/.='v~KӞK|ҋG9$5z<=z|Y$y]`âmqЌ%Ep%I} yQRY2Tw@jDkV^$Z`Ru•_f(мiAo?Y\oj,SDGt`9#=w"h[syoEvo_ushsFIg"c$7]hTf}'R ChW]bRtD(JEJS"56ؒbX0̃ժ&HX9n&RKBh*FtL# [ovSR{Ɠ2 ڳQEFMMҠԙhبVC5VLb+zuԞt4uIaT֦T*LdPdLi eMK$J?JaTI/8R&1\,nI/baKPʙ?JbIDܶtҲ0?SQ'ǔ?Sj,'!̟D)!G䰄x0b?=?Q~< pt#Ȍ,,!ߘ?1ua=Cܟ(yTa.L~d҂:#?!3O~-s$A2Rwm9&'J)3BO7S1OɨGp r~Os&ȏx0FdV2x2qRqp~2{cyxPǑw1a5<`^OS~X3c)iRz۫gfio{:ϣk 8ﮭ][q_۟u]G$\j@޵xc/#XՐ;^";Y3#y~_P)ƃO> v![&h|œɇHK`?thO`- >_ۻCjߝ/ߕOVnG>A#_3zu WL#?[CKPso=CǮޡC?mD;5z ǺݥXz5_m=ȞH?".P-=)GkVԣ$zKvᶞmV.۬ճpV'穧ɯMq|u'Y,Tz]lv=TOz1kBd)ք`n3Yebowebxew#]Yy|KSBެ{E/ /Qyv9QhKtLG7PrsY_r7NTކl={^u͹纭(8:?_V¨E9;#Fڦ'PK) 7;tC2qDqb-h,mќ8N} k<5UhW݉Ф|؋)gnjbM PdS4a\}̤a}5pT=I-7KAk7lOU&د l$CR}D%knJ=  h$IF9(ió6ݛU4ѫUte/Nz kLڷ%]geaԾELٰ%EF7" gÕ$Z4R%g0v[0*EKc 8V?C)&%b5#Y?!00Uԍ\[$ff$MKҢ$O)5;k "6M09y<MJ^#yPNќyrb"D×n]A& -*:au[Ek)o&'E=j1etÚ6nk.Zr ZD㋦:7``1@G'B`ĉq\*Kb0Jo?8_ kiORrJ>|ǔԝ/6]$GKEO\› =p#p^X_ :Ҳ1bًc$pX "Sm\8/Ob+,#fQ>Q}AJ 1,&fbF |$/447IoފGuƫjEdz;ynqd :'b,l|$(yivd-jIG"/OEa[m .>G[lL&f>|.Ԥi/uޟMc+]ߑϸ~9ǢmCM/i~S;<mZzy\{cz@ 'Uͮ'JXwf;S0^{Kw㩧?[$ꧩH$,^#CϑlGI ԋQzS_w=*,֫|o/^"MnTo=ެ\z目ߟz$D_gQߏ0Ck+$? ˮŠFk[-O) P̎J 7[g:Z#`]&šHmbEֽh}Y4<7LI篿G__?y7G?'eendstream endobj 53 0 obj << /Type /Page /Parent 3 0 R /Contents 54 0 R /Resources 4 0 R >> endobj 54 0 obj << /Length 4432 /Filter /FlateDecode >> stream xZI'?EDj;A$@rpr0&^,_?U$؇YjD"镮_~}q?z5U/Mz|IKw7o9\幟ο?k+׿_>\yIקK/[MAF '}|r}/_wo?LZjۿ~헯ׂNE@uBUbsEn"DG4Z!r-7*`gf|d0ɿkg[ j7]DV6Vki ccߓ%7W&+?Մa0D%Gl$HJ?+鏠' %K- &LDg~Ih t'PہO/,3dZL>fIEz3$ba >9' <(?rK3LR`F1?:5y߃/Lq~^2#q=hyσ_W6c GϤx'.{>~:,X\Z i?~y|޲E{A<Ԉ|( MX\/$v߀G5 l*x3.\x@"RlOqp9D#^Ϩt/hߔfuO>9z_z-[>V`mk=>qYX:?|̇wK`ꋕO9ηHG>3_cc5==M,=P`^yCOzH1zXm=LZzkC4zPz b-p> ơ +'qE`˥'ЛvQ$ҫA="Vhf*%]\e:g݊N~JMi_rf)LAtR&"/1k=qxNdsK6Z6sdzz+=68gH:#۾aB2D;#<83C٩Ũ-/)prm>cWS['o5ujlp&QZ TF2_ -R:5f2 Li]*j"U"5ZjbLítC53yZdd^֋xDcSLY' ySW#P؎ _F T c'°*p'gb'J{^o^Gu0g";s`,|odG/P~Y xO7b/=;; yȋMf~7^nİ⻅|0׷ѥaLw`ɊNG ǎ| /V<W9╉Hx;Xz/|o 6s?qD|H!/$} 1|KÓO&Aky'&NAU2q;_'Ė_"1h|1[I3 7̇ә/h,<~s[_ub99l=ACoh|S/y3OcQ=4TZzi!~z ҩp^CP.=ǁ{yAR;bzVқ9(ZSbbB%zsC/wo-= [oV$nO=̑ZV 7fz2Y"˰&Ds+ø++Ӽ 8+ ~NQwJB(\+;j Xb6*u}XtE 9v *=#Ϟ}]s^v_E.LV#+ھe$/œFn A6޿w/tBL5i?3VϪV+9;y8Փ0 7Z![?Im a  #nlFhn9%aߛ"fEٱ2F:|L,7'lI~(I;nN9 yxIU2i8 _$dmEf?Y@&]&bSOj]¢()Ip5$j$"jLjއaLam"CU_J.-؋ҖT%އX@mJǏOv́M("f, =)EF51E҈~+gFanP1b^|>QO7HE#U`g\|X͇KF|D[aJ56_kje91`BV> >o;#0V>W#q,fґ/Oit[eS<|``kW>9ϓza{?Glqom ';zE)=&qƛ5 ߥo=eQ2I[8k$~4w=I=}{zPX>>"H=}o>&%Q{WEpzV|i3.q>0bE#ާO= G֥Uo[{zK盽?zիhL\YO4( Q21r ˿vˮdEcc O9)XPX/}@}K F[DX}tR^6ښ;g뱮\7?~!K|?"ְ9t@?߿͛o]o|G'euendstream endobj 55 0 obj << /Type /Page /Parent 3 0 R /Contents 56 0 R /Resources 4 0 R >> endobj 56 0 obj << /Length 1056 /Filter /FlateDecode >> stream xWM7 ϯqs(\mrr(I]$%ER8q,HJh#|ϐt )A qsWp?=px0p?ՀBt3&"*>u\2LX;6pw)` 8x;93~5X1WN UfM(%J>`u)`S(.3r }1X1M*+  )1>uL{Ȓ7s&=n*/.XyÑ 6Z]KIbt9aHfp bX45X(Wk79[pT&R4tҞЂ9xtK__P~j 5n>Lc,%bXJ;l+ cuUm 512h74bn~KEP管͹Ⱥ*&"d@=6%7xeYX, aH;A@P08&a!!=24mܒΝwm}9llr*1%ts3.O6NkYMHLr8Y 3endstream endobj 57 0 obj << /Type /Page /Parent 3 0 R /Contents 58 0 R /Resources 4 0 R >> endobj 58 0 obj << /Length 5562 /Filter /FlateDecode >> stream x[ͯ'qwɫ 'qZ-h82?UCATo8Ï.6Wz}^}u5U뫦z*#]-_߳ۯ׿WvᏯ }/oX_-k:q_k?wx4療ãAihc|KXXw_R`?_c]}x}q۷߾ӧֻw?5/Z{/גl/x9|۝jaW9ͳãA+  >1csm۟j~+inO 5 1%lUvq4}WZ݄S0%Sk J^Wɂe]M+VR;#6]#`ĒW_F/7lxC 'Xon Pr7uKWsrAL$J-\% \0鐍NG㥔'HŲ;Ċb~A֮dS@$\t>71WeV"2 gļq ̠XXÅ3|g:2 Ӫ97v;sWoBA ]ý!N-4nOV~ J-4# %[hx4Z!@L l)bozEDo`!pFngyxd|`pW`%9y!eְ!0,HLXapz 2\ +M_ՈL%p%N+ēX$/r6Ʋ-\a[ 7v\Ӣ Ò5'bG&Ý橹Zc"[cj5t xG K 00/>T1~fg=@3`ʽ^\O >/n{/m{Q7+ޏh۟#AuעDGy䗎x/`CdO$xƃO(G[X*>֝7w՚QxмlIc+fC>57gCj={l+-Vpzȧ=v |{ֽ0䔟ڛp뒲!nJ5 v>o꥿-9WBF(Xoah0{GS&mo[kg\0 Yk۟HݏO~z{)S#nSt)S~`B0LC\Y0=$н“NJF>JĐ 5Dnό8'OU gi|(ևX(χcJ&%ҥ-ߒ %ՄS h>{K l@.xj=5U8!#|q'ϰ97X8#nٍ ]qX:a=L!eOL;o. W~8}O\5>_.fk>q+LZ:Jr8'1nV+yM0/Xw_N8#,e|]NB@k?DWFX/5{b=IwHwnOEj-="[W扌t:ۗP;>/.)\2D. Pnc{ID`iȅݿItD G`#G//, \ñ7_t$YjݎYY㷰2{!+|u6{T+yD܆;0}"k3O'C*Lw==ȘΧϫٓX0A&|>L^y9\e_dy-ގwgΫ͞<F9qge{',0P1,̲3,ݾx@gYlgi`$m/iOqڛupdU?eHr91kᶿr!3ϮGd%OYo EDh;ALOCΩ}Am(O@\o@\ׇ@\_1|Q/9}mr"&7_k!s.>C~#pY|AC 74,= O|EHG>iԑHCb?%<)1%-q;OkX{:b?G X} W;S[=& HwGymD=E‹ޢcP4z1zsp9փEح(r,~z_[f鳭gB[ҡʡ[/gsfmz;ܸ8CQg=Gz|Y@?OsAC&j ;̷ڵma adC4^ӟciHVx׶m!}\9T`cUՙ,8{H%+o^*0No'][ӶgpW8ӫ*uыJâatW߷WbGP(V&O'fR#w}1pܽn:E\l;Ւr*;s~Nfs ^}}8_lbR fKgX.T3{0=lŒ[&_nL,cl;t5Mb.kͪk/%rx/)Hn%}et=UMt21^&U}$fhf ^~ZA||z^ ;T4gst?B&/?eq" Qve<]Όa &O_n?oU(êNOgX/gns^gjT,=O+B7Ki_]=©_?\~X/xp[|ӄtHi ?u1LJ![]'%Q_vt>vz-~cy3-~u,ӠjO$_hO,yg?q'Knfɳ=x|G\!rS%;Sb[-'|\|{|Mî=|O{g;_^9SGr*y3w'"_N)Ig||M|m{lGgo^ '!Govd>^ɺLVy~ܬzc륬Ӫ0_/*l=YzMǞy9/ G{pzG//VzҏaI(sbuGzVUޥ$01'}ibGo eutyz_|V~~a|a?`A?9Sۿ@Yk*K%,׫ozܱlS|ޫ0^wcr!U=?&b, ,=܋gBVVkՒgM _!+IɹIyphϾ] DC  eP))ˋ["$swr #'>Ι^(8D%^e~m>^,SI&ww b 8oĝL9vi`8fRJjۼ(f#"iɐ9G.8,8C7?84\8G{rN݌p*Sv&m*\=O@ qcO2fk5\C^8'ƃT֥=Ȕ̞=8+JN-5DyƁY$0vךi;,'t3s!t3,Nna1y(Y-}d%VbZha ^ <|UѼxkQkGuMUiXZ}ֻڑcZ}UA'JnZT+e%tjǟjU|VZn?Ld}!x"&xUW/x$zD#+NL>&f~ vsb9=OanaOBD?vhy+<gNuC#kK+?|Kg~|`>|a|E>g|#Z^zz]^[O{7̏GYBz1z.1zCoU[Gqk9Ο ?,"[z$A){GiOGUڛ=KB#N72 R^BNB|$N04m^?X]hgw9~&:Uw?I\p q#ƿP2: }\G&Z@ȸendstream endobj 59 0 obj << /Type /Page /Parent 3 0 R /Contents 60 0 R /Resources 4 0 R >> endobj 60 0 obj << /Length 1056 /Filter /FlateDecode >> stream xWM7 ϯqs(\mrr(I]$%ER8q,HJh#|ϐt )A qsWp?=px0p?ՀBt3&"*>u\2LX;6pw)` 8x;93~5X1WN UfM(%J>`u)`S(.3r }1X1M*+  )1>uL{Ȓ7s&=n*/.XyÑ 6Z]KIbt9aHfp bX45X(Wk79[pT&R4tҞЂ9xtK__P~j 5n>Lc,%bXJ;l+ cuUm 512h74bn~KEP管͹Ⱥ*&"d@=6%7xeYX, aH;A@P08&a!!=24mܒΝwm}9llr*1%ts3.O6NkYMHLr8Y 3endstream endobj 61 0 obj << /Type /Page /Parent 3 0 R /Contents 62 0 R /Resources 4 0 R >> endobj 62 0 obj << /Length 5562 /Filter /FlateDecode >> stream x[ͯ'qwɫ 'qZ-h82?UCATo8Ï.6Wz}^}u5U뫦z*#]-_߳ۯ׿WvᏯ }/oX_-k:q_k?wx4療ãAihc|KXXw_R`?_c]}x}q۷߾ӧֻw?5/Z{/גl/x9|۝jaW9ͳãA+  >1csm۟j~+inO 5 1%lUvq4}WZ݄S0%Sk J^Wɂe]M+VR;#6]#`ĒW_F/7lxC 'Xon Pr7uKWsrAL$J-\% \0鐍NG㥔'HŲ;Ċb~A֮dS@$\t>71WeV"2 gļq ̠XXÅ3|g:2 Ӫ97v;sWoBA ]ý!N-4nOV~ J-4# %[hx4Z!@L l)bozEDo`!pFngyxd|`pW`%9y!eְ!0,HLXapz 2\ +M_ՈL%p%N+ēX$/r6Ʋ-\a[ 7v\Ӣ Ò5'bG&Ý橹Zc"[cj5t xG K 00/>T1~fg=@3`ʽ^\O >/n{/m{Q7+ޏh۟#AuעDGy䗎x/`CdO$xƃO(G[X*>֝7w՚QxмlIc+fC>57gCj={l+-Vpzȧ=v |{ֽ0䔟ڛp뒲!nJ5 v>o꥿-9WBF(Xoah0{GS&mo[kg\0 Yk۟HݏO~z{)S#nSt)S~`B0LC\Y0=$н“NJF>JĐ 5Dnό8'OU gi|(ևX(χcJ&%ҥ-ߒ %ՄS h>{K l@.xj=5U8!#|q'ϰ97X8#nٍ ]qX:a=L!eOL;o. W~8}O\5>_.fk>q+LZ:Jr8'1nV+yM0/Xw_N8#,e|]NB@k?DWFX/5{b=IwHwnOEj-="[W扌t:ۗP;>/.)\2D. Pnc{ID`iȅݿItD G`#G//, \ñ7_t$YjݎYY㷰2{!+|u6{T+yD܆;0}"k3O'C*Lw==ȘΧϫٓX0A&|>L^y9\e_dy-ގwgΫ͞<F9qge{',0P1,̲3,ݾx@gYlgi`$m/iOqڛupdU?eHr91kᶿr!3ϮGd%OYo EDh;ALOCΩ}Am(O@\o@\ׇ@\_1|Q/9}mr"&7_k!s.>C~#pY|AC 74,= O|EHG>iԑHCb?%<)1%-q;OkX{:b?G X} W;S[=& HwGymD=E‹ޢcP4z1zsp9փEح(r,~z_[f鳭gB[ҡʡ[/gsfmz;ܸ8CQg=Gz|Y@?OsAC&j ;̷ڵma adC4^ӟciHVx׶m!}\9T`cUՙ,8{H%+o^*0No'][ӶgpW8ӫ*uыJâatW߷WbGP(V&O'fR#w}1pܽn:E\l;Ւr*;s~Nfs ^}}8_lbR fKgX.T3{0=lŒ[&_nL,cl;t5Mb.kͪk/%rx/)Hn%}et=UMt21^&U}$fhf ^~ZA||z^ ;T4gst?B&/?eq" Qve<]Όa &O_n?oU(êNOgX/gns^gjT,=O+B7Ki_]=©_?\~X/xp[|ӄtHi ?u1LJ![]'%Q_vt>vz-~cy3-~u,ӠjO$_hO,yg?q'Knfɳ=x|G\!rS%;Sb[-'|\|{|Mî=|O{g;_^9SGr*y3w'"_N)Ig||M|m{lGgo^ '!Govd>^ɺLVy~ܬzc륬Ӫ0_/*l=YzMǞy9/ G{pzG//VzҏaI(sbuGzVUޥ$01'}ibGo eutyz_|V~~a|a?`A?9Sۿ@Yk*K%,׫ozܱlS|ޫ0^wcr!U=?&b, ,=܋gBVVkՒgM _!+IɹIyphϾ] DC  eP))ˋ["$swr #'>Ι^(8D%^e~m>^,SI&ww b 8oĝL9vi`8fRJjۼ(f#"iɐ9G.8,8C7?84\8G{rN݌p*Sv&m*\=O@ qcO2fk5\C^8'ƃT֥=Ȕ̞=8+JN-5DyƁY$0vךi;,'t3s!t3,Nna1y(Y-}d%VbZha ^ <|UѼxkQkGuMUiXZ}ֻڑcZ}UA'JnZT+e%tjǟjU|VZn?Ld}!x"&xUW/x$zD#+NL>&f~ vsb9=OanaOBD?vhy+<gNuC#kK+?|Kg~|`>|a|E>g|#Z^zz]^[O{7̏GYBz1z.1zCoU[Gqk9Ο ?,"[z$A){GiOGUڛ=KB#N72 R^BNB|$N04m^?X]hgw9~&:Uw?I\p q#ƿP2: }\G&Z@ȸendstream endobj 63 0 obj << /Type /Page /Parent 3 0 R /Contents 64 0 R /Resources 4 0 R >> endobj 64 0 obj << /Length 971 /Filter /FlateDecode >> stream xWMoI 1(g5])Œq@IEh vu0\^+UAez_ /'ѥ bE ovzzsCv"LXhC%; +'<ݳBowjp1Q2^^]l;V-P$$JJ!!T'r`˞Q(ZU3+PVM(nJ͢ drŇbdI9ὲ0;ME= @.ؒp{D/f3ǰu1WXMbPVM(ʣM||DN2> endobj 66 0 obj << /Length 5562 /Filter /FlateDecode >> stream x[ͯ'qwɫ 'qZ-h82?UCATo8Ï.6Wz}^}u5U뫦z*#]-_߳ۯ׿WvᏯ }/oX_-k:q_k?wx4療ãAihc|KXXw_R`?_c]}x}q۷߾ӧֻw?5/Z{/גl/x9|۝jaW9ͳãA+  >1csm۟j~+inO 5 1%lUvq4}WZ݄S0%Sk J^Wɂe]M+VR;#6]#`ĒW_F/7lxC 'Xon Pr7uKWsrAL$J-\% \0鐍NG㥔'HŲ;Ċb~A֮dS@$\t>71WeV"2 gļq ̠XXÅ3|g:2 Ӫ97v;sWoBA ]ý!N-4nOV~ J-4# %[hx4Z!@L l)bozEDo`!pFngyxd|`pW`%9y!eְ!0,HLXapz 2\ +M_ՈL%p%N+ēX$/r6Ʋ-\a[ 7v\Ӣ Ò5'bG&Ý橹Zc"[cj5t xG K 00/>T1~fg=@3`ʽ^\O >/n{/m{Q7+ޏh۟#AuעDGy䗎x/`CdO$xƃO(G[X*>֝7w՚QxмlIc+fC>57gCj={l+-Vpzȧ=v |{ֽ0䔟ڛp뒲!nJ5 v>o꥿-9WBF(Xoah0{GS&mo[kg\0 Yk۟HݏO~z{)S#nSt)S~`B0LC\Y0=$н“NJF>JĐ 5Dnό8'OU gi|(ևX(χcJ&%ҥ-ߒ %ՄS h>{K l@.xj=5U8!#|q'ϰ97X8#nٍ ]qX:a=L!eOL;o. W~8}O\5>_.fk>q+LZ:Jr8'1nV+yM0/Xw_N8#,e|]NB@k?DWFX/5{b=IwHwnOEj-="[W扌t:ۗP;>/.)\2D. Pnc{ID`iȅݿItD G`#G//, \ñ7_t$YjݎYY㷰2{!+|u6{T+yD܆;0}"k3O'C*Lw==ȘΧϫٓX0A&|>L^y9\e_dy-ގwgΫ͞<F9qge{',0P1,̲3,ݾx@gYlgi`$m/iOqڛupdU?eHr91kᶿr!3ϮGd%OYo EDh;ALOCΩ}Am(O@\o@\ׇ@\_1|Q/9}mr"&7_k!s.>C~#pY|AC 74,= O|EHG>iԑHCb?%<)1%-q;OkX{:b?G X} W;S[=& HwGymD=E‹ޢcP4z1zsp9փEح(r,~z_[f鳭gB[ҡʡ[/gsfmz;ܸ8CQg=Gz|Y@?OsAC&j ;̷ڵma adC4^ӟciHVx׶m!}\9T`cUՙ,8{H%+o^*0No'][ӶgpW8ӫ*uыJâatW߷WbGP(V&O'fR#w}1pܽn:E\l;Ւr*;s~Nfs ^}}8_lbR fKgX.T3{0=lŒ[&_nL,cl;t5Mb.kͪk/%rx/)Hn%}et=UMt21^&U}$fhf ^~ZA||z^ ;T4gst?B&/?eq" Qve<]Όa &O_n?oU(êNOgX/gns^gjT,=O+B7Ki_]=©_?\~X/xp[|ӄtHi ?u1LJ![]'%Q_vt>vz-~cy3-~u,ӠjO$_hO,yg?q'Knfɳ=x|G\!rS%;Sb[-'|\|{|Mî=|O{g;_^9SGr*y3w'"_N)Ig||M|m{lGgo^ '!Govd>^ɺLVy~ܬzc륬Ӫ0_/*l=YzMǞy9/ G{pzG//VzҏaI(sbuGzVUޥ$01'}ibGo eutyz_|V~~a|a?`A?9Sۿ@Yk*K%,׫ozܱlS|ޫ0^wcr!U=?&b, ,=܋gBVVkՒgM _!+IɹIyphϾ] DC  eP))ˋ["$swr #'>Ι^(8D%^e~m>^,SI&ww b 8oĝL9vi`8fRJjۼ(f#"iɐ9G.8,8C7?84\8G{rN݌p*Sv&m*\=O@ qcO2fk5\C^8'ƃT֥=Ȕ̞=8+JN-5DyƁY$0vךi;,'t3s!t3,Nna1y(Y-}d%VbZha ^ <|UѼxkQkGuMUiXZ}ֻڑcZ}UA'JnZT+e%tjǟjU|VZn?Ld}!x"&xUW/x$zD#+NL>&f~ vsb9=OanaOBD?vhy+<gNuC#kK+?|Kg~|`>|a|E>g|#Z^zz]^[O{7̏GYBz1z.1zCoU[Gqk9Ο ?,"[z$A){GiOGUڛ=KB#N72 R^BNB|$N04m^?X]hgw9~&:Uw?I\p q#ƿP2: }\G&Z@ȸendstream endobj 67 0 obj << /Type /Page /Parent 3 0 R /Contents 68 0 R /Resources 4 0 R >> endobj 68 0 obj << /Length 11664 /Filter /FlateDecode >> stream x}M:rZڋDQݰ 0 cV=46~̈$3uKG+%~%C_#oa~<2=Ryzy߾kxSy߾\8ϡ<~|Yo©L9 TrUax_9kxW(ǿjuǏ8Ѣ?T'U \6>QUdkQ,`u␬-q#2qW Az}yN~{N^ᔗ TrCi*KI EiP%Ӷ>׭B[\GW?jsB#܈KEn\u  J>.9HtxݵC FET[|][?.7>裋~NފN3cggZ <=B%79TNI EgZz8Ym4Z2YB;={9nD%mZ"aJ@]BqK!KxܦEg@IjTF8w]M?'Vt9=Aߞy0&* MA DaA Ϲ 5:}$gj!幕W[-!*7~fV{ :D?TV0m m 95gBVֺr&~rý輄Ww}XLzӲjHn PI/Nj (DWKZs }nV2 w5wSw.[y}I85@%7x]() ϣ[g}`]/J:O }n [Z7Fq]V'z(ڴ uYWOfR%mJx3)6MS^t^_OKav~NXEaSݴ0U(9BC HV,5*%Ht#!(8ݏK92m&Ec~iIZ37|o\T/N BM3jŪ)޵MNN`s2I+:UX[Oy_m U[5eXyZ=_ڱE,}Fߓqﻱz)G&_[4~n=<'㡩d_]立 Bq(ǣ$\b8cU5Agcҹcu~2~! ě{bkV'(JiTmJF'Ya HST1)wc% s:+T#m8զOx+kq*=?4JkQJd()KqQHJЬFrǢI6$'oS8T/,$]xE}F| ˜f]ȕ4f)%қǭ[ڢT/Q筶&ע'>N+I}%neNBP,cHߏK92om_2ő\+TMS&MV&iJT=2δZwV);J,! 8Ee.vD#an3)#j3Ko(P.*x䂣0QF`֧xi$㭄xߎK96 [ /ĻU&`4Q{[`{y&ʬJq STFoJ4V74 =kNCj2zuȜ6qQw5ݐ JЬx K9}.Ism2-j*S${~ ܳ}$sH+ç׿&i݊fq߆[D U&R8_yRZoG5 Ms^S).X0y&XVڵ]b)j5zuLu֚~/E=A-'^rkMb.v^Y7΃&{ dMu)TܥlQCf)(j.9p!8WT(jH`=󈙻,|,{KjRzK'uմOQ£.VYv&(Az)Ӝ$V27|rgoBEi'i֧|#2I+XtnE" #XlaOUk7Ջ\oEG7 Z#g~+#n^)DwK'ET[z9ޛ7.E f[&gБ E ] /GܛFi(śI |g]E}BA|Z- mS۱[9r+'TmB^M~6&:fRNQ3LPffo륜n)mp'hrѐ6"plx% nGVh; 8Ee.vDc qx ~C7|oZr5M>!(J˝b}>$ťn{z) nSDev>lCնU2GaYu z*arCfLbڻJ4fmWtY4vEJU=UCWK @fU_k@sny;V/thm. i xCM zuJ ֯ت)%8jv 2Br;VEWKx*o(PmKL^]bVu FQoĬ֧xoT;AqwX^#ik$ZLPo T5K^ĎuQ0{FVìևx:ύt]/Ap >Ǽ+ј1m1g? m NիS0(9koJZ+(:gos)>vsx|^*v (w.y { ż/o꥜>gsP Oi uUxCQX>Ļ$GqxG?3an}L7UIHS(个ӳ5~Ĭ֧xOq%dA۱z)u4oۙmAիވ5ه;~#Eӡ"ޞ TJRnK4NesTM3oaeʍ*BߧeY)|5H"ckY+Pt;\/ى6pçj[eR*Sf3n 4*5kR5Ap۱?3b]N [aa*'P.0$QFoZ--2A{XLV4F^vSez5k%5,EݬCws;V/hl!η,BpU[]JgqF&R [e q ST1)wcg?*\mxZtm?TmcT/nI?fQP[~y?$%6p?V/8ΗKp[Fo(\/AO3ϸ EIa;)IV\NsoqOT 1)w%K܌Mf4$ˮ> y`sITt/jY/v-E>4z} yV054(RNY϶!~6iL~G!/8|fC**b>|UOp˵(Չ8tSW8M=1JqJ!&n8䝉/yLRL|nK򨉱mT>8G|}^1,jϚH5bJ kѼrtUuųe \mB,悥 <ݑ.΢l f>y?\zTδc> N|ԓ1Xwî؇|U++054 (RLsIӿom{cYT.汤|` ~fD>ܻ°yI>MTݼ.H8GOy i3M7|soV6Q_ RZJB0)I>As M17ʽpS9Վ̮snǬrDULRy_l!}9?!L,2 K!PR~Dcչ<) @n%?ٓ0=l*GM1 9TY]Dz[)a;\/AEcd,A427 yӨ>6#vv,QBZ[}4W%I+Κ@n~i7|re鐯K!_VvG\S5#!O"4 JЬFrm<3mBdnJ ?~nRdy!_4B_T 1)w%+6 9X@D !f~Ƃ"No$Ck )X@隠YpUڽQ9,g ~$*'|(JrN),e)Q3Mq 7ʽp`H7 }<l˅\U\CqC |<|VZq7|43 rwpƢsEϦUoI\t<ᣐ+|M}y@6RZN 3z} >4n%h1>v?\/\iN8+\7|rXHhP!r BE)/6z} fx] 1)wU5zX;K0gr&ͨJ|<4rMB(7rwQSBEJ\wpO/N?gw9X=˙<9 E}B||WB*^3(JqJ KZ .!6φOz_}y.j:bcAQC՝$8/rt.?/5-&߆{j L"X}W*w}NwY)(mLbma5nǘ/rt.4&⾜l V$B$v=#(s8\I|93k&=3i~ JoK4f˷Բp?i-\Nk-YB Ouq_^Qs٭>A Kz)g/9ptSᾳFXcQK!beQN >ވ`U[@qJ [%ޢe?[l0~G!P֒Cr%<(~ٲ,yrM7ʽp^O:9pw|fOryX& qaػP!JPLj8MpƬsRNN[ho( T.w,I~I;61)3CNsݭ>A bz)g˩U),yKXԣ dblAQ-8uX@qJ > "j&߆!䟜b+DBV8'fـX*uku/A /g.1c5!܌g.'Tz I]$ZO!U)juOErd./ׁ@]Y?9XTA -ĬD+6BP\:B8MpFox2ܷ9?H7/.:(xa\Of,d]lDUB pP EJ[4 pL=O%߆[gDI_NVKRj6 +CLvi-Ç}57Xz+t?\Ucm yVrqQB$w9JRe%>I ;p#sy9xQYo!tO7ck*McrˁY)|">~_SZ\9.8I2Om?ml^4cl*BU unE}v]:5 JY륜u;Ki,)wx VnfV?|8ܶ>kni*/jL0!<Yr\Oc!GQq%S:DJr p^# 4$'9]w4:BEͲi0"E[.J br6z)'s4  Lg,{"T.>_/&?WVO!_`j֡+D,׍hdҀ0Mv}<l$ T:| I<,rJ:$C%:z)G)ƤnRAȩ-? 9T?L~ yw6UJ;Z 0! ֡9u%IqJictLu\6CɩCd-U&o徚ZðK޲/[O*uku/@ bKz)*٨L7|G7 ^хCUð;EC)/jEC~Hi*oH|Ei#4g묔QW<:pʧǽ?|s wvn-NUC^s-qH%heױ K92Gنoýs/LO/N:zaȢvB|IT(Nsڟ:t?\Bdk)ȃk)ָQȕN?18e:b߱h;N`!mc%hV q h,n./&3gBV˗Sj|.*a8Gq5 ?- NrzP#4+O<륜쬤)x:'`3ᣐ8R哗s7X%}9aHޘ֡Y$!ߗ5A!&nF&0)BsRyUZE!WJikϺxsz7٬O4?՗BPW~\yyҺEm%hu R6w_[?p߲lfUhZfX v6P%ukfI.X0iYo=OYZ fUhZZ%[}_">NkUX!.RRBZvDcӹ;7R-#L0;'rW;,zK|ܗ*ukuȏMv^Y %ϕ.kB \V6&w$w!uM¼0c.јu2f=&Kf~> AO;CJkRYƘ%hV q K9,+<o( >qPdrM|N؝"`8߇ukj (NS)1w%EiqO."n ?Y}*w! XԞx0| Ti\!%huuVRǃ5i7~!j]:Z OFv WBgR 8MwQh:ox܍Xjo\75*dshb?|و},Jb[rPrt.46Qi(g'X/徼~ʐ\BE%>>:oQSC!J y7|K9/E~9N*"'*u4>yKW(ć= aZai*%} syY3|Oa3აS^k^9ɝ2$+/OdQm;3>ZX|/r c}d$wQgXlW*w֡~Gfg%wע'C:5\)NS)!_~;\Qfۢz?$:WNJ P uEݲI|YRPs,R%y͵ֺryXfK!n/O rd5UZAmy{îcaQw rBPMy ?)NS)/.(%0&%@p 7KUs+ڦag`ь)j brqM7ʽpUq@t%Dlo d9T>cV!.[ٙEsJlQ9>I B(RNVgM۬wN`*1U$E%>+aؼ!%i*%%9xaĀ0t O!Xry2.xa~uEmhpҒ#%h.qy?\/ | /,3:-:Í8!Iv/,#i*OjȻ}43~>9X|5ڏU>cȧQBh5JwGQKAD.JDͲp`5!I'oc1Ջ9yJ q78 (_)yYC~yӜarpFvsy(iQ3CꉗXLCSr`BQꈿ yVvOP>o륜mv+is v9'GƓϢdziUPp#m><2^sZBȕ4gAU5+煙0EAfUS̄Kv!M3Ç9! ל:8M~D#/̜r; 埆efHU !a~} Tk9 륜e99t[Ν?[ QMzuXlv(X{:5!0ci*%w%[ {Bm?$r\N³S zJ5:s,ݩCRN]K'd-X|o Tmr^cE͘ly !:DT7;h)F}Y3ivMyGާy9U0WüE%>*c\+5}K9_N^g)>l^Vˡr/`2W(r>WIv!RRbK4VS<BG,8lh9o(j~\VJUC^s4v^|62'´l$pӀP|)X NE͘l8` v!RfNp馊hdr[=Eq6zu#l>R3^XqBY4OPf G.Xa[Um ܶ?'IW> endobj 70 0 obj << /Length 138645 /Filter /FlateDecode >> stream xM.=W5V&9m6 @>F- BNX";IƊ ??~_mgU_?7/ǿ=O__}*w~_x_rJqn(? tCmw{u1w+aoO{ _W[sw/_oG>{ |Kᅲ}kk?pw/JvW[(_^2(]^Q\ArK\wW3J_Fr=ՌW3ʗױN].nzvnۓn^7{ҡ ^a% `q0P4nWzI}. |C4nHVqn^7l%|C+N -[ af[!^7l-|C/^ =[ af!ƓxPe8 2|玲^7p e8 2|çtp e8 2uaa?^7p e8 2tCt/f!^7l8놕 ot/f!^7l8놝 ot/e!^7l8놝 oo6uCˆCnp ;1^2uCˆCnp ;1^2uCˆCnpd!^7l8~uü 0^6ruC a^cot/uC _cxݰ.17| ^cx/1nXd!^7l8놑 xݰ %!^7l8놑 xݰ %!^7l8놑 xݰ %!^7l8놑 xݰ _w,e!^7l8놝 ot/e!^7l8놝 ot/]cx0/17| \cx/1n>ˆcxP.1n^7p e1n^7\#k,nh5@n ׈ kTxp u56@7kpxp u58@7kpxp u58@7kpxp u58@7kpxp b!ϥ!4RiNm ν޿ώH]F]# ˟|39.|Ɵ|xw?w?p lɇYHO@zO?vB?ݪ:'Z6SGm>WH8oI5)K,Mg~}~ƴOӀ=_dT;Hg#6{|ą> ÁQ'/,D/H'>Ê w⋁«9TOzp|32Γ1\6Z[?7JBA w%\'D/ a_Y}c ?O$ĈӋ6^uEEN 8NS MO>'  D/ܟ]'N'ĩ,!-!G$'~-vL[=8zJ`7ؾ$~zTD[}~]'!kokkh[F+5aC6UNXYZ\1Y3 - [~".73߄0L?+vFDTV;o FI˾3g8]jV5~zf1$'DWj/r5Z*'|-`_Vj=!5 ~RTX7ggH3't8G!Ʊx RK~ObSQ8| >F`&:GucO TА!sW437BDLDހ)hDo80 C::aVD7:=y c'](K2Bt!]-_qK߸q@$UK.rMt1p֒z; ;C; ';/6C9>E;MT;\Cc;kr;zCDB$# za˸q=А"d"z@&у1ՈR"̃Eh$9KMaBU"E j3]4P6DSQ8"iI$0 ߣ)z_=ōC==_g{SdO'5k_>i'ӹuWi9[Fs'/VN^Ћ;Oߗ~CEqj TDCE3#z#07}hjxd4~4n8螄YSfatD7}za aΆ2}R@t' !`,8$T~˛P¸ԇlXT o|RoGMA9bW귌 弈S _`U_ATPXTG{P8Te XT'귧8~{ ]oo{Y *d"֨ߒ-CchH{<Ѽ#D$ߙKQ0Ma~#uG )BxXm@q6I18a"vv~v=K~ԱOXztc62/l}`O=Nid{jɫ|=\~?Tx3}PQ==ve I,uH86!NtHXuW@#h: csLw ­6zRe_㺰rN#-Y壚u^`O,/)~G٬폲Ywk'\Tc8&,r<:Y2Ro])$ZQ Pڰb6;p؁K~y_,*v`STvxң>ӣDwDwDwU&sX"gH8nJ~m ˱ZޱiXtqu%Aw6fUv‰2nBr > 'cZ+-gm%,Q6OnO45~/9%l*ЩC\*f^bo6ȋwP{~=؛{{RtY$_'b?)b!YU11ػ夼O:+1nXbRAfސHx!Grz^+'`4~`CB?腃Qt鏂:(T*!*C**ݐVchH4vՐrj \5Q7`|a4oPlĢbG2Q#ջT'+$6ʜ3B(]~L%nj ؁6fi4S* (Ĝ8Wrž1!(Fڈ 4Rp䬉ʉ;Hhwm#'hW*GC;B&T0"Tk6A1AUTR$"KH M!AB"|E qҧxX8zb|uHT;HB;Gȡ>eغΑwSYzx0 ݯx*n ?[vocǝuG:|-#8O;(1mra_D4箓̓ H~IOC  73tj{N:iإ[oz~>$j|co& 8P 1na\A[r0kSnj:ψKꎡfSw۬?w6czGq[┻/+p򑛣'$Ƕ4Hܒ &-iȡ9q n!}Vˆ.D^)'pvGu KMErZ.ۂ$P$Kj.q*~n[Alɬj+KifGg ~@ O4L_8EH'+516m 7bkk8LNoY]POFtGtHtItj(KtwLtgMtWNtGo0AC ?;tw`3,tPAC&4n"3T@a7aB"p^EX;l!Kw !!¡Wc)v0u:B&/u*iN' `_ŨVsSt|\~?aZ;SS!xSVo>A3Abt͔-h{)yybA&0KL53UԌXQpcKglO 3OBw%OL 0 %aaCŊ3WBai5*I`UI sߒp$yI9v4-TIJ|1R_ġl. JYKn ^vS5p*f $PKT3KŻh:(I]O%9/zWl*%v:,[Rf-VIN[3(ɉhJraz%Jf6y3oc7Jr|M`zee^Dʈ[%y1J?J$c`J\*I{T@.58kտL *IVIbK:}/a]/az$k{d>㱼$GŎ^a8$l m*ɳ*5$™nFL'*/„x \ X?!~>R(:FAžT@ʈ^9NU7h Do*HaDC"z3G#$*RגmI[WILcC(d82+PI"!T@7XC3q$/)طP[F-2R "@(ɝčҷ!FbQIAI.q$M%ٟ$憒zTI' bQIJza-,^H_od4D5m,P@ݤeYvQ#݌I }x ~D(~kKp^[E/+זzycYOT9z"M鍦bdbS4Q7`LmMOtӀݬnt6rl͹Ǝ$PH2Bt!] YEtq#].UK.rMt17Mb 垈ڈ 4Rp QG=H zaGr.łl*(-DD fу1n\qP0XB(V @=D Ez+-Z q+)$~*?T4ihbmpfWEEMd'6fࢄ}݋_ -[mi0G}ɱx#[ë쩸I!vwCݡgKyv} 7J*n.ҍ ɃiF]3cGӑЃi݆/Uu׭bB2=m -SulQ"iȔMIQّJV;N 6V"( XL;NIn_~wdrޱ}P.+&8N9b2ѧ*8V&;Ns_1E(8ڀK1ءc=i8}DŽO'q 4p'&X!?\ 0F\XFgi;[; lFggvBSYYS> VC*6'}MrS*ZȉW&AeI[&_8L5YTRSLB5Uv_fSනem8|M;c-vd0lkI([-/jhH%qVcf%+~>?D!Da_(fzRo*X{WІ􅪛荡YӛJUfc&f֐T#hDo M5oC5ĦL膃:̊FאI`n %c'BAt!ȴ[-P햯v9] %DUK.vA&\7bNto>{& Db ڈ4R pʉQ=H zAGv.h9=A#!pTD` *Tk6f3<#z$l?KЍM-Y"ZTu0.EӐIEPE<Wl9ߵ џ~l͂v?`SD34. K{o-HUݛ?gw󩱻7W_q>Gx56 Ցxk/\<^`ќzq;Yvǥ }mWkB_#IىK8Bߴ#7 rз^D.bU6ޠ =^UֵS9&5S9[? q@Hr 3T3xrQ|V8->"BMY -6EtZ?B*6Q,Trt3 Bg P,гZ Uh}ӫh+,EZ- i;={LAurdz:BO'hm+t<6B9+tDP[,qmeKZEJEaKKD?aXఔȞ'PE7,k3$TYUDFUnBT(ѫf':GSȈ!MOv(0bho(Ӏݬ0&&M,y")c' \0]d0Dt"|[-} '$U(%PLw%1'VU &S U*]=Е\qD%*t%j(KQ+9kr+9zC:S1cǼ~.DlА"!КB&CThnG0FQO `e=F% i*8T\kEjxʧXV8{piL9A[ ag%q|Y#(`1/ {LNNns1I`v$Mjso *Fՙ𵇔 -;=,1Y3e˜ m޶GٚiS=Ԡ4DWa?1D7Ǻqbc R`l[om͌edE Fa+[XE?Z EQn[{žmW "ۨ4* O Me#UP3#z#v7Q,LWo3I膳hW7m$( V7vKæe)].P!_D7CI߾q߲oQ&.d5|zC9sН] ѝ]ݢ&]*.ݱ5]= !`;wp-P J=D"d2T@wcDնjn=y"n;%mzx cRca=pv,ێhy{NşS#ʆ(*.VAܣNڽ ܽ]6Ā^ڽI9p#H/b:/Wdv«+ D@kq`9mZ~0ŒS709sӫޖ:ӟ_vbNos5)n&mb$/?sX1OES\+g fO|̜. 1C"篽0=3^/3hNKn!l'D[39\1Яy[h|1Xs\B$&rڳ9F=8i12swiYS< I-)=$=;wG&^w!:: | < 1}{]ߋ<x*O[(ȌD} F}U߈R{bJ/Ondb;=ދm.{ ^ aOHoz~H&]lNeYzbzS,9,="KҳC=,? -~S2Ks8*. Y,TlnY,G?4I?%ߒ反_dd Oo|Sٸ+yб߮R*Vup%#1@\jۥ~/ۦ J?''b) z D'mG:m;F@m)_W lGzvd+N8л5c^qѲ7햞,,({_ 2$+?}ibJif6$/q]™9OA9O[e3z]6$\##xqO5[(?.E-۝x3r홼žq(cI 3y3g {$nQȞ=y(;I^|'KOwċE=c] {mɞGe87 {޶ZHW$+^aΡ=Co1ms`ZEG*l93SaV\\P|_C's>"~OC*'~/JJAVyaO*鶮\>bTd7|qj ih/d'bawjrjdd4K?˞?,{%˞{o?ЋCO?,=2"K!,=$K/CO[,&KId qY,Fk>jdS-Y5y={3=BOFx=x#y/5;=7[]aZyϑS`?K FYKc ^l~?aO;©٫@;~LV1dFѭ$Ԅ[u;W.ٿ%ct;t;ﷹw;wK /w!+ym3KB<|ȵOK3SFC:dCxur7.>DC 1lh9クGT}s-y<3/̾.@\yώT?sJoCOHQ/n_$Q'q/‹[#eTT&ÕQk~Fw?WcsQRffG@"rTgRoΒ"?:(Q~Uyv}Dw#{%;)_nTݖGZuYa+TiRCQRQRtFX1ES..QM?UK^x-jeL>R)#H{*i[9TRl*ig>Њ2S}OOmqeZLiQjodG,Ou HiK ɲ^eOao=e)i'3^zAQ'zcz4u(-άwN-z[?Dz=;?<9LJW7꿕3꿕/5꿕oG+ٟK+90x<-\ODb Gk/;[Q'^x8==x\oN#LQx]sm˰/È/+ЛC"\|E0uP.:&@Js914:mO;|΍|HNDu/YpPv 첍 I) ]B7}Ȟmw/˷_d.mdwwu)?;| {@ױ8P\Ov0j|-Gl}Aţ9F,ca,?^ò%,1UsAq~k&[!޴#g9p'z8yN<|ƴsWʶMd`L;99tǜ0^kĶa%Ōw6W6Ys8s%o~|⛿ϧ5D^M֜ ;heJmWgUR}w̑CmD}ۘXC\S}ըoۗoL~5sMmۍD}X"^>l>lL}dnmNTƘ}?F\}ۙ=Cr"5r v~VM^ПsДṭd.^ߐpW}D@^Zl{|[!d^6^S^_AY}NZ9XX6} {KaR*]rbz޶ `6&~F+~/FSy"<r}`;T_d{[Y크S{B217#5JV{vJ;Ya YDm;XhJ=o;fE}K7>9=WzH%=%Q{f=6&K-{O'$T+3wdCrO?%T+c{eO.W# T+#{x?;%rM}[G<kh)#T=ǃh)^4xMcGɊWa)5xw۞3{/CR4:&@;|X{{/>LX>e\w0gu:/Lnw$SbՅ_qڜ ϶RY=3u}z?\} btec'$\ j>pW(+/N19Irq Wr>9{-S 0xܱ[xp͋Mm+qȯV8[弲jbOzZ|Pٲ# b{|Wk *L|>[`n~I+89x^%^Ry [ʫOIVy#>LEV}#To'@V{)nsjoP{$;Q@ G Ȳb ȞȲ|#YJ=c+dơdEۥ'w/CҫbI~YzgzH^bgS8,.?'8Y,F'Xl֘eyeb[dk9Y8 GȊWȊgȊw#"+^"+"+2xx79=ˏx'ˏx-ţdūh)%+-6M0YrIpMSmx]Gy9x݁M?-w%ϭٙPv^?ޛݾ3_Zo-_l9k'rc^b ް?K|[g|촔߭~|/.>uN|K>ٴ-%o_u`ml ՎnR[mOX_O.]ն]LHBjV7e;~t7q{4<ᩝهȚb 3oAK*}8mJfn%TT?r?ϛ ݥ̞x RA.OTOǖ8ݢђ}x=2h?-+s}k^*㮞\Sn3Lg`ILɿ~Fw׊k-j>y3m $2~f+< k=t%~,j?'6ؒ6pږ+[zvCA3f9}0Sk #~=(Oe-,Lo=]ä?W?t5~h?ź˟WNװynIWykǐx8J7l9^1x<[OȊ-D#?A_OgxQUEg˭?)&gi[#)^6=N|-9?Ͷ?M{$gûW>X>F}}m8=7m)ܖ#hįL[ϒl&c |/~6qͲ~Ci-_oC ݖV>k_J.O's # ozc?\CF tr{nC@}ϞggGFk-HzC2| {Gl'X Ӝ}3!/zebrtk"K :x왻[DXG+ˏ'myC凛*OJ}̾xyDǰK:YyDc-ph7vV73>6̊dy'>#5;sjОI8ξ!FFywC0{8kfh9yh޲}6,ƨg[ml7L4{V^[/B&6A?hzs:[of_\ftǟWmROMԂaa}_l͖vds}e{ޝw8l57<;osD},%}oVy-;Xru?ϤaMmG}[?~.<ZyDy:{yDzq^Gxvm^߇Wjwj/dmƣWGgoKjd'`Ӱ' Z̄=;&JzD^9 9:^,=?&wvq,0Gݟ9#:tv,{gȊ=pxgWȊg=qxxx-gǬ#^sxS{:{h7Ig7"5{xYψw͞#vxpKM?"6x)ugM"7cLO՝0kZoPw,I7l})3mIg)u| ϶/k?ٵ&d]?nn^]?_XYqVŮ2",LLWeg3׌%n擫[nYKi#60"WlN\a-ݛLu);\ʹurU~){Sps9qK@IW?7puTVIʧZ+Y+z"yRce;B J\۴AIa I1xG(p-gcE{JÓ?F{=sB y{q W>m"xE(:kiSxF8m_ gBAҝ{ҹ(f+^%h3\Y>^g/VC_P1['Wl͓\ղ x Pk8[ ˺VjOgO {^'uH;2_]^z3hO+>-!$ζxb"BL56^v dbc.DNT=&z߼Xf;P58sc`$JSyb M*oGŽ> U}[@V{)~YbbۈU8{A<,{ɞފ%edkA<8 Qz@^'ơ7'="hO`2,ICCO-?} ='K/'E2?"hO`33\ٟo=8?=/{jOyYq+(ϐkjO3C/ToGF=Ԟj#b+5xb'·hO(x93Q.iK xAסg)GŧxY5xr ;xmQ?y{q ]}_m_?u\)p2k3߯ $<_P6k[ V}z?azq=V;D7rP-U/rPZ%8!Fp>ge6qUF$k{Qj{jQjQj=m(LŞ1JCVOVd“5J_}WQ~% + dƑ +{KY ՎmW, YYW;]YjǺ+C+>,YYjǺ+KY(cRUv\۔,:eѠe3,sMS`u1sVI#vdm@8dTY(/灧QY/)S}R{閅V{"; JV{y}e&{!˞Ȳ^{?Ѓng@H/,=2"KϺ!!#KKS,=&KC{Y,}.Wd3qC%Y,k,M?'ߓG@VH}r9kyղsU_eJǓy53.Q<7v]0-1OUG>EpL[JǸg=wڢЧ- 2Gd Dw[YOmtT騪nQUgݣS[OQ%Uүb==ٿ"6E[qvSې1~or7pMq8YywK},gJ^=?nOgo'g7pI^8#Yz<[OzF:Ϩpo=F{ϙ^6?q~HyDsI??$_:?unGdk$\S/O8T##5HG;Ko9T5s%MGċ#M7UyĻ;Q$#ۦgEn/\g}Gg^{u?A|gaZRÓ8u̻)vp=lT6*qcԠ̝n,de }iF-i+GŜ;G!kYDqOȶ gf_9<8*d7'Z=q}%5M}[s; >}G[Rp* 5?lw%y$ o~#e4 H e!E+];"3\)x ;?O[9}Ϲy}Y% }e.^dB81ӏsX+Jy}}?ӳU)%x>g:2HgգkOY SҴL?O?UgS>^Z>ޚN8li(2dMyػ0}ԥ)R{I{ PSy8(o +eY,K&=^ejOcHV{%={?{W,{'K ,="K3;L+%YzZ}&V]Ik,'>JdC>JW3G\S}Ods=Yq ddd#d+ϐ/OGU9^#+#+3xx7œG#^%+-6M.YpYp#.vĂm_Ɋa)F9΀ H@믤'<&W_9X&N߶%DbT;Qz w$Y7DgIxͿQkD P_?gN_kzjPox:oRaq֜ R@^NSBiMo,>q u^*>(Dn\- ${PL|7yZH||}[;yჲe˞9"{OΏE$ٺ[NҲy5-VNuKe~,LIÊ}-{la[^[a ϢlX-ݪnI;'YmCj/IhOްEjԞjaI ]uK^;ad{sإdEsןYz2K.=#Ke&=$K/KS[^? oGgݧ=ofCqS-Y\ž8=YYY {+#Wg<"!?a}x<žxP)^#+v{{װg.{g>ÞklIn;0_n+ކ>xzuMmQÞ1'oxDBAyiaiډ9W7],9kߖY,:)( u W,%|Y9(!ץ\] bYs~oR4HJ5ݥ<]ڇC]sϑrs}i]YIWy~ss;q]_asuN=;˞;Ȫ/l.sYW,iBV{8ujo Ihd瞷'sed˂}=~avzUػqYzȓ7dqYzFޑdq)YzKdy\,@ ˟gdroᯗ.NG{LYsՋo>RIq;[)s#[?˓eV}IIagS'Ɋ7MS<:m ū6/i.Ż!xi[j-xܖJFnK##G9}|d3 X@ 츓~4yMqoZ+ױӇk(6x&-UgCc;H{ǴK5~y}7x&-YŞ7x櫕[;paUt}0 ^eNoZv|sY6+Xl'vOx ,h-aJu/[:CH `'*r T,p-36}+r2Pi;= 'O-XHf0^H^UX|jKPa9J^vX/o?RgGD%6 F^h؆0+?O ĝgU6<}v-_ߟ T%wV> w$J z)ʙFQ6E"J&%"wZ4;Qp*qQC$jDˢ>3ψBZI?NTWQ׺^BbC +$La 9Eg޷vjTTl|E5z*9uQQ=*Έ";8ވ?yC#zEgՏy[/mmwdN 'glonf<ۍ?*8OUozf{bmJMlʫ*3gUb*ogfT_Ve>^$hU^cH=9{{kюz8;=4a/G'gcmiknan BzzasBOqv=:pKzzx'tv=m[a kgz8EA_O8?"_@ICgdSg_;?';{<o+^qx!%g>#rxCkY{xAk/Zx{ěDj_Ļf=GlCۦDnzUg`ꨮC&4@6}\t6ZortM;٧rTsYi TO~78M4$"V6^K$h)r}+C'|l{m=iqxm=o=t/h |}> szb躭}f=v_WحdDn:7pIӳ}$J")x=m3d?>y=k'zx\gOR2<"lao9tȾH\_?v뻸r~29yg:{p(?xYCpٌ#Cg,bq} k/')+s㍜GrhgjÞOa\8A' a'jfDd=ga϶'}s9gž-=K3x=W[dJf?#L뺾0O̩j'3g\g\Js3dcg {ƙo3tP֖ s;a8A=b'g^~[ϳEe}H+ab{m[=WVU4ʻ"IGEj"UdwEjN^vnI0,A| dS5de* $1_17S21_X ױ^ȱ_z#z~^ɱ-FQ;9A'7fxEC_5ӟȡȡ/Gm}ܠoC_SCߓ^4ӷiOBސ5{F{N{H{I{J{K{ N{M{NT8 \#6~⯀ӟ!\#_j}-/⏑_#?gS=p \+Jd=цZGV<n#zO7E?zfXy:\ٽz" Zߥ۶Y Cໟ,^ߥX$ I'p͎F ;KgwS \ f'ߋk^[V}quӁݭS} ܴV+u=Z5[dg ~ܹ?rM]{o)ul nȝjey6S o?峴L0v93O+u]8]8;[y.E](P%lb+.dُr]m;b| vVEwߥXȧ{fz"yd|qʫkiEx;_\=}#6u-1zv!}'{oZI_ŸomS# X/*^xE,fƭD=֫#miK]bC\_9w}p^i@=hQ}@[:;Ԇ5ninڭXƓ['>vv_֪4q||;n񆏯)~MmpJZW~ >Ϯ,Egz@>Kc<jx!N'xRy o^rsx+ŗӘoi11_P[qV;w5]/&\Yo\㻦grwk'zp>!!߫S_W:-/G"%wkSoOSֆwqDƭdс(WOj>M/Kzۦ7}&;Mo3^s`7_~7(W"aN}qeGr,i ;p놦׹{ۇ2eه$'oeώmamzk)ӣUTJ9i0=DFfmcNd4.i<]ӜeLčeDe6Q"7DIX\HaeN5TT#䚣ۆ!r)j)3xZ['80yj|r|krjF[Ʒ"W߮flzڦfff2S/fR7柸1psC&OrJ7s|n'qMxo%WoofNT(9ΨVѕ5}"nqFO煛=wr|M7'nDˇks|o^nL6b+L mDk-v힗(˕mDy166Rr޼-Gg)By }6"e,RZk,eX2o˖yXpkەVsەUʛdlp||vryd[o}mW3^z"z۸?9z~E]mmgo{3Km?9+ڴ#_q;)9-cL rc7)^m?Ҟޑt{hiʏ_YnLfgn%L}o= >udY'nH o^K³'UlLe|Ϸ}Ce=^ Zfv}`=.v<"x/u d8>CgE\YCz%\-Dǻ9$?b;<Ђ+U}{ CZFkKٹ/P@p,5F\UzY|#.h,VCŌϛՊ{ avM^y}b7r^=vڶyMK xoV󔷗r"\-)7G Rjp敝|۫3n5F¿ }Hu!{rzHq^H Sb7e%{+OvkHfWn Џ Sv l^ c>-h\<4%خiOa4||  R^Ya)9yAtAMU>|xts2uǃSmRʸ1.|RNrc>/Ǐߞ2}_@2r'!|d=:zv^Es#!D97>tv}<[îۇ^Þ8qv{\SK=wnv#/鯐ßqv1!g0ӟ"kXO9 oCXKL@?? *KC+e߆~L3u硏݇yloFک߭ɿolyj j}yPliwM@roe>7olsSXo_ǛJ(.+T%z.,(3brVܥ:аٓՃB^"]~:я-իV? rG*guѨ4,6+]R}٫3 &XzU;9{QP׫C9{QPiXMVrUHpoկ:ְ재յ(=neսuzWs|gNQ9&٫9{4gϣ'G5g?zumo^٫A>Y]٫ϑ:뜽W|x䨞{<1z9a}d?d=AXY9-/:s<:#97BeuG軬}!.z$iV-Y;[^Rr1N)7ysYsBa/>!+?\>EU~dOmꦗU0lvm)$" y5Jyy7d||ivP7+#d>7N>K|'pfWɱ^zn]yw>T_CCXڔ#pf299aѧocrkrsJ}yx'7GWgwഇ䰗䰧䰷yh5O8W7#_i}CU?F{WmH-zf(gWm?KFjƓU=Ln-׳uc// ͭ)HRzmeΣ"y߫MWYBمFhH6β2߇ߒm-F|w/|g23-dæ=NeiRzt[qSGhv̶wSt>fZ0|gNl~rYR~=^CqmG`(3vn9lvZe_6S}K4Tݛǿ):-rƣﻗ/r)2͎S_{{|GVXs2ݎs|Z. #<iG4ϤN-Գ!W_id|-MizCUoAP֊]WoAfoAfoAE8pb|Yb1h-A1A1A=>A1[{Ayn|}+4Ҍ;|>A1A1;Ƿ2߷=ۊMjA1Vq3Lus|-f{aIZaVUϳ<;y_c3}Böh2^$x#7+\È<]ϥ1H@sO|#|{)+|M]9z!Su H9絞ɱe}@^9g>!r|R}5>9ݫ>vv;6GE99=9'7c^͏=cw䰇䰗䰧faoGG9599_ 7ߩ8r+!;!?2S%o{|_#/ߗ7?> ?9ODoUtODh5G x -er߶(@߈&vGjwt'Fh]?u],L)l^OmAg4=Ŀ}t-ɞO~ۍ&/|6߫'6{o^{-ߓΟ=ŏE/[}j~톯JZؑo_I g Q3iYy== Mv(GD/fOq&5< k펉f;j>~f8QXk| n ɛ_8ȃy{&wᨽ}QyU8ѮxoQa̹1W@-찌ai2Ty K3 *=-5HKcRsymga{Z際xzsw}Xf`':pf$^+0:?C^}e ٛ?;o?#%w@n7t囷<Q14gbh;>0" xmOxa&<,LEyIM`Eec>s|ܟ?ݢr5y΢i;8#9+V]'*[Um>##>$>%%>&>''=  {B{D{_ia]޷$=%=&7yߗ={? O쏿aAr+gO_"?eY-pc6&?G7bŸ$iCQpğ*.9aӧ/zGk9_+;NDn,*17 vўۈ}uf"!|ra}߻x;{M[/M"GbWvjP,l|-C}m=~QmkWl#Ng^[}?cզUD>ӵJ Q9mn~݈YN:wcerK8V.Ӆ7qqȜˏmGeE L޾H,;rXJxfgqBnȡ~6qNn4ݍ6e*{N4y.9G y)NS0y{)8SEn9 -~8ﶻ5dt'9FʔSEuRRn2`-Vȑ#et;^o}qe|aV^2 L-_rC[څg3z"r ;+%drvTcuVVS,1Ou}v׉ xޭ(>mc?^ωwS&hZss^'Vou ~6-pv}}y1n9}H}~vl {x7+SnEu-7m~oTUQL U >6v 7:bGBnrAwkK3ZzJR/(\u7絕\ #WU\'U_{YuUpW_\s\&u6ީV5϶=϶'pT_H//Ͷ!ʻٶvx5}|]_ҚhXq.-oGsC?9_Q/ J/ Jz^XXPVǼ\yyy/(p^Mo敆7v!k!^6%φMUZ<+φ!Ð5h)k1RmCgHYϔtB7(nAtʿჷIGk8WYFeMb/~>yHCWһ}Y}1HjPy58D^#4wPM`e4*p:kCi熫\ͯ{՜͊7zzmz\Y/}A^)Uߐ[>#MwM}Hn)}=njj/=o\S .`QMx1 Vt#({WQftMmfts){iޝІvK>ƀv#>.d@oMŭ~]KT\Pşg"H|#1vYv)wCT~hŮf[-[y f2sE*T~-[zޢa2cO`}@}aOoȡ&Z">hnzKZ$>ޒO'=0{1?d~أWK'ҶbOaoaaai_ ?A9r3w_"?E 85rs͏?8?"C7m~?J6%?<;D\Ӷ>&?n[OMnLfWn%Lٽ}" caڧeڕ>;mgM훯nNvk;{Nw[{Il-Ωze#k|6}7xc6xn[2{"/rs{{{aED|!|h`m{mҔcZ@|z,Ɋzz'z>d[p@r裍`WǂZ'uk9vQ}Jn9vQ}- 59M[:8[}?kZ#,;OՉcދcZ0Z{6ImX2gCɨ^fw:6)./z$RG'ֱѰ,{ҋr,zˢή+qf">KyyPj6"ӍyRC:leU)g[R>~ŝ26,F%y=|rg<g8߉% brs=wMCI];wD}sr=9"|M9qOrDԀNo͍9r]#wwr$n0D;I ̗wGwU!yxY?<> .s2z|ѕ~v{ދuW񻠃wEw}ϖ"!彻Z_<޻A߻g 2u;zrGCTG":WAޢrǥX>r[V#U#}//>˪]sޗc"?SX/o9?cstv Ig7OIYw& }4eЧCߦ}_"][7Þc-d})8Hx6L#'hmfUcYW3%FU.oӦe{?h'x:!MVEϚZo< x&\XEO}~tkE# *y=>)b}]$i߷zGC/ lY=Ay5<::| |iYi39cc(|nY}x܋\X/ c=cY#9+9sC6)U_[۸P}D^)o~ч/GIV[rOyהqs6)Gl'̓B yYɡɡaa/&bžސ^ӞM S9!9%9)8-9195999=8r 'oAWϐ!?4?So G'm}Io$Zş%ԏ?lBe/O61_Q_Q}ӟ0Ӿ0ec &-R,1}bjWVtQի{oI٫?a=-{ҫmՏ,&I~!+N\ Bgw̻:Ǖ3"Rㆁ+ ޽Z.ҵ V +yxBΗdL hߏ#;BX{l {%P\ FWd/xrygՕ=<?>"{)Ω/>)v^/n)[BLI?+}wK?Sϓ7)ǻSt?׋!OCo!DGqV^D^Kh]#ds :寮RU 5OY뿚cs|":&[^dHg룐?;Ç~S! 벐?;Ç>!R!~!%!O:הu)xm; K:GȠy yۮ]gXxݫhe]Gxnnv 6Cy!op|f21ߎ]||]21-6S9֋Kz"z#z#>$<}z>|lX y#"?)i3_/[JbNRQRQ y{߸Q~%[}?ʡ?v;Vg-~$rGz rNgufŐs#ӏT:o?:(Gpkj /JbRL\GG|^C9߮읈/W,+:{^g$>rnycQSSԼbBܳj0>SE'j؆'2UCGG=)o*wW/yFCx{F<Ǯ"HylηL'彐^8 y/T y/4|b>\S ;ː'^hm6)B!dV`7 煼7A[{s yBMțjBɂ!hU3O?zm$K۸Bd)T!ˣXYaOu_?-F*>E@!;a'ga _Nl6ߎ;Һr}߶km2*g{qdDŞכ|J"ɻzG‘|YÙ// w<%// &G:"^2ýEl[N-&՝= L;{ӓ#޹;{ NyMp)3]4%5]4!Wʻh:9-[ʻhJytgOqt.[Q\_tw83)qGxwʻIra}d}XoRUk}g:[A_d:}8`_.St3LGt5 tn)o+92RM3>` 2wMۦxެ}9yŭuZ}և)v>v}1v9^11!rȫ#2>~_}}tŗn9ߺ?|$|%|nZ2ɱ.p[|HJ?A'v(R޵>#wOʻVէUq(7㴖|{JyתR޵="HywjOʻVU1sp{yWД, ry[z[wS^"~G;_%?Sޥ?Ѻ]ԟ6'vG9~~>8}S׹0m[N!o.y4Wznhx};M~TX׻X^IuRoIl6jjx6{o|Ӈ۸fw$zH$m 9#WF̘ {e(לI7VC/W b+14[ѶyV<;5tŞrKyf4噞Exܶ{՚LMa<NJ-pOyjc1'G]Cʇ!]3zui>oOIMe|ݜ=Y<4yy0ry%YC=A))6  JOZry,RROyiEh`ۭ-48Ŵ'0)U_Sgԇ0~RSΏ>}=?|~D]rö_?=>>0.)'ǯhR^# d =1idrxp{GB_ުvo|Ji}g-e/|3/H˸|]yYh'o%P6^'o8ߛߌg!L7d6kʿKȿ=w?)7)6bO{S.EH`!x&GI[L߷U?)W9pDKv3rRhP_Uϱ|_r|c7Q}xXwLσLLʐ9eNMpʛ ]! MpGrWK ~pS|Y񩱞ɱOr rOה몯3oR%ߺSJR>'H=!?)ȿ={G~DM%9)cT3l"8 ?o]e=?Ng{>\SxW#N,O[3>~EǓ!燷aWθre3ړb_ w+"o-yޏVMGlI?OMmk?<C*f9NUvXySxJk.o}$vmFB6\o׻Lny 61swoOj ֞n% ;nNdEG3.[HOo\pI^R<ΛvK} 'vWz J~wk -܅~ϛc=ha_ϧx@0&ⲶpU#y wчή/@L}J}{JcgUx=pv{qY퉳Grv{xG8ca8?9gWq~y~-cß|sSEGxsV#]rX_/c=?6wC?"~AuTxl'LnyCBU{{: A ۳ 9-oHߒl6$!AOS"ӭ_LKزŚZ/,z,<+;?ḿ (>vd,γ-o:R1f%M@Q)rJΞ&|JV򅇓~%QI/ODy@YӸe암Qi+1zVjvJ4 p\^)ُ5/W4MJΞ0앬=+aRs=x>?*qR91WwrTwJ^üQtWJwJ䨴awW&9{9*;{%xpm~e%ygO"GBT읽KV'GB[VwJXR?Vw7I)]v*>NαxuяK:%@g'}SA^݅4?;:9]yE}::9vtr!owv8ttrm;$GwvN'@:|O9cGbc=cz?2dc=cSC_^ 9 89999!8%9)9-9185999=99EGxWؓ`(="=##=$$=e?_lL/??F#|9![//ß-91pka_ϑ߳/`GOvS?6%,y~|=_tG#?Q>=ߟԏ퀙,yGn%|׌c/{; ü4fyy?寶}(}c7˼Ol@?|G6rC[R0Doowg~>^W]?s譒ݓbb'e0G N݊j ě?\{3pY\K \>v+ė5&:{(̗5ك/w >>ǒk2؛ǒq2Xܹ4=8X2O#Xكٝ=ttYi5ص5*vuEY`|8UEsIյyV=l|RMVpni&;8U=,Ad Zh2J+w;9R#"ΞLg 9Q ${2 [&8{2 9e03ك=#uȑ>Xo BXLFd#LFd%^ޅW^(#?3Q$cAea&s9G bоLfݙ՞j7'dE@pdIyTM>ɇO/^e)3,g;yiAӮL0dωdorc"3e_i\DӮsL6Q6#9D1ژhcs=L\ϔqOyz>a<.zv]S5q prG룯GvXɡ/ɡOɡoي+}M}N}O{N{A{B{C{D{N{F{G{H{I{J{ N{L{M{N{O9 wGᯀӟYg}&o99[&O'oN?j_Ur?ߝ| ?m/&;M>=yӯ̀i*΍o^q0ɿo}lݦJϮџ ˤ<詽! # 3$oߒmFU?Qc6 |/Slvgj`]ax{t4n؝k֔hx8v106';Q̶1.l;{ ]oYͭ<`fG.K㞱g;Vf`.s:f5` 9{dj(Ϫ<<ü``քffb 5 !C@ܐsR7 ɼܟf%Cxw>QyS9>{}p)ýk< *xc=qgQ&y տQD) Ka)C5o( Kz囦zERi뤩J%MI릭Mb)JUs![,#!Ӄ!GLU8~M_\n"㙦b>G= i ʸcd_! N {މ84e=MLh|Ҕ\%])> 78=M‘|qSaՒҽQ=]{Tg^㓮oVU7ZO8tOʿz{^wgIS[8mt}~ ?YLoqҕ-6K?EfO8ڜMǷ2vuЖ?EVOWښ)ʶ!n{]z/wk)yely_˦cRex"2Fe;<̐ȓ6%4eadq;2|2_12- Kփez!zm޺ewz߲^ɱ];9AGg~`Oȡo#cWVR9]7>iG[-'eސ^Þޑ^Þޒ^Þޓ9 r#??8%̇oa>?f,GlG}ߴ'(8ՎgAM?=~zۈ#Lϛ^D=s?M1rM.F˴MЏ܏~SȘ~dԏw?2w1kߘ~Uv&3GF>Yc}10x!㹮!-%,FiwB"oKbe*d>;eY6˚b|;VvFփdQ֛UwHP5BX e_C_C,䑆Yt+rwG_.4}J} N}xש O?B#r;__LojFnF{ Qzq*6W;EWM_?*s?i>.{x1 2=瓱ȮJ ϋgۅo^n/nOO%;_w-ݥ;ΐpGuyْ <\}/DOxqOw^u`:4qi^o|: sgs>6s{p+?w舾ہp ;M뛘Ow;ӗv|2nf|퍸w{sG=m')졏vk|wmoVl,|ڶYˏ n:v&νw;槼9<`,aFl}m!|ZDZ/[2Ǯrê,FIykd>2_G|:v Ne|&|7\փeRz!zL@Yoe=c?M9~p ۧ>!\GƢȡ,SI9!8ѷ磏]+5999=9c{A9vU{C9vU{E^9vU{G{N{I{J9vU{L~r>]N{N{O' r8g9O S[l~f,^ϋ!$O7|,U[M?mHmW⏛>ϛ~l~'m =ۿ--ygrD6 7!f^x-|祿'Bw?t xO.o\y߯Y|e}+T\~5gVֈ wOoe>"ϔwkϬ~;n]e5S-G׏=zb/%}9 yR{e_T崗䰧䰷&jiK 7V#Wo[ClEK)x[ǟ"y"no!'gU?\~VHyw}=OۮVʻ6KO>C̦A BthSuW575}ucD';ox$,q$Rom: ߾ D| E`׵u-41pu8/<ٻqbgeqT,n;ȸr=^,O'AŘ_(@%Ajw8Y}||Ǘ&뷇;yߊ㇖頌vCr}rm_{/ƢOϓ͙g;7m[Ǫ۫/o2H(:>7SQn=C/ks|qTs};?r|S/?9G v#PQn28|/ 0}#k<}LFK?"xZ*oS$")J"Oyc>Xa6/1:]cuO=GkVRFփ-|Y/XO'Ǘ1zZekuc+8 y=]-H?O崷"ޓ w,ꏐoW?D2/L⯑9OvģGOGK֟^&ԟ^^cMnHyWB S~'L~=ڔ5Իb^3sW?yܛ+F}=E|zή`-_;do'MΟm{ߋu^9#c<ϝkx^8L{#|GcOޮ=|J{\E>{P¹| G[oɛ;M䣪N[-!fB9p{ aKRѹo~.p^[M?p>`[Q-=TX,za<0 灯XMorlm!Ө7G'*hܚh5ez3k~?o̡s߿_bta6^-uc>y|:ˍhe͗xb?h!0GyYkprG.b%w)Ov~O\9vhc{sg[:'|ނ؍L-ؐ7b N>%u2}<޿FclesSxsj T;A<|OqomW-GK/1ymk;zrkqϵ_eQ>mˋ?r֕OyiMynO_((O-+0%Ϲ?oNb녔j뉔G#Q_oL?/;JmÕq??㮿翩}{^{Vsr+1.cA?W[\{,_HTAyxY}X`/iSAhAhAhxXhΧc9߬ĿG瘯%zwgC}pNy)Od*NyDɔw2A}9 WV#2Z\;2!L}Ju}L&Sɴa/ȴ'd2s+2OCrbOK_1={O2MOO"y?ϐKyC&//9kDc_"/0+忩h$7M?zp^XS˟5}&; _>8/ |0Ͽpx^@ ȏ#Ke b6뿍B1o˿@La :'3nQ%vj>osSOڡxm<8ZǐȤQ6߅ӧq(mb1C}=^+m N鹗l7\Fu߷˓qQLL5.Vv?.ԡ&[:mI7և鵅kg9:S9ųc9LeWK׹MnWKU'҉W_{7N<|Ҝ#Վ!/럢tiL54S૮|<\ {=̹_݈߇;4enBnPDWu(tŒx>un.| }P/ܵ[XG>w Ϊ=LG9pn*buK>/uwGˎFx)-Qxǣ42:zU_Y-֯= =,ﷲ?һyXNGxX\Mj9Z9 ̷\櫭d>PyOwԇ/G֏ЧC_S[]a^8=q{N{9s;簇b/Þ:u{}ҞGޕp~7*G*<2Tr;BSr[BkŸsG /VT~je7VtS˦ğ6";Mt>>#s=t\/ 1Ho]c˿jW aSǤk?pĵuA}1-<ܺwk*wk,%>}ữ϶Z;]|5dfv-ѳf5=d>-7O ܍ lFTO^NWt7.26.lc+nnN՗sFFWWvjKq"՘ȝU+X"|*wc1ޔܧ6f1bpN\ʓ9ԛe ]ssrx;9ܡ>kc_5͋S-zQNwy)]{SDgΟ%13̆ ?DfrS1^9 1 vs#XmI]dlTSr Oj'Gy1ŞpO-?#=zVΟQ=,vO^9*h.xzȮ[YOE5ј? c4i&󧡚h̟-NNF\oZvZ̟8D!F/?7zqыъx=7[qa%7\sO?{-Eg/{#1ײoy,[Gײ}}X/Kie/}[إ]H֕2(m&2c ;]d&o٪1cd|vz"!/NSOKNyvzl~Ȼ3/CXj7GV^sa48sѧoG WkΡ ӷi/GlGW3qSCpK簧=OjiWl?K 7q~dw4udt  @c%:W?VΟ絜un9ng7;PmCOWyچ꟪@?ßCLzs=ayb 8lߗky8psP^rzcEwk4˛-4d_L=R$kh˵6xh_οj@~a;X}naiw5{=b;p<;U'7Z=1߆vϙcO{|y7ji6MlD=و>m|x{ܕܸ=Ќ~x)YFw{Ϸ4<&'ԯ˻Uy%l/ ۏ<؞ Ќ,Hpyy4a ]yzM>+sy;of 57}=Oxqp:8o}^}ՙA<Ţ5Jڗ<.>x `*_{ӕY]ժ'󼢭7_Mσ-n<!jpA3)şsxbxn?_Qs;{#+Aϳ4S>b;'FGOA˲Ood>.r9g3_Ny.]"OS<.4#y]lN޺pqyq'oGE~W>q;Їv."9)8sc!U;w~y 'aoۦO_8 }8xsFGYO,_jW5qؔ&ۊn#,ٲD[kF;i4sۏ:ٵ?Ӽn5A\Zzz߿_>ھbl;Mn{4ud&d7ɇǍway8~.dF%ngyrcyrclwFcayzh8]wwOg*%;H]yɡ^\b;˙Yw;WF87F{83Xм#؝\]<}·n筦^Au伨}9&++!g&c|9=GyQ:peoY;e,>Nf3"/h{2Km_&孚֬x>mSt/۰ͧ7oSCrl,y(O7lhnwf1|z7*:|)GlV_Fq迍99BެHy|{qy`ayV;֮Vաfˣˣ7[1n,؜ں.y"j/~=sz ;{ >q?͓x͓<͓͓>}]^>qU sex6x{·fnH2S |9_/OSʔ*/v#H6 My&Sۃsdꋆ O7PlWL}G>lzS_:>moL}Ln[;'i/P% L{=bȴwdC2%8)yϔ7fL{NwRތG[{ !_qaU#E'[50bߝkeqɵ.l 3Y z?3ڳ3^}1vC¼ex͘6 +N{z{zk|{nOdmmln1t3jO=;tOxza7_na{Q4'{$׫3ar<6Mb<6Y^E[zmxl_ze<&o3*ѤW/yx6k<"ه\e<6t| -1AN?K~[c{㱭{Ǒ^e{ZqOSb<z?"oݏ88M˚';*9vr<zSxexX/a_}EԷ3øx\SsS802SsjOT{dͥ<8lvvt˙====kQ w[ͮzk(| ~l_߻~4﷽vKmi'oGkxdM+y~I˓8vmK7v=dx]U/NrI߾4_Wۏ4V=~xC/H;Pj>ӣӭZ?~J_,,|M,N{#e(5:{K~z߻<+]ly[3hMw!ymZ5~5uCk"$x#,7*eyxi<@)xX}YOK.m7*2?[sXio/a 5şטoÒ]s>:|Evbi~Ry֣hJ"!â Rޝg]bgfۺ+[Nj>s~yhЧ%MkN}b|؛Ghy5~{Q{8UyZyU|<2ʡ@+Nl|r6__t2_-o|l(ɫ&⏛>_7}$W^0}& ӿ޵ 8lߗm1f$Í??v|.$͂<FC?ں]AvnO6 sSmÓqMFey_NkE57O㧝nf(oLKNR([ɷX>[4"yph"y6z^pބ>= |7}OϯMzm}-Cު,LN~oY t/yS<֓@Dzm% {Yejrc<-LL{Y1_ʃ';9z'sCC^ 7hb?K?[s7~rV}EO߭L4kCXYa(_|I$a<~/]Vߔk;?}z߿_mQx*D ~F/_0xܾ!o^ {AFؿuBYoЯٱ*>7sn$>h Fm-y˖Vq sܙm<[V l~Fq@6яUɡ*p)Ρ/;76ۙ,~oάMf?ysތN#]8=-c?Й>8&07`LFBvV_ܿsVdksf!̟kog/-qiw蛻ymB3V|D7w}#?s77eh53o6>qceozyM*Qq^pp?y?8o|[vL,gp-'9^s<wGV̇쫘/Ao Χ:ߺx|z[p>wD|z[P bʋsS޽.^.*UlXʻs!??!SuL}uy>#S-!?lފ2"L}}Ys]aȴdړnioȴGaȴgd;2!9)L{L&Ӟ;' LL32G3f<9O[dca~?yf/B>ҟ< yK*5Ys_H&mǡ_>K.}\@z5п8lF(]MM܄{ J%Z~mkZ]ĊF\Zo~_\zaNÏ`aawed$n롵Jab %/~VDn/v\BXm-Ӳ`ylRfxA/zOXCl<׻'_uX<Tfn>79nHGn{Aw^4_ߟVH;P·|ózQ;<9?!b<Ȗ "σ?6C^/<l/x>}G9=sk?W~_ScZZ})7?նcx-?VksOcz> 1 bީ"|2揹'׫:q=oq≠:d?S |1kΟ?7Dg2}/ L۫ 1DCs{CL? bP[׻!榻g~Pxb5Ԗ[sA6ۋ=z"g1r?'[Y>Dzqy+:4﫲|k<*2Ob*;W>Ϟ:c>TtRi>s̷1+1_1+:͇o}>]^8=q{Lr{N{9sSp[aÞ;?saqG̟L;a_rn2[sElZ2&oڃ?j%jEg+]שɻ˦ğ6!+j^Q?ۍzLz"Op8l_i1so뿃@:4mG6s;_:e7w_[z?o/|u߿_YQ̼\8wq|h=͇GrolH߇?wKe<-츭|]o|Kuq}d)}oQg,{zA#,;D>ϰ|^#aM}Yy?c:|E+[G^Ge*m}VW'rp 'ΡoC9r}N}<}O՗ΡOò~?skΡx'ao{6>n|ׇS簷oii1_Ӟ;w`'ɋ 2 9Ow d/s[TᏙ>99?~9EgO?kU]ӿ;~LyEHL鏃_GcHwL鍹@:c<1K,Yt㿻`|W9O˿^?ϡė˻+v|F6i?b u[\,˿sde}כitkutkle'zCiDo> lˏ՞;zSY]eDlLN߷lX.!OoFw k3aQ:3Eoxӕ'?&{5T~mӎOwDXOͰZJj&"vȋ3+twd^%OsK+se[Y lnF(vdٳY(lQLpc2,G\LJeXRx;^m(׳l=.%eM67}mdkGy۲3s<6Zxs<-L_F+/c>mJqUxхsoFyh򴭗Dʛ "!\9}I}N}dW芕9sCЗ(Bn]9ska^8= kG9s3wഇa/>Ҟ:u{ N{?|6/8?'G_(s;6 G9)LsQ9?Y>:Os~wSv~6}' Ӧ/6}*[M?oZ}0}/dczٗ/ݔAæ}g߹jߖi@C'rߢhH;|:ٵ?E_#^}w8%$aN6CӷR7vb:n.$KLU߅V-a>W!. 4G˗Wʪ6o7xzYH[|^?/i~Isvظ:Y]:WPO -Ϳw u,(';.1 ]r{dѺ)je![y[Z;dq^_d[n-#dxs_r o$T[-㿑cNWgsGrRU>Eѥ)(61^rHh-mY<SyFi}q?H&?8myWs-[PyY/#=oOzD_ kysaUeS_:>%\s/>EߓGb/K{r{5=#=$kEskZb^gwa5mß -ogK?Dn2[)p[%_#W-O)ğ$WG_|He/c?M2UqSC>߇|z '1Aæ}wYVϿĠ +jdkQؔ~>,%ٵj߭VɇqmYw~q}z7gk}(l=(:2 خdQlώKX|4shXbnX6K&llώɶh Ql{޼oֹGâ{Q^ݢ^=E-7n޼V_|0Pvc/Džk|\Xܙ>0ǝkp9Xys ܄ |ތV-1>A漄"E8|wʱ|<(X؛ y?\,{g]e̐w_߼|ק|}?mmϻy~}oot }\ōfAtFw7o;.[|iz|{>F7[v\Xjz?#k=< $kD>}YyW, kOse|s /M|kכKWZ;܍pʋ;<54RޜC6;NOyv^[s>Oo#WM>l}>}*oN}>ު=p.oN{>ȹ}88sCᰧiׇLJ;pM寴?>C/5/oN55o7? ~ k6Qj-佩[Y/>s_obW]Q:gVpgI;??h2tVƂUtv[NvmOV_ńʵۅ3/pEb1ztw4ztjX4/l튇wG 6Eg/>C#tZq^ ãKepC:OMq5fP'u۸)]țﻡɓ;:>HK˓OFCsmRnDS֦<:ZpIwsqzpvOuftH k#y$FxlKXpԶ#t6_<O 539OHg<=;;tߞG9F {1+Z3Fםe7:/]ޏ;n%=+͓#W+}!8 wleKhșECnnd }Y, }Wkmv6C_v;./ѪЗKZЋocz"g8aɎynsAyaɎ>} $;Hv1P{5kj@oXc8|&^2c>:|86y yyyyCשGWpʳsȻ}9 8s#8s;pCЗΡOC:>v} N}9s 'xio9rQ{7>p|񱷘?i^Ӟ?M9ZLJ?@+G_qMZ}Lss8 Os8}_uO6}+YӦh߶}*ǭȪ$@mjz`~,TO .,S!<;HoXݗ? M&vNXM{!k3 .-mw6QvuLFɴu"OsR1=usbI V!yاm,@v?̎iՔjFqbI7W Ԇr{2x2Ww;Z;\n(wC7ꄼU a{B~Q{b=p>tLy~>2jUfi'^߿WOD9h;֢~!q6_UZHrDX]T-fO,*݃[^l<\\L+\~LkZ~{+Ffwp/H!.tKhc;#Ò}Yύ-I9=2ic7j|h5j|V6F1_7ZO|h=DaDȋsF+V!NR^C7ZSo}њ"86O'Ft@#W6ЇΡ/E >/u}zsc^xS'ao^mč=s{#l t{9skps88 9_9?>EOnDFX&_n;Sb#~f@ZᏛ~}vZGYO|~u b[ cWm-l[?Hޓ}EMϧu@wIA'>^;ߗW?qZY.v{qt/>0wt4rAp}A}J`|R}\\RV9uNO7Ly~4yzeg\}T`nefޡ?Z*[g4?Pkd0o3߁;3c!o7ev&_=w>4]hm>K{J9'Mwe(,1Α,Yj+G ;9j{,[<; e>˅Ӹ!.7:W;ONtn:C?7ttpFє@2]\ojݱШߑXE;]L^V$[~>X.zA޴3^/c>h5bZ/}9?|tt[3t>'֭t|s8s9ɜry<)od㴢")d3N>v,9 L}4[_9>#SߑԗdӉ&[odk299bdОioiȴgd;2sK2)L{Lv{N' _pLLLL92!2%鏑a?G sddG_|? NL!eo߆~J,u߇is=Np KiRVJڟ||h={tŠsۿwIvmOn#F\[z?Һ}z?`CyN,{yrŖ7Kd+z4ݗQ(:ó,  t<[I}zO'K{{=go)/8/{)G>ǡ=ߛȢ?qi.%㾔{{zfڷ[肋CM&,(~s;kL2tu+{Q~=hP2'hYI3Nj7ΕsO{>t{ΣGԯ+o¸ҿsf:?M sK{kh+}֙ʝ-wUy+W'7l[M Ǝ }Wpyb5ωaxG[v|h6{\q"-D'G,ZoVKs(ϗ~lm~lj}^m1͆Vʯr=;'߳ C,yڥ>EjlMﳱ5Ŏ/1^1E%ma~2ZU|qк"8cCgWϖe&Xz,8<<}=Wß|M9Wl?NC_j8N99> 9?Ъ!ņV 5c mh0E?6gm(vqD? O7nuÓko^y7rqd $g6OIAr_zxXro$pavqϭzS|){?п?}ữc|y:;]xuh?:Zꗎeq<:7IG؏H7Cug8 +VWώ;﷼g:j7t}漨]~  ٖ?Te}WΌnGl\3*b+Q:G_~-اvgkG5?g&ۓY|͹,dֆ&O#<8_w[,<_%Y !-8"-\AޕYfߜeyK¹0~~s?xE H3_f'A>ڛ2m@5yl!\t鏬rW~Ka7w{Al }xχNfk5c)7~ߏb[/>w[ipF;~ Q;^ﮟfliSm2qHo>Ȯ!.uy?ȦE\>y-q3IZ=x1p5p9"{|o^ܑ4pǁV1_Md>>m<b@z9oCϏ}>?;~=p{Ļ|b^9=s{N{<~ɸG/ska8? G̏?3?C6/9?eA-l~fQ9l?h]j+q9VC>&ڋ]a/?mEm?⏛7}(ӗ^0}* {U aS3xf[[V?C2P^ճBbPŊThv@wkӓnC%t6 tD}~79^Vܜ<ԯ{|šEGk^Y'5> "ۊNsO˾-&m[귅z5_m!fg+9њ~畇Ÿ+Dgi5D+핷j^^/i/5Ӕglw"= 􁢼R_MzVS_N/l~[#^|{;;b&vC^ylwHgb~09s{Љg?./`>\% c|O_ /kO Ϙ1~~s7Z#c/JwccsލiH޷ xXzmxnB9q|hmd>n;j=e>;|(Y ʓsFǍ׍gV6Zۇlud}GC_m]9F+Їw\>u}p9c/+s؛%x=s{GVrKpS簷a^;=w9'oq9w s[v#9fI9܈8G~8c~xg*OO>P]0~sYnazX>y|cy\s>B ݙ ׿-/f[{a=צԦߦ>b̪U~9~Adl*Wm/8G'̓Gp,|vΧXcr>?֢?hUێca k/ hq|ea{*XyVzϻ ֫|Uм@SkT;x6UPކ ?9VA'qr.S9ɜU.26!SmMy%S/ow26/' >L} g Cߑԗ9s[2eds Ei/51sأei5Sbi/ɴ'Sb#Sbɴ/[Χ:pLs>sCdK>^O'0_#ӟJL5E2I7!: J.7a!OC_ }8OOC}\/@z[Jp ojMmcGBa{tŠMnM]]A/b~ca"6p_}zw7P~sM{'=O}?g&_{>D_~m4c!aj\3=/;F͐{>yD6G[~ES_zᵔwߍw~7#F\Vl\֜u5>~/7 Q~K]o"<.WQ>~yf~f"rlm[CC7/O 1ʽ|tj2WTkU`Sy]/ym Nyo8_~+] 5߯wmG(ʹ]G8aѧow+18k|Wp~{]9=s~wU{yUsqjE7sMoUs#o3ΏߢPKO|_kߵldN'4y!l5~C/ӟnvC7׺A|^/#7t~D;'L?zj1~1]rO뿻|^BG':ۜz!IZ8wVf\[ZSԿ ZYXor~Y۟?u|9n˳ ?6|Du#߶Q?wȷ]ܿzۓk/ˇg]偓M |e|S0근sn>cOQnf,L:p-n/:7>͋9snD>oUìF^<ʇk;y|yaUffl[xF}~^?rd|Ë^&׿[y##(7a6믾9}E|G~gkA?|c^[S4[Ozwb]?$[_ЧےGz(,w;]_Ee_Vo'94agzyLoh0>I5Ѿa ޷EA|#L6i}pljl1KpUyrnMqCrWylP>ÛC_S̏}4? Rywá/V} N}>ܹ}88dXYa˛Ӟ9=tn{ N{>/s{p/̏?1?#/83ٌ/M697?No|eONědCd?Hn]z[?mOmӏ⏛7}-^OYOL7@ X MoػCϪkW'c8w=j w$1.;yo9P}?+]Ec4o]1[~Yf{jpz?noMv?`~yq-Ƨ,ym|e'|;ߞB6_]`eZȟ}M^㞏~x1>|MyKz'tDß8'Uy0>]SQ> 1y0ީƍ_5noG|3 a+߹s?D>OO^Hxc+G7\rGח%QUHݟ/2B,>([S,t32lsݏ>[!'nzXO^|~wA~Q nW/gю2Co }c;hFhvɱZl'U_Fw"{[onV{^沅u_[XW{qӿG~Z^i{GA>Z/yϻQ5Fx_Z}hu<,Gd<ͼx[+|AS'oVD:#7|GdPöܔ3L"O!oX&Qy€"+Ŷx'ۺy> BɃg)w/-oէcϣz}H}8 8.?zEڱn߇]3gzawy7Pȃۃ(gEfX2ӭvppnP΍y0}ɡP:7O8;/yQ}vz`p?3Cx, gqnأd<|;x41|P9Q  qiHv1lGNsV$ciM[~b1צ|!ucwA7u]p|dvAtF N7aq 8.d]Mys;<3ú]-}xtmwkGW} %ч#rC)}In9%㥏+7u'a/+cҟ$߄|? yL,.=a?ҟ~I(qסҟK1Ч^7|38wb ߶=;VZmg]T4(]\ϩߢt[ ~ _l\P{mN}z9ɕ6ZpW;mnp..fJ·wҶc^ Զ <%{._r|*׻"ۗ9&tor0Ka+Ӿ-xBft 9k3<>oF8G O"/%GK!|$|#S"*Ynjr.oFA3:DAdKF6觌~8跌:2/3:4o38v}G^>=( wEFl\F/n+۟эD?nKK{V{FSnF!-ϳ͖V#&AX>oc5[}7dxYgOfS9d|coNr>:7َd7;-Jyp/yjmNylm3IyvnM ·CtDqnE8Ygwtw}ۺBsysGOW{p'VFs#p+ga˛Ӟ:=vn{Qq|x}8.}N9g{BKK܄ka5D?-V?dchC.gMmp{wcCwc8?ğ7'KY>[YO>~mk k^_ZmǪ?_2s;m:N~זӿ-c8xr8Qs6t;,n;~y [؝uqGMu0YW|*M~y1kT~nn9V%vws42,VuKAyݩMugŁCC|;Ç>'e1_qa^9|l(7cQ^^[?g40g&C'k';/؍t^\Cu n5͉qOsw?w;ɱ$`/-e7a>'wm>n"i.yv)N=wi]ȳŶgyU+<#!v4wyo:Ǔ Gٺ|"e*)oӢR:h949ϽW{ƫiOF8=r{9sKp8/N/y]].,M??> `<[3_GY>_YO~~7QNwLs b6?py~LVsߖYC5GL][t Y)܂yNvmw@\ĥeߗW?帽<~FX Yk[.ɭܸf_ޔ{[~ sw#'աm[X;g0/ xV"ODžڼc|+g#tIu鼩.mGa~,׭>;Ws9r DSa3ZBuroj4}"zi8x}^8/j?tUZ[ȣS #yc7[^ǭ}ۅ.xmW_R@0e+SBWY:I}UJGVK%QQk%qxDxB-п[jCޮ y}B-sK!~/9îMdI'9Bȃ(''9mH21_g>|;xKxiʱE*׋]z"qMy?)-))تUUSߐc"WV}N}H^"D[185y<{ryl'G#r{#8y!)SV|o~ş'Pk#6bpPk#PF؃wwDՀ߰6 ^M`iIأ! 9ɞmcQ(^Zl~6_{{zwHlݹՎ pݹD(k^e[߲#Z&meяј{(/{ZDo0~>^8)k#?.5K}K&LJzχ}XY~lMm%7vyOGnOZrϒs$_#Z̲*,*~7~Gzz/'H88"=X#< _~rcsD6rq_=B~Z2>+[Ps!Oֈur$a>Eygv(]'uyௗW ^~bJ6菻^wűB_ 9Br`vSPEYX|)w j9[^s,/.q jx]2>ާy9}>_}>tNrףWrgg_ή]_8>qv}C};gׇЗήO9>o];vv}Nywv{ 9S3gwa^:=|{!s_pv5 gG_?}C/9?}QcA?Ї/B'/w7=ׅϞBw+vv y2!?H~ q$;$7~ɍ@r0V}A,6c b}{'rA:Fgd!+CnNl5gš} ֲxݿ޿UeݮzwyqI8TVM#pg89^Kz-N\`?NXRo55Kc)qR#Qg;GL0)Kq\\~G\Pq\S)u8;0:7K.-Xy5Xoy%G{TS_Wʣ=-'ioCq^[i<Ӟc=&Gp]/RQ!gz֧Kx[a?f@s)ySA?jCՎ뻝xHL2#ӟF2dH~Lɍ31y&3߼U8Lfc?dFCA+ۿSV??]0?۹WaO&aCgi#@vd_{Fk~v_JޫۿN 2Z O:-piit9}m:\6V.t+_R9NS::)xn97+x>l8"?ݽ<^ 9N,9'Kcr?iٓ#%ӵ͒.3nzb7*MMO;:.?OCqI`x駯8=X ;V}~J( ;}zQٓYyyoU<6%orP~wĽ2^i^osmhdg9ng\Vts©zd*AWIt7: x/.ywA7Gm+r3pi5!9ѷу+5998=9n'7GWӣĊ>?8!9%9)9-8195999=9p 'o2?;wC0_ҟ"ԟ#g_A[/ӟ%GGmj[Y[{{D1'a,w/|FwC}ӟRRI}g_vڃwf y:NH΁53Eʼnn`$4,mEt?;?z [v֟>0[;\v֧?%8mυd ˣUo\vԮ=K쵮Byhyqɲ뺼'{c-| j`Od F>%&˞۰m|z=ua/ WU'Ƿ1zQ#Ƿ|߫[Q_=x6ʎmCoZ}Kd6koG2_D[vԚKx^o2ƷuBw}&ҝ#?2d k)zonk%/M8-w:/x\Gs|W~zfkˣc|][o<;;q}uK9wvݿ߻_?o".x([6Zݿ{+ӿݯo\^l|mu}Ms9Ȇ:y)>yD߷V79A/#Sc7rT|P6loݺ^jz"?9_.%ǷUkCko몏:LJ>#__r|T}I^9 _ x'k^Ӟ9{t>|#_㰗k NOia5ǷW/[oo!^՟!_¯oUd|c5?x>_I56?ş%6!2߶(j 9M_~L~ۈ=qؔB,s뿻|$cF~Gh`%dϾS-[_?gG{{{vw A9eaaY<?w4i 懝coӸ|9#{ M#{ZtqF/<{<7FSn:h7x}<+[#ܴlVcd>{y1;v}b }7J_1Zźesb^u('gKmi=ǺΒδ,`(o'ɭU^EgW.rЉjrnO׃3o{g>L!{'`g_[>x-rg/cxFx YCj{/i[9 1?`ηp;a%j)|:dDD߶x}%bo|Nv'+R m>C^>oPCK }cї2C??VL|3o١[W>ϛף_7WpWpߧo}U byQwxqW"bkxz8 n"Nŏ|8nv4-Fq-fìDNLyx=彲*"o[wEg)Pw\pÝpOyOxDDXIyO{y>P?N!ovzy{{:&m{:ϔv%佰=l1!<wI}춐7;=䭝--xDY|e+  t60ƣ#3ƫ{ϳnٟ) yuJybyc>Xu/V]21]g|.q# 9c\\ϖ6(##?)﷾}?]RK{46{`qb/%}9 yg۸k{tഗ䰧䰷]589yG۸7!B"?PK6?ğ"Dsmvto_dGgGP<_[َ*w[)o$?SQ|Ky['n/Jys|țC>|mBcbXZ3p_wӵqn_B:z6caCgy D/ɞt.{ ɷ|ߋ͈Zuβ6o+NނdM|n&&it4Fm!N8%o֢.GS.'r&mOO](W?}{T7n#Ŏ#{-]thvp#ӥOPS\Z=-+[y: ?Oyn%s\t].ZSD80'⧗jQq nOWy&/?%?ZrKb=!O?]&o?}ZQ]}9 W?]'w7_#=G9]g7WkL^o }`{[K.:J}c%=v $wZfx-4E'My,넼nCq̇/O"[9UaJL>a}'tFJl-eCC_CSߐCC_CC߁SC_CCߒCS_CCߓ^,yioaaai^=]{>+5999=9:?S|9[,jC9![/ß-8ᯙ/NTrEGφS%Oї/Ӧߞ_}3|nS߷JLVnn\Aۿ YZ%0\tWz6MisCl|Gh'[td_JQ6 Fk~6_^ֺɳ[6zG̫=au{؇FO~B?mDR|YҞm#>|=t!zz~X< P߻p_^\~~-v/yO8cW_s~N{;wF6^vV^[GXBtL?z#z3^_?~>|Z>!ϔP==Iϩ%+?srKϩR#?ڣac{Ӟ=$?"|=G!oOW+yG0__!QC෬?eM-r_;eOl?xUeɃ[U}? NJ[oKiӧov8)z;?{;!!O { mDd"m.5țGJ.Xad{b_-d_E{;<{2u|/?z_yN4軟|gs_ŝƈ>㾯K}8-Q7G~#'M7Wl͈QLw>ʬe^.:^g8s<_-Ȏy}*<N|xKn97S0TrlgppGyJWλrb2qUkj3zlXϷz\G[Ggk&r=\V,^~c*X4>EdH|Ybc=7dwzn8d|?Xmh#UЧθd_iHeeeegb=T@u: ׳eۼ[<.2,HOA^Tw[)aP2^1$mȣ}` d:ԑlOճGPhia2_|flvKDf])d=VDrc=ŞwrjS_SXU7Պ>"">&KrѷG_-Wsr{rp =!!=Gv^#=$=%%=&&='?@' cGԏ?S?NC&o3J7Uw\k՟^}"Je=gm}k_a/>c=MoQOe`W7=HA.ڔn;voۿyAq=3h,Q_ ͒^'{63щﭶ l|ݿ޿.n}uj{x[*Ws(c\:z=>ŧ]GTwńButw:ڏ.t/彑}b#0Fl!/ u\חʞv!4/C}/ɫ:ec?)יF;͟~R},$7,ٮ;G|}X~z<<4> WקZ.Ey:\NxNtx~ gϵry ~}pK󿐼BrpWspocv47a~_%!^Vޯvsx<܋Xx=bXvn-1^z;hyGW}xSެfmXl^}i^Tg\o j֊=9>SߒC}?m^Þ=#p+r3WK{J޹ތg^Þރ \ok? r#Wǟ#|+!rKŸeG1rk6ğhfS7m}?J.^lG1-뭫?l_eOw4_(+M?oN}Ӈ0})do~ٗo*8l߷ ,N[6+q˦ `´D$l:^f${6Q3xo-^޿ o$^^R1d)圵~@T9VP%H!gETzEx2+k]R $z-]j%]nRK $ˆzG-Z:ZNeVzrZPsZSsXtֲ"G]ja9{2rAvgrZ[U,AN}쵾+g-0r shg5V̎e-2gUFvguМ=yk֚bsrsZoq Zq^K9QעsZue8Q 9=#G=3j9{>gQ kb>f-Ag/V!C2tnoڒZXoY+ٳ^dx8胬}Y,&kEBe-I諬5 }(V%5Cgֺt/]ʄ>ZYkey[v<ŠZIB NwSڧ1^ c#[ }<6ԧз'7GWgw䰇䰗ധ䰷ϴ>K⏐_( Z3M}c_#?yhj7.TuzH}S *˗lPiӗo7}+cM_o\e`@ ƵK({yCϷyZ5 7od*" [su~Kg?V&k{x^޿YGxݸ](=Hvz@gHWSj].i87nh=\Кd:?6ۓw}C2i.a?fUq#'rF6O#w$?^ޮ&ӲPu/i-eU~l߼RlVe7%g gڟon64^[ ȑ qJs`|Jۍ.o6Y+}sHwf#NUwk~sMs|~zm|sF-P~|rF-ppb7= wXG@cCǻHFdl',F`1U WI&!f35qc;Vݝ؎ucE L.Y\X݂9 E9]>X+>Z"~A~yB-PcɏTyay>y>.:S|h(=ΣKqWձ`ϻQ{ lyjw^:Zѽ^M<<ݪtOP`gtO'G)`ڐG ܞGP)\ }wuȣz.^8/jl}("Ԗyc<2 "hRy)al)G<Щ91-w(16"Z)uly';K@@(`[WY]y X51ۤxޒ&S]cAc"701 yL<&rB!Dn`c"70q[ݫ{+8y*: ,'{*jn{cXҎ̧j9*ZK|$|h-muwrk,륢DKy+qCgrKy[_ԏ>A7C8Y5,7.Ͽ64j/~ZS{lm(MyzM>ɦ64n^^6odKʍ FљO*r22;7g+kUi峔G׃R-+s:y=8:i;[rQ=yb^y;GNa 1+3;|9:ua\nX|et42;a~ۆ+=<-tn>(| >?6 ]ojF5ֿvy }s'0\8k%ncGkR?r;4.nRw{tKۣKVJ3!|Y)Ju~l,ϿۡS--[.˛,)E>rmXn|_k0ҩ1^Ȑ(My*򲚖"OywJ|~b{K9cb>NЭNXOXo;ncc=wN}`-D_ؾV 8MGl#r+rn38ѧot+1859990} lxTY=$=%%=&&=x?@8G_|ӟ!c,O#z*1pk6ş 9A[O/z֧Gmbj_Y.Ÿ^~iwԺ/Gngj~_܃M!-19*\xǞͼ޳4x}"Ǚ%h{yg?_{{~g4{l|vV%]F+K꧅A+_vy~ŕîÞ\'>?'JM]/vw;ɇ~c')~Vub3v?]y>gghXrO}{(7]? {kd?"{i>g/]Nч(kn.o 6@''퓱w2uio}Օ㸖| Dθ%KIVz {Gr6칱'`YŨ2qqV{^:<Pr--X_; NS_-tZoiXoK;c nZ,a}omYrZz3n߆վQֺFzhm:c7JN7iy˼{n,q5svkzc~>ՕɿE>nG64D4d7{$ֻs|k{,E~%xX%x"Y/z)$를!O$를ay߷nOLd\Wr1ߑ̕jz, Yovo!zDz,9YD&B8C &f=ѲW+Ί>$\B. H}̳J}L}І9 `y'=Yfެ=Z{> MޑW^Z䰷'jׯM9=9rfz[ r#W?C.|~}m ¹_3?G6_\hPr&9х.^Bm}lQi[o/jhXϛdJ<HlBˆ8l,-#^ZH^=-VVܟm[KloCܱ8ΡJtm)mF熸MǕn6‚jmw r[nIr:3o7rq6H|$Gm?#3Hh$Kf9< HhrD; 2!-ʌ0h rDcXDk#&g49EMbFmBhpFkʣh)x4Z4*x4K4w6g4V#+֣DmwYMQ)>)4})ьO%&DC~hIMĄtn)['Qc0)E;?) )Ş8GbGbϜgʣh-*bOaoȣv"$?@EE Gџ?8Y\d}h'{[CևFb}?G1Aӟtv QWM?{I>݃>AJ?P?AiO=\ԗ=AF1џ?+k~Ke jvW/4fɤ^-^f:Y?{5ٿ|y<ۿ>]m\Yݨ,cӚf%r:8/$>%%>&&=ơԏ{R?~Qثgc֏{Z?~qc~7"zY"D{[ᯙ~9Ar3ԟ$ Ng%=Uer6&w=v$0v/c?QϷkw=qؔn'.,7_ֳ4_,p;XF6?# ;8޽丽{AvΟ e^OnO#Z93brȖ{Ȗڌ~&,G.?ju*(ϭ浺ggA]eo=$;hCϬ }SkbbVwSB_7l[$ZC¢y4qyò%dO-1P\&Ƌ9l~xCHE^{|̗Oo䘏ïK|l,mxӕcc=cCC_ oȡȡȡȡɡ/ɡOɡoɡɡɡaa/aOioaaaaai/aOaoaaai_ ?A84EK9!rKA[Ꮝ6>{$9M?⏒_5%,9]_G [݇N~}c?0t?1Z :Bbbߍߛxe?y8uf[t;@أ1ہad_hjFk~6_ S>ٿ du{ͲW5F따o{J4wk3F6YO 7Cn&o.BG-[{N1kKvscvq"w}QK kEe<1^e<1޶y,6"<7M`X 99md>sg]95w]/\Og=z]>}}B'r5}E.9SߑgqKr5~r|wQ}L}Лχǣ\?&7[#=B^V^k(O oaċ\?~ wQy oQ|~ }Z,~ljS뭼6C"3yHhon-w#T=Q^.e!ѵd{N^ ^'{637]㽈gg^|{z Q-X+3 zo6Cۆj%ׯqhwϋ=~?eyt˨xˈ 2Aeؗ[m5}rO 4|{:{oT!|A[6{φgog]뙽mKQ NrTsO>o3Է\bvΞ,"΍g#ó=~i{vK{p9/9y2x>seWwqS3>yWSown(=ozRx7%ws-2vߙ}g^rG5xccc>cUoGpWrgrwrrp'r7rGrWrgrwpr rrr裊jȡȡwM9%8)9-9195998=999 9 89999!9%8i'195998=9r 'o!B\K#iꏑKԟW?`OVOS%ԗ~?K/[%͞W7{~la~ZbnX)—W[ό٬ kme;+x8${63lﵬx-{{Ὧ_길{͛s=w4t {r}mY2;TrNAnw ᭆ\WK&G7K]9z!{9CC38kޜu^?9~ܵ:xׇp׷Ҝ}=ʷ9O)y_ij8/9Ewy{">85~7^__#tx~^V5~?k\s=*ks_Ư9qJnlAY³'{uogN7^p/8&{| ONU 8{YӖ)ߙ>})~~?{yr~K?7csmTyfhx>^5@'/r-lopc|HyĊ/3ϓ7pG;:Ez3Y/7]o\gXyO y+xػqf:~b/5~bok^kޓk_ A.K</%|_[û/5|_{ۖ 8EGG_w_&o6u+;G?ףKYI&5-糍|o 擓oQ[iʞ/<id^Qڹ#7?%{w!ya1/'qnr3rr?A.AEy|GG-|wcv2Q';G[q.2Qgz0|GLw|ov^V^2ߛ_|=ӟ];k|v9Q,;-K#Stalg,ֿ_֭9G۰l}6#%&k%Eܟy쏼И)Iyc>clD|rqAGߟ dأWc={?tX?iiK{Se77E{Sַ3%_I2߫SO"?2ߋkoK9xO4})(9Uӯϒߵ˥LzYYqrҟ 9 #s?aюe-4r6XC}er ,a$7=uT׭'Ed_\'kYl#[{C_?Yޮ?'^~&V)^e]3֮c?My}%d{s-Ýiߌ xsms;uRx>rwފo ԋw@gy-Cz[7EgC}C.㷥y߮=~ne> y:~7~^tnz^|#?g=F_'Ϧw?0C}فYWx>[7owNrzQzLkI¿3^]#~ێVI{gY9~99~?ܟc7ҟ77,-aYa%{}<ox9xSt9.aR)og>_ȘyYd>sr;?c_/ξȱޜ}=:zuLrgGή]C9>tv}s_sr{5~iok^9s^K{\_y/{Ÿp~x_3Ώ_y"Sι?}}~{)Y+g\M̙9uG#卄~|Gцd_,/2[-yßm{Ru~/>  9{QϹy>qO9+hcGA ǧ8w8(h?8q> ڧwƷ8//9_wx>ϡ<|}y}:Wdsd'׷p |<^ǹy>'};ϓ=t>(Wy1 KUŜܼ87]9y2y?׿nCy@^ 9Gxx;\njsoB;m~Qr+B?V xkoC~% Kd{ҿo<3 y>f6kjw!xc8`C79C̗O3g>|my g)z z!zz#z$z%z&z>h6S_CC4A>"jG՚r;rCpKrSv }K}L}>''= =!!=""=#=$$=%=&&='?@9 p#Wϐ!?N9-rcϑ#?7᏶>l&wяC oK?<.e@ϟoT 8l_ÚXoL,De:gZL~Gvt6u XkE{il#5?{_轈F ErkǍ~'71oaMOw>iBI{v[o>Vi_]'S_\sN|7lݹ>_psw! N%=+q?U'G=;הB}B>@{N/הqO/Ժ/"7xqR_|D{O#_c?K~[3*w?꧔E?i/"k[yy׋4*o/](NXx?M_̿NaXLB|^\E/)saY[?m󼸉7q^|D/ ?xo}RBBo!riuQ[ aݏa3&g1?s$I<̱yCS1r'r̷a=#9gXcYOXoX\XXEZu'7)_]8yWW}I)U߂Sgu_]yrwGW%z5M^Ӟȿ=&WW{N{O/@/]΋ȿ?C."y_[㏍fQ9r?~'?_3-?6&'@˅%_^ =qؔ,t5cOa!VilX :af!D/ɞ}Y5-k^޿Mg2o'D!ܤ?B;߼|}Mej=:}78 Yq?J^|=hba3?=y|x&7aq^~:W3|GG9ۏ*u+/??%cM{ۇϿWkC[W>oE}GCcG_ܼI'w~><ѯa ol>?# /'])dЧ̋9¨}:&gK.R0?o$VC~iލ&u%<)o ` /OVx]8]|gr^Kxz#7}["7G_>Cwu>>ܒۣ<>\ޜ>> >><>\ޜy%O> 8wi)o??>/Np?p~$?gMKn7.eWOoυq8ѯo.z-a?+*{9lݻڟ{~ϾJ%|/lgu~/Wv~~?:,G ??<}>X?ѯ$)Oa.|a3C w~x~/s)G5y 7"W'G:8ϫQOAo\.9wp#燷wmof?pݔ뇻Ƿ燷8'oW7W"wnI(zwQBˆ=U<CD}/}};omwg)W#g?p 舾9{{yo1"=C$oۏ`ڇvU||p|{^2O^2AI!*O瞼Ώp1ߧ)\þ7z{:zw~^y 7îȡϜ]9>%uv}?bݞ8="rv{?\?ska_pv+_rvʹ1Gx?dw%36gx\C=<˓y󹐖!Oȿyo~CY;ϗwϷU|R}+3Cw~]7n!/^!RBB}nx%_;/I=Dx9Y}Uسwc^ze%c7!7~BVk{Bf Bfn!^?u ^!^א3k'5ɿx9L9$%J9rD<.oG<^Ix}'x<kvepO{}KLi`7'PԄ,ߵ<d} j㻨{x6{)^gz<0 45R7?7}Ztǖ/ϔ|x>\貯=+:_3_Mcy٫`:OYx~12W <7y>\^7}:?fs|p?:#p}^WH>S7wc3ײxuK^7?\~gIOfop{zy2s?_[:5?/O;w{g@ΛW{g`Zzwtj =_j/n,y o.y ?/z{j Xi|ӟǧr,}Qe`+X e^eO7`#X9X,{ =ނea`X,hؾWuvw`CsSL?_Wү g+XXXsckxxxxIzWGW'xw|a7)^+6mpwN~?y<1|?`ys 'uQoU}ܲФOlFұ$ ]F.O&,ıeq5XӽtgX?A&_L'{dꓙf<`'K|eշ3oO|g'惜 덒5eKw@ۙy~|S_`ַ!~ 3~7:d}ґzdO8ey2_d3*<Nk pɇy ;5ɋ#Xqi+^k>zqpe|?x0>p}Zop>Z3?;%z[쇟yw٪]#5g߭yd&%~x~Ӱ?u>y-ُN㧳3<|ͷ3pg6=1=~M|俷D~o\Z%FIksjrR{kC!m!O佽~f}3?9GB۩?_`чїѧѷc/Ǟx7`#X9X,{ =ނea`X,,?߁ɟ:`{'7G=9+qxx <~+x ={c/{؏+7G#^+ݟxwǿOO+<;̾ -Yr41Og'7A~.azq|e1Ae0.i* ??ξe㎱al˝oV==-<%f?^?A'6q+&wc1旛vރhZ!ѫoff+c[wf+23e̛MV2{oۛo`e^`?9wkadf~/>=;`}cp}}S_5z5~O^k^kpx9xwjo]rs8-JȬMfP{u>|dw}3O/_3\^bOܣ^l$˙}㑲23ۧ;5bsaܙ/RE\Ɗy!ho$w?S<'o-%Ϝw2-m1uo=~!sIYr~z"HKY_]_d{,K|ўdY!eϐXD!o22ŏBfZv2XqY`Lf_8",}!S.od#z93XN= ^kjs#2L{G=$^^L{LI,{O^ILB.Wd32L ?%ߒ]Ɍފ'Ȍ7ȌGWȌgȌw _CdK`Sd[dc_#^#3#?J "yD{?3śdƣϺxKdn"v{6È^F<5}1p1p{z6[8 NaoIO+{cc䄮WSb'>N|;qӟ^;;jo\zGpd;wv?_F}ɖϽ0Tww֯>%az>GYῌO]΋|q>Z~ݸG<`mw3wWgOnVB-oz _%oB#?"OdO T<=ɼJה/=];ݬ5OIf<ŋ+sykOƧϋWf)^ȏO_}@C7=yN_v+FB!/xN4>ޓVVNHZBiy=Qe~Y">6l}4~v,sghoa<Cލ륇K_Oڧ?OP?ߝCY }KC_g\CO'`pg7!3S簷9[9x&O7'fI3;pM_6< o-dG-x}G'^ix}ӯg&9GI%{BO+?^&sij뽯9;x;?K#s{wȿ s1'l]o =Ak8{>Rܦ_)^v6?w{q6qZScyu{}^ϩ_u:t󹜕Y>7_`*23yrOM{=F}|e_kwvC3~Sj>F~7p~W}j?S|-gK|㓯3h??z5_5_G^}_Tϯ+o~]?~wﯙ{+@WϸGhzjW|?~]?~Dh?OKjm%u]tzGs Y`'O'_'}[J/;%n|gWG{rfgX9 X,{r{e/Þeo`ko`{XBU,^j~/ǟΏ1F?~߃G_9^_?7#گhrc!p3.~og_ykfR<٫[jI7>xSY)hgxyc7xlrXw;'Gf y=\ 鹿(8'a<rIe?z^d!3ysϓ[O+μS|#Y/?kWē՟snd֓&k=nkxq<|xꉓ󱦨w2֟"ԟG/,?{ݟӱ`H|[kfџv|<9{{kt?O},ez_=(>^&ES{$i'Xm!s<*X,X#a爗ݟ"ޟx|u)+k<`5Ol11-ׯ?f,ng)Ս>i4V*A>F~,K{_/'ZmĽ8uzxo5o<8:q7-Ixfo&3y|X{:/dìO$͓9+_ۧMf}mw|Mw7ꃃU?w?T|Yo~8Ou䖸]ﳭ^{cF{^gjm/ڛ$/y$y-/`72+\^[_'r0,}%S߷W= ^eOȴ7a+ryy}>L{ =&Ӟۇdm+ \,F^?$ӟoa{20 ry0r0%爧ÌÌ\LJOKׇϺGKf<$e okuϓ}+~O8˧.jY`[-?ydɟY;rm;|Dg'tqŊqo'q}vYwz 3W߾^2O'oKu{ϩ5$s=rIzw>d̬t[n"}:g{=^f/_W\ZJ#VEgOO^O$s |o=d!1G3>͟pP/Wt|-໻9__5/|)>Y~ͽw1zHa`2s̿MaJ-Ay]?/mVw8Jwޏ %ٸ># }'r}S5x ԥ=5m%_zۧ7Bϖd>盿d>7-Z2wg}EZN_;>'3YW'A!lN׫9$նljG;ߙyø%~Osi>~O1^۸9ګ$ig`$yYGLKvp*"L9X&S?7>/`Sz7G,}n}o{>}I؛Gs3X,{ =5N,{ ˞#L9X,9˟`K`[1>'s|/Kyr^ >';Wyr<nIOǜ#^'{O>S7GџIx\>wupOxk4/4hiz(AS}W-erON;>'\O=mwΖu}D~O,/vز?qom|tŏ$q|E<=m/DQwk~iO}hv̷DV|ҽ}o;y/_>5Է~ O30ϣ_aW&7ɬI_b֯!se:^B~+_|]d_v{]#3/~$=?Vf'3` 8w;ᮓY<8Y_W5yvr }ꞏy1WS4;k'W3_<>U<Ŭ7 O'_3_ܒ>U'3x'}^8+Y_<зX?1+B }#9f?n>'Ϸy#rKRW;ORK]`t}I秔> __~CЧ>Ч>?If`ix\>8G^IFw5+xk~LS<nIZ~x>o=J(XٳςЧ+u'Bkݯϛ}Ow{Sy<1_>X>6tr](;OW+xG.jG'?t{;q̸^y˾V)-OB3Bw=m?0ϛE7)r1/?O'3ϲoʿKao^|Y;3ߒg؃{_|dw9~wWc?U/ß<8ws|6og#s3Oz$~z{k_>̿NNxzO#cc'<W##cw˳Di8k&\N |[OwXTOfS#w|);?گ>wwr5|!3ߤ{;l=מ̬G߶ho:`;X9X,{=r{=ށe^eO`c`s=X8 X, ,:˟o`{'7#+^++qxx x x9159=MR< V(XijO<^ ;ٻoo[~xx~{}fx<=yO|$cR]R'~>;óyDܫ,{2Xs]p|X?wb1\?#~ǫ7>~s~>cx58y<#>J|xȸ~G7c}^ě;;>\#~^o3⥛^'>UqMVL_m~8˷el j'W圏g$ݿlxk!H/gysOyh;vp/N{`2ﱝ1s{]=/䙸'y]I'qx}aS|0'~JfԇY_'L\>'qKNܓ=!ހeȴWGgd;fS?L{L~,{~Pk~\?L!{y!y~Y_Z6n$i?l~w6?H=I>n(]?y-5ıu?wZG뿰vmb7O]t.]ycσreχEds9H/~ ~z=왙ܘߎ66][F2|2a>rdw'3yރOz"33d&s?x1azMzx3d/UzNNMm|^2>Yx>g>7z}6;ēך|sH|6q>]_}l^&}#I"? +=u>[_ɞͿzynzO3?yz=v3Ho/1+{|I{s_E NTqzGt[v0~Js|N'Xms{ }.- OO?H+Ϙxx9% }2-p}sLS< >?x9MW)+^^], }~z~xBWݽ^ }| כQ<|P>X+ s1'gYr41O_B8NIUf'R=eW u.,nwxĽټ_#ݸs[t'y+{>4<l#@'GiOϋXޫ7lyXqMɃ~qp'k+$s?;9y'IGfo '4w:@>Oz:_@ngxd/5џXI{d#-x%O3o!O3!3?9yQ︿'S._ryif`$3o|b"ԟf:p~/ߑ^o5mx`xh~{}xꭟO'c|"3߻^|U"uEhxx x3[`ci'~xxO7STw,7տ>w*OM'kz3$ٖe] 5>ndpǖi^=սth%޶Z?6Qt6d>w1-'~.?z_W~kOl]cߓ}31EUm򨾿i;y@%>$h'GIx޸땓Gø|cWk yԑ=<9`3QgG1?;7{$y3cfI3/g&y8G<^IwKG['q+ɣxܒxʾOS[=ww<)﻾;5kX89 R?>~u=g{#3 dY/Y|XZ}i|w>YMmy˼9\o 0%Vq̇CUqv+xlzȲBx}Se?; ZW:*zuyh@5WyObXx9,d 1F {d\^iİwbC1L{+=^aŰd1D #?_wbC1L+?_)/{211 1 '#d+b3쯌wĈ%KG{{o?cz+shj~WZ?NPm=7ߙ7lJJFc̋|h_KgjA[Yu̇jۙe=Z2/zOO|⟽2#xҿ1H#;x [ɿg b>/g7'ŋ ɫ0>7OA{8OC7+_3wg~'fqJO߂y1cg>{*מy߁O؛&{\v<7i_'L'53ۏ3W#do~L<&naozOs7ƇQy;ٛ>8}m7.,BHz_+~X{`Gg`WhO6%y%/$y%oCOߺ׻P՟Ρ` XԭΡ`3X=^'{eg`;簇`}V#?-X95X,{?_8?߀W`3w`C%X, ?v ?߃/8G<VV<VV<x1VV<Vx%{s<nެ:G^ެoO S?^:z1ӽtgu˰8ScFޚPO.'A?ܔVb sj~#^OΣJ;Yd^OgW?}OwNwʾFcO/a_.'ϞW#KᏭ7Pux}zO#ԋC=hS#%ߖ̿7?xxxX?=Ss<˓-{̓G-FOwړ+|qxxg_w?ᯍ+#Yχ[]/#IdQSO/ ϟ2דx ߮xixW5CaBež׏O?oM?oM?oq6^kR{X^`OmӒxxx=ŋ`œf/R V<:_^ς=Kٻ/OLMܸ%{x}/?H op7l`ݿ^{r7lwf;ӽr?]{=uLO6wNbMx 5>1,mı=^n~?-;9W=4Z< |sy<ma7޴W9^[wt2oΧydn';߹>e?ڟ'/~^W|#xEu< ~3Kz< qϻxDS-߯Oj[-|;ߊ67A}]߯?oY~u}[q 7#z~SZWgOfŻ`Cp3p:2/|YY`1u󃜑xiٿreև[#o7zM]6*Oxvy>x{y>g<8P~8Y9LlVweA~ǝg`K4~JV{ƧԞvP's$y%c!oK_O`O\~#گO+؃cOޘaOEÞea/`[1x^e-@|=%FL\ƓxFhd{qO75r gܣkxr x/!n~wEī)f%iLs<.I_}M fxxmLclO-[Cv<C'gggF1M;|f')x 5?1wı3?< h;_ĵVd6w>w׋].O #_{~s>~6cϏd.箿/=z}hy%͐33!yhr+>HftyYwӞFkokzްd~{D} n̜$ށls<N<~-J|k<{-#3 ۃzN@^iO2<f=c1ɋg/b )Wz^RID w.12sy->33?[/?>-wIn~}267KмVft{pًb9q@˞O&ʞ,qG'^y{/?;|܆L3EL+^?^S^޷xx~ojzCϛ=-AjzSY^gC`?T_U?U_UshR?GG_Gː9>`s|xx9%Oo>x95)+3ARIIK3O{z=A۸G{xZ6!%"_8˖eb>CuJ J J݅=zaw+0ջh/'g_w_?L}z_Kl~RO/jn`$y9<)n`S_?[ ,}KWg,{n!o; xg B5=K%{ !YאFev~/OvtW{ݛ]2<뽚/v-dԗd/IJ>ٱr3k~bp򩙹 _̿[ɍ૿/9ȓI7m>̍_^p~ǹp`;zzl~2/'ҹsqx>v`&<=[SX9 ok>ο߳x^z5?+j~~Cd=e1 {^g>_~̚O/'kv0_8矇_v덯9jzͼ~~8#?o{f"ZEH7ɐ=oʾL}^{axm'뵰v, t bzz {'.X^B{ٙ%!$zcfVX^BXo)?z`gIU+X e^8=ހeW;,{=^eOނe`ssX,,?߁_O`cgk`{''Xxd}gRV<V?ox5k`s`{)+^4I/)+5UYg)5a)^vxzyۋ;kϛ=O4k`!'X>ؒ#_JO|;j~}?w='z6>[mXdxQw=xw=xVO4na<*ϯW?| gwy!;գ?bypgG?_>cywO5CuɼE8X-ɿOȿlO$B8/mBf&gK?%{c'땍qy52$xo&?>R^I;{(3/=^A{:<>y y%O}?_O`}BgV?/`X>Ρ`;WW|'o:v>|/OvߵUwۈc:˿z?Uۨ6χ%Z>X[djUZmcgdvf;i<_mḐK"둲>`>32뽐ߟ|`_'32yb>zd'y>dO!7'̷ *];}#3ϫQX`78y;?^d?c\JO'o<=q-џZ##s=|e-Sxy;S|dџ}^_^}ϋ9_J>џl L_7GWd||eĒV1sU ydX/+)XoQ/|,nQVܢ?fۧw;v}&&d#_36y?{"5~՝T;[<~;)`-6 <UW'X>bRY`WX>T[O}q}K굗`s{hX9 Xzv+l3S^]aolϝ׏?Q?~MW^,X9!X\S::?˟Ok=9+pxxܢ?+qxx ܣ?+rx x x\?]xR:9ԟNG'^x~])vx!`ۦ)7N{׷Wx~<{_h˧ZQ!+bNl[N'W2fi U&$5>н|gu>DcҗE~x>"w>עuϻ>O軝w/s?tv>VԲ[W=7w| hŗwkE[ߍg߻[YݸBZW {?_W究G'o\% }߾Rw{=?W=nonUnU|e<1MN㚟8On?P_X_·ݸ5f7a|6=?0}ߞf{;|7;=?-ݝߐgo;p\Ÿ׷Qk"^mϗ3zM/{ɼ?z`? ߌ?)ꍓg/Iܹ]S}y2ψGn}ßϓ˹}/;⑛o_=Fo_xOӹD8V/"V?"R{;<XKOD`n%sX>o`#X e`doG`+X,{,{ ea` T?ߨjXMO ,Ja,t ?'x)#`+πu֫%)-ǺקWYO:ϑ8OovOxxcg#^^paRm};q;un#޷O/t6>Gf{dP}_-<)SXnYNgc ]y.ܼK߽"N[ w{ozi˞gxͧ[]}x}N='󣑙/rӧ E=:]/)>~2V+żO{>R/0wZ U毜=]jNwj̇718Myp+=܏Bf1O|ϧדYq`&sA׆yf<|O2k~w _8O9ȇ/I[}n>?_O3=>^ }F镯? 3y01xWl|B[CIZ2Ͼ CB=L麞knIBoBBB>@v><^!}--_0K]^=o/}}={F`ײhO;x,ydrX\B`/ӟ֧Yџ輦I9 ,}K_g8X,{=r{=ށeaO`c5X9=X+y˟og`;o^>%x%}9Y>_KKSV!.xvyuŻ|mD|m }6"g˷C+_o }wDil/61kDh bmogcmIz?f)W^wl;|f'tX~d'6Nl^{=t?cJmo?Ϸ/}i ʘ_vFsIgE{|롾~oy-{ OW5_ait||c̋}о_{ U߅]~V/1.7%0x=Bo󻜚jȋSxq~o~>c>\ÿOy7_~^w+{}|>S~roIz5?/o3I|0#/?O#v;{[~ yoVoK݊ہ>Ycʞ4|(o7wYG{vNyo߲'+w{x#;=#L{{칯we{~žw[/ {>y=wGf^-};=>}Yq|Mu|Ly|Lm #I`zk %yFԟoSƲԟKO=od}K5B-*YYy;{J_O%{g +xx\G/I=[jܒk- =G d~B{xxF={zz^z +m?̑[&n"/r|esȏgke_%dgpG~{<|o ˗}~Zϼ~CϬ|٣es q33q+#(ɜ%s ܙ0I~ 2 2;9V(:OFfɾ߳ ~=ϩίW["U[ߋ`7{mgLjjy^fR{V[K(06^&y%oOaSqT}}Wr+X>X⏤/`s[zz폞>Wk%q&{=ހe,H ,{֏{Z?~qk(9X,˟8U&?s?_O`s=Xs ```#π/9G<XXX\{ZL"XsěS< VZ~VϦx5)+޶JٻKw~¾ߵOxf X>_wRbؾK>Nl_z=߃L?xḠ-x 2ͮfxo'-x/|>kV_]{o[&ow<ߚe%绿Y%5?y^a*f/|hOSƹqU, ތO;뫒 d/x3~iogJ'Ȝ_#:ȇO| xs'̊Wxt2'5s>OGf~{2ϳ?C"7ޙ#3gY|̜w}gd/#>Ẇ;S3fk'sM_֚y&{דzJK7֫y1-7ߥQZCm7ϿՓy%{l!{syd/FfgjB31E77Ȫaon>W|nzUħ[z8t 7^B9>,y W!y W!y:V? o6= V.}K_Y6|YΡ`ؓ7c^={7>p|S,{ ˞;/'`T ?_ '&6/`[1X99Xxxx9 !爗ל#sDV<nޜOO9>īO)+5EK0XًOoI9NpM ccu|Yl/hi)ȚW_1usX.O.VB6Ƴqz̽,KO 6|hP/nyeׯT.pzU3ϰ/sz02װ-+1[ {5r]o>x]`}Uc__O^_Pu^Ow}^G?ԛ}Drgְ<@aߧk=C5D|9C3\y>$1}i?gFn?;ןE<sIܫ%Hsx?@vGݺ@|HkTWL?ưEy>{~c賱cY>OԻχ?>og/ }F}K뗒Ki'0ۑW?O?%y|&o8F'+'Βd3cB'VM}>S|,އ{?yy?|z+>{<^^?s<[ cϥSǛ-xxt"99 pӴ7G[b}>B;8'V^ 8{l~;pii/aODF18dUO?_߁#WgwY,)8-81>9=>#m>SxM}C5L}]=pM}]yœ73^?gd/apK}FO=_||4^D2= f?d>1sܿ?3A?WsVK>=1~/=|a,?O|brKϦBW7S.o}I\Zvu?'p= Y߀'_o_rE)r5< {s1W0;Hq+e )d OuaˎG_-}5kaߝG?\r=3pw&W-}=~C?g/~џ#ߘ0:zb?޻؏뻓  f3~~  |-0/ٯ/Y\`_v=ӅsnBi仕</ަO8e_yތ[6pYfqYomc(AJ}g?-,_c_V^5k=FL^2),/78E^dʳ=_y91^Mr<9dEƳsw2L}!S7p#J>d28 L{D"ӞiaɴdS2-L{ {N'/'7d#2LG?$ӟodk298=8ׇgȌwȌȌȌofFf^;υܿ=kϓܻ=~t~y%*{}K6K$|#}"z~m3G{5w>O_{z^/%&[So&J{q8KSWH6>ʇ|e5> y}?i[٤~4yO]D\gEgNFf⻠ǿx?~\sNC\>o[8 e .(Eƣ-6zCe=zϖ1̧nXbM8ɅqVx[a&_Ga_X7z]eұ+5c~ipIyXM"o~/EH~ aSڷz8N"o[~яEIsXy?"⇢+ݿ)-xEޯGx+Z<6~oyρxxM]y=-]~~/~|wyo)ye?)os{v)oo^v,<ڌy/)o|ƞnĞWϗ {teg>nC4ko#r~opE^y;x2^1xx_|GrVBbO3mS޵wmjȻ?wS ayū>~2Oя0~#z[i<>=~яWf_d`Hf=/bb?y5ڹ?5?5t}zϷmg]P_ x<{gܿ?[v3ro|egS ,EV~pB?-Gb} ܨ ;c|cC?E,B :~Caa?V{YziSiiUQԾȣ}vN3;}!H."/ DM?ȣG9yE14'~qQpyLS42 \EK;ck^|MyGOLyO5ыNj0B;ћ8/2~;;q]dn)uEOW,bȄ~_{a^|y|pmIJG﫛y&S~Sy)][Z'2[ 91^=q.3L}V3DuI}$S_gú>E)h؛E8y\RD".\D]!8%y<[ry189y4<^]3^'Wg9p=3:) S~=ve!il7xʺ_סNdsn]]5buݳvns~9j;a͑Ï<x> /;z)<켫Wq3zA|/ /~\/8Ee{K>]뱼Uy__,}{w(׋;+aa[!O' /b%<%33 |F<8#+8M_џ\Cy {i}̿"O"?es}zȷ!oa7JˆLJz(u*Wa?Zy/oG3geu{y4?/ Z~b~][~c[xJ~+ɟ2ޖl$6}ʯ{k',)^?5y=8'y|ֈOޗsbS}{"/pDIKOW3S3׋C폧šo&}uN};_^^^^^;g=ϋÞak_zV8r8^9x^\//~x^^s3)j<G<8zkx<Ɠ*<55x[YpĻpx9iOoxW=[/}o70;Açr׭U}Ҷ̋?T 8O+>Er}Zvm[zB}*py~Tn%s(OS7k\ƅM`!z>祟x=CTe&sҟvr@=: eow T0ϳ[c!OsuofVUn8oBKި^N_I<O/+gO_wG¨ʅ,M7'U#t~yB.'A?(7oY5$˩1|z'#+]79fd p^Iqs*_s?n|;=UP'߲۳7^Ϧ!\!׽Bܯ{?xy?kYG|_:w8/Ooxxx>t/'Է~ })Cb/aOaoaaaϜށ^Þ:==?pN❾߀_ß9??헿??W<`_po#޿=p3w:q8)p[f$GfD9H<xē7IG5 {]\>q{~fx?Nf19>8sE^VrxJaWVx?~z\uho7]Λ.&aQ<^o ]_瓜cO;?[rXϫ<aSʕkv^''WÅ`aϱٟ<GH29c s { .|S#G>f[kp;דove+8Gf=/rC Mx79o_#Gߖ~ `$yߏԏ.; d|\olx\/Ef}?`uQE]mdNN93x  ؏H^9w['߆raLa?k#g {4r}K%ߛ?.wg9~>,l?678l6y"15^55ެGpWpgmp8 }uN}^Þ8=wyM8sCpKpSp[pcpk޹+88sp#p+pw_;?G<xay'o8g<xSplL%^|ox ~-Gxoy>ZăE< xģWm`H> endobj 72 0 obj << /Length 799 /Filter /FlateDecode >> stream xVMO1WukVBm%H= (  ;C@@ಛ}f< X;u w ^hu`3߰VlN.|ngkvzHR6 ox0:@ڲ+KvpӉrYC oc6al8&-ʯ8WV0Bl/ vθyɇW)tgIj.g1ie$ c|8]Cɿ듎=j^V=B$~ϧDU)C)cAes^ Rz׸ܣqZȔDp& 0Xxr[`a5FtJeT+^n: 킈;;Ŷ2^Z'i4;;uve+X`.<*J`(4 A8q<.>u8|`K l4]v~82-/ bO!`Y7vy9<|t4Z4bhzZ>a0Z] JB`L %! 0$A$ddBi$x%> endobj 74 0 obj << /Length 4394 /Filter /FlateDecode >> stream xZM?bpffjDBI$8`d`#S=_l~ݙލW~||qx~ܪFk;kNz?GC/?;~㫯p -z5̈́x YDŽ0Pׄ {sB=1A4) z{OC?{C}?'OWLE#oUz=}u}wzOOuuĞp).XdՏ k&3&gz@xAp˵3܃palymߒ @,'M>[Txl\@xzD#G#@xB~l}D,# 1X**m`f.<G```g<@Puv4 mgՄm;# 1Q~&*ō?ጀm0Bn002C²7.$% O|ӯgmEqb_øq?F loY\czWMbPEEA=[:rDao`kGyA46M™A'sc'QVlir< %1J4%Cbˑl\v"ߏFGfr$y#rוyii/m3֝iovm;53-}+t: :ʡX?ΗAS ,Se֥r(&NKB I2V^IcٖͫhM&rē얏$( Hj) 룋"j-RR";)R=QtZ\7cuE(jb%6?"S\cܖS^"p7Y`$q0EDuG?E>I'-',-{MZt6G?na_lb0q!C1QAĄxpJ\y#'CLh?ămS'ؗZk'!?YK4xp"'c><%މڡIOkbBrցi/d'.u$&Z*߼Gs&?1! -!=G#Ku9>A\$]u6uDO%/ o R3OٮOEq"EO ["ß{~ԌK|l D'?Q}V`q|P/0W}?8N@%iv{ ZkE= y-{ai67Iў{76yq^qs7\_y^˟@ +;lŽ&x 06#޺%;U+^`όgA!xBYtO> fbxxSi01|Dð(|E&3A"La?%x`%1g)ϟ|+ъĴk,s؋!TV>ci3qO7g"G>w";xo 315Fɯ3|| iz&ol[|zz ϛ:Gz&_zu-w>Xp5=\zQ|Ea&&`96mblR'\~yJ!ۿ՚>/JU|QH3 yh򵚿h CV{|U*o?eEƕ] **D38O/aY+a'F`qU4;nk{?żiۃ|.ח=n{<󼈻T^MPd'߈kdWa31ʗqǃ&kǬxOLxd/V<3^5xVq;*vt ',QqO>ROeJTL/S_5/OU &S+'+5i|O|@\|ai|[{l#{~w3_|:!̗W;RBoivc˫y^Ew><^}uǡO0K[o#}Wb ;/x)㏺i1I_s;#ѤCjP//^`,=iDTTo,=W;tO / 奇˭w=]{h@~%f[qkk{K쒽G_r{c|k\{?e|ǪU#spŹ|Rendstream endobj 75 0 obj << /Type /Page /Parent 3 0 R /Contents 76 0 R /Resources 4 0 R >> endobj 76 0 obj << /Length 4395 /Filter /FlateDecode >> stream xZM?bpffjDBI$8`d`#S=_lyݙލW~||qx~ܪFk;kNz?GC|WGoB xTEzy]_fBۂ焬w{cB k€w=9[Ӟ ք =ݽ  csi'O}>{+&7ê{>;z=v:bO8N^w? `xzj0rE݊]^?ҔUݍ(0").XdՏ k&3&gz@xAp˵3܃palymߒ @,'M>[Txl\@xzD#G#@xB~l}D,# 1X**m`f.<G```g<@Puv4 mgՄm;# 1Q~&*ō?ጀm0Bn002C²7.$% O|ӯgmEqb_øq9޾$(>X>8l{t W' :yA sK4'.b Ibx\bx*j⭘JAx-AW<+AR`)3o!o>Qq?j%cn>fEwɆ,|pilbT˅3N&N~'yJtgb˕$hXK8#s3#ٸE,q/޿XQH󘹓IGj~+";1^\۴g;`v^qkg>$ZVKf#h෭h%cre-1/bTKgpUCqU"-5Of%j +Paź ãĕeЃwvo~es]k4{_2 L?dM_@lGeٽm%YkG!xמ~x;E߻kRĄ_+t1I+p4\NtTʌIrlUkF_tTT+\8N IjtB[2$f$jE=ZBR^Z^m jwpyvDKZt g#)$iI(4xv3I&qʒ v#u{ q ۲ymDxE vwRZQ4Q-E1Q!~}t]P-EJCdt'E'.V_TFqREM&]dblrK$&"˼l$hݟ(Bh'IEx}Sݟe/InՆtC'"2KMB,?&O4x~>&!O6+8odxixppM*VT RRzM$'v ?OḋrAԒ';Q;? Zɳ}rB\HB:0$VԥßDKBWbObB'&v;d`Ǒ4ݟpd n"'?;둤~|ԦOHԵEOj))#Orca1??1_ds//q^q' ,.~cjǩxc=~DK{~Au=΋P<γK:{x 0kr#{ev۟]m@Dxvo*-&h哯ل|&H\w4,goL$&L>o%Z|̓e|.{=1t 6mf 03xWg¶uXdCwVV>-5aF>&&|>usb՝~1m~SO^քzmOo[y_1[џ4K[O?nEΧ^.7v["hEܸz'GSzH=*Eҳ͚[r!Fveg94zwړYd/V=_ef;ny@aFA/ގ|?{?}Htf-|#ÝAi'ҵ:#gkOl:St'fwb urVc<^Z(!p1f_*[NfCu^]‰57&;N*NwE_XX#N 1:H5b:8ΖNb0O68QWJps{АCٱbzpe PXMó&&h!5C Gzch"Ifب<ͣG%.dk>3="鞎>q?ZMy[sc=_R7Hc21:x1 X>MLCXv{1/&z=z?-?}c7̒^w,+mث\MӾ0* o(qV2lę9ަMV Җ/_2Tu2ZU'21E/ BCw8 SVajJe Lܸka;Y8_4#Bh|TE39=5k0=pe u?.~{ÍQzmcqG~1m{/'qmo~=w1uq}+_,YaqmJ 1,&f=]"xd/447Ioe݊Guƫ&#:"xA2@nD7*nGlR)>w*F=RejrjG>UJȲ-ݎ|`y55ϫ<_g3k08Toi #zD XL=x~zGeC#~^b3O=eQ"P?M=F"i+z|v{$tA Ћc'֛픥Gu|3*x;wp7}r[o)KW{zM-oߜ@5} 죞(V>%tA {b&OSYw/U}Ooāl5nu@vo=~ɞ]KN@>;y{ukugAXW߱c8wϒ|o^^}߲۟~#Sfendstream endobj 77 0 obj << /Type /Page /Parent 3 0 R /Contents 78 0 R /Resources 4 0 R >> endobj 78 0 obj << /Length 4399 /Filter /FlateDecode >> stream xZM?bpffjDBI$8`d`#S=_lyݙލW~||qx~ܪFk;kNz?GC|WGoB xTEzy]_fBۂ焬w{cB k€w=9[Ӟ ք =ݽ  csi'O}>{+&7ê{>;z=v:bO8N^w? `xzj0rE݊]^?ҔUݍ(0"o}<ܙw1K~W^5C{g|`I&TώӈIf`ӫ>>3.ca5';qH1FQ2^hSfk8`3 NtL@6 {(Џ- !ҌY3*HpkP8j3=ߡb9qAqr1 9s9 r͹Qrx`,mxnI|Q88%|9q'7zf/0,!"cuG@:%+cd?Q$lBo@h1`eD0#8Xe0BM0E'c,PT^# 9!࡚mg!8O"Aq6B6ڙ F@hFfHXVƅ$uL30(nSl 7k7NQc|5C=zUX{?T~`m{AzZu^*y3wr?H/ue^Cd'fڋyuuڛ|?lۢ+ṅAKߊNEr(hpK`u)" X*TdK+/⃣S2O(8RwVpv*u)Z8g)lķ1 3 5`,[nݰ%X̒قz l6\2.x(J5vŢɬ$WMpew*cXdx2 z6.ͯy7qfKÕKvw㨬v"͞$ym6c]sO~{w@js0+`. &1wbeԒ&1kQÉnՔj8Z1I.`M֘yeƒ I0A40IMNXhKFD،W'VKZH KvSK vC D2N|dN*TK88#=(&*į.RHIqHDjKs"qXYCD\LqCr[OBzDDdíOm0Eh-$ßpZSE7iy؃ӭڰn\:]})Ie`~DQB<)sE1 OOŊ C ӟ`_j1_xd.!GZO8Z$<{'j>0'Ak?yOU IZYܟĊuhI|?YILTHĄn 8,aM'vq=t ?X(06I0?e>%qĝ:?U.\pl}# #8'' beS3/Ջ2u ß7DYE4At TSX_85xhiV/цڰߴ'E{:ݬAyyv} rI?t/y-s7^dn"x ;(/؎'^XxVxVx?33 e=M¶'M7t â|1|0%L>Mɗɧ<>D+^y_%c/'PY]v>#s|#:Lضn;|HΗʧ6w%&$'|N=z8o ˚pCoоm=m3z|n2[c}rCG gtFYӫΘe {Ui4zނ@E eG= CdÂF .izQֶ%(ol狒MN G&Q1u;cڣLy"Q~_TR;%l'Wm88=`۴qJDBr+]n^_Tk D&(UE!Qh΀aj1 9Z흒U 4Wv- 7{'fD >qh&Uf  5DžW`@z8Zm,hگR>mbŲ\_$.ͯgX "Sxe7q;A+/c#˟4Z ,#m"?_i$,+_VⅆfW*>S1yNC~ը_,>UM*|OXO&f>|Ԥi=q>q9򅍧O o}+[ߑϸ~=̇?ۿ3_^ȧJ Yvۑy,fyl{M^?jz-maD[a^g/OS憎_zhKw㩧?[$ꧩH$M^#CϑnzD=AzQ}LQzSot^%=?u'n//^=tt:ej^㣩훓w`}_}n5S~"X,^)c?+tž 謹͗83mƭ]/ٳKg'qqnl}>;Vp.Y_w[/ہSBendstream endobj 79 0 obj << /Type /Page /Parent 3 0 R /Contents 80 0 R /Resources 4 0 R >> endobj 80 0 obj << /Length 4520 /Filter /FlateDecode >> stream xZO1KX0mAI$DJl) 90J^?T |3]]uT+^_]>~}{~ܪFk;뻗?97G!\>~OpW _-z=꺞dBۂ焬w{cB k€w=9[Ӟ ք =ݽ  csiCx߼?%OWL7ê{;=v:bO8N^w ``6.KS:_OWIt7^ӣ[È(G,NcBDŽ ?z1±c71RV2w߼)<}@hm|W|fRwW/˯|t0ꄪzwEފ:h%c]-TTVq_滀 A[:bnPx@h1`eD0#8Xe0BM0E'c,PT^# 9!࡚mg!8O"Aq6B6ڙ F@hFfHXVƅ$uL30(nSl 7k7NQc|5C=zUX{?T~`m{AzZt^*y3wr?H/ue^Cd'fڋyuuڛ|?lۢ+ṅAKߊNEr(hpK`u)" X*TdK+/⃣S2O(8RPpv*u)Z8g)lķ1 3 5`,[nݰ%X̒قz l6\2.x(J5vŢYI$O*cXdx2 z6.ɯy7qfKÕKvw㨬v"͞$ym6c]s/X'!7$ӵ^QbԯGH\ A8RKtBE ' WShe$D*F5 W:[cF .W'$5I:a-[I`3^X-i!)t[/M-it[/MQ6;<;d%-  x$p<$heI`Ժ=8mټd"IH.J"%!2"EU/Ez8Vm`)[dq&v]bqqS.2E16m?E % we^N?SOTwyS쓤z"n)jqOѲݤa^Oj^ppv&! 'A<?E t`LLdKa7{B<4CV!V.$!WhBfq+ROb%+pd1'1Q!a20HOp8OP7㓟HU?p>jS'G$^dZbF'5HZ\w'[^Tpɏ0ܟȟ/2OL͸T/ׁ@tgux1PMc{~5x<Zⱞf ~X]c ^ײGj~Ӟwjcj(ٍ?y%н D߀{9_.ȶ{ x`Gcc;xa=[Q[&x$όw.Eb6)&_ێ7G4 WlBL>$.;3P7 &_&`ɷ^|LL{M2M>hBe:63_wD|Ch~+z3aۺ|G,!q;_W++xؚ0#[hk>:9\?g☶^y'h/k AƶϧWx~ЏKSĭOhQޢSu/ ^Su;حXCzI"n\N=a|S=@^zȢvfMwS#Pc;2z;O,^G`z|N=>0UTozE~;l'VAs_Bn[ʿ:(/e >_ef;ny@aFA/ގ|?{纽k0=MoFCڦ';5k\d= zLgw8}i9[}bsគp{81{(5]0k/|G'fq Y6R{p63cxBNA7qtVqCP.zqrܬ\E{qty6ljUӿ777ï؃ʎEӃ-{Xjre=5)&_7G 1Iff8{,FI5FOi=*}p(%[DfOHtL ol}oʋؚdR=Ebwi%)[)Wibگ*۫|1Xsl9#d3fYi^ja$ Pn(CQre'jseˇl2Ew,'tCpEbm7[,dyQp.9nL|lo(SH_GN>|Ea&&`96mblR'\~yJ!ۿ՚>/JU|QH3 yh򵚿h CV{|U*o?eEƕ] **D38O/aY+a'F`qU4;nk{?żiۃ|.ח=n{<󼈻T^MPd'߈kdWa31ʗqǃ&kǬxOLxd/V<3^5xVq;*vt ',QqO>ROeJTL/ƱvC~ը_,>UM*|OXO&f>|Ԥi=q>q9򅍧O o}+[ߑϸ~=̇?ۿ3_^ȧJ Yvۑy,fyl{M^?jz-maD[a^g/OS憎_zhKw㩧?[$ꧩH$M^#CϑnzD=AzQ}LQzSot^%=?u'n//^=tt:ej^?㣩훓w`}_}n5S~"X,^)V}dSG#/q6"`[`];g_g=:=Nc]s,|-;Vwᘃ+]g/٫///淬-|Kٯ}Zu5ZX{y58z\LƯ|U_~xlL6oY/:O~Y(endstream endobj 81 0 obj << /Type /Page /Parent 3 0 R /Contents 82 0 R /Resources 4 0 R >> endobj 82 0 obj << /Length 4414 /Filter /FlateDecode >> stream xZM?bpffjDBI$#F離{[9`zfvwwo]?\A*Q.;Nz?GC|ŗWקGoB xTEzu]fBۂ焬w{cB k€w=9[Ӟ ք =ݽ  csigχ޼o{ G~țaս^__?s{]''/w˻YIxzj0rE݊]^ӥ)/$/oQڭaDkxnhn r1!c€DŽ_s=pnXC+;x|6 ھы߼|?~ǯ_~i-褽8a U~u\jVChެrƀI-TTVq.K)L ձ8+'7u“h=G#"b00Dz#c# wz j y] !#vwG+ R 6Gblӝ>[Dw]Rߕl͐xpǫ%xa dzc4bxY3k'p㌰>˘8̯Wds`,V`1ljy=hJ'd N 0ز"9d9 6Z|1*֜',wp3鐓 O ל!@ݟݶȈÈS-#H'prhm"=V7;}S ]"ȪX=LfMb-&ƃvkgآ!0ھ%X*rO}<<ʹ G)F:#&XFc0BU#T4 \Tky2F2|- Ey0B1Q큠ni":a vF b> $MT'l#yl`6.qa`de5o\HJ2X_τ:#S6A wq%0F/Ws}?dIs=Q|8^5C}qnaOAiuWy:@J\iOr?]tx]Tc[1Z8J=!T1C{/ʼnxAmE Gjb͞_c|F|[o[1KPƲ6 Zb^,-f%➫DPk[,j3 Ui8\mM!V7Q72JN\X=h\oC-Lӻ1ԗ8Г 㨷v"͞$cym6c]sOg(^7S(J<)ZNJR=7^߇?aᔺ8vh9n[a/8 y Rz& Ix:0&&ăS%f09?!b@!ܟoӟ?Th^D 0r`B<ă9ܟp#-yNOT}`Oqr \+AL{!߸?z'1)P?rԐ0 i=MsR'8Y'hOz8#/~2-x`|#ma$-~v}J.;u-/~\GFp OOČ'&l_j@܇?e{ :Kk惺J<~=qj<b-XO^k?9_/k٣ M{aiOJtػY σD]bƟA^Zoݤgi=v<0Q#^O֭Tح&\f<  g;R|1[/ȃO[Mo#+b&& ` K|([/?Oy0|[VZ/>&&_`&K4^|O /|"_G!Gt4^?q=򙰙v#8ǝ/kOm|Klu45O~Xu{3qL[/pޠ}cz+^z7Wҿm|btӻkqW&WyWQP0=ng0yeO0K4מ=l9ޭ8(̢p˜ׂ dۑgq_׼\7iN6p~d89H3M݉VAl͉ N6NEL'{Q|WTVr|ӓNk}FĂfbLtҨՋ}A eɒ$IAEѺH q""F'^WْL,/ff' I~~5DRvl/488V,I1Q;8Zy6>Ñf4Nq6z^NY?S5]dd{#mmdS">qmBZQNۋrVM#1>ĴEmZ141GcxaOXTH ~2wz>sa"6M0F\HBšG}lYP˹b"EE"ͻ:7?U8J1ڶdE/|Q<ޗ?(6_8 7&}>NgQuL{)Z@$/)jZxdX`>ZQ˰ g~_?ۜ616NZHH[.<~Yj Zv($ /<4LQ[_4!RRV7؟2s^fo||ь|qS'DJԬ#0y}Z7GY뵍Ž֎^UʴA XR˞E yy^]y*&n?qeldF oĵmT2g+ İEw勍A5iV|ތ'MWi{+yPW<+& :?ߨ')Jg*&ߩX_|/ KUŧ[sY'+5i|O|@\|ai|[l#{~w3_|);!Ϧ̗W;RBoivcy^Ew>h^}ǡO0K[o#ݙWc ;/x)㏺i1I_s;6!#ѤCjP/:^`,=iDTTo,={WvO/k楇˭5}=]hz{dYzɭj}>]/X`DQҭ212ͻB8E‹Beʟ>htA%d-.ֵָٽ}%{oA1>5=͢޿'2_} ?lzuw_S_endstream endobj 83 0 obj << /Type /Page /Parent 3 0 R /Contents 84 0 R /Resources 4 0 R >> endobj 84 0 obj << /Length 4420 /Filter /FlateDecode >> stream xZM?bp23u%P`)9&؈Tu+9`zfvww_\?^A*Q.z?>ugï5_y|>99ßC%^/UqQ^\ח9!09A]tOpxNִ'8<&;5asBOwo{cp'O<}O G_~țaս^O^^?|:bO8N^w `xzj0rE݊]^?Ҕ嗿Uݍ(0"%o}<ܙw1K~W^5C{g|`I&TώӈIf`ӫ>>3$jN4GwⰑ,`ceJ,6R->pgMDl4Q vS[rCA0gT,Gvb5ѡprF+/2XsNd~m¡cܧCN.":p?ZDtD$Cg#bQ "VPi3 F0sQ=d38# DwAgm;#x&ld$20H4qP)nP gv&npe|q!)``x~c~->nL-5Mƍgf=_%iJ<)ZNJR=7^߇?aᔺ8vh9n[a/8 y Rz& Ix:0&&ăS%f09?!b@!ܟoӟ?Th^D 0r`B<ă9ܟp#-yNOT}`Oqr \+AL{!߸?z'1)P?rԐ0 i=MsR'8Y'hOz8#/~2-x`|#ma$-~v}J.;u-/~\GFp OOČ'&l_j@܇?e{ :Kk惺J<~=qj<b-XO^k?9_/k٣ M{aiOJtػY σD]bƟA^Zoݤgi=v<0Q#^O֭Tح&\f<  g;R|1[/ȃO[Mo#+b&& ` K|([/?Oy0|[VZ/>&&_`&K4^|O /|"_G!Gt4^?q=򙰙v#8ǝ/kOm|Klu45O~Xu{3qL[/pޠ}cz+^z7Wҿm|btӻkqW&WyWQP0=ng~HQ E% dkρl9ޭ8(̢p˜ׂ dۑgq_׼\7iN6p~d89H3M݉VAl͉J4lCN~K Tt"5wEm%7=6gĉoA,n;j .<ȄO'Xh++qPv,IkT԰^7+"btґj~up-"alFq`IWWC$eRII.C{c5ϲÛ'a3InI$g@Ek,}p3%[IEF7fO6!j+&4ͱ YjD?3XLL{/QN1ަuLO~}[<^{狉Ex?OeDpIZ's']1J.bӴ/ #i$DQ8z|Ea&'`:ط9mblR'\yJ!ۿ>/J|QH_ yhh CV{|*o?eEƕ **D38O/dY+a'F`qU4nk{?iۃ|.=n{K<󼈻T^MPd'߈kdWa31qǃ&kҬxOL xd/V<3^5xVVq;M*vt ',QqO>R6UeJTL4/ &C~_,>UM*|ϲ|M|<\I{|r O;eߚf#W#qz;Mٙ6gڑO|K{# %%g< ogg5`endstream endobj 85 0 obj << /Type /Page /Parent 3 0 R /Contents 86 0 R /Resources 4 0 R >> endobj 86 0 obj << /Length 4400 /Filter /FlateDecode >> stream xZM?bpffjDBI$8`d`#S=_lyݙލW~||qx~ܪFk;kNz?GC|WGoB xTEzy]_fBۂ焬w{cB k€w=9[Ӟ ք =ݽ  csi'O}>{+&7ê{>;z=v:bO8N^w? `xzj0rE݊]^?ҔUݍ(0").XdՏ k&3&gz@xAp˵3܃palymߒ @,'M>[Txl\@xzD#G#@xB~l}D,# 1X**m`f.<G```g<@Puv4 mgՄm;# 1Q~&*ō?ጀm0Bn002C²7.$% O|ӯgmEqb_øq9޾$(>X>8l{t W' :yA sK4'.b Ibx\bx*j⭘JAx-AW<+AR`)3o!o>Qq?j%cn>fEwɆ,|pilbT˅3N&N~'yJtgb˕$hXK8#s3#ٸE,q/޿XQH󘹓IGj~+";1^\۴g;`v^qkg>$ZVKf#h෭h%cre-1/bTKgpUCqU"-5Of%j +Paź ãĕew ȋ7/y7qfKÕKvw㨬v"͞$ym6c]sO~{w@js0+`. &1wbeԒ&1kQÉnՔj8Z1I.`M֘yeƒ I0A40IMNXhKFD،W'VKZH KvSK vC D2N|dN*TK88#=(&*į.RHIqHDjKs"qXYCD\LqCr[OBzDDd׃ Om0Eh-$ßpZSE7iy؃ӭڰn\:]})Ie`~DQB<)sE1 OOŊ C ӟ`_j1_xd.!GZO8Z$<{'j>0'Ak?yOU IZYܟĊuhI|?YILTHĄn 8,aM'vq=t ?X(06I0?e>%qĝ:?U.\pl}# #8'' beS3/Ջ2u ß7DYE4At TSX_85xhiV/цڰߴ'E{:ݬAyyv} rI?t/y-s7^dn"x ;(/؎'^XxVxVx?33 e=M¶'M7t â|1|0%L>Mɗɧ<>D+^y_%c/'PY]v>#s|#:Lضn;|HΗʧ6w%&$'|N=z8o ˚pCoоm=m3z|n2[c}rCG gtFYӫΘe {Ui4zނ@E eG= CdÂF .izQֶ%(ol狒MN G&Q1u;cڣLy"Q~_TR;%l'Wm88=`۴qJDBr+]n^_Tk D&(UE!Qh΀aj1 9Z흒U 4Wv- 7{'fD >qh&Uf  5DžW`@z8Zm,hگR>mbŲ\_$.ͯgX "Sxe7q;A+/c#˟4Z ,#m"?_i$,+_VⅆfW*>S1yNC~ը_,>UM*|OXO&f>|Ԥi=q>q9򅍧O o}+[ߑϸ~=̇?ۿ3_^ȧJ Yvۑy,fyl{M^?jz-maD[a^g/OS憎_zhKw㩧?[$ꧩH$M^#CϑnzD=AzQ}LQzSot^%=?u'n//^=tt:ej^㣩훓w`}_}n5S~"X,^)c?+tž 謹͗83mƭ]/ٳKg'qqnl}>;Vp.Y_w[/T,endstream endobj 87 0 obj << /Type /Page /Parent 3 0 R /Contents 88 0 R /Resources 4 0 R >> endobj 88 0 obj << /Length 4436 /Filter /FlateDecode >> stream xZO1KXdU}ۂH(Db8`d`#9o\,0gԩgW~x|~p~ܪFk;kNz?p/>;~˯pw -z5Մx YDŽ0Pׄ {sB=1A4) z{<~z~?'ݳOWL?E#oUz={u}wzOuuĞp[Dw]Rߕl͐xpǫ%xa dzc4bxY3k'p㌰>˘8/Wds`,V`1ljy=hJ'd N 0ز"9d9 6Z|1*֜',wp3鐓 O ל!@ݟݶȈÈS-#H'prhm"=V7;}S ]"ȪX=LfMb-&ƃvkgآ!0ھ%X*rO}<<ʹ G)F:#&XFc0BU#T4 \Tky2F2|- Ey0B1Q큠ni":a vF b> $MT'l#yl`6.qa`de5o\HJ2X_τ:#S6A wq%0FϰWs}?dIs=Q|8^5C}qnaOAiuy:@J\iOr?]tx]Tc[1Z8J=!T1C{/ʼnxAmE Gjb͞_c|F|[o[1KPƲ6 Zb^,-f%➫DPk[,j>AhLOF24!@3&FYɉ+=c1Yo^_xtivzw &zcvNddL0ކc|k\{;J߮)v0+`A/ &1CwbR)1]kQÉՔj8Z1/ÊQcM.ÆQjƒ թ1AJ0uMNXhKFZ8TX'VKeHKSK% C*9DE3OR4d*N5P88J Bj(&5į.]KjtIqHTIME)Kt骶Ҏ5sXʖ^ԉCؤ]KOqCr[OBzIGݤeíOr05i-'%ʈßpJ]SF7iy؃ӭڰn\]})Ie`~ǤRB<)3H獜1 OOJ C ӟ`_*4_ixd90!GP`O8ZԖ<'*>0'A?H` I ZoܟJuI?ILjHĄ ̦9R,a4O' q=Rw ?XT06I0?e>%vĝ:?U.\pl}# #8'' bFe6/K5u ßMDMZť5Ao%t X?X_85xhi/цڰߴ'|:ݬAyFyv} rI?t/y-s7^dnx˴;(/؎'^XxVxVx?33 e)>f'⭦7t R}1[|0%L>ୃɗɧ<>D+^y_%c/'PYV]v>#s|#:Ln;|HΗ5ʧ6w%:'|N=z8o ZsCoоm=m31[ :5x++Ӽ(L(S7C3OQ E% dkρlWfQ8Fa̎kAg縯k^{CBᛊMOL'aׂ z?A2&Dqb+h ntAis!'fw*b:ߋ滢rcGtZ37 D7f_5[dƧFu^s8H(;N$5N*EjXXON1:H5b:8Ζdb~0{6#8QmvM+!c{Ť$~ơűȇgYMMBL˓~7pl 5~Pt>Qͤ"#il'tL ul}Պr^?Ljgq&(Ro:i>|n=D]c}"DE"g$ӓ٘{ {Ui4@E(eG= Cd΂ZEH.*izQֶ%(zs|Q<ޗ?(6_8 7&}>NgQuL{)Z@$/)jZxdX`>ZQ˰ g~_?ۜ616NZHH[.<~Yj Zv($ /<4LQ[_4!RRV7؟2s^fo||ь|qS'DJԬ#0y}Z7GY뵍Ž֎^UʴA XR˞E yy^]y*&n?qeldF oĵmT2g+ İEw勍A5iV|ތ'MWi{+yPW<+& :?ߨ')Jg*&AZ`!ԃ/U_&ǃoM>gYl L&f>|Ԥi=q>q9򅍧O oM}+[ߑϸ~=Ǧ̇?3_^ȧJ Yvۑy,fyˢm{M^?jz-maD[wg^{g/OS憎_zhKw㩧?[$ꧩH$M^#Cϑ؄zD=AzQ}xQzSɲy^%=?un/^=tuej'^w`}Ŋ_FY.K4* !8/ 1{B+ž+/Yϗ8ГͶXZXd9'{?Ͽ{䳓X׸\7B~x>V%g< o篿5"aendstream endobj 89 0 obj << /Type /Page /Parent 3 0 R /Contents 90 0 R /Resources 4 0 R >> endobj 90 0 obj << /Length 4325 /Filter /FlateDecode >> stream xZ˲ ߯Yd)**IUY 1`6&s~xa=wzzёf_~ʸ\-"D[rwIg׿WW!\_}_{~zpCs^EpS^\W9`.59@]e0x햴<d)w ksH{co|8W%|b zz$wzOt;bO8N^|~䠷?aswz{O]Pv?]rs%xGɆ6 pX|@ǀ\8[8}&@F<7߽ !z|OTG^y?6Yn;ثzt-褽_pn EE>:h.`#~hެ*:\Jy|ƌ57#RoLBaw ,Nb0i8ը݇CQR FF[Wc`k۱ xy=v`]p@Mq11&k=8?~$ :N/F.c 3ëcwی58ƈ-]wʎ1{Ǚ8E]%i8X/z+m8b>]# 1|]X̢yF1"ns\8~yY퉍vgjQҝzQD14 faK`qNdX !8_ŒhF\wW ɿu;penFƪ 5M jĊcn {v\9_͞x1"x 6??y^7h~VvORqi?eU-)TV~d48Q$eo R<^xyո"i`FP0\blx=@&Y#"ؤ  `8Z "+Q˕'>1`p8__S(YDp>1_)F RedR(CIN> 1&Jtzw m~\/ܢu=c6F 'EVHK:p ծ:Vpa H n<D<܎s0#c=Mk۞| _!zayy/| 㧿3-fĘx.`''q0cc1YZ/xFx/73_-K>Wʘk:h"|Yf;Xw1t5| CohkG>?|Q4Q| 76p#v+ߎ|V4| !D\A| -ӑ% Ey1==p86/(_[oߖWO)ʗ[0*ZoD<[E~bzf5zq9[z\z^d<ʡ'ЛqQЫK Kmslf<-= .-Η,N2[ȋʒҸP%Xh^%&^/XkAJrs! W~aq↿ѼiAү=?xSßШ/5YŅ_l\\x?^c Khq1&Ό.2Yqon%pW19!#18& dTs\&␔|ZR,jx4 L!a"%;1Idɑv#YQǃGtL7&aWJxdΞ<z`L4T䟘|NN4h-d~l)E]58Zf`a n qxjbPw' caŪ'KH 9~hq',8F1?QFOY9#|xw*Z)q?5Az,o>TXN O̚M&O~%nV 7?ܟO&?gcl:{ jx /N>B"dqZgX<|O'7pc`|>Tlڜ`]av#t811:ƑhKb̧η:ĴĹ|; [O]:p|Yz燪v:v=zi%ߩ[\=M.F9_:^| Ћ@}$OS"XL-ڵJzYnf͛ȟ&Co7ǁ&N>g|g+뉦zYu!KBs*{++Ӽ> *լ |~V426dkpnٕ,&e|\i/c4 =\泽󠌜24[O2pxNki?FNex2]KVXf:QV-̐?)Qp.4Ƕ6aڣ -,㋦/7g `1@Gֳ&BJĉq\&*Kb0GȜo?8_h]*U1/O$:1%u狮m ђ_k>.~^7GYՍŽB]Ej#-{/xcl۞Uyy^CyJ2h7q? g97I7bWa31߅AH<+^hh>oƓ$՗+$˨<(WIdg^;yndhC_H6O>(y ud-I"/OEa[m->FlCL&f>|.Tyi;͙/f7mc+]ߑϸ~92hCm/i~Sa|K{#< 2jsw3 !8ǡOp'JXc;S0^{YKw㩧?[$ꧩH$,K^#CϑlGI ԋ-QzSv=*,{֫|'s/^Z(zzYz{G7]M@S}{}oYj%+$?cŠFk[AM,+{euiW_+88*1lhu]u#F_e-vd뺯=~4!3gSS:f.?{q٫~ϯ}'/")eendstream endobj 91 0 obj << /Type /Page /Parent 3 0 R /Contents 92 0 R /Resources 4 0 R >> endobj 92 0 obj << /Length 799 /Filter /FlateDecode >> stream xVMO1WukVBm%H= (  ;C@@ಛ}f< X;u w ^hu`3߰VlN.|ngkvzHR6 ox0:@ڲ+KvpӉrYC oc6al8&-ʯ8WV0Bl/ vθyɇW)tgIj.g1ie$ c|8]Cɿ듎=j^V=B$~ϧDU)C)cAes^ Rz׸ܣqZȔDp& 0Xxr[`a5FtJeT+^n: 킈;;Ŷ2^Z'i4;;uve+X`.<*J`(4 A8q<.>u8|`K l4]v~82-/ bO!`Y7vy9<|t4Z4bhzZ>a0Z] JB`L %! 0$A$ddBi$x%> endobj 94 0 obj << /Length 4395 /Filter /FlateDecode >> stream xZM?bpffjDBI$8`d`#S=_lyݙލW~||qx~ܪFk;kNz?GC|WGoB xTEzy]_fBۂ焬w{cB k€w=9[Ӟ ք =ݽ  csi'O}>{+&7ê{>;z=v:bO8N^w? `xzj0rE݊]^?ҔUݍ(0").XdՏ k&3&gz@xAp˵3܃palymߒ @,'M>[Txl\@xzD#G#@xB~l}D,# 1X**m`f.<G```g<@Puv4 mgՄm;# 1Q~&*ō?ጀm0Bn002C²7.$% O|ӯgmEqb_øq9޾$(>X>8l{t W' :yA sK4'.b Ibx\bx*j⭘JAx-AW<+AR`)3o!o>Qq?j%cn>fEwɆ,|pilbT˅3N&N~'yJtgb˕$hXK8#s3#ٸE,q/޿XQH󘹓IGj~+";1^\۴g;`v^qkg>$ZVKf#h෭h%cre-1/bTKgpUCqU"-5Of%j +Paź ãĕeЃwvo~es]k4{_2 L?dM_@lGeٽm%YkG!xמ~x;E߻kRĄ_+t1I+p4\NtTʌIrlUkF_tTT+\8N IjtB[2$f$jE=ZBR^Z^m jwpyvDKZt g#)$iI(4xv3I&qʒ v#u{ q ۲ymDxE vwRZQ4Q-E1Q!~}t]P-EJCdt'E'.V_TFqREM&]dblrK$&"˼l$hݟ(Bh'IEx}Sݟe/InՆtC'"2KMB,?&O4x~>&!O6+8odxixppM*VT RRzM$'v ?OḋrAԒ';Q;? Zɳ}rB\HB:0$VԥßDKBWbObB'&v;d`Ǒ4ݟpd n"'?;둤~|ԦOHԵEOj))#Orca1??1_ds//q^q' ,.~cjǩxc=~DK{~Au=΋P<γK:{x 0kr#{ev۟]m@Dxvo*-&h哯ل|&H\w4,goL$&L>o%Z|̓e|.{=1t 6mf 03xWg¶uXdCwVV>-5aF>&&|>usb՝~1m~SO^քzmOo[y_1[џ4K[O?nEΧ^.7v["hEܸz'GSzH=*Eҳ͚[r!Fveg94zwړYd/V=_ef;ny@aFA/ގ|?{?}Htf-|#ÝAi'ҵ:#gkOl:St'fwb urVc<^Z(!p1f_*[NfCu^]‰57&;N*NwE_XX#N 1:H5b:8ΖNb0O68QWJps{АCٱbzpe PXMó&&h!5C Gzch"Ifب<ͣG%.dk>3="鞎>q?ZMy[sc=_R7Hc21:x1 X>MLCXv{1/&z=z?-?}c7̒^w,+mث\MӾ0* o(qV2lę9ަMV Җ/_2Tu2ZU'21E/ BCw8 SVajJe Lܸka;Y8_4#Bh|TE39=5k0=pe u?.~{ÍQzmcqG~1m{/'qmo~=w1uq}+_,YaqmJ 1,&f=]"xd/447Ioe݊Guƫ&#:"xA2@nD7*nGlR)>w*F=RejrjG>UJȲ-ݎ|`y55ϫ<_g3k08Toi #zD XL=x~zGeC#~^b3O=eQ"P?M=F"i+z|v{$tA Ћc'֛픥Gu|3*x;wp7}r[o)KW{zM-oߜ@5} 죞(V>%tA {b&OSYw/U}Ooāl5nu@vo=~ɞ]KN@>;y{ukugAXW߱c8wϒ|o^^}߲۟~#Sfendstream endobj 95 0 obj << /Type /Page /Parent 3 0 R /Contents 96 0 R /Resources 4 0 R >> endobj 96 0 obj << /Length 823 /Filter /FlateDecode >> stream xVMO1W̡r׮WP[ h"q@P@P 3@!yf3p rtv^3X׷#B`<ԟ|-FNvVBN/ H[fz7p @)04G_Bⅎ'U+/O,"RQFh~d(uFJuPHQe_O&t%1`Ո3?x./,B]M&7gȺ1w5;dLD5˜({5%MoQá~[2ckEMY2ȪߵvO1aziPi:z>FM0&vM`Z'T8;[Wc4OF0b%mb+U3j*턈͹wcbg{pklMBL41GY&03YeÊLGz]lC\_ .Ԅ|xQpq` nŗY[ 5{&mqony\Ĭ75J5Obh{j9e갆] քP/"?B`X\ք2!^0V~L}ͮ\}l,llhEcF;wn˪~ V6dCgwØ=N6 hH=Lizj[bCʖ`MQ{> endobj 98 0 obj << /Length 4421 /Filter /FlateDecode >> stream xZO1,`U}ۂH(`) qsyS7DY`uLwuթS5Ox}}Õr^Wϯ^rGǟ>B?o?>G>_?"'\}b(x*.*7&Ļ-xNz'8<&& xN~z5  NaM۞06>'v07ӷptm?]1F zzO{q|˝e\OOS۸.RVOt(ퟮnGi/Q/& XʝƄ ~vc¹cnb d{śl$BkW{_~7߽z'fRwWӋW_ZI{/?pè+r ]yD-Vީ^P]2S 1Իcq: VNn'S?zF:5HE``v6 .p'c# wz j!6r;ę~EAa;`8p$Ɩ|< x5_|Lpgޯ,]y= n}ZQ&P}<;VN#?'5Ox ;8p 8rrs:~sX"ܒF@(&=Ts- :CD'lC5a$C'qDJqm20m8# 3qІ%.3 ̐ II#kp[g`jQܦ8Axn0n?h6j,I{1g=֫&~" -U9 "70#⼠y:oPHi\+ @.GK:?nR<~v<3W+{x+w \|Psj~zEG\5ÕITb]QV\2_W.ތ5=/wW/q'>QY}Dvo=I0m==ǺƵ纟FZ/a(1a#]$ALRc. %Mb:!ע݆)p2c\"[#Ɓ+1U#Uʄ`h`$Ж-$IZQO즖4즇(f\ex2ђ]F IwZJ8 LI\$HjCȶl^E[o2$l`|$DȤݝTpp FzTKQLT_]dTK%mIꉢժl"UmE6-8@Q.8)f"ܟ2&ß)`f';<)ZIR=i7^߇?a8vhًn[a/8 ut Rd x:0&&ăS%0=!b@!ܟoӟ?b^S? 0ɲ]B<ă9ܟp#I,yN}`Opl\++L{!?u'1ђP?0 iq$M'8Y'Oz$骃8#/~2u-xQ`|#ma$-~v}J.;u-/~\GFp OO܋'f_e@܇?e{o :h惺?<~=qj<b-XO^k?._/k٣ M{aiOtػYσD]b5ƟA^Zo^Dgd=v<0Q#^O֭(ح[f<  g;ʢ{1/mǃOěJo#E+b6!& ` K|(/?Oy0|[VD/>&&_`&K4^|O M/|"_G!Gt4^?q=mv#8ǝ/ūOm|KlMI45O~Xu{3qL[/p5ޠ}cz+^zEW" {b6 t^p WN/Na|v|/y|?ʿK4ƄEW=l'9ޭW8(o5"eۑgq_׼\ۖ·i֬pxd31M]VAzlm]{ CLwN|S*r̞KkE=8f9KbItz˳ A8d!XCy zqr!FSAI,f' V Ntbr(;ULNaa*[yxԤ|D-Կ&yHoaM$ U?ye֣lgg2[d=Y#1'8.VgU+)/ckuK]jfqS&Qo:\˧i>z|n2[c}rCG gtFYӫΘe {Ui4zނ@E eG= CdÂF .izQֶ%(ol狒MN G&Q1u;cڣLy"Q~_TR;%l'Wm88=`۴qJDBr+]n^_Tk D&(UE!Qh΀aj1 9Z흒U 4Wv- 7{'fD >qh&Uf  5DžW`@z8Zm,hگR>mbŲ\_$.ͯgX "Sxe7q;A+/c#˟4Z ,#m"?_i$,+_VⅆfW*>S1yNC~ը_,>UM*|OXO&f>|Ԥi=q>q9򅍧O o}+[ߑϸ~=̇?ۿ3_^ȧJ Yvۑy,fyl{M^?jz-maD[a^g/OS憎_zhKw㩧?[$ꧩH$M^#CϑnzD=AzQ}LQzSot^%=?u'n//^=tt:ej^㣩훓w`}_}n5S~"X,^)]?+tž 謹͗8ГͶX.Xd%{ο{䳓X׸\7?~6tG"t޿>Q>Ӌ]J:/n//j%7iendstream endobj 99 0 obj << /Type /Page /Parent 3 0 R /Contents 100 0 R /Resources 4 0 R >> endobj 100 0 obj << /Length 809 /Filter /FlateDecode >> stream xVMOA ϯ^Am%VAIѿ_3k> l67k;N ܫSn&@:6G;9f[etru;[3`}Ci}ˆ1Җ^5\r &0ƀN*]9 (,^LU  E#"%|`4Z|[yA X:drI"1ʾN]ZJxse1ioW~\^_YUn/ޅ@OθW)\Ks$5dLD5˜({5Q>]tQ#~b#dM7Uu2ߵAX'Ƙ|+xK0ucp^ȔDۮ,8k zE|}4FtJQ[˨hxm1$ "6߹.u$&AldIގe̅'W fK!GS.?C^:\>K M4]vp82-o fO!`[7vy9#7%@v{$=N} So =xߧy=Iy4l1P#~`{Y$wK}z5ih \a?W[agqSRendstream endobj 101 0 obj << /Type /Page /Parent 3 0 R /Contents 102 0 R /Resources 4 0 R >> endobj 102 0 obj << /Length 4401 /Filter /FlateDecode >> stream xZM?bp23u%P`)q/09`zfvwwo]?^A*Q.z_?>u'5_}|?)9ßC%^/UqQ3!msB;=1! 5asiOpxLw k€焞DŽ9φ޼o^=>K=t_4fXu׳zg>n;],z$<=5"n.Ҕ嗿Uݍ(0"%W6Gblӝ>[Dw]Rߕl͐xpǫ%xa dzc4bxY3kp~㌰> w1{ݣ;qH1FQ2^hSfk8`3 NtL@6 {(Џ- !ҌY3*HpkP8jsIT9'N2?Y6F1g!'A9;C?%һm-39 [?G^7NF17D{nvH$?`EU?2z'ZM-8s…ECa}K&T4=lyP<:ys'W4OSt-FL":"(`b Fi#de2Z`bAՁ;Ҡ3Dt¶޸d00 ű?E^t=x=ݪ {OEeؗ"X0Lܟh|L%CЁ11!ܟm,1Wq DxT@<0 IO!M ܟɘ%Obɳwv#~gZX\u` IK]?7ܟDOLH vl#i?&?ADO~bw#IWMݟxkŋnß #iSSrG9ßoxS'?0cp"b'^_&?15R(#_>){OTX\D3A@5 gS<kz^/ZauQxy^moګ M{Rͪ}$zxg7 "tC>`'=/GN&? ぉ"xnEɎnߊW>3Yh?3޹Pݓ٤|!l;|"TZ|#LL0,'_ 1LhXC $|IL|ʃ'J"z1155\9{bl|Aea: 1g>τm·9|)^|j}[bkŒ|LlM|Ī;s<cz 7#<޶^A?.=Nc? hFzO=ֽ(\zobO=`cE=%֋q9$OM9(zzU"ڥg5BN=@rik;v'?^zzy9,bW=PhiXqrʻʿ;["ɫuQ_1&,@@~}f;ny@aFA/ގ|?{߷}Htf-|#ÝAi'ҵ:#gkOl:St'fwb urVc<^Z(!p1f_*[NfCu^]‰57&;N*NwE_XX#N 1:H5b:8ΖNb0O68QWJps{АCٱbzpe PXMó&&h!5C Gzch"Ifب<ͣG%.dk>3="鞎>q?ZMy[sc=_R7Hc21:x1 X>MLCXv{1/&z=z?-?}c7̒^w,+mث\MӾ0* o(qV2lę9ަMV Җ/_2Tu2ZU'21E/ BCw8 SVajJe Lܸka;Y8_4#Bh|TE39=5k0=pe u?.~{ÍQzmcqG~1m{/'qmo~=w1uq}+_,YaqmJ 1,&f=]"xd/447Ioe݊Guƫ&#:"xA2@nD7*nGlR)>w*F=RejrjG>UJȲ-ݎ|`y55ϫ<_g3k08Toi #zD XL=x~zGeC#~^b3O=eQ"P?M=F"i+z|v{$tA Ћc'֛픥Gu|3*x;wp7}r[o)KW{zM-oߜ@5} 죞(V>%tA j`{?RYw/U}OoālEvv d.{t%{ =ǺƵY]f;x.:/W_ͼgaendstream endobj 103 0 obj << /Type /Page /Parent 3 0 R /Contents 104 0 R /Resources 4 0 R >> endobj 104 0 obj << /Length 4404 /Filter /FlateDecode >> stream xZM?bp23u%P`)q/09`zfvwwo]?^A*Q.z_?>u'5_}|?)9ßC%^/UqQ3!msB;=1! 5asiOpxLw k€焞DŽ9φ޼o^=>K=t_4fXu׳zg>n;],z$<=5"n.Ҕ嗿Uݍ(0"%x|<ޚ/>&x3Wb gkăk7>^-( M>+Ǔ̚\W}<7}g \jN4wa#YE-3ԢMqPa8F loY\czWMbPEEA=[:rDao`kGyA46M™A'sc'QVlir< %1J4%Cbˑl\v"ߏFGfr$y#rוyii/m3֝iovm;53-}+t: :ʡX?ΗAS ,Se֥r(&~GZ/a(1a#]$ALRc. %Mb:!ע݆)p2c\"[#Ɓ+1U#Uʄ`h`$Ж-$IZQO즖4즇(f\ex2ђ]F IwZJ8 LI\$HjCȶl^E[o2$l`|$DȤݝTpp FzTKQLT_]dTK%mIꉢժl"UmE6-8@Q.8)f"ܟ2['ß)`f';<)ZIR=i7^߇?a8vhًn[a/8 ut Rd x:0&&ăS%0=!b@!ܟoӟ?b^S? 0ɲ]B<ă9ܟp#I,yN}`Opl\++L{!?u'1ђP?0 iq$M'8Y'Oz$骃8#/~2u-xQ`|#ma$-~v}J.;u-/~\GFp OO܋'f_e@܇?e{o :h惺?<~=qj<b-XO^k?._/k٣ M{aiOtػYσD]b5ƟA^Zo^Dgd=v<0Q#^O֭(ح[f<  g;ʢ{1/mǃOěJo#E+b6!& ` K|(/?Oy0|[VD/>&&_`&K4^|O M/|"_G!Gt4^?q=mv#8ǝ/ūOm|KlMI45O~Xu{3qL[/p5ޠ}cz+^zEW" {b6 t^p WNyWP`0}k[;/y|?ʿK4ƄEW=l'9ޭW8(o5"eۑgq_׼\·i֬pxd31M]VAzlm]{ CLwN|S*r̞KkE=8f9KbItz˳ A8d!XCy zqr!FSAI,f' V Ntbr(;ULNaa*[yxԤ|D-Կ&yHoaM$ U?ye֣lgg2[d=Y#1'8.VgU+)/ckuK]jfqS&Qo:\˧i>z|n2[c}rCG gtFYӫΘe {Ui4zނ@E eG= CdÂF .izQֶ%(ol狒MN G&Q1u;cڣLy"Q~_TR;%l'Wm88=`۴qJDBr+]n^_Tk D&(UE!Qh΀aj1 9Z흒U 4Wv- 7{'fD >qh&Uf  5DžW`@z8Zm,hگR>mbŲ\_$.ͯgX "Sxe7q;A+/c#˟4Z ,#m"?_i$,+_VⅆfW*>S1yNC~ը_,>UM*|OXO&f>|Ԥi=q>q9򅍧O o}+[ߑϸ~=̇?ۿ3_^ȧJ Yvۑy,fyl{M^?jz-maD[a^g/OS憎_zhKw㩧?[$ꧩH$M^#CϑnzD=AzQ}LQzSot^%=?u'n//^=tt:ej^㣩훓w`}_}n5SUYm,`r/G?+tž 謹͗8ГͶX.Xd%{ο{䳓X׸\7?~6tl`}ϟ^<E'{exW{럾?2aendstream endobj 105 0 obj << /Type /Page /Parent 3 0 R /Contents 106 0 R /Resources 4 0 R >> endobj 106 0 obj << /Length 4425 /Filter /FlateDecode >> stream xZM?bp23u%P`)q6`#S=_09`zfvwwo]?\A*Q.z_?>u'5_}|?)9ßC%^UqQ^^翚9!09A]tOpxNִ'8<&;5asBOwo{cpgOoaO%~b/y3٫׳o~f7]WG .wq?=trb?tiJ*~zvk b€iLH01g\8&[8}&@J>_AB o?}x|}O߽͇_^>}7^OkA'z( NwGlXwQ͹d,\Eê1;իU#@*`q.`p`PX94OGn> ,00DzkC b㱑b;xk5Ձyl` P?bhwqX" ŰGi8cK>x|<ޚ/>&8΃w1K~W^5C{g|`I&TώӈIf`ӫ>>3$jN4GwⰑ,`ceJ,6R->pgMDl4Q vS[rCA0gT,Gvb5ѡprF+/2XsNd~m¡cܧCN.":p?ZDtD$Cg#bQ "VPi3 F0sQ=d38# DwAgm;#x&ld$20H4qP)nP gv&npe|q!)``x~c~->nL-5Mƍg?f=_%iK1G,@x x }Y|U+sY5{--L6dɅKcߤZ.t217vul;y(P; CX$AZ9)e'(b;Hozd? `&Gb̝O:R+ ]ىgަ=ci&Ϭo۶([3*fJuE7x(6:Ʃ˥(TS1x(J8gb?)5{~]Y7mE Gm GC.A ˖`7,kqx!z^B> "{Aͯ]oxVp2ɻ 1Q 2<ʊK\X=xWxkW<śF%J%d8*븯m/b~^=ƽ dzX׸\cD6d~w@js0+`. &1wbeԒ&1kQÉnՔj8Z1I.`M֘yeƒ I0A40IMNXhKFD،W'VKZH KvSK vC D2N|dN*TK88#=(&*į.RHIqHDjKs"qXYCD\LqCr[OBzDDdíOm0Eh-$ßpZSE7iy؃ӭڰn\:]})Ie`~DQB<)sE1 OOŊ C ӟ`_j1_xd.!GZO8Z$<{'j>0'Ak?yOU IZYܟĊuhI|?YILTHĄn 8,aM'vq=t ?X(06I0?e>%qĝ:?U.\pl}# #8'' beS3/Ջ2u ß7DYE4At TS?X_85xhiV/цڰߴ'E{:ݬAyyv} rI?t/y-s7^dn"x ;(/؎'^XxVxVx?33 e=M¶'M7t â|1|0%L>Mɗɧ<>D+^y_%c/'PY]v>#s|#:Lضn;|HΗʧ6w%&$'|N=z8o ˚pCoоm=m33="鞎>q?ZMy[sc=_R7Hc21:x1 X>MLCXv{1/&z=z?-?}c7̒^w,+mث\MӾ0* o(qV2lę9ަMV Җ/_2Tu2ZU'21E/ BCw8 SVajJe Lܸka;Y8_4#Bh|TE39=5k0=pe u?.~{ÍQzmcqG~1m{/'qmo~=w1uq}+_,YaqmJ 1,&f=]"xd/447Ioe݊Guƫ&#:"xA2@nD7*nGlR)>w8|ȯKUŧ[sǓϕ4m'G> .G]_v=6=|e;ׯG~gwKګT)!ηw;1σ<;|Y|ɾZz 'SCO7t>+w~c1 iK]z|{h@~%d-ָ ֵٽ}%{vޣ/9=1>5=ͿݿQl6]cO/}[<ߞo}>{aendstream endobj 107 0 obj << /Type /Page /Parent 3 0 R /Contents 108 0 R /Resources 4 0 R >> endobj 108 0 obj << /Length 799 /Filter /FlateDecode >> stream xVMO1WukVBm%H= (  ;C@@ಛ}f< X;u w ^hu`3߰VlN.|ngkvzHR6 ox0:@ڲ+KvpӉrYC oc6al8&-ʯ8WV0Bl/ vθyɇW)tgIj.g1ie$ c|8]Cɿ듎=j^V=B$~ϧDU)C)cAes^ Rz׸ܣqZȔDp& 0Xxr[`a5FtJeT+^n: 킈;;Ŷ2^Z'i4;;uve+X`.<*J`(4 A8q<.>u8|`K l4]v~82-/ bO!`Y7vy9<|t4Z4bhzZ>a0Z] JB`L %! 0$A$ddBi$x%> endobj 110 0 obj << /Length 3784 /Filter /FlateDecode >> stream xM޶2YT?D[m-@AIc93s(t>/)ΜRJgKZ_~~|cZRS]{^JO랗7,?㓷/ۺmr }˯m#-> ikkIS-uxy/uuœ|_|u/q?=㟲w<=0Ki;^J?d/?Χru}GmC`kk_:^:9qpeؗ٤Q:jrpo_ۯew #o~~zWfg߽ͯ{5tGX0ֺoaGUSkMXT౶CLy_`[fXc_W1rj0,\if1Db1DƱ#m֜7A{r&ok`HSQ[66K[t;H۱oG% u5M)y{^3}cov^5C}{-( MX}wF?'57s-^6kvW`ؚf1ƚl" <SeJ *Vu7[ny=S є.ԉ Z^ ;nЏ !ьY3U,[vb4ɱXv:_7aŘN㴗V8twӑWݐcޏ5UG.Zw 2g8 )>#:Nr|sōA1 =u7;}Ӳ/ ]#Ⱥ/T=+\M.{=#Y=dF @ 'C9c)GoxlZ@a'gD`x<IJ|l#"EhqJ(BM3`bK1F)Z\jՃۏ!gi"xfLbd M )ō3`pE@h# ̐1$g>3㶮`֢MvHCƸq?& ?x/XkxYbݟe/ɱ=x={OVDw/l0q!0c`ẗlˈ'7{F<@!ܟl?O6ɟ`_CU?d.#xp&?a!G>';,#>s_9\Q{0TlSG B!~2v?Y IxQy<G#M&]A\$kcoHOV]|S`zSGS5Ô0DD Z0"}cz*06B7A'V\f>>g~ybG5]x+^Ċ'-xƣX*V<bA D,K͟N=?z(^?z+n7:ZntX@'bOg>?0xKxbO?z"xb#Oq>!qYO͟z,xk~^ Og=*7:Y͟zYzZw}:yqӹqS7|wYN_n ߲iY$n0,4Ы̠Wֻsfe]i_Pm^/罝?[>.]{n >dnW gvfC xm3,"\̷j-;y/,C^]w}s!'nߊi>E̗8}xz)c"3\ þT 7< 3Cw=k~vQfwV#]Wd``xψaKS<ޜwƩ̞̓YWpНpsy_> endobj 112 0 obj << /Length 3612 /Filter /FlateDecode >> stream xZM ?bɡەA[ h 6CCຉi I%6`xO?ht~oo><coO)5ޞСHwjor}m~aœ8;Duu؞pܴjBHR\wZ_G^yO?og_~R\חo{sW?Ө ~|uj4aչ͵t>RX|c 8njXY}k9Sr uq8֞ΰLj1wkg0CM[;gkg˙/ΐt۷p=Bvw<.g|{j=SgYÈ\hۓiȷK<֞$=tvoy{Lޞw:֎D3{{ ޞ۷Xuy{Lޞ ú3n,<=AH۳@l7y|'/=m|'/uo|'ikg|"O֎LE u>|'ukO_D> [{RpX1dqDqϞ*սb.l=ط[/b e1 P%Ӿ_ O`>_D2.4pm@4#&:cܲQ.[ĄxͅDn bjD_@l'7wp|B7>Qq=W8J]kƗb|ZS_-&Df|55*v|C%q '\ۓW)|V[FY>˗S'.bWǰGJ._^s|{_nluz~r?To`SsztC^F#LXF85=T.n%grz PLX{'8A8Jz$pNoqhoգwlU8RzEBrzQ=|w3 G!^UnlbiTb2**nC-Z"CL- (/X&_scy<*X FG'|Ch1YBV#N!1J͗iT+O{{|Kaf>&5ߏi>'F,=@[z#ޠ}C5=,T=.#?fz_4=E_ޢU=FQz^ϵXGIdz!I^roӣDuW,jUϒߪӻ05TɟikuzO,U#EH>0Xxz]"0 d SWZ4C/jw_BgLX ʾʿѮ ؉U_P1:X}g4zw15c˿yW\ƙ¬i )Γ~nN'a=.0ܽ4癎n3L\ g*1FTpRƙ<.n'`𢯅kV ¨w83 mȏc+a<f]8S[xx[+-<FyF3ʅ<Sgr ۷3?e.\癢4Δ/pgb| ׍/|Sqc0?1Slj@t>\El=W(كģ!՞YDA ""nb) lM\?px\o NGA jJ 1?~ˊ` |$[$^7ND*Ƴh~@RBBD?o$ /> dW?LRwz|oʗ"_OEou׷b_|MnPF{EoOlgyQ|q;뇰|I{UO2[,V~e|ey`#?^?u5yGw_orNwp/^KׯOUendstream endobj 113 0 obj << /Type /Page /Parent 3 0 R /Contents 114 0 R /Resources 4 0 R >> endobj 114 0 obj << /Length 4222 /Filter /FlateDecode >> stream xZM?bp23u%PRr0M/[2wvwzחW~~z|ut~ܪFk;kz|#!'_ Z\#^_?<"\}b(x*n*z?<dCR x~z5Na 0>q g)a銉F> zD?5a;y{o˝eߞ v{oO AnvrbviJB*tm=J5 }FFw Xʝƀ~ccjb T|b$$Bk_˧W'߼}Ǘ?0+سś^~lM蔽W؀ U͕~|tlGǝTTVM.S)J 1936u?z_$5DE``v6 .p';7B{]rѯ׻V`HSAڇdXCr3ݯ#)?BMKNǯ[DջXB+Z ڍٯW+>JE!T+ۓ,ݫ~=݅:p81/߉Mdk`*QP1b-gF1.ԑȮ& "^vqBT#`Bm #d UЮ^&:JSsΉ 1U:u:]79vGu"sⅱD&ޒ>WA8%|k  ^X!"c#|SH$ePX3w7%롋>׋|1_W>5XV|$a#v+QǕ)kҋq L@PڷAWR1Uג؂TC{!H>46MYAsaPVlSr<%1* QCYbQE,q/>XHIGizUy]/m3]omۯ=3-};nt: 6:Xv`i*rD XX*tdKH(t1x8J^ڎDjc^_?fA4v ujX݆aZˌْ̲zl1\6_MgA|>;S8\} (v 2e%Llx*OoSWо l^+Wyr u XbBfu/1ħ$&t1i`tOTMwl^\x]]'*u|XD[23MHxBXMסKPnyRB{tOM׍ qfC.,oxsy1N5ì#I5|!n!$Do2:l|Dĺ=h(q 4Qg4%:u >Nm}6Cxu?vg780q@rYΧh_>p7U$q av>ѧh70q>l)&-x~Ҫx zvfz|CB>lar~&CLD~z|*滑)L>!+>_3 0d!!#|p>Q0v%.? 1y9'VN$ANxA|Ob}O:$Vüχ;ꮄOL('d` 8@Y'SxQǪ}xo'G$^dTbqlz#mI-0>e?%9ĝu>UN\m}##EX0K@})Ѻ' ,3Y>h8~1=@AXKxN9ᙘPuoQR2;NV2y. -JqLW;jLY=Z.(38&Q48IDٖb1ovl;(.I< u8Qqfy!v4#,*+QCx&P ,BΘ[<: mv%0Y¼fXixEGI$19~r-O,j-*KpslgL;:w3 0Yv4Ix/~%J&f8Bu;8= -Q/ʶL\>Jڇ1V/A~6Uҥ_F8:$*$1/G Vlgִ^b}i~`D~r8&>U?be- zQYeE•fzzLzq׋fQ%z`=pe"Hh#/ 47IyÕoGn:U g׎;߹-{tA -&DuM#GucU)SOvݎ@?]~{|rX~ڧ;~~f}T_>b-"Mn=US>"Yo,ro-Y~;;6_}/jeP! .1WMendstream endobj 115 0 obj << /Type /Page /Parent 3 0 R /Contents 116 0 R /Resources 4 0 R >> endobj 116 0 obj << /Length 3612 /Filter /FlateDecode >> stream xK+v6F, / E$ʱd8?Ti}%@l8ug͒Ϸo}[]zYk]jkKi-ݾ|Ͽ~|۶-?׾/}-`ߐ< kMmy,O5H1^m  lxߠճ}ךw J׼ F^q6pkWyYL޾K=iIcCG_=,_u<{}3{'ݝ0&,'ooeKolv{o&?hv{o/G{-rTnPT=d9d|kxChRh98/~? #|w_dŋw_=O|<Vzݏ޾z>;to{XTau/1#d3]3ܗcm;68ͰǾ taX\uaWE S)pccG .mۚrmv=55`N ~ƦuCڎuuX4ܟ)81$׌qyzZ5ɯoLmckkazI~1p _ߝ+dͤ~=ǚ:+l053m5,`LZYJpjWw-ްxf*X!Nub&b* V uܬ[ t Un^&96kKƕ2:N{Y A}8ٸq XSuxⅩ%:ޖ>LQ8m_şL(>9TMa1PCBNtZE;S xH݄ xBB8>g ܘd)sd+\*rOB9c+7s^@+'Nψ*& (p?@h10%FDr<ۈeD0Ef%sN3!. \ipG@(V޿# 3=T~G;CDg C5c4Cq`'hRX)1;B{'m.[02CF~#9p0Z_όǺ#Y1ͮ ?5ƃ31KyzXbGkĚO[kZbA,'&ҫg.V</bœX#ϙfΈaF< ,#\OXo$xH9C<^?fu7!oz!#BO2!KDBc =a!!}>{˨F䣅ƅɟpN` # l'O<@c?=o'G"OuMjSokӟ:;^lC)X1ͮ'kA DQ0M#z'h\d>NAڋ>#VX !|5bͷX=D|<_t3q̇3_OUO3g>f= .W=z"xb#YψU8_tSrYzM/z:=AYOt֣|YzW.z:eivYt|ӹq)AQN)73aJj_ivI5?E*ƲZṇymym>K93vF6-A-ݝZYRWJ8W+yav4SxS7 GVQ­L.[ ],v;co8(,0?͎ngLaپ4|rϔX(L`ø|8q4!k7nA8"s eI2[%f?0&/97(߲mzglѿ’Q/%g<.c`XgG^`$O~-w_Mطh?qcn?H-b 0ږ(ߜ9_ ?&C/~~h~XEgі|O߸O/^7>쫽 ?q8+3O/wXZ#zX bGkĚOsZK -KԓXzKb5xY,3^Ċ'Mx *V< $xX~$_gC2xX~+Χb/'bQWb3]̇bKX6xcX%~HXCBcJҨ }?Y폿ԏ Uendstream endobj 117 0 obj << /Type /Page /Parent 3 0 R /Contents 118 0 R /Resources 4 0 R >> endobj 118 0 obj << /Length 3429 /Filter /FlateDecode >> stream xZKb0]ӏ-(HĖ@,6F~TUa{ntԩ ǗG8~8~~|u|(9$YJ8x~~xI_xO?=>Nzďtxz0rSg;0tI˫==z53%"J yk„9qNMMpܲnBHRw7HZ_GO~O?o_~R܁{3]/p4"r6f"Dql#:\K#78ap9ʼn栌/xՏ3%Yp]gL3o 8xlyz6?314xθ=x>6^|y :C2o?ٶ a$Seog:Le^g #Ƿkv&oO!?.x:D6)~u3y{8 6u3x{"7o?sa63y{ 6^ϸq@!eo Y Z20,]7T"K6.g!*ExEx׽EmՏO<_D> 8*61ԍ/"EmDT˧,h:|1-ATl4ATM_ o@\(G *GY2 az FOkSQȌ_s"ߎa$CvZacqz}=xr 8Wjtw7X6bz[jHk؋z{°Va+9=@VIހSsztC^g?UhNM2LNO[Xnz]Kpzq;|B`D^O&V=|L"׳lӻ,G݉2 fz|U qRQŨ{R̿ Dk=ף`{:$jc 5b%Iz][x&X6=j4,HH^XQ'(6bDx:vbM^[]D/_\~wmol^f]Pq71 klQߣP*\qı0YljM}"AD>(|n}xR! ^8-"SLO1AO\~O|׋|~)"|O_zӨ O-ᦸn񔮝GU,[xJ)mO)Q-_?O tm>RtC@A@9x[/d/n ^cms ΞٻvEn Q/v  ]O=1F*V/1QIbἭs|#_[,rd4>ެYczccZωs!^y'h/ 7T#gBR x]zG0=xRhz PfzIez=׺cMkN"nFZ$/ƿMvzG*Y[uz F23;=M~NoVx0QHl<(QFOpd/fc-!њiתElT]E l}-|S\F0;qg 󤨅ۤ" O*.l #$qV8O^M ƙ ϐV߇FSٗ ׍/|˗ pc0t>1SDžu=E7l?QW(كģ!i՞YFD ?i̍hQ(;j> v|MIF  (H_|$_Ic3I]B*I-!#/Ez(ā' zo1?a-snķՋ>ޟ-ܪGU_g\?[U?ģCB%U]=>[zLYbe N/0b-=-D GdU^aG1=|Tx)zh%MOu(H$ly#hTx-{$\2Z/UOv"*7e9I$ӫ]OݢJ8_:=]z gzwǦKbzxz0\?PzfBOlObI5|?yi?IER)6} ԫ|m[ bi|6W11޾endstream endobj 119 0 obj << /Type /Page /Parent 3 0 R /Contents 120 0 R /Resources 4 0 R >> endobj 120 0 obj << /Length 4136 /Filter /FlateDecode >> stream xZKbp2DBI$bK9 q`#S0%.LOuu/xp*r|\n-%]_^q7O!\|7k+_s럏x}~xD7PBT w_Pc0x H 㮲<vK ;59`{=1>qٛwͳWuOtȇa֣]O_^]>S}&l'o/wGK? 䠷swz{o]H(.9no /(PikH11gW%>VStHrpoӛow? !z_?R>y͋g?O~a-q{6x݋W/ ! 6:2Ixqj̘zS=R(S$AaɉC 6 1]uupp(**9;r~Nٱ xy=v`p̰ Mq11׮{#9.xiCpg`uvr11KzSGq3 G,~q!-Lq|1f]>,;Cت+ݵ]ܢc ȅ,Zg3~2JB O,c",Xj#DK!^d;z2|I & Nj0Bq'$7Ǖ}^"k~]/( 8^PI '5ЂO zc<(qzA/hnT6^#"HyO؆j 0'`Vy |r<B>܎s^#cw<-k;z _!za~⋨o>s߀Gx ? fe˜|.`''q0cc1Y !\ڢE`֫bɇқ>c0& ]37cpM-[/LN=.Sρ4mE ծ'Pzcw="nGgE wZEU/n䮧b=XQ1Q43`! ܯq0^OLLQ~9P&}%S鷊ck,sb0 /|O2_71WYϗF2&=~|Z~]v[/3,N1ȋʲҸRAhBY{gC$jch Qzf>.Ýyc 7~f*1Hjf"3ѥ['&R’mtѪ~ÌO461Q.'`9|@3czx};1EDGfƧlF%`-1^'"OYPB>XWSvw>eu SB>%IH & `|"_O4x>PoR^OW̷w0=?X(&W3n;1< Sh,8Y%F(,'wOlSD+rF!kJcr>HFO4pzxw>mrZul!o>SN݌|0'Sh zԧ$<(qm >pi*t{|Zt: x45;^=X|g<53tG׎hO]6_6bO]6ߺNl$׃]6H]xKo3x!Ǯ՘|fՎ|czA=D7ةG(lė^8 SQ8㩗zӡ[.z /oY[χCRw=w@zW=f}XzEzFNqCb~Й<뭎?1155qz?00u ~eK#?J_~Į!?ᇌO/"_\?.F~9_:^z OqnI$N9*UoN?Dbj׎ff>n~0;yik?vS~8~_st/~]`~~:${ëEJ52nͯshER'L[$cn}-R7F#fH,4%@ ۳rO\4N0!&ږc oEUa$-Xy/j]~QNN[%8&ƉEҹ۷X%2r* <MfXkWDjYd1JjAgf%%h'CY,2BSrӔDuv֌oid[P'1&I9$e~S%0H䪇7V z]=4*5EYG!Z[%,Ak<`ZYYTl'%60ώfgn,Ϧ5c[l8AqDdc8|V3Ϗ4d;Sݖ)YQKтaU9&ZJKf|4lm?hv ~ruzhMj%?n'F[hG-iTX]VvE`gڲs!9?iq/itZ6N j5xT/BBK?L/֮ۄ~xECLm-AfOYiCH([fQ,3+Č?9~01" m z'~HpQ/%SOҳ ' =~TD@$%׋B(g zBr%A{`k<1s=o'$zB@5_]X둨Gkw +Ћ/ێ'qoF-bu񐽟M>pl'_|!Ob߲߈٢N> =Wa-;|$> $I7Ig#7|*Z,q;7iz YĐD/Ko$[ nJxtdmIC/E/KOEa[="[za51soK[ſz@\z׏#"zj#}Jw3_zҬW?zxs?5-Ьg~? -mB ۏU,Bx ;b]~z> endobj 122 0 obj << /Length 3552 /Filter /FlateDecode >> stream xK%+j ̬-ȶlKxF@11`ωu=H^t]YU8q"2ۧ[޾~|lq;=mԽ嶏Ցl?}FO?>yOc_liS>ſo2l}77pS߾۶}.|lp=WLJ%X sj{+WLJ{IAc8>4<|2&wLW?}{/Ӗ ̇^>hۧ?crcOG ~d213nowFAʍν7PTd? {K4(AC3+<%:ڠspo_/5~@A y=~p+~~/(՛_oУyj *l'bsEnט!>Gos@ngs2,l|s-Mg`.Wݯfk| lf*涝s˖i/5w]liA9yO>?Jaj.x^s埝ˣPu}~s9`,`X#ånK#+Gn~-,LgpBэ1> ;ôuq FC3k Fr/^F^u(Vffx=/x/x'x7x'x5_k>|^Zेॗ१ॷWKb]x+^Ċ'-xţX*V<bX~!/ˏ+L,bX~,_bX x XF|$V+W>+_OʷbcX(x[xl Xh67B藑YP1yض=ٍ&~ psBzNԴDaF]8(+Nlc-LL/V. /&b#qDXoP~hgPP@L;%Y!D^X;8 fㅃpB#8P;!.*DȍO7aazV~B=UHYfV86s=Yز>,S n'';?s=Ax?i1|!3ѳ"Rf'0*(`a0E<BnzX&x#gzӕW+V>+_|.w=z@\zZD7ĪG]Oq!骧 ^xt{bՃbՋG妧 ^tbtUtrӵ^q)Cͳk[m[ڲ߻},[$+}Bf[zjBشA:+ <|Kdg~Fզ4m }aSO[%- $aSLY;?Q3v2$VϾ͂+}³8Kug2?[ٍn|YY>t=pE,t>6+Hi9[ Kd;dZa̳|P<봳\2͢5#g;$[WI-~$< ZYR'^R%7z#-fjCƥ gP!TnňÈzءU6 \lKaLa~O<Z)z[zT^eɟbW1쐵)$8w̢K"qY¤W+qc XU2q|Ƨ,zIޜ-Wg/RtE󋉩%N+zɝzc\/kz z|vh͒,KOn!ZES?Vb7?&ֆUCo"pgamndI~!vc:ۑ _;w ,+rWل}8a $` -l~VZ~Hh[VDV~F_ 3۟~6L^$¶ ~X3[CI~O %ʬ7__xG__L3?i9 le_L;h5{<^+xoKt[kZbA,/=7(^һXEx+ĊbųX@,O߈GbX~N,?/bX~|X~/V>^B|"V+|%V>+|(V+oW>+_σW^^WW=#V#.7%)-UUω/zPzQzRz3xգbիr_\xWn[|/M[~=">1̛g9׶HXɾY[$+b{} |ИR4fF_myW?~_i&endstream endobj 123 0 obj << /Type /Page /Parent 3 0 R /Contents 124 0 R /Resources 4 0 R >> endobj 124 0 obj << /Length 3358 /Filter /FlateDecode >> stream xKSk%PRr0&؈|GicK6,;:u#???:~>v^rt,H%w<^??uҋ_??x/-G8?<^p1|pM8pVCj~@ ^h(vD@ڙ/rJ I3^vDųU` ]0.ygo1oz|{OG??_$藡׭O_yz;?oϿb㟞R>kTEjO5Or }6o]013 ">;tM R鐢ʡ#x|9xD$B_GO~O?o_~ؗuޛ__ūϬC,{/X9 ElM܉cF>H:-ql#:G78]g9!65B_x[˙a=Ku uμ3l퐦ŒlPޭ1 )3CMs:֎rkK}s{ gړ!Uwb$Sc.g=]g4\<,:KLlM ?3@8L~5 \'o FEs8t_oZ@ȂP< \91+^gnV,!BnBx=w+B|n,I-^@%¬+ʰgn.;0RE\o(~ć5Xns0&^M[zF IH~S=F! Bj>k~~ d~B'̌6fU yb6_4&@CmBp/pD[%κ_xJqק0:ƲS>XX|xJv}JȇǛOIv}JȇGbJ<0Sy}6uБ }|n,}j7>\h!ף;z((87bOy!D; 'vc;B_TI: Mhn#B,땾igX`gCz /=m}zH:~.pBLu'Zkpz }QR_LYcջCe}rM^O;G뱲ת){=޷2X>/@u?o" 0_J̯`u?h|C#/ixM)C_$1J~ I$ Q$n|̯־q?[n5n˪U_+mtT~=穑׎ߴl0N0|?Q8c=ՔmvڷH: mn̚]c -|g3.cS 8[0Cې9%7Kh\4R58<$۸ ^H ϐ6Ý9=82clFIQdƵ85Ʋ,y%Qė-ΐPE3+nog 0QRrageu-,84Yϳ#2y6e٤mHb(qxWtZYiOI2ndM٦17yvj,xJq%|q$/g]\ljbg2NgZGԑyߛ^$=elXٞ,ዡ'wyӋT8\Jz/K3]Ӣ,Nr,Λ^$uN=aIxZŰ-1Q2=1nz!ٸnz!)%ܘE땑}"<@|<QW$e͗ϧroCB`S¬Vq2xx0+ޔ!DNU'Yg.z<c[${C7. <3Ev|ׅߴ-=ԿBC뉌7/=(JRO=Էxw>ovbz*(d .:/h> endobj 126 0 obj << /Length 799 /Filter /FlateDecode >> stream xVMO1WukVBm%H= (  ;C@@ಛ}f< X;u w ^hu`3߰VlN.|ngkvzHR6 ox0:@ڲ+KvpӉrYC oc6al8&-ʯ8WV0Bl/ vθyɇW)tgIj.g1ie$ c|8]Cɿ듎=j^V=B$~ϧDU)C)cAes^ Rz׸ܣqZȔDp& 0Xxr[`a5FtJeT+^n: 킈;;Ŷ2^Z'i4;;uve+X`.<*J`(4 A8q<.>u8|`K l4]v~82-/ bO!`Y7vy9<|t4Z4bhzZ>a0Z] JB`L %! 0$A$ddBi$x%> endobj 128 0 obj << /Length 4395 /Filter /FlateDecode >> stream xZM?bpffjDBI$8`d`#S=_lyݙލW~||qx~ܪFk;kNz?GC|WGoB xTEzy]_fBۂ焬w{cB k€w=9[Ӟ ք =ݽ  csi'O}>{+&7ê{>;z=v:bO8N^w? `xzj0rE݊]^?ҔUݍ(0").XdՏ k&3&gz@xAp˵3܃palymߒ @,'M>[Txl\@xzD#G#@xB~l}D,# 1X**m`f.<G```g<@Puv4 mgՄm;# 1Q~&*ō?ጀm0Bn002C²7.$% O|ӯgmEqb_øq9޾$(>X>8l{t W' :yA sK4'.b Ibx\bx*j⭘JAx-AW<+AR`)3o!o>Qq?j%cn>fEwɆ,|pilbT˅3N&N~'yJtgb˕$hXK8#s3#ٸE,q/޿XQH󘹓IGj~+";1^\۴g;`v^qkg>$ZVKf#h෭h%cre-1/bTKgpUCqU"-5Of%j +Paź ãĕeЃwvo~es]k4{_2 L?dM_@lGeٽm%YkG!xמ~x;E߻kRĄ_+t1I+p4\NtTʌIrlUkF_tTT+\8N IjtB[2$f$jE=ZBR^Z^m jwpyvDKZt g#)$iI(4xv3I&qʒ v#u{ q ۲ymDxE vwRZQ4Q-E1Q!~}t]P-EJCdt'E'.V_TFqREM&]dblrK$&"˼l$hݟ(Bh'IEx}Sݟe/InՆtC'"2KMB,?&O4x~>&!O6+8odxixppM*VT RRzM$'v ?OḋrAԒ';Q;? Zɳ}rB\HB:0$VԥßDKBWbObB'&v;d`Ǒ4ݟpd n"'?;둤~|ԦOHԵEOj))#Orca1??1_ds//q^q' ,.~cjǩxc=~DK{~Au=΋P<γK:{x 0kr#{ev۟]m@Dxvo*-&h哯ل|&H\w4,goL$&L>o%Z|̓e|.{=1t 6mf 03xWg¶uXdCwVV>-5aF>&&|>usb՝~1m~SO^քzmOo[y_1[џ4K[O?nEΧ^.7v["hEܸz'GSzH=*Eҳ͚[r!Fveg94zwړYd/V=_ef;ny@aFA/ގ|?{?}Htf-|#ÝAi'ҵ:#gkOl:St'fwb urVc<^Z(!p1f_*[NfCu^]‰57&;N*NwE_XX#N 1:H5b:8ΖNb0O68QWJps{АCٱbzpe PXMó&&h!5C Gzch"Ifب<ͣG%.dk>3="鞎>q?ZMy[sc=_R7Hc21:x1 X>MLCXv{1/&z=z?-?}c7̒^w,+mث\MӾ0* o(qV2lę9ަMV Җ/_2Tu2ZU'21E/ BCw8 SVajJe Lܸka;Y8_4#Bh|TE39=5k0=pe u?.~{ÍQzmcqG~1m{/'qmo~=w1uq}+_,YaqmJ 1,&f=]"xd/447Ioe݊Guƫ&#:"xA2@nD7*nGlR)>w*F=RejrjG>UJȲ-ݎ|`y55ϫ<_g3k08Toi #zD XL=x~zGeC#~^b3O=eQ"P?M=F"i+z|v{$tA Ћc'֛픥Gu|3*x;wp7}r[o)KW{zM-oߜ@5} 죞(V>%tA {b&OSYw/U}Ooāl5nu@vo=~ɞ]KN@>;y{ukugAXW߱c8wϒ|o^^}߲۟~#Sfendstream endobj 129 0 obj << /Type /Page /Parent 3 0 R /Contents 130 0 R /Resources 4 0 R >> endobj 130 0 obj << /Length 823 /Filter /FlateDecode >> stream xVMO1W̡r׮WP[ h"q@P@P 3@!yf3p rtv^3X׷#B`<ԟ|-FNvVBN/ H[fz7p @)04G_Bⅎ'U+/O,"RQFh~d(uFJuPHQe_O&t%1`Ո3?x./,B]M&7gȺ1w5;dLD5˜({5%MoQá~[2ckEMY2ȪߵvO1aziPi:z>FM0&vM`Z'T8;[Wc4OF0b%mb+U3j*턈͹wcbg{pklMBL41GY&03YeÊLGz]lC\_ .Ԅ|xQpq` nŗY[ 5{&mqony\Ĭ75J5Obh{j9e갆] քP/"?B`X\ք2!^0V~L}ͮ\}l,llhEcF;wn˪~ V6dCgwØ=N6 hH=Lizj[bCʖ`MQ{> endobj 132 0 obj << /Length 4421 /Filter /FlateDecode >> stream xZO1,`U}ۂH(`) qsyS7DY`uLwuթS5Ox}}Õr^Wϯ^rGǟ>B?o?>G>_?"'\}b(x*.*7&Ļ-xNz'8<&& xN~z5  NaM۞06>'v07ӷptm?]1F zzO{q|˝e\OOS۸.RVOt(ퟮnGi/Q/& XʝƄ ~vc¹cnb d{śl$BkW{_~7߽z'fRwWӋW_ZI{/?pè+r ]yD-Vީ^P]2S 1Իcq: VNn'S?zF:5HE``v6 .p'c# wz j!6r;ę~EAa;`8p$Ɩ|< x5_|Lpgޯ,]y= n}ZQ&P}<;VN#?'5Ox ;8p 8rrs:~sX"ܒF@(&=Ts- :CD'lC5a$C'qDJqm20m8# 3qІ%.3 ̐ II#kp[g`jQܦ8Axn0n?h6j,I{1g=֫&~" -U9 "70#⼠y:oPHi\+ @.GK:?nR<~v<3W+{x+w \|Psj~zEG\5ÕITb]QV\2_W.ތ5=/wW/q'>QY}Dvo=I0m==ǺƵ纟FZ/a(1a#]$ALRc. %Mb:!ע݆)p2c\"[#Ɓ+1U#Uʄ`h`$Ж-$IZQO즖4즇(f\ex2ђ]F IwZJ8 LI\$HjCȶl^E[o2$l`|$DȤݝTpp FzTKQLT_]dTK%mIꉢժl"UmE6-8@Q.8)f"ܟ2&ß)`f';<)ZIR=i7^߇?a8vhًn[a/8 ut Rd x:0&&ăS%0=!b@!ܟoӟ?b^S? 0ɲ]B<ă9ܟp#I,yN}`Opl\++L{!?u'1ђP?0 iq$M'8Y'Oz$骃8#/~2u-xQ`|#ma$-~v}J.;u-/~\GFp OO܋'f_e@܇?e{o :h惺?<~=qj<b-XO^k?._/k٣ M{aiOtػYσD]b5ƟA^Zo^Dgd=v<0Q#^O֭(ح[f<  g;ʢ{1/mǃOěJo#E+b6!& ` K|(/?Oy0|[VD/>&&_`&K4^|O M/|"_G!Gt4^?q=mv#8ǝ/ūOm|KlMI45O~Xu{3qL[/p5ޠ}cz+^zEW" {b6 t^p WN/Na|v|/y|?ʿK4ƄEW=l'9ޭW8(o5"eۑgq_׼\ۖ·i֬pxd31M]VAzlm]{ CLwN|S*r̞KkE=8f9KbItz˳ A8d!XCy zqr!FSAI,f' V Ntbr(;ULNaa*[yxԤ|D-Կ&yHoaM$ U?ye֣lgg2[d=Y#1'8.VgU+)/ckuK]jfqS&Qo:\˧i>z|n2[c}rCG gtFYӫΘe {Ui4zނ@E eG= CdÂF .izQֶ%(ol狒MN G&Q1u;cڣLy"Q~_TR;%l'Wm88=`۴qJDBr+]n^_Tk D&(UE!Qh΀aj1 9Z흒U 4Wv- 7{'fD >qh&Uf  5DžW`@z8Zm,hگR>mbŲ\_$.ͯgX "Sxe7q;A+/c#˟4Z ,#m"?_i$,+_VⅆfW*>S1yNC~ը_,>UM*|OXO&f>|Ԥi=q>q9򅍧O o}+[ߑϸ~=̇?ۿ3_^ȧJ Yvۑy,fyl{M^?jz-maD[a^g/OS憎_zhKw㩧?[$ꧩH$M^#CϑnzD=AzQ}LQzSot^%=?u'n//^=tt:ej^㣩훓w`}_}n5S~"X,^)]?+tž 謹͗8ГͶX.Xd%{ο{䳓X׸\7?~6tG"t޿>Q>Ӌ]J:/n//j%7iendstream endobj 133 0 obj << /Type /Page /Parent 3 0 R /Contents 134 0 R /Resources 4 0 R >> endobj 134 0 obj << /Length 809 /Filter /FlateDecode >> stream xVMOA ϯ^Am%VAIѿ_3k> l67k;N ܫSn&@:6G;9f[etru;[3`}Ci}ˆ1Җ^5\r &0ƀN*]9 (,^LU  E#"%|`4Z|[yA X:drI"1ʾN]ZJxse1ioW~\^_YUn/ޅ@OθW)\Ks$5dLD5˜({5Q>]tQ#~b#dM7Uu2ߵAX'Ƙ|+xK0ucp^ȔDۮ,8k zE|}4FtJQ[˨hxm1$ "6߹.u$&AldIގe̅'W fK!GS.?C^:\>K M4]vp82-o fO!`[7vy9#7%@v{$=N} So =xߧy=Iy4l1P#~`{Y$wK}z5ih \a?W[agqSRendstream endobj 135 0 obj << /Type /Page /Parent 3 0 R /Contents 136 0 R /Resources 4 0 R >> endobj 136 0 obj << /Length 4401 /Filter /FlateDecode >> stream xZM?bp23u%P`)q/09`zfvwwo]?^A*Q.z_?>u'5_}|?)9ßC%^/UqQ3!msB;=1! 5asiOpxLw k€焞DŽ9φ޼o^=>K=t_4fXu׳zg>n;],z$<=5"n.Ҕ嗿Uݍ(0"%W6Gblӝ>[Dw]Rߕl͐xpǫ%xa dzc4bxY3kp~㌰> w1{ݣ;qH1FQ2^hSfk8`3 NtL@6 {(Џ- !ҌY3*HpkP8jsIT9'N2?Y6F1g!'A9;C?%һm-39 [?G^7NF17D{nvH$?`EU?2z'ZM-8s…ECa}K&T4=lyP<:ys'W4OSt-FL":"(`b Fi#de2Z`bAՁ;Ҡ3Dt¶޸d00 ű?E^t=x=ݪ {OEeؗ"X0Lܟh|L%CЁ11!ܟm,1Wq DxT@<0 IO!M ܟɘ%Obɳwv#~gZX\u` IK]?7ܟDOLH vl#i?&?ADO~bw#IWMݟxkŋnß #iSSrG9ßoxS'?0cp"b'^_&?15R(#_>){OTX\D3A@5 gS<kz^/ZauQxy^moګ M{Rͪ}$zxg7 "tC>`'=/GN&? ぉ"xnEɎnߊW>3Yh?3޹Pݓ٤|!l;|"TZ|#LL0,'_ 1LhXC $|IL|ʃ'J"z1155\9{bl|Aea: 1g>τm·9|)^|j}[bkŒ|LlM|Ī;s<cz 7#<޶^A?.=Nc? hFzO=ֽ(\zobO=`cE=%֋q9$OM9(zzU"ڥg5BN=@rik;v'?^zzy9,bW=PhiXqrʻʿ;["ɫuQ_1&,@@~}f;ny@aFA/ގ|?{߷}Htf-|#ÝAi'ҵ:#gkOl:St'fwb urVc<^Z(!p1f_*[NfCu^]‰57&;N*NwE_XX#N 1:H5b:8ΖNb0O68QWJps{АCٱbzpe PXMó&&h!5C Gzch"Ifب<ͣG%.dk>3="鞎>q?ZMy[sc=_R7Hc21:x1 X>MLCXv{1/&z=z?-?}c7̒^w,+mث\MӾ0* o(qV2lę9ަMV Җ/_2Tu2ZU'21E/ BCw8 SVajJe Lܸka;Y8_4#Bh|TE39=5k0=pe u?.~{ÍQzmcqG~1m{/'qmo~=w1uq}+_,YaqmJ 1,&f=]"xd/447Ioe݊Guƫ&#:"xA2@nD7*nGlR)>w*F=RejrjG>UJȲ-ݎ|`y55ϫ<_g3k08Toi #zD XL=x~zGeC#~^b3O=eQ"P?M=F"i+z|v{$tA Ћc'֛픥Gu|3*x;wp7}r[o)KW{zM-oߜ@5} 죞(V>%tA j`{?RYw/U}OoālEvv d.{t%{ =ǺƵY]f;x.:/W_ͼgaendstream endobj 137 0 obj << /Type /Page /Parent 3 0 R /Contents 138 0 R /Resources 4 0 R >> endobj 138 0 obj << /Length 4404 /Filter /FlateDecode >> stream xZM?bp23u%P`)q/09`zfvwwo]?^A*Q.z_?>u'5_}|?)9ßC%^/UqQ3!msB;=1! 5asiOpxLw k€焞DŽ9φ޼o^=>K=t_4fXu׳zg>n;],z$<=5"n.Ҕ嗿Uݍ(0"%x|<ޚ/>&x3Wb gkăk7>^-( M>+Ǔ̚\W}<7}g \jN4wa#YE-3ԢMqPa8F loY\czWMbPEEA=[:rDao`kGyA46M™A'sc'QVlir< %1J4%Cbˑl\v"ߏFGfr$y#rוyii/m3֝iovm;53-}+t: :ʡX?ΗAS ,Se֥r(&~GZ/a(1a#]$ALRc. %Mb:!ע݆)p2c\"[#Ɓ+1U#Uʄ`h`$Ж-$IZQO즖4즇(f\ex2ђ]F IwZJ8 LI\$HjCȶl^E[o2$l`|$DȤݝTpp FzTKQLT_]dTK%mIꉢժl"UmE6-8@Q.8)f"ܟ2['ß)`f';<)ZIR=i7^߇?a8vhًn[a/8 ut Rd x:0&&ăS%0=!b@!ܟoӟ?b^S? 0ɲ]B<ă9ܟp#I,yN}`Opl\++L{!?u'1ђP?0 iq$M'8Y'Oz$骃8#/~2u-xQ`|#ma$-~v}J.;u-/~\GFp OO܋'f_e@܇?e{o :h惺?<~=qj<b-XO^k?._/k٣ M{aiOtػYσD]b5ƟA^Zo^Dgd=v<0Q#^O֭(ح[f<  g;ʢ{1/mǃOěJo#E+b6!& ` K|(/?Oy0|[VD/>&&_`&K4^|O M/|"_G!Gt4^?q=mv#8ǝ/ūOm|KlMI45O~Xu{3qL[/p5ޠ}cz+^zEW" {b6 t^p WNyWP`0}k[;/y|?ʿK4ƄEW=l'9ޭW8(o5"eۑgq_׼\·i֬pxd31M]VAzlm]{ CLwN|S*r̞KkE=8f9KbItz˳ A8d!XCy zqr!FSAI,f' V Ntbr(;ULNaa*[yxԤ|D-Կ&yHoaM$ U?ye֣lgg2[d=Y#1'8.VgU+)/ckuK]jfqS&Qo:\˧i>z|n2[c}rCG gtFYӫΘe {Ui4zނ@E eG= CdÂF .izQֶ%(ol狒MN G&Q1u;cڣLy"Q~_TR;%l'Wm88=`۴qJDBr+]n^_Tk D&(UE!Qh΀aj1 9Z흒U 4Wv- 7{'fD >qh&Uf  5DžW`@z8Zm,hگR>mbŲ\_$.ͯgX "Sxe7q;A+/c#˟4Z ,#m"?_i$,+_VⅆfW*>S1yNC~ը_,>UM*|OXO&f>|Ԥi=q>q9򅍧O o}+[ߑϸ~=̇?ۿ3_^ȧJ Yvۑy,fyl{M^?jz-maD[a^g/OS憎_zhKw㩧?[$ꧩH$M^#CϑnzD=AzQ}LQzSot^%=?u'n//^=tt:ej^㣩훓w`}_}n5SUYm,`r/G?+tž 謹͗8ГͶX.Xd%{ο{䳓X׸\7?~6tl`}ϟ^<E'{exW{럾?2aendstream endobj 139 0 obj << /Type /Page /Parent 3 0 R /Contents 140 0 R /Resources 4 0 R >> endobj 140 0 obj << /Length 4425 /Filter /FlateDecode >> stream xZM?bp23u%P`)q6`#S=_09`zfvwwo]?\A*Q.z_?>u'5_}|?)9ßC%^UqQ^^翚9!09A]tOpxNִ'8<&;5asBOwo{cpgOoaO%~b/y3٫׳o~f7]WG .wq?=trb?tiJ*~zvk b€iLH01g\8&[8}&@J>_AB o?}x|}O߽͇_^>}7^OkA'z( NwGlXwQ͹d,\Eê1;իU#@*`q.`p`PX94OGn> ,00DzkC b㱑b;xk5Ձyl` P?bhwqX" ŰGi8cK>x|<ޚ/>&8΃w1K~W^5C{g|`I&TώӈIf`ӫ>>3$jN4GwⰑ,`ceJ,6R->pgMDl4Q vS[rCA0gT,Gvb5ѡprF+/2XsNd~m¡cܧCN.":p?ZDtD$Cg#bQ "VPi3 F0sQ=d38# DwAgm;#x&ld$20H4qP)nP gv&npe|q!)``x~c~->nL-5Mƍg?f=_%iK1G,@x x }Y|U+sY5{--L6dɅKcߤZ.t217vul;y(P; CX$AZ9)e'(b;Hozd? `&Gb̝O:R+ ]ىgަ=ci&Ϭo۶([3*fJuE7x(6:Ʃ˥(TS1x(J8gb?)5{~]Y7mE Gm GC.A ˖`7,kqx!z^B> "{Aͯ]oxVp2ɻ 1Q 2<ʊK\X=xWxkW<śF%J%d8*븯m/b~^=ƽ dzX׸\cD6d~w@js0+`. &1wbeԒ&1kQÉnՔj8Z1I.`M֘yeƒ I0A40IMNXhKFD،W'VKZH KvSK vC D2N|dN*TK88#=(&*į.RHIqHDjKs"qXYCD\LqCr[OBzDDdíOm0Eh-$ßpZSE7iy؃ӭڰn\:]})Ie`~DQB<)sE1 OOŊ C ӟ`_j1_xd.!GZO8Z$<{'j>0'Ak?yOU IZYܟĊuhI|?YILTHĄn 8,aM'vq=t ?X(06I0?e>%qĝ:?U.\pl}# #8'' beS3/Ջ2u ß7DYE4At TS?X_85xhiV/цڰߴ'E{:ݬAyyv} rI?t/y-s7^dn"x ;(/؎'^XxVxVx?33 e=M¶'M7t â|1|0%L>Mɗɧ<>D+^y_%c/'PY]v>#s|#:Lضn;|HΗʧ6w%&$'|N=z8o ˚pCoоm=m33="鞎>q?ZMy[sc=_R7Hc21:x1 X>MLCXv{1/&z=z?-?}c7̒^w,+mث\MӾ0* o(qV2lę9ަMV Җ/_2Tu2ZU'21E/ BCw8 SVajJe Lܸka;Y8_4#Bh|TE39=5k0=pe u?.~{ÍQzmcqG~1m{/'qmo~=w1uq}+_,YaqmJ 1,&f=]"xd/447Ioe݊Guƫ&#:"xA2@nD7*nGlR)>w8|ȯKUŧ[sǓϕ4m'G> .G]_v=6=|e;ׯG~gwKګT)!ηw;1σ<;|Y|ɾZz 'SCO7t>+w~c1 iK]z|{h@~%d-ָ ֵٽ}%{vޣ/9=1>5=ͿݿQl6]cO/}[<ߞo}>{aendstream endobj 141 0 obj << /Type /Page /Parent 3 0 R /Contents 142 0 R /Resources 4 0 R >> endobj 142 0 obj << /Length 4314 /Filter /FlateDecode >> stream xZK%G_qb̌h $pK, , ?DD>lڒ,ͬȈ'*oxwOwGY^S޿_Ny7 _ 9GS{q/|S%.O]~ˀG\Oihvy Ot(˟Rn|gO(={P5!5;܏&[}& [dO-M{23zKLf[PU۱"+^q~kf.)=1 p'yw`Ob*Wx#; 3q}_[c~if4qfH-(M>^+S̚\}<}gIz \h濽| F\(F|GtV_AkC8LG7l; o,~(t ~d+O7ɽ9=[q ȦxhQLb.ey(9jP<:ys'W4ό)f:xBFDr?tˈa#48X%ӦfF0sQ3b38# `bA% ]mgՂm;# 1c?DJqm6ڕx# vL 5||p!H00 u?;h/ǟǼ o$_3ߛ0q 㩩ǎf #( qy bjfZwE+|)6:ƭ˭(V[1|)J8'u)i܊z~݊يE G GCnA ۑ`7,kqx!zB "{Aͯ]ojՊp3 1ܣ|ĕeЋwvѿʚm"+9/OW/1G㨝v!^um{{dzc<z 6G SV& bs4,VH-i 5\6\M놳 ٪ F_t6TT+ 8NIjtBG1$Rf$=Ւ´ԒƴlP̳ O&[Ҳ+8HW>NKB[IV^Imcٖl-&rċV$_( Hj) 볋"j#RJ1(X~v.R֛]ı:<=tM\]dblr[$&"ۺlX$?SOTw5)[)=i^?ßpZSE75V#G?7픰/E6 0Lܟh|LCXO6V+R7{A<@!ܟ˟?b^S?dٮ GZO8QF$V<{jS5ܟ<*ʅ i/d'L -o#? Il#i?Ȓ?Ad/~tGměL]Kn^R3Oծ/E丆?2΅ m.~aD|'^_?15ҽ(#_'T̀',.ycnszk=DK{~A&_`K6|O M/|"_W!Gt4^qm=N#9/ūOm||KlM$|_W>'V=,=@ ?eMoG|8z ϛG>zT&_9z-wp5kܴ=zQDG/֓<7ңDW,jʿK6ƄE}>l'5>W V~atƵz9vk׵S|Y';5kܽd= w=K^Jt:G\5Stf'wb uVc<^X(!p1a"7[LNfCw^5]‰57:.*NwM_X#. 9;H7b:9Nr0OPWJps{АCձbzpe PXMó&kxqS^%lf+r(HRU?5zTBy 2QJ3ӳˉ֫w ~{:Z$7̾j7pl}|KMDOj=eb{u֫c|YCXN{o3x/AtFYӫΘeeղ H Pn(SW93I<,\nT{@9ڻL> wOջ̰- Ų/Z59]"lM.p`zcw~[ǴG[D:"_t㝒}6n+6-\M`95cal\~yʔS?[EOdaRU;_4 q|/SnJ%_Ln\ٵ0<읬O/O41||1LdO͚/{>1sߏ zށp#p^X>l-_|,m/uI؛_ϰ]AL]E<29oqW$_b#۟4[ l#"?_i$,+_VZㅆVW*<|b![ԋ/U_6 S++5i9|O\|@ܮ|a|[{,=|eׯW~]gwKk\T)!ɷ1σ<'|Y|žz 'S͡'Fzzf;XzB"~^b3/=eя"P?-=F"r^z|v{$rAMeEM1֓FDMv֣,J=?M'o/^޽txxwGhj}S/X`_D.N21sV[$?e4 l@~%h- >;~]KNw ]㱮^7?~1$endstream endobj 143 0 obj << /Type /Page /Parent 3 0 R /Contents 144 0 R /Resources 4 0 R >> endobj 144 0 obj << /Length 4385 /Filter /FlateDecode >> stream xZM?b9efjDBIĖr@'0)?UecK9`zfvwwﯟ~r^UnK5]R׏#!5_}|>%9ßC%^UqQ~翚9!09A]tOpxNִ'8<&;5asBOwo{cpًa0!^~b⿟V߿#~y;˸ß? vy#q?]ܭ#.MP~?]%xyOn #B_tCs& XʝƄ ޸z1±c7Q,B%sp߼k6ykGu_4=CL<6ѷbsoDG*͘ժ1 %c1 A[`bdnPx WGblӝ>#Dw]Rߕl͐xp8}ZzQP}<;VN#?'5Ox ;8p 8?@h1`eD0#8Xe0BM0E='c,PT^# 9!࡚mg!8O"Aq6B6ڙ F@hFfHXVƅ$uL30&nSl 7k7NQc{!;Ҟys=Yss0ȶpK mU{B= L{o}<_ )mwО_r!?~ȥHvIgMώ`uSQcoGPbk x\b.>K1G,@x x }Y|U+sY5{--L6dɅKcߤZ.t217vul;y(P;  k gbrd %#>*y3wr?H/ue^Cd'fڋyuuڛ|?lۢ+ṅAKߊNEr(hpK`u)" X*Td<+/⃣S2O(8RwVpv*u)Z8g)lķ1 3 5`,[nݰ%X̒قz l6\2.x(J5vŢ٬WMpew*cXQGY+ˠj_ʚR59/wW/q'>Q;}Dvo=I0m==ǺƵ纟SKX 9JLHIԘa2GjINȵDjJ5̘$VHq`J`KHռ2$ &I',%#qK" lFC7^-i!)t[/M-it[/MQF;<;d%-  x$p<$heI`Ժ=8mٞd"IH.J"%!2"EU/Ez8Vm`)[dq&v]bqqS.2E16m?E % we^6L?SOTwyS쓤z"n)jqOѲݤa^Oj^ppv&! 'A<?E t`LLdKa7{B<4CV!V.$!WhBfq+ROb%+pd1'1Q!a20HOp8OP7㓟($]u6uDO%/ o R3OٮOEq"EO ["ß{~ԌK|loD'?Q}V`q|P Ͼy 4;^-=ڰߴWhOUaXO"fb q&ѰɇI03OhEcbk5kDs*+1ش'ub|DG3_# m;bsRZYηքؚD#_יωUwy>SǴM=A{Yn 7Gx>m~\zMz#n=DJG/m=E;z{QߵznNJ(zKqrIM rQ"ҫDK6kn˅zۡɟv6ZO~f:[sYĮzz+| (Ѱ'f@?ov x|A1_j~h 2k/+zNs[p^;Pj9E˾#Ϟ㾮y-4=1݁Y =&pgc8ĉtN݃ʼnC݇w\U=x;81{3\qrٷ߃Pg{pb ɎC‡t֫fBN/R؃X$̓9N~4Pvl/n8T8V,I1:8Z/63Ñf94H6~b/OQ %ˬG)ٚL.'rޭ*,j+3ߔͱ5:.5y3zL8V)KS^SĴ_=T>aWb򭇱>a!ޣSr3G:V{,{g̲҆4 H=oA"P2Σ!OaAr#qe4?XNx@T( kےoXE&xB[(\Fsܘ:1Q<(/e㝒}6j+6LM|s/j8iN "!m.CNU//5]|"_(4dg@0k5NIT`΍+UE3"TgpL8_4*SWšO\«iw k=e6~4ZyW)Ӷ1bK]/{3,y_yw ϛ򗱑O-׶QȌ4 gbߕ/+M֎YBCy34]^֭xA_gj2"\#w4)TF/*OX||l+<^|b![ԃ/U_&ǃoM>V,'_3O>WjҴ8'v}Gg\cuCߙ/ivS,;<W3_|ey6&jC/ПL5=a0"ЭG0K3ꧩw_/=4w%;Su- c$&[wl7LGIԠ^^>&Xz҈nNYzT7:Sw螟^z7Kwӗ[/wkzZyxxw[׷hj}]/X`D,w,[ bxV[?e4~LgNX_ZWAt4b zkځ>{=d~|vמf?|*B\߯~w|z}׿{˧^ŗtL#no~u׿>{Z^endstream endobj 145 0 obj << /Type /Page /Parent 3 0 R /Contents 146 0 R /Resources 4 0 R >> endobj 146 0 obj << /Length 4359 /Filter /FlateDecode >> stream xZKGb`U:-X!Xq`$>Tˎ-E{鮮:uf7OW[ҨwMxtNz|Ͽq}u?ך>?{pOな\_˟Mw[}OpxLHuM.'8<'zkDš09=1al|N80ӻ/~pta?]1V+Wo}e7EWG y;˸OO|S۸O)w+vyKS:_$/oQڭaD[xnhnKӘ1ac{\8&[8}& [dۏmצ"__~ȵk'}(&Tջ#VlWEZ?SSZ5ıd,1|zc0wu@ ϒ꣉|7t[І m@T N6;#4]ƀASqC2l~Cv3D0rw\qH-xqxDμ_Y*z6WK/0J4Bgi$f0UOw~Ga}ba5'Gw(`cGJ<6R-=pgMTbl4Q vS[?Ҍ R3*hpkP8jsIT9'N2?Y6F1g!'A9;C?%һm-39 [?GZ7NF17D{nvHQ&?`EU?2v'ZM-8s…ES޸d00Qq?j%cn>fEwɆ,|pilbT˅3N&N~'yJtgva-BC\ dĝx~7b=G0#1cN'K{L{q3oӞN{gַm[yŭxQ2iw'%ERG)ERI[8DFwRzbj%۹HU[ot ,e,PKl".E!F-h!Dn"I'`6"4}TOZčOX8E-)Z$.;3P7 &_&`ɷ^|LL{M2M>hBe:63_wD|Ch~+z3aۺ|G,!q;_W++xؚ0#[hk>:9\?g☶^y'h/k AƶϧWx~ЏKSĭOhQޢSu/ ^Su;حXCzI"n\N=a|S=@^zȢvfMwS#Pc;2z[O,^G`z|N=>0UTozE~;l'V߮A/R5?K^3ߏo1aQ{e@O6ۉvwk @0:ǵzvs5=)YLؚc w=KJ>[>pOA8=Z=}.|i5ZEzzim8U,g}@\l=x8 NձzyVw!'ܠ8Y:8!|(O}aaZ89nV."x=8[:{@<ٌ~D]*ߛWACe=,Cec59ϲÛ"a33=lC$ٚa'4P^>zr"z鞎>q?ZMy[sc=_R7Hc21:x1 X>MLCXv{1/&z=z?-?}c7̒^w,+mث\MӾ0* o(qV2lę_9MV Җ/_2Tu2ZU'21E/ BCw8 SVajJe Lܸka;Y8_4#Bh|TE39=5k0=pe u?.~{ÍQzmcqG~1m{/'qmo~=w1uq}+_,YaqmJ 1,&f=]"xd/447Ioe݊Guƫ&#:"xA2@nD7*nGlR)>w*E=RejrjG>UJȲ-ݎ|`y55ϫ<_g3k08Toi #zD XL=x~zGeC#~^b3O=eQ"P?M=F"i+z|v{$tA Ћc'֛픥Gu|3*x;wp7}r[o)KW{z@Ϗ޷oNzQO+o|X WNTgEXɽSFV}d_LG#/q'mƭ]/ٳKg'qqn0lWٗ?~w9/}~%Vendstream endobj 147 0 obj << /Type /Page /Parent 3 0 R /Contents 148 0 R /Resources 4 0 R >> endobj 148 0 obj << /Length 799 /Filter /FlateDecode >> stream xVMO1WukVBm%H= (  ;C@@ಛ}f< X;u w ^hu`3߰VlN.|ngkvzHR6 ox0:@ڲ+KvpӉrYC oc6al8&-ʯ8WV0Bl/ vθyɇW)tgIj.g1ie$ c|8]Cɿ듎=j^V=B$~ϧDU)C)cAes^ Rz׸ܣqZȔDp& 0Xxr[`a5FtJeT+^n: 킈;;Ŷ2^Z'i4;;uve+X`.<*J`(4 A8q<.>u8|`K l4]v~82-/ bO!`Y7vy9<|t4Z4bhzZ>a0Z] JB`L %! 0$A$ddBi$x%> endobj 150 0 obj << /Length 3784 /Filter /FlateDecode >> stream xM޶2YT?D[m-@AIc93s(t>/)ΜRJgKZ_~~|cZRS]{^JO랗7,?㓷/ۺmr }˯m#-> ikkIS-uxy/uuœ|_|u/q?=㟲w<=0Ki;^J?d/?Χru}GmC`kk_:^:9qpeؗ٤Q:jrpo_ۯew #o~~zWfg߽ͯ{5tGX0ֺoaGUSkMXT౶CLy_`[fXc_W1rj0,\if1Db1DƱ#m֜7A{r&ok`HSQ[66K[t;H۱oG% u5M)y{^3}cov^5C}{-( MX}wF?'57s-^6kvW`ؚf1ƚl" <SeJ *Vu7[ny=S є.ԉ Z^ ;nЏ !ьY3U,[vb4ɱXv:_7aŘN㴗V8twӑWݐcޏ5UG.Zw 2g8 )>#:Nr|sōA1 =u7;}Ӳ/ ]#Ⱥ/T=+\M.{=#Y=dF @ 'C9c)GoxlZ@a'gD`x<IJ|l#"EhqJ(BM3`bK1F)Z\jՃۏ!gi"xfLbd M )ō3`pE@h# ̐1$g>3㶮`֢MvHCƸq?& ?x/XkxYbݟe/ɱ=x={OVDw/l0q!0c`ẗlˈ'7{F<@!ܟl?O6ɟ`_CU?d.#xp&?a!G>';,#>s_9\Q{0TlSG B!~2v?Y IxQy<G#M&]A\$kcoHOV]|S`zSGS5Ô0DD Z0"}cz*06B7A'V\f>>g~ybG5]x+^Ċ'-xƣX*V<bA D,K͟N=?z(^?z+n7:ZntX@'bOg>?0xKxbO?z"xb#Oq>!qYO͟z,xk~^ Og=*7:Y͟zYzZw}:yqӹqS7|wYN_n ߲iY$n0,4Ы̠Wֻsfe]i_Pm^/罝?[>.]{n >dnW gvfC xm3,"\̷j-;y/,C^]w}s!'nߊi>E̗8}xz)c"3\ þT 7< 3Cw=k~vQfwV#]Wd``xψaKS<ޜwƩ̞̓YWpНpsy_> endobj 152 0 obj << /Length 3612 /Filter /FlateDecode >> stream xZM ?bɡەA[ h 6CCຉi I%6`xO?ht~oo><coO)5ޞСHwjor}m~aœ8;Duu؞pܴjBHR\wZ_G^yO?og_~R\חo{sW?Ө ~|uj4aչ͵t>RX|c 8njXY}k9Sr uq8֞ΰLj1wkg0CM[;gkg˙/ΐt۷p=Bvw<.g|{j=SgYÈ\hۓiȷK<֞$=tvoy{Lޞw:֎D3{{ ޞ۷Xuy{Lޞ ú3n,<=AH۳@l7y|'/=m|'/uo|'ikg|"O֎LE u>|'ukO_D> [{RpX1dqDqϞ*սb.l=ط[/b e1 P%Ӿ_ O`>_D2.4pm@4#&:cܲQ.[ĄxͅDn bjD_@l'7wp|B7>Qq=W8J]kƗb|ZS_-&Df|55*v|C%q '\ۓW)|V[FY>˗S'.bWǰGJ._^s|{_nluz~r?To`SsztC^F#LXF85=T.n%grz PLX{'8A8Jz$pNoqhoգwlU8RzEBrzQ=|w3 G!^UnlbiTb2**nC-Z"CL- (/X&_scy<*X FG'|Ch1YBV#N!1J͗iT+O{{|Kaf>&5ߏi>'F,=@[z#ޠ}C5=,T=.#?fz_4=E_ޢU=FQz^ϵXGIdz!I^roӣDuW,jUϒߪӻ05TɟikuzO,U#EH>0Xxz]"0 d SWZ4C/jw_BgLX ʾʿѮ ؉U_P1:X}g4zw15c˿yW\ƙ¬i )Γ~nN'a=.0ܽ4癎n3L\ g*1FTpRƙ<.n'`𢯅kV ¨w83 mȏc+a<f]8S[xx[+-<FyF3ʅ<Sgr ۷3?e.\癢4Δ/pgb| ׍/|Sqc0?1Slj@t>\El=W(كģ!՞YDA ""nb) lM\?px\o NGA jJ 1?~ˊ` |$[$^7ND*Ƴh~@RBBD?o$ /> dW?LRwz|oʗ"_OEou׷b_|MnPF{EoOlgyQ|q;뇰|I{UO2[,V~e|ey`#?^?u5yGw_orNwp/^KׯOUendstream endobj 153 0 obj << /Type /Page /Parent 3 0 R /Contents 154 0 R /Resources 4 0 R >> endobj 154 0 obj << /Length 4319 /Filter /FlateDecode >> stream xZKe7.a6 E 2 jBQdߧHGknwWW7z׷3^\f/Kv*-]O~}ϯrۯx}}:?+-qot׫ׇx&w3 ]}sc=ǀ|㋶<ظ]ǀbϕ5 9`k=1 >~]8pflݻWW>ć^>~a׻o~NIք?(Sb=rkzoN1^Jz3^1|JfqzoO_vG~@Dن +ǀ>zz1\aT,XB#spS\sO[FxnsObf\n̮[XO"#_ y~|x3|U|龯T`cJin[W>&<.7ץT#ˋ,l>|r OuaP"+7_1te#x^iW=`n%^m3߲W=J+*O#0czU[kX`]EX/oW1ɭĦ64)*;Lܞ,b_|?1 1~;06UhWiF!J7p|C+6[8;v>R~eP% >H l3qe ҒMzCFzgjovn3*Bw~]񙟇nĺӯ"r=dǃ;]1Si_"brLeU7폇 Vr%ɗpJL]Pz:[eXQ+bv[ l]O 1o7]"ZIђlhQڔ .oyɃAя.Ƽ)4aMa6s-VJvxA6)O*=*TWA6l)jN7o4kUiUFV-؎[!?CBPa(Z XnCB I+|IIdc 8JVPцe*Rϫaf|mw{7ސY@cc9I C(?asZ6:?g ßHs7Ӿ_Hyo`ߊF)Gt+UJ9(+``&R|rη G>PlW|G?4VY7]t`ǎ*e ATW7&'"+eQEVI ,̆k01H:Q)Jˤx(>y=>|?,NӾYRYڸ>֘Y~l*XȪ?˪Ywե(SfԾk6]ҹ#OLMAfz2O9m 8HsuJSkLS"oC5h[-5Ɋ0|h1gj /5ơTK g;"-j|&jonT4V0_j|A52]j>v1o5ݧZw>j _jDUnn|`WpUO5-iQZI8oT <֤Kmcc` ~d;㞭m-4G@lv̹4َ}XsO߿}# >Fݝ<T J^ތM[Ȱ BRi2bB"ut2Ƃ8h^3c2rR &{\0%52b:"2unٓdRPĊɄR)鐓(N"= 6hIb*ug863HG UFʞ$.*HADą8P]'`LƯ8j>T 8TEit=ǩR:؜[ 혥[Ґ'sZ YzneV^81WK7bRמﻫ(90KJsE!S7 T`2ebig=Nثthyb_Iǥ'1QQǴR 1(mR lw,-5Of>_CgX)A5E7Jڲgw+)c~pat=Ҕɂғ V|fcOt?* J8/-ZR=&i|ljbك@=w JqTlIT`=~RK (l.#Vxf+|bB-ռ]2px)&e318fkKz n~}~jŦ=gً"zxRudՓϮ:O`c?x7#3xUx#C|g<w8DVjVnI畏~dWbbL~{a^6[Rvq˛O "o||U3b:} nOoc|.\7Ea!,sb;157g=#f=|?aFjKboSa]Xx' ģlQ#?S?[KC/SL=EVl-Ӷ+S^+S{C/~նУC*?ֳ̧r]ߝfҾַ.~Pbl=>zHd_D~ahsCGTg7p ʏu~P al 9)-9*Ot&/1=/-m~?͹l':Xs3S S&u71q{'F"/XM .On>ωҼХ' "Jg!sSRgLӂMBԈ:Qcƙb0*NXf!|, Rt/T"~tc!xЕux(DG< i⅂gj2-#E@}wԫ., mgę!W](\Iә]Å݈|_tZWn3; +TR aSuX\x5vG~1%؆w;&_=ƅ,9F,x i,&7G$F?;ߴw,%Ɵ|Ӕ8t "'=N"=pF +|%hM7x8ەB5 ŔX=7݅;u8 x7ԣk>pozG?m{ ?azsqٷAݺZ&~2Qwı_\H>n]6VHm qQ|cS/-oˢgU|hɗ:l[B| |mE܊Vs+Vf2]o̤wV="nc+K33.m;bqzh~Y%]oԸzLz7뵹X^xl=@\z^zGdzCh=yz\,DCOѿ~ =BYz;soK[1>8Az1mIͥ7il=?^ezFM|e#6;olqQ146S_ Ҷ7?Wz,}n0B/~׹zXǟX-y_iL,Rp~/NO5@5Q6b@zOS6\$dvl95ve.^endstream endobj 155 0 obj << /Type /Page /Parent 3 0 R /Contents 156 0 R /Resources 4 0 R >> endobj 156 0 obj << /Length 4434 /Filter /FlateDecode >> stream xZK'G?E`hd" 0دODd0FsG:++32;廔rt']\M/?^Bο/k{op%^_/7\bo9^z}s]_ 7<c`!\h eܵ 7vo0xܐsnpx0=qO|pW>}%,ݫ?+&3G`h׫wg~>^}4z:bNXN>~?oO'=^S?oϹ޽ޞ{a@Í]g;DTPa78N~C7|os lb 7>惏~>s}z,lk~2褽w/S',2EG6a՘502cw̰1A;KVCp W.|G,/pu,3K. Úv89Owsmĸr 9N>',iɎ9' buUQ1gzW[=ck /pLlr+q|RqQhdiF8'0?@w6^$mơ0"caY  k~R|畃 -za0D!;+!-@c)u#Գ͑7 g Fb0ғP7Q_Bw > k>Xtx/"͹~Lv'c&{=A`\xa> xC`nvmqW|bk 7 1 Gm[m0~ƩFVfy~@jIVl5[m5SGK?Pk98@]j8C-2ҡ&W[m2?FxUJE!څa|R RTUļ8&Nn|<&J5>*]8y3U(kZĬ{Q Qu_\kLáMD sxeMtZwK6~֑/YV=!=i/~xG֨b `S ԫқsi vSb.ThZdP%0H]8p *X1Ę- ]Q9 v=&m 1RC:A$y=)(bdDtHQRFTI'HSD 1jB$#*#eO l$[0*&٨B31lԪyR.a-J!>FרvŨ5n_ ؆Y@?<;KO˘cj7^9^N&݈a(K]{|CW)1Q>c:⥇xOF݌'Pa>(ss,312qӦX͎sthib_IǤ'1NcC=H JXcag0Kgq̖{p3诡,ÔΠ= ڛS%mu36ÕS1u0 f4%b,l S2Ʌ2^ LxG??t2(-}IK20hoV.()a(}]$͍ 4X h*R[9a`P 6TjIH0C "ي߁6|{sj5I[n!VʩI u Rj^y빰~3|@xZiOYb=&>D otmlhx+Szt:XDX."zxG OG!> 3v;|`bb+_2{|b5|AycJVޏ|$e_|#'|G>$p|J|+7 s]/2 a_^q!gĬg=^zIzJ<ʮ{,mc6vΦ7V='G'ΰzq=[od꧶1+ϡg;C~%b꟩يM%{cy7ky7sz8zP<IWm[oj=:#n=|ʇe0MNfvݭLJcuࣧz\/ mmvbh|pWAΏJ!cLLjKJB:[$a!HkԾC|QElcwu˟=֏UQa^"2SG#lkŒ f[@-Y=%f=ߪ "@|[X[=߳U{ ,n$)1Py"Fnz UUH&:TjdiHOG0䅄j(Q%TG&%݈'Չy}؞J.DHE}В7࿖p ]nY!Fjm8fP䅩hO[> SEk_Ĩ"0qq['F"/X\ n׵gDY腘 cEϳy?LB'G0kpiO8# Fֈp3yW6}B7 S,@x‹G?Ņo htG#MPpOByo zՄE5­ 3^ C25zڳ4|og*~3oX>1n48 ;6B[#~DvCP2fc= Sbc8tg㛮cYSW`?T ;LשGi/b>c%H1񈟸-DhTΤV8[XLzkI:LZL^yw/ m>!o7%Uxr>aqIJaⳒT|X5^/yt>nǹvu %Y|_mtzP:U/JV LuכRwV="nc׫RgBg;,Z]oKQ11ݬǪĜ߬cz][Ohq[Ȟ 퇞|;8P1=Ez f5\qKzdԋoKO\z֣cU˩goԻW6bS+*&Qz|{qL_'~Ny6[b]5W0}yDkDKk>ƤO"w/>}O{Ba6:zn>Y:v*c=L{lCvw-]n}l>bvIb߾go?W~._%ᄍͷ֨z;Zfendstream endobj 157 0 obj << /Type /Page /Parent 3 0 R /Contents 158 0 R /Resources 4 0 R >> endobj 158 0 obj << /Length 4415 /Filter /FlateDecode >> stream xZ&qOGVm]˕l AHCJ3Z( }%ʌx}}/z=j.*-]Iׇ__}7/!\?k{}pKƟo_"oCs KCNLjv0*ʧ41kG^hB޾pTxW?phD#Apnɦy]v:uEc>J6dcۻuԟ=~}'O}d;; ֩: v1@* 1כZ`8 .FJKI6NP` UrSх*qCXiO٢Ph7c҆/i-8dOc"VLFJI%EhD8pAN1EDK>P;!A>bP2RDpQpFbLʈi*ԉa?8>Fz+BjVآ4J:RcT){zkw\[sm/Xii踳y8VVxc idҍԵ;tžc!#9fC) 1/^zhx&0X3217ɲ<:)7m8I&xLzc:= aڃĠ1&}f~tl72L =UҖ^w>sh3\K8[`HSR*0%\X/99a>ʘ|{ӝ(J'_-j<:ȞEBJe߁X(Q%fk  @{lcOPO[ ;"♭ ʭa;`η7;V3elP`-X땜 [+7xޙj<ARvqKO8[7>ҋ~1[wCb9_ ͧyp|M\>Q{"]O9 q915zFz01~ UĜ߬ģzv=&nclzcsz{q [/COF~j[SLBzFoMo,=^"z[m=~s~s=׭áC/zնУC*?ֳ̧|]_[3_iti[ogz|(1^g^=>zʡ\ ;Xj'WapX8VĤ~-T[hO2!b04m^j泎l/Xfc&;oۯ]i~ ;xM:e[+\03  o-1d'V-|Oܴ`ڢ1e*ܓP`q&LT0rcB2QСWK$+2-=FԬ#b'F/Ĵ.>^(|H!dBv:9:nYO{ʼnYHM85",FX{)̻ -4|Y6g)Ń^]?).xЕuxK(D{tmDOg"N=J{yˏ1/AqG>'moAn1w?[*~=Y鯹/YmsփzQ:UOeޔ"q^⟾x=+w? ק^x[zқ8eS2_N=|ezX^.~P146S/g<.vt#=oȾ`JBѰϿ\UN~#Z'Z__q4&})?Q{j ѫ~Ժ,f=Hc V,2 invgO>};oۏ]t_o<i_endstream endobj 159 0 obj << /Type /Page /Parent 3 0 R /Contents 160 0 R /Resources 4 0 R >> endobj 160 0 obj << /Length 760 /Filter /FlateDecode >> stream xVMO1W1jkVJ4z@4A c;Dro>{X;xTWݠMulсVwK|,v"nqR΀A 6ʦA H[Wz\01svU9:oOe`xe3T.h3j:kK<!lVI$k97 u: >B "FEb0.S=)g :86c"4! n/ޅ@_θyɇ9wn2&MDaL)O:Pox]&~:RTU-C1r8/oƵ{ NB3ҋr4˜('5SZ+68p[Oc(N4ڊXFEؼX.؜s]+^YŇ&ޠٛ~hiM/Ӏ5'YhPq|$!7F#:B &ڀ$L:^ ip0X&6LJ>#7%GvI~|v{ߑݧO =xSOcv%x<* 8> endobj 162 0 obj << /Length 4357 /Filter /FlateDecode >> stream xZM&ő?pvWfkw%$[5 dfe}GdxSUYٝϯt}sWcWdwKk\?|u^y~:ⷿǯ5_|畮7 ^[n< &-xNv?}OxLuM`.'<'z  jgMmOxLN;|f^/ѽt%_,fXuכw'vO7߼]''/w?㗗_ti0rU݊_^ӵ*. ݍgD;xmn r˘ 01G\8&[8}&CJ߿ˇl}?O/'_~yLp{5}oׂN{2F\;":h6GU[ժ %cI]ϝv|u,Mݡy1*hSTT> DŇSg&poH;xk5Ձyl`Gץr;ę=bJ0zw\iD-Ÿ܂xb<ݖ/>&sgޯ-z;x/L24xlF?5w-^q ;8.n/߾zN90yyB+%hv[k<IqB4eubQqC声fJ?||Y fœ@u^դ6tCÚpCqz1 N9s9r͹rx`*Lxn>a(FcGtom_@zM8'7zf/0,!!S G@:EPAVf2C(nj 6<o<nvYx.L-r훸pR{dz(xVd7hD\=<}D N1l 0ڈHG2@G2Ҧ3 FpsQ=d5`P큠n2 -v0B`$C'q!ѤA`O6ڙ F@h|Ff,xBDt00<_ؠ_OmEq_ǸN #oY\cv\bPEEA=5= "xao`kGyA;AkGz##q}T39/_Y\o͞Lӏ{+Y38[>QY}D~o=ymvc]so_LZO@js0;`. &1weԓ&1k1BjJu̘$'d$Xe`}93sRu5q}NQcJ&-{zU# ßzG/E6 `?qQ$DA`'=/GN.? ぉ"xEɎߊW>3Yh?3޹Pݓ٤|l;|TZ|LL0,'_ 1LhXC}I03OEcbk5k&w*+1ش'ub|DG3_#)m;b՝sRZYηބ؛D#_יωvy>S'z 7#<޶^A?.=N?tɶޢS( ^Su?حXCFI"n\N=ӣ|S=@^zȢvMwS#PS;2z;O,^G`z|N=>0UhzE~;l'VAs埠g|v5D|?ʿKrƄEWAs{p^;3˿ s\}@1;=c]s[)>6=1݁Y=&pgУL]^A{lm]{*'܇w\U=xa;41{3\qr ߟ'e33(J.ĚtCJ‡t֫%pr!SA?T̓ V Atbr(ULAaa*[yxԴ|D<,&y)ϑf94H6~(OQ)%˼GٛL!'ev{Gcx֟׼hO/u˛S$fzDZzO^ǂbr,/~}P<_e˷) =/eAq&d1j!WeQ=oE"P>eG= CdÊ-F !TmEQַ(o]N GQ&Q1u;ˏm`ڣLy"1~ wJO/ gk ަMV Vȯ_:T 2zU':1Ũ/ ž qLZ_,=CVd|Uo?KeEƍ] $938O/aWšO\«@z8Zo,XگQ>ʶ1bB/{3,y_ywi ϛ`򗱑O<׶Ȍ4 gbߍ/+ҎoǬxO&{W˺<(W':"xA2oa7aGn2-1wF;e|koo1?b?xQ{|r O }+_ߑϸ~;̇?ۿ3_^ȧF Yvۑy,fyl{jC/П\5=&[o8#}Wb ;/x)珺i1Iӭ_s;#ȡ(/^?&Xz҉niNYz7:Sw葟z^zKwח[/wozzyxxw[ןQT^>Y>Yk)?Wymx,Qה^<;*ȿNN X@o}Gvv w.9zt%g{-c]s,^<"endstream endobj 163 0 obj << /Type /Page /Parent 3 0 R /Contents 164 0 R /Resources 4 0 R >> endobj 164 0 obj << /Length 4315 /Filter /FlateDecode >> stream xZO1KXdҗ(HĖ@,】m眪 H,q}SNL>뇫;-rI+xt}qzF?_\=};p~wǗ_]#^ =l]'W ݗy4H5n rMwGt68ol7?9m?]1Ļ+qz={}}R>}3:'9u\s=~sgrx}!TZ }4ph1GsǢYi,ŏ߿CIO~Jw/~u=8A`槗oy3^?ݩiTi~ |TPWsLNhC #`"*5rr|&V>'=;]V3DI mA38UvKnwkWFjr+:_TE8T.f]a0v}Qo)= wxgQ_q7>?9ߴc4XCWl_ceW`6 m sI|}aS`V.8+]OԻhߤ.6 Vq:Qe_=4/L!rjffcJ;QS,ܺ"&V7UonqK7kn&ۺm|ct.=q5j>ubGNw `#c9\G5.L.NQC!H#,hLhIsl9Aϳ!"'e"i 6pSwck лG82#&`|{ #kcgGd#<^# I`!xuW#"kqF~)8`)+CCa!)'_r"w:dl?y$혐Έb7.I% '#;$!fô;S|E{ne6Ǽlg).=I<OEW5_nGS2OoEAO"Sͯ[Am[("([1v9YrlY'R.cOLE).6Of5 3W.PZ& SZ`> Ͽ.LIsz y&ұ%o3Ͳm}u?<^±S}`M&baBѢJ0Di%ᾣQ Is ,%KۤM=jjwD4h'qdA҂t%s5;1V>B=4C}У-=lia ־(tgT}4ܟLbZZְ>̉,H2!SV}m=x /:v!Qח/LDEM ]ؖ\M6MI0Y589*||Um0>Ųek I_ּ=lòdK_2Y&f|<_7ޑxxB~6,^x&18Vgoimg>~4G9hٷ63NL|Dž`s%mɧ|ѓջm=m3б;7#=vU|GiC 3_ҮG>c[ڼ^y\?g1ms'/曩7ط  ;wq!)׀e-⻜zlt6z<z SO?q|S=uW_,kz .zY=M~uE,^z߰<zz},cW=2| ʞ6 !?7kWNA|=_zsc?_,bP3xLkk%|m떎mQ5>f[-kss_=[˿i6 7nSoQi-8ݍheqw:zK! όp ]|'ڿ|y=1?v#q~k*> endobj 166 0 obj << /Length 4395 /Filter /FlateDecode >> stream xZM?bpffjDBI$8`d`#S=_lyݙލW~||qx~ܪFk;kNz?GC|WGoB xTEzy]_fBۂ焬w{cB k€w=9[Ӟ ք =ݽ  csi'O}>{+&7ê{>;z=v:bO8N^w? `xzj0rE݊]^?ҔUݍ(0").XdՏ k&3&gz@xAp˵3܃palymߒ @,'M>[Txl\@xzD#G#@xB~l}D,# 1X**m`f.<G```g<@Puv4 mgՄm;# 1Q~&*ō?ጀm0Bn002C²7.$% O|ӯgmEqb_øq9޾$(>X>8l{t W' :yA sK4'.b Ibx\bx*j⭘JAx-AW<+AR`)3o!o>Qq?j%cn>fEwɆ,|pilbT˅3N&N~'yJtgb˕$hXK8#s3#ٸE,q/޿XQH󘹓IGj~+";1^\۴g;`v^qkg>$ZVKf#h෭h%cre-1/bTKgpUCqU"-5Of%j +Paź ãĕeЃwvo~es]k4{_2 L?dM_@lGeٽm%YkG!xמ~x;E߻kRĄ_+t1I+p4\NtTʌIrlUkF_tTT+\8N IjtB[2$f$jE=ZBR^Z^m jwpyvDKZt g#)$iI(4xv3I&qʒ v#u{ q ۲ymDxE vwRZQ4Q-E1Q!~}t]P-EJCdt'E'.V_TFqREM&]dblrK$&"˼l$hݟ(Bh'IEx}Sݟe/InՆtC'"2KMB,?&O4x~>&!O6+8odxixppM*VT RRzM$'v ?OḋrAԒ';Q;? Zɳ}rB\HB:0$VԥßDKBWbObB'&v;d`Ǒ4ݟpd n"'?;둤~|ԦOHԵEOj))#Orca1??1_ds//q^q' ,.~cjǩxc=~DK{~Au=΋P<γK:{x 0kr#{ev۟]m@Dxvo*-&h哯ل|&H\w4,goL$&L>o%Z|̓e|.{=1t 6mf 03xWg¶uXdCwVV>-5aF>&&|>usb՝~1m~SO^քzmOo[y_1[џ4K[O?nEΧ^.7v["hEܸz'GSzH=*Eҳ͚[r!Fveg94zwړYd/V=_ef;ny@aFA/ގ|?{?}Htf-|#ÝAi'ҵ:#gkOl:St'fwb urVc<^Z(!p1f_*[NfCu^]‰57&;N*NwE_XX#N 1:H5b:8ΖNb0O68QWJps{АCٱbzpe PXMó&&h!5C Gzch"Ifب<ͣG%.dk>3="鞎>q?ZMy[sc=_R7Hc21:x1 X>MLCXv{1/&z=z?-?}c7̒^w,+mث\MӾ0* o(qV2lę9ަMV Җ/_2Tu2ZU'21E/ BCw8 SVajJe Lܸka;Y8_4#Bh|TE39=5k0=pe u?.~{ÍQzmcqG~1m{/'qmo~=w1uq}+_,YaqmJ 1,&f=]"xd/447Ioe݊Guƫ&#:"xA2@nD7*nGlR)>w*F=RejrjG>UJȲ-ݎ|`y55ϫ<_g3k08Toi #zD XL=x~zGeC#~^b3O=eQ"P?M=F"i+z|v{$tA Ћc'֛픥Gu|3*x;wp7}r[o)KW{zM-oߜ@5} 죞(V>%tA {b&OSYw/U}Ooāl5nu@vo=~ɞ]KN@>;y{ukugAXW߱c8wϒ|o^^}߲۟~#Sfendstream endobj 167 0 obj << /Type /Page /Parent 3 0 R /Contents 168 0 R /Resources 4 0 R >> endobj 168 0 obj << /Length 4395 /Filter /FlateDecode >> stream xZM?bpffjDBI$8`d`#S=_lyݙލW~||qx~ܪFk;kNz?GC|WGoB xTEzy]_fBۂ焬w{cB k€w=9[Ӟ ք =ݽ  csi'O}>{+&7ê{>;z=v:bO8N^w? `xzj0rE݊]^?ҔUݍ(0").XdՏ k&3&gz@xAp˵3܃palymߒ @,'M>[Txl\@xzD#G#@xB~l}D,# 1X**m`f.<G```g<@Puv4 mgՄm;# 1Q~&*ō?ጀm0Bn002C²7.$% O|ӯgmEqb_øq9޾$(>X>8l{t W' :yA sK4'.b Ibx\bx*j⭘JAx-AW<+AR`)3o!o>Qq?j%cn>fEwɆ,|pilbT˅3N&N~'yJtgb˕$hXK8#s3#ٸE,q/޿XQH󘹓IGj~+";1^\۴g;`v^qkg>$ZVKf#h෭h%cre-1/bTKgpUCqU"-5Of%j +Paź ãĕeЃwvo~es]k4{_2 L?dM_@lGeٽm%YkG!xמ~x;E߻kRĄ_+t1I+p4\NtTʌIrlUkF_tTT+\8N IjtB[2$f$jE=ZBR^Z^m jwpyvDKZt g#)$iI(4xv3I&qʒ v#u{ q ۲ymDxE vwRZQ4Q-E1Q!~}t]P-EJCdt'E'.V_TFqREM&]dblrK$&"˼l$hݟ(Bh'IEx}Sݟe/InՆtC'"2KMB,?&O4x~>&!O6+8odxixppM*VT RRzM$'v ?OḋrAԒ';Q;? Zɳ}rB\HB:0$VԥßDKBWbObB'&v;d`Ǒ4ݟpd n"'?;둤~|ԦOHԵEOj))#Orca1??1_ds//q^q' ,.~cjǩxc=~DK{~Au=΋P<γK:{x 0kr#{ev۟]m@Dxvo*-&h哯ل|&H\w4,goL$&L>o%Z|̓e|.{=1t 6mf 03xWg¶uXdCwVV>-5aF>&&|>usb՝~1m~SO^քzmOo[y_1[џ4K[O?nEΧ^.7v["hEܸz'GSzH=*Eҳ͚[r!Fveg94zwړYd/V=_ef;ny@aFA/ގ|?{?}Htf-|#ÝAi'ҵ:#gkOl:St'fwb urVc<^Z(!p1f_*[NfCu^]‰57&;N*NwE_XX#N 1:H5b:8ΖNb0O68QWJps{АCٱbzpe PXMó&&h!5C Gzch"Ifب<ͣG%.dk>3="鞎>q?ZMy[sc=_R7Hc21:x1 X>MLCXv{1/&z=z?-?}c7̒^w,+mث\MӾ0* o(qV2lę9ަMV Җ/_2Tu2ZU'21E/ BCw8 SVajJe Lܸka;Y8_4#Bh|TE39=5k0=pe u?.~{ÍQzmcqG~1m{/'qmo~=w1uq}+_,YaqmJ 1,&f=]"xd/447Ioe݊Guƫ&#:"xA2@nD7*nGlR)>w*F=RejrjG>UJȲ-ݎ|`y55ϫ<_g3k08Toi #zD XL=x~zGeC#~^b3O=eQ"P?M=F"i+z|v{$tA Ћc'֛픥Gu|3*x;wp7}r[o)KW{zM-oߜ@5} 죞(V>%tA {b&OSYw/U}Ooāl5nu@vo=~ɞ]KN@>;y{ukugAXW߱c8wϒ|o^^}߲۟~#Sfendstream endobj 169 0 obj << /Type /Page /Parent 3 0 R /Contents 170 0 R /Resources 4 0 R >> endobj 170 0 obj << /Length 4395 /Filter /FlateDecode >> stream xZM?bpffjDBI$8`d`#S=_lyݙލW~||qx~ܪFk;kNz?GC|WGoB xTEzy]_fBۂ焬w{cB k€w=9[Ӟ ք =ݽ  csi'O}>{+&7ê{>;z=v:bO8N^w? `xzj0rE݊]^?ҔUݍ(0").XdՏ k&3&gz@xAp˵3܃palymߒ @,'M>[Txl\@xzD#G#@xB~l}D,# 1X**m`f.<G```g<@Puv4 mgՄm;# 1Q~&*ō?ጀm0Bn002C²7.$% O|ӯgmEqb_øq9޾$(>X>8l{t W' :yA sK4'.b Ibx\bx*j⭘JAx-AW<+AR`)3o!o>Qq?j%cn>fEwɆ,|pilbT˅3N&N~'yJtgb˕$hXK8#s3#ٸE,q/޿XQH󘹓IGj~+";1^\۴g;`v^qkg>$ZVKf#h෭h%cre-1/bTKgpUCqU"-5Of%j +Paź ãĕeЃwvo~es]k4{_2 L?dM_@lGeٽm%YkG!xמ~x;E߻kRĄ_+t1I+p4\NtTʌIrlUkF_tTT+\8N IjtB[2$f$jE=ZBR^Z^m jwpyvDKZt g#)$iI(4xv3I&qʒ v#u{ q ۲ymDxE vwRZQ4Q-E1Q!~}t]P-EJCdt'E'.V_TFqREM&]dblrK$&"˼l$hݟ(Bh'IEx}Sݟe/InՆtC'"2KMB,?&O4x~>&!O6+8odxixppM*VT RRzM$'v ?OḋrAԒ';Q;? Zɳ}rB\HB:0$VԥßDKBWbObB'&v;d`Ǒ4ݟpd n"'?;둤~|ԦOHԵEOj))#Orca1??1_ds//q^q' ,.~cjǩxc=~DK{~Au=΋P<γK:{x 0kr#{ev۟]m@Dxvo*-&h哯ل|&H\w4,goL$&L>o%Z|̓e|.{=1t 6mf 03xWg¶uXdCwVV>-5aF>&&|>usb՝~1m~SO^քzmOo[y_1[џ4K[O?nEΧ^.7v["hEܸz'GSzH=*Eҳ͚[r!Fveg94zwړYd/V=_ef;ny@aFA/ގ|?{?}Htf-|#ÝAi'ҵ:#gkOl:St'fwb urVc<^Z(!p1f_*[NfCu^]‰57&;N*NwE_XX#N 1:H5b:8ΖNb0O68QWJps{АCٱbzpe PXMó&&h!5C Gzch"Ifب<ͣG%.dk>3="鞎>q?ZMy[sc=_R7Hc21:x1 X>MLCXv{1/&z=z?-?}c7̒^w,+mث\MӾ0* o(qV2lę9ަMV Җ/_2Tu2ZU'21E/ BCw8 SVajJe Lܸka;Y8_4#Bh|TE39=5k0=pe u?.~{ÍQzmcqG~1m{/'qmo~=w1uq}+_,YaqmJ 1,&f=]"xd/447Ioe݊Guƫ&#:"xA2@nD7*nGlR)>w*F=RejrjG>UJȲ-ݎ|`y55ϫ<_g3k08Toi #zD XL=x~zGeC#~^b3O=eQ"P?M=F"i+z|v{$tA Ћc'֛픥Gu|3*x;wp7}r[o)KW{zM-oߜ@5} 죞(V>%tA {b&OSYw/U}Ooāl5nu@vo=~ɞ]KN@>;y{ukugAXW߱c8wϒ|o^^}߲۟~#Sfendstream endobj 171 0 obj << /Type /Page /Parent 3 0 R /Contents 172 0 R /Resources 4 0 R >> endobj 172 0 obj << /Length 4315 /Filter /FlateDecode >> stream xZO1KXdҗ(HĖ@,】m眪 H,q}SNL>뇫;-rI+xt}qzF?_\=};p~wǗ_]#^ =l]'W ݗy4H5n rMwGt68ol7?9m?]1Ļ+qz={}}R>}3:'9u\s=~sgrx}!TZ }4ph1GsǢYi,ŏ߿CIO~Jw/~u=8A`槗oy3^?ݩiTi~ |TPWsLNhC #`"*5rr|&V>'=;]V3DI mA38UvKnwkWFjr+:_TE8T.f]a0v}Qo)= wxgQ_q7>?9ߴc4XCWl_ceW`6 m sI|}aS`V.8+]OԻhߤ.6 Vq:Qe_=4/L!rjffcJ;QS,ܺ"&V7UonqK7kn&ۺm|ct.=q5j>ubGNw `#c9\G5.L.NQC!H#,hLhIsl9Aϳ!"'e"i 6pSwck лG82#&`|{ #kcgGd#<^# I`!xuW#"kqF~)8`)+CCa!)'_r"w:dl?y$혐Έb7.I% '#;$!fô;S|E{ne6Ǽlg).=I<OEW5_nGS2OoEAO"Sͯ[Am[("([1v9YrlY'R.cOLE).6Of5 3W.PZ& SZ`> Ͽ.LIsz y&ұ%o3Ͳm}u?<^±S}`M&baBѢJ0Di%ᾣQ Is ,%KۤM=jjwD4h'qdA҂t%s5;1V>B=4C}У-=lia ־(tgT}4ܟLbZZְ>̉,H2!SV}m=x /:v!Qח/LDEM ]ؖ\M6MI0Y589*||Um0>Ųek I_ּ=lòdK_2Y&f|<_7ޑxxB~6,^x&18Vgoimg>~4G9hٷ63NL|Dž`s%mɧ|ѓջm=m3б;7#=vU|GiC 3_ҮG>c[ڼ^y\?g1ms'/曩7ط  ;wq!)׀e-⻜zlt6z<z SO?q|S=uW_,kz .zY=M~uE,^z߰<zz},cW=2| ʞ6 !?7kWNA|=_zsc?_,bP3xLkk%|m떎mQ5>f[-kss_=[˿i6 7nSoQi-8ݍheqw:zK! όp ]|'ڿ|y=1?v#q~k*> endobj 174 0 obj << /Length 4315 /Filter /FlateDecode >> stream xZO1KXdҗ(HĖ@,】m眪 H,q}SNL>뇫;-rI+xt}qzF?_\=};p~wǗ_]#^ =l]'W ݗy4H5n rMwGt68ol7?9m?]1Ļ+qz={}}R>}3:'9u\s=~sgrx}!TZ }4ph1GsǢYi,ŏ߿CIO~Jw/~u=8A`槗oy3^?ݩiTi~ |TPWsLNhC #`"*5rr|&V>'=;]V3DI mA38UvKnwkWFjr+:_TE8T.f]a0v}Qo)= wxgQ_q7>?9ߴc4XCWl_ceW`6 m sI|}aS`V.8+]OԻhߤ.6 Vq:Qe_=4/L!rjffcJ;QS,ܺ"&V7UonqK7kn&ۺm|ct.=q5j>ubGNw `#c9\G5.L.NQC!H#,hLhIsl9Aϳ!"'e"i 6pSwck лG82#&`|{ #kcgGd#<^# I`!xuW#"kqF~)8`)+CCa!)'_r"w:dl?y$혐Έb7.I% '#;$!fô;S|E{ne6Ǽlg).=I<OEW5_nGS2OoEAO"Sͯ[Am[("([1v9YrlY'R.cOLE).6Of5 3W.PZ& SZ`> Ͽ.LIsz y&ұ%o3Ͳm}u?<^±S}`M&baBѢJ0Di%ᾣQ Is ,%KۤM=jjwD4h'qdA҂t%s5;1V>B=4C}У-=lia ־(tgT}4ܟLbZZְ>̉,H2!SV}m=x /:v!Qח/LDEM ]ؖ\M6MI0Y589*||Um0>Ųek I_ּ=lòdK_2Y&f|<_7ޑxxB~6,^x&18Vgoimg>~4G9hٷ63NL|Dž`s%mɧ|ѓջm=m3б;7#=vU|GiC 3_ҮG>c[ڼ^y\?g1ms'/曩7ط  ;wq!)׀e-⻜zlt6z<z SO?q|S=uW_,kz .zY=M~uE,^z߰<zz},cW=2| ʞ6 !?7kWNA|=_zsc?_,bP3xLkk%|m떎mQ5>f[-kss_=[˿i6 7nSoQi-8ݍheqw:zK! όp ]|'ڿ|y=1?v#q~k*> endobj 176 0 obj << /Length 4315 /Filter /FlateDecode >> stream xZO1KXdҗ(HĖ@,】m眪 H,q}SNL>뇫;-rI+xt}qzF?_\=};p~wǗ_]#^ =l]'W ݗy4H5n rMwGt68ol7?9m?]1Ļ+qz={}}R>}3:'9u\s=~sgrx}!TZ }4ph1GsǢYi,ŏ߿CIO~Jw/~u=8A`槗oy3^?ݩiTi~ |TPWsLNhC #`"*5rr|&V>'=;]V3DI mA38UvKnwkWFjr+:_TE8T.f]a0v}Qo)= wxgQ_q7>?9ߴc4XCWl_ceW`6 m sI|}aS`V.8+]OԻhߤ.6 Vq:Qe_=4/L!rjffcJ;QS,ܺ"&V7UonqK7kn&ۺm|ct.=q5j>ubGNw `#c9\G5.L.NQC!H#,hLhIsl9Aϳ!"'e"i 6pSwck лG82#&`|{ #kcgGd#<^# I`!xuW#"kqF~)8`)+CCa!)'_r"w:dl?y$혐Έb7.I% '#;$!fô;S|E{ne6Ǽlg).=I<OEW5_nGS2OoEAO"Sͯ[Am[("([1v9YrlY'R.cOLE).6Of5 3W.PZ& SZ`> Ͽ.LIsz y&ұ%o3Ͳm}u?<^±S}`M&baBѢJ0Di%ᾣQ Is ,%KۤM=jjwD4h'qdA҂t%s5;1V>B=4C}У-=lia ־(tgT}4ܟLbZZְ>̉,H2!SV}m=x /:v!Qח/LDEM ]ؖ\M6MI0Y589*||Um0>Ųek I_ּ=lòdK_2Y&f|<_7ޑxxB~6,^x&18Vgoimg>~4G9hٷ63NL|Dž`s%mɧ|ѓջm=m3б;7#=vU|GiC 3_ҮG>c[ڼ^y\?g1ms'/曩7ط  ;wq!)׀e-⻜zlt6z<z SO?q|S=uW_,kz .zY=M~uE,^z߰<zz},cW=2| ʞ6 !?7kWNA|=_zsc?_,bP3xLkk%|m떎mQ5>f[-kss_=[˿i6 7nSoQi-8ݍheqw:zK! όp ]|'ڿ|y=1?v#q~k*> endobj 178 0 obj << /Length 4315 /Filter /FlateDecode >> stream xZO1KXdҗ(HĖ@,】m眪 H,q}SNL>뇫;-rI+xt}qzF?_\=};p~wǗ_]#^ =l]'W ݗy4H5n rMwGt68ol7?9m?]1Ļ+qz={}}R>}3:'9u\s=~sgrx}!TZ }4ph1GsǢYi,ŏ߿CIO~Jw/~u=8A`槗oy3^?ݩiTi~ |TPWsLNhC #`"*5rr|&V>'=;]V3DI mA38UvKnwkWFjr+:_TE8T.f]a0v}Qo)= wxgQ_q7>?9ߴc4XCWl_ceW`6 m sI|}aS`V.8+]OԻhߤ.6 Vq:Qe_=4/L!rjffcJ;QS,ܺ"&V7UonqK7kn&ۺm|ct.=q5j>ubGNw `#c9\G5.L.NQC!H#,hLhIsl9Aϳ!"'e"i 6pSwck лG82#&`|{ #kcgGd#<^# I`!xuW#"kqF~)8`)+CCa!)'_r"w:dl?y$혐Έb7.I% '#;$!fô;S|E{ne6Ǽlg).=I<OEW5_nGS2OoEAO"Sͯ[Am[("([1v9YrlY'R.cOLE).6Of5 3W.PZ& SZ`> Ͽ.LIsz y&ұ%o3Ͳm}u?<^±S}`M&baBѢJ0Di%ᾣQ Is ,%KۤM=jjwD4h'qdA҂t%s5;1V>B=4C}У-=lia ־(tgT}4ܟLbZZְ>̉,H2!SV}m=x /:v!Qח/LDEM ]ؖ\M6MI0Y589*||Um0>Ųek I_ּ=lòdK_2Y&f|<_7ޑxxB~6,^x&18Vgoimg>~4G9hٷ63NL|Dž`s%mɧ|ѓջm=m3б;7#=vU|GiC 3_ҮG>c[ڼ^y\?g1ms'/曩7ط  ;wq!)׀e-⻜zlt6z<z SO?q|S=uW_,kz .zY=M~uE,^z߰<zz},cW=2| ʞ6 !?7kWNA|=_zsc?_,bP3xLkk%|m떎mQ5>f[-kss_=[˿i6 7nSoQi-8ݍheqw:zK! όp ]|'ڿ|y=1?v#q~k*> endobj 180 0 obj << /Length 4315 /Filter /FlateDecode >> stream xZO1KXdҗ(HĖ@,】m眪 H,q}SNL>뇫;-rI+xt}qzF?_\=};p~wǗ_]#^ =l]'W ݗy4H5n rMwGt68ol7?9m?]1Ļ+qz={}}R>}3:'9u\s=~sgrx}!TZ }4ph1GsǢYi,ŏ߿CIO~Jw/~u=8A`槗oy3^?ݩiTi~ |TPWsLNhC #`"*5rr|&V>'=;]V3DI mA38UvKnwkWFjr+:_TE8T.f]a0v}Qo)= wxgQ_q7>?9ߴc4XCWl_ceW`6 m sI|}aS`V.8+]OԻhߤ.6 Vq:Qe_=4/L!rjffcJ;QS,ܺ"&V7UonqK7kn&ۺm|ct.=q5j>ubGNw `#c9\G5.L.NQC!H#,hLhIsl9Aϳ!"'e"i 6pSwck лG82#&`|{ #kcgGd#<^# I`!xuW#"kqF~)8`)+CCa!)'_r"w:dl?y$혐Έb7.I% '#;$!fô;S|E{ne6Ǽlg).=I<OEW5_nGS2OoEAO"Sͯ[Am[("([1v9YrlY'R.cOLE).6Of5 3W.PZ& SZ`> Ͽ.LIsz y&ұ%o3Ͳm}u?<^±S}`M&baBѢJ0Di%ᾣQ Is ,%KۤM=jjwD4h'qdA҂t%s5;1V>B=4C}У-=lia ־(tgT}4ܟLbZZְ>̉,H2!SV}m=x /:v!Qח/LDEM ]ؖ\M6MI0Y589*||Um0>Ųek I_ּ=lòdK_2Y&f|<_7ޑxxB~6,^x&18Vgoimg>~4G9hٷ63NL|Dž`s%mɧ|ѓջm=m3б;7#=vU|GiC 3_ҮG>c[ڼ^y\?g1ms'/曩7ط  ;wq!)׀e-⻜zlt6z<z SO?q|S=uW_,kz .zY=M~uE,^z߰<zz},cW=2| ʞ6 !?7kWNA|=_zsc?_,bP3xLkk%|m떎mQ5>f[-kss_=[˿i6 7nSoQi-8ݍheqw:zK! όp ]|'ڿ|y=1?v#q~k*> endobj 182 0 obj << /Length 4315 /Filter /FlateDecode >> stream xZO1KXdҗ(HĖ@,】m眪 H,q}SNL>뇫;-rI+xt}qzF?_\=};p~wǗ_]#^ =l]'W ݗy4H5n rMwGt68ol7?9m?]1Ļ+qz={}}R>}3:'9u\s=~sgrx}!TZ }4ph1GsǢYi,ŏ߿CIO~Jw/~u=8A`槗oy3^?ݩiTi~ |TPWsLNhC #`"*5rr|&V>'=;]V3DI mA38UvKnwkWFjr+:_TE8T.f]a0v}Qo)= wxgQ_q7>?9ߴc4XCWl_ceW`6 m sI|}aS`V.8+]OԻhߤ.6 Vq:Qe_=4/L!rjffcJ;QS,ܺ"&V7UonqK7kn&ۺm|ct.=q5j>ubGNw `#c9\G5.L.NQC!H#,hLhIsl9Aϳ!"'e"i 6pSwck лG82#&`|{ #kcgGd#<^# I`!xuW#"kqF~)8`)+CCa!)'_r"w:dl?y$혐Έb7.I% '#;$!fô;S|E{ne6Ǽlg).=I<OEW5_nGS2OoEAO"Sͯ[Am[("([1v9YrlY'R.cOLE).6Of5 3W.PZ& SZ`> Ͽ.LIsz y&ұ%o3Ͳm}u?<^±S}`M&baBѢJ0Di%ᾣQ Is ,%KۤM=jjwD4h'qdA҂t%s5;1V>B=4C}У-=lia ־(tgT}4ܟLbZZְ>̉,H2!SV}m=x /:v!Qח/LDEM ]ؖ\M6MI0Y589*||Um0>Ųek I_ּ=lòdK_2Y&f|<_7ޑxxB~6,^x&18Vgoimg>~4G9hٷ63NL|Dž`s%mɧ|ѓջm=m3б;7#=vU|GiC 3_ҮG>c[ڼ^y\?g1ms'/曩7ط  ;wq!)׀e-⻜zlt6z<z SO?q|S=uW_,kz .zY=M~uE,^z߰<zz},cW=2| ʞ6 !?7kWNA|=_zsc?_,bP3xLkk%|m떎mQ5>f[-kss_=[˿i6 7nSoQi-8ݍheqw:zK! όp ]|'ڿ|y=1?v#q~k*> endobj 184 0 obj << /Length 4237 /Filter /FlateDecode >> stream xZMfEݿ.as]UŨ QdG0 ѿ9UA\0_էN{ѕ/o_>rf%\Zӝk?W<<'~˟?//}xg<6> r8Aq€ ߻zq‡^9{D_$8N04VWo޽7>{z˯_ Ğ}?/{o{o?^}nU8=~߾k@精}1Qˌfv'/9qz=kR %cI]՟;=n w{w$IG|8XoUX'ܹݵ +=-~8[ .YNq޵۝\܏8vRr:ę=]->1mcRջx~W^@;sw0>xl<`Xh>N-^rDZF>wx!a[xXUv?~0JI?=Z9$@=bHȻGmE7SaY:ÙܙGAk1Pyr͏V/+0,@;ŗ\'A\G|-gȍ|]TcIB|-QAW>C+!RץP)ֈ5*no=Pq>Kjbn=%w=S AXr 7gJ̉BZNg ! ڮ0H0^pF !g!.G ]x~7b;G0#1cNG203^یg3Y}a6^i{g>,Zv\h9 :XGX>^Y#"?pLXxrTW#cےFbD\D#d>8Q8rw,v R;k-Y7mG A߶cѐPbnC0eB fYI|.& =W`[lj>)Jc =[0{O\)l^xW?/_\o¼%o_2LHWf q~v}N/9?Mގ׸^O0@zs[`. wmԋ&1Iȱc!m8R'o3 ժV FWC^< Li@{EzSOl^Pf^4f)K"LI'X.EA4:h!jpf ʖ uu CM+nrX uG@Bipѣ[JB&% [*Ma2z"MU/.LxS8vm`-dMMꑺnSa25L1&i22'`69DwGWE>bكOɫi'ڈ@ 0/M6 ~0MO |xb} ᱁q O֊g7  >0~ȇmxS|g W;A>#|>Qq>V ?I1-}`kKxb@*KInOE?XIT3e:0QQ4O 'S;Q }MOЏDݵM',}~H86D}KK*X>Q,CUX{1~Ҍkz'`Xmg0ѬZ|1M}cqj:a-O2^k>.1_/kţxOv9ݼAzJzvϽr=_^OzG|n7ÐmG"|`HGcb;xa={S{|VwMbnRLPn;zFY=b`ؔO"&3ELc`?SMԟ\>&o3^S_S59èz@bpf ⮻(Qoy|#zE\zܶnzHӮʪ~zK0&Ѩ|>usb]9~I_y'/߄~MmOoۯpz8?C?~LO?֣)\~ 7뾰#JhEܸ~ǦM9(~zU$"gonˁ~ᗩvm tq`6˯#ǗO/&v5W&4Ok݃^5?A-|u%Dz?ڿKrDD7Ch{ځ_FZ${xk^{modt֬p=&AgȣL.ibo]{;]=@zpkqb'CL]c)* =0KkE{3]yvo"!5E{VbBN!79x9!}hO|a`n.u{O$R }r^qv(U,!ql ln,Su8yRnf>Gy6ۡ7FOi{TJ{2ߣ,a'exG'1 \}֟׼h}s{noƞ"1;e,$&^Ӯ@ebƯ=T>aW?c|vCc㗲 縏rlFU2k읱jaWeQ{ފDE}Xz\/?{+_6Ў}.SNv;3]D-Xbء% (&'An,|l|g xiO $Ư#N?ГЋ+Ĵ3w-5> ԉ!$_uةeEMWU^ =9c=:_,=ÎVd|UCo0?KeEč5IEs!4艥g AOB/a+aO\@x8e'|,>ʎ1b®x+z\buq+{H_D,y",׶hHd+°L{"|0형/ 47}7Y E|5q!\l#w.4S^[O,Xzczd>խW%zfx革e^9_IࡷS+SY=l'G= .G__v}{l#~w3ߎzquCΟۿ^2^F YveQlfzl{j'wO8d ~bfXL?|~eC#_bO?Qߢ?M?F!i+~z(4rA{, t!oZl,?jW;O= /S퇻헻o~z{xxwۯT_>Bk)?yox. 0+r -8k?3`u@~8{أ/9{׸7?~s;VpuNCO߽o|~˿當endstream endobj 185 0 obj << /Type /Page /Parent 3 0 R /Contents 186 0 R /Resources 4 0 R >> endobj 186 0 obj << /Length 4222 /Filter /FlateDecode >> stream xZˮ%G߯襽i*^[#@ < lk3~̬ ,|=q*+22IקW}UV4%-%_\栗}>~s?s?oi+?_\~Iק𧻓o^[xŻKn>9dgW>ykx/?eFT^J qCyÛO_z+{~@}?+7?|߼է?a2g/˯|&tn?Z1PUQ}_ `?GHuk!X۝ Rƞ; L1rztfP^!w*1Q 0t+XLw+==26{/=ʏӸԻTR%nJXH́qعbKF˄•cqw~0=q"->[|ygX=n9q\xc~Xh?1og`IJ#Wwx4}y1o_/otF室bƺ`8w}T JܙRbf tPG=6ķ/`—oHܹ:l8 vAŜ֍ 9j@y[@.w9ָ}x"aHm |꙳18x5"8=<Oy8iP Ki$pߠ# =oz9||h2_W>Uz|3!M|VAw>CWɏuX.=)z^4[O %zӔkQ|֫fYQ~K SOXRˡ ׷ : } u*q'VU[E/5_%Ȯ.PĒvQވ~,Ĭٳvr=(\(*/* 3Ϻͅ:Ȯ [4_i{-c;&Hr8 vr;f`9u9"SDŽ./GL,ӑqIcC`ttv|t;!txv{9Nld;RA?kovńr;bl3jᨁS=76V6CLguef*~X}nFR56A|2W8\䇚2 bL朲A޿ySmnO\ CND2ix>@m>Τ}Dl=?I:dzz+=i~vsj!ĔZpԧLL  ֧!Ђ8ߘ(æ~ ^/7j6ZԺUGƳ^ 29)^j1E+ i:F" Ij;AXz={1[a배`ج=9>$BM|=_$[׋D~xߌWxvot]J;7a'`߀<-;:}yn39|B6-|ǎW>S +߅[z@LL?ڡ'JSoxz$}KY?ϩwg<^?^~O=z,.f`X z{b0"?nE~ӏ&ӯc[t{E95LoG=xUgnKc|ac_~OS_I|=80׻7l?Ġ^~m~sؠwxՔk$ܚ_?B6/{wc=O:c^q9~wIfX7?e2ә)܍mq9vJ!AOA:<fb?Ӟ٩vؿ ۍ{?mvw^;;D)3lؕu!bh'_6~~r|~t'ŎyǯطNgՈ}}Y :A; ~_S{5_4Ҫ'0am3_?[ +%'ebWG#%wl>5_8uK\hM)ciS?p?]X 4WJ#OsݭQia)?VI8߿qpbyKݮxCW Mk?_C~R~D>d&7b} eLj@.>|g8f |l>n7"ǮW6qz;ǯc׌ǪW?"P?-ݏzUus/۳Yrȧ07Oӏtӯ3w_U|闘O~mE}~e5W9q=}zA } !,o,?+W[gwparaVnu;u~}Ϧ߷_@3'uPZbxՔk`n LžL_?kt;Gޝ}}s8=b6uxȞ[u/Gu׼7?4V߲ⷬc[7o߿g˿]endstream endobj 187 0 obj << /Type /Page /Parent 3 0 R /Contents 188 0 R /Resources 4 0 R >> endobj 188 0 obj << /Length 732 /Filter /FlateDecode >> stream xVMO1W5 j+!M*6(Twl7cF\voތj $ |A9phF--|qV{d"~ 2ZH  ꤤS:WF;rp@J)ga[\߀B$cs;=!*iT6[Skc Q*KFˠO0Db 3[sNy/a7lϯ0S1x|ʭpE[O +y_?uendstream endobj 189 0 obj << /Type /Page /Parent 3 0 R /Contents 190 0 R /Resources 4 0 R >> endobj 190 0 obj << /Length 4087 /Filter /FlateDecode >> stream xZɮ,q߯/(&O¹ :(T_~Fnq)0l|nς9F?z<2> /+`n0qMO h~?';>]u~8c}zDN`/!/5]A[zlS+DPܯ[z&,]f/8n^ɐ=1$zTRf/GQ.zPOU~\zn_LOn:b<[f/{?hcq!9ʹlBv6 oGyj=$r) !WU$ܺ* ac9,=ED:.2jb0~U`m>j~=CxUal|ݚBwi<1fҼpMxy},Ŵô),"mҶӼt^l7w0unt $yOuQ&Hgly~s]:Oos^qIqÞڒ/{uO/=/"G\;]w<ʺ x+Ga+hB:BW>4FZYW>iO9#gr?1v/P-.s'!woG8 ~ >2Cu۾.u^e=Qfq?/0Ua2tF_5-dC&C A!3aa!S[ L2-{,fI??d,#F!À x/uq_<8N|LvD6_o|T(34*T"),bT"-`/C01;<궮T ڒYC#UBPݡɑU}DS|=(:Za0͏bWΜPjP9ªY)[V⑳y8o۶jFx5u,qAZW'Uw͢³>ώc_g/~uTWP@:V*˜Ul)Pd[a!Qi#q:nLeNP툰9!x_MjfNZ+8yTaG=Æ.`)SvQ`G"foG"g#ERY-R섔)z\}QtOuƛ豺VWJ`OTGPlXrb%]y!WlX,`k0V#G͍&XH"KPXj2z=[[mN3_j@Y~ [#pS=1V<oG1["~Ӑv۰죽ͫ.eZzʲ),(3 [Sfm[AB~T#Vx]bw</ MmRbm5 Rj2!~{Q|ؒqW8(CU0P|WTUb]b)~kZ&0 KXոrҕ>oYxEDa6V`/=ejhQqY/RgJofFσ/@\ʯM&{5mLLo&UG.^ \Lbu?u׋ 8AKANM1hU !G Dq6@ʼnJb.~Ftc5ھ:>[⽧X\gcqKDD5ۿ8KE×VSN.N;tZKkypאż>GykOQ~\=Q-1FU.0=g-.bSur2V֠/g^76?˽T˽&NưY< AQڋ*uwaWbK֥ӑS׻]H~ɳk:Bw{2ڟT/Sh/?0dTj''MyRwCwiVw}P9=zG{ph]ă\Si=EU<*T_J|E%G35<Ż׃Q-9%L^fT{oک,uޖօ5{,i"OC0 mY};[VbV!VXe㰽 K58zNڏa~ȞCI4^i?Ҳz L,{7E3ٻu׋Q=4>ʾ_|VVȷӞ=yN{r\X^;ڞlWe|u?'yr_C>xw=Ow'ޠJkXjN<;^Μ|WWO"]W>r^Rvwv*|a>iiFjiP~fu{oj9泖O>Zy-|r >[[b ]{|bng\|N/g 7qZn\gߍO=y^p=m-WzLzzMe9v^aoo'?1Pi#{G{zeOG#Ύl=K'{֊_=ynF~:?cw~BZl =7edu~#zrbbwѫ3=;OB=z?~`ďoN0ί8/O1j5T]Sf_l}]?1xg'N8C-r#r=HkD}ojbm!]}Ǿ|?s ,\sendstream endobj 191 0 obj << /Type /Page /Parent 3 0 R /Contents 192 0 R /Resources 4 0 R >> endobj 192 0 obj << /Length 4251 /Filter /FlateDecode >> stream xZMGbp`3WGR%2(r" ~18Rbzvvgwŕ^Sf[Zn,W[ z?tן~˟ro/%cso>uk%=.?v=+q9vP]1qN`:px ]ŀs޸ۗ~S?]_i^zt_^o~>'ݝN?]ag/='^ӊŗO0{+%_/g$W0N+s㴽_:6]-`{5jU\ Pwn=2aˬ/;cT.6as&D{ܭ̻'V~'Nw^8ɆǽmW{+q!VvE!8s< 'w ,&0H){1}N\3ݟoxx01wLgi\'92^/xh`3תs?6i6|3c]3z77{_x;N踞pLGFoTwoX v1Xxcb#~Wpl;0K$sMȈf{r9M>dsWbpز//m-om >5,7c&YbLͰ-[8qhBp+F\6i7Ş Ѱ&*Yn mZu)揋a@{xDJ<>Ëj~0.̻ (S):'.i a7~,"hh2+LK]xq=Ua` 8UCªOlZyiC ȶbafp5öXF@&o ;Û  }GºX y`[FMxD? Uc>ce?|鿱_㴇$Þ6Mɇ uOy8O[Hyw tmdfQf|? |+ح<}z<"^xx#xx53)G, >%E|\>1NU|;w>S|e,K{-{߁vBV>hX|j4Kr?(:_PIsÌ{{ti|f ٟ$\4T3Sz{&2ߞyϗPH>ӨaӬGyyidq3RyyJ.L~]2c~.#`62sHH5.c̬1=Zt>df=fQ2+ߺ 3$$ߋddsg .jՇxlSLLrk,2p:Tӡkd0V zv}m7<]Lʽv]ߧcwMA';l*~FX݂&ܩ1 Xh;_U 1֢RoZ0ƟgiÀ7_fڨH R3FiaToTD$qQQL ZUN$[Uq~L}dbW5_h/H. bd'Ov`]׹1->'U\YUE)㱌z<!er*z(rHɇ={Mϰ)=1+iFS7T:ay#-̒O,|5͎Ah;+ڈ7Po(|QDD3 vĻU #|`~;.GH+3z'߉&|wBQ||[h赃%>4u5EGxg2|.{>MMP>V>SVE|3((Uҏ|H3FiM̷]cXKXzFzmXQ/`HO{Gzސ}ՑqY􌝧w8wpH?ßBOёC#&fP&I {??AWu\/.BO#qt4&6_,^E:wgp= ; qt5åק =on Q0녙\{=Y/To%@GNׯ?ZV''ؑe" clZDV]=A[Bo9L{l_{m#l!qW/-Oa5`@/z٨rXN5ppk~jODV_jMόfF8L]WCDj b7*y+&:PaObo 4]p)!=QE_PJ7yC zK6Qt9i;[=3|kN&G` Ww}(~1Y'‘*E6WEb5=jQY|]# '*FoP133Q^=CH+CHn%xp ߚ\>fʕZvȏTT9†30%bɧtW\Nx^MO9(7A_O~1Vg㭚<7s$ȃxSF&yeihU{G]̫/uQ^TNl-w<&n/ ]Wl6 w>B#DǂjE/4ZTCVm&gWeZtoWOC+?Y7m:vB Vg<7ԝRS޵&{۱hyB{63xhb<Ph{#z|&{%>jFu=oy/[.b=QzQc?Q~Q#SWI핰vYFy[2yCN˧?f 3f{-0ۑ᯻< _D<;e_ym9E-fi>uf2g>f|r_3?iwW>7|/ah*~ǰ8q^*ǔU=z[ץoRo|#LWT9zUy #z"^G1,~|:)쏖5'"] O. X$H$hWzT뒙q#>["uR_uPx+~S>%_[b~Hbqo}}~\endstream endobj 193 0 obj << /Type /Page /Parent 3 0 R /Contents 194 0 R /Resources 4 0 R >> endobj 194 0 obj << /Length 4155 /Filter /FlateDecode >> stream xZˮqО~Le$ d`d6IGT"5]fwuժUEWWwj׬wkW3߽\;/_ ~J׿?~<u}9[k=zN^y۟nʵ}`sܩ{qsޣ B c{ |I`w'lwN{+͍λb%x˼`3f.\ՆY`vgwYgnX { b5ݍq\?;g܄(tW_wyߣonαqS8eay!3?{9? X tV8][|p&2=lx0}MvZ/ySwBLtXyaro1x| \nOo_T =%? <|O<Bx3h8⍴85 lxɉ;h|1_@87\|5WKy$ƨ>cW~%eb[l+i7fH>dw:ij nv!vt*"n革toc=8i~Ly /dK!8o??d {e ܤy!s?ݲ2hCFx?2 n|2 8iibYg7̃yGD`kHaxLC=CI%BG,Bu(6s塜QՀ㡺A[2khr8X(;<9 ϗ|ZE8PimY|q~BBzqo/f |MW>f⑳/^?~LmՌ>s4y,wg KU{-q={_D%_.x`ұ:UjDKM&ÀJQ݈qcLcvt>j!"Λljv.XV3wZZX6FR;"6tv)u[Mɜӏ`=.O5{>9)rjulQNYlYNxgwjq *ap$7>Ae EPޡ^%;Q(X]9ؕJnfPW:Cpmuh8qh^ $F)sy8$;K}Kz(Kϣ5as8nڟ'BU(b\bYo.aW}6y5KlT\Q)[LlG-Sib/*_:$dɟV7HvuEcKVSx bٯQƇ&,@]MWƋy&Yj) Bmʃ^ƕݔU0|ˊoK-%r)|Pxy(PM"~:UjU|*GW._MjRrk_ Lo&+7m]}]r\LbU?uxX__|p[9_Z>٧5-G,Rۃv >}I>{%Ҧ> c6ڃ"7ӌ~|QQ'c %?Q+_*}p>$^|YO0)"w>ݠh/?0dTQNgO4IQ;;9=Бf.J' ԡѨ <5#QTNեĊ:-/ZK]:h]!|8oCb_@9DyÆiˌ[r%-`%uo =4[Ƨ܅U-+0jvB+Ixs+zLބ%zNʏf~ȞCI^ip~eXn|6gwi|0˕VVȷSΛr?a|:w=OwߠJky#ڑ_!gU'w9@_E<~xۯr]ez>kKNs7ܦOAKTEK=|Ҍ|ӠK}|rg-x6ߵ/-|r >꼃o.07T1v]9~=ݦw>w vD;i]N9_ϴӾ|%a|^W[گ>1v5/y^.ǜz zX =wWt9q?Bd^:{NߣV|tؚ|A=r|BZl =cЋ|#zr>^\;ztEo᎞ӣл3ګGuy^~ ]JϏGG;U |uy~aP71r2#d7ﲡM;x"*Iod3䯁X/G!ȹ dhB}c]f\nj+_te}^GO^o?_~y}7>sendstream endobj 195 0 obj << /Type /Page /Parent 3 0 R /Contents 196 0 R /Resources 4 0 R >> endobj 196 0 obj << /Length 4155 /Filter /FlateDecode >> stream xZˮqО~Le$ d`d6IGT"5]fwuժUEWWwj׬wkW3߽\;/_ ~J׿?~<u}9[k=zN^y۟nʵ}`sܩ{qsޣ B c{ |I`w'lwN{+͍λb%x˼`3f.\ՆY`vgwYgnX { b5ݍq\?;g܄(tW_wyߣonαqS8eay!3?{9? X tV8][|p&2=lx0}MvZ/ySwBLtXyaro1x| \nOo_T =%? <|O<Bx3h8⍴85 lxɉ;h|1_@87\|5WKy$ƨ>cW~%eb[l+i7fH>dw:ij nv!vt*"n革toc=8i~Ly /dK!8o??d {e ܤy!s?ݲ2hCFx?2 n|2 8iibYg7̃yGD`kHaxLC=CI%BG,Bu(6s塜QՀ㡺A[2khr8X(;<9 ϗ|ZE8PimY|q~BBzqo/f |MW>f⑳/^?~LmՌ>s4y,wg KU{-q={_D%_.x`ұ:UjDKM&ÀJQ݈qcLcvt>j!"Λljv.XV3wZZX6FR;"6tv)u[Mɜӏ`=.O5{>9)rjulQNYlYNxgwjq *ap$7>Ae EPޡ^%;Q(X]9ؕJnfPW:Cpmuh8qh^ $F)sy8$;K}Kz(Kϣ5as8nڟ'BU(b\bYo.aW}6y5KlT\Q)[LlG-Sib/*_:$dɟV7HvuEcKVSx bٯQƇ&,@]MWƋy&Yj) Bmʃ^ƕݔU0|ˊoK-%r)|Pxy(PM"~:UjU|*GW._MjRrk_ Lo&+7m]}]r\LbU?uxX__|p[9_Z>٧5-G,Rۃv >}I>{%Ҧ> c6ڃ"7ӌ~|QQ'c %?Q+_*}p>$^|YO0)"w>ݠh/?0dTQNgO4IQ;;9=Бf.J' ԡѨ <5#QTNեĊ:-/ZK]:h]!|8oCb_@9DyÆiˌ[r%-`%uo =4[Ƨ܅U-+0jvB+Ixs+zLބ%zNʏf~ȞCI^ip~eXn|6gwi|0˕VVȷSΛr?a|:w=OwߠJky#ڑ_!gU'w9@_E<~xۯr]ez>kKNs7ܦOAKTEK=|Ҍ|ӠK}|rg-x6ߵ/-|r >꼃o.07T1v]9~=ݦw>w vD;i]N9_ϴӾ|%a|^W[گ>1v5/y^.ǜz zX =wWt9q?Bd^:{NߣV|tؚ|A=r|BZl =cЋ|#zr>^\;ztEo᎞ӣл3ګGuy^~ ]JϏGG;U |uy~aP71r2#d7ﲡM;x"*Iod3䯁X/G!ȹ dhB}c]f\nj+_te}^GO^o?_~y}7>sendstream endobj 197 0 obj << /Type /Page /Parent 3 0 R /Contents 198 0 R /Resources 4 0 R >> endobj 198 0 obj << /Length 4155 /Filter /FlateDecode >> stream xZˮqО~Le$ d`d6IGT"5]fwuժUEWWwj׬wkW3߽\;/_ ~J׿?~<u}9[k=zN^y۟nʵ}`sܩ{qsޣ B c{ |I`w'lwN{+͍λb%x˼`3f.\ՆY`vgwYgnX { b5ݍq\?;g܄(tW_wyߣonαqS8eay!3?{9? X tV8][|p&2=lx0}MvZ/ySwBLtXyaro1x| \nOo_T =%? <|O<Bx3h8⍴85 lxɉ;h|1_@87\|5WKy$ƨ>cW~%eb[l+i7fH>dw:ij nv!vt*"n革toc=8i~Ly /dK!8o??d {e ܤy!s?ݲ2hCFx?2 n|2 8iibYg7̃yGD`kHaxLC=CI%BG,Bu(6s塜QՀ㡺A[2khr8X(;<9 ϗ|ZE8PimY|q~BBzqo/f |MW>f⑳/^?~LmՌ>s4y,wg KU{-q={_D%_.x`ұ:UjDKM&ÀJQ݈qcLcvt>j!"Λljv.XV3wZZX6FR;"6tv)u[Mɜӏ`=.O5{>9)rjulQNYlYNxgwjq *ap$7>Ae EPޡ^%;Q(X]9ؕJnfPW:Cpmuh8qh^ $F)sy8$;K}Kz(Kϣ5as8nڟ'BU(b\bYo.aW}6y5KlT\Q)[LlG-Sib/*_:$dɟV7HvuEcKVSx bٯQƇ&,@]MWƋy&Yj) Bmʃ^ƕݔU0|ˊoK-%r)|Pxy(PM"~:UjU|*GW._MjRrk_ Lo&+7m]}]r\LbU?uxX__|p[9_Z>٧5-G,Rۃv >}I>{%Ҧ> c6ڃ"7ӌ~|QQ'c %?Q+_*}p>$^|YO0)"w>ݠh/?0dTQNgO4IQ;;9=Бf.J' ԡѨ <5#QTNեĊ:-/ZK]:h]!|8oCb_@9DyÆiˌ[r%-`%uo =4[Ƨ܅U-+0jvB+Ixs+zLބ%zNʏf~ȞCI^ip~eXn|6gwi|0˕VVȷSΛr?a|:w=OwߠJky#ڑ_!gU'w9@_E<~xۯr]ez>kKNs7ܦOAKTEK=|Ҍ|ӠK}|rg-x6ߵ/-|r >꼃o.07T1v]9~=ݦw>w vD;i]N9_ϴӾ|%a|^W[گ>1v5/y^.ǜz zX =wWt9q?Bd^:{NߣV|tؚ|A=r|BZl =cЋ|#zr>^\;ztEo᎞ӣл3ګGuy^~ ]JϏGG;U |uy~aP71r2#d7ﲡM;x"*Iod3䯁X/G!ȹ dhB}c]f\nj+_te}^GO^o?_~y}7>sendstream endobj 199 0 obj << /Type /Page /Parent 3 0 R /Contents 200 0 R /Resources 4 0 R >> endobj 200 0 obj << /Length 4155 /Filter /FlateDecode >> stream xZˮqО~Le$ d`d6IGT"5]fwuժUEWWwj׬wkW3߽\;/_ ~J׿?~<u}9[k=zN^y۟nʵ}`sܩ{qsޣ B c{ |I`w'lwN{+͍λb%x˼`3f.\ՆY`vgwYgnX { b5ݍq\?;g܄(tW_wyߣonαqS8eay!3?{9? X tV8][|p&2=lx0}MvZ/ySwBLtXyaro1x| \nOo_T =%? <|O<Bx3h8⍴85 lxɉ;h|1_@87\|5WKy$ƨ>cW~%eb[l+i7fH>dw:ij nv!vt*"n革toc=8i~Ly /dK!8o??d {e ܤy!s?ݲ2hCFx?2 n|2 8iibYg7̃yGD`kHaxLC=CI%BG,Bu(6s塜QՀ㡺A[2khr8X(;<9 ϗ|ZE8PimY|q~BBzqo/f |MW>f⑳/^?~LmՌ>s4y,wg KU{-q={_D%_.x`ұ:UjDKM&ÀJQ݈qcLcvt>j!"Λljv.XV3wZZX6FR;"6tv)u[Mɜӏ`=.O5{>9)rjulQNYlYNxgwjq *ap$7>Ae EPޡ^%;Q(X]9ؕJnfPW:Cpmuh8qh^ $F)sy8$;K}Kz(Kϣ5as8nڟ'BU(b\bYo.aW}6y5KlT\Q)[LlG-Sib/*_:$dɟV7HvuEcKVSx bٯQƇ&,@]MWƋy&Yj) Bmʃ^ƕݔU0|ˊoK-%r)|Pxy(PM"~:UjU|*GW._MjRrk_ Lo&+7m]}]r\LbU?uxX__|p[9_Z>٧5-G,Rۃv >}I>{%Ҧ> c6ڃ"7ӌ~|QQ'c %?Q+_*}p>$^|YO0)"w>ݠh/?0dTQNgO4IQ;;9=Бf.J' ԡѨ <5#QTNեĊ:-/ZK]:h]!|8oCb_@9DyÆiˌ[r%-`%uo =4[Ƨ܅U-+0jvB+Ixs+zLބ%zNʏf~ȞCI^ip~eXn|6gwi|0˕VVȷSΛr?a|:w=OwߠJky#ڑ_!gU'w9@_E<~xۯr]ez>kKNs7ܦOAKTEK=|Ҍ|ӠK}|rg-x6ߵ/-|r >꼃o.07T1v]9~=ݦw>w vD;i]N9_ϴӾ|%a|^W[گ>1v5/y^.ǜz zX =wWt9q?Bd^:{NߣV|tؚ|A=r|BZl =cЋ|#zr>^\;ztEo᎞ӣл3ګGuy^~ ]JϏGG;U |uy~aP71r2#d7ﲡM;x"*Iod3䯁X/G!ȹ dhB}c]f\nj+_te}^GO^o?_~y}7>sendstream endobj 201 0 obj << /Type /Page /Parent 3 0 R /Contents 202 0 R /Resources 4 0 R >> endobj 202 0 obj << /Length 4155 /Filter /FlateDecode >> stream xZˮqО~Le$ d`d6IGT"5]fwuժUEWWwj׬wkW3߽\;/_ ~J׿?~<u}9[k=zN^y۟nʵ}`sܩ{qsޣ B c{ |I`w'lwN{+͍λb%x˼`3f.\ՆY`vgwYgnX { b5ݍq\?;g܄(tW_wyߣonαqS8eay!3?{9? X tV8][|p&2=lx0}MvZ/ySwBLtXyaro1x| \nOo_T =%? <|O<Bx3h8⍴85 lxɉ;h|1_@87\|5WKy$ƨ>cW~%eb[l+i7fH>dw:ij nv!vt*"n革toc=8i~Ly /dK!8o??d {e ܤy!s?ݲ2hCFx?2 n|2 8iibYg7̃yGD`kHaxLC=CI%BG,Bu(6s塜QՀ㡺A[2khr8X(;<9 ϗ|ZE8PimY|q~BBzqo/f |MW>f⑳/^?~LmՌ>s4y,wg KU{-q={_D%_.x`ұ:UjDKM&ÀJQ݈qcLcvt>j!"Λljv.XV3wZZX6FR;"6tv)u[Mɜӏ`=.O5{>9)rjulQNYlYNxgwjq *ap$7>Ae EPޡ^%;Q(X]9ؕJnfPW:Cpmuh8qh^ $F)sy8$;K}Kz(Kϣ5as8nڟ'BU(b\bYo.aW}6y5KlT\Q)[LlG-Sib/*_:$dɟV7HvuEcKVSx bٯQƇ&,@]MWƋy&Yj) Bmʃ^ƕݔU0|ˊoK-%r)|Pxy(PM"~:UjU|*GW._MjRrk_ Lo&+7m]}]r\LbU?uxX__|p[9_Z>٧5-G,Rۃv >}I>{%Ҧ> c6ڃ"7ӌ~|QQ'c %?Q+_*}p>$^|YO0)"w>ݠh/?0dTQNgO4IQ;;9=Бf.J' ԡѨ <5#QTNեĊ:-/ZK]:h]!|8oCb_@9DyÆiˌ[r%-`%uo =4[Ƨ܅U-+0jvB+Ixs+zLބ%zNʏf~ȞCI^ip~eXn|6gwi|0˕VVȷSΛr?a|:w=OwߠJky#ڑ_!gU'w9@_E<~xۯr]ez>kKNs7ܦOAKTEK=|Ҍ|ӠK}|rg-x6ߵ/-|r >꼃o.07T1v]9~=ݦw>w vD;i]N9_ϴӾ|%a|^W[گ>1v5/y^.ǜz zX =wWt9q?Bd^:{NߣV|tؚ|A=r|BZl =cЋ|#zr>^\;ztEo᎞ӣл3ګGuy^~ ]JϏGG;U |uy~aP71r2#d7ﲡM;x"*Iod3䯁X/G!ȹ dhB}c]f\nj+_te}^GO^o?_~y}7>sendstream endobj 203 0 obj << /Type /Page /Parent 3 0 R /Contents 204 0 R /Resources 4 0 R >> endobj 204 0 obj << /Length 4251 /Filter /FlateDecode >> stream xZMGbp`3WGR%2(r" ~18Rbzvvgwŕ^Sf[Zn,W[ z?tן~˟ro/%cso>uk%=.?v=+q9vP]1qN`:px ]ŀs޸ۗ~S?]_i^zt_^o~>'ݝN?]ag/='^ӊŗO0{+%_/g$W0N+s㴽_:6]-`{5jU\ Pwn=2aˬ/;cT.6as&D{ܭ̻'V~'Nw^8ɆǽmW{+q!VvE!8s< 'w ,&0H){1}N\3ݟoxx01wLgi\'92^/xh`3תs?6i6|3c]3z77{_x;N踞pLGFoTwoX v1Xxcb#~Wpl;0K$sMȈf{r9M>dsWbpز//m-om >5,7c&YbLͰ-[8qhBp+F\6i7Ş Ѱ&*Yn mZu)揋a@{xDJ<>Ëj~0.̻ (S):'.i a7~,"hh2+LK]xq=Ua` 8UCªOlZyiC ȶbafp5öXF@&o ;Û  }GºX y`[FMxD? Uc>ce?|鿱_㴇$Þ6Mɇ uOy8O[Hyw tmdfQf|? |+ح<}z<"^xx#xx53)G, >%E|\>1NU|;w>S|e,K{-{߁vBV>hX|j4Kr?(:_PIsÌ{{ti|f ٟ$\4T3Sz{&2ߞyϗPH>ӨaӬGyyidq3RyyJ.L~]2c~.#`62sHH5.c̬1=Zt>df=fQ2+ߺ 3$$ߋddsg .jՇxlSLLrk,2p:Tӡkd0V zv}m7<]Lʽv]ߧcwMA';l*~FX݂&ܩ1 Xh;_U 1֢RoZ0ƟgiÀ7_fڨH R3FiaToTD$qQQL ZUN$[Uq~L}dbW5_h/H. bd'Ov`]׹1->'U\YUE)㱌z<!er*z(rHɇ={Mϰ)=1+iFS7T:ay#-̒O,|5͎Ah;+ڈ7Po(|QDD3 vĻU #|`~;.GH+3z'߉&|wBQ||[h赃%>4u5EGxg2|.{>MMP>V>SVE|3((Uҏ|H3FiM̷]cXKXzFzmXQ/`HO{Gzސ}ՑqY􌝧w8wpH?ßBOёC#&fP&I {??AWu\/.BO#qt4&6_,^E:wgp= ; qt5åק =on Q0녙\{=Y/To%@GNׯ?ZV''ؑe" clZDV]=A[Bo9L{l_{m#l!qW/-Oa5`@/z٨rXN5ppk~jODV_jMόfF8L]WCDj b7*y+&:PaObo 4]p)!=QE_PJ7yC zK6Qt9i;[=3|kN&G` Ww}(~1Y'‘*E6WEb5=jQY|]# '*FoP133Q^=CH+CHn%xp ߚ\>fʕZvȏTT9†30%bɧtW\Nx^MO9(7A_O~1Vg㭚<7s$ȃxSF&yeihU{G]̫/uQ^TNl-w<&n/ ]Wl6 w>B#DǂjE/4ZTCVm&gWeZtoWOC+?Y7m:vB Vg<7ԝRS޵&{۱hyB{63xhb<Ph{#z|&{%>jFu=oy/[.b=QzQc?Q~Q#SWI핰vYFy[2yCN˧?f 3f{-0ۑ᯻< _D<;e_ym9E-fi>uf2g>f|r_3?iwW>7|/ah*~ǰ8q^*ǔU=z[ץoRo|#LWT9zUy #z"^G1,~|:)쏖5'"] O. X$H$hWzT뒙q#>["uR_uPx+~S>%_[b~Hbqo}}~\endstream endobj 205 0 obj << /Type /Page /Parent 3 0 R /Contents 206 0 R /Resources 4 0 R >> endobj 206 0 obj << /Length 4251 /Filter /FlateDecode >> stream xZMGbp`3WGR%2(r" ~18Rbzvvgwŕ^Sf[Zn,W[ z?tן~˟ro/%cso>uk%=.?v=+q9vP]1qN`:px ]ŀs޸ۗ~S?]_i^zt_^o~>'ݝN?]ag/='^ӊŗO0{+%_/g$W0N+s㴽_:6]-`{5jU\ Pwn=2aˬ/;cT.6as&D{ܭ̻'V~'Nw^8ɆǽmW{+q!VvE!8s< 'w ,&0H){1}N\3ݟoxx01wLgi\'92^/xh`3תs?6i6|3c]3z77{_x;N踞pLGFoTwoX v1Xxcb#~Wpl;0K$sMȈf{r9M>dsWbpز//m-om >5,7c&YbLͰ-[8qhBp+F\6i7Ş Ѱ&*Yn mZu)揋a@{xDJ<>Ëj~0.̻ (S):'.i a7~,"hh2+LK]xq=Ua` 8UCªOlZyiC ȶbafp5öXF@&o ;Û  }GºX y`[FMxD? Uc>ce?|鿱_㴇$Þ6Mɇ uOy8O[Hyw tmdfQf|? |+ح<}z<"^xx#xx53)G, >%E|\>1NU|;w>S|e,K{-{߁vBV>hX|j4Kr?(:_PIsÌ{{ti|f ٟ$\4T3Sz{&2ߞyϗPH>ӨaӬGyyidq3RyyJ.L~]2c~.#`62sHH5.c̬1=Zt>df=fQ2+ߺ 3$$ߋddsg .jՇxlSLLrk,2p:Tӡkd0V zv}m7<]Lʽv]ߧcwMA';l*~FX݂&ܩ1 Xh;_U 1֢RoZ0ƟgiÀ7_fڨH R3FiaToTD$qQQL ZUN$[Uq~L}dbW5_h/H. bd'Ov`]׹1->'U\YUE)㱌z<!er*z(rHɇ={Mϰ)=1+iFS7T:ay#-̒O,|5͎Ah;+ڈ7Po(|QDD3 vĻU #|`~;.GH+3z'߉&|wBQ||[h赃%>4u5EGxg2|.{>MMP>V>SVE|3((Uҏ|H3FiM̷]cXKXzFzmXQ/`HO{Gzސ}ՑqY􌝧w8wpH?ßBOёC#&fP&I {??AWu\/.BO#qt4&6_,^E:wgp= ; qt5åק =on Q0녙\{=Y/To%@GNׯ?ZV''ؑe" clZDV]=A[Bo9L{l_{m#l!qW/-Oa5`@/z٨rXN5ppk~jODV_jMόfF8L]WCDj b7*y+&:PaObo 4]p)!=QE_PJ7yC zK6Qt9i;[=3|kN&G` Ww}(~1Y'‘*E6WEb5=jQY|]# '*FoP133Q^=CH+CHn%xp ߚ\>fʕZvȏTT9†30%bɧtW\Nx^MO9(7A_O~1Vg㭚<7s$ȃxSF&yeihU{G]̫/uQ^TNl-w<&n/ ]Wl6 w>B#DǂjE/4ZTCVm&gWeZtoWOC+?Y7m:vB Vg<7ԝRS޵&{۱hyB{63xhb<Ph{#z|&{%>jFu=oy/[.b=QzQc?Q~Q#SWI핰vYFy[2yCN˧?f 3f{-0ۑ᯻< _D<;e_ym9E-fi>uf2g>f|r_3?iwW>7|/ah*~ǰ8q^*ǔU=z[ץoRo|#LWT9zUy #z"^G1,~|:)쏖5'"] O. X$H$hWzT뒙q#>["uR_uPx+~S>%_[b~Hbqo}}~\endstream endobj 207 0 obj << /Type /Page /Parent 3 0 R /Contents 208 0 R /Resources 4 0 R >> endobj 208 0 obj << /Length 4251 /Filter /FlateDecode >> stream xZMGbp`3WGR%2(r" ~18Rbzvvgwŕ^Sf[Zn,W[ z?tן~˟ro/%cso>uk%=.?v=+q9vP]1qN`:px ]ŀs޸ۗ~S?]_i^zt_^o~>'ݝN?]ag/='^ӊŗO0{+%_/g$W0N+s㴽_:6]-`{5jU\ Pwn=2aˬ/;cT.6as&D{ܭ̻'V~'Nw^8ɆǽmW{+q!VvE!8s< 'w ,&0H){1}N\3ݟoxx01wLgi\'92^/xh`3תs?6i6|3c]3z77{_x;N踞pLGFoTwoX v1Xxcb#~Wpl;0K$sMȈf{r9M>dsWbpز//m-om >5,7c&YbLͰ-[8qhBp+F\6i7Ş Ѱ&*Yn mZu)揋a@{xDJ<>Ëj~0.̻ (S):'.i a7~,"hh2+LK]xq=Ua` 8UCªOlZyiC ȶbafp5öXF@&o ;Û  }GºX y`[FMxD? Uc>ce?|鿱_㴇$Þ6Mɇ uOy8O[Hyw tmdfQf|? |+ح<}z<"^xx#xx53)G, >%E|\>1NU|;w>S|e,K{-{߁vBV>hX|j4Kr?(:_PIsÌ{{ti|f ٟ$\4T3Sz{&2ߞyϗPH>ӨaӬGyyidq3RyyJ.L~]2c~.#`62sHH5.c̬1=Zt>df=fQ2+ߺ 3$$ߋddsg .jՇxlSLLrk,2p:Tӡkd0V zv}m7<]Lʽv]ߧcwMA';l*~FX݂&ܩ1 Xh;_U 1֢RoZ0ƟgiÀ7_fڨH R3FiaToTD$qQQL ZUN$[Uq~L}dbW5_h/H. bd'Ov`]׹1->'U\YUE)㱌z<!er*z(rHɇ={Mϰ)=1+iFS7T:ay#-̒O,|5͎Ah;+ڈ7Po(|QDD3 vĻU #|`~;.GH+3z'߉&|wBQ||[h赃%>4u5EGxg2|.{>MMP>V>SVE|3((Uҏ|H3FiM̷]cXKXzFzmXQ/`HO{Gzސ}ՑqY􌝧w8wpH?ßBOёC#&fP&I {??AWu\/.BO#qt4&6_,^E:wgp= ; qt5åק =on Q0녙\{=Y/To%@GNׯ?ZV''ؑe" clZDV]=A[Bo9L{l_{m#l!qW/-Oa5`@/z٨rXN5ppk~jODV_jMόfF8L]WCDj b7*y+&:PaObo 4]p)!=QE_PJ7yC zK6Qt9i;[=3|kN&G` Ww}(~1Y'‘*E6WEb5=jQY|]# '*FoP133Q^=CH+CHn%xp ߚ\>fʕZvȏTT9†30%bɧtW\Nx^MO9(7A_O~1Vg㭚<7s$ȃxSF&yeihU{G]̫/uQ^TNl-w<&n/ ]Wl6 w>B#DǂjE/4ZTCVm&gWeZtoWOC+?Y7m:vB Vg<7ԝRS޵&{۱hyB{63xhb<Ph{#z|&{%>jFu=oy/[.b=QzQc?Q~Q#SWI핰vYFy[2yCN˧?f 3f{-0ۑ᯻< _D<;e_ym9E-fi>uf2g>f|r_3?iwW>7|/ah*~ǰ8q^*ǔU=z[ץoRo|#LWT9zUy #z"^G1,~|:)쏖5'"] O. X$H$hWzT뒙q#>["uR_uPx+~S>%_[b~Hbqo}}~\endstream endobj 209 0 obj << /Type /Page /Parent 3 0 R /Contents 210 0 R /Resources 4 0 R >> endobj 210 0 obj << /Length 4155 /Filter /FlateDecode >> stream xZˮqО~Le$ d`d6IGT"5]fwuժUEWWwj׬wkW3߽\;/_ ~J׿?~<u}9[k=zN^y۟nʵ}`sܩ{qsޣ B c{ |I`w'lwN{+͍λb%x˼`3f.\ՆY`vgwYgnX { b5ݍq\?;g܄(tW_wyߣonαqS8eay!3?{9? X tV8][|p&2=lx0}MvZ/ySwBLtXyaro1x| \nOo_T =%? <|O<Bx3h8⍴85 lxɉ;h|1_@87\|5WKy$ƨ>cW~%eb[l+i7fH>dw:ij nv!vt*"n革toc=8i~Ly /dK!8o??d {e ܤy!s?ݲ2hCFx?2 n|2 8iibYg7̃yGD`kHaxLC=CI%BG,Bu(6s塜QՀ㡺A[2khr8X(;<9 ϗ|ZE8PimY|q~BBzqo/f |MW>f⑳/^?~LmՌ>s4y,wg KU{-q={_D%_.x`ұ:UjDKM&ÀJQ݈qcLcvt>j!"Λljv.XV3wZZX6FR;"6tv)u[Mɜӏ`=.O5{>9)rjulQNYlYNxgwjq *ap$7>Ae EPޡ^%;Q(X]9ؕJnfPW:Cpmuh8qh^ $F)sy8$;K}Kz(Kϣ5as8nڟ'BU(b\bYo.aW}6y5KlT\Q)[LlG-Sib/*_:$dɟV7HvuEcKVSx bٯQƇ&,@]MWƋy&Yj) Bmʃ^ƕݔU0|ˊoK-%r)|Pxy(PM"~:UjU|*GW._MjRrk_ Lo&+7m]}]r\LbU?uxX__|p[9_Z>٧5-G,Rۃv >}I>{%Ҧ> c6ڃ"7ӌ~|QQ'c %?Q+_*}p>$^|YO0)"w>ݠh/?0dTQNgO4IQ;;9=Бf.J' ԡѨ <5#QTNեĊ:-/ZK]:h]!|8oCb_@9DyÆiˌ[r%-`%uo =4[Ƨ܅U-+0jvB+Ixs+zLބ%zNʏf~ȞCI^ip~eXn|6gwi|0˕VVȷSΛr?a|:w=OwߠJky#ڑ_!gU'w9@_E<~xۯr]ez>kKNs7ܦOAKTEK=|Ҍ|ӠK}|rg-x6ߵ/-|r >꼃o.07T1v]9~=ݦw>w vD;i]N9_ϴӾ|%a|^W[گ>1v5/y^.ǜz zX =wWt9q?Bd^:{NߣV|tؚ|A=r|BZl =cЋ|#zr>^\;ztEo᎞ӣл3ګGuy^~ ]JϏGG;U |uy~aP71r2#d7ﲡM;x"*Iod3䯁X/G!ȹ dhB}c]f\nj+_te}^GO^o?_~y}7>sendstream endobj 211 0 obj << /Type /Page /Parent 3 0 R /Contents 212 0 R /Resources 4 0 R >> endobj 212 0 obj << /Length 4155 /Filter /FlateDecode >> stream xZˮqО~Le$ d`d6IGT"5]fwuժUEWWwj׬wkW3߽\;/_ ~J׿?~<u}9[k=zN^y۟nʵ}`sܩ{qsޣ B c{ |I`w'lwN{+͍λb%x˼`3f.\ՆY`vgwYgnX { b5ݍq\?;g܄(tW_wyߣonαqS8eay!3?{9? X tV8][|p&2=lx0}MvZ/ySwBLtXyaro1x| \nOo_T =%? <|O<Bx3h8⍴85 lxɉ;h|1_@87\|5WKy$ƨ>cW~%eb[l+i7fH>dw:ij nv!vt*"n革toc=8i~Ly /dK!8o??d {e ܤy!s?ݲ2hCFx?2 n|2 8iibYg7̃yGD`kHaxLC=CI%BG,Bu(6s塜QՀ㡺A[2khr8X(;<9 ϗ|ZE8PimY|q~BBzqo/f |MW>f⑳/^?~LmՌ>s4y,wg KU{-q={_D%_.x`ұ:UjDKM&ÀJQ݈qcLcvt>j!"Λljv.XV3wZZX6FR;"6tv)u[Mɜӏ`=.O5{>9)rjulQNYlYNxgwjq *ap$7>Ae EPޡ^%;Q(X]9ؕJnfPW:Cpmuh8qh^ $F)sy8$;K}Kz(Kϣ5as8nڟ'BU(b\bYo.aW}6y5KlT\Q)[LlG-Sib/*_:$dɟV7HvuEcKVSx bٯQƇ&,@]MWƋy&Yj) Bmʃ^ƕݔU0|ˊoK-%r)|Pxy(PM"~:UjU|*GW._MjRrk_ Lo&+7m]}]r\LbU?uxX__|p[9_Z>٧5-G,Rۃv >}I>{%Ҧ> c6ڃ"7ӌ~|QQ'c %?Q+_*}p>$^|YO0)"w>ݠh/?0dTQNgO4IQ;;9=Бf.J' ԡѨ <5#QTNեĊ:-/ZK]:h]!|8oCb_@9DyÆiˌ[r%-`%uo =4[Ƨ܅U-+0jvB+Ixs+zLބ%zNʏf~ȞCI^ip~eXn|6gwi|0˕VVȷSΛr?a|:w=OwߠJky#ڑ_!gU'w9@_E<~xۯr]ez>kKNs7ܦOAKTEK=|Ҍ|ӠK}|rg-x6ߵ/-|r >꼃o.07T1v]9~=ݦw>w vD;i]N9_ϴӾ|%a|^W[گ>1v5/y^.ǜz zX =wWt9q?Bd^:{NߣV|tؚ|A=r|BZl =cЋ|#zr>^\;ztEo᎞ӣл3ګGuy^~ ]JϏGG;U |uy~aP71r2#d7ﲡM;x"*Iod3䯁X/G!ȹ dhB}c]f\nj+_te}^GO^o?_~y}7>sendstream endobj 213 0 obj << /Type /Page /Parent 3 0 R /Contents 214 0 R /Resources 4 0 R >> endobj 214 0 obj << /Length 4251 /Filter /FlateDecode >> stream xZMGbp`3WGR%2(r" ~18Rbzvvgwŕ^Sf[Zn,W[ z?tן~˟ro/%cso>uk%=.?v=+q9vP]1qN`:px ]ŀs޸ۗ~S?]_i^zt_^o~>'ݝN?]ag/='^ӊŗO0{+%_/g$W0N+s㴽_:6]-`{5jU\ Pwn=2aˬ/;cT.6as&D{ܭ̻'V~'Nw^8ɆǽmW{+q!VvE!8s< 'w ,&0H){1}N\3ݟoxx01wLgi\'92^/xh`3תs?6i6|3c]3z77{_x;N踞pLGFoTwoX v1Xxcb#~Wpl;0K$sMȈf{r9M>dsWbpز//m-om >5,7c&YbLͰ-[8qhBp+F\6i7Ş Ѱ&*Yn mZu)揋a@{xDJ<>Ëj~0.̻ (S):'.i a7~,"hh2+LK]xq=Ua` 8UCªOlZyiC ȶbafp5öXF@&o ;Û  }GºX y`[FMxD? Uc>ce?|鿱_㴇$Þ6Mɇ uOy8O[Hyw tmdfQf|? |+ح<}z<"^xx#xx53)G, >%E|\>1NU|;w>S|e,K{-{߁vBV>hX|j4Kr?(:_PIsÌ{{ti|f ٟ$\4T3Sz{&2ߞyϗPH>ӨaӬGyyidq3RyyJ.L~]2c~.#`62sHH5.c̬1=Zt>df=fQ2+ߺ 3$$ߋddsg .jՇxlSLLrk,2p:Tӡkd0V zv}m7<]Lʽv]ߧcwMA';l*~FX݂&ܩ1 Xh;_U 1֢RoZ0ƟgiÀ7_fڨH R3FiaToTD$qQQL ZUN$[Uq~L}dbW5_h/H. bd'Ov`]׹1->'U\YUE)㱌z<!er*z(rHɇ={Mϰ)=1+iFS7T:ay#-̒O,|5͎Ah;+ڈ7Po(|QDD3 vĻU #|`~;.GH+3z'߉&|wBQ||[h赃%>4u5EGxg2|.{>MMP>V>SVE|3((Uҏ|H3FiM̷]cXKXzFzmXQ/`HO{Gzސ}ՑqY􌝧w8wpH?ßBOёC#&fP&I {??AWu\/.BO#qt4&6_,^E:wgp= ; qt5åק =on Q0녙\{=Y/To%@GNׯ?ZV''ؑe" clZDV]=A[Bo9L{l_{m#l!qW/-Oa5`@/z٨rXN5ppk~jODV_jMόfF8L]WCDj b7*y+&:PaObo 4]p)!=QE_PJ7yC zK6Qt9i;[=3|kN&G` Ww}(~1Y'‘*E6WEb5=jQY|]# '*FoP133Q^=CH+CHn%xp ߚ\>fʕZvȏTT9†30%bɧtW\Nx^MO9(7A_O~1Vg㭚<7s$ȃxSF&yeihU{G]̫/uQ^TNl-w<&n/ ]Wl6 w>B#DǂjE/4ZTCVm&gWeZtoWOC+?Y7m:vB Vg<7ԝRS޵&{۱hyB{63xhb<Ph{#z|&{%>jFu=oy/[.b=QzQc?Q~Q#SWI핰vYFy[2yCN˧?f 3f{-0ۑ᯻< _D<;e_ym9E-fi>uf2g>f|r_3?iwW>7|/ah*~ǰ8q^*ǔU=z[ץoRo|#LWT9zUy #z"^G1,~|:)쏖5'"] O. X$H$hWzT뒙q#>["uR_uPx+~S>%_[b~Hbqo}}~\endstream endobj 215 0 obj << /Type /Page /Parent 3 0 R /Contents 216 0 R /Resources 4 0 R >> endobj 216 0 obj << /Length 4251 /Filter /FlateDecode >> stream xZMGbp`3WGR%2(r" ~18Rbzvvgwŕ^Sf[Zn,W[ z?tן~˟ro/%cso>uk%=.?v=+q9vP]1qN`:px ]ŀs޸ۗ~S?]_i^zt_^o~>'ݝN?]ag/='^ӊŗO0{+%_/g$W0N+s㴽_:6]-`{5jU\ Pwn=2aˬ/;cT.6as&D{ܭ̻'V~'Nw^8ɆǽmW{+q!VvE!8s< 'w ,&0H){1}N\3ݟoxx01wLgi\'92^/xh`3תs?6i6|3c]3z77{_x;N踞pLGFoTwoX v1Xxcb#~Wpl;0K$sMȈf{r9M>dsWbpز//m-om >5,7c&YbLͰ-[8qhBp+F\6i7Ş Ѱ&*Yn mZu)揋a@{xDJ<>Ëj~0.̻ (S):'.i a7~,"hh2+LK]xq=Ua` 8UCªOlZyiC ȶbafp5öXF@&o ;Û  }GºX y`[FMxD? Uc>ce?|鿱_㴇$Þ6Mɇ uOy8O[Hyw tmdfQf|? |+ح<}z<"^xx#xx53)G, >%E|\>1NU|;w>S|e,K{-{߁vBV>hX|j4Kr?(:_PIsÌ{{ti|f ٟ$\4T3Sz{&2ߞyϗPH>ӨaӬGyyidq3RyyJ.L~]2c~.#`62sHH5.c̬1=Zt>df=fQ2+ߺ 3$$ߋddsg .jՇxlSLLrk,2p:Tӡkd0V zv}m7<]Lʽv]ߧcwMA';l*~FX݂&ܩ1 Xh;_U 1֢RoZ0ƟgiÀ7_fڨH R3FiaToTD$qQQL ZUN$[Uq~L}dbW5_h/H. bd'Ov`]׹1->'U\YUE)㱌z<!er*z(rHɇ={Mϰ)=1+iFS7T:ay#-̒O,|5͎Ah;+ڈ7Po(|QDD3 vĻU #|`~;.GH+3z'߉&|wBQ||[h赃%>4u5EGxg2|.{>MMP>V>SVE|3((Uҏ|H3FiM̷]cXKXzFzmXQ/`HO{Gzސ}ՑqY􌝧w8wpH?ßBOёC#&fP&I {??AWu\/.BO#qt4&6_,^E:wgp= ; qt5åק =on Q0녙\{=Y/To%@GNׯ?ZV''ؑe" clZDV]=A[Bo9L{l_{m#l!qW/-Oa5`@/z٨rXN5ppk~jODV_jMόfF8L]WCDj b7*y+&:PaObo 4]p)!=QE_PJ7yC zK6Qt9i;[=3|kN&G` Ww}(~1Y'‘*E6WEb5=jQY|]# '*FoP133Q^=CH+CHn%xp ߚ\>fʕZvȏTT9†30%bɧtW\Nx^MO9(7A_O~1Vg㭚<7s$ȃxSF&yeihU{G]̫/uQ^TNl-w<&n/ ]Wl6 w>B#DǂjE/4ZTCVm&gWeZtoWOC+?Y7m:vB Vg<7ԝRS޵&{۱hyB{63xhb<Ph{#z|&{%>jFu=oy/[.b=QzQc?Q~Q#SWI핰vYFy[2yCN˧?f 3f{-0ۑ᯻< _D<;e_ym9E-fi>uf2g>f|r_3?iwW>7|/ah*~ǰ8q^*ǔU=z[ץoRo|#LWT9zUy #z"^G1,~|:)쏖5'"] O. X$H$hWzT뒙q#>["uR_uPx+~S>%_[b~Hbqo}}~\endstream endobj 217 0 obj << /Type /Page /Parent 3 0 R /Contents 218 0 R /Resources 4 0 R >> endobj 218 0 obj << /Length 4155 /Filter /FlateDecode >> stream xZˮ%q߯襵i d2D}# iˉUYٝ\?]}ߩ]ޭ]-{|r߮8??}ut߯/u+]o?2\|_< \?v/ڄ7G,u=o-]`;z/`{T\]:`=}t1 LIT~|岹1yW\ֽo"ԃvrrw,weܓ0L|w4wpݣ{o!\&p1΁g~,뮘?{963Nr , [b<<۽`Rz|xFYc[MXaZx0C$0,0|2e.\(fa٫||}ݽCxUa,|ݚBwi<0F¼pMxy~LŴô)+0DimƧy{#in[%ra.\IR#/LnB5=yc<փ^ <@*A{{'䇽zGN缀|'|y#7O 78 _A:ϣ~Gу"^H#Oc GV#;^͜39x@; А;f#˃ ~ >4oxIJlS,|m5"_ i?xCN4قxw25NNE-3w"84H\#Mb}GQ`7,E|igG:#ͯ2 8!y!3pò2L?tt=/d[X#^ȨYGfoC'2 ^,,yp32px  7lox}P@ghT8DR(XE[Pt`<8ۺPy_ϟvĊ2/VK:CR-OZ luZ aWG^߮>d5E~ *e|(j tUaoߚ .4 F<%l\M_e ÷Ԣ\"7*x0P մ,ZV7|$|XUῩd&-$?nο6jſU-m.eX$VSGqXq~ǎxЮU~8 X*R~cz;8ñ׌<$ެ&< {y5zsE7(=aE R:j®?j+䗺ǟƎ^xXQ͞xE<u iI?x^ B;hv1>r>}ͮm >b|[OuLwOރ/6Pl| e>齾fm?狊">w>!ox,^||V4|G!zzOi[T|N|Oݒ.r^zUw DuS7h/ ݘ+{;~3zmd=DxtC^tzk=z %i[- MЋ+*'ٍxt34m~zկֳ.zw O OwzzFxGo[[^}y֫Q`^ 3ޏzղ_ZB rrϗGbKp9(x$/`*NdTtI6Css{t2O{O-϶gҸKDx5˿L?KE7ݗVSN.qv.]H=Ln&9 ^r2BXǎgp ˆD?pWb7_t[.ǏO%bVX5Z ±b.j(4ݛN7iSnP9}"qZNoKPeqE?*T]JxEԥ?yZwχF:$e K7lvą8?*Z~[[n[pc Oca|]Xo˪^۲h'"D< W<*/MXhlg7ߨ=Ԛ8H:GZ]oeƷhS|&{|1\ُoE퇈*\s]D<7~m4\N_ԃ/'-(_7 7Ѭ.W-|g]2/B͗-S;qCjim~Q{ bOt} V=?L;Q·ܯ_;_ Χ~u#Ӿn';_= ;z\ <>/ޞw߰>|~_oN0WWQOc*~)3rϖs>.o/t/N`;C%rq߈{HVM-q={X7?~է痠?e_c鿮C돱݀o~קo?~wBmendstream endobj 219 0 obj << /Type /Page /Parent 3 0 R /Contents 220 0 R /Resources 4 0 R >> endobj 220 0 obj << /Length 4155 /Filter /FlateDecode >> stream xZˮ%q߯襵i d2D}# iˉUYٝ\?]}ߩ]ޭ]-{|r߮8??}ut߯/u+]o?2\|_< \?v/ڄ7G,u=o-]`;z/`{T\]:`=}t1 LIT~|岹1yW\ֽo"ԃvrrw,weܓ0L|w4wpݣ{o!\&p1΁g~,뮘?{963Nr , [b<<۽`Rz|xFYc[MXaZx0C$0,0|2e.\(fa٫||}ݽCxUa,|ݚBwi<0F¼pMxy~LŴô)+0DimƧy{#in[%ra.\IR#/LnB5=yc<փ^ <@*A{{'䇽zGN缀|'|y#7O 78 _A:ϣ~Gу"^H#Oc GV#;^͜39x@; А;f#˃ ~ >4oxIJlS,|m5"_ i?xCN4قxw25NNE-3w"84H\#Mb}GQ`7,E|igG:#ͯ2 8!y!3pò2L?tt=/d[X#^ȨYGfoC'2 ^,,yp32px  7lox}P@ghT8DR(XE[Pt`<8ۺPy_ϟvĊ2/VK:CR-OZ luZ aWG^߮>d5E~ *e|(j tUaoߚ .4 F<%l\M_e ÷Ԣ\"7*x0P մ,ZV7|$|XUῩd&-$?nο6jſU-m.eX$VSGqXq~ǎxЮU~8 X*R~cz;8ñ׌<$ެ&< {y5zsE7(=aE R:j®?j+䗺ǟƎ^xXQ͞xE<u iI?x^ B;hv1>r>}ͮm >b|[OuLwOރ/6Pl| e>齾fm?狊">w>!ox,^||V4|G!zzOi[T|N|Oݒ.r^zUw DuS7h/ ݘ+{;~3zmd=DxtC^tzk=z %i[- MЋ+*'ٍxt34m~zկֳ.zw O OwzzFxGo[[^}y֫Q`^ 3ޏzղ_ZB rrϗGbKp9(x$/`*NdTtI6Css{t2O{O-϶gҸKDx5˿L?KE7ݗVSN.qv.]H=Ln&9 ^r2BXǎgp ˆD?pWb7_t[.ǏO%bVX5Z ±b.j(4ݛN7iSnP9}"qZNoKPeqE?*T]JxEԥ?yZwχF:$e K7lvą8?*Z~[[n[pc Oca|]Xo˪^۲h'"D< W<*/MXhlg7ߨ=Ԛ8H:GZ]oeƷhS|&{|1\ُoE퇈*\s]D<7~m4\N_ԃ/'-(_7 7Ѭ.W-|g]2/B͗-S;qCjim~Q{ bOt} V=?L;Q·ܯ_;_ Χ~u#Ӿn';_= ;z\ <>/ޞw߰>|~_oN0WWQOc*~)3rϖs>.o/t/N`;C%rq߈{HVM-q={X7?~է痠?e_c鿮C돱݀o~קo?~wBmendstream endobj 221 0 obj << /Type /Page /Parent 3 0 R /Contents 222 0 R /Resources 4 0 R >> endobj 222 0 obj << /Length 4155 /Filter /FlateDecode >> stream xZˮ%q߯襵i d2D}# iˉUYٝ\?]}ߩ]ޭ]-{|r߮8??}ut߯/u+]o?2\|_< \?v/ڄ7G,u=o-]`;z/`{T\]:`=}t1 LIT~|岹1yW\ֽo"ԃvrrw,weܓ0L|w4wpݣ{o!\&p1΁g~,뮘?{963Nr , [b<<۽`Rz|xFYc[MXaZx0C$0,0|2e.\(fa٫||}ݽCxUa,|ݚBwi<0F¼pMxy~LŴô)+0DimƧy{#in[%ra.\IR#/LnB5=yc<փ^ <@*A{{'䇽zGN缀|'|y#7O 78 _A:ϣ~Gу"^H#Oc GV#;^͜39x@; А;f#˃ ~ >4oxIJlS,|m5"_ i?xCN4قxw25NNE-3w"84H\#Mb}GQ`7,E|igG:#ͯ2 8!y!3pò2L?tt=/d[X#^ȨYGfoC'2 ^,,yp32px  7lox}P@ghT8DR(XE[Pt`<8ۺPy_ϟvĊ2/VK:CR-OZ luZ aWG^߮>d5E~ *e|(j tUaoߚ .4 F<%l\M_e ÷Ԣ\"7*x0P մ,ZV7|$|XUῩd&-$?nο6jſU-m.eX$VSGqXq~ǎxЮU~8 X*R~cz;8ñ׌<$ެ&< {y5zsE7(=aE R:j®?j+䗺ǟƎ^xXQ͞xE<u iI?x^ B;hv1>r>}ͮm >b|[OuLwOރ/6Pl| e>齾fm?狊">w>!ox,^||V4|G!zzOi[T|N|Oݒ.r^zUw DuS7h/ ݘ+{;~3zmd=DxtC^tzk=z %i[- MЋ+*'ٍxt34m~zկֳ.zw O OwzzFxGo[[^}y֫Q`^ 3ޏzղ_ZB rrϗGbKp9(x$/`*NdTtI6Css{t2O{O-϶gҸKDx5˿L?KE7ݗVSN.qv.]H=Ln&9 ^r2BXǎgp ˆD?pWb7_t[.ǏO%bVX5Z ±b.j(4ݛN7iSnP9}"qZNoKPeqE?*T]JxEԥ?yZwχF:$e K7lvą8?*Z~[[n[pc Oca|]Xo˪^۲h'"D< W<*/MXhlg7ߨ=Ԛ8H:GZ]oeƷhS|&{|1\ُoE퇈*\s]D<7~m4\N_ԃ/'-(_7 7Ѭ.W-|g]2/B͗-S;qCjim~Q{ bOt} V=?L;Q·ܯ_;_ Χ~u#Ӿn';_= ;z\ <>/ޞw߰>|~_oN0WWQOc*~)3rϖs>.o/t/N`;C%rq߈{HVM-q={X7?~է痠?e_c鿮C돱݀o~קo?~wBmendstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R 9 0 R 11 0 R 13 0 R 15 0 R 17 0 R 19 0 R 21 0 R 23 0 R 25 0 R 27 0 R 29 0 R 31 0 R 33 0 R 35 0 R 37 0 R 39 0 R 41 0 R 43 0 R 45 0 R 47 0 R 49 0 R 51 0 R 53 0 R 55 0 R 57 0 R 59 0 R 61 0 R 63 0 R 65 0 R 67 0 R 69 0 R 71 0 R 73 0 R 75 0 R 77 0 R 79 0 R 81 0 R 83 0 R 85 0 R 87 0 R 89 0 R 91 0 R 93 0 R 95 0 R 97 0 R 99 0 R 101 0 R 103 0 R 105 0 R 107 0 R 109 0 R 111 0 R 113 0 R 115 0 R 117 0 R 119 0 R 121 0 R 123 0 R 125 0 R 127 0 R 129 0 R 131 0 R 133 0 R 135 0 R 137 0 R 139 0 R 141 0 R 143 0 R 145 0 R 147 0 R 149 0 R 151 0 R 153 0 R 155 0 R 157 0 R 159 0 R 161 0 R 163 0 R 165 0 R 167 0 R 169 0 R 171 0 R 173 0 R 175 0 R 177 0 R 179 0 R 181 0 R 183 0 R 185 0 R 187 0 R 189 0 R 191 0 R 193 0 R 195 0 R 197 0 R 199 0 R 201 0 R 203 0 R 205 0 R 207 0 R 209 0 R 211 0 R 213 0 R 215 0 R 217 0 R 219 0 R 221 0 R ] /Count 108 /MediaBox [0 0 504 504] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 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 223 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus ] >> endobj 224 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 223 0 R >> endobj 225 0 obj << /Type /Font /Subtype /Type1 /Name /F3 /BaseFont /Helvetica-Bold /Encoding 223 0 R >> endobj xref 0 226 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000508864 00000 n 0000509758 00000 n 0000509883 00000 n 0000509916 00000 n 0000000212 00000 n 0000000292 00000 n 0000001162 00000 n 0000001243 00000 n 0000002189 00000 n 0000002271 00000 n 0000003217 00000 n 0000003299 00000 n 0000004249 00000 n 0000004331 00000 n 0000005398 00000 n 0000005480 00000 n 0000006449 00000 n 0000006531 00000 n 0000007497 00000 n 0000007579 00000 n 0000008532 00000 n 0000008614 00000 n 0000009602 00000 n 0000009684 00000 n 0000010654 00000 n 0000010736 00000 n 0000011607 00000 n 0000011689 00000 n 0000012635 00000 n 0000012717 00000 n 0000013612 00000 n 0000013694 00000 n 0000014666 00000 n 0000014748 00000 n 0000015629 00000 n 0000015711 00000 n 0000016669 00000 n 0000016751 00000 n 0000017714 00000 n 0000017796 00000 n 0000018779 00000 n 0000018861 00000 n 0000019693 00000 n 0000019775 00000 n 0000024205 00000 n 0000024287 00000 n 0000028660 00000 n 0000028742 00000 n 0000033227 00000 n 0000033309 00000 n 0000037781 00000 n 0000037863 00000 n 0000042368 00000 n 0000042450 00000 n 0000043579 00000 n 0000043661 00000 n 0000049296 00000 n 0000049378 00000 n 0000050507 00000 n 0000050589 00000 n 0000056224 00000 n 0000056306 00000 n 0000057349 00000 n 0000057431 00000 n 0000063066 00000 n 0000063148 00000 n 0000074886 00000 n 0000074968 00000 n 0000213688 00000 n 0000213770 00000 n 0000214641 00000 n 0000214723 00000 n 0000219190 00000 n 0000219272 00000 n 0000223740 00000 n 0000223822 00000 n 0000228294 00000 n 0000228376 00000 n 0000232969 00000 n 0000233051 00000 n 0000237538 00000 n 0000237620 00000 n 0000242113 00000 n 0000242195 00000 n 0000246668 00000 n 0000246750 00000 n 0000251259 00000 n 0000251341 00000 n 0000255739 00000 n 0000255821 00000 n 0000256692 00000 n 0000256774 00000 n 0000261242 00000 n 0000261324 00000 n 0000262219 00000 n 0000262301 00000 n 0000266795 00000 n 0000266878 00000 n 0000267760 00000 n 0000267844 00000 n 0000272319 00000 n 0000272403 00000 n 0000276881 00000 n 0000276965 00000 n 0000281464 00000 n 0000281548 00000 n 0000282420 00000 n 0000282504 00000 n 0000286362 00000 n 0000286446 00000 n 0000290132 00000 n 0000290216 00000 n 0000294512 00000 n 0000294596 00000 n 0000298282 00000 n 0000298366 00000 n 0000301869 00000 n 0000301953 00000 n 0000306163 00000 n 0000306247 00000 n 0000309873 00000 n 0000309957 00000 n 0000313389 00000 n 0000313473 00000 n 0000314345 00000 n 0000314429 00000 n 0000318898 00000 n 0000318982 00000 n 0000319878 00000 n 0000319962 00000 n 0000324457 00000 n 0000324541 00000 n 0000325423 00000 n 0000325507 00000 n 0000329982 00000 n 0000330066 00000 n 0000334544 00000 n 0000334628 00000 n 0000339127 00000 n 0000339211 00000 n 0000343599 00000 n 0000343683 00000 n 0000348142 00000 n 0000348226 00000 n 0000352659 00000 n 0000352743 00000 n 0000353615 00000 n 0000353699 00000 n 0000357557 00000 n 0000357641 00000 n 0000361327 00000 n 0000361411 00000 n 0000365804 00000 n 0000365888 00000 n 0000370396 00000 n 0000370480 00000 n 0000374969 00000 n 0000375053 00000 n 0000375886 00000 n 0000375970 00000 n 0000380401 00000 n 0000380485 00000 n 0000384874 00000 n 0000384958 00000 n 0000389427 00000 n 0000389511 00000 n 0000393980 00000 n 0000394064 00000 n 0000398533 00000 n 0000398617 00000 n 0000403006 00000 n 0000403090 00000 n 0000407479 00000 n 0000407563 00000 n 0000411952 00000 n 0000412036 00000 n 0000416425 00000 n 0000416509 00000 n 0000420898 00000 n 0000420982 00000 n 0000425371 00000 n 0000425455 00000 n 0000429766 00000 n 0000429850 00000 n 0000434146 00000 n 0000434230 00000 n 0000435035 00000 n 0000435119 00000 n 0000439280 00000 n 0000439364 00000 n 0000443689 00000 n 0000443773 00000 n 0000448002 00000 n 0000448086 00000 n 0000452315 00000 n 0000452399 00000 n 0000456628 00000 n 0000456712 00000 n 0000460941 00000 n 0000461025 00000 n 0000465254 00000 n 0000465338 00000 n 0000469663 00000 n 0000469747 00000 n 0000474072 00000 n 0000474156 00000 n 0000478481 00000 n 0000478565 00000 n 0000482794 00000 n 0000482878 00000 n 0000487107 00000 n 0000487191 00000 n 0000491516 00000 n 0000491600 00000 n 0000495925 00000 n 0000496009 00000 n 0000500238 00000 n 0000500322 00000 n 0000504551 00000 n 0000504635 00000 n 0000512611 00000 n 0000512707 00000 n 0000512807 00000 n trailer << /Size 226 /Info 1 0 R /Root 2 0 R >> startxref 512912 %%EOF vioplot/tests/testthat/test_histoplot_formula.R0000644000176200001440000000240514640410551021705 0ustar liggesuserslibrary("vioplot") context("formula input") test_that("plot data list input", { data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") }) test_that("plot vector formula input", { boxplot(iris$Sepal.Length~iris$Species) histoplot(iris$Sepal.Length~iris$Species) }) test_that("plot column formula with dataframe input", { boxplot(Sepal.Length~Species, data=iris) histoplot(Sepal.Length~Species, data=iris) }) test_that("plot formula with dataframe input and scalar colour", { histoplot(Sepal.Length~Species, data=iris, col="lightblue") }) test_that("plot formula with dataframe input and vector colour", { histoplot(Sepal.Length~Species, data=iris, col=c("lightgreen", "lightblue", "palevioletred")) }) # attach(iris) # iris <- as.matrix(iris[,1:4]) # test_that("plot column formula with matrix input", { # histoplot(Sepal.Length~Species, data=iris) # }) vioplot/tests/testthat/test_violin_customisation.R0000644000176200001440000000656014640410551022422 0ustar liggesuserslibrary("vioplot") context("color custom and vectorised") test_that("plot with defaults and scalar colours", { data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="magenta") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue") }) #Vectorisation test_that("plot with vector colours", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) }) ## Plot colours: Violin Lines and Boxplot test_that("plot with scalar border", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue") }) test_that("plot with scalar boxplot modifications", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", rectCol="palevioletred", lineCol="violetred") }) test_that("plot with scalar median colour", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", colMed="violet") }) ### Combined customisation test_that("plot with combined scalar customisation", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue", rectCol="palevioletred", lineCol="violetred", colMed="violet") }) ### Vectorisation test_that("plot with combined vector customisation", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T, col=c("lightgreen", "lightblue", "palevioletred"), border=c("darkolivegreen4", "royalblue4", "violetred4"), rectCol=c("forestgreen", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), colMed=c("green", "cyan", "magenta"), pchMed=c(15, 17, 19)) }) vioplot/tests/testthat/test_violin_na_handle.R0000644000176200001440000000241614640410551021426 0ustar liggesuserslibrary("vioplot") context("NA handling for vector or formula input") test_that("plot data list input", { data(iris) iris[2,3]<-NA boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") }) test_that("plot vector formula input", { boxplot(iris$Sepal.Length~iris$Species) vioplot(iris$Sepal.Length~iris$Species) }) test_that("plot column formula with dataframe input", { boxplot(Sepal.Length~Species, data=iris) vioplot(Sepal.Length~Species, data=iris) }) test_that("plot formula with dataframe input and scalar colour", { vioplot(Sepal.Length~Species, data=iris, col="lightblue") }) test_that("plot formula with dataframe input and vector colour", { vioplot(Sepal.Length~Species, data=iris, col=c("lightgreen", "lightblue", "palevioletred")) }) # iris <- as.matrix(iris) # test_that("plot column formula with matrix input", { # vioplot(Sepal.Length~Species, data=iris) # }) vioplot/tests/testthat/test_violin_side.R0000644000176200001440000000147314640410551020443 0ustar liggesuserslibrary("vioplot") context("side option") test_that("plot with left and right side options", { data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="magenta", side ="left") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="magenta", side ="right") }) vioplot/tests/testthat/test_histoplot_customisation.R0000644000176200001440000000660214640410551023144 0ustar liggesuserslibrary("vioplot") context("color custom and vectorised") test_that("plot with defaults and scalar colours", { data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="magenta") histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue") }) #Vectorisation test_that("plot with vector colours", { histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) }) ## Plot colours: Violin Lines and Boxplot test_that("plot with scalar border", { histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue") }) test_that("plot with scalar boxplot modifications", { histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", rectCol="palevioletred", lineCol="violetred") }) test_that("plot with scalar median colour", { histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", colMed="violet") }) ### Combined customisation test_that("plot with combined scalar customisation", { histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue", rectCol="palevioletred", lineCol="violetred", colMed="violet") }) ### Vectorisation test_that("plot with combined vector customisation", { histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T, col=c("lightgreen", "lightblue", "palevioletred"), border=c("darkolivegreen4", "royalblue4", "violetred4"), rectCol=c("forestgreen", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), colMed=c("green", "cyan", "magenta"), pchMed=c(15, 17, 19)) }) vioplot/tests/testthat/test_violin_area.R0000644000176200001440000000413414640410551020424 0ustar liggesuserslibrary("vioplot") context("controlling area") test_that("plot defaults", { data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) }) ##Violin Plot Area test_that("equal area with areaEqual TRUE", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", areaEqual = TRUE) }) test_that("equal width with areaEqual FALSE", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Width)", areaEqual = FALSE) }) test_that("equal area with areaEqual with vector colours", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = TRUE, col=c("lightgreen", "lightblue", "palevioletred"), rectCol=c("green", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), border=c("darkolivegreen4", "royalblue4", "violetred4")) }) test_that("equal area with areaEqual and wex scaling", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = TRUE, col=c("lightgreen", "lightblue", "palevioletred"), rectCol=c("green", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), border=c("darkolivegreen4", "royalblue4", "violetred4"), wex=1.25) }) vioplot/tests/testthat/test_ylog.R0000644000176200001440000002244514641333642017121 0ustar liggesuserslibrary("vioplot") context("log-scale") test_that("plot defaults", { data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) }) ##y-axis log scale (ylog) test_that("log-scale y-axis with ylog TRUE", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", ylog = T) }) test_that("linear y-axis with ylog FALSE", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", ylog = F) }) ##y-axis log scale (log=TRUE) test_that("log-scale y-axis with log TRUE", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = T) }) test_that("linear y-axis with log FALSE", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = F) }) test_that("override with ylog TRUE", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = F, ylog=T) }) ##y-axis log scale (log="y") test_that("log-scale y-axis with log='y'", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = 'y') }) test_that("log-scale y-axis with log='xy'", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = 'xy') }) test_that("linear y-axis with log=''", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = '') }) test_that("linear y-axis with log='x'", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = 'x') }) test_that("override with ylog TRUE", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = 'x', ylog=T) }) ##y-axis removed test_that("linear scale y-axis with labels removed", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", ylog = F, yaxt="n") }) test_that("log-scale y-axis with labels removed", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", ylog = T, yaxt="n") }) library("vioplot") context("log-scale") test_that("horizontal: plot defaults", { data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], horizontal = TRUE, names=c("setosa", "versicolor", "virginica")) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], horizontal = TRUE, names=c("setosa", "versicolor", "virginica")) }) ##x-axis log scale (ylog) test_that("horizontal: log-scale x-axis with ylog TRUE", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], horizontal = TRUE, names=c("setosa", "versicolor", "virginica"), main="Sepal Length", ylog = T) }) test_that("horizontal: log-scale x-axis with xlog TRUE", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], horizontal = TRUE, names=c("setosa", "versicolor", "virginica"), main="Sepal Length", xlog = T) }) test_that("horizontal: linear x-axis with ylog FALSE", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], horizontal = TRUE, names=c("setosa", "versicolor", "virginica"), main="Sepal Length", ylog = F) }) test_that("horizontal: linear x-axis with xlog FALSE", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], horizontal = TRUE, names=c("setosa", "versicolor", "virginica"), main="Sepal Length", xlog = F) }) ##x-axis log scale (log=TRUE) test_that("horizontal: log-scale x-axis with log TRUE", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], horizontal = TRUE, names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = T) }) test_that("horizontal: linear x-axis with log FALSE", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], horizontal = TRUE, names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = F) }) test_that("horizontal: override with ylog TRUE", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], horizontal = TRUE, names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = F, ylog=T) }) ##x-axis log scale (log="y") test_that("horizontal: log-scale x-axis with log='y'", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], horizontal = TRUE, names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = 'y') }) test_that("horizontal: log-scale x-axis with log='xy'", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], horizontal = TRUE, names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = 'xy') }) test_that("horizontal: linear x-axis with log=''", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], horizontal = TRUE, names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = '') }) test_that("horizontal: linear x-axis with log='x'", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], horizontal = TRUE, names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = 'x') }) test_that("horizontal: override with ylog TRUE", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], horizontal = TRUE, names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = 'x', ylog=T) }) test_that("horizontal: override with xlog TRUE", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], horizontal = TRUE, names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = 'x', xlog=T) }) ##x-axis removed test_that("horizontal: linear scale x-axis with labels removed", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], horizontal = TRUE, names=c("setosa", "versicolor", "virginica"), main="Sepal Length", ylog = F, yaxt="n") }) test_that("horizontal: linear scale x-axis with labels removed", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], horizontal = TRUE, names=c("setosa", "versicolor", "virginica"), main="Sepal Length", xlog = F, yaxt="n") }) test_that("horizontal: log-scale x-axis with labels removed", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], horizontal = TRUE, names=c("setosa", "versicolor", "virginica"), main="Sepal Length", xlog = T, yaxt="n") }) vioplot/tests/testthat/test_violin_names.R0000644000176200001440000000070714640410551020621 0ustar liggesuserslibrary("vioplot") context("names input") test_that("list input", { data(iris) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("a", "b", "c")) }) test_that("naming formulae", { data(iris) vioplot(iris$Sepal.Length~iris$Species, names=c("a", "b", "c")) vioplot(Sepal.Length~Species, data=iris, names=c("a", "b", "c")) }) vioplot/tests/testthat/test_violin_median.R0000644000176200001440000000517614640410551020760 0ustar liggesuserslibrary("vioplot") context("side option") test_that("plot with left and right side options and median point", { data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="magenta", side ="left") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="magenta", side ="right") }) test_that("plot with both sides and median line", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="magenta", side ="both", plotCentre = "line") }) test_that("plot with left and right side options and median line", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="magenta", side ="left", plotCentre = "line") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="magenta", side ="right", plotCentre = "line") }) test_that("plot with areaEqual options and median line", { vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="magenta", side ="both", plotCentre = "line", areaEqual = T) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="magenta", side ="left", plotCentre = "line", areaEqual = T) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="magenta", side ="right", plotCentre = "line", areaEqual = T) }) vioplot/tests/testthat/test_violin_classes.R0000644000176200001440000000136614640410551021155 0ustar liggesuserslibrary("vioplot") context("different input classes") test_that("input as data.frame", { data(iris) boxplot(as.data.frame(iris)) vioplot(as.data.frame(iris)[sapply(as.list(iris), is.numeric)]) }) test_that("input as list", { data(iris) boxplot(as.list(iris)) vioplot(as.list(iris)[sapply(as.list(iris), is.numeric)]) }) test_that("input as matrix (by col)", { data(iris) boxplot(as.matrix(iris[sapply(as.list(iris), is.numeric)])) vioplot(as.matrix(iris[sapply(as.list(iris), is.numeric)])) }) test_that("input as matrix (by col)", { data(iris) boxplot(as.matrix(iris[sapply(as.list(iris), is.numeric)]), use.cols = FALSE) vioplot(as.matrix(iris[sapply(as.list(iris), is.numeric)]), use.cols = FALSE) }) vioplot/tests/testthat/test_violin_formula.R0000644000176200001440000000237114640410551021162 0ustar liggesuserslibrary("vioplot") context("formula input") test_that("plot data list input", { data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") }) test_that("plot vector formula input", { boxplot(iris$Sepal.Length~iris$Species) vioplot(iris$Sepal.Length~iris$Species) }) test_that("plot column formula with dataframe input", { boxplot(Sepal.Length~Species, data=iris) vioplot(Sepal.Length~Species, data=iris) }) test_that("plot formula with dataframe input and scalar colour", { vioplot(Sepal.Length~Species, data=iris, col="lightblue") }) test_that("plot formula with dataframe input and vector colour", { vioplot(Sepal.Length~Species, data=iris, col=c("lightgreen", "lightblue", "palevioletred")) }) # attach(iris) # iris <- as.matrix(iris[,1:4]) # test_that("plot column formula with matrix input", { # vioplot(Sepal.Length~Species, data=iris) # }) vioplot/tests/testthat.R0000644000176200001440000000007614640410551015076 0ustar liggesuserslibrary(testthat) library(vioplot) test_check("vioplot") vioplot/MD50000644000176200001440000000734614641730542012276 0ustar liggesusersa2ec75b9e37ba5b3fb74e405746d615f *DESCRIPTION 2471549f0298f300f65611ed5e1d5879 *LICENSE 89c254328d62918cdae58d18053b4ab6 *NAMESPACE d6e101b1097209d6f8ec0cfa70700036 *NEWS.md f739c4f0565d25a21baab15d7a8ba199 *R/annotation.R 3c4e1c0485e53440e2aae205f76dafef *R/histoplot.R 6ecec0d5f72a1572619ef54170def519 *R/vioplot.R a87094e4fc6f755eb0055c22702c505c *R/vioplot.stats.R fb6aa4907cba237d47936f18c106377a *build/vignette.rds 9a3bc88f43b1f7c55f05234682712deb *inst/CITATION 203b242b4a9521f975c30c735a0fca45 *inst/COPYRIGHT 6fc30b1a293514df3a94d52f3524f86d *inst/doc/histogram_customisation.R 132c4f5605216c379d058986b3c83cc9 *inst/doc/histogram_customisation.Rmd c7956111bf1ef46e66cc289a94dc0335 *inst/doc/histogram_customisation.html 0d90cfbbd31a24f47400749c4e41946d *inst/doc/histogram_formulae.R 1aec35d42235202d78415c33b52a713c *inst/doc/histogram_formulae.Rmd 80d7a7ff0b4f5e738710f6b2e863545b *inst/doc/histogram_formulae.html c3928970523fcc80a15ed0b7b9b4cf57 *inst/doc/overlaying_annotations.R dca7af5e497c95438c9f7d9419ef2369 *inst/doc/overlaying_annotations.Rmd 1cb27a1e093b4a81dd53a8e7daa77dba *inst/doc/overlaying_annotations.html 88181fd580e4c84721616db797c30100 *inst/doc/violin_area.R 17912fbe51bfcdb18a36b3e79e0531b3 *inst/doc/violin_area.Rmd c3cfe9e047cc3302a7dc5e25253cd306 *inst/doc/violin_area.html 3e30097eb81ee222a1a030720ba91011 *inst/doc/violin_customisation.R 416da1cfcb6db0b6084ddf04c75f6caa *inst/doc/violin_customisation.Rmd 3f6297c593355fa53ac55f8e20008137 *inst/doc/violin_customisation.html 07bacf70777563d12bfdacf6602b9531 *inst/doc/violin_formulae.R 935d22fd4f1409f175cba80329254d86 *inst/doc/violin_formulae.Rmd 3062891e333b8b374cc89395b6c44f3f *inst/doc/violin_formulae.html 8398bec5d6416165f7ee8fc3056dd192 *inst/doc/violin_split.R 27ad80e41787077f32df86af32a9bb24 *inst/doc/violin_split.Rmd fe9e8efe8fc824d28b6de55e5005a89b *inst/doc/violin_split.html ff9053272aedef8ef075aae300cc01ad *inst/doc/violin_ylog.R 0ee4bbcdebc44aee60d70fb925a3293b *inst/doc/violin_ylog.Rmd ed9944f1c99720bff941399a4cfa29c5 *inst/doc/violin_ylog.html 2f38474784cfe589b90e96b674bbb0c8 *man/add_labels.Rd b4a13c1bc176c7b30c6c3ea0b6291b5e *man/add_outliers.Rd 057f1b8a483ad06978f9047388c80cf3 *man/histoplot.Rd da5667a7f6b86e53c17706b65302d4c2 *man/violin.stats.Rd 0868327342d8e4b2b0b8c8095c119f2f *man/vioplot.Rd 1d53bb440414366b40f2a93f6c0cc28f *tests/testthat.R 38ba3322dbf360079b6afbb994406b29 *tests/testthat/Rplots.pdf 4cc744f62ba0fbe9b70b2ebb8d0fc495 *tests/testthat/test_histoplot_customisation.R 0d5f8e5618b9bfb18572577e1e688ab0 *tests/testthat/test_histoplot_formula.R 90794388c1fb998a4edad962386fa580 *tests/testthat/test_violin_area.R 804ecde3338af38198bb2c036728d8b8 *tests/testthat/test_violin_classes.R 339cca29244a70d55cb23c7ce3b73ed9 *tests/testthat/test_violin_customisation.R 1b741d0a36fdf00d5f2709f9f64f8742 *tests/testthat/test_violin_formula.R 0f5042c611ecc9ec99fa1b1bcbed8104 *tests/testthat/test_violin_median.R df0ad94eec67f0b02c31a2a39a69df75 *tests/testthat/test_violin_na_handle.R 89aa2e97bf993475884967c08c98726f *tests/testthat/test_violin_names.R 199e695421ac78914d2e15e8997b1a7c *tests/testthat/test_violin_side.R d916488ea99f8282545c3915ba64b51b *tests/testthat/test_violin_unequal_groups.R bde7518bac9b63b429ce491aaecfe085 *tests/testthat/test_ylog.R 132c4f5605216c379d058986b3c83cc9 *vignettes/histogram_customisation.Rmd 1aec35d42235202d78415c33b52a713c *vignettes/histogram_formulae.Rmd dca7af5e497c95438c9f7d9419ef2369 *vignettes/overlaying_annotations.Rmd 17912fbe51bfcdb18a36b3e79e0531b3 *vignettes/violin_area.Rmd 416da1cfcb6db0b6084ddf04c75f6caa *vignettes/violin_customisation.Rmd 935d22fd4f1409f175cba80329254d86 *vignettes/violin_formulae.Rmd 27ad80e41787077f32df86af32a9bb24 *vignettes/violin_split.Rmd 0ee4bbcdebc44aee60d70fb925a3293b *vignettes/violin_ylog.Rmd vioplot/R/0000755000176200001440000000000014640663741012162 5ustar liggesusersvioplot/R/vioplot.R0000644000176200001440000011447614641612724014012 0ustar liggesusers#' Violin Plot #' #' Produce violin plot(s) of the given (grouped) values with enhanced annotation and colour per group. Includes customisation of colours for each aspect of the violin, boxplot, and separate violins. This supports input of data as a list or formula, being backwards compatible with \code{\link[vioplot]{vioplot}} (0.2) and taking input in a formula as used for \code{\link[graphics]{boxplot}}. #' #' @name vioplot #' @aliases violinplot #' @param x for specifying data from which the boxplots are to be produced. Either a numeric vector, or a single list containing such vectors. Additional unnamed arguments specify further data as separate vectors (each corresponding to a component boxplot). NAs are allowed in the data. #' @param ... additional data vectors or formula parameters. For the formula method, named arguments to be passed to the default method. #' @param formula a formula, such as y ~ grp, where y is a numeric vector of data values to be split into groups according to the grouping variable grp (usually a factor). #' @param data a data.frame (or list) from which the variables in formula should be taken. #' @param use.cols logical indicating if columns (by default) or rows (use.cols = FALSE) should be plotted. #' @param subset an optional vector specifying a subset of observations to be used for plotting. #' @param drop,sep,lex.order defines groups to plot from formula, passed to \code{split.default}, see there. #' @param range a factor to calculate the upper/lower adjacent values #' @param h the height for the density estimator, if omit as explained in sm.density, h will be set to an optimum. A vector of length one, two or three, defining the smoothing parameter. A normal kernel function is used and h is its standard deviation. If this parameter is omitted, a normal optimal smoothing parameter is used. #' @param xlim,ylim numeric vectors of length 2, giving the x and y coordinates ranges. #' @param yaxt A character which specifies the y axis type. Specifying "n" suppresses plotting. #' @param ylog,xlog A logical value (see log in \code{\link[graphics]{plot.default}}). If ylog is TRUE, a logarithmic scale is in use (e.g., after plot(*, log = "y")). For horizontal = TRUE then, if xlog is TRUE, a logarithmic scale is in use (e.g., after plot(*, log = "x")). For a new device, it defaults to FALSE, i.e., linear scale. #' @param log Logarithmic scale if log = "y" or TRUE. Invokes ylog = TRUE. If horizontal is TRUE then invokes xlog = TRUE. #' @param logLab Increments for labelling y-axis on log-scale, defaults to numbers starting with 1, 2, 5, and 10. #' @param names one label, or a vector of labels for the data must match the number of data given #' @param col Graphical parameter for fill colour of the violin(s) polygon. NA for no fill colour. If col is a vector, it specifies the colour per violin, and colours are reused if necessary. #' @param border Graphical parameters for the colour of the violin border passed to lines. NA for no border. If border is a vector, it specifies the colour per violin, and colours are reused if necessary. #' @param lty,lwd Graphical parameters for the violin passed to lines and polygon #' @param rectCol Graphical parameters to control fill colour of the box. NA for no fill colour. If col is a vector, it specifies the colour per violin, and colours are reused if necessary. #' @param lineCol Graphical parameters to control colour of the box outline and whiskers. NA for no border. If lineCol is a vector, it specifies the colour per violin, and colours are reused if necessary. #' @param pchMed Graphical parameters to control shape of the median point. If pchMed is a vector, it specifies the shape per violin. #' @param colMed,colMed2 Graphical parameters to control colour of the median point. If colMed is a vector, it specifies the colour per violin. colMed specifies the fill colour in all cases unless pchMed is 21:25 in which case colMed is the border colour and colMed2 is the fill colour. #' @param drawRect logical. The box is drawn if TRUE. #' @param areaEqual logical. Density plots checked for equal area if TRUE. wex must be scalar, relative widths of violins depend on area. #' @param at position of each violin. Default to 1:n #' @param add logical. if FALSE (default) a new plot is created #' @param wex relative expansion of the violin. If wex is a vector, it specifies the area/width size per violin and sizes are reused if necessary. #' @param horizontal logical. To use horizontal or vertical violins. Note that log scale can only be used on the x-axis for horizontal violins, and on the y-axis otherwise. #' @param main,sub,xlab,ylab graphical parameters passed to plot. #' @param cex A numerical value giving the amount by which plotting text should be magnified relative to the default. #' @param cex.axis The magnification to be used for y axis annotation relative to the current setting of cex. #' @param cex.names The magnification to be used for x axis annotation relative to the current setting of cex. Takes the value of cex.axis if not given. #' @param cex.lab The magnification to be used for x and y labels relative to the current setting of cex. #' @param cex.main The magnification to be used for main titles relative to the current setting of cex. #' @param cex.sub The magnification to be used for sub-titles relative to the current setting of cex. #' @param na.action a function which indicates what should happen when the data contain NAs. The default is to ignore missing values in either the response or the group. #' @param na.rm logical value indicating whether NA values should be stripped before the computation proceeds. Defaults to TRUE. #' @param side defaults to "both". Assigning "left" or "right" enables one sided plotting of violins. May be applied as a scalar across all groups. #' @param plotCentre defaults to "points", plotting a central point at the median. If "line" is given a median line is plotted (subject to side) alternatively. #' @param srt.axis angle for axis labels, scalar applies to both axes or vector with 2 components. [x, y] defaults to c(0, 90) with angles counter-clockwise from vertical. #' @param axes,frame.plot,panel.first,panel.last,asp,line,outer,adj,ann,ask,bg,bty,cin,col.axis,col.lab,col.main,col.sub,cra,crt,csi,cxy,din,err,family,fg,fig,fin,font,font.axis,font.lab,font.main,font.sub,lab,las,lend,lheight,ljoin,lmitre,mai,mar,mex,mfcol,mfg,mfrow,mgp,mkh,new,oma,omd,omi,page,pch,pin,plt,ps,pty,smo,srt,tck,tcl,usr,xaxp,xaxs,xaxt,xpd,yaxp,yaxs,ylbias Arguments to be passed to methods, such as graphical parameters (see \code{\link[graphics]{par}})). #' @keywords plot graphics violin #' @import sm #' @importFrom zoo rollmean #' @importFrom stats median na.omit quantile #' @importFrom graphics Axis axis box lines par plot.new plot.window plot.xy points polygon rect title #' @importFrom grDevices boxplot.stats dev.flush dev.hold dev.interactive devAskNewPage xy.coords #' @export #' @examples #' #' # box- vs violin-plot #' par(mfrow=c(2,1)) #' mu<-2 #' si<-0.6 #' bimodal<-c(rnorm(1000,-mu,si),rnorm(1000,mu,si)) #' uniform<-runif(2000,-4,4) #' normal<-rnorm(2000,0,3) #' vioplot(bimodal,uniform,normal) #' boxplot(bimodal,uniform,normal) #' #' # add to an existing plot #' x <- rnorm(100) #' y <- rnorm(100) #' plot(x, y, xlim=c(-5,5), ylim=c(-5,5)) #' vioplot(x, col="tomato", horizontal=TRUE, at=-4, add=TRUE,lty=2, rectCol="gray") #' vioplot(y, col="cyan", horizontal=FALSE, at=-4, add=TRUE,lty=2) #' #' # formula input #' data("iris") #' vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", #' col=c("lightgreen", "lightblue", "palevioletred")) #' legend("topleft", legend=c("setosa", "versicolor", "virginica"), #' fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) #' #' data("diamonds", package = "ggplot2") #' palette <- RColorBrewer::brewer.pal(9, "Pastel1") #' par(mfrow=c(3, 1)) #' vioplot(price ~ cut, data = diamonds, las = 1, col = palette) #' vioplot(price ~ clarity, data = diamonds, las = 2, col = palette) #' vioplot(price ~ color, data = diamonds, las = 2, col = palette) #' par(mfrow=c(3, 1)) #' #' #generate example data #' data_one <- rnorm(100) #' data_two <- rnorm(50, 1, 2) #' #' #generate violin plot with similar functionality to vioplot #' vioplot(data_one, data_two, col="magenta") #' #' #note vioplox defaults to a greyscale plot #' vioplot(data_one, data_two) #' #' #colours can be customised separately, with axis labels, legends, and titles #' vioplot(data_one, data_two, col=c("red","blue"), names=c("data one", "data two"), #' main="data violin", xlab="data class", ylab="data read") #' legend("topleft", fill=c("red","blue"), legend=c("data one", "data two")) #' #' #colours can be customised for the violin fill and border separately #' vioplot(data_one, data_two, col="grey85", border="purple", names=c("data one", "data two"), #' main="data violin", xlab="data class", ylab="data read") #' #' #colours can also be customised for the boxplot rectange and lines (border and whiskers) #' vioplot(data_one, data_two, col="grey85", rectCol="lightblue", lineCol="blue", #' border="purple", names=c("data one", "data two"), #' main="data violin", xlab="data class", ylab="data read") #' #' #these colours can also be customised separately for each violin #' vioplot(data_one, data_two, col=c("skyblue", "plum"), rectCol=c("lightblue", "palevioletred"), #' lineCol="blue", border=c("royalblue", "purple"), names=c("data one", "data two"), #' main="data violin", xlab="data class", ylab="data read") #' #' #this applies to any number of violins, given that colours are provided for each #' vioplot(data_one, data_two, rnorm(200, 3, 0.5), rpois(200, 2.5), rbinom(100, 10, 0.4), #' col=c("red", "orange", "green", "blue", "violet"), #' rectCol=c("palevioletred", "peachpuff", "lightgreen", "lightblue", "plum"), #' lineCol=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"), #' border=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"), #' names=c("data one", "data two", "data three", "data four", "data five"), #' main="data violin", xlab="data class", ylab="data read") #' #' #The areaEqual parameter scales with width of violins #' #Violins will have equal density area (including missing tails) rather than equal maximum width #' vioplot(data_one, data_two, areaEqual=TRUE) #' #' vioplot(data_one, data_two, areaEqual=TRUE, #' col=c("skyblue", "plum"), rectCol=c("lightblue", "palevioletred"), #' lineCol="blue", border=c("royalblue", "purple"), names=c("data one", "data two"), #' main="data violin", xlab="data class", ylab="data read") #' #' vioplot(data_one, data_two, rnorm(200, 3, 0.5), rpois(200, 2.5), rbinom(100, 10, 0.4), #' areaEqual=TRUE, col=c("red", "orange", "green", "blue", "violet"), #' rectCol=c("palevioletred", "peachpuff", "lightgreen", "lightblue", "plum"), #' lineCol=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"), #' border=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"), #' names=c("data one", "data two", "data three", "data four", "data five"), #' main="data violin", xlab="data class", ylab="data read") #' @export #' @usage NULL vioplot <- function(x, ...) { UseMethod("vioplot") } #' Draw a Violin plot for each Column (Row) of a Matrix #' #' Interpreting the columns (or rows) of a matrix as different groups, draw a boxplot for each. #' #' @aliases violin.matrix violinplot.matrix #' @param x a numeric matrix. #' @param use.cols logical indicating if columns (by default) or rows (use.cols = FALSE) should be plotted. #' @param ... Further arguments to \code{\link[vioplot]{vioplot}}. #' @rdname vioplot #' @export vioplot.matrix <- function (x, use.cols = TRUE, ...) { groups <- if (use.cols) { split(c(x), rep.int(1L:ncol(x), rep.int(nrow(x), ncol(x)))) } else split(c(x), seq(nrow(x))) if (length(nam <- dimnames(x)[[1 + use.cols]])) names(groups) <- nam invisible(vioplot(groups, ...)) } #' @rdname vioplot #' @export vioplot.list <- function (x, ...){ ind <- sapply(x, is.numeric) if(all(!ind)){ stop(paste("elements are not numeric: ", names(x)[!sapply(x, is.numeric)])) } if(any(!ind)){ warning(paste("some elements are not numeric: ", names(x)[!sapply(x, is.numeric)])) x <- x[sapply(x, is.numeric)] } invisible(vioplot.default(x, ...)) } #' @rdname vioplot #' @export vioplot.data.frame <- vioplot.list #' @rdname vioplot #' @export vioplot.matrix <- vioplot.matrix #' @rdname vioplot #' @export vioplot.formula <- function (formula, data = NULL, ..., subset, na.action = NULL, add = FALSE, ann = !add, horizontal = FALSE, side = "both", cex.axis = par()$cex, srt.axis = c(0, 90), xlab = mklab(y_var = horizontal), ylab = mklab(y_var = !horizontal), main = "", sub = "", names=NULL, drop = FALSE, sep = ".", lex.order = FALSE) { if (missing(formula) || (length(formula) != 3L)){ stop("'formula' missing or incorrect") } if(add && side != "both"){ if(!is.null(names)) warning("Warning: names can only be changed on first call of vioplot (when add = FALSE) ") if(!missing(xlab)) warning("Warning: x-axis labels can only be changed on first call of vioplot (when add = FALSE) ") if(!missing(ylab)) warning("Warning: y-axis labels can only be changed on first call of vioplot (when add = FALSE) ") } if (missing(xlab) || missing(ylab)){ mklab <- function(y_var){ if(y_var){ names(mf)[response] } else { paste(names(mf)[-response], collapse = " : ") } } } m <- match.call(expand.dots = FALSE) if (is.matrix(eval(m$data, parent.frame()))) m$data <- as.data.frame(data) m$... <- m$drop <- m$sep <- m$lex.order <- NULL m$xlab <- m$ylab <- m$main <- m$sub <- NULL m$add <- m$ann <- m$horizontal <- NULL m$names <- m$side <- NULL m$srt.axis <- m$cex.axis <- NULL m$na.action <- na.action m[[1L]] <- quote(stats::model.frame.default) mf <- eval(m, parent.frame()) response <- attr(attr(mf, "terms"), "response") if(add){ xlab <- ylab <- NA } vioplot(split(mf[[response]], mf[-response], drop = drop, sep = sep, lex.order = lex.order), names = names, add = add, ann = ann, horizontal = horizontal, side = side, srt.axis = srt.axis, cex.axis = cex.axis, ...) title(main = main, sub = sub, xlab = xlab, ylab = ylab) } #' @rdname vioplot #' @export vioplot.default <- function (x, ..., data = NULL, range = 1.5, h = NULL, xlim = NULL, ylim = NULL, names = NULL, horizontal = FALSE, col = "grey50", border = par()$fg, lty = 1, lwd = 1, rectCol = par()$fg, lineCol = par()$fg, pchMed = 19, colMed = "white", colMed2 = "grey 75", at, add = FALSE, wex = 1, drawRect = TRUE, areaEqual=FALSE, axes = TRUE, frame.plot = axes, panel.first = NULL, panel.last = NULL, asp = NA, main="", sub="", xlab=NA, ylab=NA, line = 1, outer = FALSE, xlog = NA, ylog=NA, adj=NA, ann = NA, ask=NA, bg=NA, bty=NA, cex=NA, cex.axis=NA, cex.lab=NA, cex.main=NA, cex.names=NULL, cex.sub=NA, cin=NA, col.axis=NA, col.lab=NA, col.main=NA, col.sub=NA, cra=NA, crt=NA, csi=NA,cxy=NA, din=NA, err=NA, family=NA, fg=NA, fig=NA, fin=NA, font=NA, font.axis=NA, font.lab=NA, font.main=NA, font.sub=NA, lab=NA, las=NA, lend=NA, lheight=NA, ljoin=NA, lmitre=NA, mai=NA, mar=NA, mex=NA, mfcol=NA, mfg=NA, mfrow=NA, mgp=NA, mkh=NA, new=NA, oma=NA, omd=NA, omi=NA, page=NA, pch=NA, pin=NA, plt=NA, ps=NA, pty=NA, smo=NA, srt=NA, srt.axis = c(0, 90), tck=NA, tcl=NA, usr=NA, xaxp=NA, xaxs=NA, xaxt=NA, xpd=NA, yaxp=NA, yaxs=NA, yaxt=NA, ylbias=NA, log="", logLab=c(1,2,5), na.action = NULL, na.rm = T, side = "both", plotCentre = "point") { #assign graphical parameters if not given for(ii in 1:length(names(par()))){ if(is.na(get(names(par())[ii])[1])) assign(names(par()[ii]), unlist(par()[[ii]])) } #check axis parameters after setting srt parameter for kernel density if(length(srt.axis) == 1){ srt.axis <- rep(srt.axis, 2) } if(length(srt.axis) < 1){ srt.axis <- c(0, 90) } srt.axis.x <- srt.axis[1] srt.axis.y <- srt.axis[2] if(add && side != "both"){ if(!is.null(names)) warning("Warning: names can only be changed on first call of vioplot (when add = FALSE) ") if(!is.na(xlab)) warning("Warning: x-axis labels can only be changed on first call of vioplot (when add = FALSE) ") if(!is.na(ylab)) warning("vy-axis labels can only be changed on first call of vioplot (when add = FALSE) ") if(!missing(main)) warning("Warning: main title can only be changed on first call of vioplot (when add = FALSE) ") if(!missing(sub)) warning("Warning: subtitle can only be changed on first call of vioplot (when add = FALSE) ") } if(!is.list(x)){ datas <- list(x, ...) } else{ datas <- lapply(x, unlist) if(is.null(names)){ names <- names(datas) } } datas <- lapply(datas, function(x){ if((all(x == na.omit(unique(x))[1] | is.na(x))) & length(x) > 100){ na.omit(unique(x))[1] } else { x } }) if(is.character(log)) if("y" %in% unlist(strsplit(log, ""))) log <- TRUE if(is.na(xlog) | (horizontal == TRUE & (log == FALSE | log == ""))) xlog <- FALSE log <- ifelse(log == TRUE, "y", "") if(log == 'x' | log == 'xy' | xlog == TRUE){ if(horizontal | log == "xy"){ log <- TRUE } else { log <- FALSE ylog <- FALSE } xlog <- FALSE } if(log == TRUE | ylog == TRUE){ ylog <- TRUE log <- "y" } else { log <- "" } if(ylog){ #check data is compatible with log scale if(all(unlist(datas) <= 0)){ ylog <- FALSE warning("log scale cannot be used with non-positive data") } else { #log-scale data datas <- datas #lapply(datas, function(x) log(unlist(x))) } } if(is.null(na.action)) na.action <- na.omit lapply(datas, function(data) data <- data[!sapply(data, is.infinite)]) if(na.rm) datas <- lapply(datas, na.action) n <- length(datas) #if(is.list(datas)) datas <- as.data.frame(datas) if (missing(at)) at <- 1:n upper <- vector(mode = "numeric", length = n) lower <- vector(mode = "numeric", length = n) q1 <- vector(mode = "numeric", length = n) q2 <- vector(mode = "numeric", length = n) q3 <- vector(mode = "numeric", length = n) med <- vector(mode = "numeric", length = n) base <- vector(mode = "list", length = n) height <- vector(mode = "list", length = n) area_check <- vector(mode = "list", length = n) baserange <- c(Inf, -Inf) args <- list(display = "none") radj <- ifelse(side == "right", 0, 1) ladj <- ifelse(side == "left", 0, 1) boxwex <- wex if (!(is.null(h))) args <- c(args, h = h) if(plotCentre == "line") med.dens <- rep(NA, n) if(areaEqual){ for (i in 1:n) { data <- unlist(datas[[i]]) data.min <- min(data, na.rm = na.rm) data.max <- max(data, na.rm = na.rm) q1[i] <- quantile(data, 0.25) q2[i] <- quantile(data, 0.5) q3[i] <- quantile(data, 0.75) med[i] <- median(data) iqd <- q3[i] - q1[i] upper[i] <- min(q3[i] + range * iqd, data.max) lower[i] <- max(q1[i] - range * iqd, data.min) est.xlim <- c(min(lower[i], data.min), max(upper[i], data.max)) smout <- do.call("sm.density", c(list(data, xlim = est.xlim), args)) if(plotCentre == "line"){ med.dat <- do.call("sm.density", c(list(data, xlim=est.xlim, eval.points=med[i], display = "none"))) med.dens[i] <- med.dat$estimate } Avg.pos <- mean(smout$eval.points) xt <- diff(smout$eval.points[smout$eval.points1){ warning("wex may not be a vector if areaEqual is TRUE") print("using first element of wex") wex<-wex[i] } wex <-unlist(area_check)/max(unlist(area_check))*wex } for (i in 1:n) { data <- unlist(datas[[i]]) data.min <- min(data, na.rm = na.rm) data.max <- max(data, na.rm = na.rm) q1[i] <- quantile(data, 0.25) q2[i] <- quantile(data, 0.5) q3[i] <- quantile(data, 0.75) med[i] <- median(data) iqd <- q3[i] - q1[i] upper[i] <- min(q3[i] + range * iqd, data.max) lower[i] <- max(q1[i] - range * iqd, data.min) est.xlim <- c(min(lower[i], data.min), max(upper[i], data.max)) smout <- do.call("sm.density", c(list(data, xlim = est.xlim), args)) hscale <- 0.4/max(smout$estimate) * ifelse(length(wex)>1, wex[i], wex) base[[i]] <- smout$eval.points height[[i]] <- smout$estimate * hscale t <- range(base[[i]]) baserange[1] <- min(baserange[1], t[1]) baserange[2] <- max(baserange[2], t[2]) if(plotCentre == "line"){ med.dat <- do.call("sm.density", c(list(data, xlim=est.xlim, eval.points=med[i], display = "none"))) med.dens[i] <- med.dat$estimate *hscale } } if (!add) { if (is.null(xlim)) { xlim <- if (n == 1){ at + c(-0.5, 0.5) } else { range(at) + min(diff(at))/2 * c(-1, 1) } } else { xlim.default <- if (n == 1){ at + c(-0.5, 0.5) } else { range(at) + min(diff(at))/2 * c(-1, 1) } print(paste0("Using c(", xlim[1],",", xlim[2], ") as input for xlim, note that default values for these dimensions are c(", xlim.default[1],",", xlim.default[2], ")")) } if (is.null(ylim)) { ylim <- baserange } } if (is.null(names)) { label <- 1:n } else { label <- names } if(srt.axis.x == 0 && srt.axis.y == 90){ groups <- label } else { groups <- FALSE } boxwidth <- 0.05 * ifelse(length(boxwex)>1, boxwex[i], boxwex) if (!add){ plot.new() if(!horizontal){ plot.window(xlim, ylim, log = log, asp = asp, bty = bty, cex = cex, xaxs = xaxs, yaxs = yaxs, lab = lab, mai = mai, mar = mar, mex = mex, mfcol = mfcol, mfrow = mfrow, mfg = mfg, xlog = xlog, ylog = ylog) } else { plot.window(ylim, xlim, log = ifelse(log == "y", "x", ""), asp = asp, bty = bty, cex = cex, xaxs = xaxs, yaxs = yaxs, lab = lab, mai = mai, mar = mar, mex = mex, mfcol = mfcol, mfrow = mfrow, mfg = mfg, xlog = ylog, ylog = xlog) } } panel.first if (!horizontal) { if (!add) { plot.window(xlim, ylim, log = log, asp = asp, bty = bty, cex = cex, xaxs = xaxs, yaxs = yaxs, lab = lab, mai = mai, mar = mar, mex = mex, mfcol = mfcol, mfrow = mfrow, mfg = mfg, xlog = xlog, ylog = ylog) xaxp <- par()$xaxp yaxp <- par()$yaxp if(yaxt !="n"){ if(ylog){ #log_axis_label <- log_axis_label[log_axis >= exp(par("usr")[3])] #log_axis <- log_axis[log_axis >= exp(par("usr")[3])] #log_axis_label <- log_axis_label[log_axis <= exp(par("usr")[4])] #log_axis <- log_axis[log_axis <= exp(par("usr")[4])] if (groups[1] == FALSE){ yaxis <- Axis(unlist(datas), side = 2, labels = groups, srt = srt.axis.y, cex.axis = cex.axis, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) # xaxp = xaxp, yaxp = yaxp disabled for log text(x = par("usr")[1] * 0.8 , y = yaxis, labels = yaxis, srt = srt.axis.y, xpd = TRUE, adj = c(1.5,-1), cex.axis = cex.axis, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) } else { Axis(unlist(datas), side = 2, cex.axis = cex.axis, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) # xaxp = xaxp, yaxp = yaxp disabled for log } if(is.null(cex.names)) cex.names <- cex.axis if(xaxt !="n"){ if (groups[1] == FALSE){ xaxis <- Axis(1:length(datas), at = at, labels = FALSE, side = 1, srt = srt.axis.x, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) # xaxp = xaxp, yaxp = yaxp disabled for log text(x = xaxis , y = par("usr")[3] * 1.2, labels = label, srt = srt.axis.x, xpd = TRUE, adj = c(0.5,0.5), cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) # xaxp = xaxp, yaxp = yaxp disabled for log } else { Axis(1:length(datas), at = at, labels = groups, side = 1, srt = srt.axis.x, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) # xaxp = xaxp, yaxp = yaxp disabled for log } } } else { if (groups[1] == FALSE){ yaxis <- Axis(unlist(datas), side = 2, labels = groups, srt = srt.axis.y, cex.axis = cex.axis, col.axis = col.axis, font.axis = font.axis, mgp = mgp, yaxp = yaxp, tck = tck, tcl = tcl, las = las) text(x = par("usr")[1] * 0.8 , y = yaxis, labels = yaxis, srt = srt.axis.y, xpd = TRUE, adj = c(1.5,-1), cex.axis = cex.axis, col.axis = col.axis, font.axis = font.axis, mgp = mgp, yaxp = yaxp, tck = tck, tcl = tcl, las = las) } else { Axis(unlist(datas), side = 2, cex.axis = cex.axis, col.axis = col.axis, font.axis = font.axis, mgp = mgp, yaxp = yaxp, tck = tck, tcl = tcl, las = las) } if(is.null(cex.names)) cex.names <- cex.axis if(xaxt !="n"){ if (groups[1] == FALSE){ xaxis <- Axis(1:length(datas), at = at, labels = FALSE, side = 1, srt = srt.axis.x, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, xaxp = xaxp, tck = tck, tcl = tcl, las = las) text(x = xaxis , y = par("usr")[3] * 1.2, labels = label, srt = srt.axis.x, xpd = TRUE, adj = c(0.5,0.5), cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, xaxp = xaxp, tck = tck, tcl = tcl, las = las) } else { Axis(1:length(datas), at = at, labels = groups, side = 1, srt = srt.axis.x, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, xaxp = xaxp, tck = tck, tcl = tcl, las = las) } } } } else { if(ylog){ if(is.null(cex.names)) cex.names <- cex.axis if(xaxt !="n"){ if (groups[1] == FALSE){ xaxis <- Axis(1:length(datas), at = at, labels = FALSE, side = 1, srt = srt.axis.x, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) # xaxp = xaxp, yaxp = yaxp disabled for log text(x = xaxis , y = par("usr")[3] * 1.2, labels = label, srt = srt.axis.x, xpd = TRUE, adj = c(0.5,0.5), cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) # xaxp = xaxp, yaxp = yaxp disabled for log } else { Axis(1:length(datas), at = at, labels = groups, side = 1, srt = srt.axis.x, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) # xaxp = xaxp, yaxp = yaxp disabled for log } } } else { if(is.null(cex.names)) cex.names <- cex.axis if(xaxt !="n"){ if (groups[1] == FALSE){ xaxis <- Axis(1:length(datas), at = at, labels = FALSE, side = 1, srt = srt.axis.x, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, xaxp = xaxp, tck = tck, tcl = tcl, las = las) text(x = xaxis , y = par("usr")[3] * 1.2, labels = label, srt = srt.axis.x, xpd = TRUE, adj = c(0.5,0.5), cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, xaxp = xaxp, tck = tck, tcl = tcl, las = las) } else { Axis(1:length(datas), at = at, labels = groups, side = 1, srt = srt.axis.x, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, xaxp = xaxp, tck = tck, tcl = tcl, las = las) } } } } } if (frame.plot) { box(lty = lty, lwd = lwd) } for (i in 1:n) { polygon(c(at[i] - radj*height[[i]], rev(at[i] + ladj*height[[i]])), c(base[[i]], rev(base[[i]])), col = ifelse(length(col)>1,col[1+(i-1)%%length(col)], col), border = ifelse(length(border)>1, border[1+(i-1)%%length(border)], border), lty = lty, lwd = lwd, xpd = xpd, lend = lend, ljoin = ljoin, lmitre = lmitre) if (drawRect) { lines(at[c(i, i)], c(lower[i], upper[i]), lwd = lwd, lty = lty, col = ifelse(length(lineCol)>1, lineCol[1+(i-1)%%length(lineCol)], lineCol), lend = lend, ljoin = ljoin, lmitre = lmitre) rect(at[i] - radj*ifelse(length(boxwidth)>1, boxwidth[i], boxwidth)/2, q1[i], at[i] + ladj*ifelse(length(boxwidth)>1, boxwidth[i], boxwidth)/2, q3[i], col = ifelse(length(rectCol)>1, rectCol[1+(i-1)%%length(rectCol)], rectCol), border = ifelse(length(lineCol)>1, lineCol[1+(i-1)%%length(lineCol)], lineCol), xpd = xpd, lend = lend, ljoin = ljoin, lmitre = lmitre) if(plotCentre == "line"){ lines(x = c(at[i] - radj*med.dens[i], at[i], at[i] + ladj*med.dens[i]), y = rep(med[i],3)) } else { points(at[i], med[i], pch = ifelse(length(pchMed)>1, pchMed[1+(i-1)%%length(pchMed)], pchMed), col = ifelse(length(colMed)>1, colMed[1+(i-1)%%length(colMed)], colMed), bg = ifelse(length(colMed2)>1, colMed2[1+(i-1)%%length(colMed2)], colMed2), cex = cex, lwd = lwd, lty = lty) } } } } else { if(log == "y" || ylog == TRUE){ log <- "x" xlog <- TRUE ylog <- FALSE } if (!add) { plot.window(ylim, xlim, log = log, asp = asp, bty = bty, cex = cex, xaxs = xaxs, yaxs = yaxs, lab = lab, mai = mai, mar = mar, mex = mex, mfcol = mfcol, mfrow = mfrow, mfg = mfg, xlog = xlog, ylog = ylog) xaxp <- par()$xaxp yaxp <- par()$yaxp if(yaxt !="n"){ if(xlog){ #log_axis_label <- log_axis_label[log_axis >= exp(par("usr")[3])] #log_axis <- log_axis[log_axis >= exp(par("usr")[3])] #log_axis_label <- log_axis_label[log_axis <= exp(par("usr")[4])] #log_axis <- log_axis[log_axis <= exp(par("usr")[4])] if (groups[1] == FALSE){ xaxis <- Axis(1:length(datas), at = at, labels = FALSE, side = 1, srt = srt.axis.x, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) # xaxp = xaxp, yaxp = yaxp disabled for log text(x = xaxis , y = par("usr")[3] * 1.2, labels = label, srt = srt.axis.x, xpd = TRUE, adj = c(0.5,0.5), cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) # xaxp = xaxp, yaxp = yaxp disabled for log } else { Axis(1:length(datas), at = at, labels = groups, side = 1, srt = srt.axis.x, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) # xaxp = xaxp, yaxp = yaxp disabled for log } if(is.null(cex.names)) cex.names <- cex.axis if(xaxt !="n"){ if (groups[1] == FALSE){ yaxis <- Axis(unlist(datas), side = 2, labels = groups, srt = srt.axis.y, cex.axis = cex.axis, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) # xaxp = xaxp, yaxp = yaxp disabled for log text(x = par("usr")[1] * 0.8 , y = yaxis, labels = yaxis, srt = srt.axis.y, xpd = TRUE, adj = c(1.5,-1), cex.axis = cex.axis, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) } else { Axis(unlist(datas), side = 2, cex.axis = cex.axis, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) # xaxp = xaxp, yaxp = yaxp disabled for log } } } else { if (groups[1] == FALSE){ xaxis <- Axis(1:length(datas), at = at, labels = FALSE, side = 1, srt = srt.axis.x, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, xaxp = xaxp, tck = tck, tcl = tcl, las = las) text(x = xaxis , y = par("usr")[3] * 1.2, labels = label, srt = srt.axis.x, xpd = TRUE, adj = c(0.5,0.5), cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, xaxp = xaxp, tck = tck, tcl = tcl, las = las) } else { Axis(1:length(datas), at = at, labels = groups, side = 1, srt = srt.axis.x, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, xaxp = xaxp, tck = tck, tcl = tcl, las = las) } if(is.null(cex.names)) cex.names <- cex.axis if(xaxt !="n"){ if (groups[1] == FALSE){ xaxis <- Axis(1:length(datas), at = at, labels = FALSE, side = 1, srt = srt.axis.x, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, yaxp = yaxp, tck = tck, tcl = tcl, las = las) text(x = xaxis , y = par("usr")[3] * 1.2, labels = label, srt = srt.axis.x, xpd = TRUE, adj = c(0.5,0.5), cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, yaxp = yaxp, tck = tck, tcl = tcl, las = las) } else { Axis(1:length(datas), at = at, labels = groups, side = 1, srt = srt.axis.x, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, yaxp = yaxp, tck = tck, tcl = tcl, las = las) } } } } else { if(ylog){ if(is.null(cex.names)) cex.names <- cex.axis if(xaxt !="n"){ if (groups[1] == FALSE){ xaxis <- Axis(1:length(datas), at = at, labels = FALSE, side = 1, srt = srt.axis.x, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, xaxp = xaxp, tck = tck, tcl = tcl, las = las) text(x = xaxis , y = par("usr")[3] * 1.2, labels = label, srt = srt.axis.x, xpd = TRUE, adj = c(0.5,0.5), cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, xaxp = xaxp, tck = tck, tcl = tcl, las = las) } else { Axis(1:length(datas), at = at, labels = groups, side = 1, srt = srt.axis.x, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, xaxp = xaxp, tck = tck, tcl = tcl, las = las) } } } else { if(is.null(cex.names)) cex.names <- cex.axis if(xaxt !="n"){ if (groups[1] == FALSE){ xaxis <- Axis(1:length(datas), at = at, labels = FALSE, side = 1, srt = srt.axis.x, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, xaxp = xaxp, tck = tck, tcl = tcl, las = las) text(x = xaxis , y = par("usr")[3] * 1.2, labels = label, srt = srt.axis.x, xpd = TRUE, adj = c(0.5,0.5), cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, xaxp = xaxp, tck = tck, tcl = tcl, las = las) } else { Axis(1:length(datas), at = at, labels = groups, side = 1, srt = srt.axis.x, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, xaxp = xaxp, tck = tck, tcl = tcl, las = las) } } } } } if (frame.plot) { box(lty = lty, lwd = lwd) } for (i in 1:n) { polygon(c(base[[i]], rev(base[[i]])), c(at[i] - radj*height[[i]], rev(at[i] + ladj*height[[i]])), col = ifelse(length(col)>1,col[1+(i-1)%%length(col)], col), border = ifelse(length(border)>1, border[1+(i-1)%%length(border)], border), lty = lty, lwd = lwd, xpd = xpd, lend = lend, ljoin = ljoin, lmitre = lmitre) if (drawRect) { lines(c(lower[i], upper[i]), at[c(i, i)], lwd = lwd, lty = lty, col = ifelse(length(lineCol)>1, lineCol[1+(i-1)%%length(lineCol)], lineCol), lend = lend, ljoin = ljoin, lmitre = lmitre) rect(q1[i], at[i] - radj*ifelse(length(boxwidth)>1, boxwidth[i], boxwidth)/2, q3[i], at[i] + ladj*ifelse(length(boxwidth)>1, boxwidth[i], boxwidth)/2, col = ifelse(length(rectCol)>1, rectCol[1+(i-1)%%length(rectCol)], rectCol), border = ifelse(length(lineCol)>1, lineCol[1+(i-1)%%length(lineCol)], lineCol), xpd = xpd, lend = lend, ljoin = ljoin, lmitre = lmitre) if(plotCentre == "line"){ lines(y = c(at[i] - radj*med.dens[i], at[i], at[i] + ladj*med.dens[i]), x = rep(med[i],3)) } else { points(med[i], at[i], pch = ifelse(length(pchMed)>1, pchMed[1+(i-1)%%length(pchMed)], pchMed), col = ifelse(length(colMed)>1, colMed[1+(i-1)%%length(colMed)], colMed), , bg = ifelse(length(colMed2)>1, colMed2[1+(i-1)%%length(colMed2)], colMed2), cex = cex, lwd = lwd, lty = lty) } } } } panel.last if (ann) { title(main = main, sub = sub, xlab = xlab, ylab = ylab, line = line, outer = outer, xpd = xpd, cex.main = cex.main, col.main = col.main, font.main = font.main) } invisible(list(upper = upper, lower = lower, median = med, q1 = q1, q3 = q3)) } vioplot/R/annotation.R0000644000176200001440000001206214641626552014460 0ustar liggesusers#' Annotated Violin Plot #' #' @name add_labels #' @description #' Annotate violin plots with custom labels #' @aliases add_labels #' @param variable continuous variable to to plot on y-axis (numeric or integer) #' @param categories discrete variable to break down groups (factor or string). #' @param cex size of text. #' @param col colour of text #' @param height adjust placement of text. #' @keywords plot graphics violin annotation. #' @examples #' #' # box- vs violin-plot #' par(mfrow=c(2,1)) #' mu<-2 #' si<-0.6 #' bimodal<-c(rnorm(1000,-mu,si),rnorm(1000,mu,si)) #' uniform<-runif(2000,-4,4) #' normal<-rnorm(2000,0,3) #' #' # annotate a violin plot #' group <- rep(c("bimodal", "uniform", "normal"), #' sapply(list(bimodal, uniform, normal), length)) #' table(group) #' vioplot(bimodal,uniform,normal) #' add_labels(unlist(bimodal,uniform,normal), group, height = 3, cex = 0.8) #' #' # boxplots are also supported #' boxplot(bimodal,uniform,normal) #' add_labels(unlist(bimodal,uniform,normal), group, height = 3, cex = 0.8) #' #' #' # formula input #' data("iris") #' vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", #' col=c("lightgreen", "lightblue", "palevioletred")) #' legend("bottomright", legend=c("setosa", "versicolor", "virginica"), #' fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) #' add_labels(unlist(iris$Sepal.Length), iris$Species, height = 0, cex = 0.8) #' #' # demo with outliers #' iris2 <- iris #' iris2 <- rbind(iris2, c(7, 0, 0, 0, "setosa")) #' iris2 <- rbind(iris2, c(0, 0, 0, 0, "setosa")) #' iris2 <- rbind(iris2, c(9, 0, 0, 0, "versicolor")) #' iris2 <- rbind(iris2, c(2, 0, 0, 0, "versicolor")) #' iris2 <- rbind(iris2, c(10, 0, 0, 0, "virginica")) #' iris2 <- rbind(iris2, c(12, 0, 0, 0, "virginica")) #' iris2$Species <- factor(iris2$Species) #' iris2$Sepal.Length <- as.numeric(iris2$Sepal.Length) #' #' vioplot(Sepal.Length~Species, data = iris2, main = "Sepal Length", #' col=c("lightgreen", "lightblue", "palevioletred")) #' add_outliers(unlist(iris2$Sepal.Length), iris2$Species, #' col = "grey50", fill = "red", bars = "grey85") #' legend("bottomright", legend=c("setosa", "versicolor", "virginica"), #' fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) #' add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0, cex = 0.8) #' #' @usage add_labels(variable, categories, cex = par()$cex, col = par()$fg, height = 0.5) #' @rdname add_labels #' @export #' add_labels <- function(variable, categories, cex = par()$cex, col = par()$fg, height = 0.5){ text(x = seq_along(table(categories)), y = rep(max(variable)+height, length(categories)), sapply(table(categories), function(nn) paste0(c("n=", nn), collapse = "")), col = col, cex = cex) } #' Annotated Violin Plot #' #' Annotate violin plots with outliers #' #' @name add_outliers #' @description #' Annotation to highlight outliers. #' @param variable continuous variable to to plot on y-axis (numeric or integer). #' @param categories discrete variable to break down groups (factor or string). #' @param col colour of rings or borders. Scalar applied to all columns or a vector for each category. #' @param fill colour of spots. Scalar applied to all columns or a vector for each category. #' @param bars colour of horizontal bars. Scalar applied to all columns or a vector for each category. #' @param lwd thickness of border. #' @param cutoff minimum number (default 3L) of standard deviations to report. #' @param verbose to print logs (defaults to FALSE). #' @keywords plot graphics violin annotation #' #' @usage add_outliers(variable, categories, cutoff = 3, #' fill = par()$bg, col = par()$fg, bars = par()$fg, lwd = par()$lwd, #' verbose = FALSE) #' @rdname add_outliers #' @importFrom stats sd #' @importFrom graphics abline text #' @export add_outliers <- function(variable, categories, cutoff = 3, fill = par()$bg, col = par()$fg, bars = par()$fg, lwd = par()$lwd, verbose = FALSE){ if(length(col) == 1) col <- rep(col, length(unique(categories))) if(length(fill) == 1) fill <- rep(fill, length(unique(categories))) for(category in unique(categories)){ ii <- which(sort(unique(categories)) == category) if(verbose){ print(category) print(ii) } y <- variable[categories == category] y <- na.omit(y) if(verbose) print(length(y[y < mean(y, na.rm = TRUE) - cutoff * sd(y, na.rm = TRUE)])) points(rep(ii, length(y[y < mean(y, na.rm = TRUE) - cutoff * sd(y, na.rm = TRUE)])), y[y < mean(y, na.rm = TRUE) - cutoff * sd(y, na.rm = TRUE)], cex = 1.25, pch = 21, bg = fill[ii], col = col[ii]) if(verbose) print(length(y[y > mean(y, na.rm = TRUE) + cutoff * sd(y, na.rm = TRUE)])) points(rep(ii, length(y[y > mean(y, na.rm = TRUE) + cutoff * sd(y, na.rm = TRUE)])), y[y > mean(y, na.rm = TRUE) + cutoff * sd(y, na.rm = TRUE)], cex = 1.25, pch = 21, bg = fill[ii], col = col[ii], lwd = lwd) } abline(h=0, lwd = 1.5, lty = 2, col = bars) } vioplot/R/vioplot.stats.R0000644000176200001440000000220314640410551015120 0ustar liggesusers#' Violin Plot Statistics #' #' This function is typically called by another function to gather the statistics necessary #' for producing box plots, but may be invoked separately. See: \code{\link[grDevices]{boxplot.stats}} #' #' @aliases violin.stats violinplot.stats #' @rdname violin.stats #' @param x a numeric vector for which the violin plot will be constructed \code{NA}s and \code{NaN}s are allowed and omitted). #' @param coef this determines how far the plot ‘whiskers’ extend out from the box. If coef is positive, the #' whiskers extend to the most extreme data point which is no more than coef times the length of the box away #' from the box. A value of zero causes the whiskers to extend to the data extremes (and no outliers be returned). #' @param do.conf,do.out logicals; if FALSE, the conf or out component respectively will be empty in the result. #' @param ... arguments passed to \code{\link[vioplot]{vioplot}}. #' @importFrom grDevices boxplot.stats #' @export vioplot.stats <- function(x, coef = 1.5, do.conf = TRUE, do.out = TRUE, ...){ boxplot.stats(x, coef = coef, do.conf = do.conf, do.out = do.out) } vioplot/R/histoplot.R0000644000176200001440000007672314641337400014340 0ustar liggesusers#' histoplot #' #' Produce histogram plot(s) of the given (grouped) values with enhanced annotation and colour per group. Includes customisation of colours for each aspect of the histogram, boxplot, and separate histograms. This supports input of data as a list or formula, being backwards compatible with \code{\link[vioplot]{histoplot}} (0.2) and taking input in a formula as used for \code{\link[graphics]{boxplot}}. #' #' @name histoplot #' @aliases histoplot #' @param x for specifying data from which the boxplots are to be produced. Either a numeric vector, or a single list containing such vectors. Additional unnamed arguments specify further data as separate vectors (each corresponding to a component boxplot). NAs are allowed in the data. #' @param ... additional data vectors or formula parameters. For the formula method, named arguments to be passed to the default method. #' @param formula a formula, such as y ~ grp, where y is a numeric vector of data values to be split into groups according to the grouping variable grp (usually a factor). #' @param data a data.frame (or list) from which the variables in formula should be taken. #' @param use.cols logical indicating if columns (by default) or rows (use.cols = FALSE) should be plotted. #' @param subset an optional vector specifying a subset of observations to be used for plotting. #' @param drop,sep,lex.order defines groups to plot from formula, passed to \code{split.default}, see there. #' @param breaks the breaks for the density estimator, as explained in hist #' @param xlim,ylim numeric vectors of length 2, giving the x and y coordinates ranges. #' @param yaxt A character which specifies the y axis type. Specifying "n" suppresses plotting. #' @param ylog,xlog A logical value (see log in \code{\link[graphics]{plot.default}}). If ylog is TRUE, a logarithmic scale is in use (e.g., after plot(*, log = "y")). For horizontal = TRUE then, if xlog is TRUE, a logarithmic scale is in use (e.g., after plot(*, log = "x")). For a new device, it defaults to FALSE, i.e., linear scale. #' @param log Logarithmic scale if log = "y" or TRUE. Invokes ylog = TRUE. If horizontal is TRUE then invokes xlog = TRUE. #' @param logLab Increments for labelling y-axis on log-scale, defaults to numbers starting with 1, 2, 5, and 10. #' @param names one label, or a vector of labels for the data must match the number of data given #' @param col Graphical parameter for fill colour of the histogram(s) polygon. NA for no fill colour. If col is a vector, it specifies the colour per histogram, and colours are reused if necessary. #' @param border Graphical parameters for the colour of the histogram border passed to lines. NA for no border. If border is a vector, it specifies the colour per histogram, and colours are reused if necessary. #' @param lty,lwd Graphical parameters for the histogram passed to lines and polygon #' @param rectCol Graphical parameters to control fill colour of the box. NA for no fill colour. If col is a vector, it specifies the colour per histogram, and colours are reused if necessary. #' @param lineCol Graphical parameters to control colour of the box outline and whiskers. NA for no border. If lineCol is a vector, it specifies the colour per histogram, and colours are reused if necessary. #' @param pchMed Graphical parameters to control shape of the median point. If pchMed is a vector, it specifies the shape per histogram. #' @param colMed,colMed2 Graphical parameters to control colour of the median point. If colMed is a vector, it specifies the colour per histogram. colMed specifies the fill colour in all cases unless pchMed is 21:25 in which case colMed is the border colour and colMed2 is the fill colour. #' @param drawRect logical. The box is drawn if TRUE. #' @param areaEqual logical. Density plots checked for equal area if TRUE. wex must be scalar, relative widths of histograms depend on area. #' @param at position of each histogram. Default to 1:n #' @param add logical. if FALSE (default) a new plot is created #' @param wex relative expansion of the histogram. If wex is a vector, it specifies the area/width size per histogram and sizes are reused if necessary. #' @param horizontal logical. To use horizontal or vertical histograms. Note that log scale can only be used on the x-axis for horizontal histograms, and on the y-axis otherwise. #' @param main,sub,xlab,ylab graphical parameters passed to plot. #' @param cex A numerical value giving the amount by which plotting text should be magnified relative to the default. #' @param cex.axis The magnification to be used for y axis annotation relative to the current setting of cex. #' @param cex.names The magnification to be used for x axis annotation relative to the current setting of cex. Takes the value of cex.axis if not given. #' @param cex.lab The magnification to be used for x and y labels relative to the current setting of cex. #' @param cex.main The magnification to be used for main titles relative to the current setting of cex. #' @param cex.sub The magnification to be used for sub-titles relative to the current setting of cex. #' @param na.action a function which indicates what should happen when the data contain NAs. The default is to ignore missing values in either the response or the group. #' @param na.rm logical value indicating whether NA values should be stripped before the computation proceeds. Defaults to TRUE. #' @param side defaults to "both". Assigning "left" or "right" enables one sided plotting of histograms. May be applied as a scalar across all groups. #' @param axes,frame.plot,panel.first,panel.last,asp,line,outer,adj,ann,ask,bg,bty,cin,col.axis,col.lab,col.main,col.sub,cra,crt,csi,cxy,din,err,family,fg,fig,fin,font,font.axis,font.lab,font.main,font.sub,lab,las,lend,lheight,ljoin,lmitre,mai,mar,mex,mfcol,mfg,mfrow,mgp,mkh,new,oma,omd,omi,page,pch,pin,plt,ps,pty,smo,srt,tck,tcl,usr,xaxp,xaxs,xaxt,xpd,yaxp,yaxs,ylbias Arguments to be passed to methods, such as graphical parameters (see \code{\link[graphics]{par}})). #' @keywords plot graphics histogram #' @import sm #' @importFrom zoo rollmean #' @importFrom stats median na.omit quantile #' @importFrom graphics Axis axis box lines par plot.new plot.window plot.xy points polygon rect title #' @importFrom grDevices boxplot.stats dev.flush dev.hold dev.interactive devAskNewPage xy.coords #' @export #' @examples #' #' # box- vs histogram-plot #' par(mfrow=c(2,1)) #' mu<-2 #' si<-0.6 #' bimodal<-c(rnorm(1000,-mu,si),rnorm(1000,mu,si)) #' uniform<-runif(2000,-4,4) #' normal<-rnorm(2000,0,3) #' histoplot(bimodal,uniform,normal) #' boxplot(bimodal,uniform,normal) #' #' # add to an existing plot #' x <- rnorm(100) #' y <- rnorm(100) #' plot(x, y, xlim=c(-5,5), ylim=c(-5,5)) #' histoplot(x, col="tomato", horizontal=TRUE, at=-4, add=TRUE,lty=2, rectCol="gray") #' histoplot(y, col="cyan", horizontal=FALSE, at=-4, add=TRUE,lty=2) #' #' # formula input #' data("iris") #' histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", #' col=c("lightgreen", "lightblue", "palevioletred")) #' legend("topleft", legend=c("setosa", "versicolor", "virginica"), #' fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) #' #' data("diamonds", package = "ggplot2") #' palette <- RColorBrewer::brewer.pal(9, "Pastel1") #' par(mfrow=c(3, 1)) #' histoplot(price ~ cut, data = diamonds, las = 1, col = palette) #' histoplot(price ~ clarity, data = diamonds, las = 2, col = palette) #' histoplot(price ~ color, data = diamonds, las = 2, col = palette) #' par(mfrow=c(3, 1)) #' #' #generate example data #' data_one <- rnorm(100) #' data_two <- rnorm(50, 1, 2) #' #' #generate histogram plot with similar functionality to histoplot #' histoplot(data_one, data_two, col="magenta") #' #' #note vioplox defaults to a greyscale plot #' histoplot(data_one, data_two) #' #' #colours can be customised separately, with axis labels, legends, and titles #' histoplot(data_one, data_two, col=c("red","blue"), names=c("data one", "data two"), #' main="data histogram", xlab="data class", ylab="data read") #' legend("topleft", fill=c("red","blue"), legend=c("data one", "data two")) #' #' #colours can be customised for the histogram fill and border separately #' histoplot(data_one, data_two, col="grey85", border="purple", names=c("data one", "data two"), #' main="data histogram", xlab="data class", ylab="data read") #' #' #colours can also be customised for the boxplot rectange and lines (border and whiskers) #' histoplot(data_one, data_two, col="grey85", rectCol="lightblue", lineCol="blue", #' border="purple", names=c("data one", "data two"), #' main="data histogram", xlab="data class", ylab="data read") #' #' #these colours can also be customised separately for each histogram #' histoplot(data_one, data_two, col=c("skyblue", "plum"), rectCol=c("lightblue", "palevioletred"), #' lineCol="blue", border=c("royalblue", "purple"), names=c("data one", "data two"), #' main="data histogram", xlab="data class", ylab="data read") #' #' #this applies to any number of histograms, given that colours are provided for each #' histoplot(data_one, data_two, rnorm(200, 3, 0.5), rpois(200, 2.5), rbinom(100, 10, 0.4), #' col=c("red", "orange", "green", "blue", "violet"), #' rectCol=c("palevioletred", "peachpuff", "lightgreen", "lightblue", "plum"), #' lineCol=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"), #' border=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"), #' names=c("data one", "data two", "data three", "data four", "data five"), #' main="data histogram", xlab="data class", ylab="data read") #' #' #The areaEqual parameter scales with width of histograms #' #histograms will have equal density area (including missing tails) rather than equal maximum width #' histoplot(data_one, data_two, areaEqual=TRUE) #' #' histoplot(data_one, data_two, areaEqual=TRUE, #' col=c("skyblue", "plum"), rectCol=c("lightblue", "palevioletred"), #' lineCol="blue", border=c("royalblue", "purple"), names=c("data one", "data two"), #' main="data histogram", xlab="data class", ylab="data read") #' #' histoplot(data_one, data_two, rnorm(200, 3, 0.5), rpois(200, 2.5), rbinom(100, 10, 0.4), #' areaEqual=TRUE, col=c("red", "orange", "green", "blue", "violet"), #' rectCol=c("palevioletred", "peachpuff", "lightgreen", "lightblue", "plum"), #' lineCol=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"), #' border=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"), #' names=c("data one", "data two", "data three", "data four", "data five"), #' main="data histogram", xlab="data class", ylab="data read") #' #' #To compare multiple groups of histogram densities, it helps to adjust the wex. #' #' dlist1 <- lapply(c(10,20,30,40), function(n) runif(n)) #' dlist2 <- lapply(c(100,200,300,400), function(n) runif(n)) #' #' hscale1 <- sapply(dlist1, function(r){ #' max(hist(r, plot=FALSE, breaks=seq(0,1,by=.05))$density)}) #' histoplot(dlist1, side='left', col=grey(.3), #' breaks=seq(0,1,by=.05), add=FALSE, pchMed=NA, drawRect=FALSE, border=NA, #' wex=hscale1/length(hscale1)) #' #' hscale2 <- sapply(dlist2, function(r){ #' max(hist(r, plot=FALSE, breaks=seq(0,1,by=.05))$density)}) #' histoplot(dlist2, side='right', col=grey(.7), #' breaks=seq(0,1,by=.05), add=TRUE, pchMed=NA, drawRect=FALSE, border=NA, #' wex=hscale2/length(hscale2)) #' #' #Sometimes, it is helpful to see the raw counts instead. #' #' dvec <- length(unlist(c(dlist1, dlist2)))/4 #' #' histoplot(dlist1, side='left', col=grey(.3), #' breaks=seq(0,1,by=.05), add=FALSE, pchMed=NA, drawRect=FALSE, border=NA, #' wex=sapply(dlist1, length)/dvec*hscale1/length(hscale1)) #' histoplot(dlist2, side='right', col=grey(.7), #' breaks=seq(0,1,by=.05), add=TRUE, pchMed=NA, drawRect=FALSE, border=NA, #' wex=sapply(dlist2, length)/dvec*hscale2/length(hscale2)) #' #' #It may also benefit some users to pass density and angle arguments to the #' # histograms (ultimately rect) and create outer legends #' #' hist(runif(100), density=c(10,20), angle=c(22,90+22) ,col=1) #' #' outer_legend <- function(...) { #' opar <- par(fig=c(0, 1, 0, 1), oma=c(0, 0, 0, 0), mar=c(0, 0, 0, 0), new=TRUE) #' on.exit(par(opar)) #' plot(0, 0, type='n', bty='n', xaxt='n', yaxt='n') #' legend(...) #' } #' outer_legend('topright', pch=15, density=c(10,20), angle=c(22,90+22), col=0, legend=c('Y','N')) #' #' @export #' @usage NULL histoplot <- function(x, ...) { UseMethod("histoplot") } #' Draw a histogram plot for each Column (Row) of a Matrix #' #' Interpreting the columns (or rows) of a matrix as different groups, draw a boxplot for each. #' #' @aliases histogram.matrix histoplot.matrix #' @param x a numeric matrix. #' @param use.cols logical indicating if columns (by default) or rows (use.cols = FALSE) should be plotted. #' @param ... Further arguments to \code{\link[vioplot]{histoplot}}. #' @rdname histoplot #' @export histoplot.matrix <- function (x, use.cols = TRUE, ...) { groups <- if (use.cols) { split(c(x), rep.int(1L:ncol(x), rep.int(nrow(x), ncol(x)))) } else split(c(x), seq(nrow(x))) if (length(nam <- dimnames(x)[[1 + use.cols]])) names(groups) <- nam invisible(histoplot(groups, ...)) } #' @rdname histoplot #' @export histoplot.list <- function (x, ...){ ind <- sapply(x, is.numeric) if(all(!ind)){ stop(paste("elements are not numeric: ", names(x)[!sapply(x, is.numeric)])) } if(any(!ind)){ warning(paste("some elements are not numeric: ", names(x)[!sapply(x, is.numeric)])) x <- x[sapply(x, is.numeric)] } invisible(histoplot.default(x, ...)) } #' @rdname histoplot #' @export histoplot.data.frame <- histoplot.list #' @rdname histoplot #' @export histoplot.matrix <- histoplot.matrix #' @rdname histoplot #' @export histoplot.formula <- function (formula, data = NULL, ..., subset, na.action = NULL, add = FALSE, ann = !add, horizontal = FALSE, side = "both", xlab = mklab(y_var = horizontal), ylab = mklab(y_var = !horizontal), names=NULL, drop = FALSE, sep = ".", lex.order = FALSE) { if (missing(formula) || (length(formula) != 3L)){ stop("'formula' missing or incorrect") } if(add && side != "both"){ if(!is.null(names)) warning("Warning: names can only be changed on first call of histoplot (when add = FALSE) ") if(!missing(xlab)) warning("Warning: x-axis labels can only be changed on first call of histoplot (when add = FALSE) ") if(!missing(ylab)) warning("Warning: y-axis labels can only be changed on first call of histoplot (when add = FALSE) ") } if (missing(xlab) || missing(ylab)){ mklab <- function(y_var){ if(y_var){ names(mf)[response] } else { paste(names(mf)[-response], collapse = " : ") } } } m <- match.call(expand.dots = FALSE) if (is.matrix(eval(m$data, parent.frame()))){ m$data <- as.data.frame(data) } m$... <- m$drop <- m$sep <- m$lex.order <- NULL m$xlab <- m$ylab <- m$add <- m$ann <- m$horizontal <- NULL m$names <- m$side <- NULL m$na.action <- na.action m[[1L]] <- quote(stats::model.frame.default) mf <- eval(m, parent.frame()) response <- attr(attr(mf, "terms"), "response") if(add){ xlab <- ylab <- NA } x <- split(mf[[response]], mf[-response], drop = drop, sep = sep, lex.order = lex.order) histoplot(x, xlab = xlab, ylab = ylab, names = names, add = add, ann = ann, horizontal = horizontal, side = side, ...) } #' @rdname histoplot #' @export histoplot.default <- function (x, ..., data = NULL, breaks = 'Sturges', xlim = NULL, ylim = NULL, names = NULL, horizontal = FALSE, col = "grey50", border = par()$fg, lty = 1, lwd = 1, rectCol = par()$fg, lineCol = par()$fg, pchMed = 19, colMed = "white", colMed2 = "grey 75", at, add = FALSE, wex = 1, drawRect = TRUE, areaEqual=FALSE, axes = TRUE, frame.plot = axes, panel.first = NULL, panel.last = NULL, asp = NA, main="", sub="", xlab=NA, ylab=NA, line = NA, outer = FALSE, xlog = NA, ylog=NA, adj=NA, ann = NA, ask=NA, bg=NA, bty=NA, cex=NA, cex.axis=NA, cex.lab=NA, cex.main=NA, cex.names=NULL, cex.sub=NA, cin=NA, col.axis=NA, col.lab=NA, col.main=NA, col.sub=NA, cra=NA, crt=NA, csi=NA,cxy=NA, din=NA, err=NA, family=NA, fg=NA, fig=NA, fin=NA, font=NA, font.axis=NA, font.lab=NA, font.main=NA, font.sub=NA, lab=NA, las=NA, lend=NA, lheight=NA, ljoin=NA, lmitre=NA, mai=NA, mar=NA, mex=NA, mfcol=NA, mfg=NA, mfrow=NA, mgp=NA, mkh=NA, new=NA, oma=NA, omd=NA, omi=NA, page=NA, pch=NA, pin=NA, plt=NA, ps=NA, pty=NA, smo=NA, srt=NA, tck=NA, tcl=NA, usr=NA, xaxp=NA, xaxs=NA, xaxt=NA, xpd=NA, yaxp=NA, yaxs=NA, yaxt=NA, ylbias=NA, log="", logLab=c(1,2,5), na.action = NULL, na.rm = T, side = "both") { #assign graphical parameters if not given for(ii in 1:length(names(par()))){ if(is.na(get(names(par())[ii])[1])) assign(names(par()[ii]), unlist(par()[[ii]])) } if(add && side != "both"){ if(!is.null(names)) warning("Warning: names can only be changed on first call of histoplot (when add = FALSE) ") if(!is.na(xlab)) warning("Warning: x-axis labels can only be changed on first call of histoplot (when add = FALSE) ") if(!is.na(ylab)) warning("vy-axis labels can only be changed on first call of histoplot (when add = FALSE) ") if(!missing(main)) warning("Warning: main title can only be changed on first call of histoplot (when add = FALSE) ") if(!missing(sub)) warning("Warning: subtitle can only be changed on first call of histoplot (when add = FALSE) ") } if(!is.list(x)){ datas <- list(x, ...) } else{ datas <- lapply(x, unlist) if(is.null(names)){ names <- names(datas) } } datas <- lapply(datas, function(x){ if(all(x == unique(x)[1]) & length(x) > 100){ unique(x)[1] } else { x } }) if(is.character(log)) if("y" %in% unlist(strsplit(log, ""))) log <- TRUE if(is.na(xlog) | (horizontal == TRUE & (log == FALSE | log == ""))) xlog <- FALSE log <- ifelse(log == TRUE, "y", "") if(log == 'x' | log == 'xy' | xlog == TRUE){ if(horizontal | log == "xy"){ log <- TRUE } else { log <- FALSE ylog <- FALSE } xlog <- FALSE } if(log == TRUE | ylog == TRUE){ ylog <- TRUE log <- "y" } else { log <- "" } if(ylog){ #check data is compatible with log scale if(all(unlist(datas) <= 0)){ ylog <- FALSE warning("log scale cannot be used with non-positive data") } else { #log-scale data datas <- datas #lapply(datas, function(x) log(unlist(x))) } } if(is.null(na.action)) na.action <- na.omit lapply(datas, function(data) data <- data[!sapply(data, is.infinite)]) if(na.rm) datas <- lapply(datas, na.action) n <- length(datas) #if(is.list(datas)) datas <- as.data.frame(datas) if (missing(at)){ at <- 1:n } #upper <- vector(mode = "numeric", length = n) #lower <- vector(mode = "numeric", length = n) q1 <- vector(mode = "numeric", length = n) q2 <- vector(mode = "numeric", length = n) q3 <- vector(mode = "numeric", length = n) med <- vector(mode = "numeric", length = n) base <- vector(mode = "list", length = n) height <- vector(mode = "list", length = n) area_check <- vector(mode = "list", length = n) baserange <- c(Inf, -Inf) args <- list(plot = FALSE, breaks = breaks) radj <- ifelse(side == "right", 0, 1) ladj <- ifelse(side == "left", 0, 1) boxwex <- wex if(areaEqual){ for (i in 1:n) { data <- unlist(datas[[i]]) data.min <- min(data, na.rm = na.rm) data.max <- max(data, na.rm = na.rm) q1[i] <- quantile(data, 0.25) q2[i] <- quantile(data, 0.5) q3[i] <- quantile(data, 0.75) med[i] <- median(data) iqd <- q3[i] - q1[i] #upper[i] <- min(q3[i] + range * iqd, data.max) #lower[i] <- max(q1[i] - range * iqd, data.min) #est.xlim <- c(min(lower[i], data.min), max(upper[i], data.max)) smout <- do.call("hist", c(list(data), args)) Avg.pos <- mean(smout$mids) xt <- diff(smout$mids[smout$mids1){ warning("wex may not be a vector if areaEqual is TRUE") print("using first element of wex") wex<-wex[i] } wex <-unlist(area_check)/max(unlist(area_check))*wex } for (i in 1:n) { data <- unlist(datas[[i]]) data.min <- min(data, na.rm = na.rm) data.max <- max(data, na.rm = na.rm) q1[i] <- quantile(data, 0.25) q2[i] <- quantile(data, 0.5) q3[i] <- quantile(data, 0.75) med[i] <- median(data) iqd <- q3[i] - q1[i] #upper[i] <- min(q3[i] + range * iqd, data.max) #lower[i] <- max(q1[i] - range * iqd, data.min) #est.xlim <- c(min(lower[i], data.min), max(upper[i], data.max)) smout <- do.call("hist", c(list(data), args)) hscale <- 0.4/max(smout$density) * ifelse(length(wex)>1, wex[i], wex) base[[i]] <- smout$breaks height[[i]] <- smout$density * hscale t <- range(base[[i]]) baserange[1] <- min(baserange[1], t[1]) baserange[2] <- max(baserange[2], t[2]) } if (!add) { if (is.null(xlim)) { xlim <- if (n == 1){ at + c(-0.5, 0.5) } else { range(at) + min(diff(at))/2 * c(-1, 1) } } else { xlim.default <- if (n == 1){ at + c(-0.5, 0.5) } else { range(at) + min(diff(at))/2 * c(-1, 1) } print(paste0("Using c(", xlim[1],",", xlim[2], ") as input for xlim, note that default values for these dimensions are c(", xlim.default[1],",", xlim.default[2], ")")) } if (is.null(ylim)) { ylim <- baserange } } if (is.null(names)) { label <- 1:n } else { label <- names } boxwidth <- 0.05 * ifelse(length(boxwex)>1, boxwex[i], boxwex) if (!add){ plot.new() if(!horizontal){ plot.window(xlim, ylim, log = log, asp = asp, bty = bty, cex = cex, xaxs = xaxs, yaxs = yaxs, lab = lab, mai = mai, mar = mar, mex = mex, mfcol = mfcol, mfrow = mfrow, mfg = mfg, xlog = xlog, ylog = ylog) } else { plot.window(ylim, xlim, log = ifelse(log == "y", "x", ""), asp = asp, bty = bty, cex = cex, xaxs = xaxs, yaxs = yaxs, lab = lab, mai = mai, mar = mar, mex = mex, mfcol = mfcol, mfrow = mfrow, mfg = mfg, xlog = ylog, ylog = xlog) } } panel.first if (!horizontal) { if (!add) { plot.window(xlim, ylim, log = log, asp = asp, bty = bty, cex = cex, xaxs = xaxs, yaxs = yaxs, lab = lab, mai = mai, mar = mar, mex = mex, mfcol = mfcol, mfrow = mfrow, mfg = mfg, xlog = xlog, ylog = ylog) xaxp <- par()$xaxp yaxp <- par()$yaxp if(yaxt !="n"){ if(ylog){ #log_axis_label <- log_axis_label[log_axis >= exp(par("usr")[3])] #log_axis <- log_axis[log_axis >= exp(par("usr")[3])] #log_axis_label <- log_axis_label[log_axis <= exp(par("usr")[4])] #log_axis <- log_axis[log_axis <= exp(par("usr")[4])] Axis(unlist(datas), side = 2, cex.axis = cex.axis, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) # xaxp = xaxp, yaxp = yaxp disabled for log if(is.null(cex.names)) cex.names <- cex.axis if(xaxt !="n"){ Axis(1:length(datas), at = at, labels = label, side = 1, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) # xaxp = xaxp, yaxp = yaxp disabled for log } } else { Axis(unlist(datas), side = 2, cex.axis = cex.axis, col.axis = col.axis, font.axis = font.axis, mgp = mgp, yaxp = yaxp, tck = tck, tcl = tcl, las = las) if(is.null(cex.names)) cex.names <- cex.axis if(xaxt !="n"){ Axis(1:length(datas), at = at, labels = label, side = 1, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, xaxp = xaxp, tck = tck, tcl = tcl, las = las) } } } else { if(ylog){ if(is.null(cex.names)) cex.names <- cex.axis if(xaxt !="n"){ Axis(1:length(datas), at = at, labels = label, side = 1, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) # xaxp = xaxp, yaxp = yaxp disabled for log } } else { if(is.null(cex.names)) cex.names <- cex.axis if(xaxt !="n"){ Axis(1:length(datas), at = at, labels = label, side = 1, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, xaxp = xaxp, tck = tck, tcl = tcl, las = las) } } } } if (frame.plot) { box(lty = lty, lwd = lwd) } for (i in 1:n) { colp <- ifelse(length(col)>1,col[1+(i-1)%%length(col)], col) borderp <- ifelse(length(border)>1, border[1+(i-1)%%length(border)], border) nB <- length(base[[i]]) #xp <- c(at[i] - radj*height[[i]], rev(at[i] + ladj*height[[i]])) #yp <- c(base[[i]], rev(base[[i]])) #polygon(xp, yp, col=colp, border=borderp, #lty = lty, lwd = lwd, xpd = xpd, lend = lend, ljoin = ljoin, lmitre = lmitre) x0 <- at[i]- radj*height[[i]] y0 <- base[[i]][-nB] x1 <- at[i]+ ladj*height[[i]] y1 <- base[[i]][-1L] rect(x0, y0, x1, y1, col = colp, border = borderp, lty = lty) if (drawRect) { #lines(at[c(i, i)], c(lower[i], upper[i]), lwd = lwd, # lty = lty, col = ifelse(length(lineCol)>1, lineCol[1+(i-1)%%length(lineCol)], lineCol), lend = lend, ljoin = ljoin, lmitre = lmitre) rect(at[i] - radj*ifelse(length(boxwidth)>1, boxwidth[i], boxwidth)/2, q1[i], at[i] + ladj*ifelse(length(boxwidth)>1, boxwidth[i], boxwidth)/2, q3[i], col = ifelse(length(rectCol)>1, rectCol[1+(i-1)%%length(rectCol)], rectCol), border = ifelse(length(lineCol)>1, lineCol[1+(i-1)%%length(lineCol)], lineCol), xpd = xpd, lend = lend, ljoin = ljoin, lmitre = lmitre) points(at[i], med[i], pch = ifelse(length(pchMed)>1, pchMed[1+(i-1)%%length(pchMed)], pchMed), col = ifelse(length(colMed)>1, colMed[1+(i-1)%%length(colMed)], colMed), bg = ifelse(length(colMed2)>1, colMed2[1+(i-1)%%length(colMed2)], colMed2), cex = cex, lwd = lwd, lty = lty) } } } else { if(log == "y" || ylog == TRUE){ log <- "x" xlog <- TRUE ylog <- FALSE } if (!add) { plot.window(ylim, xlim, log = log, asp = asp, bty = bty, cex = cex, xaxs = xaxs, yaxs = yaxs, lab = lab, mai = mai, mar = mar, mex = mex, mfcol = mfcol, mfrow = mfrow, mfg = mfg, xlog = xlog, ylog = ylog) xaxp <- par()$xaxp yaxp <- par()$yaxp if(yaxt !="n"){ if(xlog){ #log_axis_label <- log_axis_label[log_axis >= exp(par("usr")[3])] #log_axis <- log_axis[log_axis >= exp(par("usr")[3])] #log_axis_label <- log_axis_label[log_axis <= exp(par("usr")[4])] #log_axis <- log_axis[log_axis <= exp(par("usr")[4])] Axis(unlist(datas), side = 1, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) # xaxp = xaxp, yaxp = yaxp disabled for log if(is.null(cex.names)) cex.names <- cex.axis if(xaxt !="n"){ Axis(1:length(datas), at = at, labels = label, side = 2, cex.axis = cex.axis, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) # xaxp = xaxp, yaxp = yaxp disabled for log } } else { Axis(unlist(datas), side = 1, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, xaxp = xaxp, tck = tck, tcl = tcl, las = las) if(is.null(cex.names)) cex.names <- cex.axis if(xaxt !="n"){ Axis(1:length(datas), at = at, labels = label, side = 2, cex.axis = cex.axis, col.axis = col.axis, font.axis = font.axis, mgp = mgp, yaxp = yaxp, tck = tck, tcl = tcl, las = las) } } } else { if(ylog){ if(is.null(cex.names)) cex.names <- cex.axis if(xaxt !="n"){ Axis(1:length(datas), at = at, labels = label, side = 1, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, tck = tck, tcl = tcl, las = las) # xaxp = xaxp, yaxp = yaxp disabled for log } } else { if(is.null(cex.names)) cex.names <- cex.axis if(xaxt !="n"){ Axis(1:length(datas), at = at, labels = label, side = 1, cex.axis = cex.names, col.axis = col.axis, font.axis = font.axis, mgp = mgp, xaxp = xaxp, tck = tck, tcl = tcl, las = las) } } } } if (frame.plot) { box(lty = lty, lwd = lwd) } for (i in 1:n) { colp <- ifelse(length(col)>1,col[1+(i-1)%%length(col)], col) borderp <- ifelse(length(border)>1, border[1+(i-1)%%length(border)], border) nB <- length(height[[i]]) #xp <- c(at[i] - radj*height[[i]], rev(at[i] + ladj*height[[i]])) #yp <- c(base[[i]], rev(base[[i]])) #polygon(xp, yp, col=colp, border=borderp, #lty = lty, lwd = lwd, xpd = xpd, lend = lend, ljoin = ljoin, lmitre = lmitre) x0 <- at[i]- radj*height[[i]] y0 <- base[[i]][-nB] x1 <- at[i]+ ladj*height[[i]] y1 <- base[[i]][-1L] rect(x0, y0, x1, y1, col = colp, border = borderp, lty = lty) if (drawRect) { #lines(c(lower[i], upper[i]), at[c(i, i)], lwd = lwd, # lty = lty, col = ifelse(length(lineCol)>1, lineCol[1+(i-1)%%length(lineCol)], lineCol), lend = lend, ljoin = ljoin, lmitre = lmitre) rect(q1[i], at[i] - radj*ifelse(length(boxwidth)>1, boxwidth[i], boxwidth)/2, q3[i], at[i] + ladj*ifelse(length(boxwidth)>1, boxwidth[i], boxwidth)/2, col = ifelse(length(rectCol)>1, rectCol[1+(i-1)%%length(rectCol)], rectCol), border = ifelse(length(lineCol)>1, lineCol[1+(i-1)%%length(lineCol)], lineCol), xpd = xpd, lend = lend, ljoin = ljoin, lmitre = lmitre) points(med[i], at[i], pch = ifelse(length(pchMed)>1, pchMed[1+(i-1)%%length(pchMed)], pchMed), col = ifelse(length(colMed)>1, colMed[1+(i-1)%%length(colMed)], colMed), , bg = ifelse(length(colMed2)>1, colMed2[1+(i-1)%%length(colMed2)], colMed2), cex = cex, lwd = lwd, lty = lty) } } } panel.last if (ann) { title(main = main, sub = sub, xlab = xlab, ylab = ylab, line = line, outer = outer, xpd = xpd, cex.main = cex.main, col.main = col.main, font.main = font.main) } invisible(list( #upper = upper, lower = lower, median = med, q1 = q1, q3 = q3)) } vioplot/vignettes/0000755000176200001440000000000014641725510013763 5ustar liggesusersvioplot/vignettes/histogram_customisation.Rmd0000644000176200001440000002625314641611371021414 0ustar liggesusers--- title: "An alternative to Violin Plots with Histograms" author: "Tom Kelly, Jordan Adamson" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{vioplot: An alternative to Violin Plots with Histograms} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- While boxplots have become the _de facto_ standard for plotting the distribution of data this is a vast oversimplification and may not show everything needed to evaluate the variation of data. This is particularly important for datasets which do not form a Gaussian "Normal" distribution that most researchers have become accustomed to. While density plots are helpful in this regard, they can be less aesthetically pleasing than boxplots and harder to interpret for those familiar with boxplots. Often the only ways to compare multiple data types with density use slices of the data with faceting the plotting panes or overlaying density curves with colours and a legend. This approach is jarring for new users and leads to cluttered plots difficult to present to a wider audience. Therefore violin plots, density plots, and histograms are a powerful tool to assist researchers to visualise data, particularly in the quality checking and exploratory parts of an analysis. These plots have many benefits: - Greater flexibility for plotting variation than boxplots - More familiarity to boxplot users than density plots - Easier to directly compare data types than existing plots As shown below for the `iris` dataset, histogram plots show distribution information that the boxplot is unable to. ```{r} library("vioplot") ``` ```{r, message=FALSE, eval=FALSE} data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) library("vioplot") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) ``` ```{r, message=FALSE, echo=FALSE} data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="magenta") ``` ## Plot Defaults However as we can see here the plot defaults are not aesthetically pleasing, with a rather glaring colour scheme unsuitable for professional or academic usage. Thus the plot default colours have been changed as shown here: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") ``` # Histogram plot Here we introduce a variant of the violin plot, using a mirrored bihistogram to show the distribution: ```{r} histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") ``` ## Plot colours: Histogram Fill Plot colours can be further customised as with the original viooplot package using the `col` argument: ```{r} histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue") ``` ### Vectorisation The `vioplot` (0.2) function is unable to colour each histogram separately, thus this is enabled with a vectorised `col` in `viooplot` (0.3) and `histoplot` (0.4): ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) ``` ```{r} histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) ``` ## Plot colours: Violin Lines and Boxplot Colours can also be customised for the histogram fill and border separately using the `col` and `border` arguments: ```{r} histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue") ``` Similarly, the arguments `lineCol` and `rectCol` specify the colors of the boxplot outline and rectangle fill. For simplicity the box and whiskers of the boxplot will always have the same colour. ```{r} histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", rectCol="palevioletred", lineCol="violetred") ``` The same applies to the colour of the median point with `colMed`: ```{r} histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", colMed="violet") ``` ### Combined customisation These can be customised colours can be combined: ```{r} histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue", rectCol="palevioletred", lineCol="violetred", colMed="violet") ``` ### Vectorisation These color and shape settings can also be customised separately for each histogram: ```{r} histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T, col=c("lightgreen", "lightblue", "palevioletred"), border=c("darkolivegreen4", "royalblue4", "violetred4"), rectCol=c("forestgreen", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), colMed=c("green", "cyan", "magenta"), pchMed=c(15, 17, 19)) ``` ## Split Bihistogram Plots We set up the data with two categories (Sepal Width) as follows: ```{r, message=FALSE} data(iris) summary(iris$Sepal.Width) table(iris$Sepal.Width > mean(iris$Sepal.Width)) iris_large <- iris[iris$Sepal.Width > mean(iris$Sepal.Width), ] iris_small <- iris[iris$Sepal.Width <= mean(iris$Sepal.Width), ] ``` An indirect comparison can be achieved with par: ```{r, fig.align = 'center', fig.height = 6, fig.width = 6, fig.keep = 'last'} { par(mfrow=c(1,2)) histoplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line") histoplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line") par(mfrow=c(1,1)) } ``` A direct comparision of 2 datasets can be made with the `side` argument and `add = TRUE` on the second plot: ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} histoplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right") histoplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T) title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ``` ## Split Histogram Plots We set up the data with two categories (Sepal Width) as follows: ```{r, message=FALSE} data(iris) summary(iris$Sepal.Width) table(iris$Sepal.Width > mean(iris$Sepal.Width)) iris_large <- iris[iris$Sepal.Width > mean(iris$Sepal.Width), ] iris_small <- iris[iris$Sepal.Width <= mean(iris$Sepal.Width), ] ``` A more direct comparision can be made with the `side` argument and `add = TRUE` on the second plot: ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} histoplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right") histoplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T) title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ``` ## Fine tuning with split histograms #To compare multiple groups of histogram densities, it helps to adjust the wex. ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} dlist1 <- lapply(c(10,20,30,40), function(n) runif(n)) dlist2 <- lapply(c(100,200,300,400), function(n) runif(n)) hscale1 <- sapply(dlist1, function(r){ max(hist(r, plot=FALSE, breaks=seq(0,1,by=.05))$density)}) histoplot(dlist1, side='left', col=grey(.3), breaks=seq(0,1,by=.05), add=FALSE, pchMed=NA, drawRect=FALSE, border=NA, wex=hscale1/length(hscale1)) hscale2 <- sapply(dlist2, function(r){ max(hist(r, plot=FALSE, breaks=seq(0,1,by=.05))$density)}) histoplot(dlist2, side='right', col=grey(.7), breaks=seq(0,1,by=.05), add=TRUE, pchMed=NA, drawRect=FALSE, border=NA, wex=hscale2/length(hscale2)) ``` Sometimes, it is helpful to see the raw counts instead. ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} dvec <- length(unlist(c(dlist1, dlist2)))/4 histoplot(dlist1, side='left', col=grey(.3), breaks=seq(0,1,by=.05), add=FALSE, pchMed=NA, drawRect=FALSE, border=NA, wex=sapply(dlist1, length)/dvec*hscale1/length(hscale1)) histoplot(dlist2, side='right', col=grey(.7), breaks=seq(0,1,by=.05), add=TRUE, pchMed=NA, drawRect=FALSE, border=NA, wex=sapply(dlist2, length)/dvec*hscale2/length(hscale2)) ``` ### Shading histograms It may also benefit some users to pass density and angle arguments to the histograms (ultimately rect) and create outer legends. ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} hist(runif(100), density=c(10,20), angle=c(22,90+22) ,col=1) outer_legend <- function(...) { opar <- par(fig=c(0, 1, 0, 1), oma=c(0, 0, 0, 0), mar=c(0, 0, 0, 0), new=TRUE) on.exit(par(opar)) plot(0, 0, type='n', bty='n', xaxt='n', yaxt='n') legend(...) } outer_legend('topright', pch=15, density=c(10,20), angle=c(22,90+22), col=0, legend=c('Y','N')) ``` vioplot/vignettes/violin_area.Rmd0000644000176200001440000001736014640410551016721 0ustar liggesusers--- title: "Controlling Violin Plot Area" author: "Tom Kelly" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{vioplot: Controlling Violin Plot Area} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- While boxplots have become the _de facto_ standard for plotting the distribution of data this is a vast oversimplification and may not show everything needed to evaluate the variation of data. This is particularly important for datasets which do not form a Gaussian "Normal" distribution that most researchers have become accustomed to. While density plots are helpful in this regard, they can be less aesthetically pleasing than boxplots and harder to interpret for those familiar with boxplots. Often the only ways to compare multiple data types with density use slices of the data with faceting the plotting panes or overlaying density curves with colours and a legend. This approach is jarring for new users and leads to cluttered plots difficult to present to a wider audience. ##Violin Plots Therefore violin plots are a powerful tool to assist researchers to visualise data, particularly in the quality checking and exploratory parts of an analysis. Violin plots have many benefits: - Greater flexibility for plotting variation than boxplots - More familiarity to boxplot users than density plots - Easier to directly compare data types than existing plots As shown below for the `iris` dataset, violin plots show distribution information that the boxplot is unable to. ```{r} library("vioplot") ``` ```{r, message=FALSE} data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) ``` ##Violin Plot Area However there are concerns that existing violin plot packages (such as \code{\link[vioplot]{vioplot}}) scales the data to the most aesthetically suitable width rather than maintaining proportions comparable across data sets. Consider the differing distributions shown below: ```{r, echo=FALSE, message=FALSE} par(mar=rep(1,4)) ``` ```{r} par(mfrow=c(3, 1)) par(mar=rep(2, 4)) plot(density(iris$Sepal.Length[iris$Species=="setosa"]), main="Sepal Length: setosa", col="green") plot(density(iris$Sepal.Length[iris$Species=="versicolor"]), main="Sepal Length: versicolor", col="blue") plot(density(iris$Sepal.Length[iris$Species=="virginica"]), main="Sepal Length: virginica", col="palevioletred4") par(mfrow=c(1, 1)) ``` ```{r, echo=FALSE, message=FALSE} par(mar=c(5, 4, 4, 2) + 0.1) ``` #Comparing datasets Neither of these plots above show the relative distribtions on the same scale, even if we match the x-axis of a density plot the relative heights are obscured and difficult to compare. ```{r, echo=FALSE, message=FALSE} par(mar=rep(2,4)) ``` ```{r} par(mfrow=c(3, 1)) par(mar=rep(2, 4)) xaxis <- c(3, 9) yaxis <- c(0, 1.25) plot(density(iris$Sepal.Length[iris$Species=="setosa"]), main="Sepal Length: setosa", col="green", xlim=xaxis, ylim=yaxis) plot(density(iris$Sepal.Length[iris$Species=="versicolor"]), main="Sepal Length: versicolor", col="blue", xlim=xaxis, ylim=yaxis) plot(density(iris$Sepal.Length[iris$Species=="virginica"]), main="Sepal Length: virginica", col="palevioletred4", xlim=xaxis, ylim=yaxis) par(mfrow=c(1, 1)) ``` ```{r, echo=FALSE, message=FALSE} par(mar=c(5, 4, 4, 2) + 0.1) ``` This can somewhat be addressed by overlaying density plots: ```{r} par(mfrow=c(1, 1)) xaxis <- c(3, 9) yaxis <- c(0, 1.25) plot(density(iris$Sepal.Length[iris$Species=="setosa"]), main="Sepal Length", col="green", xlim=xaxis, ylim=yaxis) lines(density(iris$Sepal.Length[iris$Species=="versicolor"]), col="blue") lines(density(iris$Sepal.Length[iris$Species=="virginica"]), col="palevioletred4") legend("topright", fill=c("green", "blue", "palevioletred4"), legend=levels(iris$Species), cex=0.5) ``` This has the benefit of highlighting the different distributions of the data subsets. However, notice here that a figure legend become necessary, plot axis limits need to be defined to display the range of all distribution curves, and the plot quickly becomes cluttered if the number of factors to be compared becomes much larger. ##Area control in Violin plot Therefore the `areaEqual` parameter has been added to customise the violin plot to serve a similar purpose: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", areaEqual = T) ``` If we compare this to the original vioplot functionality (defaulting to `areaEqual = FALSE`) the differences between the two are clear. ```{r, echo=FALSE, message=FALSE} par(mar=rep(2, 4)) ``` ```{r} par(mfrow=c(2,1)) par(mar=rep(2, 4)) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Width)", areaEqual = F) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T) par(mfrow=c(1,1)) ``` ```{r, echo=FALSE, message=FALSE} par(mar=c(5, 4, 4, 2) + 0.1) ``` Note that `areaEqual` is considering the full area of the density distribution before removing the outlier tails. We leave it up to the users discretion which they elect to use. The `areaEqual` functionality is compatible with all of the customisation used in discussed in [the main vioplot vignette](violin_customisation.html) ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T, col=c("lightgreen", "lightblue", "palevioletred"), rectCol=c("green", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), border=c("darkolivegreen4", "royalblue4", "violetred4")) ``` The violin width can further be scaled with `wex`, which maintains the proportions across the datasets if `areaEqual = TRUE`: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T, col=c("lightgreen", "lightblue", "palevioletred"), rectCol=c("green", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), border=c("darkolivegreen4", "royalblue4", "violetred4"), wex=1.25) ``` ## Comparing distributions Notice the utility of `areaEqual` for cases where different datasets have different underlying distributions: ```{r} vioplot(rnorm(200, 3, 0.5), rpois(200, 2.5), rbinom(100, 10, 0.4), rlnorm(200, 0, 0.5), rnbinom(200, 10, 0.9), rlogis(20, 0, 0.5), areaEqual = F, main="Equal Width", xlab="distribution", ylab="data value", names=c("normal", "poisson", "binomial", "log-normal", "neg-binomial", "logistic")) vioplot(rnorm(200, 3, 0.5), rpois(200, 2.5), rbinom(100, 10, 0.4), rlnorm(200, 0, 0.5), rnbinom(200, 10, 0.9), rlogis(20, 0, 0.5), areaEqual = T, main="Equal Area", xlab="distribution", ylab="data value", names=c("normal", "poisson", "binomial", "log-normal", "neg-binomial", "logistic")) ``` vioplot/vignettes/histogram_formulae.Rmd0000644000176200001440000001221414640410551020311 0ustar liggesusers--- title: "Customising Histogram Plots with Formula Input" author: "Tom Kelly" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{histoplot: Customising Histogram Plots with Formula Input} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- Since boxplots have become the _de facto_ standard for plotting the distribution of data most users are familiar with these and the formula input for dataframes. However this input is not available in the standard `histoplot` package. Thus it has been restored here for enhanced backwards compatibility with `boxplot`. As shown below for the `iris` dataset, histogram plots show distribution information taking formula input that `boxplot` implements but `histoplot` is unable to. This demonstrates the customisation demonstrated in [the main histoplot vignette using histoplot syntax](histogram_customisation.html) with the formula method commonly used for `boxplot`, `t.test`, and `lm`. ```{r} library("vioplot") ``` ```{r, message=FALSE, eval=FALSE} data(iris) boxplot(Sepal.Length~Species, data = iris) ``` ```{r, message=FALSE, echo=FALSE} data(iris) boxplot(Sepal.Length~Species, data = iris, main = "Sepal Length") ``` Whereas performing the same function does not work with `vioplot` (0.2). ```{r, message=FALSE, eval=FALSE} devtools::install_version("vioplot", version = "0.2") library("vioplot") vioplot(Sepal.Length~Species, data = iris) ``` ``` Error in min(data) : invalid 'type' (language) of argument ``` ## Plot Defaults ```{r, message=FALSE, eval=FALSE} vioplot(Sepal.Length~Species, data = iris) ``` ```{r, message=FALSE, echo=FALSE} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="magenta") ``` Another concern we see here is that the `vioplot` defaults are not aesthetically pleasing, with a rather glaring colour scheme unsuitable for professional or academic usage. Thus the plot default colours have been changed as shown here: ```{r} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length") ``` ## Plot colours: Histogram Fill Plot colours can be further customised as with the original vioplot package using the `col` argument: ```{r} histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue") ``` ### Vectorisation However the `vioplot` (0.2) function is unable to colour each histogram separately, thus this is enabled with a vectorised `col` in `histoplot` (0.4): ```{r} histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) ``` ## Plot colours: Violin Lines and Boxplot Colours can also be customised for the histogram fill and border separately using the `col` and `border` arguments: ```{r} histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue", border="royalblue") ``` Similarly, the arguments `lineCol` and `rectCol` specify the colours of the boxplot outline and rectangle fill. For simplicity the box and whiskers of the boxplot will always have the same colour. ```{r} histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", rectCol="palevioletred", lineCol="violetred") ``` The same applies to the colour of the median point with `colMed`: ```{r} histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", colMed="violet") ``` ### Combined customisation These can be customised colours can be combined: ```{r} histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue", border="royalblue", rectCol="palevioletred", lineCol="violetred", colMed="violet") ``` ### Vectorisation These colour and shape settings can also be customised separately for each histogram: ```{r} histoplot(Sepal.Length~Species, data = iris, main="Sepal Length", col=c("lightgreen", "lightblue", "palevioletred"), border=c("darkolivegreen4", "royalblue4", "violetred4"), rectCol=c("forestgreen", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), colMed=c("green", "cyan", "magenta"), pchMed=c(15, 17, 19)) ``` ## Split Bihistogram Plots We set up the data with two categories (Sepal Width) as follows: ```{r, message=FALSE} data(iris) summary(iris$Sepal.Width) table(iris$Sepal.Width > mean(iris$Sepal.Width)) iris_large <- iris[iris$Sepal.Width > mean(iris$Sepal.Width), ] iris_small <- iris[iris$Sepal.Width <= mean(iris$Sepal.Width), ] ``` A direct comparision of 2 datasets can be made with the `side` argument and `add = TRUE` on the second plot: ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} histoplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right") histoplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T) title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ``` vioplot/vignettes/violin_ylog.Rmd0000644000176200001440000001043114640410551016753 0ustar liggesusers--- title: "Controlling y-axis Plotting" author: "Tom Kelly" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{vioplot: Controlling y-axis Plotting} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- While boxplots have become the _de facto_ standard for plotting the distribution of data this is a vast oversimplification and may not show everything needed to evaluate the variation of data. This is particularly important for datasets which do not form a Gaussian "Normal" distribution that most researchers have become accustomed to. While density plots are helpful in this regard, they can be less aesthetically pleasing than boxplots and harder to interpret for those familiar with boxplots. Often the only ways to compare multiple data types with density use slices of the data with faceting the plotting panes or overlaying density curves with colours and a legend. This approach is jarring for new users and leads to cluttered plots difficult to present to a wider audience. ##Violin Plots Therefore violin plots are a powerful tool to assist researchers to visualise data, particularly in the quality checking and exploratory parts of an analysis. Violin plots have many benefits: - Greater flexibility for plotting variation than boxplots - More familiarity to boxplot users than density plots - Easier to directly compare data types than existing plots As shown below for the `iris` dataset, violin plots show distribution information that the boxplot is unable to. ```{r} library("vioplot") ``` ```{r, message=FALSE} data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) ``` ##Violin y-axis ###Logarithmic scale However the existing violin plot packages (such as \code{\link[vioplot]{vioplot}}) do not support log-scale of the y-axis. This has been amended with the `ylog` argument. ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", ylog = T, ylim=c(log(1), log(10))) ``` This can also be invoked with the `log="y"` argument compatible with `boxplot`: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = T, ylim=c(log(1), log(10))) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = "y", ylim=c(log(1), log(10))) ``` ###custom y-axes The y-axes can also be removed with `yaxt="n"` to enable customised y-axes: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", yaxt="n") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", ylog = T, yaxt="n", ylim=c(log(1), log(10))) ``` Thus custom axes can be added to violin plots. As shown on a linear scale: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", yaxt="n") axis(2, at=1:10, labels=1:10) ``` As well as for on a log scale: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", yaxt="n", log="y", ylim=c(log(4), log(9))) axis(2, at=log(1:10), labels=1:10) ``` vioplot/vignettes/violin_split.Rmd0000644000176200001440000002601314641625552017151 0ustar liggesusers--- title: "Split Violin Plots" author: "Tom Kelly" date: "`r Sys.Date()`" output: rmarkdown::html_vignette fig_width: 6 fig_height: 3 fig_align: 'center' fig_keep: 'last' vignette: > %\VignetteIndexEntry{vioplot: Split Violin Plots} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ##Violin Plots Therefore violin plots are a powerful tool to assist researchers to visualise data, particularly in the quality checking and exploratory parts of an analysis. Violin plots have many benefits: - Greater flexibility for plotting variation than boxplots - More familiarity to boxplot users than density plots - Easier to directly compare data types than existing plots As shown below for the `iris` dataset, violin plots show distribution information that the boxplot is unable to. ###General Set up ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} library("vioplot") ``` We set up the data with two categories (Sepal Width) as follows: ```{r, message=FALSE} data(iris) summary(iris$Sepal.Width) table(iris$Sepal.Width > mean(iris$Sepal.Width)) iris_large <- iris[iris$Sepal.Width > mean(iris$Sepal.Width), ] iris_small <- iris[iris$Sepal.Width <= mean(iris$Sepal.Width), ] ``` ###Boxplots First we plot Sepal Length on its own: ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} boxplot(Sepal.Length~Species, data=iris, col="grey") ``` An indirect comparison can be achieved with par: ```{r, fig.align = 'center', fig.height = 6, fig.width = 6, fig.keep = 'last'} { par(mfrow=c(2,1)) boxplot(Sepal.Length~Species, data=iris_small, col = "lightblue") boxplot(Sepal.Length~Species, data=iris_large, col = "palevioletred") par(mfrow=c(1,1)) } ``` ### Violin Plots First we plot Sepal Length on its own: ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} vioplot(Sepal.Length~Species, data=iris) ``` An indirect comparison can be achieved with par: ```{r, fig.align = 'center', fig.height = 6, fig.width = 6, fig.keep = 'last'} { par(mfrow=c(2,1)) vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line") vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line") par(mfrow=c(1,1)) } ``` An indirect comparison can be achieved with par: ```{r, fig.align = 'center', fig.height = 6, fig.width = 6, fig.keep = 'last'} { par(mfrow=c(1,2)) vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line") vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line") par(mfrow=c(1,1)) } ``` ### Split Violin Plots A more direct comparision can be made with the `side` argument and `add = TRUE` on the second plot: ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right") vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T) title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ``` #### Custom axes labels Custom axes labels are supported for split violin plots. However, you must use these arguments on the *first* call of `vioplot`. ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right", xlab = "Iris species", ylab = "Length", main = "Sepals", names=paste("Iris", levels(iris$Species))) vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T) legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Width") ``` Note that this is disabled for the second `vioplot` call to avoid overlaying labels. ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right") vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T, xlab = "Iris species", ylab = "Length", main = "Sepals", names=paste("Iris", levels(iris$Species))) legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Width") ``` #### Median The line median option is more suitable for side by side comparisions but the point option is still available also: ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "point", side = "right", pchMed = 21, colMed = "palevioletred4", colMed2 = "palevioletred2") vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "point", side = "left", pchMed = 21, colMed = "lightblue4", colMed2 = "lightblue2", add = T) title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ``` It may be necessary to include a `points` command to fix the median being overwritten by the following plots: ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "point", side = "right", pchMed = 21, colMed = "palevioletred4", colMed2 = "palevioletred2") vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "point", side = "left", pchMed = 21, colMed = "lightblue4", colMed2 = "lightblue2", add = T) points(1:length(levels(iris$Species)), as.numeric(sapply(levels(iris$Species), function(species) median(iris_large[grep(species, iris_large$Species),]$Sepal.Length))), pch = 21, col = "palevioletred4", bg = "palevioletred2") title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ``` Similarly points could be added where a line has been used previously: ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right", pchMed = 21, colMed = "palevioletred4", colMed2 = "palevioletred2") vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", pchMed = 21, colMed = "lightblue4", colMed2 = "lightblue2", add = T) points(1:length(levels(iris$Species)), as.numeric(sapply(levels(iris$Species), function(species) median(iris_large[grep(species, iris_large$Species),]$Sepal.Length))), pch = 21, col = "palevioletred4", bg = "palevioletred2") points(1:length(levels(iris$Species)), as.numeric(sapply(levels(iris$Species), function(species) median(iris_small[grep(species, iris_small$Species),]$Sepal.Length))), pch = 21, col = "lightblue4", bg = "lightblue2") title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ``` Here it is aesthetically pleasing and intuitive to interpret categorical differences in mean and variation in a continuous variable. ### Enchanced annotation demonstration. Here we add outliers and show annotation features. ```{r, warning=FALSE} # add outliers to demo data iris2 <- iris iris2 <- rbind(iris2, c(7, 1, 0, 0, "setosa")) iris2 <- rbind(iris2, c(1, 10, 0, 0, "setosa")) iris2 <- rbind(iris2, c(9, 2, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(2, 12, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(10, 1, 0, 0, "virginica")) iris2 <- rbind(iris2, c(12, 7, 0, 0, "virginica")) iris2$Species <- factor(iris2$Species) iris2$Sepal.Length <- as.numeric(iris2$Sepal.Length) iris2$Sepal.Width <- as.numeric(iris2$Sepal.Width) table(iris2$Species) ``` Annotation on split violins are shown here. See the main violin plot vignette for details on these parameters. ```{r, fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'} data(iris) summary(iris2$Sepal.Width) table(iris2$Sepal.Width > mean(iris2$Sepal.Width)) iris_large <- iris2[iris2$Sepal.Width > mean(iris2$Sepal.Width), ] iris_small <- iris2[iris2$Sepal.Width <= mean(iris2$Sepal.Width), ] attach(iris_large) vioplot(Sepal.Length~Species, data=iris_large, plotCentre = "line", side = "right", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(iris2$Sepal.Length) * 0.9, max(iris2$Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(iris_large$Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris_large$Sepal.Length), iris2$Species, cutoff = 2, col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2, fill = "grey85") legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("palegreen3", "lightblue3", "palevioletred3"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) attach(iris_small) vioplot(Sepal.Length~Species, data=iris_small, plotCentre = "line", side = "left", add = T, col=c("palegreen1", "lightblue1", "palevioletred1"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(iris_small$Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2, col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2, fill = "grey50") legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) # add legend and titles legend("topleft", fill = c("lightblue2", "lightblue3"), legend = c("small", "large"), title = "Sepal Width") title(xlab = "Species", ylab = "Sepal Length") ``` #### Sources These extensions to `vioplot` here are based on those provided here: * https://gist.github.com/mbjoseph/5852613 These have previously been discussed on the following sites: * https://mbjoseph.github.io/posts/2018-12-23-split-violin-plots/ * http://tagteam.harvard.edu/hub_feeds/1981/feed_items/209875 * [https://www.r-bloggers.com/split-violin-plots/](https://www.r-bloggers.com/2013/06/split-violin-plots/) vioplot/vignettes/violin_customisation.Rmd0000644000176200001440000002766014641625405020725 0ustar liggesusers--- title: "Customising Violin Plots" author: "Tom Kelly" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{vioplot: Customising Violin Plots} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- While boxplots have become the _de facto_ standard for plotting the distribution of data this is a vast oversimplification and may not show everything needed to evaluate the variation of data. This is particularly important for datasets which do not form a Gaussian "Normal" distribution that most researchers have become accustomed to. While density plots are helpful in this regard, they can be less aesthetically pleasing than boxplots and harder to interpret for those familiar with boxplots. Often the only ways to compare multiple data types with density use slices of the data with faceting the plotting panes or overlaying density curves with colours and a legend. This approach is jarring for new users and leads to cluttered plots difficult to present to a wider audience. Therefore violin plots are a powerful tool to assist researchers to visualise data, particularly in the quality checking and exploratory parts of an analysis. Violin plots have many benefits: - Greater flexibility for plotting variation than boxplots - More familiarity to boxplot users than density plots - Easier to directly compare data types than existing plots As shown below for the `iris` dataset, violin plots show distribution information that the boxplot is unable to. ```{r} library("vioplot") ``` ```{r, message=FALSE, eval=FALSE} data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) library("vioplot") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) ``` ```{r, message=FALSE, echo=FALSE} data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="magenta") ``` ## Plot Defaults However as we can see here the plot defaults are not aesthetically pleasing, with a rather glaring colour scheme unsuitable for professional or academic usage. Thus the plot default colours have been changed as shown here: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") ``` ## Plot colours: Violin Fill Plot colours can be further customised as with the original vioplot package using the `col` argument: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue") ``` ### Vectorisation However the `vioplot` (0.2) function is unable to colour each violin separately, thus this is enabled with a vectorised `col` in `vioplot` (0.3): ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) ``` ## Plot colours: Violin Lines and Boxplot Colours can also be customised for the violin fill and border separately using the `col` and `border` arguments: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue") ``` Similarly, the arguments `lineCol` and `rectCol` specify the colors of the boxplot outline and rectangle fill. For simplicity the box and whiskers of the boxplot will always have the same colour. ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", rectCol="palevioletred", lineCol="violetred") ``` The same applies to the colour of the median point with `colMed`: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", colMed="violet") ``` ### Combined customisation These can be customised colours can be combined: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue", rectCol="palevioletred", lineCol="violetred", colMed="violet") ``` ### Vectorisation These color and shape settings can also be customised separately for each violin: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T, col=c("lightgreen", "lightblue", "palevioletred"), border=c("darkolivegreen4", "royalblue4", "violetred4"), rectCol=c("forestgreen", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), colMed=c("green", "cyan", "magenta"), pchMed=c(15, 17, 19)) ``` This should be sufficient to customise the violin plot but further examples are given in [the areaEqual vioplot vignette](violin_area.html) including how violin plots are useful for comparing variation when data does not follow the same distribution. This document also compares the violin plot with other established methods to plot data variation. ### Enhanced Annotation Here we demonstrate additional annotation features to display outliers and group sizes. #### Labelling group size Note that y-axes limits need to be adjusted to avoid overlaying text. ```{r, fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'} data("iris") attach(iris) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], main = "Sepal Length", ylab = "", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(0, max(Sepal.Length) * 1.1)) legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.8) add_labels(unlist(iris$Sepal.Length), iris$Species, height = 0.5, cex = 0.8) ``` #### Plotting outliers and medians Here we add outliers and show annotation features. ```{r, warning=FALSE} # add outliers to demo data iris2 <- iris iris2 <- rbind(iris2, c(7, 1, 0, 0, "setosa")) iris2 <- rbind(iris2, c(1, 10, 0, 0, "setosa")) iris2 <- rbind(iris2, c(9, 2, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(2, 12, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(10, 1, 0, 0, "virginica")) iris2 <- rbind(iris2, c(12, 7, 0, 0, "virginica")) iris2$Species <- factor(iris2$Species) iris2$Sepal.Length <- as.numeric(iris2$Sepal.Length) iris2$Sepal.Width <- as.numeric(iris2$Sepal.Width) table(iris2$Species) ``` This adds outliers to the plot. ```{r, fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'} attach(iris2) vioplot(iris2$Sepal.Length[iris$Species=="setosa"], iris2$Sepal.Length[iris$Species=="versicolor"], iris2$Sepal.Length[iris2$Species=="virginica"], main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2, col = "black", bars = "grey85", lwd = 2, fill = c("palegreen3", "lightblue3", "palevioletred3")) legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) ``` Annotation on split violins are shown here. See the split violin plot vignette for details on these parameters. ```{r, fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'} data(iris) summary(iris2$Sepal.Width) table(iris2$Sepal.Width > mean(iris2$Sepal.Width)) iris_large <- iris2[iris2$Sepal.Width > mean(iris2$Sepal.Width), ] iris_small <- iris2[iris2$Sepal.Width <= mean(iris2$Sepal.Width), ] attach(iris_large) vioplot(iris_large$Sepal.Length[iris_large$Species=="setosa"], iris_large$Sepal.Length[iris_large$Species=="versicolor"], iris_large$Sepal.Length[iris_large$Species=="virginica"], plotCentre = "line", side = "right", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(iris2$Sepal.Length) * 0.9, max(iris2$Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(iris_large$Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris_large$Sepal.Length), iris2$Species, cutoff = 2, col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2, fill = "grey85") legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) attach(iris_small) vioplot(iris_small$Sepal.Length[iris_small$Species=="setosa"], iris_small$Sepal.Length[iris_small$Species=="versicolor"], iris_small$Sepal.Length[iris_small$Species=="virginica"], plotCentre = "line", side = "left", add = T, col=c("palegreen1", "lightblue1", "palevioletred1"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(iris_small$Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2, col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2, fill = "grey50") legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) # add legend and titles legend("topleft", fill = c("lightblue2", "lightblue3"), legend = c("small", "large"), title = "Sepal Width") title(xlab = "Species", ylab = "Sepal Length") ``` vioplot/vignettes/violin_formulae.Rmd0000644000176200001440000002222614641625352017630 0ustar liggesusers--- title: "Customising Violin Plots with Formula Input" author: "Tom Kelly" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{vioplot: Customising Violin Plots with Formula Input} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- Since boxplots have become the _de facto_ standard for plotting the distribution of data most users are familiar with these and the formula input for dataframes. However this input is not available in the standard `vioplot` package. Thus it has been restored here for enhanced backwards compatibility with `boxplot`. As shown below for the `iris` dataset, violin plots show distribution information taking formula input that `boxplot` implements but `vioplot` is unable to. This demonstrates the customisation demonstrated in [the main vioplot vignette using vioplot syntax](violin_customisation.html) with the formula method commonly used for `boxplot`, `t.test`, and `lm`. ```{r} library("vioplot") ``` ```{r, message=FALSE, eval=FALSE} data(iris) boxplot(Sepal.Length~Species, data = iris) ``` ```{r, message=FALSE, echo=FALSE} data(iris) boxplot(Sepal.Length~Species, data = iris, main = "Sepal Length") ``` Whereas performing the same function does not work with `vioplot` (0.2). ```{r, message=FALSE, eval=FALSE} devtools::install_version("vioplot", version = "0.2") library("vioplot") vioplot(Sepal.Length~Species, data = iris) ``` ``` Error in min(data) : invalid 'type' (language) of argument ``` ## Plot Defaults ```{r, message=FALSE, eval=FALSE} vioplot(Sepal.Length~Species, data = iris) ``` ```{r, message=FALSE, echo=FALSE} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="magenta") ``` Another concern we see here is that the `vioplot` defaults are not aesthetically pleasing, with a rather glaring colour scheme unsuitable for professional or academic usage. Thus the plot default colours have been changed as shown here: ```{r} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length") ``` ## Plot colours: Violin Fill Plot colours can be further customised as with the original vioplot package using the `col` argument: ```{r} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue") ``` ### Vectorisation However the `vioplot` (0.2) function is unable to colour each violin separately, thus this is enabled with a vectorised `col` in `vioplot` (0.3): ```{r} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) ``` ## Plot colours: Violin Lines and Boxplot Colours can also be customised for the violin fill and border separately using the `col` and `border` arguments: ```{r} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue", border="royalblue") ``` Similarly, the arguments `lineCol` and `rectCol` specify the colours of the boxplot outline and rectangle fill. For simplicity the box and whiskers of the boxplot will always have the same colour. ```{r} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", rectCol="palevioletred", lineCol="violetred") ``` The same applies to the colour of the median point with `colMed`: ```{r} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", colMed="violet") ``` ### Combined customisation These can be customised colours can be combined: ```{r} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue", border="royalblue", rectCol="palevioletred", lineCol="violetred", colMed="violet") ``` ### Vectorisation These colour and shape settings can also be customised separately for each violin: ```{r} vioplot(Sepal.Length~Species, data = iris, main="Sepal Length", col=c("lightgreen", "lightblue", "palevioletred"), border=c("darkolivegreen4", "royalblue4", "violetred4"), rectCol=c("forestgreen", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), colMed=c("green", "cyan", "magenta"), pchMed=c(15, 17, 19)) ``` ### Enhanced Annotation Here we demonstrate additional annotation features to display outliers and group sizes. #### Labelling group size Note that y-axes limits need to be adjusted to avoid overlaying text. ```{r, fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'} data("iris") attach(iris) vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", ylab = "", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(0, max(Sepal.Length) * 1.1)) legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.8) add_labels(unlist(iris$Sepal.Length), iris$Species, height = 0.5, cex = 0.8) ``` #### Plotting outliers and medians Here we add outliers and show annotation features. ```{r, warning=FALSE} # add outliers to demo data iris2 <- iris iris2 <- rbind(iris2, c(7, 1, 0, 0, "setosa")) iris2 <- rbind(iris2, c(1, 10, 0, 0, "setosa")) iris2 <- rbind(iris2, c(9, 2, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(2, 12, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(10, 1, 0, 0, "virginica")) iris2 <- rbind(iris2, c(12, 7, 0, 0, "virginica")) iris2$Species <- factor(iris2$Species) iris2$Sepal.Length <- as.numeric(iris2$Sepal.Length) iris2$Sepal.Width <- as.numeric(iris2$Sepal.Width) table(iris2$Species) ``` This adds outliers to the plot. ```{r, fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'} attach(iris2) vioplot(Sepal.Length~Species, data = iris2, main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1)) Sepal.medians <- sapply(unique(Species), function(sp) median(Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2, col = "black", bars = "grey85", lwd = 2, fill = c("palegreen3", "lightblue3", "palevioletred3")) legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) ``` Annotation on split violins are shown here. See the split violin plot vignette for details on these parameters. ```{r, fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'} data(iris) summary(iris2$Sepal.Width) table(iris2$Sepal.Width > mean(iris2$Sepal.Width)) iris_large <- iris2[iris2$Sepal.Width > mean(iris2$Sepal.Width), ] iris_small <- iris2[iris2$Sepal.Width <= mean(iris2$Sepal.Width), ] attach(iris_large) vioplot(Sepal.Length~Species, data=iris_large, plotCentre = "line", side = "right", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(iris2$Sepal.Length) * 0.9, max(iris2$Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(iris_large$Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris_large$Sepal.Length), iris2$Species, cutoff = 2, col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2, fill = "grey85") legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("palegreen3", "lightblue3", "palevioletred3"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) attach(iris_small) vioplot(Sepal.Length~Species, data=iris_small, plotCentre = "line", side = "left", add = T, col=c("palegreen1", "lightblue1", "palevioletred1"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(iris_small$Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2, col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2, fill = "grey50") legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) # add legend and titles legend("topleft", fill = c("lightblue2", "lightblue3"), legend = c("small", "large"), title = "Sepal Width") title(xlab = "Species", ylab = "Sepal Length") ``` vioplot/vignettes/overlaying_annotations.Rmd0000644000176200001440000000563214640410551021224 0ustar liggesusers--- title: "Overlaying base R graphics" author: "Tom Kelly" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{vioplot: Overlaying base R graphics} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ## Introduction: Integration with base R graphics Here we demonstrate how to combine violin plots with other base R graphics. In principle any base R graphics can be overlayed on top of a violin plot for annotation. Many problems can be resolved by overlaying base R graphics and integrating vioplot with other plotting functions. Any additional elements can be overlayed by running commands after generating the plot. The x-axes are integer values [1,2,3,…] for each violin. The y-axes are continuous values as displayed. The following plotting elements are supported for example: points, lines, polygon It is also possible to modify plotting parameters with: title, axis, legend "vioplot()" functions similar to "plot()" and passes input arguments from "par()". ### Plotting violins with highlighted medians For example it is possible to add additional annotations. ```{r} # generate dummy data a <- rnorm(25, 3, 0.5) b <- rnorm(25, 2, 1.0) c <- rnorm(25, 2.75, 0.25) d <- rnorm(25, 3.15, 0.375) e <- rnorm(25, 1, 0.25) datamat <- cbind(a, b, c, d, e) dim(datamat) ``` ```{r} library("vioplot") ``` ```{r} vioplot(datamat, ylim = c(0, 5)) # compute medians data.med <- apply(datamat, 2, median) data.med #overlay medians lines(data.med, lty = 2, lwd = 1.5) points(data.med, pch = 19, col = "red", cex = 2.25) ``` ### Custom axes and titles It is also possible to modify the axes labels and titles as shown in this example. Here default axes are suppressed and replaced with custom parameters. ```{r} outcome <- c(rnorm(25, 3, 1), rnorm(25, 2, 0.5)) intervention <- c(rep("treatment", 25), rep("control", 25)) table(intervention) names(table(intervention)) unique(sort(intervention)) intervention <- as.factor(intervention) levels(intervention) d <- data.frame(outcome, intervention) vioplot(outcome ~ intervention, data = d, xaxt = 'n', yaxt = 'n', main = "", xlab = "", ylab = "") axis(side = 1, at = 1:length(levels(intervention)), labels = levels(intervention)) mtext("custom x labels for intervention", side = 1) mtext("custom y labels for outcome", side = 2) title(main = "example with custom title", sub = "subtitles are supported") ``` #### Annotated histograms This is also supported by the histogram plot. ```{r} histoplot(outcome ~ intervention, data = d, xaxt = 'n', yaxt = 'n', main = "", xlab = "", ylab = "") axis(side = 1, at = 1:length(levels(intervention)), labels = levels(intervention)) mtext("custom x labels for intervention", side = 1) mtext("custom y labels for outcome", side = 2) title(main = "example with custom title", sub = "subtitles are supported") ``` vioplot/NAMESPACE0000644000176200001440000000223414641336307013175 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(histoplot,data.frame) S3method(histoplot,default) S3method(histoplot,formula) S3method(histoplot,list) S3method(histoplot,matrix) S3method(vioplot,data.frame) S3method(vioplot,default) S3method(vioplot,formula) S3method(vioplot,list) S3method(vioplot,matrix) S3method(vioplot,stats) export(add_labels) export(add_outliers) export(histoplot) export(vioplot) import(sm) importFrom(grDevices,boxplot.stats) importFrom(grDevices,dev.flush) importFrom(grDevices,dev.hold) importFrom(grDevices,dev.interactive) importFrom(grDevices,devAskNewPage) importFrom(grDevices,xy.coords) importFrom(graphics,Axis) importFrom(graphics,abline) importFrom(graphics,axis) importFrom(graphics,box) importFrom(graphics,lines) importFrom(graphics,par) importFrom(graphics,plot.new) importFrom(graphics,plot.window) importFrom(graphics,plot.xy) importFrom(graphics,points) importFrom(graphics,polygon) importFrom(graphics,rect) importFrom(graphics,text) importFrom(graphics,title) importFrom(stats,median) importFrom(stats,na.omit) importFrom(stats,quantile) importFrom(stats,sd) importFrom(zoo,rollmean) vioplot/LICENSE0000644000176200001440000000012414640410551012750 0ustar liggesusersYEAR: 2004 COPYRIGHT HOLDER: Daniel Adler ORGANIZATION: University of Goettingen vioplot/NEWS.md0000644000176200001440000000663114641626062013061 0ustar liggesusers# vioplot 0.5.0 (2024) New features (pilot release with limited API and documentation) - adds function to annotate sample size per group - adds function to plot outliers by standard deviation magnitude threshold Updates to Violin plot - enable angled axis labels with srt.axis - pass axis aesthetic parameters from formula input Documentation - add demo of histogram plots (#19 by @Jadamso) - updated vignettes for split histograms (#19 by @Jadamso) - expands vignettes for annotated violins and annotated split violins Bug fixes - formula input detects group names but avoids overlapping axis labels # vioplot 0.4.0 (2022) New feature - adds feature for histograms in dedicated function discussed on GitHub issue #15 and PR #18 Documentation - adds vignette for histograms #18 - adds examples to overlay information with base R graphics discussed in issues #16 and #17 on GitHub - updates documentation for h parameter #14 Bug fixes - allow suppression of y-axes with `yaxt = 'n'` without disabing x-axes (should be independent parameter). Resolves unexpected behaviour reported on GitHub issue #16. - allow NA values when plotting repeated values resolves bug in #13 commit bd68db3c10ee5b8a550568f449fecd1d47a62197 # vioplot 0.3.7 (2021) Updates maintainer contact details. # vioplot 0.3.6 (2021) Bug fixes. - allow plotting repeated non-unique values over threshold number with checks #13 # vioplot 0.3.5 (2020) Bug fixes. - allow reuse of vector inputs - correct graphical paramters: xaxt, xlim - correct log scales (xlog) for horizontal violins - document axes labels for split violins # vioplot 0.3.4 (2019) Bug fixes. - avoids altering base plotting parameters `par()` - resolves issues calling log inputs without an explicit `log` parameter as text # vioplot 0.3.3 (2019) Minor release with improvements to passing parameters. - improved passing of base R plotting parameters - resolves issues with variable names and factor levels in formula inputs # vioplot 0.3.2 (2019) Minor release with improvements to passing parameters. - improved handling for formula input: levels for names and variable names for axes labels - improved passing of graphical parameters to title, and axis - axes for log-scale are automatically generated and horizontal plots are supported Examples for formula input added for convenience (this method is recommended). # vioplot 0.3.1 (2019) Minor release with continuous integration testing, improved vignettes, and License. Compatible with GitHub and CRAN Release. # vioplot 0.3.0 (2018) ## Major changes - formula inputs vioplot is now compatible with all inputs of boxplot or beanplot, including formula inputs (implemented as S3 methods). - plot customisation Various features of violins can be tweaked with plotting parameters, such as colours and shapes of aspects of the violin. These can be applied to all violins with a single (scalar) input or applied separately to each violin with multiple (vector) inputs - defaults This version is fully compatible with inputs to vioplot 0.2. The only difference in behaviour changing the default colour from a glaring magenta to a monochrome grey (more appropriate in a wider range of professional settings). Code written for previous versions should run without breaking or changes in behaviour apart from the default colour. vioplot/inst/0000755000176200001440000000000014641725510012730 5ustar liggesusersvioplot/inst/CITATION0000644000176200001440000000133314641725400014063 0ustar liggesuserscitHeader("To cite the enhanced vioplot package in publications use:") bibentry(bibtype = "Manual", title = "vioplot: violin plot", author = c(as.person("Daniel Adler"),as.person("S. Thomas Kelly"), as.person("Tom Elliott"), as.person("Jordan Adamson")), year = "2024", note = "R package version 0.5.0", url = "https://github.com/TomKellyGenetics/vioplot", textVersion = paste("Daniel Adler, S. Thomas Kelly, Tom Elliott, and Jordan Adamson (2024). vioplot: violin plot. R package version 0.5.0", "https://github.com/TomKellyGenetics/vioplot") ) citFooter(paste("Please also acknowledge the original package: \n citation(", "vioplot", ")", sep="\"")) vioplot/inst/doc/0000755000176200001440000000000014641725510013475 5ustar liggesusersvioplot/inst/doc/histogram_customisation.Rmd0000644000176200001440000002625314641611371021126 0ustar liggesusers--- title: "An alternative to Violin Plots with Histograms" author: "Tom Kelly, Jordan Adamson" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{vioplot: An alternative to Violin Plots with Histograms} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- While boxplots have become the _de facto_ standard for plotting the distribution of data this is a vast oversimplification and may not show everything needed to evaluate the variation of data. This is particularly important for datasets which do not form a Gaussian "Normal" distribution that most researchers have become accustomed to. While density plots are helpful in this regard, they can be less aesthetically pleasing than boxplots and harder to interpret for those familiar with boxplots. Often the only ways to compare multiple data types with density use slices of the data with faceting the plotting panes or overlaying density curves with colours and a legend. This approach is jarring for new users and leads to cluttered plots difficult to present to a wider audience. Therefore violin plots, density plots, and histograms are a powerful tool to assist researchers to visualise data, particularly in the quality checking and exploratory parts of an analysis. These plots have many benefits: - Greater flexibility for plotting variation than boxplots - More familiarity to boxplot users than density plots - Easier to directly compare data types than existing plots As shown below for the `iris` dataset, histogram plots show distribution information that the boxplot is unable to. ```{r} library("vioplot") ``` ```{r, message=FALSE, eval=FALSE} data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) library("vioplot") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) ``` ```{r, message=FALSE, echo=FALSE} data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="magenta") ``` ## Plot Defaults However as we can see here the plot defaults are not aesthetically pleasing, with a rather glaring colour scheme unsuitable for professional or academic usage. Thus the plot default colours have been changed as shown here: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") ``` # Histogram plot Here we introduce a variant of the violin plot, using a mirrored bihistogram to show the distribution: ```{r} histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") ``` ## Plot colours: Histogram Fill Plot colours can be further customised as with the original viooplot package using the `col` argument: ```{r} histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue") ``` ### Vectorisation The `vioplot` (0.2) function is unable to colour each histogram separately, thus this is enabled with a vectorised `col` in `viooplot` (0.3) and `histoplot` (0.4): ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) ``` ```{r} histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) ``` ## Plot colours: Violin Lines and Boxplot Colours can also be customised for the histogram fill and border separately using the `col` and `border` arguments: ```{r} histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue") ``` Similarly, the arguments `lineCol` and `rectCol` specify the colors of the boxplot outline and rectangle fill. For simplicity the box and whiskers of the boxplot will always have the same colour. ```{r} histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", rectCol="palevioletred", lineCol="violetred") ``` The same applies to the colour of the median point with `colMed`: ```{r} histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", colMed="violet") ``` ### Combined customisation These can be customised colours can be combined: ```{r} histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue", rectCol="palevioletred", lineCol="violetred", colMed="violet") ``` ### Vectorisation These color and shape settings can also be customised separately for each histogram: ```{r} histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T, col=c("lightgreen", "lightblue", "palevioletred"), border=c("darkolivegreen4", "royalblue4", "violetred4"), rectCol=c("forestgreen", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), colMed=c("green", "cyan", "magenta"), pchMed=c(15, 17, 19)) ``` ## Split Bihistogram Plots We set up the data with two categories (Sepal Width) as follows: ```{r, message=FALSE} data(iris) summary(iris$Sepal.Width) table(iris$Sepal.Width > mean(iris$Sepal.Width)) iris_large <- iris[iris$Sepal.Width > mean(iris$Sepal.Width), ] iris_small <- iris[iris$Sepal.Width <= mean(iris$Sepal.Width), ] ``` An indirect comparison can be achieved with par: ```{r, fig.align = 'center', fig.height = 6, fig.width = 6, fig.keep = 'last'} { par(mfrow=c(1,2)) histoplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line") histoplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line") par(mfrow=c(1,1)) } ``` A direct comparision of 2 datasets can be made with the `side` argument and `add = TRUE` on the second plot: ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} histoplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right") histoplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T) title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ``` ## Split Histogram Plots We set up the data with two categories (Sepal Width) as follows: ```{r, message=FALSE} data(iris) summary(iris$Sepal.Width) table(iris$Sepal.Width > mean(iris$Sepal.Width)) iris_large <- iris[iris$Sepal.Width > mean(iris$Sepal.Width), ] iris_small <- iris[iris$Sepal.Width <= mean(iris$Sepal.Width), ] ``` A more direct comparision can be made with the `side` argument and `add = TRUE` on the second plot: ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} histoplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right") histoplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T) title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ``` ## Fine tuning with split histograms #To compare multiple groups of histogram densities, it helps to adjust the wex. ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} dlist1 <- lapply(c(10,20,30,40), function(n) runif(n)) dlist2 <- lapply(c(100,200,300,400), function(n) runif(n)) hscale1 <- sapply(dlist1, function(r){ max(hist(r, plot=FALSE, breaks=seq(0,1,by=.05))$density)}) histoplot(dlist1, side='left', col=grey(.3), breaks=seq(0,1,by=.05), add=FALSE, pchMed=NA, drawRect=FALSE, border=NA, wex=hscale1/length(hscale1)) hscale2 <- sapply(dlist2, function(r){ max(hist(r, plot=FALSE, breaks=seq(0,1,by=.05))$density)}) histoplot(dlist2, side='right', col=grey(.7), breaks=seq(0,1,by=.05), add=TRUE, pchMed=NA, drawRect=FALSE, border=NA, wex=hscale2/length(hscale2)) ``` Sometimes, it is helpful to see the raw counts instead. ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} dvec <- length(unlist(c(dlist1, dlist2)))/4 histoplot(dlist1, side='left', col=grey(.3), breaks=seq(0,1,by=.05), add=FALSE, pchMed=NA, drawRect=FALSE, border=NA, wex=sapply(dlist1, length)/dvec*hscale1/length(hscale1)) histoplot(dlist2, side='right', col=grey(.7), breaks=seq(0,1,by=.05), add=TRUE, pchMed=NA, drawRect=FALSE, border=NA, wex=sapply(dlist2, length)/dvec*hscale2/length(hscale2)) ``` ### Shading histograms It may also benefit some users to pass density and angle arguments to the histograms (ultimately rect) and create outer legends. ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} hist(runif(100), density=c(10,20), angle=c(22,90+22) ,col=1) outer_legend <- function(...) { opar <- par(fig=c(0, 1, 0, 1), oma=c(0, 0, 0, 0), mar=c(0, 0, 0, 0), new=TRUE) on.exit(par(opar)) plot(0, 0, type='n', bty='n', xaxt='n', yaxt='n') legend(...) } outer_legend('topright', pch=15, density=c(10,20), angle=c(22,90+22), col=0, legend=c('Y','N')) ``` vioplot/inst/doc/histogram_formulae.html0000644000176200001440000021561214641725500020260 0ustar liggesusers Customising Histogram Plots with Formula Input

Customising Histogram Plots with Formula Input

Tom Kelly

2024-07-05

Since boxplots have become the de facto standard for plotting the distribution of data most users are familiar with these and the formula input for dataframes. However this input is not available in the standard histoplot package. Thus it has been restored here for enhanced backwards compatibility with boxplot.

As shown below for the iris dataset, histogram plots show distribution information taking formula input that boxplot implements but histoplot is unable to. This demonstrates the customisation demonstrated in the main histoplot vignette using histoplot syntax with the formula method commonly used for boxplot, t.test, and lm.

library("vioplot")
data(iris)
boxplot(Sepal.Length~Species, data = iris)

Whereas performing the same function does not work with vioplot (0.2).

devtools::install_version("vioplot", version = "0.2")
library("vioplot")
vioplot(Sepal.Length~Species, data = iris)
Error in min(data) : invalid 'type' (language) of argument

Plot Defaults

vioplot(Sepal.Length~Species, data = iris)

Another concern we see here is that the vioplot defaults are not aesthetically pleasing, with a rather glaring colour scheme unsuitable for professional or academic usage. Thus the plot default colours have been changed as shown here:

vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length")

Plot colours: Histogram Fill

Plot colours can be further customised as with the original vioplot package using the col argument:

histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue")

Vectorisation

However the vioplot (0.2) function is unable to colour each histogram separately, thus this is enabled with a vectorised col in histoplot (0.4):

histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred"))
legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5)

Plot colours: Violin Lines and Boxplot

Colours can also be customised for the histogram fill and border separately using the col and border arguments:

histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue", border="royalblue")

Similarly, the arguments lineCol and rectCol specify the colours of the boxplot outline and rectangle fill. For simplicity the box and whiskers of the boxplot will always have the same colour.

histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", rectCol="palevioletred", lineCol="violetred")

The same applies to the colour of the median point with colMed:

histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", colMed="violet")

### Combined customisation

These can be customised colours can be combined:

histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue", border="royalblue", rectCol="palevioletred", lineCol="violetred", colMed="violet")

Vectorisation

These colour and shape settings can also be customised separately for each histogram:

histoplot(Sepal.Length~Species, data = iris, main="Sepal Length", col=c("lightgreen", "lightblue", "palevioletred"), border=c("darkolivegreen4", "royalblue4", "violetred4"), rectCol=c("forestgreen", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), colMed=c("green", "cyan", "magenta"), pchMed=c(15, 17, 19))

Split Bihistogram Plots

We set up the data with two categories (Sepal Width) as follows:

data(iris)
summary(iris$Sepal.Width)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   2.000   2.800   3.000   3.057   3.300   4.400
table(iris$Sepal.Width > mean(iris$Sepal.Width))
## 
## FALSE  TRUE 
##    83    67
iris_large <- iris[iris$Sepal.Width > mean(iris$Sepal.Width), ]
iris_small <- iris[iris$Sepal.Width <= mean(iris$Sepal.Width), ]

A direct comparision of 2 datasets can be made with the side argument and add = TRUE on the second plot:

histoplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right")
histoplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T)
title(xlab = "Species", ylab = "Sepal Length")
legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width")

vioplot/inst/doc/violin_area.Rmd0000644000176200001440000001736014640410551016433 0ustar liggesusers--- title: "Controlling Violin Plot Area" author: "Tom Kelly" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{vioplot: Controlling Violin Plot Area} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- While boxplots have become the _de facto_ standard for plotting the distribution of data this is a vast oversimplification and may not show everything needed to evaluate the variation of data. This is particularly important for datasets which do not form a Gaussian "Normal" distribution that most researchers have become accustomed to. While density plots are helpful in this regard, they can be less aesthetically pleasing than boxplots and harder to interpret for those familiar with boxplots. Often the only ways to compare multiple data types with density use slices of the data with faceting the plotting panes or overlaying density curves with colours and a legend. This approach is jarring for new users and leads to cluttered plots difficult to present to a wider audience. ##Violin Plots Therefore violin plots are a powerful tool to assist researchers to visualise data, particularly in the quality checking and exploratory parts of an analysis. Violin plots have many benefits: - Greater flexibility for plotting variation than boxplots - More familiarity to boxplot users than density plots - Easier to directly compare data types than existing plots As shown below for the `iris` dataset, violin plots show distribution information that the boxplot is unable to. ```{r} library("vioplot") ``` ```{r, message=FALSE} data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) ``` ##Violin Plot Area However there are concerns that existing violin plot packages (such as \code{\link[vioplot]{vioplot}}) scales the data to the most aesthetically suitable width rather than maintaining proportions comparable across data sets. Consider the differing distributions shown below: ```{r, echo=FALSE, message=FALSE} par(mar=rep(1,4)) ``` ```{r} par(mfrow=c(3, 1)) par(mar=rep(2, 4)) plot(density(iris$Sepal.Length[iris$Species=="setosa"]), main="Sepal Length: setosa", col="green") plot(density(iris$Sepal.Length[iris$Species=="versicolor"]), main="Sepal Length: versicolor", col="blue") plot(density(iris$Sepal.Length[iris$Species=="virginica"]), main="Sepal Length: virginica", col="palevioletred4") par(mfrow=c(1, 1)) ``` ```{r, echo=FALSE, message=FALSE} par(mar=c(5, 4, 4, 2) + 0.1) ``` #Comparing datasets Neither of these plots above show the relative distribtions on the same scale, even if we match the x-axis of a density plot the relative heights are obscured and difficult to compare. ```{r, echo=FALSE, message=FALSE} par(mar=rep(2,4)) ``` ```{r} par(mfrow=c(3, 1)) par(mar=rep(2, 4)) xaxis <- c(3, 9) yaxis <- c(0, 1.25) plot(density(iris$Sepal.Length[iris$Species=="setosa"]), main="Sepal Length: setosa", col="green", xlim=xaxis, ylim=yaxis) plot(density(iris$Sepal.Length[iris$Species=="versicolor"]), main="Sepal Length: versicolor", col="blue", xlim=xaxis, ylim=yaxis) plot(density(iris$Sepal.Length[iris$Species=="virginica"]), main="Sepal Length: virginica", col="palevioletred4", xlim=xaxis, ylim=yaxis) par(mfrow=c(1, 1)) ``` ```{r, echo=FALSE, message=FALSE} par(mar=c(5, 4, 4, 2) + 0.1) ``` This can somewhat be addressed by overlaying density plots: ```{r} par(mfrow=c(1, 1)) xaxis <- c(3, 9) yaxis <- c(0, 1.25) plot(density(iris$Sepal.Length[iris$Species=="setosa"]), main="Sepal Length", col="green", xlim=xaxis, ylim=yaxis) lines(density(iris$Sepal.Length[iris$Species=="versicolor"]), col="blue") lines(density(iris$Sepal.Length[iris$Species=="virginica"]), col="palevioletred4") legend("topright", fill=c("green", "blue", "palevioletred4"), legend=levels(iris$Species), cex=0.5) ``` This has the benefit of highlighting the different distributions of the data subsets. However, notice here that a figure legend become necessary, plot axis limits need to be defined to display the range of all distribution curves, and the plot quickly becomes cluttered if the number of factors to be compared becomes much larger. ##Area control in Violin plot Therefore the `areaEqual` parameter has been added to customise the violin plot to serve a similar purpose: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", areaEqual = T) ``` If we compare this to the original vioplot functionality (defaulting to `areaEqual = FALSE`) the differences between the two are clear. ```{r, echo=FALSE, message=FALSE} par(mar=rep(2, 4)) ``` ```{r} par(mfrow=c(2,1)) par(mar=rep(2, 4)) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Width)", areaEqual = F) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T) par(mfrow=c(1,1)) ``` ```{r, echo=FALSE, message=FALSE} par(mar=c(5, 4, 4, 2) + 0.1) ``` Note that `areaEqual` is considering the full area of the density distribution before removing the outlier tails. We leave it up to the users discretion which they elect to use. The `areaEqual` functionality is compatible with all of the customisation used in discussed in [the main vioplot vignette](violin_customisation.html) ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T, col=c("lightgreen", "lightblue", "palevioletred"), rectCol=c("green", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), border=c("darkolivegreen4", "royalblue4", "violetred4")) ``` The violin width can further be scaled with `wex`, which maintains the proportions across the datasets if `areaEqual = TRUE`: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T, col=c("lightgreen", "lightblue", "palevioletred"), rectCol=c("green", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), border=c("darkolivegreen4", "royalblue4", "violetred4"), wex=1.25) ``` ## Comparing distributions Notice the utility of `areaEqual` for cases where different datasets have different underlying distributions: ```{r} vioplot(rnorm(200, 3, 0.5), rpois(200, 2.5), rbinom(100, 10, 0.4), rlnorm(200, 0, 0.5), rnbinom(200, 10, 0.9), rlogis(20, 0, 0.5), areaEqual = F, main="Equal Width", xlab="distribution", ylab="data value", names=c("normal", "poisson", "binomial", "log-normal", "neg-binomial", "logistic")) vioplot(rnorm(200, 3, 0.5), rpois(200, 2.5), rbinom(100, 10, 0.4), rlnorm(200, 0, 0.5), rnbinom(200, 10, 0.9), rlogis(20, 0, 0.5), areaEqual = T, main="Equal Area", xlab="distribution", ylab="data value", names=c("normal", "poisson", "binomial", "log-normal", "neg-binomial", "logistic")) ``` vioplot/inst/doc/histogram_formulae.Rmd0000644000176200001440000001221414640410551020023 0ustar liggesusers--- title: "Customising Histogram Plots with Formula Input" author: "Tom Kelly" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{histoplot: Customising Histogram Plots with Formula Input} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- Since boxplots have become the _de facto_ standard for plotting the distribution of data most users are familiar with these and the formula input for dataframes. However this input is not available in the standard `histoplot` package. Thus it has been restored here for enhanced backwards compatibility with `boxplot`. As shown below for the `iris` dataset, histogram plots show distribution information taking formula input that `boxplot` implements but `histoplot` is unable to. This demonstrates the customisation demonstrated in [the main histoplot vignette using histoplot syntax](histogram_customisation.html) with the formula method commonly used for `boxplot`, `t.test`, and `lm`. ```{r} library("vioplot") ``` ```{r, message=FALSE, eval=FALSE} data(iris) boxplot(Sepal.Length~Species, data = iris) ``` ```{r, message=FALSE, echo=FALSE} data(iris) boxplot(Sepal.Length~Species, data = iris, main = "Sepal Length") ``` Whereas performing the same function does not work with `vioplot` (0.2). ```{r, message=FALSE, eval=FALSE} devtools::install_version("vioplot", version = "0.2") library("vioplot") vioplot(Sepal.Length~Species, data = iris) ``` ``` Error in min(data) : invalid 'type' (language) of argument ``` ## Plot Defaults ```{r, message=FALSE, eval=FALSE} vioplot(Sepal.Length~Species, data = iris) ``` ```{r, message=FALSE, echo=FALSE} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="magenta") ``` Another concern we see here is that the `vioplot` defaults are not aesthetically pleasing, with a rather glaring colour scheme unsuitable for professional or academic usage. Thus the plot default colours have been changed as shown here: ```{r} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length") ``` ## Plot colours: Histogram Fill Plot colours can be further customised as with the original vioplot package using the `col` argument: ```{r} histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue") ``` ### Vectorisation However the `vioplot` (0.2) function is unable to colour each histogram separately, thus this is enabled with a vectorised `col` in `histoplot` (0.4): ```{r} histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) ``` ## Plot colours: Violin Lines and Boxplot Colours can also be customised for the histogram fill and border separately using the `col` and `border` arguments: ```{r} histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue", border="royalblue") ``` Similarly, the arguments `lineCol` and `rectCol` specify the colours of the boxplot outline and rectangle fill. For simplicity the box and whiskers of the boxplot will always have the same colour. ```{r} histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", rectCol="palevioletred", lineCol="violetred") ``` The same applies to the colour of the median point with `colMed`: ```{r} histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", colMed="violet") ``` ### Combined customisation These can be customised colours can be combined: ```{r} histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue", border="royalblue", rectCol="palevioletred", lineCol="violetred", colMed="violet") ``` ### Vectorisation These colour and shape settings can also be customised separately for each histogram: ```{r} histoplot(Sepal.Length~Species, data = iris, main="Sepal Length", col=c("lightgreen", "lightblue", "palevioletred"), border=c("darkolivegreen4", "royalblue4", "violetred4"), rectCol=c("forestgreen", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), colMed=c("green", "cyan", "magenta"), pchMed=c(15, 17, 19)) ``` ## Split Bihistogram Plots We set up the data with two categories (Sepal Width) as follows: ```{r, message=FALSE} data(iris) summary(iris$Sepal.Width) table(iris$Sepal.Width > mean(iris$Sepal.Width)) iris_large <- iris[iris$Sepal.Width > mean(iris$Sepal.Width), ] iris_small <- iris[iris$Sepal.Width <= mean(iris$Sepal.Width), ] ``` A direct comparision of 2 datasets can be made with the `side` argument and `add = TRUE` on the second plot: ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} histoplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right") histoplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T) title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ``` vioplot/inst/doc/violin_customisation.html0000644000176200001440000033536214641725503020662 0ustar liggesusers Customising Violin Plots

Customising Violin Plots

Tom Kelly

2024-07-05

While boxplots have become the de facto standard for plotting the distribution of data this is a vast oversimplification and may not show everything needed to evaluate the variation of data. This is particularly important for datasets which do not form a Gaussian “Normal” distribution that most researchers have become accustomed to.

While density plots are helpful in this regard, they can be less aesthetically pleasing than boxplots and harder to interpret for those familiar with boxplots. Often the only ways to compare multiple data types with density use slices of the data with faceting the plotting panes or overlaying density curves with colours and a legend. This approach is jarring for new users and leads to cluttered plots difficult to present to a wider audience.

Therefore violin plots are a powerful tool to assist researchers to visualise data, particularly in the quality checking and exploratory parts of an analysis. Violin plots have many benefits:

  • Greater flexibility for plotting variation than boxplots
  • More familiarity to boxplot users than density plots
  • Easier to directly compare data types than existing plots

As shown below for the iris dataset, violin plots show distribution information that the boxplot is unable to.

library("vioplot")
data(iris)
boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"))
library("vioplot")
vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"))

Plot Defaults

However as we can see here the plot defaults are not aesthetically pleasing, with a rather glaring colour scheme unsuitable for professional or academic usage. Thus the plot default colours have been changed as shown here:

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length")

Plot colours: Violin Fill

Plot colours can be further customised as with the original vioplot package using the col argument:

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue")

Vectorisation

However the vioplot (0.2) function is unable to colour each violin separately, thus this is enabled with a vectorised col in vioplot (0.3):

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred"))
legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5)

Plot colours: Violin Lines and Boxplot

Colours can also be customised for the violin fill and border separately using the col and border arguments:

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue")

Similarly, the arguments lineCol and rectCol specify the colors of the boxplot outline and rectangle fill. For simplicity the box and whiskers of the boxplot will always have the same colour.

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", rectCol="palevioletred", lineCol="violetred")

The same applies to the colour of the median point with colMed:

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", colMed="violet")

### Combined customisation

These can be customised colours can be combined:

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue", rectCol="palevioletred", lineCol="violetred", colMed="violet")

Vectorisation

These color and shape settings can also be customised separately for each violin:

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T, col=c("lightgreen", "lightblue", "palevioletred"), border=c("darkolivegreen4", "royalblue4", "violetred4"), rectCol=c("forestgreen", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), colMed=c("green", "cyan", "magenta"), pchMed=c(15, 17, 19))

This should be sufficient to customise the violin plot but further examples are given in the areaEqual vioplot vignette including how violin plots are useful for comparing variation when data does not follow the same distribution. This document also compares the violin plot with other established methods to plot data variation.

Enhanced Annotation

Here we demonstrate additional annotation features to display outliers and group sizes.

Labelling group size

Note that y-axes limits need to be adjusted to avoid overlaying text.

data("iris")
attach(iris)
vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], main = "Sepal Length", ylab = "",
        col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(0, max(Sepal.Length) * 1.1))
legend("bottomright", legend=c("setosa", "versicolor", "virginica"),
       fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.8)
add_labels(unlist(iris$Sepal.Length), iris$Species, height = 0.5, cex = 0.8)

#### Plotting outliers and medians

Here we add outliers and show annotation features.

# add outliers to demo data
iris2 <- iris
iris2 <- rbind(iris2, c(7, 1, 0, 0, "setosa"))
iris2 <- rbind(iris2, c(1, 10, 0, 0, "setosa"))
iris2 <- rbind(iris2, c(9, 2, 0, 0, "versicolor"))
iris2 <- rbind(iris2, c(2, 12, 0, 0, "versicolor"))
iris2 <- rbind(iris2, c(10, 1, 0, 0, "virginica"))
iris2 <- rbind(iris2, c(12, 7, 0, 0, "virginica"))
iris2$Species <- factor(iris2$Species)
iris2$Sepal.Length <- as.numeric(iris2$Sepal.Length)
iris2$Sepal.Width <- as.numeric(iris2$Sepal.Width)
table(iris2$Species)
## 
##     setosa versicolor  virginica 
##         52         52         52

This adds outliers to the plot.

attach(iris2)
## The following objects are masked from iris:
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
vioplot(iris2$Sepal.Length[iris$Species=="setosa"], iris2$Sepal.Length[iris$Species=="versicolor"], iris2$Sepal.Length[iris2$Species=="virginica"], main = "Sepal Length",
        col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1),
        names=c("setosa", "versicolor", "virginica"))
Sepal.medians <- sapply(unique(Species), function(sp) median(Sepal.Length[Species == sp]))
# highlights medians
points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2,
       col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4"))
# plots outliers above 2 SD
add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2,
             col = "black", bars = "grey85", lwd = 2,
             fill = c("palegreen3", "lightblue3", "palevioletred3"))
legend("bottomright", legend=c("setosa", "versicolor", "virginica"),
       fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6)
add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8)

Annotation on split violins are shown here. See the split violin plot vignette for details on these parameters.

data(iris)
summary(iris2$Sepal.Width)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   1.000   2.800   3.000   3.151   3.400  12.000
table(iris2$Sepal.Width > mean(iris2$Sepal.Width))
## 
## FALSE  TRUE 
##    97    59
iris_large <- iris2[iris2$Sepal.Width > mean(iris2$Sepal.Width), ]
iris_small <- iris2[iris2$Sepal.Width <= mean(iris2$Sepal.Width), ]

attach(iris_large)
## The following objects are masked from iris2:
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris:
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
vioplot(iris_large$Sepal.Length[iris_large$Species=="setosa"], iris_large$Sepal.Length[iris_large$Species=="versicolor"], iris_large$Sepal.Length[iris_large$Species=="virginica"], plotCentre = "line", side = "right", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(iris2$Sepal.Length) * 0.9, max(iris2$Sepal.Length) * 1.1),
        names=c("setosa", "versicolor", "virginica"))
Sepal.medians <- sapply(unique(Species), function(sp) median(iris_large$Sepal.Length[Species == sp]))
# highlights medians
points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2,
       col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4"))
# plots outliers above 2 SD
add_outliers(unlist(iris_large$Sepal.Length), iris2$Species, cutoff = 2,
             col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2,
             fill = "grey85")
legend("bottomright", legend=c("setosa", "versicolor", "virginica"),
       fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6)
add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8)

attach(iris_small)
## The following objects are masked from iris_large:
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris2:
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris:
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
vioplot(iris_small$Sepal.Length[iris_small$Species=="setosa"], iris_small$Sepal.Length[iris_small$Species=="versicolor"], iris_small$Sepal.Length[iris_small$Species=="virginica"], plotCentre = "line", side = "left", add = T, col=c("palegreen1", "lightblue1", "palevioletred1"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1),
        names=c("setosa", "versicolor", "virginica"))
## Warning in vioplot.default(iris_small$Sepal.Length[iris_small$Species == : Warning: names can only be changed on first call of vioplot (when add = FALSE)
Sepal.medians <- sapply(unique(Species), function(sp) median(iris_small$Sepal.Length[Species == sp]))
# highlights medians
points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2,
       col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4"))
# plots outliers above 2 SD
add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2,
             col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2,
             fill = "grey50")
legend("bottomright", legend=c("setosa", "versicolor", "virginica"),
       fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6)
add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8)

# add legend and titles
legend("topleft", fill = c("lightblue2", "lightblue3"), legend = c("small", "large"), title = "Sepal Width")
title(xlab = "Species", ylab = "Sepal Length")

vioplot/inst/doc/violin_area.R0000644000176200001440000001254314641725501016115 0ustar liggesusers## ----------------------------------------------------------------------------- library("vioplot") ## ----message=FALSE------------------------------------------------------------ data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) ## ----echo=FALSE, message=FALSE------------------------------------------------ par(mar=rep(1,4)) ## ----------------------------------------------------------------------------- par(mfrow=c(3, 1)) par(mar=rep(2, 4)) plot(density(iris$Sepal.Length[iris$Species=="setosa"]), main="Sepal Length: setosa", col="green") plot(density(iris$Sepal.Length[iris$Species=="versicolor"]), main="Sepal Length: versicolor", col="blue") plot(density(iris$Sepal.Length[iris$Species=="virginica"]), main="Sepal Length: virginica", col="palevioletred4") par(mfrow=c(1, 1)) ## ----echo=FALSE, message=FALSE------------------------------------------------ par(mar=c(5, 4, 4, 2) + 0.1) ## ----echo=FALSE, message=FALSE------------------------------------------------ par(mar=rep(2,4)) ## ----------------------------------------------------------------------------- par(mfrow=c(3, 1)) par(mar=rep(2, 4)) xaxis <- c(3, 9) yaxis <- c(0, 1.25) plot(density(iris$Sepal.Length[iris$Species=="setosa"]), main="Sepal Length: setosa", col="green", xlim=xaxis, ylim=yaxis) plot(density(iris$Sepal.Length[iris$Species=="versicolor"]), main="Sepal Length: versicolor", col="blue", xlim=xaxis, ylim=yaxis) plot(density(iris$Sepal.Length[iris$Species=="virginica"]), main="Sepal Length: virginica", col="palevioletred4", xlim=xaxis, ylim=yaxis) par(mfrow=c(1, 1)) ## ----echo=FALSE, message=FALSE------------------------------------------------ par(mar=c(5, 4, 4, 2) + 0.1) ## ----------------------------------------------------------------------------- par(mfrow=c(1, 1)) xaxis <- c(3, 9) yaxis <- c(0, 1.25) plot(density(iris$Sepal.Length[iris$Species=="setosa"]), main="Sepal Length", col="green", xlim=xaxis, ylim=yaxis) lines(density(iris$Sepal.Length[iris$Species=="versicolor"]), col="blue") lines(density(iris$Sepal.Length[iris$Species=="virginica"]), col="palevioletred4") legend("topright", fill=c("green", "blue", "palevioletred4"), legend=levels(iris$Species), cex=0.5) ## ----------------------------------------------------------------------------- vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", areaEqual = T) ## ----echo=FALSE, message=FALSE------------------------------------------------ par(mar=rep(2, 4)) ## ----------------------------------------------------------------------------- par(mfrow=c(2,1)) par(mar=rep(2, 4)) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Width)", areaEqual = F) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T) par(mfrow=c(1,1)) ## ----echo=FALSE, message=FALSE------------------------------------------------ par(mar=c(5, 4, 4, 2) + 0.1) ## ----------------------------------------------------------------------------- vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T, col=c("lightgreen", "lightblue", "palevioletred"), rectCol=c("green", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), border=c("darkolivegreen4", "royalblue4", "violetred4")) ## ----------------------------------------------------------------------------- vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T, col=c("lightgreen", "lightblue", "palevioletred"), rectCol=c("green", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), border=c("darkolivegreen4", "royalblue4", "violetred4"), wex=1.25) ## ----------------------------------------------------------------------------- vioplot(rnorm(200, 3, 0.5), rpois(200, 2.5), rbinom(100, 10, 0.4), rlnorm(200, 0, 0.5), rnbinom(200, 10, 0.9), rlogis(20, 0, 0.5), areaEqual = F, main="Equal Width", xlab="distribution", ylab="data value", names=c("normal", "poisson", "binomial", "log-normal", "neg-binomial", "logistic")) vioplot(rnorm(200, 3, 0.5), rpois(200, 2.5), rbinom(100, 10, 0.4), rlnorm(200, 0, 0.5), rnbinom(200, 10, 0.9), rlogis(20, 0, 0.5), areaEqual = T, main="Equal Area", xlab="distribution", ylab="data value", names=c("normal", "poisson", "binomial", "log-normal", "neg-binomial", "logistic")) vioplot/inst/doc/violin_ylog.Rmd0000644000176200001440000001043114640410551016465 0ustar liggesusers--- title: "Controlling y-axis Plotting" author: "Tom Kelly" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{vioplot: Controlling y-axis Plotting} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- While boxplots have become the _de facto_ standard for plotting the distribution of data this is a vast oversimplification and may not show everything needed to evaluate the variation of data. This is particularly important for datasets which do not form a Gaussian "Normal" distribution that most researchers have become accustomed to. While density plots are helpful in this regard, they can be less aesthetically pleasing than boxplots and harder to interpret for those familiar with boxplots. Often the only ways to compare multiple data types with density use slices of the data with faceting the plotting panes or overlaying density curves with colours and a legend. This approach is jarring for new users and leads to cluttered plots difficult to present to a wider audience. ##Violin Plots Therefore violin plots are a powerful tool to assist researchers to visualise data, particularly in the quality checking and exploratory parts of an analysis. Violin plots have many benefits: - Greater flexibility for plotting variation than boxplots - More familiarity to boxplot users than density plots - Easier to directly compare data types than existing plots As shown below for the `iris` dataset, violin plots show distribution information that the boxplot is unable to. ```{r} library("vioplot") ``` ```{r, message=FALSE} data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) ``` ##Violin y-axis ###Logarithmic scale However the existing violin plot packages (such as \code{\link[vioplot]{vioplot}}) do not support log-scale of the y-axis. This has been amended with the `ylog` argument. ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", ylog = T, ylim=c(log(1), log(10))) ``` This can also be invoked with the `log="y"` argument compatible with `boxplot`: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = T, ylim=c(log(1), log(10))) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = "y", ylim=c(log(1), log(10))) ``` ###custom y-axes The y-axes can also be removed with `yaxt="n"` to enable customised y-axes: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", yaxt="n") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", ylog = T, yaxt="n", ylim=c(log(1), log(10))) ``` Thus custom axes can be added to violin plots. As shown on a linear scale: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", yaxt="n") axis(2, at=1:10, labels=1:10) ``` As well as for on a log scale: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", yaxt="n", log="y", ylim=c(log(4), log(9))) axis(2, at=log(1:10), labels=1:10) ``` vioplot/inst/doc/violin_split.Rmd0000644000176200001440000002601314641625552016663 0ustar liggesusers--- title: "Split Violin Plots" author: "Tom Kelly" date: "`r Sys.Date()`" output: rmarkdown::html_vignette fig_width: 6 fig_height: 3 fig_align: 'center' fig_keep: 'last' vignette: > %\VignetteIndexEntry{vioplot: Split Violin Plots} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ##Violin Plots Therefore violin plots are a powerful tool to assist researchers to visualise data, particularly in the quality checking and exploratory parts of an analysis. Violin plots have many benefits: - Greater flexibility for plotting variation than boxplots - More familiarity to boxplot users than density plots - Easier to directly compare data types than existing plots As shown below for the `iris` dataset, violin plots show distribution information that the boxplot is unable to. ###General Set up ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} library("vioplot") ``` We set up the data with two categories (Sepal Width) as follows: ```{r, message=FALSE} data(iris) summary(iris$Sepal.Width) table(iris$Sepal.Width > mean(iris$Sepal.Width)) iris_large <- iris[iris$Sepal.Width > mean(iris$Sepal.Width), ] iris_small <- iris[iris$Sepal.Width <= mean(iris$Sepal.Width), ] ``` ###Boxplots First we plot Sepal Length on its own: ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} boxplot(Sepal.Length~Species, data=iris, col="grey") ``` An indirect comparison can be achieved with par: ```{r, fig.align = 'center', fig.height = 6, fig.width = 6, fig.keep = 'last'} { par(mfrow=c(2,1)) boxplot(Sepal.Length~Species, data=iris_small, col = "lightblue") boxplot(Sepal.Length~Species, data=iris_large, col = "palevioletred") par(mfrow=c(1,1)) } ``` ### Violin Plots First we plot Sepal Length on its own: ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} vioplot(Sepal.Length~Species, data=iris) ``` An indirect comparison can be achieved with par: ```{r, fig.align = 'center', fig.height = 6, fig.width = 6, fig.keep = 'last'} { par(mfrow=c(2,1)) vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line") vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line") par(mfrow=c(1,1)) } ``` An indirect comparison can be achieved with par: ```{r, fig.align = 'center', fig.height = 6, fig.width = 6, fig.keep = 'last'} { par(mfrow=c(1,2)) vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line") vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line") par(mfrow=c(1,1)) } ``` ### Split Violin Plots A more direct comparision can be made with the `side` argument and `add = TRUE` on the second plot: ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right") vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T) title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ``` #### Custom axes labels Custom axes labels are supported for split violin plots. However, you must use these arguments on the *first* call of `vioplot`. ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right", xlab = "Iris species", ylab = "Length", main = "Sepals", names=paste("Iris", levels(iris$Species))) vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T) legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Width") ``` Note that this is disabled for the second `vioplot` call to avoid overlaying labels. ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right") vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T, xlab = "Iris species", ylab = "Length", main = "Sepals", names=paste("Iris", levels(iris$Species))) legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Width") ``` #### Median The line median option is more suitable for side by side comparisions but the point option is still available also: ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "point", side = "right", pchMed = 21, colMed = "palevioletred4", colMed2 = "palevioletred2") vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "point", side = "left", pchMed = 21, colMed = "lightblue4", colMed2 = "lightblue2", add = T) title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ``` It may be necessary to include a `points` command to fix the median being overwritten by the following plots: ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "point", side = "right", pchMed = 21, colMed = "palevioletred4", colMed2 = "palevioletred2") vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "point", side = "left", pchMed = 21, colMed = "lightblue4", colMed2 = "lightblue2", add = T) points(1:length(levels(iris$Species)), as.numeric(sapply(levels(iris$Species), function(species) median(iris_large[grep(species, iris_large$Species),]$Sepal.Length))), pch = 21, col = "palevioletred4", bg = "palevioletred2") title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ``` Similarly points could be added where a line has been used previously: ```{r, fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'} vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right", pchMed = 21, colMed = "palevioletred4", colMed2 = "palevioletred2") vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", pchMed = 21, colMed = "lightblue4", colMed2 = "lightblue2", add = T) points(1:length(levels(iris$Species)), as.numeric(sapply(levels(iris$Species), function(species) median(iris_large[grep(species, iris_large$Species),]$Sepal.Length))), pch = 21, col = "palevioletred4", bg = "palevioletred2") points(1:length(levels(iris$Species)), as.numeric(sapply(levels(iris$Species), function(species) median(iris_small[grep(species, iris_small$Species),]$Sepal.Length))), pch = 21, col = "lightblue4", bg = "lightblue2") title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ``` Here it is aesthetically pleasing and intuitive to interpret categorical differences in mean and variation in a continuous variable. ### Enchanced annotation demonstration. Here we add outliers and show annotation features. ```{r, warning=FALSE} # add outliers to demo data iris2 <- iris iris2 <- rbind(iris2, c(7, 1, 0, 0, "setosa")) iris2 <- rbind(iris2, c(1, 10, 0, 0, "setosa")) iris2 <- rbind(iris2, c(9, 2, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(2, 12, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(10, 1, 0, 0, "virginica")) iris2 <- rbind(iris2, c(12, 7, 0, 0, "virginica")) iris2$Species <- factor(iris2$Species) iris2$Sepal.Length <- as.numeric(iris2$Sepal.Length) iris2$Sepal.Width <- as.numeric(iris2$Sepal.Width) table(iris2$Species) ``` Annotation on split violins are shown here. See the main violin plot vignette for details on these parameters. ```{r, fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'} data(iris) summary(iris2$Sepal.Width) table(iris2$Sepal.Width > mean(iris2$Sepal.Width)) iris_large <- iris2[iris2$Sepal.Width > mean(iris2$Sepal.Width), ] iris_small <- iris2[iris2$Sepal.Width <= mean(iris2$Sepal.Width), ] attach(iris_large) vioplot(Sepal.Length~Species, data=iris_large, plotCentre = "line", side = "right", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(iris2$Sepal.Length) * 0.9, max(iris2$Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(iris_large$Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris_large$Sepal.Length), iris2$Species, cutoff = 2, col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2, fill = "grey85") legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("palegreen3", "lightblue3", "palevioletred3"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) attach(iris_small) vioplot(Sepal.Length~Species, data=iris_small, plotCentre = "line", side = "left", add = T, col=c("palegreen1", "lightblue1", "palevioletred1"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(iris_small$Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2, col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2, fill = "grey50") legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) # add legend and titles legend("topleft", fill = c("lightblue2", "lightblue3"), legend = c("small", "large"), title = "Sepal Width") title(xlab = "Species", ylab = "Sepal Length") ``` #### Sources These extensions to `vioplot` here are based on those provided here: * https://gist.github.com/mbjoseph/5852613 These have previously been discussed on the following sites: * https://mbjoseph.github.io/posts/2018-12-23-split-violin-plots/ * http://tagteam.harvard.edu/hub_feeds/1981/feed_items/209875 * [https://www.r-bloggers.com/split-violin-plots/](https://www.r-bloggers.com/2013/06/split-violin-plots/) vioplot/inst/doc/histogram_formulae.R0000644000176200001440000000700414641725500017507 0ustar liggesusers## ----------------------------------------------------------------------------- library("vioplot") ## ----message=FALSE, eval=FALSE------------------------------------------------ # data(iris) # boxplot(Sepal.Length~Species, data = iris) ## ----message=FALSE, echo=FALSE------------------------------------------------ data(iris) boxplot(Sepal.Length~Species, data = iris, main = "Sepal Length") ## ----message=FALSE, eval=FALSE------------------------------------------------ # devtools::install_version("vioplot", version = "0.2") # library("vioplot") # vioplot(Sepal.Length~Species, data = iris) ## ----message=FALSE, eval=FALSE------------------------------------------------ # vioplot(Sepal.Length~Species, data = iris) ## ----message=FALSE, echo=FALSE------------------------------------------------ vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="magenta") ## ----------------------------------------------------------------------------- vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length") ## ----------------------------------------------------------------------------- histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue") ## ----------------------------------------------------------------------------- histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) ## ----------------------------------------------------------------------------- histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue", border="royalblue") ## ----------------------------------------------------------------------------- histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", rectCol="palevioletred", lineCol="violetred") ## ----------------------------------------------------------------------------- histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", colMed="violet") ## ----------------------------------------------------------------------------- histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue", border="royalblue", rectCol="palevioletred", lineCol="violetred", colMed="violet") ## ----------------------------------------------------------------------------- histoplot(Sepal.Length~Species, data = iris, main="Sepal Length", col=c("lightgreen", "lightblue", "palevioletred"), border=c("darkolivegreen4", "royalblue4", "violetred4"), rectCol=c("forestgreen", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), colMed=c("green", "cyan", "magenta"), pchMed=c(15, 17, 19)) ## ----message=FALSE------------------------------------------------------------ data(iris) summary(iris$Sepal.Width) table(iris$Sepal.Width > mean(iris$Sepal.Width)) iris_large <- iris[iris$Sepal.Width > mean(iris$Sepal.Width), ] iris_small <- iris[iris$Sepal.Width <= mean(iris$Sepal.Width), ] ## ----fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'---- histoplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right") histoplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T) title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") vioplot/inst/doc/violin_split.html0000644000176200001440000041207214641725506017111 0ustar liggesusers Split Violin Plots

Split Violin Plots

Tom Kelly

2024-07-05

##Violin Plots

Therefore violin plots are a powerful tool to assist researchers to visualise data, particularly in the quality checking and exploratory parts of an analysis. Violin plots have many benefits:

  • Greater flexibility for plotting variation than boxplots
  • More familiarity to boxplot users than density plots
  • Easier to directly compare data types than existing plots

As shown below for the iris dataset, violin plots show distribution information that the boxplot is unable to.

###General Set up

library("vioplot")

We set up the data with two categories (Sepal Width) as follows:

data(iris)
summary(iris$Sepal.Width)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   2.000   2.800   3.000   3.057   3.300   4.400
table(iris$Sepal.Width > mean(iris$Sepal.Width))
## 
## FALSE  TRUE 
##    83    67
iris_large <- iris[iris$Sepal.Width > mean(iris$Sepal.Width), ]
iris_small <- iris[iris$Sepal.Width <= mean(iris$Sepal.Width), ]

###Boxplots

First we plot Sepal Length on its own:

boxplot(Sepal.Length~Species, data=iris, col="grey")

An indirect comparison can be achieved with par:

{
  par(mfrow=c(2,1))
boxplot(Sepal.Length~Species, data=iris_small, col = "lightblue")
boxplot(Sepal.Length~Species, data=iris_large, col = "palevioletred")
par(mfrow=c(1,1))
}

Violin Plots

First we plot Sepal Length on its own:

vioplot(Sepal.Length~Species, data=iris)

An indirect comparison can be achieved with par:

{
  par(mfrow=c(2,1))
vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line")
vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line")
par(mfrow=c(1,1))
}

An indirect comparison can be achieved with par:

{
  par(mfrow=c(1,2))
vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line")
vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line")
par(mfrow=c(1,1))
}

Split Violin Plots

A more direct comparision can be made with the side argument and add = TRUE on the second plot:

vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right")
vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T)
title(xlab = "Species", ylab = "Sepal Length")
legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width")

Custom axes labels

Custom axes labels are supported for split violin plots. However, you must use these arguments on the first call of vioplot.

vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right", xlab = "Iris species", ylab = "Length", main = "Sepals", names=paste("Iris", levels(iris$Species)))
vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T)
legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Width")

Note that this is disabled for the second vioplot call to avoid overlaying labels.

vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right")
vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T, xlab = "Iris species", ylab = "Length", main = "Sepals", names=paste("Iris", levels(iris$Species)))
## Warning in vioplot.formula(Sepal.Length ~ Species, data = iris_small, col = "lightblue", : Warning: names can only be changed on first call of vioplot (when add = FALSE)
## Warning in vioplot.formula(Sepal.Length ~ Species, data = iris_small, col = "lightblue", : Warning: x-axis labels can only be changed on first call of vioplot (when add = FALSE)
## Warning in vioplot.formula(Sepal.Length ~ Species, data = iris_small, col = "lightblue", : Warning: y-axis labels can only be changed on first call of vioplot (when add = FALSE)
## Warning in vioplot.default(x, ...): Warning: names can only be changed on first call of vioplot (when add = FALSE)
legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Width")

Median

The line median option is more suitable for side by side comparisions but the point option is still available also:

vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "point", side = "right", pchMed = 21, colMed = "palevioletred4", colMed2 = "palevioletred2")
vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "point", side = "left", pchMed = 21, colMed = "lightblue4", colMed2 = "lightblue2", add = T)
title(xlab = "Species", ylab = "Sepal Length")
legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width")

It may be necessary to include a points command to fix the median being overwritten by the following plots:

vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "point", side = "right", pchMed = 21, colMed = "palevioletred4", colMed2 = "palevioletred2")
vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "point", side = "left", pchMed = 21, colMed = "lightblue4", colMed2 = "lightblue2", add = T)
points(1:length(levels(iris$Species)), as.numeric(sapply(levels(iris$Species), function(species) median(iris_large[grep(species, iris_large$Species),]$Sepal.Length))), pch = 21, col = "palevioletred4", bg = "palevioletred2")
title(xlab = "Species", ylab = "Sepal Length")
legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width")

Similarly points could be added where a line has been used previously:

vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right", pchMed = 21, colMed = "palevioletred4", colMed2 = "palevioletred2")
vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", pchMed = 21, colMed = "lightblue4", colMed2 = "lightblue2", add = T)
points(1:length(levels(iris$Species)), as.numeric(sapply(levels(iris$Species), function(species) median(iris_large[grep(species, iris_large$Species),]$Sepal.Length))), pch = 21, col = "palevioletred4", bg = "palevioletred2")
points(1:length(levels(iris$Species)), as.numeric(sapply(levels(iris$Species), function(species) median(iris_small[grep(species, iris_small$Species),]$Sepal.Length))), pch = 21, col = "lightblue4", bg = "lightblue2")
title(xlab = "Species", ylab = "Sepal Length")
legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width")

Here it is aesthetically pleasing and intuitive to interpret categorical differences in mean and variation in a continuous variable.

Enchanced annotation demonstration.

Here we add outliers and show annotation features.

# add outliers to demo data
iris2 <- iris
iris2 <- rbind(iris2, c(7, 1, 0, 0, "setosa"))
iris2 <- rbind(iris2, c(1, 10, 0, 0, "setosa"))
iris2 <- rbind(iris2, c(9, 2, 0, 0, "versicolor"))
iris2 <- rbind(iris2, c(2, 12, 0, 0, "versicolor"))
iris2 <- rbind(iris2, c(10, 1, 0, 0, "virginica"))
iris2 <- rbind(iris2, c(12, 7, 0, 0, "virginica"))
iris2$Species <- factor(iris2$Species)
iris2$Sepal.Length <- as.numeric(iris2$Sepal.Length)
iris2$Sepal.Width <- as.numeric(iris2$Sepal.Width)
table(iris2$Species)
## 
##     setosa versicolor  virginica 
##         52         52         52

Annotation on split violins are shown here. See the main violin plot vignette for details on these parameters.

data(iris)
summary(iris2$Sepal.Width)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   1.000   2.800   3.000   3.151   3.400  12.000
table(iris2$Sepal.Width > mean(iris2$Sepal.Width))
## 
## FALSE  TRUE 
##    97    59
iris_large <- iris2[iris2$Sepal.Width > mean(iris2$Sepal.Width), ]
iris_small <- iris2[iris2$Sepal.Width <= mean(iris2$Sepal.Width), ]

attach(iris_large)
## The following objects are masked from iris_small (pos = 3):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris_large (pos = 4):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris2 (pos = 5):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris (pos = 6):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris_small (pos = 7):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris_large (pos = 8):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris2 (pos = 9):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris (pos = 10):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
vioplot(Sepal.Length~Species, data=iris_large, plotCentre = "line", side = "right", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(iris2$Sepal.Length) * 0.9, max(iris2$Sepal.Length) * 1.1),
        names=c("setosa", "versicolor", "virginica"))
Sepal.medians <- sapply(unique(Species), function(sp) median(iris_large$Sepal.Length[Species == sp]))
# highlights medians
points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2,
       col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4"))
# plots outliers above 2 SD
add_outliers(unlist(iris_large$Sepal.Length), iris2$Species, cutoff = 2,
             col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2,
             fill = "grey85")
legend("bottomright", legend=c("setosa", "versicolor", "virginica"),
       fill=c("palegreen3", "lightblue3", "palevioletred3"), cex = 0.6)
add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8)

attach(iris_small)
## The following objects are masked from iris_large (pos = 3):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris_small (pos = 4):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris_large (pos = 5):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris2 (pos = 6):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris (pos = 7):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris_small (pos = 8):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris_large (pos = 9):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris2 (pos = 10):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris (pos = 11):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
vioplot(Sepal.Length~Species, data=iris_small, plotCentre = "line", side = "left", add = T, col=c("palegreen1", "lightblue1", "palevioletred1"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1),
        names=c("setosa", "versicolor", "virginica"))
## Warning in vioplot.formula(Sepal.Length ~ Species, data = iris_small, plotCentre = "line", : Warning: names can only be changed on first call of vioplot (when add = FALSE)
## Warning in vioplot.default(x, ...): Warning: names can only be changed on first call of vioplot (when add = FALSE)
Sepal.medians <- sapply(unique(Species), function(sp) median(iris_small$Sepal.Length[Species == sp]))
# highlights medians
points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2,
       col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4"))
# plots outliers above 2 SD
add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2,
             col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2,
             fill = "grey50")
legend("bottomright", legend=c("setosa", "versicolor", "virginica"),
       fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6)
add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8)

# add legend and titles
legend("topleft", fill = c("lightblue2", "lightblue3"), legend = c("small", "large"), title = "Sepal Width")
title(xlab = "Species", ylab = "Sepal Length")

Sources

These extensions to vioplot here are based on those provided here:

These have previously been discussed on the following sites:

vioplot/inst/doc/violin_area.html0000644000176200001440000023736214641725502016671 0ustar liggesusers Controlling Violin Plot Area

Controlling Violin Plot Area

Tom Kelly

2024-07-05

While boxplots have become the de facto standard for plotting the distribution of data this is a vast oversimplification and may not show everything needed to evaluate the variation of data. This is particularly important for datasets which do not form a Gaussian “Normal” distribution that most researchers have become accustomed to.

While density plots are helpful in this regard, they can be less aesthetically pleasing than boxplots and harder to interpret for those familiar with boxplots. Often the only ways to compare multiple data types with density use slices of the data with faceting the plotting panes or overlaying density curves with colours and a legend. This approach is jarring for new users and leads to cluttered plots difficult to present to a wider audience.

##Violin Plots

Therefore violin plots are a powerful tool to assist researchers to visualise data, particularly in the quality checking and exploratory parts of an analysis. Violin plots have many benefits:

  • Greater flexibility for plotting variation than boxplots
  • More familiarity to boxplot users than density plots
  • Easier to directly compare data types than existing plots

As shown below for the iris dataset, violin plots show distribution information that the boxplot is unable to.

library("vioplot")
data(iris)
boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"))

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"))

##Violin Plot Area

However there are concerns that existing violin plot packages (such as ) scales the data to the most aesthetically suitable width rather than maintaining proportions comparable across data sets. Consider the differing distributions shown below:

par(mfrow=c(3, 1))
par(mar=rep(2, 4))
plot(density(iris$Sepal.Length[iris$Species=="setosa"]), main="Sepal Length: setosa", col="green")
plot(density(iris$Sepal.Length[iris$Species=="versicolor"]), main="Sepal Length: versicolor", col="blue")
plot(density(iris$Sepal.Length[iris$Species=="virginica"]), main="Sepal Length: virginica", col="palevioletred4")

par(mfrow=c(1, 1))

#Comparing datasets

Neither of these plots above show the relative distribtions on the same scale, even if we match the x-axis of a density plot the relative heights are obscured and difficult to compare.

par(mfrow=c(3, 1))
par(mar=rep(2, 4))
xaxis <- c(3, 9)
yaxis <- c(0, 1.25)
plot(density(iris$Sepal.Length[iris$Species=="setosa"]), main="Sepal Length: setosa", col="green", xlim=xaxis, ylim=yaxis)
plot(density(iris$Sepal.Length[iris$Species=="versicolor"]), main="Sepal Length: versicolor", col="blue", xlim=xaxis, ylim=yaxis)
plot(density(iris$Sepal.Length[iris$Species=="virginica"]), main="Sepal Length: virginica", col="palevioletred4", xlim=xaxis, ylim=yaxis)

par(mfrow=c(1, 1))

This can somewhat be addressed by overlaying density plots:

par(mfrow=c(1, 1))
xaxis <- c(3, 9)
yaxis <- c(0, 1.25)
plot(density(iris$Sepal.Length[iris$Species=="setosa"]), main="Sepal Length", col="green", xlim=xaxis, ylim=yaxis)
lines(density(iris$Sepal.Length[iris$Species=="versicolor"]), col="blue")
lines(density(iris$Sepal.Length[iris$Species=="virginica"]), col="palevioletred4")
legend("topright", fill=c("green", "blue", "palevioletred4"), legend=levels(iris$Species), cex=0.5)

This has the benefit of highlighting the different distributions of the data subsets. However, notice here that a figure legend become necessary, plot axis limits need to be defined to display the range of all distribution curves, and the plot quickly becomes cluttered if the number of factors to be compared becomes much larger.

##Area control in Violin plot

Therefore the areaEqual parameter has been added to customise the violin plot to serve a similar purpose:

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", areaEqual = T)

If we compare this to the original vioplot functionality (defaulting to areaEqual = FALSE) the differences between the two are clear.

par(mfrow=c(2,1))
par(mar=rep(2, 4))
vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Width)", areaEqual = F)
vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T)

par(mfrow=c(1,1))

Note that areaEqual is considering the full area of the density distribution before removing the outlier tails. We leave it up to the users discretion which they elect to use. The areaEqual functionality is compatible with all of the customisation used in discussed in the main vioplot vignette

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T, col=c("lightgreen", "lightblue", "palevioletred"), rectCol=c("green", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), border=c("darkolivegreen4", "royalblue4", "violetred4"))

The violin width can further be scaled with wex, which maintains the proportions across the datasets if areaEqual = TRUE:

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T, col=c("lightgreen", "lightblue", "palevioletred"), rectCol=c("green", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), border=c("darkolivegreen4", "royalblue4", "violetred4"), wex=1.25)

Comparing distributions

Notice the utility of areaEqual for cases where different datasets have different underlying distributions:

vioplot(rnorm(200, 3, 0.5), rpois(200, 2.5),  rbinom(100, 10, 0.4), rlnorm(200, 0, 0.5), rnbinom(200, 10, 0.9), rlogis(20, 0, 0.5), areaEqual = F, main="Equal Width", xlab="distribution", ylab="data value", names=c("normal", "poisson", "binomial", "log-normal", "neg-binomial", "logistic"))

vioplot(rnorm(200, 3, 0.5), rpois(200, 2.5),  rbinom(100, 10, 0.4), rlnorm(200, 0, 0.5), rnbinom(200, 10, 0.9), rlogis(20, 0, 0.5), areaEqual = T, main="Equal Area", xlab="distribution", ylab="data value", names=c("normal", "poisson", "binomial", "log-normal", "neg-binomial", "logistic"))

vioplot/inst/doc/violin_customisation.R0000644000176200001440000002233614641725503020111 0ustar liggesusers## ----------------------------------------------------------------------------- library("vioplot") ## ----message=FALSE, eval=FALSE------------------------------------------------ # data(iris) # boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) # library("vioplot") # vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) ## ----message=FALSE, echo=FALSE------------------------------------------------ data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="magenta") ## ----------------------------------------------------------------------------- vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") ## ----------------------------------------------------------------------------- vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue") ## ----------------------------------------------------------------------------- vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) ## ----------------------------------------------------------------------------- vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue") ## ----------------------------------------------------------------------------- vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", rectCol="palevioletred", lineCol="violetred") ## ----------------------------------------------------------------------------- vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", colMed="violet") ## ----------------------------------------------------------------------------- vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue", rectCol="palevioletred", lineCol="violetred", colMed="violet") ## ----------------------------------------------------------------------------- vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T, col=c("lightgreen", "lightblue", "palevioletred"), border=c("darkolivegreen4", "royalblue4", "violetred4"), rectCol=c("forestgreen", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), colMed=c("green", "cyan", "magenta"), pchMed=c(15, 17, 19)) ## ----fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'---- data("iris") attach(iris) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], main = "Sepal Length", ylab = "", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(0, max(Sepal.Length) * 1.1)) legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.8) add_labels(unlist(iris$Sepal.Length), iris$Species, height = 0.5, cex = 0.8) ## ----warning=FALSE------------------------------------------------------------ # add outliers to demo data iris2 <- iris iris2 <- rbind(iris2, c(7, 1, 0, 0, "setosa")) iris2 <- rbind(iris2, c(1, 10, 0, 0, "setosa")) iris2 <- rbind(iris2, c(9, 2, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(2, 12, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(10, 1, 0, 0, "virginica")) iris2 <- rbind(iris2, c(12, 7, 0, 0, "virginica")) iris2$Species <- factor(iris2$Species) iris2$Sepal.Length <- as.numeric(iris2$Sepal.Length) iris2$Sepal.Width <- as.numeric(iris2$Sepal.Width) table(iris2$Species) ## ----fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'---- attach(iris2) vioplot(iris2$Sepal.Length[iris$Species=="setosa"], iris2$Sepal.Length[iris$Species=="versicolor"], iris2$Sepal.Length[iris2$Species=="virginica"], main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2, col = "black", bars = "grey85", lwd = 2, fill = c("palegreen3", "lightblue3", "palevioletred3")) legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) ## ----fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'---- data(iris) summary(iris2$Sepal.Width) table(iris2$Sepal.Width > mean(iris2$Sepal.Width)) iris_large <- iris2[iris2$Sepal.Width > mean(iris2$Sepal.Width), ] iris_small <- iris2[iris2$Sepal.Width <= mean(iris2$Sepal.Width), ] attach(iris_large) vioplot(iris_large$Sepal.Length[iris_large$Species=="setosa"], iris_large$Sepal.Length[iris_large$Species=="versicolor"], iris_large$Sepal.Length[iris_large$Species=="virginica"], plotCentre = "line", side = "right", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(iris2$Sepal.Length) * 0.9, max(iris2$Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(iris_large$Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris_large$Sepal.Length), iris2$Species, cutoff = 2, col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2, fill = "grey85") legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) attach(iris_small) vioplot(iris_small$Sepal.Length[iris_small$Species=="setosa"], iris_small$Sepal.Length[iris_small$Species=="versicolor"], iris_small$Sepal.Length[iris_small$Species=="virginica"], plotCentre = "line", side = "left", add = T, col=c("palegreen1", "lightblue1", "palevioletred1"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(iris_small$Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2, col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2, fill = "grey50") legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) # add legend and titles legend("topleft", fill = c("lightblue2", "lightblue3"), legend = c("small", "large"), title = "Sepal Width") title(xlab = "Species", ylab = "Sepal Length") vioplot/inst/doc/violin_ylog.html0000644000176200001440000013554014641725507016733 0ustar liggesusers Controlling y-axis Plotting

Controlling y-axis Plotting

Tom Kelly

2024-07-05

While boxplots have become the de facto standard for plotting the distribution of data this is a vast oversimplification and may not show everything needed to evaluate the variation of data. This is particularly important for datasets which do not form a Gaussian “Normal” distribution that most researchers have become accustomed to.

While density plots are helpful in this regard, they can be less aesthetically pleasing than boxplots and harder to interpret for those familiar with boxplots. Often the only ways to compare multiple data types with density use slices of the data with faceting the plotting panes or overlaying density curves with colours and a legend. This approach is jarring for new users and leads to cluttered plots difficult to present to a wider audience.

##Violin Plots

Therefore violin plots are a powerful tool to assist researchers to visualise data, particularly in the quality checking and exploratory parts of an analysis. Violin plots have many benefits:

  • Greater flexibility for plotting variation than boxplots
  • More familiarity to boxplot users than density plots
  • Easier to directly compare data types than existing plots

As shown below for the iris dataset, violin plots show distribution information that the boxplot is unable to.

library("vioplot")
data(iris)
boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"))

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"))

##Violin y-axis

###Logarithmic scale

However the existing violin plot packages (such as ) do not support log-scale of the y-axis. This has been amended with the ylog argument.

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", ylog = T, ylim=c(log(1), log(10)))
## Warning in plot.window(xlim, ylim, log = log, asp = asp, bty = bty, cex = cex,
## : nonfinite axis=2 limits [GScale(-inf,0.362216,..); log=TRUE] -- corrected now
## Warning in plot.window(xlim, ylim, log = log, asp = asp, bty = bty, cex = cex,
## : nonfinite axis=2 limits [GScale(-inf,0.362216,..); log=TRUE] -- corrected now

This can also be invoked with the log="y" argument compatible with boxplot:

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = T, ylim=c(log(1), log(10)))
vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = "y", ylim=c(log(1), log(10)))

###custom y-axes

The y-axes can also be removed with yaxt="n" to enable customised y-axes:

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", yaxt="n")

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", ylog = T, yaxt="n", ylim=c(log(1), log(10)))
## Warning in plot.window(xlim, ylim, log = log, asp = asp, bty = bty, cex = cex,
## : nonfinite axis=2 limits [GScale(-inf,0.362216,..); log=TRUE] -- corrected now
## Warning in plot.window(xlim, ylim, log = log, asp = asp, bty = bty, cex = cex,
## : nonfinite axis=2 limits [GScale(-inf,0.362216,..); log=TRUE] -- corrected now

Thus custom axes can be added to violin plots. As shown on a linear scale:

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", yaxt="n")
axis(2, at=1:10, labels=1:10)

As well as for on a log scale:

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", yaxt="n", log="y", ylim=c(log(4), log(9)))
axis(2, at=log(1:10), labels=1:10)

vioplot/inst/doc/histogram_customisation.html0000644000176200001440000035677414641725477021403 0ustar liggesusers An alternative to Violin Plots with Histograms

An alternative to Violin Plots with Histograms

Tom Kelly, Jordan Adamson

2024-07-05

While boxplots have become the de facto standard for plotting the distribution of data this is a vast oversimplification and may not show everything needed to evaluate the variation of data. This is particularly important for datasets which do not form a Gaussian “Normal” distribution that most researchers have become accustomed to.

While density plots are helpful in this regard, they can be less aesthetically pleasing than boxplots and harder to interpret for those familiar with boxplots. Often the only ways to compare multiple data types with density use slices of the data with faceting the plotting panes or overlaying density curves with colours and a legend. This approach is jarring for new users and leads to cluttered plots difficult to present to a wider audience.

Therefore violin plots, density plots, and histograms are a powerful tool to assist researchers to visualise data, particularly in the quality checking and exploratory parts of an analysis. These plots have many benefits:

  • Greater flexibility for plotting variation than boxplots
  • More familiarity to boxplot users than density plots
  • Easier to directly compare data types than existing plots

As shown below for the iris dataset, histogram plots show distribution information that the boxplot is unable to.

library("vioplot")
## Loading required package: sm
## Package 'sm', version 2.2-6.0: type help(sm) for summary information
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
data(iris)
boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"))
library("vioplot")
vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"))

Plot Defaults

However as we can see here the plot defaults are not aesthetically pleasing, with a rather glaring colour scheme unsuitable for professional or academic usage. Thus the plot default colours have been changed as shown here:

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length")

Histogram plot

Here we introduce a variant of the violin plot, using a mirrored bihistogram to show the distribution:

histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length")

Plot colours: Histogram Fill

Plot colours can be further customised as with the original viooplot package using the col argument:

histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue")

Vectorisation

The vioplot (0.2) function is unable to colour each histogram separately, thus this is enabled with a vectorised col in viooplot (0.3) and histoplot (0.4):

vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred"))
legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5)

histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred"))
legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5)

Plot colours: Violin Lines and Boxplot

Colours can also be customised for the histogram fill and border separately using the col and border arguments:

histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue")

Similarly, the arguments lineCol and rectCol specify the colors of the boxplot outline and rectangle fill. For simplicity the box and whiskers of the boxplot will always have the same colour.

histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", rectCol="palevioletred", lineCol="violetred")

The same applies to the colour of the median point with colMed:

histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", colMed="violet")

### Combined customisation

These can be customised colours can be combined:

histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue", rectCol="palevioletred", lineCol="violetred", colMed="violet")

Vectorisation

These color and shape settings can also be customised separately for each histogram:

histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T, col=c("lightgreen", "lightblue", "palevioletred"), border=c("darkolivegreen4", "royalblue4", "violetred4"), rectCol=c("forestgreen", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), colMed=c("green", "cyan", "magenta"), pchMed=c(15, 17, 19))

Split Bihistogram Plots

We set up the data with two categories (Sepal Width) as follows:

data(iris)
summary(iris$Sepal.Width)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   2.000   2.800   3.000   3.057   3.300   4.400
table(iris$Sepal.Width > mean(iris$Sepal.Width))
## 
## FALSE  TRUE 
##    83    67
iris_large <- iris[iris$Sepal.Width > mean(iris$Sepal.Width), ]
iris_small <- iris[iris$Sepal.Width <= mean(iris$Sepal.Width), ]

An indirect comparison can be achieved with par:

{
  par(mfrow=c(1,2))
histoplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line")
histoplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line")
par(mfrow=c(1,1))
}

A direct comparision of 2 datasets can be made with the side argument and add = TRUE on the second plot:

histoplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right")
histoplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T)
title(xlab = "Species", ylab = "Sepal Length")
legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width")

Split Histogram Plots

We set up the data with two categories (Sepal Width) as follows:

data(iris)
summary(iris$Sepal.Width)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   2.000   2.800   3.000   3.057   3.300   4.400
table(iris$Sepal.Width > mean(iris$Sepal.Width))
## 
## FALSE  TRUE 
##    83    67
iris_large <- iris[iris$Sepal.Width > mean(iris$Sepal.Width), ]
iris_small <- iris[iris$Sepal.Width <= mean(iris$Sepal.Width), ]

A more direct comparision can be made with the side argument and add = TRUE on the second plot:

histoplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right")
histoplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T)
title(xlab = "Species", ylab = "Sepal Length")
legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width")

Fine tuning with split histograms

#To compare multiple groups of histogram densities, it helps to adjust the wex.

dlist1 <- lapply(c(10,20,30,40), function(n) runif(n))
dlist2 <- lapply(c(100,200,300,400), function(n) runif(n))

hscale1 <- sapply(dlist1, function(r){
  max(hist(r, plot=FALSE, breaks=seq(0,1,by=.05))$density)})
histoplot(dlist1, side='left', col=grey(.3),
          breaks=seq(0,1,by=.05), add=FALSE, pchMed=NA, drawRect=FALSE, border=NA,
          wex=hscale1/length(hscale1))
hscale2 <- sapply(dlist2, function(r){
  max(hist(r, plot=FALSE, breaks=seq(0,1,by=.05))$density)})
histoplot(dlist2, side='right', col=grey(.7),
          breaks=seq(0,1,by=.05), add=TRUE, pchMed=NA, drawRect=FALSE, border=NA,
          wex=hscale2/length(hscale2))

Sometimes, it is helpful to see the raw counts instead.

dvec <- length(unlist(c(dlist1, dlist2)))/4

histoplot(dlist1, side='left', col=grey(.3),
          breaks=seq(0,1,by=.05), add=FALSE, pchMed=NA, drawRect=FALSE, border=NA,
          wex=sapply(dlist1, length)/dvec*hscale1/length(hscale1))
histoplot(dlist2, side='right', col=grey(.7),
          breaks=seq(0,1,by=.05), add=TRUE, pchMed=NA, drawRect=FALSE, border=NA,
          wex=sapply(dlist2, length)/dvec*hscale2/length(hscale2))

### Shading histograms

It may also benefit some users to pass density and angle arguments to the histograms (ultimately rect) and create outer legends.

hist(runif(100), density=c(10,20), angle=c(22,90+22) ,col=1)

outer_legend <- function(...) {
  opar <- par(fig=c(0, 1, 0, 1), oma=c(0, 0, 0, 0), mar=c(0, 0, 0, 0), new=TRUE)
  on.exit(par(opar))
  plot(0, 0, type='n', bty='n', xaxt='n', yaxt='n')
  legend(...)
}
outer_legend('topright', pch=15, density=c(10,20), angle=c(22,90+22), col=0, legend=c('Y','N'))

vioplot/inst/doc/overlaying_annotations.R0000644000176200001440000000353714641725500020423 0ustar liggesusers## ----------------------------------------------------------------------------- # generate dummy data a <- rnorm(25, 3, 0.5) b <- rnorm(25, 2, 1.0) c <- rnorm(25, 2.75, 0.25) d <- rnorm(25, 3.15, 0.375) e <- rnorm(25, 1, 0.25) datamat <- cbind(a, b, c, d, e) dim(datamat) ## ----------------------------------------------------------------------------- library("vioplot") ## ----------------------------------------------------------------------------- vioplot(datamat, ylim = c(0, 5)) # compute medians data.med <- apply(datamat, 2, median) data.med #overlay medians lines(data.med, lty = 2, lwd = 1.5) points(data.med, pch = 19, col = "red", cex = 2.25) ## ----------------------------------------------------------------------------- outcome <- c(rnorm(25, 3, 1), rnorm(25, 2, 0.5)) intervention <- c(rep("treatment", 25), rep("control", 25)) table(intervention) names(table(intervention)) unique(sort(intervention)) intervention <- as.factor(intervention) levels(intervention) d <- data.frame(outcome, intervention) vioplot(outcome ~ intervention, data = d, xaxt = 'n', yaxt = 'n', main = "", xlab = "", ylab = "") axis(side = 1, at = 1:length(levels(intervention)), labels = levels(intervention)) mtext("custom x labels for intervention", side = 1) mtext("custom y labels for outcome", side = 2) title(main = "example with custom title", sub = "subtitles are supported") ## ----------------------------------------------------------------------------- histoplot(outcome ~ intervention, data = d, xaxt = 'n', yaxt = 'n', main = "", xlab = "", ylab = "") axis(side = 1, at = 1:length(levels(intervention)), labels = levels(intervention)) mtext("custom x labels for intervention", side = 1) mtext("custom y labels for outcome", side = 2) title(main = "example with custom title", sub = "subtitles are supported") vioplot/inst/doc/violin_customisation.Rmd0000644000176200001440000002766014641625405020437 0ustar liggesusers--- title: "Customising Violin Plots" author: "Tom Kelly" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{vioplot: Customising Violin Plots} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- While boxplots have become the _de facto_ standard for plotting the distribution of data this is a vast oversimplification and may not show everything needed to evaluate the variation of data. This is particularly important for datasets which do not form a Gaussian "Normal" distribution that most researchers have become accustomed to. While density plots are helpful in this regard, they can be less aesthetically pleasing than boxplots and harder to interpret for those familiar with boxplots. Often the only ways to compare multiple data types with density use slices of the data with faceting the plotting panes or overlaying density curves with colours and a legend. This approach is jarring for new users and leads to cluttered plots difficult to present to a wider audience. Therefore violin plots are a powerful tool to assist researchers to visualise data, particularly in the quality checking and exploratory parts of an analysis. Violin plots have many benefits: - Greater flexibility for plotting variation than boxplots - More familiarity to boxplot users than density plots - Easier to directly compare data types than existing plots As shown below for the `iris` dataset, violin plots show distribution information that the boxplot is unable to. ```{r} library("vioplot") ``` ```{r, message=FALSE, eval=FALSE} data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) library("vioplot") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) ``` ```{r, message=FALSE, echo=FALSE} data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="magenta") ``` ## Plot Defaults However as we can see here the plot defaults are not aesthetically pleasing, with a rather glaring colour scheme unsuitable for professional or academic usage. Thus the plot default colours have been changed as shown here: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") ``` ## Plot colours: Violin Fill Plot colours can be further customised as with the original vioplot package using the `col` argument: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue") ``` ### Vectorisation However the `vioplot` (0.2) function is unable to colour each violin separately, thus this is enabled with a vectorised `col` in `vioplot` (0.3): ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) ``` ## Plot colours: Violin Lines and Boxplot Colours can also be customised for the violin fill and border separately using the `col` and `border` arguments: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue") ``` Similarly, the arguments `lineCol` and `rectCol` specify the colors of the boxplot outline and rectangle fill. For simplicity the box and whiskers of the boxplot will always have the same colour. ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", rectCol="palevioletred", lineCol="violetred") ``` The same applies to the colour of the median point with `colMed`: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", colMed="violet") ``` ### Combined customisation These can be customised colours can be combined: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue", rectCol="palevioletred", lineCol="violetred", colMed="violet") ``` ### Vectorisation These color and shape settings can also be customised separately for each violin: ```{r} vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T, col=c("lightgreen", "lightblue", "palevioletred"), border=c("darkolivegreen4", "royalblue4", "violetred4"), rectCol=c("forestgreen", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), colMed=c("green", "cyan", "magenta"), pchMed=c(15, 17, 19)) ``` This should be sufficient to customise the violin plot but further examples are given in [the areaEqual vioplot vignette](violin_area.html) including how violin plots are useful for comparing variation when data does not follow the same distribution. This document also compares the violin plot with other established methods to plot data variation. ### Enhanced Annotation Here we demonstrate additional annotation features to display outliers and group sizes. #### Labelling group size Note that y-axes limits need to be adjusted to avoid overlaying text. ```{r, fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'} data("iris") attach(iris) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], main = "Sepal Length", ylab = "", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(0, max(Sepal.Length) * 1.1)) legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.8) add_labels(unlist(iris$Sepal.Length), iris$Species, height = 0.5, cex = 0.8) ``` #### Plotting outliers and medians Here we add outliers and show annotation features. ```{r, warning=FALSE} # add outliers to demo data iris2 <- iris iris2 <- rbind(iris2, c(7, 1, 0, 0, "setosa")) iris2 <- rbind(iris2, c(1, 10, 0, 0, "setosa")) iris2 <- rbind(iris2, c(9, 2, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(2, 12, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(10, 1, 0, 0, "virginica")) iris2 <- rbind(iris2, c(12, 7, 0, 0, "virginica")) iris2$Species <- factor(iris2$Species) iris2$Sepal.Length <- as.numeric(iris2$Sepal.Length) iris2$Sepal.Width <- as.numeric(iris2$Sepal.Width) table(iris2$Species) ``` This adds outliers to the plot. ```{r, fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'} attach(iris2) vioplot(iris2$Sepal.Length[iris$Species=="setosa"], iris2$Sepal.Length[iris$Species=="versicolor"], iris2$Sepal.Length[iris2$Species=="virginica"], main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2, col = "black", bars = "grey85", lwd = 2, fill = c("palegreen3", "lightblue3", "palevioletred3")) legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) ``` Annotation on split violins are shown here. See the split violin plot vignette for details on these parameters. ```{r, fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'} data(iris) summary(iris2$Sepal.Width) table(iris2$Sepal.Width > mean(iris2$Sepal.Width)) iris_large <- iris2[iris2$Sepal.Width > mean(iris2$Sepal.Width), ] iris_small <- iris2[iris2$Sepal.Width <= mean(iris2$Sepal.Width), ] attach(iris_large) vioplot(iris_large$Sepal.Length[iris_large$Species=="setosa"], iris_large$Sepal.Length[iris_large$Species=="versicolor"], iris_large$Sepal.Length[iris_large$Species=="virginica"], plotCentre = "line", side = "right", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(iris2$Sepal.Length) * 0.9, max(iris2$Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(iris_large$Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris_large$Sepal.Length), iris2$Species, cutoff = 2, col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2, fill = "grey85") legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) attach(iris_small) vioplot(iris_small$Sepal.Length[iris_small$Species=="setosa"], iris_small$Sepal.Length[iris_small$Species=="versicolor"], iris_small$Sepal.Length[iris_small$Species=="virginica"], plotCentre = "line", side = "left", add = T, col=c("palegreen1", "lightblue1", "palevioletred1"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(iris_small$Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2, col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2, fill = "grey50") legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) # add legend and titles legend("topleft", fill = c("lightblue2", "lightblue3"), legend = c("small", "large"), title = "Sepal Width") title(xlab = "Species", ylab = "Sepal Length") ``` vioplot/inst/doc/violin_formulae.R0000644000176200001440000001646714641725505017034 0ustar liggesusers## ----------------------------------------------------------------------------- library("vioplot") ## ----message=FALSE, eval=FALSE------------------------------------------------ # data(iris) # boxplot(Sepal.Length~Species, data = iris) ## ----message=FALSE, echo=FALSE------------------------------------------------ data(iris) boxplot(Sepal.Length~Species, data = iris, main = "Sepal Length") ## ----message=FALSE, eval=FALSE------------------------------------------------ # devtools::install_version("vioplot", version = "0.2") # library("vioplot") # vioplot(Sepal.Length~Species, data = iris) ## ----message=FALSE, eval=FALSE------------------------------------------------ # vioplot(Sepal.Length~Species, data = iris) ## ----message=FALSE, echo=FALSE------------------------------------------------ vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="magenta") ## ----------------------------------------------------------------------------- vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length") ## ----------------------------------------------------------------------------- vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue") ## ----------------------------------------------------------------------------- vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) ## ----------------------------------------------------------------------------- vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue", border="royalblue") ## ----------------------------------------------------------------------------- vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", rectCol="palevioletred", lineCol="violetred") ## ----------------------------------------------------------------------------- vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", colMed="violet") ## ----------------------------------------------------------------------------- vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue", border="royalblue", rectCol="palevioletred", lineCol="violetred", colMed="violet") ## ----------------------------------------------------------------------------- vioplot(Sepal.Length~Species, data = iris, main="Sepal Length", col=c("lightgreen", "lightblue", "palevioletred"), border=c("darkolivegreen4", "royalblue4", "violetred4"), rectCol=c("forestgreen", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), colMed=c("green", "cyan", "magenta"), pchMed=c(15, 17, 19)) ## ----fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'---- data("iris") attach(iris) vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", ylab = "", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(0, max(Sepal.Length) * 1.1)) legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.8) add_labels(unlist(iris$Sepal.Length), iris$Species, height = 0.5, cex = 0.8) ## ----warning=FALSE------------------------------------------------------------ # add outliers to demo data iris2 <- iris iris2 <- rbind(iris2, c(7, 1, 0, 0, "setosa")) iris2 <- rbind(iris2, c(1, 10, 0, 0, "setosa")) iris2 <- rbind(iris2, c(9, 2, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(2, 12, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(10, 1, 0, 0, "virginica")) iris2 <- rbind(iris2, c(12, 7, 0, 0, "virginica")) iris2$Species <- factor(iris2$Species) iris2$Sepal.Length <- as.numeric(iris2$Sepal.Length) iris2$Sepal.Width <- as.numeric(iris2$Sepal.Width) table(iris2$Species) ## ----fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'---- attach(iris2) vioplot(Sepal.Length~Species, data = iris2, main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1)) Sepal.medians <- sapply(unique(Species), function(sp) median(Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2, col = "black", bars = "grey85", lwd = 2, fill = c("palegreen3", "lightblue3", "palevioletred3")) legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) ## ----fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'---- data(iris) summary(iris2$Sepal.Width) table(iris2$Sepal.Width > mean(iris2$Sepal.Width)) iris_large <- iris2[iris2$Sepal.Width > mean(iris2$Sepal.Width), ] iris_small <- iris2[iris2$Sepal.Width <= mean(iris2$Sepal.Width), ] attach(iris_large) vioplot(Sepal.Length~Species, data=iris_large, plotCentre = "line", side = "right", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(iris2$Sepal.Length) * 0.9, max(iris2$Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(iris_large$Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris_large$Sepal.Length), iris2$Species, cutoff = 2, col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2, fill = "grey85") legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("palegreen3", "lightblue3", "palevioletred3"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) attach(iris_small) vioplot(Sepal.Length~Species, data=iris_small, plotCentre = "line", side = "left", add = T, col=c("palegreen1", "lightblue1", "palevioletred1"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(iris_small$Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2, col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2, fill = "grey50") legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) # add legend and titles legend("topleft", fill = c("lightblue2", "lightblue3"), legend = c("small", "large"), title = "Sepal Width") title(xlab = "Species", ylab = "Sepal Length") vioplot/inst/doc/violin_split.R0000644000176200001440000002072614641725506016347 0ustar liggesusers## ----fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'---- library("vioplot") ## ----message=FALSE------------------------------------------------------------ data(iris) summary(iris$Sepal.Width) table(iris$Sepal.Width > mean(iris$Sepal.Width)) iris_large <- iris[iris$Sepal.Width > mean(iris$Sepal.Width), ] iris_small <- iris[iris$Sepal.Width <= mean(iris$Sepal.Width), ] ## ----fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'---- boxplot(Sepal.Length~Species, data=iris, col="grey") ## ----fig.align = 'center', fig.height = 6, fig.width = 6, fig.keep = 'last'---- { par(mfrow=c(2,1)) boxplot(Sepal.Length~Species, data=iris_small, col = "lightblue") boxplot(Sepal.Length~Species, data=iris_large, col = "palevioletred") par(mfrow=c(1,1)) } ## ----fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'---- vioplot(Sepal.Length~Species, data=iris) ## ----fig.align = 'center', fig.height = 6, fig.width = 6, fig.keep = 'last'---- { par(mfrow=c(2,1)) vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line") vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line") par(mfrow=c(1,1)) } ## ----fig.align = 'center', fig.height = 6, fig.width = 6, fig.keep = 'last'---- { par(mfrow=c(1,2)) vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line") vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line") par(mfrow=c(1,1)) } ## ----fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'---- vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right") vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T) title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ## ----fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'---- vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right", xlab = "Iris species", ylab = "Length", main = "Sepals", names=paste("Iris", levels(iris$Species))) vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T) legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Width") ## ----fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'---- vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right") vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T, xlab = "Iris species", ylab = "Length", main = "Sepals", names=paste("Iris", levels(iris$Species))) legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Width") ## ----fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'---- vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "point", side = "right", pchMed = 21, colMed = "palevioletred4", colMed2 = "palevioletred2") vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "point", side = "left", pchMed = 21, colMed = "lightblue4", colMed2 = "lightblue2", add = T) title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ## ----fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'---- vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "point", side = "right", pchMed = 21, colMed = "palevioletred4", colMed2 = "palevioletred2") vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "point", side = "left", pchMed = 21, colMed = "lightblue4", colMed2 = "lightblue2", add = T) points(1:length(levels(iris$Species)), as.numeric(sapply(levels(iris$Species), function(species) median(iris_large[grep(species, iris_large$Species),]$Sepal.Length))), pch = 21, col = "palevioletred4", bg = "palevioletred2") title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ## ----fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'---- vioplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right", pchMed = 21, colMed = "palevioletred4", colMed2 = "palevioletred2") vioplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", pchMed = 21, colMed = "lightblue4", colMed2 = "lightblue2", add = T) points(1:length(levels(iris$Species)), as.numeric(sapply(levels(iris$Species), function(species) median(iris_large[grep(species, iris_large$Species),]$Sepal.Length))), pch = 21, col = "palevioletred4", bg = "palevioletred2") points(1:length(levels(iris$Species)), as.numeric(sapply(levels(iris$Species), function(species) median(iris_small[grep(species, iris_small$Species),]$Sepal.Length))), pch = 21, col = "lightblue4", bg = "lightblue2") title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ## ----warning=FALSE------------------------------------------------------------ # add outliers to demo data iris2 <- iris iris2 <- rbind(iris2, c(7, 1, 0, 0, "setosa")) iris2 <- rbind(iris2, c(1, 10, 0, 0, "setosa")) iris2 <- rbind(iris2, c(9, 2, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(2, 12, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(10, 1, 0, 0, "virginica")) iris2 <- rbind(iris2, c(12, 7, 0, 0, "virginica")) iris2$Species <- factor(iris2$Species) iris2$Sepal.Length <- as.numeric(iris2$Sepal.Length) iris2$Sepal.Width <- as.numeric(iris2$Sepal.Width) table(iris2$Species) ## ----fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'---- data(iris) summary(iris2$Sepal.Width) table(iris2$Sepal.Width > mean(iris2$Sepal.Width)) iris_large <- iris2[iris2$Sepal.Width > mean(iris2$Sepal.Width), ] iris_small <- iris2[iris2$Sepal.Width <= mean(iris2$Sepal.Width), ] attach(iris_large) vioplot(Sepal.Length~Species, data=iris_large, plotCentre = "line", side = "right", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(iris2$Sepal.Length) * 0.9, max(iris2$Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(iris_large$Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris_large$Sepal.Length), iris2$Species, cutoff = 2, col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2, fill = "grey85") legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("palegreen3", "lightblue3", "palevioletred3"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) attach(iris_small) vioplot(Sepal.Length~Species, data=iris_small, plotCentre = "line", side = "left", add = T, col=c("palegreen1", "lightblue1", "palevioletred1"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(iris_small$Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2, col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2, fill = "grey50") legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) # add legend and titles legend("topleft", fill = c("lightblue2", "lightblue3"), legend = c("small", "large"), title = "Sepal Width") title(xlab = "Species", ylab = "Sepal Length") vioplot/inst/doc/histogram_customisation.R0000644000176200001440000002065214641725477020617 0ustar liggesusers## ----------------------------------------------------------------------------- library("vioplot") ## ----message=FALSE, eval=FALSE------------------------------------------------ # data(iris) # boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) # library("vioplot") # vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) ## ----message=FALSE, echo=FALSE------------------------------------------------ data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="magenta") ## ----------------------------------------------------------------------------- vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") ## ----------------------------------------------------------------------------- histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length") ## ----------------------------------------------------------------------------- histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue") ## ----------------------------------------------------------------------------- vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) ## ----------------------------------------------------------------------------- histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) ## ----------------------------------------------------------------------------- histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue") ## ----------------------------------------------------------------------------- histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", rectCol="palevioletred", lineCol="violetred") ## ----------------------------------------------------------------------------- histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", colMed="violet") ## ----------------------------------------------------------------------------- histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main = "Sepal Length", col="lightblue", border="royalblue", rectCol="palevioletred", lineCol="violetred", colMed="violet") ## ----------------------------------------------------------------------------- histoplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length (Equal Area)", areaEqual = T, col=c("lightgreen", "lightblue", "palevioletred"), border=c("darkolivegreen4", "royalblue4", "violetred4"), rectCol=c("forestgreen", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), colMed=c("green", "cyan", "magenta"), pchMed=c(15, 17, 19)) ## ----message=FALSE------------------------------------------------------------ data(iris) summary(iris$Sepal.Width) table(iris$Sepal.Width > mean(iris$Sepal.Width)) iris_large <- iris[iris$Sepal.Width > mean(iris$Sepal.Width), ] iris_small <- iris[iris$Sepal.Width <= mean(iris$Sepal.Width), ] ## ----fig.align = 'center', fig.height = 6, fig.width = 6, fig.keep = 'last'---- { par(mfrow=c(1,2)) histoplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line") histoplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line") par(mfrow=c(1,1)) } ## ----fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'---- histoplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right") histoplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T) title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ## ----message=FALSE------------------------------------------------------------ data(iris) summary(iris$Sepal.Width) table(iris$Sepal.Width > mean(iris$Sepal.Width)) iris_large <- iris[iris$Sepal.Width > mean(iris$Sepal.Width), ] iris_small <- iris[iris$Sepal.Width <= mean(iris$Sepal.Width), ] ## ----fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'---- histoplot(Sepal.Length~Species, data=iris_large, col = "palevioletred", plotCentre = "line", side = "right") histoplot(Sepal.Length~Species, data=iris_small, col = "lightblue", plotCentre = "line", side = "left", add = T) title(xlab = "Species", ylab = "Sepal Length") legend("topleft", fill = c("lightblue", "palevioletred"), legend = c("small", "large"), title = "Sepal Width") ## ----fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'---- dlist1 <- lapply(c(10,20,30,40), function(n) runif(n)) dlist2 <- lapply(c(100,200,300,400), function(n) runif(n)) hscale1 <- sapply(dlist1, function(r){ max(hist(r, plot=FALSE, breaks=seq(0,1,by=.05))$density)}) histoplot(dlist1, side='left', col=grey(.3), breaks=seq(0,1,by=.05), add=FALSE, pchMed=NA, drawRect=FALSE, border=NA, wex=hscale1/length(hscale1)) hscale2 <- sapply(dlist2, function(r){ max(hist(r, plot=FALSE, breaks=seq(0,1,by=.05))$density)}) histoplot(dlist2, side='right', col=grey(.7), breaks=seq(0,1,by=.05), add=TRUE, pchMed=NA, drawRect=FALSE, border=NA, wex=hscale2/length(hscale2)) ## ----fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'---- dvec <- length(unlist(c(dlist1, dlist2)))/4 histoplot(dlist1, side='left', col=grey(.3), breaks=seq(0,1,by=.05), add=FALSE, pchMed=NA, drawRect=FALSE, border=NA, wex=sapply(dlist1, length)/dvec*hscale1/length(hscale1)) histoplot(dlist2, side='right', col=grey(.7), breaks=seq(0,1,by=.05), add=TRUE, pchMed=NA, drawRect=FALSE, border=NA, wex=sapply(dlist2, length)/dvec*hscale2/length(hscale2)) ## ----fig.align = 'center', fig.height = 3, fig.width = 6, fig.keep = 'last'---- hist(runif(100), density=c(10,20), angle=c(22,90+22) ,col=1) outer_legend <- function(...) { opar <- par(fig=c(0, 1, 0, 1), oma=c(0, 0, 0, 0), mar=c(0, 0, 0, 0), new=TRUE) on.exit(par(opar)) plot(0, 0, type='n', bty='n', xaxt='n', yaxt='n') legend(...) } outer_legend('topright', pch=15, density=c(10,20), angle=c(22,90+22), col=0, legend=c('Y','N')) vioplot/inst/doc/violin_formulae.Rmd0000644000176200001440000002222614641625352017342 0ustar liggesusers--- title: "Customising Violin Plots with Formula Input" author: "Tom Kelly" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{vioplot: Customising Violin Plots with Formula Input} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- Since boxplots have become the _de facto_ standard for plotting the distribution of data most users are familiar with these and the formula input for dataframes. However this input is not available in the standard `vioplot` package. Thus it has been restored here for enhanced backwards compatibility with `boxplot`. As shown below for the `iris` dataset, violin plots show distribution information taking formula input that `boxplot` implements but `vioplot` is unable to. This demonstrates the customisation demonstrated in [the main vioplot vignette using vioplot syntax](violin_customisation.html) with the formula method commonly used for `boxplot`, `t.test`, and `lm`. ```{r} library("vioplot") ``` ```{r, message=FALSE, eval=FALSE} data(iris) boxplot(Sepal.Length~Species, data = iris) ``` ```{r, message=FALSE, echo=FALSE} data(iris) boxplot(Sepal.Length~Species, data = iris, main = "Sepal Length") ``` Whereas performing the same function does not work with `vioplot` (0.2). ```{r, message=FALSE, eval=FALSE} devtools::install_version("vioplot", version = "0.2") library("vioplot") vioplot(Sepal.Length~Species, data = iris) ``` ``` Error in min(data) : invalid 'type' (language) of argument ``` ## Plot Defaults ```{r, message=FALSE, eval=FALSE} vioplot(Sepal.Length~Species, data = iris) ``` ```{r, message=FALSE, echo=FALSE} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="magenta") ``` Another concern we see here is that the `vioplot` defaults are not aesthetically pleasing, with a rather glaring colour scheme unsuitable for professional or academic usage. Thus the plot default colours have been changed as shown here: ```{r} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length") ``` ## Plot colours: Violin Fill Plot colours can be further customised as with the original vioplot package using the `col` argument: ```{r} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue") ``` ### Vectorisation However the `vioplot` (0.2) function is unable to colour each violin separately, thus this is enabled with a vectorised `col` in `vioplot` (0.3): ```{r} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) ``` ## Plot colours: Violin Lines and Boxplot Colours can also be customised for the violin fill and border separately using the `col` and `border` arguments: ```{r} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue", border="royalblue") ``` Similarly, the arguments `lineCol` and `rectCol` specify the colours of the boxplot outline and rectangle fill. For simplicity the box and whiskers of the boxplot will always have the same colour. ```{r} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", rectCol="palevioletred", lineCol="violetred") ``` The same applies to the colour of the median point with `colMed`: ```{r} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", colMed="violet") ``` ### Combined customisation These can be customised colours can be combined: ```{r} vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue", border="royalblue", rectCol="palevioletred", lineCol="violetred", colMed="violet") ``` ### Vectorisation These colour and shape settings can also be customised separately for each violin: ```{r} vioplot(Sepal.Length~Species, data = iris, main="Sepal Length", col=c("lightgreen", "lightblue", "palevioletred"), border=c("darkolivegreen4", "royalblue4", "violetred4"), rectCol=c("forestgreen", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), colMed=c("green", "cyan", "magenta"), pchMed=c(15, 17, 19)) ``` ### Enhanced Annotation Here we demonstrate additional annotation features to display outliers and group sizes. #### Labelling group size Note that y-axes limits need to be adjusted to avoid overlaying text. ```{r, fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'} data("iris") attach(iris) vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", ylab = "", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(0, max(Sepal.Length) * 1.1)) legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.8) add_labels(unlist(iris$Sepal.Length), iris$Species, height = 0.5, cex = 0.8) ``` #### Plotting outliers and medians Here we add outliers and show annotation features. ```{r, warning=FALSE} # add outliers to demo data iris2 <- iris iris2 <- rbind(iris2, c(7, 1, 0, 0, "setosa")) iris2 <- rbind(iris2, c(1, 10, 0, 0, "setosa")) iris2 <- rbind(iris2, c(9, 2, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(2, 12, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(10, 1, 0, 0, "virginica")) iris2 <- rbind(iris2, c(12, 7, 0, 0, "virginica")) iris2$Species <- factor(iris2$Species) iris2$Sepal.Length <- as.numeric(iris2$Sepal.Length) iris2$Sepal.Width <- as.numeric(iris2$Sepal.Width) table(iris2$Species) ``` This adds outliers to the plot. ```{r, fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'} attach(iris2) vioplot(Sepal.Length~Species, data = iris2, main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1)) Sepal.medians <- sapply(unique(Species), function(sp) median(Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2, col = "black", bars = "grey85", lwd = 2, fill = c("palegreen3", "lightblue3", "palevioletred3")) legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) ``` Annotation on split violins are shown here. See the split violin plot vignette for details on these parameters. ```{r, fig.align = 'center', fig.height = 4, fig.width = 8, fig.keep = 'last'} data(iris) summary(iris2$Sepal.Width) table(iris2$Sepal.Width > mean(iris2$Sepal.Width)) iris_large <- iris2[iris2$Sepal.Width > mean(iris2$Sepal.Width), ] iris_small <- iris2[iris2$Sepal.Width <= mean(iris2$Sepal.Width), ] attach(iris_large) vioplot(Sepal.Length~Species, data=iris_large, plotCentre = "line", side = "right", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(iris2$Sepal.Length) * 0.9, max(iris2$Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(iris_large$Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris_large$Sepal.Length), iris2$Species, cutoff = 2, col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2, fill = "grey85") legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("palegreen3", "lightblue3", "palevioletred3"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) attach(iris_small) vioplot(Sepal.Length~Species, data=iris_small, plotCentre = "line", side = "left", add = T, col=c("palegreen1", "lightblue1", "palevioletred1"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1), names=c("setosa", "versicolor", "virginica")) Sepal.medians <- sapply(unique(Species), function(sp) median(iris_small$Sepal.Length[Species == sp])) # highlights medians points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2, col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4")) # plots outliers above 2 SD add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2, col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2, fill = "grey50") legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8) # add legend and titles legend("topleft", fill = c("lightblue2", "lightblue3"), legend = c("small", "large"), title = "Sepal Width") title(xlab = "Species", ylab = "Sepal Length") ``` vioplot/inst/doc/violin_ylog.R0000644000176200001440000000531614641725507016165 0ustar liggesusers## ----------------------------------------------------------------------------- library("vioplot") ## ----message=FALSE------------------------------------------------------------ data(iris) boxplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica")) ## ----------------------------------------------------------------------------- vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", ylog = T, ylim=c(log(1), log(10))) ## ----------------------------------------------------------------------------- vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = T, ylim=c(log(1), log(10))) vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", log = "y", ylim=c(log(1), log(10))) ## ----------------------------------------------------------------------------- vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", yaxt="n") vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", ylog = T, yaxt="n", ylim=c(log(1), log(10))) ## ----------------------------------------------------------------------------- vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", yaxt="n") axis(2, at=1:10, labels=1:10) ## ----------------------------------------------------------------------------- vioplot(iris$Sepal.Length[iris$Species=="setosa"], iris$Sepal.Length[iris$Species=="versicolor"], iris$Sepal.Length[iris$Species=="virginica"], names=c("setosa", "versicolor", "virginica"), main="Sepal Length", yaxt="n", log="y", ylim=c(log(4), log(9))) axis(2, at=log(1:10), labels=1:10) vioplot/inst/doc/overlaying_annotations.html0000644000176200001440000010352114641725500021160 0ustar liggesusers Overlaying base R graphics

Overlaying base R graphics

Tom Kelly

2024-07-05

Introduction: Integration with base R graphics

Here we demonstrate how to combine violin plots with other base R graphics. In principle any base R graphics can be overlayed on top of a violin plot for annotation.

Many problems can be resolved by overlaying base R graphics and integrating vioplot with other plotting functions. Any additional elements can be overlayed by running commands after generating the plot. The x-axes are integer values [1,2,3,…] for each violin. The y-axes are continuous values as displayed.

The following plotting elements are supported for example: points, lines, polygon

It is also possible to modify plotting parameters with: title, axis, legend

“vioplot()” functions similar to “plot()” and passes input arguments from “par()”.

Plotting violins with highlighted medians

For example it is possible to add additional annotations.

# generate dummy data
a <- rnorm(25, 3, 0.5)
b <- rnorm(25, 2, 1.0)
c <- rnorm(25, 2.75, 0.25)
d <- rnorm(25, 3.15, 0.375)
e <- rnorm(25, 1, 0.25)
datamat <- cbind(a, b, c, d, e)
dim(datamat)
## [1] 25  5
library("vioplot")
vioplot(datamat, ylim = c(0, 5))
# compute medians
data.med <- apply(datamat, 2, median)
data.med
##        a        b        c        d        e 
## 2.824456 1.849177 2.671804 3.025548 1.118633
#overlay medians
lines(data.med, lty = 2, lwd = 1.5)
points(data.med, pch = 19, col = "red", cex = 2.25)

Custom axes and titles

It is also possible to modify the axes labels and titles as shown in this example. Here default axes are suppressed and replaced with custom parameters.

outcome <- c(rnorm(25, 3, 1), rnorm(25, 2, 0.5))
intervention <- c(rep("treatment", 25), rep("control", 25))
table(intervention)
## intervention
##   control treatment 
##        25        25
names(table(intervention))
## [1] "control"   "treatment"
unique(sort(intervention))
## [1] "control"   "treatment"
intervention <- as.factor(intervention)
levels(intervention)
## [1] "control"   "treatment"
d <- data.frame(outcome, intervention)
vioplot(outcome ~ intervention, data = d, xaxt = 'n', yaxt = 'n', 
        main = "", xlab = "", ylab = "")
axis(side = 1, at = 1:length(levels(intervention)), labels = levels(intervention))
mtext("custom x labels for intervention", side = 1)
mtext("custom y labels for outcome", side = 2)
title(main = "example with custom title", sub = "subtitles are supported")

Annotated histograms

This is also supported by the histogram plot.

histoplot(outcome ~ intervention, data = d, xaxt = 'n', yaxt = 'n', 
        main = "", xlab = "", ylab = "")
axis(side = 1, at = 1:length(levels(intervention)), labels = levels(intervention))
mtext("custom x labels for intervention", side = 1)
mtext("custom y labels for outcome", side = 2)
title(main = "example with custom title", sub = "subtitles are supported")

vioplot/inst/doc/violin_formulae.html0000644000176200001440000035164214641725505017574 0ustar liggesusers Customising Violin Plots with Formula Input

Customising Violin Plots with Formula Input

Tom Kelly

2024-07-05

Since boxplots have become the de facto standard for plotting the distribution of data most users are familiar with these and the formula input for dataframes. However this input is not available in the standard vioplot package. Thus it has been restored here for enhanced backwards compatibility with boxplot.

As shown below for the iris dataset, violin plots show distribution information taking formula input that boxplot implements but vioplot is unable to. This demonstrates the customisation demonstrated in the main vioplot vignette using vioplot syntax with the formula method commonly used for boxplot, t.test, and lm.

library("vioplot")
data(iris)
boxplot(Sepal.Length~Species, data = iris)

Whereas performing the same function does not work with vioplot (0.2).

devtools::install_version("vioplot", version = "0.2")
library("vioplot")
vioplot(Sepal.Length~Species, data = iris)
Error in min(data) : invalid 'type' (language) of argument

Plot Defaults

vioplot(Sepal.Length~Species, data = iris)

Another concern we see here is that the vioplot defaults are not aesthetically pleasing, with a rather glaring colour scheme unsuitable for professional or academic usage. Thus the plot default colours have been changed as shown here:

vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length")

Plot colours: Violin Fill

Plot colours can be further customised as with the original vioplot package using the col argument:

vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue")

Vectorisation

However the vioplot (0.2) function is unable to colour each violin separately, thus this is enabled with a vectorised col in vioplot (0.3):

vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred"))
legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5)

Plot colours: Violin Lines and Boxplot

Colours can also be customised for the violin fill and border separately using the col and border arguments:

vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue", border="royalblue")

Similarly, the arguments lineCol and rectCol specify the colours of the boxplot outline and rectangle fill. For simplicity the box and whiskers of the boxplot will always have the same colour.

vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", rectCol="palevioletred", lineCol="violetred")

The same applies to the colour of the median point with colMed:

vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", colMed="violet")

### Combined customisation

These can be customised colours can be combined:

vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col="lightblue", border="royalblue", rectCol="palevioletred", lineCol="violetred", colMed="violet")

Vectorisation

These colour and shape settings can also be customised separately for each violin:

vioplot(Sepal.Length~Species, data = iris, main="Sepal Length", col=c("lightgreen", "lightblue", "palevioletred"), border=c("darkolivegreen4", "royalblue4", "violetred4"), rectCol=c("forestgreen", "blue", "palevioletred3"), lineCol=c("darkolivegreen", "royalblue", "violetred4"), colMed=c("green", "cyan", "magenta"), pchMed=c(15, 17, 19))

Enhanced Annotation

Here we demonstrate additional annotation features to display outliers and group sizes.

Labelling group size

Note that y-axes limits need to be adjusted to avoid overlaying text.

data("iris")
attach(iris)
## The following objects are masked from iris_small:
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris_large:
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris2:
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris (pos = 6):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", ylab = "",
        col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(0, max(Sepal.Length) * 1.1))
legend("bottomright", legend=c("setosa", "versicolor", "virginica"),
       fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.8)
add_labels(unlist(iris$Sepal.Length), iris$Species, height = 0.5, cex = 0.8)

#### Plotting outliers and medians

Here we add outliers and show annotation features.

# add outliers to demo data
iris2 <- iris
iris2 <- rbind(iris2, c(7, 1, 0, 0, "setosa"))
iris2 <- rbind(iris2, c(1, 10, 0, 0, "setosa"))
iris2 <- rbind(iris2, c(9, 2, 0, 0, "versicolor"))
iris2 <- rbind(iris2, c(2, 12, 0, 0, "versicolor"))
iris2 <- rbind(iris2, c(10, 1, 0, 0, "virginica"))
iris2 <- rbind(iris2, c(12, 7, 0, 0, "virginica"))
iris2$Species <- factor(iris2$Species)
iris2$Sepal.Length <- as.numeric(iris2$Sepal.Length)
iris2$Sepal.Width <- as.numeric(iris2$Sepal.Width)
table(iris2$Species)
## 
##     setosa versicolor  virginica 
##         52         52         52

This adds outliers to the plot.

attach(iris2)
## The following objects are masked from iris (pos = 3):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris_small:
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris_large:
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris2 (pos = 6):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris (pos = 7):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
vioplot(Sepal.Length~Species, data = iris2, main = "Sepal Length",
        col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1))
Sepal.medians <- sapply(unique(Species), function(sp) median(Sepal.Length[Species == sp]))
# highlights medians
points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2,
       col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4"))
# plots outliers above 2 SD
add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2,
             col = "black", bars = "grey85", lwd = 2,
             fill = c("palegreen3", "lightblue3", "palevioletred3"))
legend("bottomright", legend=c("setosa", "versicolor", "virginica"),
       fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6)
add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8)

Annotation on split violins are shown here. See the split violin plot vignette for details on these parameters.

data(iris)
summary(iris2$Sepal.Width)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   1.000   2.800   3.000   3.151   3.400  12.000
table(iris2$Sepal.Width > mean(iris2$Sepal.Width))
## 
## FALSE  TRUE 
##    97    59
iris_large <- iris2[iris2$Sepal.Width > mean(iris2$Sepal.Width), ]
iris_small <- iris2[iris2$Sepal.Width <= mean(iris2$Sepal.Width), ]

attach(iris_large)
## The following objects are masked from iris2 (pos = 3):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris (pos = 4):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris_small:
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris_large (pos = 6):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris2 (pos = 7):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris (pos = 8):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
vioplot(Sepal.Length~Species, data=iris_large, plotCentre = "line", side = "right", col=c("lightgreen", "lightblue", "palevioletred"), ylim = c(min(iris2$Sepal.Length) * 0.9, max(iris2$Sepal.Length) * 1.1),
        names=c("setosa", "versicolor", "virginica"))
Sepal.medians <- sapply(unique(Species), function(sp) median(iris_large$Sepal.Length[Species == sp]))
# highlights medians
points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2,
       col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4"))
# plots outliers above 2 SD
add_outliers(unlist(iris_large$Sepal.Length), iris2$Species, cutoff = 2,
             col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2,
             fill = "grey85")
legend("bottomright", legend=c("setosa", "versicolor", "virginica"),
       fill=c("palegreen3", "lightblue3", "palevioletred3"), cex = 0.6)
add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8)

attach(iris_small)
## The following objects are masked from iris_large (pos = 3):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris2 (pos = 4):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris (pos = 5):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris_small (pos = 6):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris_large (pos = 7):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris2 (pos = 8):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
## The following objects are masked from iris (pos = 9):
## 
##     Petal.Length, Petal.Width, Sepal.Length, Sepal.Width, Species
vioplot(Sepal.Length~Species, data=iris_small, plotCentre = "line", side = "left", add = T, col=c("palegreen1", "lightblue1", "palevioletred1"), ylim = c(min(Sepal.Length) * 0.9, max(Sepal.Length) * 1.1),
        names=c("setosa", "versicolor", "virginica"))
## Warning in vioplot.formula(Sepal.Length ~ Species, data = iris_small, plotCentre = "line", : Warning: names can only be changed on first call of vioplot (when add = FALSE)
## Warning in vioplot.default(x, ...): Warning: names can only be changed on first call of vioplot (when add = FALSE)
Sepal.medians <- sapply(unique(Species), function(sp) median(iris_small$Sepal.Length[Species == sp]))
# highlights medians
points(x = c(1:length(Sepal.medians)), y = Sepal.medians, pch = 21, cex = 1.25, lwd = 2,
       col = "white", bg = c("forestgreen", "lightblue4", "palevioletred4"))
# plots outliers above 2 SD
add_outliers(unlist(iris2$Sepal.Length), iris2$Species, cutoff = 2,
             col = c("palegreen3", "lightblue3", "palevioletred3"), bars = "grey85", lwd = 2,
             fill = "grey50")
legend("bottomright", legend=c("setosa", "versicolor", "virginica"),
       fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6)
add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0.5, cex = 0.8)

# add legend and titles
legend("topleft", fill = c("lightblue2", "lightblue3"), legend = c("small", "large"), title = "Sepal Width")
title(xlab = "Species", ylab = "Sepal Length")

vioplot/inst/doc/overlaying_annotations.Rmd0000644000176200001440000000563214640410551020736 0ustar liggesusers--- title: "Overlaying base R graphics" author: "Tom Kelly" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{vioplot: Overlaying base R graphics} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ## Introduction: Integration with base R graphics Here we demonstrate how to combine violin plots with other base R graphics. In principle any base R graphics can be overlayed on top of a violin plot for annotation. Many problems can be resolved by overlaying base R graphics and integrating vioplot with other plotting functions. Any additional elements can be overlayed by running commands after generating the plot. The x-axes are integer values [1,2,3,…] for each violin. The y-axes are continuous values as displayed. The following plotting elements are supported for example: points, lines, polygon It is also possible to modify plotting parameters with: title, axis, legend "vioplot()" functions similar to "plot()" and passes input arguments from "par()". ### Plotting violins with highlighted medians For example it is possible to add additional annotations. ```{r} # generate dummy data a <- rnorm(25, 3, 0.5) b <- rnorm(25, 2, 1.0) c <- rnorm(25, 2.75, 0.25) d <- rnorm(25, 3.15, 0.375) e <- rnorm(25, 1, 0.25) datamat <- cbind(a, b, c, d, e) dim(datamat) ``` ```{r} library("vioplot") ``` ```{r} vioplot(datamat, ylim = c(0, 5)) # compute medians data.med <- apply(datamat, 2, median) data.med #overlay medians lines(data.med, lty = 2, lwd = 1.5) points(data.med, pch = 19, col = "red", cex = 2.25) ``` ### Custom axes and titles It is also possible to modify the axes labels and titles as shown in this example. Here default axes are suppressed and replaced with custom parameters. ```{r} outcome <- c(rnorm(25, 3, 1), rnorm(25, 2, 0.5)) intervention <- c(rep("treatment", 25), rep("control", 25)) table(intervention) names(table(intervention)) unique(sort(intervention)) intervention <- as.factor(intervention) levels(intervention) d <- data.frame(outcome, intervention) vioplot(outcome ~ intervention, data = d, xaxt = 'n', yaxt = 'n', main = "", xlab = "", ylab = "") axis(side = 1, at = 1:length(levels(intervention)), labels = levels(intervention)) mtext("custom x labels for intervention", side = 1) mtext("custom y labels for outcome", side = 2) title(main = "example with custom title", sub = "subtitles are supported") ``` #### Annotated histograms This is also supported by the histogram plot. ```{r} histoplot(outcome ~ intervention, data = d, xaxt = 'n', yaxt = 'n', main = "", xlab = "", ylab = "") axis(side = 1, at = 1:length(levels(intervention)), labels = levels(intervention)) mtext("custom x labels for intervention", side = 1) mtext("custom y labels for outcome", side = 2) title(main = "example with custom title", sub = "subtitles are supported") ``` vioplot/inst/COPYRIGHT0000644000176200001440000000307514640410551014223 0ustar liggesusersCopyright (c) 2004, Daniel Adler All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the University of Goettingen nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. vioplot/build/0000755000176200001440000000000014641725510013052 5ustar liggesusersvioplot/build/vignette.rds0000644000176200001440000000074114641725510015413 0ustar liggesusersSMO1]YT0A1Pdbf4DAx# 4鶛m=.ݵz̛vy^ *WʰT*яp aP D &@H~s.T.-ƈ FyG[=mΣ~gUdȨr0MtPW#8Rđ nT НZ褡Ўn̳F<*}qzÒp@;4" k%55hҲ+_גا٫?q&=9T@̟@Lcv hk9hAv Z}gZlZT:6s5gX]3ӛWRj3vk-S2 s͔6O 0-d9m,6(#LUr ]2ޒiE4Q9!(|4N?u&#c\b=qovioplot/man/0000755000176200001440000000000014641336006012524 5ustar liggesusersvioplot/man/violin.stats.Rd0000644000176200001440000000223214640410551015444 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vioplot.stats.R \name{vioplot.stats} \alias{vioplot.stats} \alias{violin.stats} \alias{violinplot.stats} \title{Violin Plot Statistics} \usage{ \method{vioplot}{stats}(x, coef = 1.5, do.conf = TRUE, do.out = TRUE, ...) } \arguments{ \item{x}{a numeric vector for which the violin plot will be constructed \code{NA}s and \code{NaN}s are allowed and omitted).} \item{coef}{this determines how far the plot ‘whiskers’ extend out from the box. If coef is positive, the whiskers extend to the most extreme data point which is no more than coef times the length of the box away from the box. A value of zero causes the whiskers to extend to the data extremes (and no outliers be returned).} \item{do.conf, do.out}{logicals; if FALSE, the conf or out component respectively will be empty in the result.} \item{...}{arguments passed to \code{\link[vioplot]{vioplot}}.} } \description{ This function is typically called by another function to gather the statistics necessary for producing box plots, but may be invoked separately. See: \code{\link[grDevices]{boxplot.stats}} } vioplot/man/add_labels.Rd0000644000176200001440000000463314641337477015110 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/annotation.R \name{add_labels} \alias{add_labels} \title{Annotated Violin Plot} \usage{ add_labels(variable, categories, cex = par()$cex, col = par()$fg, height = 0.5) } \arguments{ \item{variable}{continuous variable to to plot on y-axis (numeric or integer)} \item{categories}{discrete variable to break down groups (factor or string).} \item{cex}{size of text.} \item{col}{colour of text} \item{height}{adjust placement of text.} } \description{ Annotate violin plots with custom labels } \examples{ # box- vs violin-plot par(mfrow=c(2,1)) mu<-2 si<-0.6 bimodal<-c(rnorm(1000,-mu,si),rnorm(1000,mu,si)) uniform<-runif(2000,-4,4) normal<-rnorm(2000,0,3) # annotate a violin plot group <- rep(c("bimodal", "uniform", "normal"), sapply(list(bimodal, uniform, normal), length)) table(group) vioplot(bimodal,uniform,normal) add_labels(unlist(bimodal,uniform,normal), group, height = 3, cex = 0.8) # boxplots are also supported boxplot(bimodal,uniform,normal) add_labels(unlist(bimodal,uniform,normal), group, height = 3, cex = 0.8) # formula input data("iris") vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris$Sepal.Length), iris$Species, height = 0, cex = 0.8) # demo with outliers iris2 <- iris iris2 <- rbind(iris2, c(7, 0, 0, 0, "setosa")) iris2 <- rbind(iris2, c(0, 0, 0, 0, "setosa")) iris2 <- rbind(iris2, c(9, 0, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(2, 0, 0, 0, "versicolor")) iris2 <- rbind(iris2, c(10, 0, 0, 0, "virginica")) iris2 <- rbind(iris2, c(12, 0, 0, 0, "virginica")) iris2$Species <- factor(iris2$Species) iris2$Sepal.Length <- as.numeric(iris2$Sepal.Length) vioplot(Sepal.Length~Species, data = iris2, main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) add_outliers(unlist(iris2$Sepal.Length), iris2$Species, col = "grey50", fill = "red", bars = "grey85") legend("bottomright", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.6) add_labels(unlist(iris2$Sepal.Length), iris2$Species, height = 0, cex = 0.8) } \keyword{annotation.} \keyword{graphics} \keyword{plot} \keyword{violin} vioplot/man/add_outliers.Rd0000644000176200001440000000212214641626557015503 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/annotation.R \name{add_outliers} \alias{add_outliers} \title{Annotated Violin Plot} \usage{ add_outliers(variable, categories, cutoff = 3, fill = par()$bg, col = par()$fg, bars = par()$fg, lwd = par()$lwd, verbose = FALSE) } \arguments{ \item{variable}{continuous variable to to plot on y-axis (numeric or integer).} \item{categories}{discrete variable to break down groups (factor or string).} \item{cutoff}{minimum number (default 3L) of standard deviations to report.} \item{fill}{colour of spots. Scalar applied to all columns or a vector for each category.} \item{col}{colour of rings or borders. Scalar applied to all columns or a vector for each category.} \item{bars}{colour of horizontal bars. Scalar applied to all columns or a vector for each category.} \item{lwd}{thickness of border.} \item{verbose}{to print logs (defaults to FALSE).} } \description{ Annotation to highlight outliers. } \details{ Annotate violin plots with outliers } \keyword{annotation} \keyword{graphics} \keyword{plot} \keyword{violin} vioplot/man/histoplot.Rd0000644000176200001440000003412214641337477015057 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/histoplot.R \name{histoplot} \alias{histoplot} \alias{histoplot.matrix} \alias{histogram.matrix} \alias{histoplot.list} \alias{histoplot.data.frame} \alias{histoplot.formula} \alias{histoplot.default} \title{histoplot} \usage{ \method{histoplot}{matrix}(x, use.cols = TRUE, ...) \method{histoplot}{list}(x, ...) \method{histoplot}{data.frame}(x, ...) \method{histoplot}{matrix}(x, use.cols = TRUE, ...) \method{histoplot}{formula}( formula, data = NULL, ..., subset, na.action = NULL, add = FALSE, ann = !add, horizontal = FALSE, side = "both", xlab = mklab(y_var = horizontal), ylab = mklab(y_var = !horizontal), names = NULL, drop = FALSE, sep = ".", lex.order = FALSE ) \method{histoplot}{default}( x, ..., data = NULL, breaks = "Sturges", xlim = NULL, ylim = NULL, names = NULL, horizontal = FALSE, col = "grey50", border = par()$fg, lty = 1, lwd = 1, rectCol = par()$fg, lineCol = par()$fg, pchMed = 19, colMed = "white", colMed2 = "grey 75", at, add = FALSE, wex = 1, drawRect = TRUE, areaEqual = FALSE, axes = TRUE, frame.plot = axes, panel.first = NULL, panel.last = NULL, asp = NA, main = "", sub = "", xlab = NA, ylab = NA, line = NA, outer = FALSE, xlog = NA, ylog = NA, adj = NA, ann = NA, ask = NA, bg = NA, bty = NA, cex = NA, cex.axis = NA, cex.lab = NA, cex.main = NA, cex.names = NULL, cex.sub = NA, cin = NA, col.axis = NA, col.lab = NA, col.main = NA, col.sub = NA, cra = NA, crt = NA, csi = NA, cxy = NA, din = NA, err = NA, family = NA, fg = NA, fig = NA, fin = NA, font = NA, font.axis = NA, font.lab = NA, font.main = NA, font.sub = NA, lab = NA, las = NA, lend = NA, lheight = NA, ljoin = NA, lmitre = NA, mai = NA, mar = NA, mex = NA, mfcol = NA, mfg = NA, mfrow = NA, mgp = NA, mkh = NA, new = NA, oma = NA, omd = NA, omi = NA, page = NA, pch = NA, pin = NA, plt = NA, ps = NA, pty = NA, smo = NA, srt = NA, tck = NA, tcl = NA, usr = NA, xaxp = NA, xaxs = NA, xaxt = NA, xpd = NA, yaxp = NA, yaxs = NA, yaxt = NA, ylbias = NA, log = "", logLab = c(1, 2, 5), na.action = NULL, na.rm = T, side = "both" ) } \arguments{ \item{x}{a numeric matrix.} \item{...}{Further arguments to \code{\link[vioplot]{histoplot}}.} \item{use.cols}{logical indicating if columns (by default) or rows (use.cols = FALSE) should be plotted.} \item{formula}{a formula, such as y ~ grp, where y is a numeric vector of data values to be split into groups according to the grouping variable grp (usually a factor).} \item{data}{a data.frame (or list) from which the variables in formula should be taken.} \item{subset}{an optional vector specifying a subset of observations to be used for plotting.} \item{na.action}{a function which indicates what should happen when the data contain NAs. The default is to ignore missing values in either the response or the group.} \item{add}{logical. if FALSE (default) a new plot is created} \item{horizontal}{logical. To use horizontal or vertical histograms. Note that log scale can only be used on the x-axis for horizontal histograms, and on the y-axis otherwise.} \item{side}{defaults to "both". Assigning "left" or "right" enables one sided plotting of histograms. May be applied as a scalar across all groups.} \item{names}{one label, or a vector of labels for the data must match the number of data given} \item{drop, sep, lex.order}{defines groups to plot from formula, passed to \code{split.default}, see there.} \item{breaks}{the breaks for the density estimator, as explained in hist} \item{xlim, ylim}{numeric vectors of length 2, giving the x and y coordinates ranges.} \item{col}{Graphical parameter for fill colour of the histogram(s) polygon. NA for no fill colour. If col is a vector, it specifies the colour per histogram, and colours are reused if necessary.} \item{border}{Graphical parameters for the colour of the histogram border passed to lines. NA for no border. If border is a vector, it specifies the colour per histogram, and colours are reused if necessary.} \item{lty, lwd}{Graphical parameters for the histogram passed to lines and polygon} \item{rectCol}{Graphical parameters to control fill colour of the box. NA for no fill colour. If col is a vector, it specifies the colour per histogram, and colours are reused if necessary.} \item{lineCol}{Graphical parameters to control colour of the box outline and whiskers. NA for no border. If lineCol is a vector, it specifies the colour per histogram, and colours are reused if necessary.} \item{pchMed}{Graphical parameters to control shape of the median point. If pchMed is a vector, it specifies the shape per histogram.} \item{colMed, colMed2}{Graphical parameters to control colour of the median point. If colMed is a vector, it specifies the colour per histogram. colMed specifies the fill colour in all cases unless pchMed is 21:25 in which case colMed is the border colour and colMed2 is the fill colour.} \item{at}{position of each histogram. Default to 1:n} \item{wex}{relative expansion of the histogram. If wex is a vector, it specifies the area/width size per histogram and sizes are reused if necessary.} \item{drawRect}{logical. The box is drawn if TRUE.} \item{areaEqual}{logical. Density plots checked for equal area if TRUE. wex must be scalar, relative widths of histograms depend on area.} \item{axes, frame.plot, panel.first, panel.last, asp, line, outer, adj, ann, ask, bg, bty, cin, col.axis, col.lab, col.main, col.sub, cra, crt, csi, cxy, din, err, family, fg, fig, fin, font, font.axis, font.lab, font.main, font.sub, lab, las, lend, lheight, ljoin, lmitre, mai, mar, mex, mfcol, mfg, mfrow, mgp, mkh, new, oma, omd, omi, page, pch, pin, plt, ps, pty, smo, srt, tck, tcl, usr, xaxp, xaxs, xaxt, xpd, yaxp, yaxs, ylbias}{Arguments to be passed to methods, such as graphical parameters (see \code{\link[graphics]{par}})).} \item{main, sub, xlab, ylab}{graphical parameters passed to plot.} \item{ylog, xlog}{A logical value (see log in \code{\link[graphics]{plot.default}}). If ylog is TRUE, a logarithmic scale is in use (e.g., after plot(*, log = "y")). For horizontal = TRUE then, if xlog is TRUE, a logarithmic scale is in use (e.g., after plot(*, log = "x")). For a new device, it defaults to FALSE, i.e., linear scale.} \item{cex}{A numerical value giving the amount by which plotting text should be magnified relative to the default.} \item{cex.axis}{The magnification to be used for y axis annotation relative to the current setting of cex.} \item{cex.lab}{The magnification to be used for x and y labels relative to the current setting of cex.} \item{cex.main}{The magnification to be used for main titles relative to the current setting of cex.} \item{cex.names}{The magnification to be used for x axis annotation relative to the current setting of cex. Takes the value of cex.axis if not given.} \item{cex.sub}{The magnification to be used for sub-titles relative to the current setting of cex.} \item{yaxt}{A character which specifies the y axis type. Specifying "n" suppresses plotting.} \item{log}{Logarithmic scale if log = "y" or TRUE. Invokes ylog = TRUE. If horizontal is TRUE then invokes xlog = TRUE.} \item{logLab}{Increments for labelling y-axis on log-scale, defaults to numbers starting with 1, 2, 5, and 10.} \item{na.rm}{logical value indicating whether NA values should be stripped before the computation proceeds. Defaults to TRUE.} } \description{ Produce histogram plot(s) of the given (grouped) values with enhanced annotation and colour per group. Includes customisation of colours for each aspect of the histogram, boxplot, and separate histograms. This supports input of data as a list or formula, being backwards compatible with \code{\link[vioplot]{histoplot}} (0.2) and taking input in a formula as used for \code{\link[graphics]{boxplot}}. Interpreting the columns (or rows) of a matrix as different groups, draw a boxplot for each. } \examples{ # box- vs histogram-plot par(mfrow=c(2,1)) mu<-2 si<-0.6 bimodal<-c(rnorm(1000,-mu,si),rnorm(1000,mu,si)) uniform<-runif(2000,-4,4) normal<-rnorm(2000,0,3) histoplot(bimodal,uniform,normal) boxplot(bimodal,uniform,normal) # add to an existing plot x <- rnorm(100) y <- rnorm(100) plot(x, y, xlim=c(-5,5), ylim=c(-5,5)) histoplot(x, col="tomato", horizontal=TRUE, at=-4, add=TRUE,lty=2, rectCol="gray") histoplot(y, col="cyan", horizontal=FALSE, at=-4, add=TRUE,lty=2) # formula input data("iris") histoplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) data("diamonds", package = "ggplot2") palette <- RColorBrewer::brewer.pal(9, "Pastel1") par(mfrow=c(3, 1)) histoplot(price ~ cut, data = diamonds, las = 1, col = palette) histoplot(price ~ clarity, data = diamonds, las = 2, col = palette) histoplot(price ~ color, data = diamonds, las = 2, col = palette) par(mfrow=c(3, 1)) #generate example data data_one <- rnorm(100) data_two <- rnorm(50, 1, 2) #generate histogram plot with similar functionality to histoplot histoplot(data_one, data_two, col="magenta") #note vioplox defaults to a greyscale plot histoplot(data_one, data_two) #colours can be customised separately, with axis labels, legends, and titles histoplot(data_one, data_two, col=c("red","blue"), names=c("data one", "data two"), main="data histogram", xlab="data class", ylab="data read") legend("topleft", fill=c("red","blue"), legend=c("data one", "data two")) #colours can be customised for the histogram fill and border separately histoplot(data_one, data_two, col="grey85", border="purple", names=c("data one", "data two"), main="data histogram", xlab="data class", ylab="data read") #colours can also be customised for the boxplot rectange and lines (border and whiskers) histoplot(data_one, data_two, col="grey85", rectCol="lightblue", lineCol="blue", border="purple", names=c("data one", "data two"), main="data histogram", xlab="data class", ylab="data read") #these colours can also be customised separately for each histogram histoplot(data_one, data_two, col=c("skyblue", "plum"), rectCol=c("lightblue", "palevioletred"), lineCol="blue", border=c("royalblue", "purple"), names=c("data one", "data two"), main="data histogram", xlab="data class", ylab="data read") #this applies to any number of histograms, given that colours are provided for each histoplot(data_one, data_two, rnorm(200, 3, 0.5), rpois(200, 2.5), rbinom(100, 10, 0.4), col=c("red", "orange", "green", "blue", "violet"), rectCol=c("palevioletred", "peachpuff", "lightgreen", "lightblue", "plum"), lineCol=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"), border=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"), names=c("data one", "data two", "data three", "data four", "data five"), main="data histogram", xlab="data class", ylab="data read") #The areaEqual parameter scales with width of histograms #histograms will have equal density area (including missing tails) rather than equal maximum width histoplot(data_one, data_two, areaEqual=TRUE) histoplot(data_one, data_two, areaEqual=TRUE, col=c("skyblue", "plum"), rectCol=c("lightblue", "palevioletred"), lineCol="blue", border=c("royalblue", "purple"), names=c("data one", "data two"), main="data histogram", xlab="data class", ylab="data read") histoplot(data_one, data_two, rnorm(200, 3, 0.5), rpois(200, 2.5), rbinom(100, 10, 0.4), areaEqual=TRUE, col=c("red", "orange", "green", "blue", "violet"), rectCol=c("palevioletred", "peachpuff", "lightgreen", "lightblue", "plum"), lineCol=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"), border=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"), names=c("data one", "data two", "data three", "data four", "data five"), main="data histogram", xlab="data class", ylab="data read") #To compare multiple groups of histogram densities, it helps to adjust the wex. dlist1 <- lapply(c(10,20,30,40), function(n) runif(n)) dlist2 <- lapply(c(100,200,300,400), function(n) runif(n)) hscale1 <- sapply(dlist1, function(r){ max(hist(r, plot=FALSE, breaks=seq(0,1,by=.05))$density)}) histoplot(dlist1, side='left', col=grey(.3), breaks=seq(0,1,by=.05), add=FALSE, pchMed=NA, drawRect=FALSE, border=NA, wex=hscale1/length(hscale1)) hscale2 <- sapply(dlist2, function(r){ max(hist(r, plot=FALSE, breaks=seq(0,1,by=.05))$density)}) histoplot(dlist2, side='right', col=grey(.7), breaks=seq(0,1,by=.05), add=TRUE, pchMed=NA, drawRect=FALSE, border=NA, wex=hscale2/length(hscale2)) #Sometimes, it is helpful to see the raw counts instead. dvec <- length(unlist(c(dlist1, dlist2)))/4 histoplot(dlist1, side='left', col=grey(.3), breaks=seq(0,1,by=.05), add=FALSE, pchMed=NA, drawRect=FALSE, border=NA, wex=sapply(dlist1, length)/dvec*hscale1/length(hscale1)) histoplot(dlist2, side='right', col=grey(.7), breaks=seq(0,1,by=.05), add=TRUE, pchMed=NA, drawRect=FALSE, border=NA, wex=sapply(dlist2, length)/dvec*hscale2/length(hscale2)) #It may also benefit some users to pass density and angle arguments to the # histograms (ultimately rect) and create outer legends hist(runif(100), density=c(10,20), angle=c(22,90+22) ,col=1) outer_legend <- function(...) { opar <- par(fig=c(0, 1, 0, 1), oma=c(0, 0, 0, 0), mar=c(0, 0, 0, 0), new=TRUE) on.exit(par(opar)) plot(0, 0, type='n', bty='n', xaxt='n', yaxt='n') legend(...) } outer_legend('topright', pch=15, density=c(10,20), angle=c(22,90+22), col=0, legend=c('Y','N')) } \keyword{graphics} \keyword{histogram} \keyword{plot} vioplot/man/vioplot.Rd0000644000176200001440000003201114641617142014507 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/vioplot.R \name{vioplot} \alias{vioplot} \alias{violinplot} \alias{vioplot.matrix} \alias{violin.matrix} \alias{violinplot.matrix} \alias{vioplot.list} \alias{vioplot.data.frame} \alias{vioplot.formula} \alias{vioplot.default} \title{Violin Plot} \usage{ \method{vioplot}{matrix}(x, use.cols = TRUE, ...) \method{vioplot}{list}(x, ...) \method{vioplot}{data.frame}(x, ...) \method{vioplot}{matrix}(x, use.cols = TRUE, ...) \method{vioplot}{formula}( formula, data = NULL, ..., subset, na.action = NULL, add = FALSE, ann = !add, horizontal = FALSE, side = "both", cex.axis = par()$cex, srt.axis = c(0, 90), xlab = mklab(y_var = horizontal), ylab = mklab(y_var = !horizontal), main = "", sub = "", names = NULL, drop = FALSE, sep = ".", lex.order = FALSE ) \method{vioplot}{default}( x, ..., data = NULL, range = 1.5, h = NULL, xlim = NULL, ylim = NULL, names = NULL, horizontal = FALSE, col = "grey50", border = par()$fg, lty = 1, lwd = 1, rectCol = par()$fg, lineCol = par()$fg, pchMed = 19, colMed = "white", colMed2 = "grey 75", at, add = FALSE, wex = 1, drawRect = TRUE, areaEqual = FALSE, axes = TRUE, frame.plot = axes, panel.first = NULL, panel.last = NULL, asp = NA, main = "", sub = "", xlab = NA, ylab = NA, line = 1, outer = FALSE, xlog = NA, ylog = NA, adj = NA, ann = NA, ask = NA, bg = NA, bty = NA, cex = NA, cex.axis = NA, cex.lab = NA, cex.main = NA, cex.names = NULL, cex.sub = NA, cin = NA, col.axis = NA, col.lab = NA, col.main = NA, col.sub = NA, cra = NA, crt = NA, csi = NA, cxy = NA, din = NA, err = NA, family = NA, fg = NA, fig = NA, fin = NA, font = NA, font.axis = NA, font.lab = NA, font.main = NA, font.sub = NA, lab = NA, las = NA, lend = NA, lheight = NA, ljoin = NA, lmitre = NA, mai = NA, mar = NA, mex = NA, mfcol = NA, mfg = NA, mfrow = NA, mgp = NA, mkh = NA, new = NA, oma = NA, omd = NA, omi = NA, page = NA, pch = NA, pin = NA, plt = NA, ps = NA, pty = NA, smo = NA, srt = NA, srt.axis = c(0, 90), tck = NA, tcl = NA, usr = NA, xaxp = NA, xaxs = NA, xaxt = NA, xpd = NA, yaxp = NA, yaxs = NA, yaxt = NA, ylbias = NA, log = "", logLab = c(1, 2, 5), na.action = NULL, na.rm = T, side = "both", plotCentre = "point" ) } \arguments{ \item{x}{a numeric matrix.} \item{...}{Further arguments to \code{\link[vioplot]{vioplot}}.} \item{use.cols}{logical indicating if columns (by default) or rows (use.cols = FALSE) should be plotted.} \item{formula}{a formula, such as y ~ grp, where y is a numeric vector of data values to be split into groups according to the grouping variable grp (usually a factor).} \item{data}{a data.frame (or list) from which the variables in formula should be taken.} \item{subset}{an optional vector specifying a subset of observations to be used for plotting.} \item{na.action}{a function which indicates what should happen when the data contain NAs. The default is to ignore missing values in either the response or the group.} \item{add}{logical. if FALSE (default) a new plot is created} \item{horizontal}{logical. To use horizontal or vertical violins. Note that log scale can only be used on the x-axis for horizontal violins, and on the y-axis otherwise.} \item{side}{defaults to "both". Assigning "left" or "right" enables one sided plotting of violins. May be applied as a scalar across all groups.} \item{cex.axis}{The magnification to be used for y axis annotation relative to the current setting of cex.} \item{srt.axis}{angle for axis labels, scalar applies to both axes or vector with 2 components. [x, y] defaults to c(0, 90) with angles counter-clockwise from vertical.} \item{main, sub, xlab, ylab}{graphical parameters passed to plot.} \item{names}{one label, or a vector of labels for the data must match the number of data given} \item{drop, sep, lex.order}{defines groups to plot from formula, passed to \code{split.default}, see there.} \item{range}{a factor to calculate the upper/lower adjacent values} \item{h}{the height for the density estimator, if omit as explained in sm.density, h will be set to an optimum. A vector of length one, two or three, defining the smoothing parameter. A normal kernel function is used and h is its standard deviation. If this parameter is omitted, a normal optimal smoothing parameter is used.} \item{xlim, ylim}{numeric vectors of length 2, giving the x and y coordinates ranges.} \item{col}{Graphical parameter for fill colour of the violin(s) polygon. NA for no fill colour. If col is a vector, it specifies the colour per violin, and colours are reused if necessary.} \item{border}{Graphical parameters for the colour of the violin border passed to lines. NA for no border. If border is a vector, it specifies the colour per violin, and colours are reused if necessary.} \item{lty, lwd}{Graphical parameters for the violin passed to lines and polygon} \item{rectCol}{Graphical parameters to control fill colour of the box. NA for no fill colour. If col is a vector, it specifies the colour per violin, and colours are reused if necessary.} \item{lineCol}{Graphical parameters to control colour of the box outline and whiskers. NA for no border. If lineCol is a vector, it specifies the colour per violin, and colours are reused if necessary.} \item{pchMed}{Graphical parameters to control shape of the median point. If pchMed is a vector, it specifies the shape per violin.} \item{colMed, colMed2}{Graphical parameters to control colour of the median point. If colMed is a vector, it specifies the colour per violin. colMed specifies the fill colour in all cases unless pchMed is 21:25 in which case colMed is the border colour and colMed2 is the fill colour.} \item{at}{position of each violin. Default to 1:n} \item{wex}{relative expansion of the violin. If wex is a vector, it specifies the area/width size per violin and sizes are reused if necessary.} \item{drawRect}{logical. The box is drawn if TRUE.} \item{areaEqual}{logical. Density plots checked for equal area if TRUE. wex must be scalar, relative widths of violins depend on area.} \item{axes, frame.plot, panel.first, panel.last, asp, line, outer, adj, ann, ask, bg, bty, cin, col.axis, col.lab, col.main, col.sub, cra, crt, csi, cxy, din, err, family, fg, fig, fin, font, font.axis, font.lab, font.main, font.sub, lab, las, lend, lheight, ljoin, lmitre, mai, mar, mex, mfcol, mfg, mfrow, mgp, mkh, new, oma, omd, omi, page, pch, pin, plt, ps, pty, smo, srt, tck, tcl, usr, xaxp, xaxs, xaxt, xpd, yaxp, yaxs, ylbias}{Arguments to be passed to methods, such as graphical parameters (see \code{\link[graphics]{par}})).} \item{ylog, xlog}{A logical value (see log in \code{\link[graphics]{plot.default}}). If ylog is TRUE, a logarithmic scale is in use (e.g., after plot(*, log = "y")). For horizontal = TRUE then, if xlog is TRUE, a logarithmic scale is in use (e.g., after plot(*, log = "x")). For a new device, it defaults to FALSE, i.e., linear scale.} \item{cex}{A numerical value giving the amount by which plotting text should be magnified relative to the default.} \item{cex.lab}{The magnification to be used for x and y labels relative to the current setting of cex.} \item{cex.main}{The magnification to be used for main titles relative to the current setting of cex.} \item{cex.names}{The magnification to be used for x axis annotation relative to the current setting of cex. Takes the value of cex.axis if not given.} \item{cex.sub}{The magnification to be used for sub-titles relative to the current setting of cex.} \item{yaxt}{A character which specifies the y axis type. Specifying "n" suppresses plotting.} \item{log}{Logarithmic scale if log = "y" or TRUE. Invokes ylog = TRUE. If horizontal is TRUE then invokes xlog = TRUE.} \item{logLab}{Increments for labelling y-axis on log-scale, defaults to numbers starting with 1, 2, 5, and 10.} \item{na.rm}{logical value indicating whether NA values should be stripped before the computation proceeds. Defaults to TRUE.} \item{plotCentre}{defaults to "points", plotting a central point at the median. If "line" is given a median line is plotted (subject to side) alternatively.} } \description{ Produce violin plot(s) of the given (grouped) values with enhanced annotation and colour per group. Includes customisation of colours for each aspect of the violin, boxplot, and separate violins. This supports input of data as a list or formula, being backwards compatible with \code{\link[vioplot]{vioplot}} (0.2) and taking input in a formula as used for \code{\link[graphics]{boxplot}}. Interpreting the columns (or rows) of a matrix as different groups, draw a boxplot for each. } \examples{ # box- vs violin-plot par(mfrow=c(2,1)) mu<-2 si<-0.6 bimodal<-c(rnorm(1000,-mu,si),rnorm(1000,mu,si)) uniform<-runif(2000,-4,4) normal<-rnorm(2000,0,3) vioplot(bimodal,uniform,normal) boxplot(bimodal,uniform,normal) # add to an existing plot x <- rnorm(100) y <- rnorm(100) plot(x, y, xlim=c(-5,5), ylim=c(-5,5)) vioplot(x, col="tomato", horizontal=TRUE, at=-4, add=TRUE,lty=2, rectCol="gray") vioplot(y, col="cyan", horizontal=FALSE, at=-4, add=TRUE,lty=2) # formula input data("iris") vioplot(Sepal.Length~Species, data = iris, main = "Sepal Length", col=c("lightgreen", "lightblue", "palevioletred")) legend("topleft", legend=c("setosa", "versicolor", "virginica"), fill=c("lightgreen", "lightblue", "palevioletred"), cex = 0.5) data("diamonds", package = "ggplot2") palette <- RColorBrewer::brewer.pal(9, "Pastel1") par(mfrow=c(3, 1)) vioplot(price ~ cut, data = diamonds, las = 1, col = palette) vioplot(price ~ clarity, data = diamonds, las = 2, col = palette) vioplot(price ~ color, data = diamonds, las = 2, col = palette) par(mfrow=c(3, 1)) #generate example data data_one <- rnorm(100) data_two <- rnorm(50, 1, 2) #generate violin plot with similar functionality to vioplot vioplot(data_one, data_two, col="magenta") #note vioplox defaults to a greyscale plot vioplot(data_one, data_two) #colours can be customised separately, with axis labels, legends, and titles vioplot(data_one, data_two, col=c("red","blue"), names=c("data one", "data two"), main="data violin", xlab="data class", ylab="data read") legend("topleft", fill=c("red","blue"), legend=c("data one", "data two")) #colours can be customised for the violin fill and border separately vioplot(data_one, data_two, col="grey85", border="purple", names=c("data one", "data two"), main="data violin", xlab="data class", ylab="data read") #colours can also be customised for the boxplot rectange and lines (border and whiskers) vioplot(data_one, data_two, col="grey85", rectCol="lightblue", lineCol="blue", border="purple", names=c("data one", "data two"), main="data violin", xlab="data class", ylab="data read") #these colours can also be customised separately for each violin vioplot(data_one, data_two, col=c("skyblue", "plum"), rectCol=c("lightblue", "palevioletred"), lineCol="blue", border=c("royalblue", "purple"), names=c("data one", "data two"), main="data violin", xlab="data class", ylab="data read") #this applies to any number of violins, given that colours are provided for each vioplot(data_one, data_two, rnorm(200, 3, 0.5), rpois(200, 2.5), rbinom(100, 10, 0.4), col=c("red", "orange", "green", "blue", "violet"), rectCol=c("palevioletred", "peachpuff", "lightgreen", "lightblue", "plum"), lineCol=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"), border=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"), names=c("data one", "data two", "data three", "data four", "data five"), main="data violin", xlab="data class", ylab="data read") #The areaEqual parameter scales with width of violins #Violins will have equal density area (including missing tails) rather than equal maximum width vioplot(data_one, data_two, areaEqual=TRUE) vioplot(data_one, data_two, areaEqual=TRUE, col=c("skyblue", "plum"), rectCol=c("lightblue", "palevioletred"), lineCol="blue", border=c("royalblue", "purple"), names=c("data one", "data two"), main="data violin", xlab="data class", ylab="data read") vioplot(data_one, data_two, rnorm(200, 3, 0.5), rpois(200, 2.5), rbinom(100, 10, 0.4), areaEqual=TRUE, col=c("red", "orange", "green", "blue", "violet"), rectCol=c("palevioletred", "peachpuff", "lightgreen", "lightblue", "plum"), lineCol=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"), border=c("red4", "orangered", "forestgreen", "royalblue", "mediumorchid"), names=c("data one", "data two", "data three", "data four", "data five"), main="data violin", xlab="data class", ylab="data read") } \keyword{graphics} \keyword{plot} \keyword{violin} vioplot/DESCRIPTION0000644000176200001440000000231414641730542013462 0ustar liggesusersPackage: vioplot Title: Violin Plot Version: 0.5.0 Date: 2024-07-04 Authors@R: c(person("Daniel", "Adler", email = "dadler@uni-goettingen.de", role = c("aut", "cph")), person("S. Thomas", "Kelly", email = "tomkellygenetics@gmail.com", role = c("aut", "cre")), person("Tom M.", "Elliott", email = "tom.elliott@auckland.ac.nz", role = c("aut", "ctb")), person("Jordan", "Adamson", email = "adamson@wifa.uni-leipzig.de", role = c("aut", "ctb"))) Description: A violin plot is a combination of a box plot and a kernel density plot. This package allows extensive customisation of violin plots. Depends: sm, zoo License: BSD_3_clause + file LICENSE URL: https://github.com/TomKellyGenetics/vioplot BugReports: https://github.com/TomKellyGenetics/vioplot/issues RoxygenNote: 7.3.2 Suggests: base, ggplot2, RColorBrewer, knitr, rmarkdown, testthat Language: en-GB VignetteBuilder: knitr Encoding: UTF-8 NeedsCompilation: no Packaged: 2024-07-05 08:14:00 UTC; kellyt Author: Daniel Adler [aut, cph], S. Thomas Kelly [aut, cre], Tom M. Elliott [aut, ctb], Jordan Adamson [aut, ctb] Maintainer: S. Thomas Kelly Repository: CRAN Date/Publication: 2024-07-05 08:40:02 UTC