seriation/0000755000176200001440000000000013531266512012253 5ustar liggesusersseriation/NAMESPACE0000644000176200001440000000566113502520046013473 0ustar liggesusersuseDynLib(seriation) import("TSP") import("grid") import("registry") importFrom("colorspace", "sequential_hcl") importFrom("gclus", "reorder.hclust") ## we use :: for gclus in seriate.hclust importFrom("cluster", "silhouette") ## we use :: for silhouette in dissplot importFrom("MASS", "isoMDS", "sammon") importFrom("graphics", "plot", "text", "title") importFrom("gplots", "heatmap.2") importFrom("stats", "reorder", "as.dist", "hclust", "runif", "rnorm", "as.dendrogram", "as.hclust", "nobs", "order.dendrogram", "cmdscale", "prcomp", "cor", "cor.test", "dist") importFrom("methods", "is") importFrom("grDevices", "grey.colors", "grey") importFrom("dendextend", "rotate") importFrom("utils", "capture.output") export( bertinplot, bertin_cut_line, criterion, dissplot, get_method, get_order, get_rank, get_permutation_matrix, hmap, panel.bars, panel.circles, panel.squares, panel.blocks, panel.lines, permute, ser_permutation, ser_permutation_vector, permutation_matrix2vector, permutation_vector2matrix, pimage, seriate, is.robinson, random.robinson, path_dist, VAT, iVAT, create_lines_data, create_ordered_data, orderplot, uniscale, bluered, greenred, grays, greys, # local search LS_insert, LS_swap, LS_reverse, LS_mixed, ## registries set_criterion_method, get_criterion_method, list_criterion_methods, show_criterion_methods, set_seriation_method, get_seriation_method, list_seriation_methods, show_seriation_methods, registry_criterion, registry_seriate, ser_dist, ser_cor, ser_align, register_DendSer, register_GA, gaperm_mixedMutation ) S3method("c", "ser_permutation") S3method("c", "ser_permutation_vector") S3method("[", "ser_permutation") S3method(criterion, dist) S3method(criterion, matrix) S3method(criterion, array) S3method(get_order, ser_permutation_vector) S3method(get_order, integer) S3method(get_order, hclust) S3method(get_order, dendrogram) S3method(get_order, ser_permutation) S3method(rev, ser_permutation_vector) S3method(length, ser_permutation_vector) # ser_permutations gets length from list S3method(pimage, matrix) S3method(pimage, dist) S3method(plot, reordered_cluster_dissimilarity_matrix) S3method(print, ser_permutation_vector) S3method(print, ser_permutation) S3method(print, reordered_cluster_dissimilarity_matrix) S3method(print, seriation_method) S3method(print, criterion_method) S3method(permute, array) S3method(permute, matrix) S3method(permute, numeric) S3method(permute, list) S3method(permute, dist) S3method(permute, character) S3method(permute, data.frame) S3method(permute, hclust) S3method(permute, dendrogram) S3method(seriate, dist) S3method(seriate, matrix) S3method(seriate, array) S3method(reorder, hclust) S3method(summary, ser_permutation) S3method(summary, ser_permutation_vector) seriation/README.md0000644000176200001440000001070613406546432013541 0ustar liggesusers# seriation - Infrastructure for Ordering Objects Using Seriation - R package [![CRAN version](http://www.r-pkg.org/badges/version/seriation)](https://cran.r-project.org/package=seriation) [![CRAN RStudio mirror downloads](http://cranlogs.r-pkg.org/badges/seriation)](https://cran.r-project.org/package=seriation) [![Travis-CI Build Status](https://travis-ci.org/mhahsler/seriation.svg?branch=master)](https://travis-ci.org/mhahsler/seriation) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/mhahsler/seriation?branch=master&svg=true)](https://ci.appveyor.com/project/mhahsler/seriation) This package provides the infrastructure for ordering objects with an implementation of several [seriation](https://en.wikipedia.org/wiki/Seriation_(archaeology))/sequencing/[ordination](https://en.wikipedia.org/wiki/Ordination_(statistics)) techniques to reorder matrices, dissimilarity matrices, and dendrograms (see below for a full list). Also provides (optimally) reordered heatmaps, color images and clustering visualizations like dissimilarity plots, and visual assessment of cluster tendency plots (VAT and iVAT). ## Installation __Stable CRAN version:__ install from within R with ```R install.packages("seriation") ``` __Current development version:__ Download package from [AppVeyor](https://ci.appveyor.com/project/mhahsler/seriation/build/artifacts) or install from GitHub (needs devtools). ```R library("devtools") install_github("mhahsler/seriation") ``` ## Usage Load library, read data and calculate distances. Then use default seriation. ```R library(seriation) data("iris") x <- as.matrix(iris[-5]) x <- x[sample(1:nrow(x)),] d <- dist(x) order <- seriate(d) order ``` ``` object of class ‘ser_permutation’, ‘list’ contains permutation vectors for 1-mode data vector length seriation method 1 150 ARSA ``` Compare quality. ```R rbind( random = criterion(d), reordered = criterion(d, order) ) ``` ``` AR_events AR_deviations RGAR Gradient_raw Gradient_weighted Path_length random 550620 948833.712 0.49938328 741 -1759.954 392.77766 reordered 54846 9426.094 0.04974243 992214 1772123.418 83.95758 Inertia Least_squares ME Moore_stress Neumann_stress 2SUM LS random 214602194 78852819 291618.0 927570.00 461133.357 29954845 5669489 reordered 356945979 76487641 402332.1 13593.32 5274.093 17810802 4486900 ``` ## Available Seriation Methods For dissimilarity data: * Branch-and-bound to minimize the unweighted/weighted column gradient * DendSer - Dendrogram seriation heuristic to optimize various criteria * GA - Genetic algorithm with warm start to optimize various criteria * HC - Hierarchical clustering (single link, avg. link, complete link) * GW - Hierarchical clustering reordered by Gruvaeus and Wainer heuristic * OLO - Hierarchical clustering with optimal leaf ordering * Identity permutation * MDS - Multidimensional scaling (metric, non-metric, angle) * ARSA - Simulated annealing (linear seriation) * TSP - Traveling sales person solver to minimize Hamiltonian path length * R2E - Rank-two ellipse seriation * Random permutation * Spectral seriation (unnormalized, normalized) * SPIN - Sorting points into neighborhoods (neighborhood algorithm, side-to-site algorithm) * VAT - Visual assessment of clustering tendency ordering * QAP - Quadratic assignment problem heuristic (2-SUM, linear seriation, inertia, banded anti-Robinson form) For matrices: * BEA - Bond Energy Algorithm to maximize the measure of effectiveness (ME) * Identity permutation * PCA - First principal component or angle on the projection on the first two principal components * Random permutation * TSP - Traveling sales person solver to maximize ME ## References * Michael Hahsler, Kurt Hornik and Christian Buchta, [Getting Things in Order: An Introduction to the R Package seriation,](http://dx.doi.org/10.18637/jss.v025.i03) _Journal of Statistical Software,_ 25(3), 2008. * Michael Hahsler. [An experimental comparison of seriation methods for one-mode two-way data.](http://dx.doi.org/10.1016/j.ejor.2016.08.066) _European Journal of Operational Research,_ 257:133-143, 2017. * [Seriation package vignette](https://cran.r-project.org/package=seriation/vignettes/seriation.pdf) with complete examples. * [Reference manual](https://cran.r-project.org/package=seriation/seriation.pdf) seriation/data/0000755000176200001440000000000013056304344013162 5ustar liggesusersseriation/data/Psych24.rda0000644000176200001440000000376512606356654015134 0ustar liggesuserskUXֶhߢ ""J]ZDdJf&>3SkyPq_Q)*nԚ4I$%dښXk)7s;p`9wp鳖ϊD" }1osF'i<|М%~f\>_T;쵙 c~LEl}Mߵq2\uy7I9n?dXnT7ˇo2wٌH>uT>df),}?O)]Y(f ޓf_TsI7^3yT?^Oe;ޓ5j}f<oƏ6`yk<,zZ*[k@_zy鿲΅$Q\ynˤ|.}Y*6 ?I3߼*ve/Z'Ӻ]-w0IYGv+euQ1u{S~sl{9lK'{P&4o?n9|O(OKjwQhóϏc'~ڬoBj5 |Z7> Kq9 2r# m^G3o h([m:6j' 7vǤ΃e"H 7؈y!?Z3PqzXF5.7:z~ns:őy7`KpMyP}vqD švQwT'%'Ct*d0'7%/M|A Z?& u%<?j GhTQ _^i䖻@4)=uu y xc7~L^]p]}DQ':nyDWO<t=!/7vխ [8k<З*_^b'%nvBM΀f_Vs鷿 ~~OKx zB^oxD79߮~/#SAJ_O%u|V|ScWyG?g' xc7~pn #Ki䵏?|!& ^Rwot ~yi G_EFO'%'ݾ'o)pngXAx@KtFx xc83U9qcy? T:ՏM$SkN,zϔfJ: רsel> xЙKf:_S=e/cfBtE&LE[30%6&-8HY+c;9Xg{4IuA{5%HtKwrt.C te\kz#cnzb$fw7Ru }ר7n3־i۵so|;wYbӒ{3ܵ)VlbN~qŕ>7RrCb}mgd׽qb7!edǜsswM~tlЈߵcȃ7bdߵ4s~F6RA#>g]ULFԽmʼni+Y1b-߸Ek񮉎js&0/d]wjxR48lFgoA13[GF̸)Gŋ?or2wEÆ|od*rv^# MH8~>2x=g6Lj_?{m;G[rU+_aZ^zŒ}HGgd w ]wmF]ӧ?k4Ȱ'w1W}cN!|'wmD#2Kϝ~z+cp[0_x嬡Ә|t7s3ˈ^=dݘ1Fmyw;zVw?ip/0<'g8F塛<{6*_5r~I7=*7?v,K;.F%MnwlCnŠKvwoG4~g;m1o<#s^t㌪=c{\ü?wPU6x7epm6>lx.Fh$ZTW^s^{JFrw:˲k z^r-w:]v^hŪyF~8QʽfLO5E4~D..+8kurV^lVj#Q=86߯9H<ǎnF-towK>ryF׬/|Ax>f5+aݐsf/#5`l×5yQkMO/24#둡\hsWZ~?Ώݒᕆl!u(1%:#ܹMqcxvb7ϙaM%]nF~}OFb?ɝQfeꥹ>gFr: ?f{q#k-ǜ[bX_Bl9Ż }ψrĐ]5kzh|u7ӻƽ9Ԉ]ƎDw4#v(7ߓC6*R'd^Zxxpۗܕ.j1K+S|}w0맼#/EQ͍?}ǹz\`L+@<żgcc~2h7ߐ?ԝFٹ]\e*O?t=eʢ \=ϑx=ۯ2BGGgc%5}r ~{ }\L}m[|o˰>>n'jH]zp^a3wO#apIShCSA؅}XC~S9#2.zp|%30pKlŗǍ/|gaC*#&lo42^etY})>;ɨ^^[0df\>Ӄp@r=nޭEOWt3r^yeF.ݹB#߃dG-래|Ó 6ev~H rWwH_ wrFϟ5mSonbD/Β.sF l$&nW|pӶ%ۿ\:!=C^ '2c78t"oEz,߰e1F{޺Swnuo=1p?}#d%b9x/6\=} oYu? mtşS/"ǙzˤwflNZpew <ԋo_:%հ'ßҽv?k [o>SGc?2 k{{8-qf-".H]9ǮFZ_yGC/cFJ/!H^}q0,3g{'?ώ?|F<^+2H-8(W =t,ߴcdw#]|/B:>ަp *܀veFVrOm=+ 캭j{Mk3莬k26Wgi>iK4?| k=bPju[ocN;sg|9ιVpoy~ǥỏ黸cw~S{};ﱤ{w~#6T $#7ҍ?^c[_Yqa_`Y wȷw[51 oO3 ϝ^xѶwKvo9mM.1b[!.{}Cy&HS/?/2\⿚mB+I,v2]L|}//|)qͅӰ {ˇ#Jp@8=g_57\mwҼ 9n;K-GU\H\4  ec5ra=#ǹZT#RA׶L sb"0w5ṗܔs]F|7;*z.S'[[upϭ+Nylq^<{;+"s{"V9%_03w7`NwD~= }#< raU+6vLgd'awᯓOqeIܻus?q{.c+~G>6J7.qrugt| -z6r qNnaC9'SqDw@T  [oȼ͹fMtPН/4/bO2~x,/< ?džp?xD|Z˳4_!-ؽ'}]mKw.xȟLW ;Vg =$>3FrcP)6I1)iǯ߉C9 ? MSܱkU J?v`_NXlξ(Kk:/ (~ ~H'Qnyƴu7ׁ33# /vkoۿiw K^fxƁ kNs+x#gw to>7wV>'!w{+#qLbK_#{@m  {sWڭ﨑!^6BVpNAx|s,Y#xȁ~*^ IҼolr~#?{L`#}M?#98 Js_{/Plf:sTG1 8=Z}y?/lwH'# I^ɳNz5Nɯ\aTg ׶o /8t綮Ά/Ճ8]i9zy4ӟ_%s4Xx&W56su|#5_Xxkc;R,Ѝ_HMGĜs A ? E惜Kyo,{u$YUzY#psr{>mjpT[dcS.tOV s_'w-܇?qF#(r[F W~݉}ikzڪJ yDpp M>Co+[j-c5=^ZyQ׶]{km+z6{}/Kܨ'|n!'D^,cu m/ih#=sh,wr -U ] <H wy~moW?}yⴉ=Qwl v#UAғ t* ңHo޲?yןH(r&~3؛"'|)wS\n7S?q~a8IڻS/*Km_f!>+N#>>?6ՕoUψb%CW|=%7 U9q g݀ޤK|'^g9Og=j{A[奝C&ա3%}{x'd .I+goXtólߚND\ |ה#7mq' rWr`;`J9~.e#nJ]މcy,5/C^Nϐϵf|w޳m Ѵ<U\ FO68ȍ.! ^OVs_IcCpe%Ҧ~N{O~/F;cW8vDl,/Z*W0F*/9>;v=r&[BGoS/.E@l;s|d̛'*:}SEg9~]uO?sK Ϲ>?دy#_L|ssǑv݌^XcN'ݎ?? )}Uᅫ2Is3jUʳ_{։̙觵͔po΁؉R7gsW` _e GW؋ ~~>fo%_Rԋi?? j?X֫_i~(?>6կb#x.ۤ-nrk7Aͼwz!zU=Iҝ 6?G/7]De Or+^L og"WA["#g͜[78{`u?X8o4T6Ÿ ?D?߱B3jS ۂ 幬8#y' ȗX#*NFSOGrw F)uCc`׹}^;3~: CZțYs򓰇x3|)s;+oA\/c'<.a󯋂r˕Gɟ|^]^ھȥmp`XIq8i{~yهPW"ߍ' _\5^w\-]n1e?y ߈Ȝw20m[c^áп)kxE/ѳUrss/R_dI9'zmD'Gky*w`9왣u܃%E_4Av ˅N/N[w'yNܨ|RDß3ZT#}~Kuc75k|nqu+zߓe8ȹ+l!`oۻaoGr_{b5?ǐ7y O!^rlyIUfc݌l|F؉3nTvSr-vTޣz6uHߙ#zmhr\5T]}>~)0:>^S"Õn\Mʗo@39,Է>ެ>ogcЛPyOm^WqNxҼ+ocqGweF?+ȗ~/7:_84-ri eW,?wx1P~=s?xqO[7 MȽ4C?A~ g޹7aZOFn+?M8c.cP~&߈So]g uism|4qMȝ{=ﯩ#8D$+ 'L_TybGE& U_#$ƣN7,~5x' x#\Y?kĮ_ÎxPyg!ժ?m]tpusnLK x?VM|+q B+wu4r3%~3>FsNx}a84RzеG|~33犫2%ϕp~ؓ1~zg̥S c9xg$?9WJW>fk[E_@O{Ǫ>D=6p|펡gm{(yng?c$4/>8~8>E;}y(uǙW:/측ؑdZy4vs ]y4^fS|NhᭇGB-顊b/ܫe;QK^Ih 7n}e'(l8@+ɽ6w'fXoV'|/%_B.r`KJ}8(w#w"5{i$O\r811lqs޷;u}H_>س}GtpN^U.۾rW}޻\sޙMcCG_s97//͇PRu#9CsojL,pap=Q<;s  ~&Qus=܇ՍDme?y]^/􃶨amC[?}L|SÑTу29ڌˌDӕ-R p}!\xmaG #kKG?8p:iڄ i.v }{ּ/ؓ6[Zcr\߼cI#喝-\} ^~jq#2˸ [[_y%ʈ|gG\~Ĕg<8>܃64xm_WyMvn✪f wc5).|/g>{oN?[7MF8Xf{m3K+\h5@#:{XWuADQS:b#I`+6C!Nkb)oZ9U v*2yHvpzP y{xbBgCKڞ'Oi25x6!>𕚃ˉчz ͑_F+ۏ|8?;ύ?7b#rJ}%3  ڶ9 ~_;8۰ )OW/٧|}f#u!r(8)Z5$~tޡ%WUOXO <LC{5ucBUQoBW_D,#k\߳ԏ̚(UYeֱ{کțf¿EǾҼc'IޣY>/GgU8r8v}=5w}C^"?N̍Wz ̞N}PKWG{T|5(o#}\Oܣ{6}B/=GOԼuWA_F~DӛMYޤ~ۑ#A>sSq`s_>s؋(\Ú3!.2^~cZ:ƒo_%">ңObk9m7<PI i Il ^>{7~?l9Jr7)r_Ո_L;eajd E^bh- .u"onC[.zgܜcp+?˷/MR?CNH͇L"~J?.^jFMr[$ Xyz~>uHڅ{w>縪?vȞÇ?:ҹʩ6Ld.ƪOy'˹Oۊ~@nǎd ȯ4߮+>ȋdw{1.Ǿ"ăէB4?9ٿkܓ_(s[s4<{ͽ&^dFsnr {ZQv4wv'Ts53)>Tyz.ަ^#uā>|Ջ2Qk[|OŰKHguwz+@O>+QwN_ZA|~Sh_:Ҫ=^oub5x%v4qGJ!xgŏcq9xBsrv \ykLs/wأ]͊M!2_ʮF O>!>ܶŋہS~G^HΥC}Sl/w&{{n<.˨c{E_|vk8O9;WT;I3?jAJķMC|f@@󐩭Qӱ⟺ɬ%>yփ ~E yܘ;(?ؗeqrn'_,_H^/6qϳѢǚ7 z@9Rt$A\}f6]%[>V>< e֕ܿ) JɿEG&wZ[ moSwýҳ;4[&z`~u2ߗ^ɞeփ|޸揳{T_z=/;1~#}8Vqw˰5+~Uw~NDO0Sd5<9?ꤹ#򜂽<.ĿYw|;x{8 ~<~JFg/ƾJDʉOBNw } GK.FFa䲸W[1go1}m[Hbw}cG|{>ہVpCȆ8#v?}N->xbt_G8-xw~6M ߦu~F`;7Cs[#5v/z4vI)~- >G?Zz|G 'B= 7>a;w_\;7Q{33g?7^V#sԷ2%\z؏'/>.}F"xz%#sirQįt<&;&knyߥߩ9F-^ğwm9= y|b=̛5to> 0Ӧ7 C>ޭdg}j"vc:y};C'.;8/rxF7ᢗc{kcX/gkW?O7$>)>7㜭;7<]}Go97  &U=%~{5׿x>U~=}W[؁ط#&a?ï 7>'*+jܧK'N5/$ǪE'.O}',mѓƗ:ud ,rCɽLaP|0aU=ip9w%dS͆>z. W{/$'v,Vfqe?íax:8psH]-Ct\@<+^qԷ}apGBsm/OU"?^(ǿsc*bAjd6LJ)n_^3v,zwGk8Ҿ (-'*vp<)vX$|Ri#?³O5؅tzkXK<ݐVo 9|B[?7>ϧvuuݦ~ 1ͽ(51MKn q~-WI!z-n[~Τ~VF~5>??W1ؗx+vCv.rǷ{^c`/ ]#~@cWp"|.O4v3')?3zZws8/<,^ңh<[&BޜOv8)[">e׼0}?l,.^S7ù_ͼW9i.X_~l 3}玑]K~%3O:Ob )n ~Juũa[G怓4'}F}(7q:⹿zeZosa''i/E MQߗEej^s= H^=)'ۄv@ى${O/SioXOB>0]⁍GAdvZAy݉S;k6B)q):c3Vū^ .iOxؑ; tpio60`7Oen(.7ͼ:IMޫpPYb%}+</5r.<]}V^Xn@]WgV~ۇ"ς!Яڇ|IW8{~~[3׫/w^tؤyS8DPqe)|sp/4nnş;@?X./$^z_Źgq |0_ªh^|xunw~F=iVJ>/WL =k|2S7ڟa~ͱ~,}~D~ўJTTtRU0fFnEg:7}'Or^ky@|NfjѼR)pu[s7~a%8r=ҳ͜W_y?s; <>37&S4Ű;6z+yGG|,KQ{$>ΥmyʹcG4D^iSI!kk+yk7=Śx}j.e^D)e\jk׼ /U/EaA\<ɜsi_ NDoSG sB/4}9; Rd!v21?3GB^Wro{KsUR ځݢW1ozIsGK'':&=o[} NUdx4/\ =Ѩ5c|J|h":aʫ%UG6)8ͫ^^7=[q%9|:Nӈ;yU[4{5E{=OB˝}6,3G(qW:7дxR.<⹚ԅsM_οgs3=+> ȩzE"su 3ޓ'x '=B(ͿU'x$^UZ _S=1,R}כyO+n[<Oo|B[9/H~k_vY>o4^~cw>x$sO,R<N;jSѻ0YnO7Oj &b\ ]&9U~&4!7髉ﳟƩG[n_n,A\ݯI*4WPqUSk`)}ػO'g;}M۸7<5:?bB?>5xGދ^xQ>2?\M/=Jy&~nzׂSCei*,72\E~*$+OS{_hw,0WE{<.r;͉=%ܩ@~!WcΝ|4_9yoÞxkGDlj:RS%65z[A>ͧS?]F\+e;mGe1r)({}M RɏZPHt%7!gá7\?׆ǹƮOSE}{ěs+r|-}Z(s'g&_Kb\F VxPyů`:kEnC}9?6!ύ.XB/W?!=$9K S ;9oܦrA-C9<@]pg:~?X=oN~hNs3+īq#r Xw湣Je2ҫ~mwlNõ{'ezזG߳6pjbU3l;1k٬> %G}xL qy( އ|\CO#-߉OѺ";4cm_k.zeg<`':SjNr8kF{p/ȟ[Ta<vRد@?vs.o^%З{mgWڥ?e'9{h5g{#?S:U\zیjh091Sp>5񳵝c0F|wpMNׇ(Ll~ .JK'\n9\Tԝ91azU6K]*!sZKx165oWbO>|/O'w#pαH6iF>ax[V?xϤ؁ܳ9v?&>#8D3|8=!\&~Z767w<|Q?QBж / %MYSꧼDNK7zTwײf﷈x;'O'j^e!)Ə>М~a핷~=J])bVlt+zKRԙi6>[kPu&'E{EJV+7kS~^s}5ؗ8"܇xKι$|6>7/B)v5Znz./֦<꛼]j_p%=ᯉ޷K X>8&5p.$>s?F4v)ZÜgDoٯ?Ū?ѽf}gzfMǣ^THwupjux&7Zsk'kķT}PIFZW} o;ʾ!>Lx;ījh Cx2}12[3v{xh/ʿN~v|@B|Rú6᭼sX{>Fo%|x?{F٫x_FtS>^Bw}`KD^⥲x/=L{S` (O8}[.Ee~2 ]4'_>ܻm>A855ȿg9UkėjgyCCأ^͏>+}?o"o{n0Kx2WתsŸ)? R/ͯVu_<(S5z\`weo_H<Y{_4'|wMW%,KrmWڑ\_͹._%$L}fpG(U-9 Ւ㹑Xv =c7hx\O⾧j5ꣵ0ߔN<ꬥ9_/T6/F&H{V/8^㒿Oq?/#<W};z ?f[_vx;sW{|'âyOuOϒNϘͻOh9z4 #2~6h5n?篦 Ki(TG N@/8oijWs>;_xuKs9Ru>K{B|]?amM&+^}=V;43zkW_zD4r_=K[ZS}'= r&&p[!rxn{iR%g<ܭ٦yϹ;A!;ߐR]2JMyUI%q~Ɨeoh?xݥsM ]:mFy-^]L~&_ O8Puŷ0 k{i=w'zTuF}gj\siȽܸBK+?POaƌBs n'p53Ruls\vr(."G2o/sŕ|HyywحR]Uֱ 99.ek_?6]o6;y[c9T4E4yHt־Lu'ϵOOݠ9V| _hɺ*.Ҿ]/9S# ש+NK> š//)BY !a=պߵ|^Y3vr`NSg^Ls=joKJ"ޞC } qm[pnmh y^KLy:Q5ԕޞF;!e?Fnss4r9P[A9_2s3zeKkOϵoqEϵt'\ȟ~בcfx_7\nT|%qڢ7׽9-9cM8^)_s{HWm֋ǶGIS'}@jTO]Qjd Eg]rJ#/ϓyyɝGRd$깑%S⫚eQN|}|穋؉u^S9w5YJEiX/~.KE+4/eF [9;/nm2\m@{?5?7y\#"^3I9|Xŏ_@D !{?7ӟfyGVn*{B|_9DZiʒ8<==ν\K)^}+g˖&"[TiAxvpu硫ǽ uW>{(gLj'4yM7ݥ3jy Cz]y޷X9-؋b`>=,amMnR{ y8(z'8'2x7}2+ky?DbgN?vIg9Y^5+~c~ڔ氛A&w߭f>UuƳyM|OV#]!{|6{Ԭu 6^o4g1x|}Ffr;]&}Ui#ݨ~#~`פzy ½E~[7Qxʭ?V:?Gi%fi߁mZo,>_8{_ojxds!> h>9?_/ ӗɝFͱ;:Ѡ^5%>#x$oYy.q~5rfXԗ>]9fQHJ;  o\J 4¹ti.+w{ۮb3,~W?+ߤk䱻9̿૖_,ϵ&eE~gJ</qd\{;WY=ߍ_‡o?p_G\sψO25FYՇN|-~~.u Ws?hYMwO<_#i0:ݨq5kL}7O|%?_0QV(ٵGoῗ@[~G#&񽡥/ڵ>> mxf??dgb⧀'}r^>Ci[%s3^ Ϸ'_$őqKlUgWqy} j.R`9p8CIڧ'﫹#3G _o q䱳9g&k}^--r~gp ?Ik;y{=)_->1Nſi0@\ߗyŜWb맪|Ń0=##^kMw;9綊OqWzts'7ߩ}mQUk_B)}5y|wӴYKsjYxqv iwb!*ο~ثG3Я~)ް}Uo/wK=*Q_Y6@/\cW"-ӹ晜Gvg7yjK{,q= nkVէr[eK:Ǖ꯿A+{Iœ\*ǿ>tzoeKēz |%>~,FpZsj⚿wmܛo)qsMyo9~+{wO3tFi2A~A8SDϢ'>H=/ P/+>R>z>#e_p.e^w#]{M7#YNl{ {kbc+Ս#859O\yːM':PQ>o9ڮ7$?S_ l_aKq߭wpR_[{Nq4ymt'^z-؁6{>xFWNq؋$Z zk_?O֡xٷ7{#2;$XOխ=nͭJ|Kij'py4rmmI>Nn&VA^8quѶټoHu-ʃ攒?[6m4c}%?Mu8Kpޖ{^źUeRg<{!v®8*x;ݹ7t8C}Ъ=0?/nk_ALGo։/})Y ˪?PR;t_Ѫ~SqQ,WQOMcw Ҟϣ-g+^/ >OhGO^׽ ]x.y7 qs+1=s&y<'K|-qw[iDϒwTs΍. <R'LxO5W3 4Y<=%w3>4ǹHqx⻕IN^W4gq%2_SDGǹo穿xS/KЯj/*jBج5U؝WMGRel//8^ʪcs-Al;ɜY"#x/oT n i`>c|PйO&g!*]Ntˉqi4=N>aG]A:^#O[sacG/x-1z:uxx yY}EK9z;Eoҿ#_ w%1E̿|~\}$#+dBO,vřУRo, /Z/'D}]7Ĵ"w#3{ W7's gӷi/1_v~>F/h.k˜| Eh?w5b^[B/[JWN-?<޼og~6o.2x§vܿooCThvQ?tm//О:bA>oSpQ'=MQkK:yȽfwYW>֘^6M~%i/]E_=O'ۓ{7v?Vyf7hgY gW=jcK/z< SГྲ׿h}ius̟ _XM H{3ZK}udz_>I<4}ߴ>JբKWz:4= ~6]?TvC$z)3 Ws DWov~C%[nnZ$-*oq]|/4kc3d_X*bq9϶ؓQ*Ip1cx*+nY'_9RA85 ;wU '? s.c_ŜkV{~?pg_%w,=r//klsOo"% /9ຣs 1_wߖYUgozϩ{Sp/>#?D$Y ~K,oBmjcQ{aǔ}~ѽ5^8">eϓR!p߬cgҼT$Q_?RlLBHO7iQro N{⵨z~@} âW&]c)p6jP?A|țDž_?0癿J!K~^[>SId=jz7 គ}?u?`oBjDž|E~Gޡ/o7߫~Ukx?Ǯ)}7C5וUu cдi޺Q#g=3m xJ}H"~qM³>#stYSg4yV\f^Z/O.;ȯ[֊Tuڼ_W=e?٦~wtgh^+uK\ӲW11'7s;z#: = fX] +¿;&s/^1G5s,ܫu!(uy!0uww~󲛰-=ԯҟ{S$y2K'eDų3\h \M?K~ +^I-v%7go5,#K Jw7O_hP]%ğg7缅}op :jmgo/y1x} =+G,xgۚҜr?}-83/mQzXJn}/i.>ˉ Ÿ0]U~gE!9n;QbMKƿn_B=eؕDuF]ʖw&^߭Kls'ɏOx|S1ɪ7D6 ^>M|pZ`&{IqMկ&?g7cgO¿ӜGH1_~9ˆI*#ky9v_&rbWSgϥGc~{Bn}~$YG}ܣ>H_uCdT>CmS z5~=|#υ՚WHk>EuOۙO9Okop=^K@^bquk?{襵|Slvx'~'FH{‹3_5 JVo)K5?8H|Skk&.^"S6i?A3;Qm武j1m/ϖWnZ;3y^x3:;ߤ'7ss[U?x]m秊DգWROhmw3{;5܃'ے6졞?U}|cXpU/R}E{ÈKӗċMUF\~ ?l.x~vûLz"ze ?UͫvG-'vEԟQj;MON>䩊nN} ӸFܮ\'WSdz͇Nz%o@Ī}6g4zPsO\?Z!ҫ۰bcs!qy[J/Ok,%=͹}xިKq/Ӱ ܘKOD'?n+oԍ iv-r*Vyua_j0gvyT_οv/vqkٳwc+_D>Ǭ8>t)=ZyW }-v'6_ro%5FG`wKu~%o#~ -~C6amOݧz{Ҽex_A:N pg4؁}i| i;/C|f Y<Ъ<?BL)=ԋ<}j}99>9k' ?@s]䯮~lOIk^y]& sfrr_Gy{ ʟK_9ɥ :lC;s_ϋ !oZ*> ={}xj>N}S4JMu{o9ː'ŷu~m[װ@n(?p5pޡ\mC:>zNO g?+7d#Ps*O]`*E/,^u۶] lO|21ZG&LMD^ڷQ .=kY+Oei/ݓLEp4_͞/G&*ʿZ"RJ'6zヌWrYT{nV)yWaVy}XV-cAKJr9O#+>:oPښ9qdxu9\չ'"7 R+Jwi ?r2 (}[ܜYާ}wB]\L"ޟ:Ӹ'=GDWjP}qj/DJg}/̙TY<}G%WOJ#Zu/GvAxKՋ3gbܯGWjb5chB0siH?iWK!^Q~l+u.հ#N>kSEl.ÞNB_<߼w]"o]89˽" eNªSi8@!=fcopKoW=7]\H֫&VAwdvoY,>u@SNp*lOwv;3GBT<vDDz}sTS<'8of.X>\_)Z*h]x 6=x_R;Rҏ|D;W" 8|{~Pgך۪|gGIn'7-S|#8o h_p'%g&voTc#~8XLvp`jÿZs4L?.i~0kη>H#|:x.<_x016X'{vd^࿉y.FYs?hd\V;W|ԊGߑ&H_Ϸ=|S<; 68o|&6wo:q޳m<;\{YF荧+u+?s]>e?Ky N+'>5j¹oHpwkkr"mG9/5go:.Rd.x~z>]}7b_[o95s !Ӟɸ|1zT/olw]#5IЧ=c~ sY֊9Fy3kM|WIn[ćx a~#^u3=H h42{SO{_oQ@}}]3TWnVW =KI32 ʯ"{_fgwA] 7@}"&Cw_ w ߛX\N9y/Z{*/ENr-'[2qN=뿣9K!1:ig(E8s3~.Z~ZΫB9|6s#¹m:Мo` ƾ0P4k g<_7Lb79`payUxҭop6xd)?x;TrmNڬn46G_*}YOݓ8^қ*>qʇb2y/~x>:NpC*x+/]K &9ηp˦we7nS"<6cCi lp/|ȁ]{mW˛ނ^0waYpuWER5S؅pռe&t϶70E\'= ;Q qf?AΧQ|U؁374 ОY.F.L?/TrU{q-b?Z@"g8zk*pK[zL5^Gjf!'L4/ٗa_aO{D%bGrkPu޻ZO _W3W{rG*0>%O{թΜT4ǹyRin͔чݴ} E / w^rYx!rmO6ϩ +%9 S:*ByO~O rrOGWoELM7x7f}bsC7]A 0|L}o>!rR"zSƞ&'(G=|cJ1PxiLOb:͛^/_p8!}'ss6[ O+𷍦'O [ck-X7κ[y{~vgT>Lv߭}1g6ݴ[e"I\<.[A^"% = ءCc->yO?|o| Ü_OE)>׮}W&+Ջq)zx*skANf.tQߣ Z/~K‘?sxoExoZjA5_C!Ms/ܣi.|W?c5s4h)߀>2SW;P <Syƣ\&pB}5/sl7OmS@}_7 !%QqގDmE25+sS{o5Lo 9kߘGr({9vj_2S%^Cq"mP7ܻDnoA LE}vC#OvY U?:]AaA"ܩ}l7%*5Gߊ|V?4bnCt~E[Ewc:+\C{4G{bp_)8(섫kQ#R?e,yRϬ>*KA]8 ?̃ڂ?4ggbydSw̻M}~?){ϟb8nU~Esit=Z~R7βA d~ñ\{4sPy>95 LfD/ MlQOp;ϭ=jSɯyրk>8~¥zT eG.{[w'L_9u,[s7ߊq$/h 9j;Y>EL T!wMF/?u_8Ϯb蹫+~QW?n[ r9O2I>\[ɟx^O4>W^6<7Q t{];_k+SnpN;A,iS=?Ԣu]op'y=w?<{.C= 2W-أsg7vr~ȯMs8Г9kꨯpczSڂ>/@ɩhd3F?r_Ayo jrW+_)9@y< WB.6JT,/55~}{!*ೠ"ׅ߳<ࡆwV'D^cN@s;xZwjr3ɗUl.1%㌚5ڳj40eV=DD4mQ$:Zyf͡MOŽͮ/ 9nԹW F@_Wz/;{q!ɚDZH칕xJyj#~k\O@u 标 ڳݪVwG77ŃBzYKgcB6ܛϣԥmQ IT^9ϑi܏uW0wk׀mx~ūykp 3^s: ,K<G9n,m~Q=Nk˲1uCUەw/x*7?aߌ+n݅~}ڧ|.~9Tͼk)~ޭ G4T6Q{!޷_OB? w“iOrxmp<#xF4{؏B~Cck.A/CK浐77}Bngo 'nG olפj4!WO7ullDOK_6>K>d}d}+g*g{./b+T9%$?U} vt[jdnA< &`E߉s@gi|-CnwϲWsO7\nP}=|Odpxf+gkυ9=Y驊'oCfO/yM\l _? zT`:n r4:exz?rz[r ymٿ`.87p~!7W[riܗωy;?OI~>ԾYr*RٻV=3}s9 =VB̚+Ѿ}PӅw7gG(B%~9S>)̿+P95'aa//' =p(Ҟ$JIsÜkxzey9sGqyX2;:7ΛN_G!n*GgО]wLopM?!%=\<_cGο ǹר| Pxǚ& v)O,i|pE^XQyP/RquL>ci{E]\6 8T@";.S}~׬}>xԳG~7k5 3)snQR~esyQ#݌_sX0IgL_ͷyw]/ hUڤ<]/,(ϵ?iUvhUi5x/쎵88ټW>bPj͜N<0(Ά*c{`s. yh7;6}qL<5?DSzۄ3=D~ì.εUVڏ(W=WN5yz;B~`ꂡy8ö٪+'MGsY}T'RtN%uĪ9ߦ)Msy%TA??!W؇|PtEW=3Lp[UO} i*|7=x?k\Q|W1U9_ʧ9 (oqesThoEaЬp^_,;wY?^Ryp^usL9/e7>{v P'ZnUʟxiU|h$uEV2A-A%ރxHy__IOΨL{h.4<{Wy ?%^w?⍘'hYbcgDcho/V_n#?Bgdz9pNO<.>9G OY/2?SușuV z\95:Dp#,ߵs}X}{ޠ^V@%9_5=ΖܭamC}s#nv>E*XO QwF&]y$n|Gpkɉ"UUԇ[;6u%kx5J?RBgpz@X~wgEOCڠ8eFIߞмQ[Ŝ%ߒ+zL}HoJs0Vtr纑9 ~;Px_W}[]qHX5جC~}aQ>[ףo=59縋7uӼCQ|U?%s8GmqWaou1uºr~LlS~Ez⎚ pq|Ey K> e]?iUfRP(?_S沛hO77OJ8hWOnxj-s"/4 ~cG?h.>P s>GU~n.yӆ7g <|\=^7=E™V4`vƞ<Խ}{l<-RIk^DK s{c(/?MUv.8-y!ڏmX+9bzǎW^]-7W!^NA|p}.TK؏YP̵cX| ԗp?W6+9NjcQ})@?Ps;}{3}Lpnd={cqY#N%?阣:Z=y߄7bog#) . wOclD~\wǮDz>{W~{4u@4g㺈s$Tr'vN}mi#u;S:,>9!im/kQFf#[/ؓ}') xǟĽ4k]y:g񇦇{ h`5,rp|>oƪvziV_Xb7S^W^>v~kJAx M޻P{X^9b'Ϥ5 (oP)x#Qk;,S}ˬy3g-֏j\]Q nƠ?yDspSq^5ףͻV.U{7ɥːOxf`쥊! 5ggEnV=%Zկ>(Мx GV;_vko\k'5rvpփbWܠ9h~ƴiַnܾ8D|7_Nk#st!1W=y5)[eM =LUջ=:o|眀=?[|fBY7`߯Mb7d(_?Iȟ=Jޯ3{]j$'Xݯ~lJ}ۯh;yqZ1~r7W}jsw7(OQ89GV<߮ Ϋ,~~Z[چ@ "Ϸ{]}63ٷ9s/Lu5ؓ!X־|NsoM _j4E)7jqf>@!7K;岫8WWToU]p'j|Wd)y^.vsgW>Uw뮳p>pTds:Ι xJ>ުx~GWwMw(wzp>.}eI=ow2^cSu_g0=WT#g6*2 94ghĤ6\inXTNW? M#s']߆g ߪsW~d^R}W Wa9zRs/r_oQ<X =ZosuUg p:b7#wK4|egN6IϿ),D],zaMwkϱ#ϞwՔĮ;_4i^3J@yᦇΥҼgxh$7 6oC'B[+7gVr.Μ` aY? uX u g_OM5_O.#T|~*vοrK{'q}<ƒ׋9=4%ݔ "C,`aUʼ1lfi٦/c) }> \ypoMcţ[ ^<}ɫT^&NבzY 2(^T˧W{ۃgVuxHB7i?o(εXsNnxÿ|Fpun;>?0!~Q⯲ ~j!Ygf`O 9FW}WsTopmVFOy~չg!~0c&7E =)޻ ]_{Rs ҷқ(D|y;]|ě7x&Us4 ? .9U'*y6 /`KG7Пιr Y׀bwpԯ-^%Y߀g+圫4Lv08;>1<_~-ea zWnT7}`O;$O iS*TNs Gў NM'Y&%ch|B{%^vgY&kإv7vOr]zGF8]x32S{2_uaoNz7Iug3Pyɇ`^ bwCȥ9=SEX% t{8ܾ{^ B34^M.(!~{p\JTՃo'? S_͋ro(Џ๢ժq<,t#7=yoc[t?=jpN^=rQ/U?*SwPG7eOqW:c#,i&^#؀ON׾xo'%܂.p7b>߱%3{C/bwjćмgApIq@X~T]9-/۩{j܉3Iw(n&>LY`;`A<ꛮW?͵ڻ#Um]̻vlFa+3K4|kPM;'M7hRBCw7~ESqK^~䝜r[I56NZI:;T{{ %Or$\؊3LYUpyWv8Ҥ|I[stw?\3ۨTmZZ.s`G"*1,\Rh(?|WYM;Eū87 R}P~|͟ϡ׌rj{_V\\XU\V9`?j8GxI ܫc>aRa Ca'OWaTӷkǮ,Wp "%Bq_v?#Z>"k_?` 7?i6T5q=^y"8j?d~j?H kȹќ]}>1GV1H?ˎ$EʯgΠHrSp>yJ4og985˟=72=.y[g6-oV}Z*T"5[O|.8K_?gGϬg`Zy3wuοK M+/T~6_}' WXN=tRӭgG:Q{=C>r6{gۀndmt9`O#9|\xuv{@ꤦ{;jyˇ/һ>߉s|GZ,-{raw}&sO%OT>cQoiלHxLw?)ԜM>k0_L3J;Uʢh_<ǩ=^gڷQ|W ~P=*kPCϝgR0_ +C4?zjhw ?Cobg*Km]zdRldɢ/}M͑w1{Y<\I>< ͙"9q/q5t%ߛT=i9ḰWElاrk Ƕ'C|QQ#ks,>{aSii5QUYKxbsbJ((\`Y5K͊c?[I]^kP._%ФUŃ0Ouk~Ϸ݅s*OW+_9kL[7-7s-wOkuc>MsOK^WؿۤOUeYMxxSs/}kRTՇ{54gʽvnĹ$h+7[e{\Ow!vҕ4my~wΠ.ufܳy>ۻVG}AvŭO,:/,AS5 ;$^6iNZ{*YaTh9X|өѾ6J횷t&u:*^cyc8hyϮy[ۃګI+qGkX4o|}vݪ7;hbn"7puɲŸ6Mߢ9{_o3x1O^}Vʟ"ݥ1n4]wnǟկ>bV {}^-Ѿ{wxthߋ}+nQ>S5AZWJosvY?sa~ѸͼE,.plWŨ_hQiC SBG*\BqF5Dz@èV?[Vm_uZpdӹg^\u;xdv~b/g6i2u=v%zYzqsն[h/Vkn (OU}j>g;zM'6oqùTgOogr/[T`z!8ӡKki <@0I!kNW<~3*QF{'70ϗ':́iʅ ׬C|7;;T Ju7C:Hs_aϓnTnYJGt4vy=]ڟ}"%U2/!XړدmZ'jpJާ!iR^?׻<$[ أbpz! MIų'>lL>q5y۵yO;T{Ŀݬ9l4Wju[%~6yTZ z'ߋVޤ}/rR_aH%xږ{Ay=ȿW*lQZd~zgQx;5_շAs.sTMZBQ"~ uyC!MTVsRyʷ5g4_l8~Ծr=~0yr#{є?n~Nf'oZw'tx2^Q?"rnާ-OQ$\PjP|sk@lb:[0oq~qLG*F_՗Q9ۦy U} D}51AOJn[\٪}|@v3r#YR}8󸏼Vs,}PhmGMҒ"͇Wx=__v_'QG[_NտYIڿ-|e]^HկJiMī5nůMTڃm_9WdkT۽ی#~l=_U'\D?m%xmiq rR:C}E oQ=*;עBLKӱ;媯TWZċp{9Jɶ9w媯"Og|ƫ B\ؑS{:@LG9Vm8 I J8Zr&.V_ܴݥKVpb͉5O_y;.Ճ_^u/y% >Hdkx-~fmˍ7>[>=33'xzȧw>~bk?_v3g?ޗ"Jy,xʔ=ːs{x6%"ٺ &5Œ^Wiٮv&{.l-Qgǝ k^>54P<⡮Z{[8B}(M]/U)7O1;[݇?SErԏPWb۱>p$D߀ݭ`Hl^7®7}oދj#k"euz2;Ϛo#o]`7}$|.9y6jJ?z=KM՞{kyk?*|Kԗzx2MRh/k{zv_MsּH?/YO߀}q~^q̏+i-POl|*y |glUq^-C BA~1-R}#,pvpc6o9{?_+hV_gk)gSo/봗]ܶ1`\z>x8yq0)ߔ ?%>m}:h&n7.lYzM{xn$_hU_nß]Om6 OQ?S׾53O s%*B/r4PJ/O] qs5+> ?CT<kO}KxѴ_-pge@g4Rs_+gT ]Bdۏ}\5_ {5',j&lGWY|55MT)/ qxbyEIIʱ_ &oR,E;8̚U@N׮97 ;%Odp~ÈkūzR;)>]hTuAأ[TO㜲|ЫOScϲWoة[3j=s,M![o["0ޱh)v`2sJƣ'7ku ~o]͜O SCx؍o6+Yc{;<;#߉ܯ>9mPs.~ ~M<⃮<{s}ö8OvsU+yNfɜo $4.QqQ9l=G>Ϊ+^LK>G?Y?b*_EN˅5cvOL\a Ń?ju\iz-UT-^^ӎ--??5{`م}̵t>} ߾ S_{=r$~̭>[Sλ|wՊUy%OUsYxVi>7IkO}M-a'?c3["B(T^g$,^۵k-(Q+z\9T%HzR1rR"=cMxWѐ| ٦{B\[oA/>ҳ;eK/啱IԸ;7I}k}^xwsʻZD?)OϯV?}cğP?[* +n?% xěm6]O<{4Nmr,|?e->&+J)Zʰk\|ĭ=zM곭5א)g?轏\秪7i/TӅʳ|'>l?)ZVS3v}7]<˰/>issVOkxP1M~fAOֲC~ ;i-+7Gۏn gL䭣.>6Xvdf۫ʓ[/_3m\sO#x-դ؆ݚOo)OZ.Bl;y^kz--uOرNuN+xqGЮyіE;q/u{.6kE{GWf_2步V} /[sW\?cJ>5狇@uz}soO"Qȡw:uv ߤ)z>5r"AR~Ayj_1}b"Ͼ|og1Kڳ{5پs4?ќоc8A49#O}Ҝ)g"yskca'^8[2^;7c4Z2XfO?_O8إ2c qC}ޛ+#RF^k9g!U^.վ&tmvʞ'ѣnͅ^,^„egU~;꣭mz;{,~W>ۭ~(hsl䰬r?7{7wyB͋[>TcrW7Wkv/?T(>(~zy']>Jb~3O(iޫi=[y{wעm&%>)w6űGXs-f5G^ʟcGoV_Cz~٩<:h?{sثglj7O|> g~_+V>|8*^&,\`[R{n; k_cHTWrw+ %ߡ:)%Em{&?'%>J-W~څӯi/u'^\c.ƟYO!.r+ζ*djn">-"9L4Xuv9Ƚ2'k/]y-+ߖnx/#'Xy[⏕iCkg_¹o 5Cwq/ȯxƮX>:sNGc/՗!~S_QM_soYOsl%>;:C{ZK>$s生qWWqz"3|?uFՖW\k,≨67JL"o "Cԏ7SoWUd;?SI0rΙ M+o1m]cۏoC?H#ܻE}FԺ7)Ѿ^p`0K+{Us7xlzsUosNK kY{c‘7w}P^E{}ߠz&o~UvsUwίך_8{}}@xr_܄\;;OO<$J{ P{nxjǀwknLOogY=!<DNG>W7bǛLsI^L#PPwø ?]ආ'vֹ#ĎY#?'޲WsPG`lz O^/5yg|V}wgGnKHvH>w"rT:Dawӡ܎W8'כOᤲmna0fG/Y۹2ʰwS\ _q^틮+Tk븋ä=c #~;|JB'Շ yXNP>q$rcͭ9)Ik^&קxbv̲wWq/#BIߴ:4?U/fyzNsf_r. v/͍ZoMx:dq1yw5炿=r8e7^?޿i6TW?eڿGȁо4g:MI sTU?EYo[5y{gaExKr~R}WЯދAB7[~\W =UCigpϭjE^}\ly{^,|g~q?C8xZӼkmET}l%UoYϻoCJ4H`IL|5K葽"2M_̻C{$-pI?K"9#A6hUmi8R{+FbW;<#gشw6˿;} *u؛+切Jsv~\^C p3۵'e-RW>=TP4Y$Xk zvڻ|1CsySCM_ď>?G|ހ5G]!p˰O r_鹐Ϳ׋EquX9QMWԜm58-۽H#;Ox][I^gR ?\_|E<- sOq%XzYuڲSk_#/%9X2hl^ .-XGުupx0'R8 oRW{=Tϵr+'%h;B} W*o^O&_w\(LjJT/5Q>*qNxM>hmڏ_Ds5W< oTg{xD;/f1'hמӹg[K[~@x g1o/ jH`J*٥>ڛ$vO):Yx.V=0,S9* A9r5|{ս?%eS݋"9v]9ڷxnc-ߤ='>Z#hSE]GM#wxjI65:[yZtikj>sҭ7Ԟ+KصC~xSt rbUw7j/x_ԯ<~V9n>Կ+v7hKx= "?w}awgPi)V2JGs/TşҪsGI{H+U?cGM:>02&>xwvѧfS^;j:ϡsũA?@ wU_Lky[(~wW?RUށnEUgʇG:oqʯV}O4,y܃]6?ɩEY+^_ě#}{Ъf)O!ox C<}NܬegWq_&e|ګWvY=+ڇVrռqėjC..եGfWyק}eIrpeuK=k/9%Wj_7V]\)Ҧ8i&x zR4QS˱6)th>;RUt]ES?T]nUVϱ {gxx)!mނ]jnxFIWq/ԧXOVs+N7;P;oNȵDPGk?O$ᣠ0oߜwI[9GϷgS߽e\BNϞ۰;u{XU'T4z40OiX}Ko}CG/UR{C'O 3G:4| Mud߱Vmhw47`5jNG?Ku9߬=K5>O(ͧ}4犧$l{_?-^^W?o-vMz zwqmMșe;kb/Ӥ>/RmO7 ǕT .v@4VI}ζ5'=Ry|'߀](U_`صQ5kߥXWs;t.xfjA4 TY}Uqi* {ԦfW_bOk5>sF{ſZz,/Opp[O0hR[~XɑMuE# yգsOw{v۟R \vHϱh*(L;Q{1_m繨I8E{S5S{%~}%w{a|ӏL5oyhg|yq߁;42{ǍIkMZ~kv:+38Vq\*Ѿsk]{?^^۰{+kq>c?׀W=sλO ";H$~((mS]U3jOfvI|6?ljWx@_@Lp/OJp#\xfΥ([<8%dd^*iQ,]k~^{+H~ԼeQyoڪ{UsV)Mߕ[?-bEsowjoH8\YYgHGݱ^\=i~/8SMy㑓b)5ޢP򧵪VлO@sVofFzT_rqS!)Wj_)LZ}UW:o~"v[kq*zդJk [HAa2͏L9*Ѽqk|&jOrT{&:WWЂ=h9?Yzspn#;o=h-7u#շ+gu/CXΟM/lxg` F*5|35OtpQʃVk/a /l<=|MTs/i7'VW,ǸϒQL8C Ńا9>_{[UGuh}yg.e6ޫoIT.V^XoMgPru'@:皿5='kmT}/i^8wjzlG/"6T{Z+>/.yJs,n݁}h$^=Wkn^nVEI~y-xx&oi6 UV 'jOc1\,3ЏDSp>^zqvK?%xq=@\"~GJ ʐ{4 zk% @AsŻu(sSoP?h:wnWU`eUcLzpJNU=w5Z"W}vswiORwK]38̭z+xR~feqnxd/sq/zI([^@_•߷jW3٦hN}l/U}u^)_OV𦽗o{`|ooҞOMcgh<{ D.J* )/kRA+C`W МSw6w_? ޿Uq{sǩrK Lq3z2)a_=` C]~ /2!on>U_LnOe߾dޛVioi;yٟ{mS |sNoo} 6.@Oʮ{;r%B{U'NkY՚W}ҢxƱ=Dyĉ5Z:/;{ެzUn9As5ی+sgqlռ[|W^ŭ>tx@^S84gUlV)K^^U?p{w[O}6vFyY골Z'*~ZZ=\^="(_A<#jw y:qIdC?ǹz?%.W}c^]|NcJ ֦x l#o_X{UsmpO5I^؟ۈ3J5y\vJ{6܈s욇mZ(>~~Gp<}N@x/xa:W>;V{?|H,~&bX}9Y)Q_G+T/k^x3м6xSMs$ڳTY{cRpEѹN8.kιA{ [WI0u_GX۷m>zS_F܇bwڿYkKșX> VE}wIżV*7;ܚŃ뼔ר8o];s18 v¢=eK WߴّVq^,)⎂?(8m`ߔS|п})~F>;z:T[_SQr o'5Gy5ߩf?e'$R 6{*RǦlKUSm;^^:Vuű.;vYCJ_U3q̋7OI;9C佳s󈧳}⻶hqkܣ[vȯ n^lZVk޻sA\^_A|`::lpXbR=n2%yˉ뿕VR{Fd +-ӞnέFm4mvk';{~h9!\Te +riV%K|TyK*@ oE }c E|I{\}:y-Qо#}A\4;^!ȭ/|L×vhp!QN5_oVαTu[%h_A~U_K˴tUNȱy?!/ O;]ZUW.?IA_jGOih=ժ=M ѪoghSI|KgϏC_ڣU .6ՊοLaWJ ؛#;'Ds(8]ipM;,W?OS?X|JGJߠT5S)~.R k~Fs3rjGe6*<o2rW>JB{w~v۝=S,[{PYF»2UjTbc7F="kkHs< 7 =oͣy^(RYq.+<--3ϛ({u:YrS:%Y p|&/4*xxćG&rhu߳-; }= =]m|Q?MMh cA;׬H{t*?w/rU=|tF-~d0ʳFo0`k M6[ܯ;?lg<6wI M~ 5[lnl0`H2`xz\Qwq淴)alfC@jby`_͑qU}Dr5Yh _?`wG3qMlyCf>bo Cg~.U[9 [o^މa-.' I'O2=HЉ:P!F3WHb}QmO|;KfOl!Y}rBwlQu]m1+o—uJ4'/v5S_"mS{q41_ث>z4moDO$_N^9''83ȱzpOQ<TYA'RU~ypS}^;yGuCK{z!أTqsj;㽺#a+\?{L!ՇS?,*}ww>ĎO" vě3Z>\dWo 9 ;iǎ>>5fC=G|x=Lx+~>}6ː753 F_y&U)Jl)jQxPsPb3Q'Wx()ȺMOx1}6Ľ7~ fD<_<#7+ogK'o ~~p'şN t# <_k3\b{y#ސI_;n%=}6&>bgM+3˹~.u}!?oKwًR[u\C9}FSK$QONkM}a o/ zx\9=Lw7ϋDLxH9k `c?|q4_o=Kwɟ˾|xB )/L;܇^IR'ki\܆,z#7KG?H|O5;xY{V"0?ݏ~ ^MԹۨץw Cz>~F+2!qq4#_Vp޷gv$%~dpJO+yMcGrމ\{;Jo?k7Rݒҳ{[M?-GY "N5ؕۜg"GJgeG*K3  j~3F(P&,7/ƃGW>qHl& 8hy"{ ߅K.!_[ѧяJpUbRj!ݿn#geOnqmIC=yf+\5W rKorwA"z9IRS':-}/v>s,~A/NA_KwD"oZN1طgOF/S?McoBӅ"(U?pؑ}o ;qP~DyVg-Ρ^s 甙]zS5VAvO g7#Nofo/lGek!ꚳ5( L<}%ZTHen ă~x>={d>TK?#&3^U{oƿ P'o~ZH~4~'cuRW ^/r2~K2_g8ߚŧBQ ѧ.Ntr#c}]_wq#qeG,#1ڱKS #Q#^<F[G}a]b$@0>'q1g#;v1!.^'nC,߹Fi%g@.pY`.qYzx]H9Ll_F!y:g4Ogy5nF칔e\ر9ĕ ,LjO}u?V 𦳔:}Ɗ M= CW]; ټZ:>/p~agKij}}_wn"gPqBj5/qx&#ky|' ʄYn3{YWQIxnQJZ_-&:RDŽռOhYM4E0HR9$؁R'qoQʓXBvVp ȍoع{[K`gv E'ݰ {"#}ywkUx,#)ħ[Wuз`? Rś!G) W31 TovnV \]r.%8L裉㟂>ԁ[S-P>߳y~p}p,5V}{s~"pY_pr?#KHެ:\p1sx@=zܵ:9y?[o_5?R=I|S7oQ~b2v0܁3Z3:?E̻vp=BnBC`4$~Wƴۄ􊿿He7c"U9N<T<>[I{ދMo*_q2U&,*+OuCO!/N{nR 3} x=-?W9s폟M.^#X[pEph?,#~ַg!/wp6 I^֣H=v1qC7R䇫縴= #KyG;O.-y&y&x-{QN8gțR} y?}߉WStE-3b])zs k9᫈''(:y[v!.r; ~t]!gt)0IqFj-h| ǜiҧ*?c~b3mˏOKSR g㷋~2a +$f℆گ | ?~ʯEu 1U䑷MUm'^\6Z?xª4cO~7v<3PyzCEzn@)#q=xũ=kx|dxq;yᎋ}'Q꿀/Q"'1~]ڛE_ƞԊo;u|D`v&8'Bwװ/1ǁ*zHhr]u/x2ASqH{&#)دƒ j#3&?s[ѿ}gaȗY4ߓ{$|北An5,>, `zjX\nݵyC3ne= <3GmOufԡzWj#ٝNT/ |:|:#mX[x- DqC)P8yܟEd]Z,Yz*  9 ; {hl1~6sy6E\+?#mN"^'g!pت|&q'uأV]8Wam.$.ڎ??(sH#E[!ļF.#=?N{l Xu#߮Ov1"E< gObSOc|ob:`gS<9WةMmA^vW?Ȍ= \^;^']"^T5Lx zv!X?D`BK圗]MTI]n} .yyF{5':q0͛"\>[=~8zzCCg9,+/GoJw!'f*:J_E?Z|!=wSy3VpΑyau*>!VF_|pݾ߬AmG'uScU`;ѻ 8+Q]v|߶ŽEC/c5o{6<k9Z4XA?j UV_WL# @]vQIA̚i#U>IDCџxhyh'h>Ca]&ɏ].?eGVc2߈;l%W,Sժ5?V{5;?=C>H~o+N.D;N~i.Wȷyqt.[o>u3^up+]%q1b⨒#.=MNt3`rz.R;JY |e'[\koK?+Uq;^_L[|Np&~ئ|'u&>Gi@.}=ֻ{oZe->;Ew2Gwyesػ|~z x#9KF#}m]M6g5q艿[|ZyP4OZ?og*_F^{ ͨ#pP]=ā-BP?x$< K~/ف>sIǹϕsnaA=u v#iz7# P?ֳ+/9׺Wd/m؇z`p_P3ڪ=⅏Bܕ8"iQa_&ý_CI!q#5 ykBTRߣ$]1+>Yvu97^=>sn?ϿS}d]%Cx GmGk|9 eBcSZv&}_¹c׌ VjBU<~G_o~M#>2g,H!rԢM+^Ck}g9޻ԭi]uH.So<}Vh/&hbg:v=|:qoCt)!J:|23>I>t#n1o=srT 1/IK8𚻉zc[_T͛|_PsU/| 부̚wmneEwc8<_b/nn3x<9:vڧ*/Ψ~;'Q'H<Ɨaϭb'{L~gib9m؍ܕ~AO N {E3 y}%MFʉmSxKC#G$FWBC㦷/r=  `gJē>aoK<^BzlG>SUm7bq .KXMHy55d.[WOy=>2'8//qf.= z3 .d?OȊ#rHMC<ڦx7XDwq޹W\`4$O?2$&zWlP4iJg!tÌM.$?;5y%ǹ<˟GG߸}-W|z.&7vkJ͡ќT%8>a밗|Jtzq\tѯy={yr?"u[mz<~Qlb!3P(M^~p֊x<y)g7ҟg;9ap?<˞=hqQ3rzVk ;u/2aG=a붋M!5b߂G|׎x_5c_|FV.|n@`/DGm[VG:]-9Z8ϋI朻SE (}1`Zp=oNtپe8s~^v6o01ĕ_:+E{UOic>e^NF$I[};oZMާ!)E7tU/&iNGqO?$OQn3r5Ut9 ]k^ox՗8< >Bu^Yx3i?_S`zۻﵾ=%+gV~<)SN./ʹqRoLăŭ=׉yގoktqKT ۣՍi5w'_z`5dDNQa,UjosD+-K|@^2pNQAKېS Voc5ÒQ6.S~W]"˰]~,\Rk^<Ρw6?G\H|o'({zIsxޫų:9 .Džo;J7>M:[wxgs3"pڲ`zxƽ L~q(K=NCcxv2^rx7&~1~1r&}d^%?7WT<{ކVK^:$}_oxNRyfICiKz)BfPh#q512;R,\"᣺wѫ$~#roG2爿T?oO;z1/~/r?_K=I+ ^JK9so[㧂gܻyDG+ {;XuЧ5]W"ǀ7'b>Grs_vJp.#NGk2e]qޑg#~pA{UBq>xyOF>u oZձP\Z'xL+-9Ly:+} x/Hi/ZN W3l|z|`6g<};|kmx^Ad߀i>`ċJ:Ĺ.[|߁[moU?ըHo -'&^-y33^qD =V|+*_dOǟ>I%G}%ӉS2s\/REAyV\KNFrOUk496%j*~.Eϓ/ʬ Iօ|NM.{ ip=S"{E?.į<ٷOb~ }YEΒs缭zǮ>_o(x= 5璙}[4gZ*~=W& )VyY91{-B\:2AѿUOaCs2s8qY=/~G_ >Ś8W=|C|7jfYWROS>C} p^PN  xYe5#K"<œcMJ_TǓWNC.Sú[\z74鿋]˜;;uUMqwsI_~<+.9v0g<)P`_|֍!VZS= }\~y3 ڳ  | ^G U}c[QˁҀ O\K=.ב9F{ VϮ{_ zc~(&sKλ̨xNL.z:POI8G9oR񢧮 yപ ٫)͕{딕ﭷn(pyT?NoG>7E*ǧn\A&u)zUVKo7aʞ+OX>ۈ!pUԭcnΡnɨnW _s[^gh?x;#Bn"qtp7 -Cf2qeXoCk 1^|k@ 8*+y#W<$Q L~maEa_o2hCw-mqr߫9"Y^Qѓ'eH3V}m7J|}ll[ۅ<`Cs{vƎu7a"⣍JrBS17ޱ܏q1~uWH݋}jOK9NaBb 9{eZ-T S2+o/[~⌀5'zcWk?-eVU}~x7g a_=|Vs&ok Rϋ׾ y͡_~M(Zv䦏rQP ^B-V36M7wA-⥚_rлGqo#uG3= h@,~d\&㹿2ôuxxC[ߥ+}TGSY߉B+[gxGvP'/RQ7ux rm_9GOK*C~4{Uܔ}B+hox[#>t+7/{(򷉳R>=#_`u[Bwsn-Uc275L!OkSw \!|[ZOht$qd둪sEۡШ=rٲ;`s?n"OQ88u8gVljd6rQ!up9 \ʃIIG.;?+^U? 9L<[ Fʦ`$*84~`yG<[%3-A(%\dIПڿFJЫ|^Npsr0k":_C8l!gfh 񂖃Wq C|_@7IեxsE/k߫»𷉹wu{n6jnQoVB\eڃu9Jss1}2yZI=FvOW2;~׊9ע'k\}A;aO,s\R0_b7|o*yJpS-9Cb~=PSQwi ޓ_\D=(>Y}n竟^K^/WේW#Ex 4G1o: sM{x/u g[U׎!> ހBy-/i?'966k/)4Lq_"3x+>A8D<1E\n0YxFR{+q}=ީ~۵~xf#[נ7iA@8v#ES6}C}-/܉/i&^0glV!kE *^%Fr7~ed5S5 ?|^nꝎ>.&pަx3rܡ|PNk?|A2|___KV1嗿lǜx32~:8=_x戏l#x+EN#_hܕ9t~eRꗝ\D_@ޣߪ}*x_szƷW:{|9@\u^"ލ-ujcrx#%>߄ˇsSEYw!q2?N}7(?O ET8@HG+?89 =v B|{hI=߇\M}5jA o^%דbivPw[} f#N?ig|Ω#]g&H~+6ՋWq?Ku/ ;>T_g#~-+o.h6x-8;αJcSx]ւgגLUkkr> x?*_mnǎ>,շo.E*h9ۍ^b_ۏoϽ~Lsb;X'=|'‡Lj|#ߩ7=hEڋ0Su9NoI:.^ȴor;+R]TٸKV[\Mإ`*ρ;ߥ$M׿~;ʇjυGuw sփ#?7EWq_({x?׌?茪x r/ӸL;}N}Kqiϒ|^ ڧ-ȓCN<ů`pU+Xh_*UX!C_{&q/}_}4Oz[/˖!IG' =k8\͇'}Pv围/ɪ~$%a|Aaˎ 2=Kە'Xɹ֞"z,nHZb~3waS^c.va5~)iO\'zϋ77q7}V}gr~]_!z\G_w!)` 8?V{?VNӵ!j@>q7{̻YzmL.9Uyo$^ʍSL r9ntv~q_> p{#Θ*37=3~}NIpj.3ӷƜ!iR@|^ֽ]6jT|z_e ö7%%AbQ cR? _~᫸@Y2=GeP~jM8I;>B#,C/=W|9'?{T[IoLW@d}~sω >aHmМz]h7~#?Ek/f֠@$.:FG7FܩϪY9+oM%ך#_ T\›yunr.i{*\8\| w(-%(V}\ϧ>)<ϧ~~|$EȧRͣ<=D3\m#rya9KȗuS֏I$>L<)QY1Whv;s5;Oyk!Y ~Ws6jNjbgs7C99ç]ps])pY瑚?sL$o @~x793y&^tO^?e^ O{}az(2ſXKN^2=,z||YU͜c r?T~([7}a5*w`W1pzķ)COӋ೶xv7r2q[/oɛ_n#gm9%=ꪹu'ݶiZ9$T=إ_WX?Ҿ+Wɔߐn󯑟>IJsgX?"kT(y }im] yXGx;S.o!MN\-÷W}*'̨xzBE'U s*ʽU'u=sNI{75<[EnSz^yImGy,QC͍z[oG?gG糩|ĿX+x&/MiNE||S╾Lghzz7:< _m{jp#v"ZA훋^yxe_7 f>_'d5٨ ?L}!U؇F};G=]A}Qԁ:j)ȷ3JTxw1EUi&ups_"_hίx:լCį~D3qI{wH^7'^y7LE_O⿭گ?{ @=^ܦ'u⽦N'L^u+*oм9Sa'!зS |qqNv'rQ Ϧþ]_Ϡ_Zǧw~v>Gc>'>VXs4=wun~sr v^v|9_ďn? W]/;uxYѫ/s>Qbs#y]u'05rhLviho~(UjΪE> >9gRH q>A5{TM/yF/ќ'Okn(?\ ^ :?3r<禣nAW{Wy8g|NyUܯMq^9aM?"=gֽ&"=Hk|m#Kk>;p M !ع+[rZs=uk>PGGga*G>Y8v*3kLW=KQ Gj$зZ$1 \sL}w߃m5?.>ʠ^<<k *S_Hgy?"Iܖ<y~2 6D\zxn,6ZNao=d6~_O&d|B)y0;m%y:SȊ>4GqrQFa*SݽKs%Ey%|i)OPѠy c+"|~KqS\k\!)Ozm؇*5)S]7Iɏ^8 ͧsFa7Լ!;}+uZ B~j[s^)6cSqt:sULﵾv4y0z?QuQ&ѣ,?9u";q)oD C0!63~,*ؾ03G}/˨sXzQcsJ&+9-9 Ps(V*pv)H+݀֓-{E H+lXw049Yw Zoꍍ\i.zrfsЯV_Ro?@#=C{o^d>5]GTqɸxx*o'{$N2ȹT <_|=C_K1aQmQ龥=Uoݮ8R ??Ce9 "쥗C]-. zإ:/G{o _ّsbw+?r[4ǸGg筝?=|h3^ѳO"ׁaGKZ٥ܻ{>YWwp¡KS WzKBqO~cM%vG"I}]<i?5] __{@5Oa|?)/r_n_ZQf DOྭ&CCK97KvĿ~4v3\*;W?ec\XkYV⃺k< ݂Gm*lD5۽{BETDsszt>Wawz^୔&B˶4ߓR~/=]i;8n?g)?xd<͇3{>p7I}xOg]Rgu޺GOM~ܻ݉JZ>sti-hB}ܗmW!ב yx o&irrZP՛ ϥu;X_~Kk/)+0S';Gh}FOa;D=GZ4!.B\ji7gj%zo{J8f?~>{~j:ʐ= =i'c?8=~'h"I^&D(~)r=$>$JR|r6v"3Px>zCK}zJ œkIz3SǶ8.Qzp9}Mסk榬~Lz`"uߘ%r_C2 G{x-=ڏ8\sT9[Z+}W?|yܗsĞ4Y9'y>׸vaǒrB~%7#']%'hnF7QHh{kQxe{׌ʗLԜ-ƁM#oȗ$G"w=RBKj^)o&gn^bG)mz/ ~IAՁ%2){30ՏA8{< A O+pbfz]{k>Y(j&⼮ꗩHpm­pus>)oL߿; %~H_AgA%30} r.;nV3(sye[<#40ߟP[gpvp>,=i<V?Q}Y}?EC~k$fUI?aǫ-M3w9 {َ_' }m-jDPux1N4{%Ow! r|e&h?taon:'L_I3zpoi&/%WJOj`اziR!w}=H=#}G_ ?I[c/=q"ޠٹCˣx6A%1͵ZE΢? UqI/gKj3TPOo4 gOŸ%g|K?G&S;98ߵLlWQk![Յ\>CyWIF|k)/v(tHj_U̇)iy{ϯ5p{U۱s?3 ΍?Ͽ7'ZoIYT+D/ޛA7y3"~}maL$V? ?~ ?& pߕGmOcU~lsT/n7($N+>gOi<޿Wgҽ}*yy*yŧ~2xШ>Auo  ~+*vqv"!/Zqfxy@v43+U(g^u\G_ ~[A3&/%%xcsz7pw!%7 Y}G:/rQ?s-$~n5=\n!i4C<õ˹V֞ s5C>,t)ߛm'kf(npT;OM?Dsv~pUy2G;y0Rxf旳|'kS/coHZzKf{+T~`pyGڢy܏40P'h'qsDrů4osœ[ډԊmlCR}r3TXI]/uIWl?h#j+ujwvi qwz?Al9ws_mo'%0ub)^T_/cNسSۍO?]&~ۨ w ~G4XJpϑlT:7+[3.K_Ùs8Gour߫}*{h>Wzۿ_yLAIwxMYk.:Aۮ:.?Pw3Ul /{VοY.zAC.b0y2$ۗ蝭; *>>sQr5gq#ϿA]aj/5MEi2Ϧ3PKzRRO<~:'gxip2ڗ#*QvD.?[)oL&kȩbo賨n:GmYveu7n~.#ysvltzᆪOC?ddGG]-b3N~޶@s׳/u9O'Vs[1ȣ})صƻƑ _xSN .͓şo<=4RM;>x;|C%k.E}G,!_7ݪ=㵷&+G>ԟ#7g@Yݨ: ~ҳ 7.Y 8 ]Wd4xiwtrT/kB"sjxXuMRճą݅wZx"NJ\3:l=Uyk_\O"7NOWoޫnpuC=|Jp=|~rYM+HjHW=?a%?ةt+L*':jv2Oy1/&riW$%1IUsj%}{)V}ZO׼J%xrQHn[7O_sv?ӼOڬO|_/Y^,_HΜ-{X}mSCwZyȻϸ{ 3zjps`& xig#_<}G>E6Nةg'coBF.T_e#n܋NE?_OsY7Փ^gƫN/΅X닔w'rԟx6x=vKysZq c#[uص 1NݲN!sgU9e>4%ɶ :R7]])٢P>8'<ݤjOǥW,y>|~uu)HqL91CN;׽C|s? 7,sxdbgic3]|nk?]|Ѯ={ho!1׿x`*~L?RG}~i/xK|IEy臩&kO?_vlP>~!ɞ<} oX{5jmopy*Yo~Md@܉!M_{jo$/E\؊,͑SIUO%wˮcsӑ!~O)'!+ppv4qvp^{g[GwoDIo^cǪO݅> ON_wǻ흈Ls-z53nY+@t/86}Hٙa|otꋦ'H;:ar2qPo  9NZp&őo[ȃO%vs?~>r^y>fU?fRל\G+=L+uc_Xto+x'n2*>\kz}_sF7{nsœPWsO;G?>-Ϋ5_q"rEsl=''Ǒƹ!W]sͯlDjœ&z;Ѱ }3;}?+n?x>~O=~}){MWj"B}@|L a|Eʏo/=8n6?R^򔵪{$z]n'vSw O|oY?&jDWL{QMڋfwN|CCa򠦕c\ѧ[z~4={G\=D &p_`C|* v%DAMt1/swR;%3=ko\0X|}^u8Y-ւ+=߮GL=C#|;Lwr ? G|:]}.&un/W9pGrr"-\" >AaWjϓxBg}i\{äoOVbۧسY,|XSØF]?dwഠ`u }kcgFC^Ws_ak(sѫET-y >Ԝo_LxEzz=HN8:qv{-cT9IU9RϑܘR~8"Ox|'MO0 =|ϷDm|}x#՚6G^>t9hI[Ϲڦ}It4x[|仂qWPoJ]/o^mR׊ߠ3υ1;{Ox}N.֞Crn%0? 2U&T+]ooJ 9xN][Y(_T%| \TLws6b_WKKm/ Bs׾FQ,QLx;2BK϶3;ӯK AOm3_`Rxⷫvv"?T>8S~Kg6hS|3ȷ*8AWQ[S3k՗>=]#3sxU{H߈nV_Er>Aʓk>2?ݯn\<\<=JVշW+zמ؛w|N"ǁRwS"So;hfRRYM6F$}ە-s3ljwr qd%h Gѧs(>LJ|>v>] *ogQI}K{t=yGRoGnλ{o-qjI|/-WC#wItW} Ͽ}MO%η~E]2C+|x4Ն^-RS5o/BN6v W38O1\>[q >Pt#'oWȯFq:M9/z8Ps* }tCY^' gZ_KU/=|Io4ahΣGկoByOA+߮`+N+Ϡ4\_% a&tROTiXh}V"ITxbǂ7"?[&ߊɓ&Rv[*S&>/SB?Oսlw6*o;s/*i_h{9hlGѠ"~R|ĉY~d]_C?/T)_{g{ yEǾ'W?[~UԵor%_oW?,3fx W_V{-`?7/oi/F'8++'G%~"q?~~;/c@T<.{^p1 de1&؉=i#VժE?!eՅ񼁻ks ~>o'=ø> z>ށ+ޤ~4$.Ğ-{ }8dy+  EoLj~=aG>W‡];yƾcȫRͫy9Rgp/so=˰7᧋ޡߨ{0\I*~obtl$;r"%AsS). 97oFl`'ÏeN|J{N^|=Pr=5p噋ݩC?DX7sBl49}2u`;yj:RsuM;x P~&LsO*u(X9ԍ+z !u<8IN{-yc«^3LD]>-Gc?ii+PO?t]wsO)١D/"6W9⏿XǏU>ixυ9[%n *l xjùt`W?=ew]ooNցSC`ggϳ..=VcO_G'2Ak ?w  ެ}_~]L 8Lhr8?"~yd/z]x޷?U9{|y݄OvUIޟ.F_#|׻O1bƞc'b7?2`x@=LFu3LίXx{"N[KaU^3Q,yE%}e764ٳRyu״֠רak*ѿ-U*T9uWk_hX|9zS}8q1sV_y[V, U8quU! e|"C ؓşGu7*^ oU$^]4~Nw +ޥ?UK=u~K皽0 0B W1}5|/璯2sCu;UK=X `RB ҏ?.up4WC2V |;W}}-%\˯ے)1břDZs=G p߹Xw;yUoDn̚g)Ӿsx_*cj@o߰/%ǹC_ T>k[<)4܏]߅},־RyhEq.<lwa~2:A޼CU=vôyUC{Ŧڷϻ؀KG/1ND΍)\:.Mq.[''3_(؍nk*/,վB->w FgS;h o)8_/Gu̧W&l26G{U꣭܀*W1ݺ5gZܼOo-wVflCi:DAe%/:^TN/94wd3<=^dGGIgz7W:GO49e&}_M89p){+2?S/HkejnTg&8нSIK;yBBEZ"nI*߫1>`W'R<'e7(MdY6z iM[A#9n\RV\Z1Y8Azcg6OJEGudOi {_#߄~ٯydoCɾu_ʯ #A/"/$OE+ PauoIփS)KWϸ92u@^I\Tbg!lJH˦J^7WfLQI!ɯ:wxL[{|Ȯt/ r"fR o{%>TVu>KM1{*n ts?A.Y)9$J^x4`#yE?uGQ7 ~{? 9{HXu̇כㄣ";%]A\juQN"p)n'G^4R?pK/*.9BqHJQI=)sKKɎؙqyCvf?\%;Tf'olļC9N=Qu4u1<}irwxkP9I?KzBcWD|Է<OdCu>忿{KE}qA:G2'o,~G3DTrž)OC׌>K/وyI懃R!yO6*OQJ/;`emH?T&9.ZxO}]T|<@zTܚqMsu#7)OOV/{XNyV`qx#ҿ9]Ns4˲eUGMOrǢԻ]K=ݨ9}GETv#iMԙ3Kl(O ^|+9 ]J<>R{Ks?w3$ }-sM/ HRup-l9&=VKUB*[iZz\s\^ݎޯ#iCÒ}ߔfiSf9cě1Sϛwyٿ-2st{3/չ&~V:LzV~8#UESoOw?e#gCW[F\|d<{Vӊw2w]TzsP&T ;4}'MnP}+yٕIQ}-h^m\({F_ HݿLĭJ__mCsG 1\87ݏKW\k>n]\}S}MT\eMfd7s~ͻB$Jޒq&1z]=GǧnĿLzշIHUJNʉ,Y7r0\?Cs}U[,\qaC޲{TwH&ޔuOdBe\CtV?v:h˸ԼO+4N]gNL齏|֜8'"W:gc'+J^}:a͎z$H?xyGt!C' ?G^:Rs޳N!-ۊOw+7=Mrg-KODŁ׹Y~TPrﺟ^^yDġq N[V?,k)v/XsDvMz Mj=WQO0#O%7'^^7Eg$K a:/{#oy'oD,?lG Xz(GTLn+x=}RƓ~ɳ3ӯ* ѐ둚oh&~}O~Z,QGUbN=vW5QGZI@q!Hh}O/%s䴬GupdիcϦȝӥ Ù_TWP/#TCvg!姬~$5'VNX8s>.gD'ktJC}]ϺzidG!ɝ9A05876Ko{R 9y=%B|~E^<ԈwKSJ |P!{"H}ƭك47Oh_y':`}RIeS(;{_jx1g5e^l9#,̗={yax{S9ʩs;eϦLQ[isKbgH}'$7*S\ M{yB瑂:Hjy?80u-;}WOZvOyN?POg*o\]Mߔҿ}ZvҤd]_ƈgެiء3D|祐 ^{ܭ<0Em n/yJǏ.$c͊O{&HC ѿ>lXW (^?9'PW1Outs?ΗbKoC :lK\%W6p9?Eoz?7{cq忉 xo3s&}on>E)Ń_:_87BmW_ m+ ?A.dWz3VAˤo> D.>&(կ;]e[yV$ "v{t߾I&xLLyA:g?}^C?Q37U 9BRQkk!陃Iٶ:Hs^UA-F<h" ĤOlKg`O}{H_K}K U)X"pz'yd#?8!?XF~[yY孺Xj }1~3sCu/so 5G<+xv}so)g|8oɧq/8k]-oik'M`n3Vq|F^W?@x4Iһt?%m]7 zW }~ M1{X}$ekQ sO9} 8\ao͒?2"1%\yGvp󯑿N_5p'"KuǑ3/uE~G]89Ry1uM*3?{&Ke}s&e2oے}3MDOT(5_yS\R&_iMEO?x+^7NXoTaCrQg9m(Jїs8UI+zꉑrٻW\hEUJq_3.}ޭȕTۍzLʭs QL] =pt^Au_5[U ϹArCeka oüg1ٹ' J_}|o{PL_ b%n[~{n#og/}|k02Wn'c/t\OpOz&~=ި8*} x*['UV[IV{TD$ZWH.~xF7`ҧGt-F|}FpAiC F.>pNA+s܁'}yV: '§Tg%􁮖yDϹˎW8ݯg#+}̀Kan>rzn繊Gge_S;ymS"6wT¿6#&Yŭm﫢şdl_K'8@k\4});8>-9M,{N\{op:odMuM)qqGp.TjOH.4ge</hM_"y1}7} x8phwjmLv|d`Hţf-q87ceȎ$~p$?^flUϫސs++Ceb7PG #!_7RGNtUғȉoS|A~:BԦO~SSG6w݇'^jK<` .#%;oR5Ks#~랣<ѵX7Kz^c~jW#~F.3qQZXNJ-陻~խ4<죤8W)}ߟu~_scWv*VQgz)=z//|F{W^iK/&PYs%29i~dܘD7Fw9HO.hyCTw'C^Ϝw`>JqNkнX}|xN7)~rWĿ?'rR_¼T᦬y,3ow ;=zPA?drK~%xyƤ63 osn>C5!>0'\~$E]4C&/0* nD[Fi(g({X>4oT"H~nگ<W>K+K2??wjM̜0=d'.o[fP3@>*J{Nws:4c37T\e:;}3ܷGݟ %>SsGgwe'ӧHOJ+;^0z;s7gɞ0lNxsj|I|tԥR%u{괶\ԵLlV?1qQ9}rML?c5OSY~q|mg̥yяg_lCG;7sInpN|W4Gw\#q3?aۊaFdWM2O\z~| }Yg܏)OQ %?[9>*8/pߏ}ǚt gCgoȹu>#'ލN=O]J\p3 oO?пJ?;H|_fx5N)C?@ߢ oG [ /)l%J^=ě g%/PXI!B80oxwQ;&)x!ɣNgpOQ/|;WԥGC~)}xHA(iޙG܍;?"^$o o#sνnȯğnq]Pم*o_Vȣře'Ussgo< wJns. ^wS|dn'?$ǑԿ4wULS$̕ߊ'^\@| L%bNV -{g}s)O\N)np,Mz٬:eV<?8Uqpղ?qx'C9]+2'`>4r">5CJЎ"9gy TI=/|e}9D SOOθ2+EsJU#{FJkC/J%mܯ­qw3w{K[xfpix,fsKgĜ>}x' FFU=Rv. %|~p/+@k~do\+$[>ٸ+7 I>z]z!}5qci*歎Tޓzy7RM%w_t7a uX>'|Gn>rIӿb~y@4Z1@\LbW]!p ) JJqGZ:'kWW1-!lC6gb{fH5ɗ<{Ap. {Y\$|IϸmOaP+փG`>3AWE<.{No,m ^7Ħ>?oK>cBpFfH>MWc>Tv"(+Q3=D疂%;>cS #q4}_xtRMꛎeב>D%9xS_Stĥ|'|F' ]ډO[ykp-'/aP+9JrolQcOzW]kf0:NSP=!1E.|V98pA+J_a'W*-,&uDZ3y氼oꇟ+=Nd~N/ҷ}Fv!rSMp|3ԹٯB$wG^p= Ȼ 𷅞USB} t{^:O#Q|Xkx/o_qrCz&L?G_zm9J=$|qǒvO/Od^,e.JS>r_C]1J?14JCWSc$N7Q ߊ;S'6MgN;?4TMVW9z p#[[M盁/@of\x)=qx{CL]̡G1PK tx-ϊn=DZ%%Eo8W),eT$Ǻ]IŸӗ W1i򎉗G<~? }:3'z|HխFjJ|ީ{? n?"{+_)w3VڢȐOژύV>큇~8uҩF 6p'#7潎y˟Lq`O׊%on1řS_) ~.Nsu>_&(ߑVR!= ~sғԭE+7ėcnx7J,Kk xO~x;MH_F< Q|_rC>~e?үʎ s&{bG?мFU{ZqTXN?nA?{K?c.栂%cR> ?O%xV=Mk_|ؑKoܩpc\I44tnU{u.N+^X\dq{lQ`ne1(劶=ُ^O?{S+IQyިuϞsTor]osdjïKSۓ'``_qˏ\"?NmR }T 80ikoePPwf (| M_NbTOz~UyC ݣIΒ~%6.{{mL¿`wm&_g=L .xJ:=>RESBgIʧM~1{|a/1;$'35QJ#` 5ɿ5k) ?O/қ2xûZfWWŧ؛8.Ѥ>/m3W,4E||}pisR^KT\ UڊBUc|~B9]7Fr8̋$%tMg W蓅軦w. ? 6LRV|&@Q׏y: ^OF:s@tNxVyT9stae/JHgSKm_.<|%e}/w1D?.|c) )MۛRuڹr=PF8/kWͪ?G(풷:gFm,$coUu${SUsVe8J>R]55M+^NS E_%IB_wM\a)y^t5~_?o?Lu}Ɲ#Umv[vn2L<{07 Vm;̱8˶3W7o/c벍U_+Oyγ. ^Up%G*.LdYޣרg»/{]s&v8%OW1 ;gF%>ͷ)yL-oPzm*g}nt!uxvRS rEne9w빼+^MȜR;yQiV7LZs*/UmeǯuK2Wy1ٓ8["t8%ۮ3O#_2avc+_]s&#,J$}_U~z-+˾x|r \LID5K'o!p /RWb\i`ߎU]Z{Bf// ^KV0=Obis5L|D|_g"E?A俓KV~wWc+N7:RUN»NpW2GDK;<o*O|do$oNy)P@mlK??KW(^ϼ>s q5*׷ FM?7QW1B~s3W| p8cikCya,QV17* ~u3SwʯYf,O}&l>?ʭ#G"J >sA:O=/ U5-~ww솧O(#eRyG[H'S=<߿^󐑤diAPp!R=A' 3|Vq/՗jF1#>`O}J u|}z_x`+r 7?Yr/ү'J$|A?j?{s2OhLT:,; 92gΫfM/u)^w,xY6K5,WO>2ōeSwV1_d^= 栽sǟU4> SS_J:OlDz>kz/vǠ}%T7Pe VK߽EޚkK4`D9DXB*^5<,T/qPi;)CSVç{#wegqϖg`*|YRV_a>ǻKfS-\zu[Z0N귡eU?K~Κ#"-cUyx$p} oH}3ɍgGٓ0v&%5*αO9d$^9#g`~"|у޾YcSI3w0'Z_Bvu ;ʟT0d?8ud੅7~\90P$9=k\wnT>~ʤL9\.*/ue%  ͅ*k/}/0;}o~OJ& ßa;@! 6x!wBɵ P`3FM7 _EK:L>1ъ_?UJϲ+OIs?I_5"OSpęO왪O|ڇyUg$ $E# M9Zُi{Neؿ[f9#&?#myw2?MC~‰<Z~%ű~ؓ2/A6̉EwCnȟ}&y3goC+b!ه? wnx,cxt  *)MekܪKo \V韒{?W(_Jw-~M̍0J_q#3Tv&8拝$E)un#0G3KfOIX|2Q&6/[Vi"mXO 2ߜ? x,SJ'68ؓce28#Pi{f*Eޛ?0>A+A OzI^}o}>4a{0=^TŞg7qV|"a=<0y qWvkg:r<~wO9:nviÖJG.žukR>L T╤MreX|O;9I—".ΐD_<ɣF^ >`dT" cOʼ=k"s-_3^u3qrGi8G>9Em›bL>Oywk\a ĎQ_g.O\襺sѯMnTR hgXSGة*:ٻ[B{iM){IA.fo|~[ݧ~J>eI.ұ{_sq=h~vΝ>}L:eJއ\z?{LgOݧ=<棒;k/e]p4wž-wl|o }ԽFSg"ϋA~őQxĚ+x້+*^l#c/MwQ\D|}4rrY sO>js@;@";Sa%m+S?* ߖY//U>bu<3#~>f^x5cLsƫ$ !z{|WO?$s_\+< }P[>5/nBy:?^{?̱+o51+Xx{P$~Lha⣍#7p O>|)8EI2o囩x0Nݾ:xz>S׻sI M}'CpzpxkR9x,{q!woR<~oI%量 JpC-Kߔ9 @{?A_‹G^GkErcgd_l!1t3GK}̑#)a91_g \{]d,|lap2|I˖x B9?{ݼ^;n OU}cDra~ѐSX ^gۃq\MFk>ـ+I7m7nM&yN:DdڋQ>6I6PgW;؟Z;| '2ǖT=Uk94qŭyu_aEd@ ^ H{兟a^'tf؇#_Vfc}>I͹O<\@oʘۋc փG\=7̓e 溓}7'Unx5E7xkkp{O2 2$sw̅y0O%-E{J~6LfAts }sV|;]~4}b^<0>|Ad[GGeZ + ԰g4rJ\f.$٠%/n0`6RO7 ?:LJצfg$}1kNT9,Y\h .zpxkCZmco4˨K; 'H+`޻Y/ҀP)?XW#]}bYuY#Un}_JkeR_g Uqm$UR/T烛sofK}b9M7sx'၎J]}s![=>Qs?L?UZ^D_/\.fϞM~'{;s[;G,N*\y5tγFxylU W?oZ{#ϼC/E*@`5 ~'o _B}KB\uF ,_M-dOۙ8s_ovءSm]!{cWRę uQYS7]25J?.橭W鏒g]2p'cS'Fn-2(*X|!wX{gv~|r(M>җeӧok։[{艇̷٣,'D==7=}{D{,; ߣmv\W"Ns63L<*>Z{{igN&柒lJ+KG٩Cx^P uUoj-C'm[@+mHB1_t(<ʞ_%_c:.dxDVcq䶂zxE}3w0uumԷ [j=3;Çv4'k/F9Pv' \zF:7t&|f&>K/|n E OmAsrw~_qݻ+;ogRWJO_ *>WX~:vs(3 ny#zwJ"`/=1N=N}$y^_y2t8dW~`Ly]|)I<.Sǟ͔')̅eؿ#>H2o{K]ݛwԗtl#ɯf<ߺs_ɾJ~JVGWJ"5x5c ~{*Wn<JgJO]M(Ӊ!7oox—_]u_l\|<}Jpۓ%7A<]ڱW_nms''sZT #8bG[}^t#޸rEKǜRxMk$ؑDn[>r齪#&O:0nvz%c6B?dG'^8>a\³I?PO޺/}շV^ަ]?6H&oT($śTBmO1nO9/i:{|3c>\{y?*?{6g)1HJ_< Lb=!ۡkwc4.;vR쬠ncHo7mbw|SC|2uIc)x4-^'J|ߵ84x<ݘ: :r(~ܧ $zkE^&xf/9~uxEmJN \}o%y7|ao{7^ )I<+8vSq~CN;#[Ggb/־ .;੼9xp})x3 zVz< ~Yj@9?El샚OlZC'9f̧_wۨ)oC?_A}`N=^RٿZx8$>ggѷΰ$! &4}P;w u%L# Cl<ƜQH 0Kia^2ᯫ=Qg? wدSųXH}WH&ef 1~*SK~lԋ2!xu3 ~^l ){]IqoH㿄Q@73[F~!-W K\*\s滍 Sq2^J]whxߞ?WF՟1jԾʵ?<+^9:Os?{a[ > GaNѹۜ | ^釆O+aN|U~.>G%щMk^~b <$&Ib 8(fIRgп~Ibv\nT#ԿT>5`wx}/\-ʋ<#wc+~O.6a>zի=cŘ0'DZ,OyT}rptlw@O}yg%p OYA:o_77{PvpާbWF֩nsiE_g] Ⱦ&F~3|9@j?@Pmb.=$ wwjwK*쵹G?s:j^_9vϥ\eBQųs(J0e>߱Y'!Cviղ%[-GK&|erry!6`%ٟe5E塞mc'5 9 Y\a~$3볤{_*jZӯKOsSGNe7?OeZ pCNSy ^qOϜayRiڱ;O*N #hO$ߔ~$MwymEߍ1Ggój̸?e#8pc_^ oϜs7-ޙe7+//`?i}e̹Ffc pu<(*9 -gswa8%z |P~0? .O74_0<o87~ oᥞ>Cz &7/0G/Y> ŋ88軖'.g#88xW }\pmw9G^<'LW}*8h?;S)ixuU73)vZٗz|/qpO>j$_%uuwyν~~7}䧌}& '?Fyv֊\ <՚cði+ * ZW5' _`Yyb^ ~!xGxP^]\DN7DZ_f"Ւ(.*T0UQ9Є?eV WTqM:P =}Ust.':JGp.yun'NsΥ|~۷poM暓q~!,>pb(_LŞY{_pb[7y^}x\ou_Kս{pK+ 6?C]MŵnqQN rsCUy`0p^}qk=&s;{ULc^?j5S=wf{I=[q+q%uzNaOz{3WP8<$T//:ޜY MbmE|~+t~Fx+(-S0Z'zkk8v_ۢs.=G]{e76L0װצO]~Sy{R_nWϕ#_大Qk$83ߧ<,FTsgO%)Nwj{O Lsls8QPm!7&Si vPڣ\v9v*p^cckcBk${9):]Э/5/\sܽ=J0$nvk{}IZUϾwj<\0>G>B셵m # a;[%qn+:F^rk^_G:ٛb~ )'^pn=\QN_Ô# >~10_6iKC}%<{' NRxW玱W0A%~V=;I_a?:oǽ+W7;,ە=$ s/e?<}I{r*ެ:vf4 [sK*f>H+s5C{SK×ev]w3ch!pCA _b٤>T6x&~-JW~Gػn?qyQ)(x͒ { '=YwKlO}8 X|D?eyTvf/ƸLqΊ-𖳯qaΠ[ʘW}s.az<\\ꔅ;̧dyM=./~gmmeNR7%4R]rNП_;Gr8:w{g<׷ 񘏽=iA}~$[rlH}O,9+(gc:Yy;|5?aw>+;eHXp>ءo/ѿG{FIQw ߵO1 D_>L%={^ xe*wHoDZf3왉LOKه\#yv1h7 ^Ϝ? {6g1%>4L3`K, \^]f?ŗ !Qp9  ^p'dQ>t~{H7ػTz좛-V! |i5e:tn~/D)8k[> v//3l=y3Pj6QHQYqe׹}"Wϊx'~:} 60od NMsϖ < ^?f%yyAyd'LyGϻk~菍DN648/XJx*2߿^|u\|$5ح2i4gK*?IoP^v7zw׽= n8d]8cʋ%:rw9Ξ/hתMZhwZ/ '?svK:8uڣc?<߳ 棩TO3đNe>8Q/Qbx'<~S7Z!n_̱{L7sNF|YcM?Kg?cG.aKL9|fbM~Z | >;'*?;˟Rj!RV]ޚd_f.'cse+>g=[O&!-=LaW!c݋W#r{wzL?F>슷]lM\ b ܾ 1.K>K[(O_ _tΞzb>M7~0QzJ;]GQ{+FTOoϾwc} #|Ix%N˄"es\œt٫)9gϐ^Z<];usO۟d#ONvþ{E{4ك*2om^/U)|Qă֞${C\e}>6v痲yk#~˫ٯ}2{Po1|1|i#,m5u.3X}Weo<{b9 ` G}ʞJn#I:K瀓Y_e>%sDv_ /w32iuUՍ#9Ȝ}8q=O.?_o|RT>Tm7ͤb/Ca=\6섭\%uK xp>;ЯwҿK'ao짉cRGa,e3VTa(\(<_U+0os._/اܠ%}spYs3!SKѯ(y;8^/UW4;qΙmtxUe,y]B쟊_opy ~WF}R`ǯ[cxKxw+vo=]qee>Oc{Iq_8vR|h=utv^fe"7~ٵB/vE7kÄoךӪ89Mެ۲oeh<}H/up:6"(.>>ڻ=9;[ տMxb ClϿG~! ?ZaOl?T_^sLck6.}ȭbo] K/ԷMc/2d!0,~/Zoie̼/1LUJdNO?k;OiTt#ґЈ0֨]K(ih]vMv4\AC0RA;Z|5F,)ck@Us. g8u/}_=[?f_htHpY$H_+͏eg) έzF=3t.+Pg/:x>\oݡoVNn`)Er9Nۍ;XQ8]FvSCog&umK|-ש]rJ97}fk'ӤWoQ=׽ʍܚe!};_v|z-wKppFta48tj{H;ߩ? CVm!Ιe W_Am^rw^|. pszY)}'[cԎb`ꗌB BqpDڣM,Y i4hn*ثs/-n0K eKOzh2ݘFgawE={Q#oc~OdT?T! ͵nؼ0ZO֏=Eƒst~?+['*>,*\.}%-ϫؾ~KTh_S? 6; ~~`|y_ l<;f[-iGzW/xQq@K>xuX}V5AcZ~׽NAHnYOgygm^ur9Ӻj=O1C?(3'}˝43U5FWrR\zXwb7s ȾؿQcYr]=΋֬+KMζEE<`(FuukqWFD}_M1vXIz3qG9#,9~wUho*yFS{~нd+69nlӞ_hOt݃ߝad\[;з2j(~eO~ge?=XKRgFiFnJ 4gsw`ߗy; %MӤO˜F["q)Xo/l4] ? I:h2ٍ>gٗғ7핇n .n/?O{ܫhպF+̽6.7ڏf~e,ׇѼӂ7sCewkfxx#!d*v{2䲣U{FEJn2/t=/=Zy7=_6'o՟ G[_5s}{x^@ y* _;v.cyjR:GZUFagmy6g|HsKJSRhHY?m ]j{c1}v_{{6*o-=@Ż8O6.=+g=,}(=>n׮*kSRxX疍?׶c K,osDQ~8u=K ʵ~1ƂsWKne|(ik[L~naS[ə+JQCPz@zz7~;*ٿ. ԪN4¬_,So{PPK9YwPrۤ Ho 9Tv/5ږ>:pe;+\ظ~-yJW+=x'oBe8#K|fGv>ZvѦ^zXYj(Jd_9iW1H̫Uh=\yAOnϼþX_?=='+ޮ8N&IomP}oޣy>w9Ŏϥ߯v}ў5ߋI~\l?|P}pH8ު]/"l\d?",%n[ [ٕICƮ(8}Ï?fݦ[ [x!F!xhţ7g9SNY1H%_;QؼYO㞋&֗o6V~VJfpٶNֽt-y ?ohQCPq+n藺AöU|O޻IqWׅrHDM$37I.=o{iv;Y_F}_OXj{/]QݻbF벗mOI)2޺׺Χ'٧ҏH\v2|kWylz4T?au<_:|Å}.?5exYȽ>ݫ817TGuIN@o龊OK[9Η^j^!=dYM$d}.}F/r<{,fٳ*@^˿k9dE Ho쯸'"mSqqˮ VRx[yl1~W7߸/[/y޻0(9KNsɻ |RXp딏e6+*T#wOc}&\wa ͟)ݤ{hi!?n~,.;BuT\]*~+{n *NxBaAkJ݋{7s:jg[ w%=I;i^*}yQq`S8G $ #_s^޸}Uw*#S`ww"qH^{y2W*?ݬ8&痜 ]{)~h9N籂4].>/ %]W);{OUhYy6#}.oR}p^[~Yu drċO \רQ[RM,I̾,w_Ő>[-z|Gc@ɺ:Cu).^7A\B~+sk?_R{ef{G*(mMJn@ 4FKu8ߏ.4JUl!;Y2n?ي/eR_FI?9V%@XQ<-X,[/sh.*/% kEhY ոH¦zahٍ?j7$r޿G⧁}TG~LׯZҢ\CD\kmÀ$(^\lVݫ0Az:HñOH/~ppۧ% T[&YsX:Oty:5W|$yRyJ"Wa5[sWm3F /:eG܉co;Яfՙ沄T~7sRep~*ߴ,}l@ױAo%pooؿ'W6|>{8m15inZߒ]_z7\rF۰A|r\ΧYr: cZKԷS$/&xkAf٧bfuO.^aѿ&{T|QÒVRի)jM]zF|i_zaW-%y^);V*&t>}^fk_EvDzȽZzwO^-{~n/;[_/s%!wTvpK. %_#+Xrue z~=4=+C?ř=v&C04oz?ӮqΣ-M$}g*>^vhrBF\);d7Z~y-џzy{ߗ_9W TQHŹZ~Y\} nт//*^MF#3Kgg{_@.w}Η^z[Gr(˿*y=/D9~ȕڝA"o˾Ø-NV5V2uÉ/>G߲wI6%w~i.?.HaDN|%%VLPiXvPGj;VP:\Vh˯/DT2o1?7׹^~6)Q}zòo1^$9\S\lٴA_9GT}ˢ[zcYr9$FR}ves_X,اX2ծm#t wC?YOy/0^}h$PGTJYxSqһNPhlM;nvsq㏚2K$|:>no(ȿ"\@~/?o/7U@BϙSv83 4}t .x,aL}gW< 7W77¹4?.QY+;QרSr_hyQ~L`|u#ٕWj}+xT?O7f76{eW[g}KΔݩI-k V gвFMQfH PW1Re+m:v_mO*>+tжܩL݃{Gr'ϖ-?5s(eQF/Ja5n{%yH7(IJx3Ae#7c꽃eS!($k:ĨT|~p_{[fzNlM#n6[S۵,Rx*= 竢Z<^fWn6n6ܾr݊MmVRt͑T߮Iˮ zFB'z{p5V珳0$}ō_&+8RC<<|`XR٣ZHzgПQBݡyUce__RnK,O;Tq4HW> ~n¶7g޳xD}Dr ćU:P:YzG| pV Mbg'Bo d=p@%߁_YsկN܎"] _ΪӴϒP^i7f;.lFO*}?3ޤ{L8qn|Gew:F]OӇCTrRGi^ x+u/٫e~Lxk N,Yʅտ/\ΩC]w/oYKäݷUTYѯ!dT=eCsyD/%woߨ!Zz3_Tr8|(;Nvv]DՕ:/QxewzKAʐ`IB9'Iox֫˞?/{EuwX7g7VObd_ivKرy+!+ zW$ o\:7OY.?عida[ 8p޶/$*eO(?J^ H/g\.0OGvywkԅWuPJYjgd,_W$҃BmeX԰JwHIp!w0Rު o'HvWkb{)(fV5Tۊ~cjk Iߺ]/%_Ko{N^嶦ZɞXdMuzqɏf욯+z YzC`[(cV-Gwg-B~S\1Y?=ew ?5T[Z5 U]qwdorЗyWqJis+XF{FԶu^u~eW9[EK Z辳}OX^v N}׾igsF{U_{i+O$CnPo>C&gkxp_T^qI~IԞ{,L=[-B=O?~?[:c=bHVWӱ<}NmfU.l-DT٪ OR㖿/]~[qw#>g[5S-L9%?~ΥΗ=-gT=kf?=aUCvi~'ٹNT*w J_NX.iYeџV?ECKHJ wSo]{!GW1 Vw\ٗJ;:ղׅ#h-u_/% ׺uw뼲<߂v򻫙'$^_NDs-/~?#sy7L6ՁVI'?AZ`Hp^5K_T| RK+T_;o%zZʇ%3Ȯ6I5~.V5Sv<6\dKUϙt[o :{.a)Z[:Fyq:Mzѹ}bj>,T>R|sIg.VXF;_'ޅ^鬹ztPjq;k["7Rv]Kct!reԕZU (yf^ԝuS_U\AOC3>|0%Ϥa;WsjK端t3!:GZ78#_E°ޣ#[vqLJ<$MCeFʎ)K?WP]'?Iݝ)|+=GU*gboeη>ſ;(9O~>ࡲk$o=_|xʽ_ +VpwKu#_wSu7\<&= b>I\bȎwɿs>テQ6gO<Jfuo{VyiC} /-{M#JUGO3@ߎ-ߥPsiUqT KW.tmclKV[Nnp4ͪ_]̦(-~oyf5MiϮMsnSuIoሞ+y/]K'߉a~we_S cdkVKN0y|SYX‘ AƲgde k8ĸ;m+=kUϮ{Ayb^?'wG,L};~uʣfJJXRw6J/Q7[c#o+FSWzPsTu2P=t*].+̞{3ڢ.M]]uZnkHrzztǭ5_#=X+ yxt~+;;xxJ&b%޺4E8]~g/ؔ*6YQW]Z[}yu|.?O\Fb-%|r%HNzR}[qQ8Z `G#92t{( <̭Zv}.U[PFu4'_)۾\5V~s/wHn.NΩ8?[LR{_c)47b=*̖\oO݊;s_ׄ^lhn\vjuǪ.}YqS W4?~gd9^+ONlF:>f޲Gr5oErKA~gkS=8$5^v%ȿjot);d{M?V>=Lz%^ʼnzzU7uk%O n/Y'}?J.Dw¾ {KOoB=5O O]'{{U;sV^w]1?V}xv3/fQAݱDZXI_ZeIj uKxȏoIȮF1GyTΝTNQ8õ4*a%Oܐwѹ=I͹ȼzYr~ھk 0_hkCƏ"ejH}W~;gve>>͓ߠ(+7^8CuZ=6ƃ+!ZK{e/=ZH9w7Hfs3U~+_'{~FU?'z{ -1T5'8e˾@߰^vnK!Y6UKX6F#-12?7Ͼ=jDqJ{FG2E hz,ٓڲQ(8+>F|G H^?+Ļ][r|]|@\Gg`'AU35ov,j5|XٽV}N0i?UߤsKCr.[H'X.XujŗycYʋK"9.9sʓZ|4>m!ZY!mU8q)aI0'pݻ:w݄R~=Z"<^:Gǩ7=똩|87OY'`igũ}[6Na43IQ˯.Vr]~$\~HPWy}U$9߃ص7T͢oRWίو{n+OZ![*FGΣRE\0s 6zvrvyœ?腟%QW-Ydw٩dX)Vv%sL^ŻsǏѽw*'yW w4ue; dz}{͇0yty|P΂ET 8E~g\gz]fNP|ն^}=Q{sn~JpǎWпxUSe{NMuxa#e_gHj}jPr0PZ%ҧ.00s<:e'zK:E,h_zRxJF~쭒K` _/}VW[(x#DțJ| /eT? :rK{R *5SW VЯm?{O0aɿ'>sɀ+vߔȮe#O딏,Y#NqC—IzNF n!+ܨˎkAF\Os {%{8:4:=95;}J.vj3.9J >%'JųuV<9oͩ~b䱟yCQ|Ru+-6 S:A"mON)w9AۏVWⰶgS̋ RR~=ۦZdn'˂vYE_9qpx+ [ՙ>4es%!:#uKsow-~w?0ܩ8Bfp w gXƚ)؊|AMh.InsvيU_emŕF=1|zS)W?P|j|ph w{b@p{Ɏnnq/^ Zb,\^ j0yba7}s/Ãbީi KNR?<%/s:^fxrV.?t==coYUZFᅯ]IjU(\ks/u=,B]>4EdOZׁ4eaz޽OVׅ}F} N@m9k,y~gQ]FipVvo=WFM@qM۵/c, :F\{A1 ғz Dh~3u.sdGYGqb/Cn{..q=ZYyQg>\dW3ʯ.8Gx? "<#suc)rjNv=x9W.\c$C͠N-.u\.XKhDZ,<?7yO/r,p˟S\-ė*]ޥa2K#}:LqUg-fkY^{kU'J7p/p5-B 9CukQ 4'! G,]ni xTJߗu_sp;I{t_äP~0Ǟ|R U׽Q,:K݆dw ٹ_Vg=dzgT٦:gdkwYFc1f4oo\<"6umݪK U Us#Y:BW6xl vU8yzYC;{OٺU NୣN{E}Y`{],̽}̗HI>t^<#իÿ=I~}7՞mO#\ofz!{%Jo;'Ϋ7(=n8Kw9BgG7-xytCW?ԟ-FȎo/({z&ǿx/>t_`{WCS˿QHPg`;\ `܆+4hSe+U*{j7wrV~"yLZqxMq_M]e9:uN/ϩ;$̱$FWN{*{]Kpς;7^D[!޷^M *˷yv=x7AS+?OJ?z?ͭQxikz]GHOߡ<-.ypCxuknE/|٧K7+h=/7O]{"Vnyxr'_{dOV3\Sf2$s;{(r} f7wxG(ς̽.ϟ@}͚8NxuW=2a؛b0]͊zLx1J~[rb,=b&1GH^EWv}@vn<}F%σ_eB,mPgkQ^6p"}d꾑Z%ECgzd'?W]vW޼Pϱcc;Uz[ Oron3[Ir3%W\>91:_(Ww5׼lAaZO ^z1fзK6T٣y§&z/ lg U>O<[<|Ƈ/vՏ^]<= eW37ۧϯ/]v>{q-dZg)N]>ze'w)}_E䥭8Q5-;>>؛{m[):n?<<"Ot>51J_ng2 oY wd>;X8dp/7/\&=;dgzN>_uS뿆81&,><ZǴ}$;~.|pbm$?4Y|(}ߘW.Qdc}]p Y+GSwLC}ςUwۤ%P^t-^{wst}*}yH_A\Ŝn>U%ǃIOns/,_}s1ru$q3,[u-|l`oɊWk!ٟxZ]3~!,_v~Yp^U,{2+t^#,nPTx[VSqj,:??MT|bx]Id<{92#{wFaGWMN;[g'[3e' h~<F CV_N@۩X j:x_22UssK5 ~QvmCs F.`{%= do=|;d7zev|>p^ ғ:!I|)į{>23dwU|Ǽfw/;xTݠ"{; x݂pU˫mojKa>ˡY&^J+NN%n1 [K?+U/soI1`%G;ROOs]5ϭޡKߍ^Q'9`vzx}OT,煂r+[6J?;#9Y/޾SltbSʼCqGb'^>J`M7|~#;3:Gυ_~[Uof_\ԁw7+|ɲ?Ko|,m~Mސ//5aW('[|+y";5]*o]4i𤽕{g'~YT[~ޚK\_šT:Zً Tvnqy3@=aVT5_]sW^Q^.JqsG^_ o@?iKo%G١{WYf20p쯯F|.O}c _DX8Ii?;_MMčSjPh <^Hu֑eT ^dGK>@ҷG}&5򢕻ȿeOVO:l8xK/<`exKϽ췇}~9|߹ |s{30Zͦ[Evd;{꼻+~3F~ҿn\ߥuc-{c϶h⇺k5=yO/ٱz'z/qPD=kϞ)FDC8^f8!uێ{Fwi;-> .B򽥷h}+b'7nI|P|~!,lݛ>yGթGZ?gJrt™␂&k[:L ۔Q#R"vXW[>|e?Kg _}$=O˾،+{]x3?T]:sjuc)+KN,_ ξ9^?v]7vIGu俧Yl/Aߥޘ~^vTv^䷖>`:7/x[߮T"9]0Ytѹ3 [tޱ&-w*.{{[;@ɏ7򂕷=h#'{,ҜWEa__كTiA$}?zxNAog-(i=%WuKw⚁ϲI=w wUeG?sҿFWZxf x./W^֕M[I^ʶ2۾ο̋2V!Y0ֈj'WKW>Lt>}Կ-z,PPvw'{F=U6)Om일W8=G_3s3p>[t[/pgo>caֹ4|ѿ={2m-:NyKw :5/m8M`-Axkx)~U34:˺PxsZxff?Vmֿeg]ͺOIl/_6ӊ^GSn[ \uK% q\'ۣ}mS6NWh;q5ˏ7 CVEwcg=}3Vyygceʜ*ΡKydx#&/=g7:F;L\)y8@_{Sz8k:StwS5O+N|ܢ}ْUFn.2Udn똇XrM|kǪ_a_,|^ycn{ÃhKP" {yE|#ߊ6#9yBqxm9Ou {&~nRZ#y{Kv`o:OWޡxvҳ3MzAocXz#+G?#h[[(&eo#9s߳Ɗ>/$W# Wɪ V͑x3e NR&>>|wK{N`_"ck^8UKNCGK!}${9APo+*8Y~8&{;+=\΢~6UmCf_ ^u0|U~-`_t݃K}h$ŵݿw-\OY~E{Rv>zlVRߠ~ƤK ?}/-fS6 }xD]WUV?C׳x֊ko䇪.~uߛ/۞WU+ZԳY~1UW<|:нaO ,h=7{Sж^ {l, u^k=tl%} Ig ڡ#(,{x]sd/7)/Jnj(ד_i\qV6cp{rY&ag}Y";td}14\~g򖆸S~;y7wW*^{;6?hK0 ~U!]n晏z]yUqNӺGQv,\0I:e k',RT'f-|{f{{+qCm+=Y|G*/*,|\sc獇/av{1 0y7*cƳǕyη{kHYmЧ?Sq\~ |9U*^%!AqkdxUy@yʼnY겹w3|nBh!~i={Gxҿ]m~/?װ _ScSl_% g ty+?b^//ߏ)_ | ~+ա_ ^Vk\R}n %˧oq=/0VG}tewK+eTƾҮ^>_(ܬ=>Q"G|u s@霺!^N7F/FVs9qd4PyԂS?8Z8'gy:zߕMCW..7|R]:Sj_QTdNΝcg)o0 uOكO_۶Nvz{y~sVY8\1OF=?¯י+}H~v@z/]8ghɟ/Iiީ%`GC*+Lc8;>NٲuS=pn 3s^?m&fI\KR='+jR rmhdxr97gӢD/'v*Y U h5>9l>Mx/+kJXWZ?XO2%\gBY%3ίw'|Su*lGkx/]ope?zW{=j4GCK"+_P+#E'#%^"!9s-?jCR-n#F5s)u[ģ#O0ߝhT']< m%T7<쵫znK8c/U ;X#_͒/>GmUYoW]u&氍:)0OȾT>WW;_<Tt-DOIGC|UOOHbh48ģ=C2r8}MM؁my#ꌗs37 l3v) K ɟN N _\k>◐!-Ks85kV/T>_F}Kyznq&{Ueu`l[0OLVob_F~~h b_{^ 񷉶թNgGk@uxad_9WrƎZtkmd+cS_ o j_n⽈C9·O9EI^C^ʗ,>MhnveF6xin)1xD8KowI{p${ތ35kTWv{\iX|q)ȑw՛V鞓ė~7[$xŪ}1'5ꟜJ~|h̩Ugjo:fm _48Fys <,Q78'+)B-XyzWUyvMr?ďC%|Y.$!Fǃ7s ؇?bdzK?ŕ~AAYI6@or5r+o}XS1X-o_F4GUs#x#~kj]=^TVmW{Q<կ ;_=/)NUz_k/>+_Y~L{ k?|ɦzȏn 6>x}4/WtSvA~b% y﵈&^;5θٜ_Fݽf5?~Ί" \D+_0yjo?Jö3ݎߵ^}/z탸 ZY[ ρ}1X.B:'~vee.̦=1?LY {k ܯ5B=J-+ô_gS/K[n,>rc%SkT?Ye@싞5ty{Ty*foFC~3)(zs"acwrZN ?Es:V|DVzlu&IT{ؽ}|cyK^^T۸UrW (r/+c#'˼@m_G.ϪB>E˼۩rY|OxJx9Yj8k,ޡءzEMKܖW$؃XMv5]K^SfwPS_d$>K7xf4=6jL>ؚм&S^3,% ReșP~ !ytNޘ{Yԧ?Zy6:/O="=Į>gX-yg/.~i`x◉, Wu[/cèS?m]{w ȣg)q`k ~,~scٰUjW[݋Grϱ$q'zki߭ay#n&xWh/]x{5ۈ>R\VK v0r[­}()/?=a>2qOxqp.ΆoߣU?ZR v;П<ca?>xDKv k!V.u|AWkI0ޜspB]!l4zf/(|uj_<&뎩}?5ؐEY:m4C$K-~cwNOit.E/m}^d*.r^%ZPx"~.뇪i&|&*޴081 _8`ϑێ/F ?rf [܆g[: }5*o%^Ԝn!>b_mkF6'5'0a@W wխgt]Gh9<\a`#ޣ=v}.wu\|ϫ=x q1F9%>kn*ʽT\у&s_}~Əd8OC{?s3/x o;%{yߐ s=)MR7^ߒ47r+rP6{fkcmJu>>gȗ&pn3;.Q7/J ݁~Vކߊ'&NT]$\;0}e_s5 9+sR٢[]d>h'pT}_'k,lpYա9SAjAf4{߄= ~i_>WSǗBuڇS| 0>\QwWWo:ޣn[9)ɪu~Nx@>!7W ߸“zT ~e%>r;7h7ugs9_GK@nj>>[-bomk/s.n3kE癫c}x5H=tJ|KwtӾzpГȏq.(斟Ͽ2<k/W#;'_UB~ eIJU לW cxF|+|Ǫ%2ك@͐6%IV-c8_xFd?>ŏU傏D<í'u17b{I%,9ɇ$恋#8yxVRjzȏ#|K{cwn&T>m | עIoMڇx~"SiQU?&@KB_ Bo*+ߡh_pu^dByH_nސ{:x\ }8Ǻ+9*8o_p[5;IC?īGG9ϱ oSHF~[O}Wy |2]|F)c.?( ;R?L$o6H1x˕CN QǨynXߣ'څy{]#_d+&x!*x GnzA_[ڏka7[WN|N͛"s2NaZG›4o'?:ѹV{iOj.rS@Qnxʡ,?{k=@Id%*.$Ux;ykX}ȇ9P ]ŗ0RyXq*~5xz8 {5afb0X}ƞռ'Ȼ[9|\EoNSDh9 y P^%vciBR~*!q AILE.cw#Py"^1*KkE{?.ޘxHCx V_V !MO?ySvŨGy5?UDTo.!}{Vc_Rx&ϫ!މVS+G8_6fxQ[?5[%pox{<݂X*P|v6QO⧸%o}TVpa\nW=׮-}7ӌ25{"Rh.AG/[JGSMe}.X ?AbTc";? Tw2b-?Kyf~O1~֨?<9縯.{ MGVnMlGŮ{ʔ9אې 2췭9]6$Zn|rbR)~οŎk%k^Ҩ}EWp/Ys?&d>ݳ:-y9To<?9?cϴcG^ qݧy|~.pJdaW^4sVi>I&Tu#qYvti PA@WK48q.nzXa'~Y } ; f0Ul@sϛhyڧI3ѻGu^r܋>?Q^F&%~[-ZODXx)n@z)163 '6|D5=KTop!U iOpտ؋Ý{K{'pz׾0[:u?T7;"?c*z]%:Mث3epw~(#??z~^NI &!2=:RseW 9zNtƟYOڏy|^P^'v |_tV:uxuW?u3?D+˯~p YwsQ͓Yn6B?>-ߖ'34O<~'*}N7@._cJ˵\/؈/Y-91Bu gx&5J"K\~dvF!~EsM/}5:;q~'ׅ[rww[ ~2T{_#V~=׋W9u;|xEFoIex'uBx-qeQn+n5t~/YslWY+䬾yzMF`-{x\W"?ϖjJd"ԗ[5_!Hoo{+}>}AQ5{Y5#*W|hnag!ΏyϿ|G/JwGq괇[Tpr]8 91# ,d_@u̿GAssu?G*Ow6%8+8(.ytpOSb!(_=;tl>bIYOGO-RC;AGyvL[B꫆[oI?n%|9MS9ToFuJ̅'[ r* TWý1x fE?!g۸G3UGփ-s/(l%OPr?KרDV1Lz4`͕_퉿Z։*;=#uuwuLyx?Oe?e'a\\9"\+ߍg5^ߔ͙=ʳUM=5麱ThnNqB ~n~ .3v";Hbڭ~E+/U{GܹӈSʏŵR{kg31E{$۰?j k۠uׁo=c: ?m ++*Ug,J>N&G'9Žc'2k;n3|oj!mB V?sKtOռ+'Z|P}Bw+]}cW^w>w͍kkZ|ܻJyNn͑:|>@,<]|gWO>Q}k qm {ѷ196z9{:O3yˈˬfZUyG8]~ץgZ >tX 65%^-=sKl se7JSI=&R 1 #3=Uuy˽WAr;=[y[>{=3+@f!m逽WY|9{<PW,[9e23@~g6 `?BLpdQg]EG_c9ԟ8\]x êvNbĩ=lj-Gkĩ!퍯YiHyxU|NXuv(M73){] rT0hDKv^Bt3n,?5>V1O2ynWH\m%e3S_4}̕}|jn ?W/᱈m}=EGwGȻ5]2^ǚAYd,:¿'6&%nަo9+M?۰1̽i?]yh߈U7ps+ggwᾍ|~E~F?&vR)-oǨf]zk?d+pU6}(iJHQL'I\TS߯Nԓ->臚ϟwj{O4~eמ.ğo$ufa Rwn-e~!Uyf##oCScT筽0 樯" U!ލn_l!mQs897`kRTԷJ55e8<;9|ŧؗL])"Q#1y◰iDI!7>'u5_9u}O>Sv_G:%_kΡf$+QLQ#ϩD%P+[qnKrNgv#Sߌ>>[)Fv9ȵ]xg3x&su+O\e$?Ryj^¶ x }H׼Q|GN*zVv%#~_6|t\}vj˫whڇ snS#y􅤐߱/s*okR6vn{տ՜K7k*qrt #bI1U|ݘ>n"P\4]XC<bvgJFn~nī!G9B;p4H9vcE/MڟqtO'U2awK()_&&"%Oy'8s7se%m\v,8?O7DScRJkЫq7^>wL|Ok\+ iwk~T{c/pe8R?%~ʯ='ޜoݣЇX}?A1&6p~ kUw/U?&~rbWM,۴oaZsAwZ/ck }G| ߅\:S$V~N=؋ӗ]es7jIv+?`9.{'X'j@⚺} ?>'w潇w!J&?_|됯y36p5>pAQmKGwųœڞ˝ %8{Ro~WTg}L|S{!oV?@gwhrsu?zX?^E^㳰9;v2~Y NB?c2>]@ =uϬLTGwاz/ioCܫxc摿Aq=5֜%§ꆏsߓ(>Z~ic6HYgǞFSo$yﴔ{giz0yN7EOw "~׃˄b vppLb1#)q ^2pu?|[kh;_M#PJ} = Xq|d7c'<)#q^#됃f{<=K]صC "KtNB7w- {8J[_uZ{L_9JwLo/v5|=Cno%LE6IJ^FR^v?v}˽ei_@uċvD|U_|Y7S UR+qUTE6jO//xWg`>UL7TUxc#Orx/7,+J>PIA} 5w&fp#&0yG~[_՜+BTu`G]3迉'SbwmX59%ʛD5{b߭oWY}/̫ Y8ĿaNO3-!ozzs>Ca ^`@-Y_N~|e6䓫՟/`//8B/ GiO![/y#9ׄpYV>-U|_~I'^}4OL7_N'qښsU3^|Q?G7wē" @iW7Tߧ9r8C|3uw\|[ЗjŝDZΛScjaMG/ʛ}W#9ҿhz =Fw\MY7w7%n1~!P}uwp<#kd%lz>g4NV?piX v=X}RAɎl'MPg-o=Չ_f򆃰fY?x vnJiVa=p/&+ޯ=+h$/êU9Oo,XwAZ#?Y}FNHs*x!ք&\G!(xdi|ÜCNpEp <8vmӛaO*Wpoqz,[ǩ켿ܚZJx}q@9Ws5={=ij/䊤.حJo;yo'_5ʧQ?+"_1|N #փ8uUr;{Vm}E3;l9yLӞ_ WS^{c C;҆IKK]3D˩3 gܻc }I?˱z0?+;1sgyJ3:FynVmU?9c ?ISw܍3:^ϹnSqsm'cCg݅<$|WcskY$<3=DIۈo^Kt[Cmݭ=t.?{ұWk ۫OHV|[Ԃ ~CS~O䛢{OOැ=#{=Z?Y7z*<ux 쏷zQqqFbh-P8)G^Kw4y #0?.^Ae‰OZGݾr5v!>R7|n $es0 +8}8'X| ^<?Ac~Z{8S͵jq@qnUM9D}vOVw<$y)7:R{"~qn)G5]%uIQ͕ފ*io͉'KϠ7 qe䤬B "/׻T/+'/R+-_UW\[įIqdݜnҜI!qա*8G<>?ZN]Gk"zpbXx+xNGb>FO 4)<{`/⩼W>'A} m%ȿψ߭y:@d3v/0ӻرqb;ixsv1T=6CfMIIK_f>|uĞ[NDR:/>8.>]ȡ/rx F<~ S`򎝴{7VۥvP{x(~5Gz);`܌/*^CAYˬ~ې!+3eM\D3ҿ0#jW'ūPؗ^j^fo] .W?O;B}JOeFJRgzh. #fKW *yF6e6?a/X{6Cv^Hk5Fr(N@ZsTyx-ez^rueء_7;<_\W]4@<ֶR?^FhezP%/m ^,ZCG]7s\"c49A_"w.;qGWշGޫĝ%#bӬ{X߷{s#GdRNuO|L݂{ w{M/^AŻQ-[ r=կ ŻWTd=>Mb?zQZ;0py]Fׁ,? U y8bi%i嚓GVR%g諊EIqVȡs3/^sw ~(Q_`e0?_^GltyGe gӜglbV;{8KU|g\o{n#X?[Fnd~u?~]{YXo6[#\u܂OMΦWMd/["UC|VzPsh czOEoEQcF>SD\LV_YwD Q߳Ou8朋7yUi.ƞNuDBUw(W1ej'^^tΟS}ĩ~EGD=]&> [T)_I}ks@y&#r+oi]NzrR.# PdzeyzXeWtMFOOBϢ ly;y6/E,[ _=Y|G{SC._#}ji.Ϻ: Jr)ݱN剫'V~qjnK`1RKѻg!7y3q9?y\Lyfppos#m|~p,6/p?S+"tΩB>=ߧ[_̾Cςg9`>@Ë9gpT;э|La-?^rmJW߸-#'9'Aaw?ˑ>҂s()~ V@nJ/66|sadTP[nJw_ЃP;/WBJp7xO zWڟEp6x#/ؚT|}?,3naM q?*0ềs+, ?Lߋg) \Y;| i_;򐾔ykL?^sȥO,G\-Ӽ!Gzٍy4)_ܗ-K}u7hy{ [sZ ?!Uyq.Fg4o^"^ v?rsT>R<З[=0&-ܯ?\⾼Qp8<9ۍ((">"oJ߭M*;]ua#n<]2g.'o鹑A;iK5/Ic+e[5|bN'wai3k=ysiiN68ϜAfќUmn+>Ͼ}syZS{rx=_V#>u%ו-9Rlf6BhoYH |38w(|T98pLJw柃_"'j4Ws&?8'ruؗ[_ 5!,TJ5 w>\x#{죽ղCuϠ‰ȋaT`wGh-yo *'!R|O9z|vny3|q&~ꇧN \#\w'i08 _GG "<ޣ*;|Nr]9mg ̹ᑞ3FyԭBcg:Ž[IF (V89-c'38J끽8NYVݹȧeƹwO>M}{'kjgw|/[7j[}Z紟G=R`WL_e=gM*,z~t}\?g|'ޒWfxg{iGMv,z{q:xa-YG.߃p O?Ei순:x濌g쉷e Dy {}h*/V>}+8gռY{"W_P!~~ڵI]]!vW-6Nsi{H jna/G 7:wo|j[л PfƯГA[΁߂2=ބ#N}^Iqg"pr9?J}ݗ]6\'yؕQ3zحiofڤ~ W&w}˲5' rrȓ'OrvB5.5;Rsqw һC^o]G9Ǣe Ϛ^G 핏`w/ٜ^IȱSB]WB 9zf?9zo V`i:4bSݨ5-Gb<x9{?u>ok4T8քo?B} $ Y|J?nE džp.Vz)|ǟSSM#*?T=BN*#?S~|#B9o6$ʩzs?as~N1N/ <xTqC~\{|k;_ ^*jpA坜~tD3;cSG^39-eM?;E%h/Wܔ*ꂶg#= | %e:} ߠU߁c{xxEplk#ޥ|Dوx9 s]Nց0sRs{;H!G9<ŋG.9j/ se/C{a7LuȯE{n\oTUn|e>=G)Nh>tךYā*'e"vTuaėa|~t/C >YCN=kTp'gIx!ɷ@uu9Q\ 4#(X;c_ ej.opEpDn6Y|{=;"Vy`K5wTy, (~SMqs' CXeRd}|!'g[!&?y9ZۺH{wu_vyUG.>{7zCuz|E^[(|$e~Sp4ܫ(w \}r p{>xs8~?oi' ڇ |3K9_7wv, qH4n'L(P/^}Q4£3ģ ╶ ῭WPO+!0awWyB{pԫ]+*zh)t+[x sR9W"@|Qݰ\1Y[6ri_#&O(?菡Bx1v12>-/<)8?@%SjaUbFf[F+{i36%Oec|~~"^fG%=u}Ap"7FkF!;mي}P_א߲ w _+oZAGג XGt魯xop Oo{.x"(;c}R?K'؍3Wvqv/!o9 ƎT?P{+ޯR'hZ Ɵd=@H(r ]]4`/ bY9?}KOwZm\c҉/߿㙂8ŜY|uyO߉Ӭ]S#i0i^QA+<'W^(|2v[y.+?R]79]x "$~;- 46[}v=Ozׯ}[[H|=·;[+CrKOif욻_3Vqzsк80s|n'HqI5K dדV,UTHIlў{[ca"?gA86}.Ԝw9ピ^R+Q}uDRU'-W}Xs _5? y9o.;Q}yGkjq@}g-9Kȏ[ x?#&|w+}PK&̪8c﯊NH-vaA\MG5iyK蕷<qg1qo6~T}Z"ex” ڰ~ wk{)}k_@hWX{n?򒎶ȓ'[G-4PTo65?&=*/ys6^K_]CxόwȏDT^^|wCý ;izk.aB!iEK+GfAz9Il8ٓ8_ziiUsn}=XQݦ-z_׈7¯:c^#+wG:[㟳5W2y^B:(̼mmJ]V9C^b9re}ޛFTڢqS{7wi'㮧^CžsUۥ>"Yy_#OR~*έ_84s/ڃg=s[vS>?T?V&έ9]:ۣ;*2W?;ڄ~T?jtS|Q~.EyIȍJєq9z= qi=J<5g՜Sy{|{Cս5W*ƑgEghy!1xoq LF..юzC\ok s揉(.=y଴e7 /罖Ɉh?R?d5|OV!^ߣCp4]J>S>#o~Qqv+aFnyzOtuS`?= ]QTfÑ#^W4^|s.7g,_"! N_Pas~K+N< eW5|j#]Fؚ*^{77sݙtf.U_K3 ,Q-ܫE`?K)W/ xq2܏(~n&_rSyn@F]GN}/F3 I=__gx^;z B0M9?U/oy4w}K/'HWcέ|%+~~О]ñ7GN}A~Q$G}ɻӺ| ;L!'Ӓ,>mG,vvQ; 摟> *T|f'_bR<~.^n5soc}bNAw&ia?kЗ#S* yGLWBZxp|ySqЃ¾+0`gM<-[]ڿV|TyVL;)/v{4|Js%n +/XG^̻h-pqQ>6[!؉߳j~* ~2ȏ!8OX{_&^sgZG߷Ux)==BgS|+*ͮ•WơدЕS^>e|ŵ}spOB/}/Ew}9HdiN+ U0]j>xAn~2`^$fh{y3gV1o3Rg xŸ^xί8.h$DktpjxR;7wg 甮=\;فn$_}58;{Μoh1"^J|G7] 4"/'qXxq_|WjğU8W[Ŵ8ޒ}b?H_3|X$F:ˑsx{72לU2Ga/LqC~DC˞^bgCQl ѦПչ|^~%xT^8Csh;ۊ4$x3R_u3#/n=iϗ$!+8bwbJac}+ ]z/D5\jɽx^מ1xߎxGYSowk^G Od3ǐ8ߕsi?Ph!keQ=`GC'Sfȩ[aY ބe9<_տȹgS\o9^&Qʋ/>8C=?{lnUo[JW}=.Y޳g_s*>x FV5Zև;ɯ1; ~,iT1L67<+}j耟qλLAۨs' ~y#{ZγlqQ3ͳ|nV6T>j٦&)/'DZ+yC*h?~؃2Օ&f}My]gyWx.Ux v`!?W_^zqϳ/gYIe:o#'W®d$dmTSyˮx2c7 kg[#ע>ypĻp ?W:?+4A@ϐ(SyߵwqDH(u-wI[qS8ilVT8!ϽQqg;8pu݁. t.߄?K~%|=c18HA%WwrNsM*c7졹loϙ21;oI y</?J͸w^~ՏyM~=ȕ۠}g}>M˔&;AͷQ~ܴ=Ue ,aOKz!F[UoC{ z/hJ#?s-~޲ԃBofgwA.]ԾᚋiL|_qJcܣ7 .Jޜww3TO=?frOn-W]VgzzXcoCeM+φůa^}ɳs6'\y U>JīmU_y7nOq^i]=ذU}x~W>{{t)/[Ռ yq훨ek*[Uwn_B|FiXs9ic+bKkL6_g͍J ./-}3<+<#[2~G>?CXE$l _>oOdxBc/z|fG*N n.8&W5\޹OpS}7iY>5Ȯ|M 8;o ^TP |fx#*l{z{NڠIMc]"wV% ;7GxŒ:?_\=j~oI!y_K8pZu[г5TE?Ew*"*3*~ܑ.^@Bչ'j5o ~;h]x5"KM1R4;U{G^ǰ;>[!>&K_SJ gp6b^҉g{ >keh?V\9ܧU=D|/+oG{5RboH #7cym|O*G4'^v>&|ZV06yNXIx-{3 .)>?.h|S ބ_;= Vsȷ7;K`Gg+(BӺdx(x0R880T'_38|F?>o|rD{ C5?4h܃[pfg_mEB"S#ZsNq_w |6?q}jpyc;#ZpBpyz;cQ5N~1&%Mn c)C,ګ{ʟ}JGʺ<5X]OZV/$n㾪!OEīZ}Gܧ{7 ԏ9!;R~a i(uĉcy7opb {ρʞ%__4 xn0$?**}$?7=t,4G *wz}#t~| ]Ms2 ;T8>sy9\o} ?ގs&Nh}4_TռCSqtX}*[kcCR}&S}(8'"[}Cnmv #߇e,қ=ߴy'fo\L[i&D)'H߽/^= 7 n">4''Oo~>Q{yoW*]}7#t?x8r9K=9?(g6 >L[:yԭG T5Az~aC?Ó_*5T4?м䪏7W!őc_ޱ_yHcsT5;,މ GU%y{ޯ6J8؋`o W-[栿ykFό%gǮW.D۩9٪N|^=hck3f!e۸?{]-[Ńx?T1*09OpO:a⪁4 Z}|ޏq/ g;R9׊X|`G|x -+҉/ Qˮ⼃os=|C_Gk)pih(oV&4Kĥ|oZ|Z饚=tO ^O"?/kCp\qŋvcx3 ,TagoռI)ӴA|U|O5jhp籏Ne4SݵǑ'A3 ܮiЏ ±3?윧|S)?>Z?#>7l?}$g5W"oA!;Uy ^pVul7#؆1䏳Yy]ɹoG^I>=;^]Y<_ʥhT\;dҜJ@];sGr>NV~<9_>80' c8 S]o>gj=r쟥9{W2Qyxq`C}OiϨRT'j?nhQQN^&B[xA ôv])j=o3^B]);f\Cr |ڃH6`K޻|=[>ج\,2LֶId'm~6V9Q AUܷy ܻT_@K䰡Qz|s |]t^筕O$4N#ZI\jG\݄^V c7*|>lfU 'pqjݝ$ٗ[ WF?ӕ*܃_=۽ȋK1_kT|6cϝrǮ'˸}攠g#wp$4 ~p/މl½{&?|Kv3GN{Θ:4}q7<αx Ca+qYsV.s:Naw72$;m/i'>޶aԧ>uSz;Yĝm3CCLg~q|o"O_u^~Ey3EUbŽ7p^oRL"o/bʿ \KMU~|9-S7Sk/zO~\(]wj0W:Qygm3NރJ݋qͽOT?b32^M"h+(Ku[ Kޯkn+o?+D=n?Tȫ:ʃm xD͔۬*~|g4&y렞mϣT˃K ߝW ]q7W 2Yp.F޳is r܏&/}ySf_&_C<9笾#}q0h4S/33G_tu;Xy}wvl?'o4~!$ ܋gUGs\WLϨyx׊6'{sm e?K:@xg5W>uryUu{oJ}+1~P%}oVQ=?-<=@>ǥk>nQB{g)tA7mWJ!>=&.Y);_ߗ]Lϴ煴oܹ7O G/#M4-3r2ixC~nq`5w(3[|y(4ss?êSHUtA2"[HW4]:F\=Mx*(=2OU WS7y{H|;W:zbۚwlvh0$*T_lI9zA|B>r&ױ^~kgܫ;z[9Bߨ{䧺kQ+VDa暟 ^ S7g qgy3ug)՝>S]Ə9 [5X^zqK {ngv35򧾖`35}xL/{9WӐwa^|PP>n|z?;? TevMb_O>83:)q)^%-R\#!ЙpP|kQs&yA;>^z"0P:_\_ /9$zq~wP|GZsy^miNu|7՟LD{⭲)su::a/? |~r/[X}նŪoh6+,qQHέ%1dMٵI_){U<^5T˪xY:\4ښq8 W&Yqn^~J7`i.}T{/Yj,_[9j=Rdf1yU cȣˬ|ۍKYAgYs8%y̋xUW NO|S{Ɍܫk70]gynIwCܓ1s*^k 9,웷 }᠍KR?yĭ8/.k?NF~WeʗZ[z߉xzBA{\V!o ĉ{iċcayVW2ϗ|rP{GxcyQ<@7g?%:ģT%y{ry?ڳ8F;y'=0_'|?URgLCG-%a mT39ԶſD?8R@sOGywd's!N^!NgU 7C/EP]b5 s/oZ>lRK]#?bEڃKhoL$|Kj;n|p pDVVF|O=Voʿ;R?av_EFC-|>}/Gf˓W/şo'_l~>MKb ^Ƚơy}ؿ:}Si!B7~qoK4gUV?wP\}v&xr׸? 5qV#/.^$^ky8%T_?|x)OF}O};,v1 Bg$e?\}˱I']CP@Į#s6՚zN]V8ԞECg(Hcڨ,pPD z%N%v3CȣzWQP>jlG'fO|svpk]ȗ2hnZPM1W`޷BϢ_U(o2C12'c&a-wz}܇]{L+W!7ћ|pVOة>tF.G{'Qбء+d'/pUs^T#[x+]򽊷Sч#Y=M'MAQѕ,9yyzs!,^k=דW{5j\yOqm- Vj9= i?O{| |صd14B)=ϕ ^ՎW9~Gy/xUɽYOs_w>#]TzHoCWx wo!`<音?ϭ #gyc49 U`_#~ge@-#ks#sVk܆<ӑ;TڂV~ԙ?,nzsx&e\K= VVv!<lGczGH 8ڸI{oOVKEin擴#;Wg3rx2y5=zWwg-+δ?9w4 3Vcؽ9qM$b.Y^Wj<4tʋQjG)#e*y} /#3[S#j o*Wsȗ m&&zk?Q{[7R5Sq~O>-|[x߉' =|(>M.,g?)⢏8l摦nAVK|]5g_uo`=WNI@ԱZy#x`X{<)k)@RӢiv >nZ}'wMKm)vOG|%}rmQ| ~_?XP<{A˺נeher_Ga;>~'_;էߝ '!7e^k}8 Z %in#ge?ΦxʶUz+{{K3w {I+aN8j^='^M:] 5[}xKT/?HsR*o#h{\~ď'}o!~yu8yCߐxKjFi7'=o˚=ȳWPZ? 4S{o^Spݙ .1~g G=*x;P:F{poxG |O0Y{1֛{Df ÆįQRH_9=~D\㛧{pas5ϟ%*JxkH q3U')~EqF(/x47+?473R[_վMbGWO;>M{_exY -oE)3O}\sߖb[!͹wB!G<-h]eK|xn4Ah/yՇZ5Z79#j6y'u `z"pJ@y~>uCDm8f !K"=~J|V%`<ܼBSRzwzd/' ٳ[sU~3|JGMi_J)f3k&(@񽆾$lI'X|~Ѧk^[6_;R8)U%=1DB6+aoQ>ߢ = A;GLY-a5 G/Y}C`i=;? ?V\>&Sa/âX} ގ|O_դT靐K:[h>H`Շ]sĊWMꃷH]xҾjUޝ،~b0Oe^)~>NUޱh3G[U+Ǒ4K3'X|u'>fRA^9: ՐI_5sOZ <}zwrC7gknr9]zsᕃӬy4"}#|L_^esLq87! xegmy$$> OW_(ʳޟcWizOx2v y|ڏ|XRh^5rV^dw܇-Y@IXs%/?8W]+1}-\9ثsO$yŰ?Ѽg@=I犟UqGO?Qi۹<}[.JurgcOKg}~, {=q9sPT_/W|~P|oo}m!.WϤx#kj/~z^Sz_E9!ۭG.6p6KC~ܵ?OGjx˵o*[&>kd IۅkUo}k߳C|&>ιd#8;(ޠTgnqi\i oLu+b'׻O^)^`BA /K;_ۗ/*H$(@bEKQA5/ZOgjLF/Bb^j 5}7gOLV?psNjz-P\UM;}ŝқxOkmKmNq%SGq.^z8:}ʏ(lإk R:kПȧy <3cs+dk^8W?GB|y:Qz {ZE_Tx}g]y}ބxC{s[yVVA v'sLNW OT@<3o'MJk9m4>Mn/R^ ;Mog )k$iӜsCgu_>>q{~-sMMC*5_9dםUϽuɻ}x6&޾ȟ{:h{*0[<3fSg`'}#zα(;#=W8#'O٠^X_.dAwy?7) _Ꝍr>2wc;FqK:X:u1qe }vCܣ'v7z1c rI8ݳ7k^/'̍_.ܓopQ 2H6j޽}i%_sw?_p z|gOSkOyS3/An ȗ}gTg^~uoCٴYsA^F;MApszDsjoR'? O^{d4כx>+Oۨ?wZ~ߑb[%TdKܟ-C=֫^?T=%qc9<9ůUΖ،߬ZQEAF@@Ҿ`>zcў@|(7:xT{* XR=MN9Ɗ3W}wKqūꆗg)ޣB,{Oi&R=ZB5/I]ɳĴ^g;{V-񧾏7p*rLN~+5y=g)~=[_&  {hOƧ۹7>Bt6fMF]_>^wDv"]s#Qȵɫ\絯gч~^{sgp*m%I;v|ޤc\#7.^A(ڗ>l ȩo=)'M{82pXأfL@{}/8 vیܧ=þhe6_=e2~{Z괣x")ܢ=?G\9?O'^:5U<ƚy]{}s rkޜx9:#ԞRg(R>Oy=G7p}`csasse , Si]unS|ڵwnTGe7w4wyȿO?P:^89G:S{y;Gs͇T&18yxeROv$2{,-sQ?}w*sDמq'ytOv4R}x%_ ~}UO(5T?`^.a;:QKu?0LvvrU/ԯLJҴ9Ja2* \_H^}4n<n?m:-ṫw%xRC}UP??KOyl؉~z_2>|r'F7|Od ˿T}D<ݰ( ~_մͿC{oOþ]o_g՝ԿQl~@TI>:i2s0\po!et;S}h~dmn6KKcb`_5e|ųx/4;v>\gOXŃn!ޯ!|Fl>UG;XG׾?\}]{tj%蛪#. 4~J|3.spoYg49q8u^cQHdm -W>u#7:~b-UĝG9swo2-Fq;x=58Lb72s5[I1_lεs\<$G޺^UY} UE\{>LM=?}8o{ !7T'Eg\seOކ%~BOKSIPBROJ-W<,T~v1?>u|/Wit{7K> >w9铯T!,VߴP"w~OxN#OwV.K^jB~F?kVyĿ>??ĩyҗ֮:ܫQWqqJ*ApzC^w־x$-]M~Jq=zzb5 Y396mA/DZHCQ(xh;ji\<Օww !܏⟬s 'B .֞ (ǎBnsΉo;7=c^_]h>=H|0;dj_Mq=p'a6y7My;>c/oE{=[{O C׺':]y7G=D4G"(Rߔ6[Hx\[Q[]_u3M<b}Wr3r j繿F6?\> ězhEoߠijjUOu뚳xѤ:'_k͙ gn^ ߦ9[gNCڟBҵ=`0NUw|o^xٹGqXBaR!ai/u /JȘ2!~Ч״W-?~Pqͫڟ}nT`ĶPw-æ/*x&^˼|S z[*p td!˱|KU|wbI󨟋/aQVڗs@8%{QuѼ.ӹBqmQ~ZYyK߃5q/yN1Jc#Zxko [o-Paw?7y4{7o|cYw܅ 6R_ }}U g;?u/܏&I^I"$.ٷ3>w~,n6}pz] nqܬ?˄T6*O'm+" ꣙(uoHHϋu{k{x7okuڇ2KR}S{Ż)>-Yp;aLo*{ TsM+vpqrEgWKC+kB}.-o6ȗR{Hvcqexz΋bwg4]BL;zdXJ[ěm"7]UK 'o Ǜy×ԟq yhɎ=z_{?A{mږWfV&3~to'Ωdia YsVʣ8~?Ļe fr/qۻQ{W³xOS[ף<{q^{ h?w<^m^ސL*58ϗ4/.X(Շ$k>;.\]ǹd\ ~ _W;in297ܕ.>5WXzhN{Nh ;^:$x:Er2n^˧kBx> Z{G )[b.uiOu0#?G5Q;~Q 3_{sS9ϊU<X<0|NhOPInSwj^Rc)xs ¿FZk~/2./5m\_- OH^4+Ƚgv _{Chm&qwQ_E<$WL@{asC.,чʯW:_ \c-wp#hyk#Vk<~{8 \>˚TO??פ>Yσ% .>7ڟ"~ݬV}p`/^~5+ 5>ͽ|mx#S_+O^x<-M~.|]%^v⯂=57p#L<ȖKNp͢}Gw@\yb5ISiqS{^ϸ+_׋_]g1#oiă̊G%ǰB]WU=wx?/gGzwXiS]>j!&!i?+{@c9#~Vsaw xQWcFyg1F` D7ؕQī1=|;rBu{}!)i i#zgkerlQ%G5p sZ<>SQ7k).??|I{e?W]Z?$uu_Ћy^)kՇzV7K?K3 {lM/ګfEZ+쏙7c'ֳԹ ڛ<+oxJ ;L{8íwOy! CL}KaǬ}+n;v>]<:i7}P<OqަU3WpO3mA/+8ϩ Hl&?ޣ pgP}ȅJO6gjGq}yTjGy4[)Osp|~dxПE]Żd?·O&g+U~Sǧ{~ Nܔ>)4VQӧP#v8g(FaaVqxҌڏ>q`7=,JeN掂g8(QӰTi~JϺ~OY# }s|\ȫ๪M+yWoxL24p{=SMCu`yTphS6_݈G} ٭M2F̟&?3rѾǕ3^"nvS<*7{tL<_Ps};B}/7Kq}E~}.Tj~Oޠ6Mөo"Ks)+[u'dU#DIqm1/"{WߝU.Rs|#ͳS`?ד|;Yy$, h^&ȗq*gePIAUi7^u*#ju2 _K{n D2;jVvۋ)c>xͺ|XpvXyxN) y:H߭c->}JF?38)܂:+kz!ٯ['О5G~'oQ:jC})cS:Ne'įQD|;d%ٗ9r'1U>گ` x?92їPmw]ބ#>~x?W,f)ZهbNj?\o=4/z 擮_t=}ڮAC9o } /\inW>]Լ$/uxlȥ/>Ϭ}tgnOs=spw7rsW-絯vu,|}s"GcܰϰQ@?Op_3ړagjQ<P})y\dz<}rn5}%pzD %9o>xƓ61t |{,vv 캱~;.ӾOoӽB.*\Siۈ6l/NlH|0XsG,K{Nkopk씧sw)'\r%p/~>\Y%])=5i~o[s[|ཏshƼV4dP',Gmhi0>.7JyNY\}i~w)pT? S|P9i=9dg>>Sdީ0ثtՑ5^+v7{>}*5| nnU<}7dR}\}8?{?ŅG~#ę9.:Lp^yP]Ny qS4}INuć?5'ywo_&=ަxr ~z4􆄟W?Fs47.> ڊq9 ~<{]nV޲CW׀,ڧ<\<iзġTCOx;2jEӎ&'M[7sS2y2ǝkݢ1ϑÞ! ҊOʺ=@.ԏ>%*UoAk)ySG0z]< {r 82g=ckyW=yPk*Ja͓⽭hoiqg35jߋR=VBC u{þ9tMirv{}){yGW||%K®w,\}"_h߭攼)}8DܯoU:sU$|\r捤/NyFnC[qΨmgۮyn>"SgOI͕9vx/S߈ųˆ=WiwCWi@fCL+3#%c'\wE΍>GO-l 8WA~#=ɣه`sy~ėۯƎن4R<ڷڛ,RK<5?v~y@cپ<;9):O??%,Hmfى\5L[NLFR!;l{g!ӱOx\iY瀫'|i)w}qES(W|UI;Xi{Y& eY XЅMvU_J6(Bror w ɧzvj9x6c7ϛWikhğKprdK>5O8J ,CN /Q17V-[q|xO8px#k^`wk=~V^W4[!U򆰏_.{P;xȑ{i~^몟ɳ=,o)էuyGU0E-'Rz(Z(h)iӾ{Ϲs$d'! 4(;)d%B(qݿz빮:&B@-_nⰲOy\gE/Ы.UW?C ڿ 9*R?cv96GGk(ܯH&< 1:޽ͼF<؎ g=qc)jfy }|1?a@{CwcA ;[Ch+ȇu# +'FjN"7`J$ }y <5=bCVbk.4/;{}:UD{˜OsX@~bl0ٿWd&x }'CӜpr=Ok+O+? y<~do%p1k.:+zmWpd_ܗk~ #?Pt=_&~y?B_Rˮ~/Ğ@Du3ֈԯ Ӟ}'_O>O5K_^[U+ZJ^8'ȹT_W}px}ľ_ͱ2sO_u%оȗy3>?`>K6g ,ϕ_*?y䏽ICtY.ʓ\'/Ρ~s>D^#Ts%ԓ<`Hux]/{aZ媷[?}V;•S>?} PuAK.ٕ{ao&5ۆʼ¢2пN$ǵOԇݎiv~J5ҫHCk 0x(o8#ܗ .Ӡy<hj~&V]5AlY;.]J}-5 >ʬʷtsOQv-?ۊ[wB<$!O]i_‰C T"2ϲL\(}lGz\S2N&|c/Vc{R2_sz%.2pox3Kz{E}4?[Mg^6}J'4Sysk.`[{,/ZuMܐu89D-\ U=<7rNU#_s&G i}_|N]u4S~VOk_̼ik_.*\.]A^O+ׅR 2(Q ]/⣴ħ1Xfvۦ>ƨJ r#~ͣq+#u|#"Iwm5o8[_+>էUR<~;[yʯW|m!l_x`cin:/~YNUusEs}zk٤D]%UQh3 v 94Mډ*w=2ymN]M5{KnO]]8F)%jyD[ <=5G|[ruZ2vxkjOW~s_}eW_Gssij}EC{ԢUIxP{(Ͽ;_sy /S߃pG@}ڳn<n~ 7xRj,W~=?|A}[ⱪ/B.Xsp_ZBG؍ߥUħqsu=ի⟘ {{cv%$ao~.ܛ[""P9=3k_WOi/s)=ϋ/Nn}8^u=ܥm{)vAr+r~XW!ao ⡛:`4N Q^.s㚍^,lmUaWksx9jd%ooCWλ<+oM1ʇ?qqmS]8x% 8ry_'~n_ ޏ^+>,{]ԉif0'p O[AY=ץ]㉽EîVO,~Bwx!ZxG 5}_58ʑʗak/㞢~A%wWHv?Z/>O {.Wcss #}JoEsxϸ?4`']k4GjT >~CKqU$Q=I^=>Ӌ^U隃k~A,EE)BɏZ!լP^[د&ꈡY[}*oTW= $~⼧k =nQ?%sΫZ![T,O4Sқ>pȝVZg":cߩR2"?hS8AW{T\ P~#׭/ +7?Y5QFpZ<f]?H|Z4?x7>vX&b޷`4uŎKC|>ySk{?^qrEkW W_M}W}/kzXV{W[#U V|)?4H\[yQsVk0Qg|9g)xԗ7Hs%G-[߬|IN+Op꓋ipߛy{m[3}'de _8=ѪKT.S^*~<'۵ѧ1_qi#x@KS,PD"f'ޖe︫;칗.%oi'\~]pr[{ yhSqg|\_}ekɋ-d;]@'3RI<@~^-܊ϧ~ɱxh5~Fa')>Eꘅ^T ǟQKG{1y!{S@ިxpS8,nOdn?z>>{~*ڃsr?n[DӾ?mg.򏕣cſvkvƃNQxlWG/SXm׉?|}|䞩UMQwyo{AK)M}qA|BʻE1/r\ ڗ)J?Axu~'a΢\K|Ыxg,1cj|xU׵6h&+3w|{įWߧ {Q~q>7~?D)vx kO{-*?2_{g,#V&?3>{^S:B>+nP ۇRڌn أ:7ߠ8恚X?LzV7[o`W3渓<]4[x0ϙ=5#i?U ˱Էs"fVz"_^3'9yhWmuޤ˕ͼj_snEl<د}8h=[5V߼<"[ہ-gz}o4Qb.JP^i%~!PZ<ϑ!R>#} ڻ}x-yuT)\N?}ͫgSx[M\?8\'6?1L:vGGkVY;OJ7ڜY8} NS_Vg'?ޓs/Xʜ`eQ~Rs1ߪ~#uXJ'5gk|;ۿ'uG>/UN#֊gl$ yގ{(ڤ8gŷi؅Sk_~؝7]ĕVZ_},+_>ɠО5Xb3rvlߟ[_%o|Ŭ<'8g!y-dU>><WeO4%_ Nߕ%^WxϬ3ecKA)= .oW]=g#;<(`B C3OI<]T^g7O޲yW8xZLˆ ifVGCЧQ9 ^٧ {ήgy{i_p\xclk޿~c9_h#_?g9k?:A+{/ ar}^AmE.Y?)B\6?-;nV=pWWI+pCXu#@%1o$#/bWsqsSW^R=}z#x%vZ|?a52ϩ^' Wu˜ _mMyjoR J\X$gpϖ8fΞ%thOrMJj|n)cKќx5xHˣuw MlpMÍw;z\q~P~M%8xr݈\>>^[;_u>Oߧy#ۭ1zm=r Rr 5}5?8Os 9k[ٱK}6Im r?(^WգրCqO^wm/5'&28_KJ~vtNב*P<;,1o</E:8?Ea3@ p|Q9~Ua};w 9kCڮ?$ԃ|~,AJEqQ-stƝ??ů,䅊go "W~L}Oc^wnOr^ng#'agiYUnR=| sL}\hG'Oj!q~5OY=9Ue"?8Ū9]o!V#~ ^E`um˃⿈QW(_nf߷jՄ]rH;-I]6M&V+Y汾A/es'9şדuE߱?mˮJ_<N# [{7*wRt.9 jn? 'GUG'Eox1f^ٷ=wG^"TI<ذJsiNFx%9J\YN 5x}Z /r\SsraW[oěV:矊~x 騾|/Ӡ|/2<SkHꁚϧN,.,#_?Fo5 *[):{X \AZv8V%ۉ /e99@K.VՒq{紉+(}yėli_hs˱[ JcWo)e} x5S{jZ翰\|<٘x\7=I\LZ_y |u| R\ӹݢ<͜[^Y>/yi?|ף_-q| mpLvc}9Wb n׾ȸp]4ׂNJŃcܘjpOC{D4oȅm|ڏۑm)G3 yk'2vxFS( ޛNU|Ľ^uk>k^N<e<݌<t2x=8{ݢ47T^fP=b}idE䑲pUrN̗j^0GTn/+:.Pk . OUč~ݚ)N˷̭|`/szЫS8C^e_͹|Vٗsxvο_9>B|\)^+} R#}Y= ysģa<]5G:.>]rF4'9Svc~~8['$%^W=Pc-8!%>oOWqd'WS^3L4Rp[jpN]_|c;{r~v5*ϹQy~{W= 29FN ?ۢ(x_џO˜6Ctx~оa͍yۨ.SԇTLyZa,мR{lI^IsE^g\ kpJD[h?ײEmHDV?q Y~~>dN˿`nW?_ڢE-zLy0V&2VȄƩG*GtToPUq˾AM?cT[k1(&ڿPM@Kyr 6nB=!a]WWϕG:786qϧ}d6}Laju|S]cdoG|yF@? (M0% L~ Km)RKE^5I,نwbTXyоDHg$V,S8?w.*!5OAw_pD0"m/_f2^y1%-dsg҆y6=5.VIKT-[77.bH?peOԄLH&Y;S=Cn5GO$e?OydoێO,kX,]_|}Sk9ṈƔ^\W\5]Ni^BNi\S9mRq%gut߻8w|/$%;ԡ2=;~$E[6N7ڶ"E^iv*ly?O3MUn}np˦!Gɥkg5UZΜydlwrs&z"`銯6E#ԴzZMW` ^OyPSr72X1'VEx%ܭ8_e$pnhޛҒMU~^- Il53SdwZQs1%G3Dɞ3w?ҋu {^}Dq(\azZnjZ=OZ[jM=j@YM9ə+&f2'&.Mݍ}N'Z7Nmj8Sk<>M{ok$~?ea%#}E[dRC[א$od^g4yM$$p1S=eW`_>e^j̪3\5=F˰?<F_T"yڢZ>yjƎe!75۰+YjEˢ5R+2\-͉G?QlnO|9/Qx W- ?ur)Vܪɷ} N75bo]%xkŰ7[C0:]Ss1Y˕vbt_1kSś]+;* ~~-C[x7~H>' J70ɸTh!YEn3ՁnFYرGKD:~=΢ĩ&㈚B_-eo{\&HjzE֕:rŵMtf\9|^'Ey78?^^VǏMZMCx/՝jx&oДz<Ѯemem wHE\+kh:ˏ<>U-/jh^E"STv!U$*Ou%=N$DWFdT"&LB~MӒTS@h%.m{#ʓm$Ni1%nLnCK4`aȃ%^X$Ԧ^7d,ZHl%נ*{És׍^r yY*KݼkuL15-TO 01ߟ-PWϕ%ć?c6^L5k.0܅w K">i?N|x^CI;Z|n4G.Bo'Cr-8|8B$w8&Ҋ4$* mxԍEե-_&OI+ ʎ7Hc7^鉖d~jrtЯQw \&l>5of5]ˢ_Yn;?~8tv^g2>TQL~.MJ 5O|۔_ ~MW"e-[GLC" 9&k4;фv/_`kCSAx-O󞺜vh 8lFȄ"OKПW$) w{Ӓ} pc%ec"W2-ՐYj y#ʇ=Rd_MQB;El#\K[ {1y_ y~IRIY&sSrK4 k,'MF~B8%QΝ0De~нVF:oSsOjn]N5޵#q L>R/7+_+ZU?'F,A=JO>x(%Ğ*-/+nԻ `n%5/yظ65$(m_l*U/@ Y-ɧO%/8͜Gs*p:Y/oas&#gUݕ܉= ௌKx9n]n}$2 8'ȃ_%?i{skQ-HcOL5pja/`]f Ǿ%G?}>$Gcj6yY8BHEQ:JJD\R% ,9#~`5,| hx_";<T_M zoQ"~>4OT>w7\ؑ%!'e§i5~ %0"׍[>pxR ݟ1䳬IqJCȆܝj8.p= khyXCKފOw]7|,I3ӆ|՘TGǮWN9HEOktҸsko%_ٔ{$c,h *hyrixX!}yOyٺ" >R8)u@JK7p#ߋ5\e˱[z*?_ԜEukDnȹ54sjo_'F! VםCƗ][Ӷأ .8W~.7LG֪<@]>aOZ}/_-5?&gsr_RE*$@DrVT[zC\ϥnuv!: ;m^uj^Cmn%*fpr-Kͤ9n@/&@_Ϧ=_ nHnj+i\C-hR@C]exVA-qkT9B('OjNsix=#g;b|{448n4>S]v=FKÄwR_N&SNw/kCody" AxHhNq>vga5vZÎL`8qç9="dw!3va]_xy?~9sO_}fM*paQ3=fYa{2'Ln;'B~sdt4Hն>\?3؜L{uHj2}fqwH̵.'id_׋=5EϢߍȻDr#-Tۖ8WpG‹??زɲT"#UWw ~4eiby{E}g_j)رAȽO ]l-z|9iOuwT\0<݌KuEwy5w"Oɾn;7)3 ˽O㐇d>e?)=S>TWE u>}4(r|Qr"utRu}j<:tH8 Oy)O>A)u1 sͱP9jHKȜjnT!˚]7gt)znxWu߬0l"WSK?}c%yn-q{]asշp8~7t&Q%5F M<~yXd#E!t0~6U goF/zUNc''a~ᅼ9Wa a|GB.U3,MCmDZe>~/ CQ䨮 <^ "C&95r}EoUt.S!.iݓ*5Q8U٘%"SG&-G檏;B||Myګяgc޳s]~Zɽ=|?Zk+sRXE7z)[vU ?n;6[ nn7;$98 Ύs &/P2<'_zKM=~WyN/~*"qo1v,[ϙ 5DSC䳧Ւ6:#'9sJӤԕ|+ENO}`{迻LH]R" ߌ]OE4P2 [yn2o~TI읱~D+/.FGnaw%Dc.6<g4X=s׍7Ӓ[Iq|?PKq:ilRsƽ[up˾[,Ir\x1K/?'.U!NV&먫%/Ng˧e+fi6y-٘SR[%b|Quw"I<6ӧf{kUxU1\C9Ofm]s~|{Ky>i34 Z"i*oSK6\{fZ9qVN8i祦ha ϱ}NܘӲcr<% K6cMGEd&i-[Wney)ߗWF^LyzUǐbܶJ y.\aJ-\E\ův_f$w&.G/R/׋ni+o}LTDN+Cs*99H_EП ؃5g>R}z|/lyG~fh_%B+yͺ2~io-e J~A\_fa1>u )5z;[[i#k5/+N~DwFORz=f9p?,&s\x2yq-Ы)Ns*S0&rsAb9{t9L⼧uښ9UINjIw:ie\=a / kW*V1YGwEKL*u/WuWr } 2s!~};4!zn^{lXfk| "ވ>|K)FZw7υeS/@܎NW /9&A7h9w3F/}-xy逸&V%{߭B,k1TF4E^зK~FoQx˜ĥ?h8j+^=~-}9(Zu40~D+2…ɷ '<- "7әc6Y,} lҝxnpaQ-1oyc_VkYx\cP;Tݽ9gA7o˅YmZ>>rfx[a2.îN.\bUJU'8)?Hr阖fwj&~F_MzuxYu"g MY"4OA|E\% OH&/ڦաW"nϹޥħם1=qјjF/TO Wԩ%(S-.f%#F'W~@~#y‡˨M-wBҏ[s WϰU3*EG|nϰ;K}"G$ȳ{琏 36:6c ė큜ޗ#KUjid&xdz"9aDԷ3y.}$Q m]3pYZN嗡'Yσ Wh仺7$q8}LG'`;S<)~$}WXGJs"u`̣CT'z<^Bqh5ա[iY%4^!oҲy'G'B݆7Uxq(@C/ Ϸ^$r|/o/"o/&[h&3Mn'&fij9qSoZT}|@B?젺]VbDy6kyJOn 4|R|Ce|+XG׳dW}o Lx`g?]PVHJo^/8zBˊ/!-}Jy]҇AKI|θzꪥ^<. 2 gjT;gX{HK GAv2M܀~]ޔ̓]ܡ%a &i\ZCU;^2jh=u!zoYsX=wgK+EX |圍\ǪL޻V|{zO{~8P_euizzR8X?'5G"}TU-W3?; "e֜n%~vCEZ\uu̟xӜP-TCI u[ZRϩ|O</-ϫ2iC.^)P5y'K\Z}ʏ~~ y2*ݦem4►nB+_?L=2-+t.^& > \knx;½5$ok/?I#oF֊G1{4όf*N,R|yvkAE`aKܽ$8?~6vjvdµ|_l!Vc{jwo ~~>[C \&͝6+,OC ԉ\OIJ~n%|짥XZeP˙Wpz>Zz7v1Omu*G7wz1ywvZ"QAبn qoR'35o x9q\pB4_{)kGy/r>PLa*I>(y; OMďYxKHE7 ~9f@G^͛*f4֨({nGO}$?4Oɩ+`k+vsn؁k{&-9E?3ޔ/K0{w9K SvPdaNz#7Ϻ/4.h~|4'Nm@JoLޙ-{doCDKnܳL]k,1Elտȧ;%[C6&lBfk[(<Ojv[".K>oaw:cLwR/ogYEfވ csjeSN<;MHq -__:c DbިZr v #t\|.n>j - ;Mq "xqy2rZj[qx*vhnj:UΡNէ%٥QP+O[G8DKLk>}m%2_kO%WN*p^͸.?ezo1|9Q65GZJ{m%q[r;ԍOEK~RlV$Mi~cmt0-#@cLDObUkY? j)Lb3y,Li 9ɽGfjnZL 'F݋yk] ! }ՏN4w#׵|e<ϛ?Ju7&v&0y+J;X yw]=# !"1 p[N;՜ U$-:ϭY`7{-H/[FjFoKYZu#mB7vcj_Qï<~d%>8s՛NS=BR8v.rn߉yW_ʧ<[ww_عQ)I/\8H&1Ku朢5_OX n~{Ζ#ߕsw)zV?nyģG_ՏPN{͊)i;uk^&z>[r r\S9ԧs 'U?b}*g}^"xC!<ɯGs.SP_ ?~© V(dhg`_[5ox<`'k5k#^A:.S}5/gXx1g;zh  n sp}m4O{p^5S8&~E\ oVl?"G},}yy MMoyE[{Z2=ܖ3!^G?~+X#5݋{L"gQݺF;?VKRGd#3%}N:^Q?BcrPo;{l8r*Sj9Q'=v4KR![MwMr#l7C@N\ڏR4kPZAGx٭>4ϯ+OP]S=;0g{WS~{G.Gϝ?#g#"u~>F}}+O>嚣5 {"Z|Cx>y-8>MM,@W+OCW3io ^3)\~L-SBps\ x0p=?ox-Z  ,ySʷj1j ?[T ~FD|pSӰ#UkT sO܏.2%]…Ӧmj<zV6Osk=^u00γ6ʎߓ77w&>X{ˊޖ^d-yZLs9|oZigR$˨mpTSEM#_~N-x*x$Ws5;Nn~S=kׇ8FZ}sg`'D+׾[ɫV^䘫ڟ) {*ߡ=-I -= =pϥ]x70Sxx ^m}:L%[ pq&9Q#w+8r<~~ )P' lLy'g#P5oA̅} &iܘ=GTG^$w^!Ρ}'Kg/,p SeLAWARyn݌UՒ}ܝ\-.n=eԝqQXslusKGq ~$ݏW%|H'3L|Mހߨz\z ϓȫW/zY6| T7)^VkX˜;'97՗=ʻTM<*CԾ)O\u[UY|xv,ߟuw28aϳ7%Sxo)SyO82yhË Sz7}'8}qϙ#u7El85}5jY2  t~rή _#h~ָ9w>&G3%n7Ǵ4s_*pO0|Zx/[4OnMEm{7&E޸Dy0y opiO_1~4%;~ON[V_DgڨW_hg^8_toՃ;aA\F)P<1e ^ыK״7ɱ^?}S%cC#;#{nErUh~8[O9*x+ᅫ$g#]9|#_s](-+{kPnb=Z͵KI3>cv0NAWqG|~?#TEɫS7<=IqH{g%3UyG>-7QKe&6xR%ܪ\9,*2f_WνR(?+q?\#c$~[[cG OQNާƂ-p>͑zgyęIv x7]]ЧD?Wuf.-|{3_I)H=MZIP+~泐ӜV&QOr'yog0zv}i5L?9=)K~vS/:E[ɛ?K6ynf`=]{_5}6>z?U{:w /S%~Ҫ;8]ha}o][|Oێ{y-ખء0G? M";-83o<:w k=o _{Pwg~Hss=;>{Y8~s7{#7Ck+{6ozKP"{Iqkw5ϋ>'&9Жs ܁q. uNpfb+z\^|}E7M+*eFbbGi#ڏˠNdgS'/4>vم>_>bf/6ɻ{Â|7*&5NJYĿ[MOuݽsYOs.l9o$K>~q`|K;yF:`?3'z&_8?4Js㿫ŧ5>4oJ5qQ ]_)3Z}s oN~ōWNAOSȿx`7^3N_+W$ͿDK!w|󌗐J¹ŞC?} h=ϩ_P\})NyƟ#{_ ><,XxI<ݚ+r԰MD[i^=gg&zOOT] )q,?|Bg'Q{jN:]ɓ-+ذ9a"pvD{B/G_-~݃>S^⃞e}hRJq 7wA UI[f> ~cI10v3K5߳?qۅn䇃= _bKzOdQӯzj4'TN|=!GUzWc푯_c,a}O{zZ"؆ݯO/$^*;QrKgyR5|_$\{8!?;1q1=MQ>hςiu}߲Bdρkvr~ju-^x1wH>>׸Bqy]^ I_l`0z \dY6h5s&眲k%x#5?T4WL1R]bpAOo cz84|Z~A,> Kin)j oͽX??I/ŭɳW5}9ŗWKk[9r?S8>syL=->g"۱pJkpPKC3+ڡ= zL}n)?iWx2h睳]}N=#;U?*7U)5\yqc,^ƿE82rM]-⍺J\s?A='׬h5)5\bſ\h?So7i'!n9X;#7銋w.Y|gC_I@+Or7'w?WS'2зxZ{?kT=K`ߓeǼ{A|a}WL[=ZqV,쫹!*Px3ÙA,ќ]g/\pBέתo&ܙ`*T[y@-v/FI+7v?ܯ]|S֐'eԓ mea^~C{mxڕsysSJ' Gr_4d<6A@_~[osiy-wFn6~uӹia gORϽ Ć+^ljWs */:y z2'v߃*՞3^~%[s~3m\XdK'o{yV>!_#/a7~-8ү9GTT>vCmء[++9g.6^$nߎ~̷X-Ke>~B}C7}oϰWz"¹ZnhSB9CKEGzq%!䥚^wDz6ko#\}7*?Ƭ9F>* V[qU18{DygG oćf3cu/b߃3W0 ?g4Ǝ4cg3m|O_DWr/b(` Ns)4YLVX@4y(O&cD|7N|x=| 4ů%>'H* 8-ޢ<`΢ >. j#2{W`޷!ēU#cv`0qhU竟:zFQ?j _4Tao澂mчչEs5I{P'sB..jKtV;Sz^3Oj/B=Irb~$׾g\N>>GߟSo3e~Hud?% +WL_Q{?陌=(~|Fj4]{[~YCcǴ/na. .o\)a%֜[ܧ{X7$\8/MKi\_pd+4= ܟ<1C>F ͧz~_k'%9{7Eo6$Z`/qN+woi ^7z]y$d3߷h*LjevVPJyse_)Ƶ;*! $_l/ԫ9>}J"*x+KWs?TgC;+a/#ߊ Q`!qoߏ4(E&={]>_|x!E{y>pslzY:oxF{bG(V87GI,ާj.n|o֯3/@YA1x;xk3ʽ?F";(|R>I={>,e'~ַ|/&4O?jTjɽ*l!'ys5^x$?$.q`yUcs9]~FL%S^] lϔy&w$ȟ+3f ,Ρ`3Dk~6RW}M#lkOSpSqͽއ4@?w͓=X՗U}|;_LEO-{Iʏ}3荜.^ է oeb_4&+_yp_ԼUsNx ;^h~Xxa_   75mk&V(X߱?їz;j|Y OU⩪og{㟐_'{<ບx+co//-TfF)~cfNi<{6RObϕI/]y_O?zo9Kȿo־!_p! wާ?"^o!2chV9/5>;U|fhįxX<ڧZ"8,{QLHA< yK}O^A&xYஂ>f r֞MOy?4{0:,o-07TM|ݯ!q-#ڧ8! {\x1Ks Wmqȥf '_ߓ<^J&Q<7߂a/i_ij 0VsQo$H/xE{~Ergav kWLFJt{x#ڃ|~srCT'/=O_Bߪߠ? qaE!C8y u lnS^b0'!?8<'/D>h$Oo+kuCӹ+Oh.-r4`a[^.~vkM!v"=ݫ oM"u Ś_yBcfawwI#_oU؟:+4 ^ѿ)~na.7hD4YFzLnj7O6zKÄ^=)u'䡮a6PJ<D洣wk]5R O&w kjry ]>o܋|Y-ao%T}[h,Z&r[:<ڊ1? 8?wgxs.k` &.5>.CNF佄n,1?Y-8G`'.ɼIVq~|_ۨ=$/]qn7eSJl\ SkO?~5y?{9 3vx@Y }!ةaMt_s^ؿn>"nw+~{T}K.5G5aVG qDQyuGeFs=؉웷ycЇIާB'un{z}v6#yNs؎'(xKw58Y9P5qHQWR=O<OUrzG;C̞M}Rw^y-sQp *ܒHj`ys~O}F<̱d=ghi }*%4)f83VGyy > }ݏ5ͼb"ܢ*O ]SJ]ӘO B|^'gL9oӜI >x)9J|GθS{Z_o GiG ҷT=15{ѽ'~maLP a?ӢNۨ{}ԧ"hUGY}iꍼ%?>{r$&a=:zSX{x=Tj(.74 v5wQO6yU}_;5'xԡyӐWgϑ_| ڳNu|n}/\*V"K;3TIݺF/Ћemd'~^q9/XOm>~4bb8{x &!ps|]BqԜWʧIϦSΪI@S}~Cga|%縇W H$|qA SN ޜD[!i|H_ G5k9P|]M~c|O%oGf",#Fs'f o&6D)!czגO&xt'5GC;p_׎8y?wj63xb]͛.F>*_B3ğ\=b^͏7~)^b˘%ۊOa s՟j=أG}7/7ѿ* 藉ho]^bjXyz꒾//&H>vnP%1kR{5/UO -8}&㟡_b#Wc6Ņ{zLxϏܮXUO ;rth!vwh>hKs>x͹ r;C<L|u޿j jsUG__ h |suGO{}V8^sl~%صTD+xFcq!&"wXN~GOK8;]e_ο$~&F؊SUȴqϦ[[ ѩkg˔N_Gx\}/G.oتyK}8sr2S[7?ӞDL駘1iKh3/0v8= |`n#G?o|JH}3/=wאC^"zBϔ| ?}h9B7CSCk9Gn*>g L]7a484u@l'7S"ނ7[-7M[N3מw[{75o1:o_9fרMܙ./ۥ)/+?~bž{kQ6&G_ om6?Dd>;c;z|N=G|{0tswBEߪy;xLtS=_eqWhF6p^Ri׼a9>!k~~Ѐ\Ks=I{#gsE6R_t^j[ 3;^DgF/G'V}JsZ#H3{gՉϖSޤ=n[׾иL `usyCQ>."N5|줚ȑW"pjEuo˿G0_OoN/_/QFVok \?kYv"/>˸cys_K$F_!l^U'v&TWM NU7)}Ng)^)kIkOݠ_=S?N^zrܣ} ~ί/U#ϥm?oe"3ރ/:xX-͛OLDbb[ԯGժ!OFS#~1quRB8!OsFpS+_\e*^kÚaW_ 5)ֻ;9UOsOދs^Gyb_|;B,x?nT_78NgOj?2dQ_x=Ji/ sY<ܗ]y9S_z=9Q{q9KQghےO7^jn鬸t< 9&Obk0Y>?vxQέ*~q RT\n+"!)ݮ[ṴޏgX|_aOL_s'Bߜ?!U49ku=%RYF$ǾvQ׎|_J/kZO.æsȓE=v%o^5Y5*cC|aspxLZO!^,Ꮒu:,oσ>ş!?8j]24G]J;vG |?649#09_r^SigZȋGd4O)sҋvq< Z6OyMk|~CkuM7m^G ՟ F +/t(.{%>S]wu yiaYL|Z㚤xAbyᥝxLVV +M^NyȳE}ɓ3'TM]sF^{7R|+ȗd5󩼁 Z O#z.aO8A^YmNܔ^IiVrVݞռ~FMaOc/uwu&^ǥ> L5Uv>^7/>#s #?k=Мܯą~e?_{T?i+^d!!^K:ݏj/iMF~&_uǮWTGOuW%s/1QʳR ܫ>[#Q'j߀5[)1ڻ襾(slX`o6n9GUL?܁vk&_Q/O.n,Fo2mN'_o39D.#}Vֈr~99ކzrϣo ү|͗ bi3pPk=~R,?I7Oq'O ^κMϳIO#iSN=95|oEG>E] 8Wx$x w"gسcaboRGVJ_&ʽ%<'&O4Dxuڐ-Lo3L|(FT&w֞O?Cyx?I~r }nk;Py [A}<%ʓ&WN-?y*;W"՜SWmOdvU}o9o/GӾ>@}-*# n?=FW㯽;w}Oۑ{_#q٤Wl=yzٿ|W׫qzñN~~A|m؈Ykߑ߆ʿ~4WGja|ZB\ſ{qsS|yLEkO"~]ڏEyΡn0~&~:ʙ wwP_ij+J}O 7ֳJw7[fQ^R:y? u?g:y~Bz·k49X yD7>qǘ/G_X~ªa2Ka^Sl[>5P v)dӇW}({F{WB͙gQ|{~YY\SGd1OJvBs9{G<{?{_=bBV&coxE}&{w S^);yNx3gkF>Ÿ&"x ^{fd[Xskss;`{& q'nƎpuү=Gܹ/}]T{y_s{ I[3.nQ}x;.BBcOHM׸ǁ5[|!&g˫9#Vyk}`_SH5s~OWMO`G{?Eċ)&6mPFFḰC|gTSOhF{w@.hĶgS~{?-f偓,hg_p&U84i=O"KԼOa&t;Uqջ*ϒ_ڈL8⑚?z [+@.> {XKgz?|";e[sylp.^9Wn9bE#ڻcR?P<$>l$e o&1ٵcO[6{ӝW-)U:Bi`ϑ^,^W;|ϖfV0c%ӷģwZTbx鏽n>W֒wy b"Uo:bz9v# &PONA:\A,[s 499G}.4be/*YqMȥ>u.:{`7i?uf򏁮2~I VG;Ӕ ދ5߆<$?(x3c_G#2MV_5ޫX7 2al?3*dG|c'H=%|Tߍ݌<k,snQS~=RMNTUUzkۮ93[P00bt%O!i{$~~<} 9'+gke䖋4 Sk|iʫUoYNW`y_ 0k{~S̪} Zl؋xkG,~LEat(Zt yexi[|aWJE.J2[c/|C9 ԴWM5e4Wƽ:"ߠ.\6uG^{:gn&>V;3Og)Ob_Hϓys.SIj?8޽u!a}ŋ_ (qqv罢?+~ kAGɮ=EK,ѹiqXX*P_{RQI&% 6G^hZ3}jBv" T|oK<"ɯ6׋j/ן">/4ZHO1ݫձ==.^Xf״.'РF+޳m{\n@zzo-Z}GO*:o&\;Ai'GKu?׉Gfv!Q βّݜy3տz;=fv'*~?|Vsxꯨ,to_J[k2;]5:ib~0yϞ~2}qRb'zU,lN>ԇ7hex'/Wig9)> [>-T7z_{G8WS `Y>br^9׸Ńۂo޸ gsX򅵚L硟/c՗|e]9 =W/y;,X K.͛=9<_YOG?~IJэW_j-aL\};wI.:i4#c&SO/Uj\s_= ׾5w"qDG._!yFކY9$w7>o+E3}h)~Jy<^=oz/G'o8yo%i~~ıY}p|'Qص^S_WnӼG,a}g"ER{C_ ّ:1,i. OzWR#44&3v(zVx_KV>Iu^7Bao<]mȕewz>2ϥęQڋVN)?~ #B7ݪ̵ਙ#l??F'y۪ԖI\ȩ=|~ ~ιy6Ɵiͯ?2.S4Px7(_]|1䶡J Jo]#13Ê:*`Ɛx"uڇYԎ)8y9x:<cY5_KgaOgyؑh@fjW+oJ'v#Wre+/|zge?E>|ns;NKRa2n yOmT=^yǸxz1Kse^#bBkշ⭨8B~a _uy5/7J=:8:$hKuΫ<=>E~[ f7xwipKFޭOO{?WVx`W.Qcf{檏, iY[KKJ e~DuK_o`PW|ٚ:E_B;ꟺy30機5r9,;J+ӽ;\E~?'v-ԗO?`qIFϼO4ǖG| 9p^ɼg3zZ?ejZ7+_| u{>g_֛A'm59 0Vù3cS.HMW>v'5?N/iOLsF!:fUc3\9<7z{96,D %}l<(zW>0|c{(:~?>Lw-zA~pf)6WrU &/?ni͚KоxD/0xaާǹGbs ش$W~f3(I#Z.}')‡_>^:ϙKd}>V>Uz~nW;o{ 9gR=ajo/1uq~>$NV+~ૹS,}J* yV*B|ijMq/w [UoV\:Ui>ڷ~xWYD>; =66[?6.=}>╼L~BpYfcF9!WU_7& t\AqҺݬy0VmB.ooVqzx[%yE+ʅ|W.ɇ+!pRVŰ ?Y=ׂ\v\̰h/2Th_s =f?{NQޭ:E|Ծ!7WķjŅ Љ3ko3P;_|1Kt3qKd=ľ ;?}!seh?\vǙ\>ϠXJv+1 įgGzV~{xXncv*N#|Wd7x6s4z'yp7S]ܓ;Gu+T?/lEx! 4Sw*I wEE7esgjV٥:/8&K{*W?;y̿9W9oM#u@c_Dp2z#bŞY#ث)ou:W&ˉkd/!n>} }'?>|T}8C3߼g>8#:83B{\}WfsܔH#?}A]O)o.8?W;YWO׳̟xз {8W!_>SW`.׋s 3Gpsҏmy_NfW{S*(古{}W_/yqvawԟ~#K09Y&{xC>>z<^) Yk0z:ˌ{E_a]-=;~ɌqyZg*jsڛ%7O͍_9ItF ϫL?cG+U4 f~F~Żw{0qq?*_)?";0T{5vҕ>u*\{#+?{b3Cyy|7 |SK}_b'2bAjWh/j̽ފ^>Q?hNrNu^ڠ<ֳ6ܵg]?A|ŹMܿO~fa/}_x@Bs~;7zRo\Wܜ=[›Fb}kVC-㸷<"v\]ιg;6{w[H(kޏ5g[7H{SnEr+^s|:Q_XO5̡/׎!?י9`{@scw{>8nz/%No+z{ ^G G8Ԟ}.So󎼀O8Wv|!^QsY{,fYHb{=_p8GxM)Wy ong ڧ昽UT>3_#ka`ȹ9aǢy ؗ|XwG}NLmj<4cu7o3}yw9w7iQ;|^!2TC}C71ky/c/_kg Ǒ?E=țbeXV2޿r4kAӐSB՜otUf+/f֜y+T y#_pSUչO<;:\vz栬ǰƹ~l/!Hx/4_<[̟ES,}|nZ잹Ty;zpqe*^p"xɵZQ9c39ُ^M 6$U hީC pFteڗKi܌9{:>+8OfB9k*bnOL\-|ېL\pSb{S\N)k o}{|WkPM<{e$,w?SSyso5B3x:sO!YRm}Ac@MB֩zlݸ\ߝr>/4iE}89On9e|Gx) ($Yڴо< g6;|L`Wʎk?7_/g侅Β U3@~vvƷZu}~s\ν׽.>D<]T{$o"e'7!gL2Cxי{ gŢ=&6i*<$Kgy֡k;:+uj,/3zp-ڃ+yty5ʾ?Й&쬯Q !uj]z5{\#8D\|asv>ɫE~9ċl :t‡xZ3uio%S<gsF~{-ձ 9+{d|*O`_7O/s曉8ح_;Ż3:Yc̳;ȣ݊_M Hd*M],α9s>hOm8tffӵSi}El ;C`{nVnYl{8|觩s+xwζ5ξx̅[nn}fLŞe":oא'#N!  "~ܹIr"?E 垃p=ozkOmwڂشo~,.zoQ nA 3}y5(s_?TGxysz+m?]Q_ 6<\ Uc;!)^O}5g_flUGe5i{[ MsC̟L[|Ox a }A3aOR7 7ꊜUܧ,OQ[N -~+lWC3/Ϫz*9O^%;ϬJ#Gb; *ߢ>7~.rRC_rH}o#$n]z̳=oe['Oz M'+e.[B[_e%G}JS3e~ |`+܆~X# ->D;?]/U?k^{dm܋,ER-[}=q+Pt ; U7beO[Y}cj:s|FSn} eֶ<ߢy`g_ dysY)t[US,էĵ+ ܒQG?F~!iF!.xg:䡲/~r[|TxN!~k~켹/~j"6 ?E>o94:g#]cCU:|??~CN}ygMk<ݜbNj&co?dSUrؗ+ϲf^Ywyɞ"ԟ?46vwMyE{jn[hF@{#mk-=;V*豥R6= ȳJxP|Jas=< ק%9WA?"_k^{z/zPJ> O}|~oз2':":Reԛ\qpxd;;kz>^w:DrN)Lh8[ؘe7UȵY/s?_6/Yk9~*Ks{/cy,5{5 ͑'~"qdā>T7>Ǽ79C5>xG'z2c>U ?n. &/@2/Nd>c>q8{O-rc̛i SeO65Kyp7)G;Gמ]RA9⿦Լ nKZķT=U9-]/Sު(93U.w7շ\]x襽(U9 c2Se'Ws"pxZDnj@ޝ7|Uj+}V}%G ѳ|gcA~e눻 pW/R}숯d~{~{@GןxCO.2VQh0^yYɋ_.^`S >v^`1~ޛ;wPJIwY OߒuÁo}r~o潲Wߒ[ǝ[L?%{(\gOmM]4|C\^/w ?l?0k7{Ws7Ws>b9s? Qj2 .nOM@|׃Oj^luߌay2gA|9+{!T|\i~?OuG劋oZ .oyV?W'UHv4zcv֌Q|^jIuzncڢʗk>ι#Rs yg zl4Kr J57uD/`o7Myۀxk{ o~3^%_8{?>:z_/ܣe}3G(Ё}3ܛu<+Ы2W=sUv4C@r{sjx|է}&zYBsܹ?N|x;׃>go>,8f!_wI2VSekH~Uu;?I|uӾ8**ë_zq&|ʚH&z'ŸJz"DP@ ɹ䙎CUwWUbDEĄ ET@ f>E &L1@{{]Y7Rxs4V]K'kg~~{ܤz9tqރ'gk[_Ie8+ Iܛ)\{1$9=B:"759ѣ{|KkƯRol|xzߕ>M; zDл|ؾgc^>=zNzqjཤ_>/ܻJP>yş=Bk5|nfI*ߜh8\\sH[Ʃs\(^7v)x"u~ً9b'C[{2 U ;~_zʳ|2OgUgi\/>VKzuǨ~0'Y^z ׸E3Y7s8V3t o|^@5r3!S^w;C~xøs`>l 9r{x:)oپ̑:k/o b4%~Yi#fbR-?߳SK8]:}{7"5c2͡w/+FM`ćNuZkg _o]x9܏9xp/v?WSpkة^ęwWo<y*/= XOUvĮ5Zz3qdf(E_^l?^wC5 g]*kVU<_uލ>S;]Is>ͅWǎb||RFUo1+ OqYkZ< E%W |n6O~3gtݣso8e?:U /` /^n.$\!^Ϙ̟|`?@5#$s|0>Ec\}7F04z3B3Kbhί?e݋? } NnL~/1p+ϭxLuL>!{o3EzEuzNեqU?ؕ:GLBڷ"> xOwVq<cJvp{ XE.q7SDA<X؇Ήs{$i ߍ ?TȟWվ}$!}Bo>l$nm[>=8/Y2TX/+L+tT/yBQRΈwˈ~Ojn1ijѪyY'2K578ߛsӢy϶y|Od)P<<:SV{ㄉ}:ow㊫Wy隋yԟ{)Typ7Khgrcׂo?<>~u(/9r ~##2ST$rhlx(V~j&Fvs[I>?k:F==r>ӻdf39dɳeRh ߟCN\ $<@z+sKP) GₜW|7%Nqe$knwb u>Wp =w/h\}CUܻ R61y5܋гORɫ+W-ϋoE}~v]9^^?S?05QP%o>A}xa~1Tݭ8ߞ׍ð}ɬQ?_t 3~xО`SxNջ#7&ֳ@OO[:I}kɳob{)O~!NoWEӜqA j~pWg {`U,6m9$,⟚|7C@ >W /w[q ŽLG-Gӣ7Gyٓ:ֹE9^g8B*_g'ZWCy߰x:Z$E|Oֳco֜]~ߍA«xՖGlz 35K}i> ?]-~ACKe}2GgV'CcXNpO/TF:oɵ~^sL-Q)R o<{$1^f̱QkKD>N=`ΐ֜v8BŽXp%Ϧ~<%r҃ZyȒ0sK _½ _WsG:7Y,{t!*|?F{bwP|Q⅞Ĺ˿{o%^6C%{pO+_Zqڋ2Uܳk,Z%ž'~é/h]~/>Z/%W?KsIKoSs06=ܜ\[VV}5хHd7& /|^x[}Upse{ѢM<[}/l&ZUU?*KpOg_Ge37~ ܐVWBWHϺT~|هH^+7?\tj{|A?.KX(s?(->)s"On#~jS#x37VNw o]*H#=f'i Nv`6s;pf3bեJ9՚Ɇo>Dq."gyJw`7wPkϳ^sOn~ <)fn%>]yV_I⦛ģ.嬇7zu3<ǒ7 &E<_5{4vvYκ:J'Ry {l<~/~+J=6pfGr{G+ xĹL緱g]v?ۮp_kIΞ?@s)Q](z;h߹IMe]it빟{l\ N֐ ˕¶q+HywU=Ϗxo?&ԋ7=S^K/J_yx+Lc]Ar$~zc}fSwiḊsmsOP~6mu5GFٗyui?s\%F[yi|4=u=}*|,g?97Io9aֿQq99<ÞQһt(Q*bQؓG[3E"ۘ37:>^%?į!n /O_渎Թ,ݟt-v3o)~q'Ov~*Rrvf4Ba3=BȷW>fїc_D}0ͺLz@C8S٭_Ψ_#L=6iE8 {&^5έw ';o>wOr| /dWrǷuK,\HԜC-:Y| >/Sϝltf/Wh/| Xz"}ü3'%}q Q=W}+8{Ka8ͳě"]_s x&y;s,Ǝz㟰ę;y_ãy¥wga'P8vw΁ObJW֬&KS=Ƙ{WdݒmG1:5/[_'/{7]CuWTTƣ9Bc'94˸iOF gǑi"R=(>?fY/Ofrqo?ǃ9'U{2W+NkƞT~% Yo&a: 8G{ U=4ʐ/n~{>/ז:gSfPBWhW;BxpMZ#"~[#;WzqWɈG2v'ԭ@+v%)7MeB䗦ŸO^o_:uc]݀ t[^ŞΧhpU)6`gzCyOr #~Om2]dgx1mf} wqcKK|~>,^;'?y7Aeݍ3iW:l\_M>P?y0yZd1rv Ѫ=}y^.Ί%p8&?bOSyb3xa&I*oYtn n.]Jtbbgo'}5Xz9dֲ/m.7tVgki}k/<2=_|Q>NZNTzoɾWy%ꧬ_}oM'u7u%#uȞf.tds_}A˻TKw0캷IGws'*zG }&YOωU_~\|]ЩџU3\+h=:ߵ޺H^7{OzR8םI_'/CKҿu.ɯ2܆m<Q58?_CǼdPnfdͧ>U{x>OvpDs}N->(gO119k$Gi>$/40FUu0W?独þC ?Xjߵ]V3L:d_KF7ݏ׸vבT[u?=?ʹtŸAͧ`Z79-wϛW6+ˣ$(}_k~KgBuKhì_|3sGsI۟3,}t{ DTϝ=rYιq-/hͯgO!o[Mߋqx׀;_g>RrK_H?{]<8?vS~x 8I|>Q9zyDzw8׽uLu"x?7_c~A95sP'=y>N/q>{Ί7V%- :B_(^!O#?9ң9̝~ZQӊ?n{vsOg)=:x%Ĺ`~n&g}Cx1xOQW4錛:wF` .}3z\*OZ y6w3yr.CoҫG0zgi)?i?~剪 uwL͠[.w۷Nw&} v3CYӚ8Jy q7y^ZjӿY6|^yONJIT߱1L RnېU-V=wNo:q^m1TɲQLtv; s7:yWw:T7*>8 Gجy][5o)d]mfQؤ~5=gOԪo&s=A<82$މ/C43?s`8v8x}#q_~W+늘wWfsx%xN\EC+vy ܌L]~@ -W=GQ<ܩؗ7d7GK7+U0}a2{Ng?i6OyF;Yӈ+ڰQTkZKb}GW.GA6XSݮ =X}@IM '/wL%ogHG0"~5[|ҏOb˔ON%T!ߑdO~UTD\c%n0qu I_Dzw){şи֪kȏ4տU>_]H~yTcgMkT)]NJ7jѡ#5/Cb5>4xͽޡt}sLרozJo%ϜBqѰ@RGO)7M}#2 Q|+jʄ3|-Qw+_h&7K_s)yN" n[H㞥_ۏDݍ]C:&{doB\OWD5-i3؏PX:P+xϋշ]:M?L/t5.9>-=s~yʰ)_\_>UNKݚ# \r-oP߈y)wԗ%})R?*E??o~s*!ٴy+B(? b=YXbW8o~ݮW>f5߱*a'9x_[:???۹99_MsP4c&]ҧݛxGzgJ#w~/kR>TxL_<)(fMu3O2KdΎϵw<-=)\K߆y󒾏u _ܿGv$qAϣ.H*`ʯxH<܎]m7/~No\T9u7ԇ:XNkO\:[uկ r[R1+|ۢ >rxkPVgŸf>EMb?ROakVEmpϒܡ'y_xKGk$ߟ?gڦ3V&ܯ5R~n4Otɭ_;hUaS܇*ŧE֑J\տxmǞY #=OOPXs`Kϱkx2 >D7Dſ\^ٚOH/#rovzGQ=__T49QlxxM~ׯ{~kWOXF = !|@MM쏟_,)H!`#YG?SHȭ{9#Q-(&_v|~fS`O/{?xZsA0GpGǟꛐC/|&'p,xspm0:z'eW\py"?K~=#4)<_u0{~;3 ?>x:{<O+[׋~Oմa?,H)78wSfI?PuOǘ竝+%#"ҍ^TI"΃WxBk N ,{W•vѪõ+qp*iuo6+y=Q#=O%U>\IZ7p/kGgc׳gL7aӼ: ͳga3^y^ͽ_$^N#ԗ-q}M܇d[yBvv: %un7iHsN! #]+kX7j.Mt8n6WD?ae鸔$%@3+S1@sW{9 $=ߘzƞwdߌqUcJfq}m'NǢQ ~)úvK7\H4>V/#sN0bڶSj։w#d 6ne}3/2ݧh>e8Y ޅ3Cpxl ~h<߫;v/]Y >L.$OPzzWPg4Ϲ^Q_O>:FQ+K v$V|VGs|Y!C韯~{]J\P<^|ңnHVy{;Is빇ٿcSG=._6_p0ݶ؇̓_)>G*:.oT?DGPW> ĞkOxoQ3U O.~?VG{@9㲏sͳYk5G]<6xD1;O|34/i^hɣC^d.{;}tf/2or}+^=Xb4;61XGyu2?c>2b\kxBg<sh︦ />5p1˝tZtIV4?fģUޮN\K濨+]'~¬A/\wU#u ˞/2չ-3Z'2QqO yg4Oz(9CMaŭSKj9+]Iʷ?$3O)PNoO7}+5]ȽʹJ(bJ`CU(o rW]M@ZFT5(φ-<@a\^G~խ|vHWr!fk!~EIa@9p>,eS!L9 0Euxs9=x 쿥9Fe{nD+~xvGl7Z#$VSv-^&QgOϳW/&S@zƇ2fo~pbȿGsksX)ŚWKH'-Ͻt߮yg*:Yū'wS5o^=i9pxZgpxi\yjoxNW"/8jͻX-M)|-V(}[徙/O|.M}x?߬yZsLGy'~x|bɊ5.$m9|lOE}Rtf=_aGj>^ҫ\ W`D\@7MO?5^ߏ,.UI}x84݇߃}0;kU~m|Dk]f5gQ(}_gz'EuW4SL@ӉZ%d7JiP3Y& ر\fW~֟D6sľaM l /U|_$OpsGYyx7Q1G⧃'ğW`ŋSaPy,+=<7CHW3qgVu0H|S2?sk5xXx"G2RX-rn}+/'v1kģ~)ƎoDz.aBH1N7.J>e[,|٫ P=38$!]3Ϲo9?ft鞦<9xWo'&_^&d! "ƍԿx ]4 hR(r"x7Ղ=ު9m9/]GK5r?3q&JhqW)S:cxHuGI%)n`Q_jP=ROҗt6bG.~^xG1)y|9P_/_7K؟{\Gn)%!}vJW{n)q"={Y~I;o4T׋' ^6nE9MmF}Bo/K jJ_|y_OM|kh<~C7>,7uL,ȐtcS\Hfg*xl[}iNrv8%!ȯgįu+]%/*H|?Vp\圖X,]m7s5;_hv0#=Y!Ki_=xL=:PNk_J_`pڊh:Vn'p߽+>v鼷=ϊ"ČjM_i\({!]毉Ӭo[E7W[}aSׂɖKuyS{QIujSf}ؤT}[9C\z>ǯL!Kuws1 ŋ]T7 W׹Yy2}YqwWzp5>~ǖx B? 2g|?6qԩ[3ڱGYs:N`ΩHLyw]w k!F*N$WA&YSIS{V5ǻN&ľ$_g~E=+p4}sM~%ҁt[Ǚۄo+qB>T/ +.J^=J yt͝'`/9ֱVKFY /=N: q3O>Kb.(S~mZlIOVG k }:}; w;&[?4{~HJǦ{5vJBaGқշ)EݐVp ~u$?|&ϟ{Cq?uބKφ .]BW2r5gzΦ`斝'ku5uxF2dN78oQʾ]l%^u9G%0?ȍW+?Dp]}q?xaOiq_kf׽* K7{˖}No༘xIT 3&P1c+bH"s[ioE5-^9687གUVJ&..{}msPޝĻIϹb8'\ԽK| ^t?':-~6u4^3 Uܮx)v>Q]ʰi7Hأ9ޘ:>'*]icxu%rOי+o\x3Kaosow:cFex{<~ź!P޳Fc97orny&Hߧ[oa鼔t5R?mͥUW{茱;G o&~x53h]y+'R'ݢ:zQ }GSį|)=rK2Sz,{gпL=t4 tqbQN>i>8W:ӧ' /Sl-LClὬgVpUN!3o8b"z16ێf4擾Df/3}h^+ӗU<ЖNt {ymR!H^R \b{h x`Ik_{q5r9y ƒwv%..a8g.k<&+&@[=Ⱥ6ǝҁouƘފ}l08,5"E*Xg?;^0HW!$:T_O٣/lW˗#^ܯ+,Z_6*_7sz)Si`C% a?՜ ͗>|F_ޅ=(; ePt']{3.K)cۮgʤKzYVٙڗ+ݤsYarstim@xf⋧Ob9޾@ow9DcVj'ڭzWd]KZ:G)]sLUNC}AOs!txZGQ(P}cxV0:G wԱuɭ$>:{.-ԧWx<=)uouo>eE;K?yI=ěPƺ'/G`muO9Mh$xj#!\򜥜Ϳ}͍ۛo[.ᾺO>ͪF2:ߴ>ԭ\~פ}%%L<[YYI9\ION19Ϫe 䇀g7s=м!_MyHsdk4/ཝO M^+}gɻd;/WU=?w>qF$M?_v ՗£X~JO%Ih0ވ?wIw*tDC8?g MSsz9z>k NO=ip_`Gr 6ᗌLo:9z {]<:C _6qy rO]:խDz>/؏?K+^qh-$>_:ʽ-^I+voWBx#~COycx&9o ?>#R;җ76'maKg_l_Eػ?3~bGC5fQ$&v6}3 7@s}sOh½|}UsĿh^/y:[[<-^_,Xs ;{Wd쳨$\+[lW_؛+ݗK3g>U;B΋_j'ҏg=G>G>8;{ϹK';Kc{FqցC9B?-tyʟ މ0'o\7/#{^O|ڤRˤ/v'8JΣ™=ozY8C{j~sq{ Q{y=zI.z/4d~co_ov+)/XJCs u{2'gB?`gK?U.z[9zB/uG|b%b;^S}xkLjqIc+|NvGiϝ8[(;G݇OGi^vstb}X׌xSSCUT}QL;$/uK.kq6CV4:1-@vFpWSזjT`+;P=>Ho|G Gih,Du{J_">VzϲC6Y =,ރZ'T?pFKOnb@>܃Oe4տ߅{:z?Ky5u)qͽgnß(3%)G79O77_#>Ĩq>ͽ4_S}_W?߿=C;4ǡд&L;|CsQ⡺L|ꈇ/ZnJc)au+oyW!+d}hT\_~?u2[hb5ͭK5Mc3)oO?|Sz7b+5pNq<ϗG=#* H :Ey"{uXꂛ'xoWTo:eҩ03[ߕ3Vx prP}.ƵBb.ңH"m?}D_y0"~dgNi;;(]JU=O/`CεƯߌ};|qvmÞY?inx2!ޕmUG[ ?^zKWmz 5X  {՟Sm.?׫yܒ}D!gg];ܓvh;SG^îClԜXa9C:p1 ^e/y^ lE8WÏ 7'c4I. 3Gyz>b'˛ WJWZ𥵅8y ڰ~mwrv;khԏė|(? ZsOjW?HNo?SUo-qwMwh/ғwH? +ϫ~p{tY)]WYi|#24s ='_or^9cBa)lb?ou6#1Tܖis p5 ͙ekm6rަ_)|nW[4 N7G:mV=3 Y-=dXœ]5'cthösi?zk5({]|DU0 Jr4}4}OO[z[WkGf܅x4z4Uni9P}@5tUZ`*7KcT_Oz3m}W٧?b#$AͭV7VTK97;o]s_ ArK;]]-"k)Q^&GP CzVSK;[GJ/Tʟw`NC<.Q=,wsqz8YC,]Ϝwvzknɽp1349mNk?s/>9I; `ù A<=1C$n{@uGsxQ{m&.z]?{Zzv>ݿ-W>˖Q鸋u/{TsoM_b/Z^l; Kq^Tm[p͓=3{O}=Wln~ ӼNǞ[G{Һt`Sw~_޷IX_}D+>sF˿ ~ ;By$Sj`F~{JR"Q6mmQI^͌缇 ?s~ιsι{}\l54H$IIU&(?cH$]uB1iѡF6C̵zCyBRw$ԣbGWvCط+xqS?{2e׆?l(ʬCVY?aL BVE)Ūo#o]) ̨镚Y ¦NzH욶__ u6@ǓDHo@bVpN!7\Xo{$jd/hM-+_Y3I+A.P/A\U]n_-: ތ=LHt (oC&?$ ?tZ&KAH]a^c-勇 );r\<"~Ac vMXCl٘1:DkLZwd {HG/OXE끓7ZZNs.F˶֙FO!u:tnVt zM w%|}dzH_XxA523/ V┏&pҬILjy5 FTq֝W-D8K]s,= l-n^ET~ߦlXdJNgA8ud?p4%>ShzhnW;F0Imp3Mʏ)j.xwI;%Ot[P^|Gc2.Otvfd e?IU9J{SxsKuY6=AU^Su_ҳ~XTLK=hPWu/;;؂en(W/Q]d*Wq#^3D x{ԛIRz`5Ty&[ow>,'HH'=Mg qqh9b?- Wd@~o/'w 7ߦ~}sx.44OqJ33iQe?ׁU)r;4nY'j3ۭk]u;JКSf\HP=]h2T5 k "&Q,m"WFZBUϱ?A}W iV Ϟ\(,$RhQZtZCm2c>/9+;geFvu4Je^!* *{2[ٻX=h> =WzhG8_ku~Y#ύ&AĔ1{#1>v9rBsU:킪Up1m _Dar |Tނȗrc ^+i}ni`opL_e낓mq|bp^]S3JmJ)ֲ`}潂ըKDvASNi#kuxy tY:r/.Nfx ?}+4qsI\>$^Vʕ`||YW&Edg|lLylp͔B vWvwLIݹrrQ+,Wi)OR,T5(禎Y7y;v+xƙq9.#UQğ)#۵e|x|^S^2G`{ҽSYmr`t_uVPC}пr8E5:NPSջ Ʌ-R{T'F CI&؎A Pvc ,˝xLԖ?jD i%oWūIc=f=`z82Qs+mJ8c,gU>v!DNxCAfoec- z =| 8s ؂wW BmQ{bƆ=ptgl!Ф-TvB\B /9'1o/Sޘ|\*ffVZ`[7:Q{]}͢"!(q5^D_itm`qG 6'EwCMf 7ϢC\dѱLC?Ƒ] .{ֲp7HF3v.9OZtUo+^Yӱ|C3@9}h%VN_w l6CiWw}r[xj[oX὜[w|&oukA{aSw=h}a[SLZ g!T7W%Tp̾Zn NO|0ܻVoU+w޵cϡZ6Eigjks"djb]> 𳍒NXymM*#g@bH]u4*C !Ǥi>OUu]ѝJ!k{V2čZV=/u1B` ;O5kؖGV 39N}@'w6陎Rdbd^poHo'Hum=W 5Bdg5Qg2+i vG"ށ5 m2]Bn~*Gr-ڤwϋBB:4ڛ;"(ѱ%D_EpѢMWS#DۃAeGQy0"C A|QũILr9j#:١d:-aA0e!jZTI"Q})1Tp#umHF'H;t$R}2-2N5]dDQnZ8Ia2ijBBcLci#XWZf `љ.q8Ȉ9fR#3IAQL Zj seriation/data/Wood.rda0000644000176200001440000001553112606356654014602 0ustar liggesusers]y?1w}9}u{ȓH$ IL!QE*E|!$;Պ$t,}2&yf;0^<<}< `)0% 5J ǤgRW-M|9|.c#W/{Ups\ "kJ0%m/H;9&[gߤ/yv ܘ)C?]s{1H{P`krz6 ZRwvUV a4mQλ[#@Tۅ#NVlaJq8U*(1}эm ?7] +&TGu9?"и2w!1Jh"MQҹ`hQY3 =]zf,aM}VӶ:,d7Xʻ3ˀ~^=O K>)kWXZ{bMF<9UIiʗ>{Y4,;ޕhec sQ?/fЗdS6:c-N{ĉ Um?GY8$lAy/GOtAB^EOX˓vCzFHX{LQjUyfo<Džحπ+4 o9ԝzw?;%KoF܅1orvʺFxV/0pwc? w?Nƽ346<:Agj] xwI3@U4Yf˘*O;,I6Ma{- \gT!G>价eA-_ TN޴FnhK:ms.gE P,H] }J{@{ޕ0잳܄ƙNJ0h{4`9LC8xkovmTs10 [ f}]XST^ ;_t:n{,IX&AsPLZ_t|-7҄{=P˽eObS41Y#ߥҞO\z_٤{BLL?CE[ڪA띓{s`A}=U廵EIΠk+ŞEKʯwX'dEHH,m<%N !"yi~PrR}3)U܀%G]m|ǹQc:@1&*_Htcv~makH0 hHKMڼ7xR{509,"i TafLJ y-= 83z6^GUfd \p`7ԛ"A1c/K:7T`P]Uєj1{V6C:MQz8i} v*x݃]ɧSx~c74꘻;NfcmiGuH)GSa ԻH@ml,qCP/vz 1saX;tW>&l RZiQk4WꞺn݋e'}l~h2XzQ}ڣa@˻s$ETtIh%UrZWeOI5|L霥&["fmL,+Y'xvQŒя7`򻋛==0UiTT|n藗7^tk\TI#et1'mHXFm Jyo2 /nc@r;g}cc,C}Ӯ2yUu`^?dŇrbjC_jܾPjLJ/m։QаCTSxsЉJI U:`XfZ,ssU}(p;{5gb2+'`SZwϯ`M^SŹ+`]A>֏MiB}06!*NVئOO^io?(bG‰ؾoUtLֱ$sWלL2K|w@U-s[QK!aP- ؍͋A{} N o tOrkjCKEkbuzp1Y?|TǾ d8k^;0Iƚ(j^E5VZMdhz>tnk55ǽ Z}kƃ0h3Mnx5[WS d1wn;g4 '7wDe_0u_о:gn,e||Z3;%՞F/K\yl6ZNTgwT^z]3o]$n ف \a_:AeGMS1)"hEE/sLT\'}@F~zlF| Rtӆaf& B=^ACkJc) g^ \ZLJ@x2n/k {}gOT}o֘=_rYjs$vd9TWUrU0i/uמZ K]d#U)˯f"ʠ+xעSG|y]SVWY N9znO}"JDCBW#f:u3b+]-IܨP.`/C{rV&֊q֓;|#&+.OH\_Xw!'ў>fb[3xO- h36t߃W KF#C+#рx/jtu8Yԭ@]񀛫s"D 4-CU*Ps\cD?u?辜F! ^ᚑ ~->j5sj9}= kYKʅeCMt(! tr>$ /;dd95Ir(~9/^A)@?=zo7{C6Px/D9{˓6^0자U )wo.WE-^+t@kG@۫6XF~2-~!-cKe!Mg : I嵐oG{YP^|k3(~cUcQ3jvY+}a雧3j٢6]k|Dr^sFVl9 f>@@*;,f=f?wH| f7 !TVh|3]Dn|S_/m_J'3QF&hj9x$u"T=+dINY/sތ'}Amua囡ehLqNhD âs3sꑣtu>ztW9n6b-fg&n=/lBw"ՠ4Rf%XڵXEM% ğ.uDZI,_5 )_g"wf#2M(+).nxbzO 1ݎ?wԨ ^.\yF;b0IlkkvF}f)ʿC\B}`ݳ4Zv&X#~40mE,{> oӫ3mj05̢A`5g):3OME}=>= c<.O8h;]>;)YV#Aߞl46(>'>!EPSo6FoF1d" wi`ٿ֏64#aЎZ$peUI,5rl(_!U'M۪6Vr`j;+fīw[zr2ZthS=.,@gf#{Y3VxzEEqV_˘ aC|m~^yoȚ}ҧg) AbfkЋNۚ06}bwK 9 OIAݛv,腖E&)awO_20K? 5H 㲓7n,ԘѱT]Ln=ĉJcA2=ވ{* oDA}QbXZ7.5C=;iQyNXzKfģ?bVԆ8r D:Z@{jsF,5ٸfk,OƧ*P4fD[2=Ie$xr.#@v>(i1373 e(H`اɖS EOvM{g ٽUf@Kcͻ6dK@z+LUu_y-*|nFǿDu>"2OqWlC#sDŽahXͩߐ&Wn̄ǴCb0N`.+>طMdzG"K?sbR!X;ۜPz\_UwzPI >hBzAgL^IS8~PY ӛ8Χ!Yup/R!s9"469P/E{w˳ˣQe2mLd_)#󼹦| o5o*ԁLÆKyu'#;?~Q[l@Kɘ  sPE ]UP%m``#Tԕ.8S~P= 9%Ds'}L>C7+`*<$IMuP;wFX*PȌZXGjo!e/Ti-}+`k^NØ7Se|W䍢E엗.q4(<"L=?B_ O*~ٙCgYWHt'7w 5k6StB>2ٲRjj/'51!1χ >Y›j+5wKŖ{1Ӷ9ûVJs~L[]l-1o=3-V[goo\J;[|-;)~rgZȞo+6Kl9'!YJSJkbvm &e6|)}؝ZÚ&?Yf ۖ^NZl)ŎIwZZ[j&ۊՏs)W)>R|;{yk۾Rj?{-+Ͻ+K&w{3WwfnC~ܳ럕Ǐk)lˍ͏3 =8Ӝ=nfY|FL/t/;'fڢ6jYߵN/[%ݘNlǺ_q6f=sw3wߝf <`痾Sorv '|.o0ts1}n(W@}Zx9}"رa>+&CLu:Vhj4z\!e@"k+aDg/_>#seriation/data/Munsingen.rda0000644000176200001440000000117012606356654015627 0ustar liggesusersOk0a oO0Oem&Ã^d_,C钴@ |7i@_r !jQ+Q\8G%|Γi]"4?WwB[/A)?)%{m*狊G7J>M)zʉCEi}.XZpcN^RHJy虓W3ߐ(Eʵ'EQ}k[r]c*9@e}ܜk*8<]2W.M=WjJ%E^/~sb%mq$CԵ۵ݷrReZm:U[Crݗ{ھ%GnQrshjMu9\k18&N} n^9AI\kGrtziG?rjA.8kS(u嗒o.rS禸Z/*4]B y.} It results in raw number of triples satisfying the gradient constraints minus triples which violate the constraints. The second function is defined as: \deqn{f(z,y) = |y-z| sign(y-z) = y-z} It weights the each satisfaction or violation by the difference by its magnitude given by the absolute difference between the values. } \item{\code{"AR_events", "AR_deviations"}}{Anti-Robinson events (Chen 2002). An even simpler loss function can be created in the same way as the gradient measures above by concentrating on violations only. \deqn{ L(D) = \sum_{i=1}^n \sum_{i d_{ik}) } where \eqn{m=(2/3-n)w + nw^2 - 2/3 w^3}, the maximal number of possible anti-Robinson events in the window. The window size \eqn{w} represents the number of neighboring objects (number of entries from the diagonal of the distance matrix) are considered. The window size is \eqn{2 \le w < n}, where smaller values result in focusing on the local structure while larger values look at the global structure. Alternatively, \code{pct} can be used instead of \code{w} to specify the window as a percentage of \eqn{n}. \code{relative=FALSE} can be to get the GAR, i.e., the absolute number of AR events in the window. } \item{\code{"BAR"}}{Banded Anti-Robinson Form (Earle and Hurley 2015). Simplified measure for closeness to the anti-Robinson form in a band of size \eqn{b} with \eqn{1 <= b < n} around the diagonal. \deqn{ L(D) = \sum_{|i-j|<=b} (b+1-|i-j|) d_{ij} } For \eqn{b=1} the measure reduces to the Hamiltonian path length. For \eqn{b=n-1} the measure is equivalent to ARc defined (Earle and Hurley, 2015). Note that ARc is equivalent to the Linear Seriation criterion (scaled by 1/2). \eqn{b} defaults to a band of 20\% of \eqn{n}. } \item{\code{"Path_length"}}{Hamiltonian path length (Caraux and Pinloche 2005). The order of the objects in a dissimilarity matrix corresponds to a path through a graph where each node represents an object and is visited exactly once, i.e., a Hamilton path. The length of the path is defined as the sum of the edge weights, i.e., dissimilarities. \deqn{L(D) = \sum_{i=1}^{n-1} d_{i,i+1}} The length of the Hamiltonian path is equal to the value of the minimal span loss function (as used by Chen 2002). Both notions are related to the \emph{traveling salesperson problem (TSP).} If \code{order} is not unique or there are non-finite distance values \code{NA} is returned.} \item{\code{"Lazy_path_length"}}{Lazy path length (Earl and Hurley 2015). A weighted version of the Hamiltonian path criterion. This loss function postpones larger distances to later in the order (i.e., a lazy traveling sales person). \deqn{L(D) = \sum_{i=1}^{n-1} (n-i) d_{i,i+1}} Earl and Hurley (2015) proposed this criterion for reordering in visualizations to concentrate on closer objects first. } \item{\code{"Inertia"}}{Inertia criterion (Caraux and Pinloche 2005). Measures the moment of the inertia of dissimilarity values around the diagonal as \deqn{M(D) = \sum_{i=1}^n \sum_{j=1}^n d(i,j)|i-j|^2} \eqn{|i-j|} is used as a measure for the distance to the diagonal and \eqn{d(i,j)} gives the weight. This criterion gives higher weight to values farther away from the diagonal. It increases with quality.} \item{\code{"Least_squares"}}{Least squares criterion (Caraux and Pinloche 2005). The sum of squares of deviations between the dissimilarities and rank differences (in the matrix) between two elements: \deqn{L(D) = \sum_{i=1}^n \sum_{j=1}^n (d(i,j) - |i-j|)^2,} where \eqn{d(i,j)} is an element of the dissimilarity matrix \eqn{D} and \eqn{|i-j|} is the rank difference between the objects. Note that if Euclidean distance is used to calculate \eqn{D} from a data matrix \eqn{X}, the order of the elements in \eqn{X} by projecting them on the first principal component of \eqn{X} minimizes this criterion. The least squares criterion is related to \emph{unidimensional scaling.} } \item{\code{"LS"}}{Linear Seriation Criterion (Hubert and Schultz 1976). Weights the distances with the absolute rank differences. \deqn{L(D) \sum_{i,j=1}^n d(i,j) (-|i-j|)} } \item{\code{"2SUM"}}{2-Sum Criterion (Barnard, Pothen, and Simon 1993). The 2-Sum loss criterion multiplies the similarity between objects with the squared rank differences. \deqn{L(D) \sum_{i,j=1}^n 1/(1+d(i,j)) (i-j)^2,} where \eqn{s(i,j) = 1/(1+d(i,j))} represents the similarity between objects \eqn{i} and \eqn{j}. } \item{\code{"ME"}, \code{"Moore_stress"}, \code{"Neumann_stress"}, \code{"Cor_R"}}{These criteria are defined on general matrices (see below for definitions). The dissimilarity matrix is first converted into a similarity matrix using \eqn{S = 1/(1+D)}. If a different transformation is required, then perform the transformation first and supply a matrix instead of a dist object.} } For a general matrix \eqn{X = x_{ij}}, \eqn{i = 1 \ldots n} and \eqn{j = 1 \ldots m}, currently the following loss/merit functions are implemented: \describe{ \item{\code{"ME"}}{Measure of Effectiveness (McCormick 1972). The measure of effectiveness (ME) for matrix \eqn{X}, is defined as \deqn{M(X) = 1/2 \sum_{i=1}^{n} \sum_{j=1}^{m} x_{i,j}(x_{i,j-1}+x_{i,j+1}+x_{i-1,j}+x_{i+1,j})} with, by convention \deqn{x_{0,j}=x_{m+1,j}=x_{i,0}=x_{i,n+1}=0.} ME is a merit measure, i.e. a higher ME indicates a better arrangement. Maximizing ME is the objective of the bond energy algorithm (BEA). } \item{\code{"Cor_R"}}{Weighted correlation coefficient R developed as the Measure of Effectiveness for the Moment Ordering Algorithm (Deutsch and Martin 1971). R is a merit measure normalized so that its value always lies in \eqn{[-1,1]}. For the special case of a square matrix \eqn{R=1} corresponds to only the main diagonal being filled, \eqn{R=0} to a random distribution of value throughout the array, and \eqn{R=-1} to the opposite diagonal only being filled. } \item{\code{"Moore_stress"}, \code{"Neumann_stress"}}{ Stress (Niermann 2005). Stress measures the conciseness of the presentation of a matrix/table and can be seen as a purity function which compares the values in a matrix/table with its neighbors. The stress measure used here is computed as the sum of squared distances of each matrix entry from its adjacent entries. \deqn{ L(X) = \sum_{i=1}^n \sum_{j=1}^m \sigma_{ij} } The following types of neighborhoods are available: \describe{ \item{Moore:}{comprises the eight adjacent entries. \deqn{ \sigma_{ij} = \sum_{k=\max(1,i-1)}^{\min(n,i+1)} \sum_{l=\max(1,j-1)}^{\min(m,j+1)} (x_{ij} - x_{kl})^2 } } \item{Neumann:}{comprises the four adjacent entries. \deqn{ \sigma_{ij} = \sum_{k=\max(1,i-1)}^{\min(n,i+1)} (x_{ij} - x_{kj})^2 + \sum_{l=\max(1,j-1)}^{\min(m,j+1)} (x_{ij} - x_{il})^2 } } } The major difference between the Moore and the Neumann neighborhood is that for the later the contribution of row and column permutations to stress are independent and thus can be optimized independently. } } } \value{ A named vector of real values. } \references{ Barnard, S.T., A. Pothen, and H. D. Simon (1993): A Spectral Algorithm for Envelope Reduction of Sparse Matrices. \emph{In Proceedings of the 1993 ACM/IEEE Conference on Supercomputing,} 493--502. Supercomputing '93. New York, NY, USA: ACM. Caraux, G. and S. Pinloche (2005): Permutmatrix: A Graphical Environment to Arrange Gene Expression Profiles in Optimal Linear Order, \emph{Bioinformatics,} \bold{21}(7), 1280--1281. Chen, C.-H. (2002): Generalized association plots: Information visualization via iteratively generated correlation matrices, \emph{Statistica Sinica,} \bold{12}(1), 7--29. Deutsch, S.B. and J.J. Martin (1971): An ordering algorithm for analysis of data arrays. \emph{Operational Research,} \bold{19}(6), 1350--1362. Earle, D. and C.B. Hurley (2015): Advances in Dendrogram Seriation for Application to Visualization. \emph{Journal of Computational and Graphical Statistics,} \bold{24}(1), 1--25. Hahsler, M. (2017): An experimental comparison of seriation methods for one-mode two-way data. \emph{European Journal of Operational Research,} \bold{257}, 133--143. Hubert, L. and J. Schultz (1976): Quadratic Assignment as a General Data Analysis Strategy. \emph{British Journal of Mathematical and Statistical Psychology,} \bold{29}(2). Blackwell Publishing Ltd. 190--241. Hubert, L., P. Arabie, and J. Meulman (2001): \emph{Combinatorial Data Analysis: Optimization by Dynamic Programming.} Society for Industrial Mathematics. Niermann, S. (2005): Optimizing the Ordering of Tables With Evolutionary Computation, \emph{The American Statistician,} \bold{59}(1), 41--46. McCormick, W.T., P.J. Schweitzer and T.W. White (1972): Problem decomposition and data reorganization by a clustering technique, \emph{Operations Research,} \bold{20}(5), 993-1009. Robinson, W.S. (1951): A method for chronologically ordering archaeological deposits, \emph{American Antiquity,} \bold{16}, 293--301. Tien, Y-J., Yun-Shien Lee, Han-Ming Wu and Chun-Houh Chen (2008): Methods for simultaneously identifying coherent local clusters with smooth global patterns in gene expression profiles, \emph{BMC Bioinformatics,} \bold{9}(155), 1--16. } \seealso{ \code{\link{list_criterion_methods}} to query the criterion registry. } \author{Christian Buchta and Michael Hahsler} \examples{ ## create random data and calculate distances m <- matrix(runif(20),ncol=2) d <- dist(m) ## get an order for rows (optimal for the least squares criterion) o <- seriate(d, method = "MDS") o ## compare the values for all available criteria rbind( unordered = criterion(d), ordered = criterion(d, o) ) ## compare RGAR by window size (from local to global) w <- 2:(nrow(m)-1) RGAR <- sapply(w, FUN = function (w) criterion(d, o, method="RGAR", w = w)) plot(w, RGAR, type = "b", ylim = c(0,1), xlab = "Windows size (w)", main = "RGAR by window size") } \keyword{cluster} seriation/man/robinson.Rd0000644000176200001440000000567612651506201015156 0ustar liggesusers\name{Robinson} \alias{Robinson} \alias{is.robinson} \alias{random.robinson} \title{Create and Recognize Robinson and Pre-Robinson Matrices} \description{ Provides functions to create and recognize (anti) Robinson and pre-Robinson matrices. A (anti) Robinson matrix has strictly decreasing (increasing) values when moving away from the main diagonal. A pre-Robinson matrix is a matrix which can be transformed into a perfect Robinson matrix using simultaneous permutations of rows and columns. } \usage{ is.robinson(x, anti = TRUE, pre = FALSE) random.robinson(n, anti = TRUE, pre = FALSE, noise = 0) } \arguments{ \item{x}{a symmetric, positive matrix or a dissimilarity matrix (a \code{dist} object). } \item{anti}{logical; check for anti Robinson structure? Note that for distances, anti Robinson structure is appropriate. } \item{pre}{logical; recognize/create pre-Robinson matrices. } \item{n}{ number of objects. } \item{noise}{ noise intensity between 0 and 1. Zero means no noise. Noise more than zero results in non-Robinson matrices. } } \details{ Note that the default matrices are anti Robinson matrices. This is done because distance matrices (the default in R) are typically anti Robinson matrices with values increasing when moving away from the diagonal. Robinson matrices are recognized using the fact that they have zero anti Robinson events. For pre-Robinson matrices we use spectral seriation first since spectral seriation is guaranteed to perfectly reorder pre-Robinson matrices (see Laurent and Seminaroti, 2015). Random pre-Robinson matrices are generated by reversing the process of unidemensional scaling. We randomly (uniform distribution with range \eqn{[0,1]}) choose \eqn{x} coordinates for \code{n} points on a straight line and calculate the pairwise distances. For Robinson matrices, the points are sorted first according to \eqn{x}. For noise, \eqn{y} coordinates is added. The coordinates are chosen uniformly between 0 and \code{noise}, with \code{noise} between 0 and 1. } \value{ A single logical value. } %\seealso{ %} \references{ M. Laurent, M. Seminaroti (2015): The quadratic assignment problem is easy for Robinsonian matrices with Toeplitz structure, \emph{Operations Research Letters} 43(1), 103--109. } \examples{ ## create a perfect anti Robinson structure m <- random.robinson(10) pimage(m) is.robinson(m) ## permute the structure to make it not Robinsonian. However, ## it is still pre-Robinson. o <- sample(10) m2 <- permute(m, ser_permutation(o,o)) pimage(m2) is.robinson(m2) is.robinson(m2, pre = TRUE) ## create a binary random Robinson matrix (not anti Robinson) m3 <- random.robinson(10, anti = FALSE) > .7 pimage(m3) is.robinson(m3, anti = FALSE) ## create matrices with noise (as distance matrices) m4 <- as.dist(random.robinson(50, pre = FALSE, noise = .1)) pimage(m4) criterion(m4, method = "AR") m5 <- as.dist(random.robinson(50, pre = FALSE, noise = .5)) pimage(m5) criterion(m5, method = "AR") } %\keyword{manip} seriation/man/hmap.Rd0000644000176200001440000001062012606356654014252 0ustar liggesusers\name{hmap} \alias{hmap} \title{Plot Heat Map Reordered Using Seriation} \description{ Provides heat maps reordered using several different seriation methods. This includes dendrogram based reordering with optimal leaf order and matrix seriation based heat maps. } \usage{ hmap(x, distfun = dist, method = "OLO", control = NULL, zlim = NULL, ...) } \arguments{ \item{x}{a matrix or a dissimilarity matrix of class dist. If a dissimilarity matrix is used, then the \code{distfun} is ignored. } \item{distfun}{function used to compute the distance (dissimilarity) between both rows and columns (default: \code{dist}). } \item{method}{a character strings indicating the used seriation algorithm (see \code{seriate.dist}). If the method results in a dendrogram then \code{heatmap} in \pkg{stats} is used to show the dendrograms, otherwise reordered distance matrices are shown instead.} \item{control}{a list of control options passed on to the seriation algorithm specified in \code{method}.} \item{zlim}{range of values to display (defaults to the range of \code{x}).} \item{\dots}{further arguments.} } \details{ For dendrogram based heat maps the arguments are passed on to \code{heatmap.2} in \pkg{gplots}. See for example \code{margins} and \code{col}. The following arguments for \code{heatmap.2} cannot be used: \code{Rowv, Colv, hclustfun, reorderfun}. For seriation-based heat maps further arguments include: \describe{ \item{\code{gp}}{an object of class \code{gpar} containing graphical parameters (see \code{gpar} in package \pkg{grid}).} \item{\code{newpage}}{a logical indicating whether to start plot on a new page (see \code{gpar} in package \pkg{grid}).} \item{\code{prop}}{a logical indicating whether the height and width of \code{x} should be plotted proportional to its dimensions.} \item{\code{showdist}}{Display seriated dissimilarity matrices? Values are \code{"none"}, \code{"both"}, \code{"rows"} or \code{"columns"}. } \item{\code{key}}{logical; show a colorkey?.} \item{key.lab}{ string plotted next to the color key.} \item{\code{axes}}{ one of \code{"auto"} (default; show axis labels if there are less than 25 labels), \code{"x"}, \code{"y"}, \code{"both"} and \code{"none"}.} \item{\code{margins}}{ bottom and right-hand-side margins are calculated automatically or can be specifies as a vector of two numbers (in lines).} \item{\code{zlim}}{ range of values displayed.} \item{\code{col}, \code{col_dist}}{ color palettes used.} } For \code{dendrogram = TRUE}, \code{seriate.hclust} with the default method \code{"optimal"} is used for arranging the dendrograms and \code{x}. \code{heatmap} is used for plotting. For \code{dendrogram = FALSE}, \code{seriate.dist} with the default method \code{"tsp"} (a traveling salesperson solver) for arranging \code{x} is used. \pkg{grid} code implemented in this package is used to produce the plot. Note that unlike the default behavior of \code{heatmap}, scaling is not automatically applied. The data have to be scaled before using \code{hmap}. } \value{ An invisible list with elements: \item{rowInd, colInd}{index permutation vectors.} \item{reorder_method}{name of the method used to reorder the matrix.} The list may contain additional elements (dendrograms, colors, etc). } \seealso{ \code{\link{seriate}}, \code{\link{pimage}}, \code{\link{dissplot}}, \code{\link[gplots]{heatmap.2}} in \pkg{gplots}.} \author{Michael Hahsler} \examples{ data("Wood") ## default heatmap does Euclidean distance, hierarchical clustering with ## average-link and optimal leaf ordering hmap(Wood) ## heatmap with correlation-based distance, green-red color (greenred is ## predefined) and optimal leaf ordering and no row label dist_cor <- function(x) as.dist(1-cor(t(x))) hmap(Wood, method="OLO", distfun = dist_cor, col=greenred(100), labRow=FALSE) ## order-based heatmap hmap(Wood, method="MDS_angle", distfun = dist_cor, col=greenred(100)) ## order-based with dissimilarity matrices hmap(Wood, method="MDS_angle", distfun = dist_cor, showdist = "both", col=greenred(100)) } \keyword{hplot} seriation/man/dissplot.Rd0000644000176200001440000002212613055430433015155 0ustar liggesusers\name{dissplot} \alias{dissplot} \alias{plot.reordered_cluster_dissimilarity_matrix} \alias{print.reordered_cluster_dissimilarity_matrix} \title{Dissimilarity Plot} \description{ Visualizes a dissimilarity matrix using seriation and matrix shading using the method developed by Hahsler and Hornik (2011). Entries with lower dissimilarities (higher similarity) are plotted darker. Such a plot can be used to uncover hidden structure in the data. The plot can also be used to visualize cluster quality (see Ling 1973). Objects belonging to the same cluster are displayed in consecutive order. The placement of clusters and the within cluster order is obtained by a seriation algorithm which tries to place large similarities/small dissimilarities close to the diagonal. Compact clusters are visible as dark squares (low dissimilarity) on the diagonal of the plot. Additionally, a Silhouette plot (Rousseeuw 1987) is added. This visualization is similar to CLUSION (see Strehl and Ghosh 2002), however, allows for using arbitrary seriating algorithms. } \usage{ dissplot(x, labels = NULL, method = "Spectral", control = NULL, options = NULL, \ldots) } \arguments{ \item{x}{ an object of class \code{dist}.} \item{labels}{ \code{NULL} or an integer vector of the same length as rows/columns in \code{x} indicating the cluster membership for each object in \code{x} as consecutive integers starting with one. The labels are used to reorder the matrix.} \item{method}{ a list with up to three elements or a single character string. Use a single character string to apply the same algorithm to reorder the clusters (inter cluster seriation) as well as the objects within each cluster (intra cluster seriation). If separate algorithms for inter and intra cluster seriation are required, \code{method} can be a \code{list} of two named elements (\code{inter_cluster} and \code{intra_cluster} each containing the name of the respective seriation method. See \code{seriate.dist} for available algorithms. Set method to \code{NA} to plot the matrix as is (no or only coarse seriation). For intra cluster reordering the special method \code{"silhouette width"} is available. Objects in clusters are then ordered by silhouette width (from silhouette plots). If no \code{method} is given, the default method of \code{seriate.dist} is used. The third list element (named \code{aggregation}) controls how inter cluster dissimilarities are computed from from the given dissimilarity matrix. The choices are \code{"avg"} (average pairwise dissimilarities; average-link), \code{"min"} (minimal pairwise dissimilarities; single-link), \code{"max"} (maximal pairwise dissimilarities; complete-link), and \code{"Hausdorff"} (pairs up each point from one cluster with the most similar point from the other cluster and then uses the largest dissimilarity of paired up points). } \item{control}{ a list of control options passed on to the seriation algorithm. In case of two different seriation algorithms, \code{control} can contain a list of two named elements (\code{inter_cluster} and \code{intra_cluster}) containing each a list with the control options for the respective algorithm.} \item{options}{a list with options for plotting the matrix. The list can contain the following elements: \describe{ \item{\code{plot}}{a logical indicating if a plot should be produced. if \code{FALSE}, the returned object can be plotted later using the function \code{plot} which takes as the second argument a list of plotting options (see \code{options} below).} \item{\code{cluster_labels}}{ a logical indicating whether to display cluster labels in the plot.} \item{\code{averages}}{ a logical vector of length two. The first element controls the upper triangle and the second element the lower triangle of the plot. \code{FALSE} displays the original dissimilarity between objects, \code{TRUE} displays cluster-wise average dissimilarities, and \code{NA} leaves the triangle white (default: \code{c(FALSE, TRUE)}, i.e., the lower triangle displays averages)} \item{\code{lines}}{ a logical indicating whether to draw lines to separate clusters.} \item{\code{flip}}{ a logical indicating if the clusters are displayed on the diagonal from north-west to south-east (\code{FALSE}; default) or from north-east to south-west (\code{TRUE}).} \item{\code{silhouettes}}{ a logical indicating whether to include a silhouette plot (see Rousseeuw, 1987).} \item{\code{threshold}}{ a numeric. If used, only plot distances below the threshold are displayed. Consider also using \code{zlim} for this purpose.} \item{\code{col}}{ colors used for the image plot.} \item{\code{key}}{ a logical indicating whether to place a color key below the plot. } \item{\code{zlim}}{ range of values to display (defaults to range \code{x}).} \item{\code{axes}}{ \code{"auto"} (default; enabled for less than 25 objects), \code{"y"} or \code{"none"}.} \item{\code{main}}{ title for the plot.} \item{\code{newpage}}{ a logical indicating whether to start plot on a new page (see \code{grid.newpage} in package \pkg{grid}). } \item{\code{pop}}{a logical indicating whether to pop the created viewports (see package \pkg{grid})? } \item{\code{gp}, \code{gp_lines}, \code{gp_labels}}{ objects of class \code{gpar} containing graphical parameters (see \code{gpar} in package \pkg{grid}). } } } \item{\ldots}{further arguments are added to \code{options}.} } \value{ An invisible object of class \code{cluster_proximity_matrix} with the following elements: \item{order}{ \code{NULL} or integer vector giving the order used to plot \code{x}.} \item{cluster_order}{ \code{NULL} or integer vector giving the order of the clusters as plotted.} \item{method}{ vector of character strings indicating the seriation methods used for plotting \code{x}.} \item{k}{ \code{NULL} or integer scalar giving the number of clusters generated.} \item{description}{ a \code{data.frame} containing information (label, size, average intra-cluster dissimilarity and the average silhouette) for the clusters as displayed in the plot (from top/left to bottom/right).} This object can be used for plotting via \code{plot(x, options = NULL, ...)}, where \code{x} is the object and \code{options} contains a list with plotting options (see above). } \references{ Hahsler, M. and Hornik, K. (2011): Dissimilarity plots: A visual exploration tool for partitional clustering. \emph{Journal of Computational and Graphical Statistics,} \bold{10}(2):335--354. Ling, R.F. (1973): A computer generated aid for cluster analysis. \emph{Communications of the ACM,} \bold{16}(6), 355--361. Rousseeuw, P.J. (1987): Silhouettes: A graphical aid to the interpretation and validation of cluster analysis. \emph{Journal of Computational and Applied Mathematics,} \bold{20}(1), 53--65. Strehl, A. and Ghosh, J. (2003): Relationship-based clustering and visualization for high-dimensional data mining. \emph{INFORMS Journal on Computing,} \bold{15}(2), 208--230. } \seealso{ \code{\link[stats]{dist}}, \code{\link{seriate}}, \code{\link{pimage}} and \code{\link{hmap}}. } \author{Michael Hahsler} \examples{ data("iris") d <- dist(iris[-5]) ## plot original matrix res <- dissplot(d, method = NA) ## plot reordered matrix using the nearest insertion algorithm (from tsp) res <- dissplot(d, method = "TSP", options = list(main = "Seriation (TSP)")) ## cluster with pam (we know iris has 3 clusters) library("cluster") l <- pam(d, 3, cluster.only = TRUE) ## we use a grid layout to place several plots on a page library("grid") grid.newpage() pushViewport(viewport(layout=grid.layout(nrow = 2, ncol = 2), gp = gpar(fontsize = 8))) pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 1)) ## visualize the clustering (using Spectral between clusters and MDS within) res <- dissplot(d, l, method = list(inter = "Spectral", intra = "MDS"), options = list(main = "PAM + Seriation - standard", newpage = FALSE)) popViewport() pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 2)) ## more visualization options. Note that we reuse the reordered object res! ## color: use 10 shades red-blue plot(res, options = list(main = "PAM + Seriation", col= bluered(10, bias=.5), newpage = FALSE)) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 1)) ## threshold (using zlim) and cubic scale to highlight differences plot(res, options = list(main = "PAM + Seriation - threshold", zlim = c(0, 1.5), col = greys(100, power = 2), newpage = FALSE)) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 2)) ## use custom (logistic) scale plot(res, options = list(main = "PAM + Seriation - logistic scale", col= hcl(c = 0, l = (plogis(seq(10, 0, length=100), location = 2, scale = 1/2, log = FALSE))*100), newpage = FALSE)) popViewport(2) ## the reordered_cluster_dissimilarity_matrix object res names(res) } \keyword{hplot} \keyword{cluster} seriation/man/criterion_methods.Rd0000644000176200001440000000527712606356654017062 0ustar liggesusers\name{criterion_methods} \alias{registry_criterion} \alias{set_criterion_method} \alias{get_criterion_method} \alias{list_criterion_methods} \alias{show_criterion_methods} \title{Registry for Criterion Methods} \description{ A registry to manage methods to calculate a criterion value given data and a permutation. } \usage{ list_criterion_methods(kind) show_criterion_methods(kind) get_criterion_method(kind, name) set_criterion_method(kind, name, fun, description = NULL, merit = NA, ...) } \arguments{ \item{kind}{the data type the method works on. For example, \code{"dist"}, \code{"matrix"} or \code{"array"}.} \item{name}{a short name for the method used to refer to the method in the function \code{criterion()}.} \item{fun}{a function containing the method's code.} \item{description}{a description of the method. For example, a long name.} \item{merit}{a boolean indicating if the criterion measure is a merit (\code{TRUE}) or a loss (\code{FALSE}) measure.} \item{...}{further information that is stored for the method in the registry.} } \details{ All methods below are convenience methods for the registry named \code{registry_criterion}. \code{list_criterion_method()} lists all available methods for a given data type (\code{kind}). The result is a vector of character strings with the short names of the methods. \code{show_criterion_method()} shows all available methods for a given data type (\code{kind}) including a description. \code{get_criterion_method()} returns information (including the implementing function) about a given method in form of an object of class \code{"criterion_method"}. With \code{set_criterion_method()} new criterion methods can be added by the user. The implementing function (\code{fun}) needs to have the formal arguments \code{x, order, ...}, where \code{x} is the data object, order is an object of class \code{permutation_vector} and \code{...} can contain additional information for the method passed on from \code{criterion()}. The implementation has to return the criterion value as a scalar. } \author{Michael Hahsler} \examples{ ## the registry registry_criterion ## use the convenience functions list_criterion_methods("dist") show_criterion_methods("dist") get_criterion_method("dist", "AR_d") ## define a new method ## a function that return sum of the diagonal elements criterion_method_matrix_foo <- function(x, order, ...) { if(!is.null(order)) x <- permute(x,order) sum(diag(x)) } ## set new method set_criterion_method("matrix", "foo", criterion_method_matrix_foo, "foo: a useless demo criterion", FALSE) list_criterion_methods("matrix") ##use all criterion methods (including the new one) criterion(matrix(1:9, ncol=3)) } \keyword{misc} seriation/man/bertinplot.Rd0000644000176200001440000001226013414537475015511 0ustar liggesusers\name{bertinplot} \alias{bertinplot} \alias{bertin_cut_line} \alias{panel.bars} \alias{panel.circles} \alias{panel.squares} \alias{panel.lines} \alias{panel.blocks} \title{Plot a Bertin Matrix} \description{ Plot a data matrix of cases and variables. Each value is represented by a symbol. Large values are highlighted. The matrix can be rearranged to make structure in the data visible (see Falguerolles et al 1997). \code{bertin_cut_line()} can be used to add cut lines (see Details). } \usage{ bertinplot(x, order = NULL, highlight = TRUE, options = NULL) } \arguments{ \item{x}{ a data matrix. Note that following Bertin, columns are variables and rows are cases. This behavior can be reversed using \code{reverse = TRUE} in \code{options}.} \item{order}{an object of class \code{ser_permutation} to rearrange \code{x} before plotting. If \code{NULL}, no rearrangement is performed.} \item{highlight}{ a logical scalar indicating whether to use highlighting. If \code{TRUE}, all variables with values greater than the variable-wise mean are highlighted. To control highlighting, also a logical matrix or a matrix with colors with the same dimensions as \code{x} can be supplied.} \item{options}{a list with options for plotting. The list can contain the following elements: \describe{ \item{\code{panel.function}}{ a function to produce the symbols. Currently available functions are \code{panel.bars} (default), \code{panel.circles}, \code{panel.squares}, \code{panel.blocks} and \code{panel.lines}. For circles and squares neg. values are represented by a dashed border. For blocks all blocks are the same size (can be used with \code{shading=TRUE}).} \item{\code{reverse}}{ logical indicating whether to swap cases and variables in the plot. The default (\code{FALSE}) is to plot cases as columns and variables as rows.} \item{\code{xlab, ylab}}{ labels (default: use labels from \code{x}).} \item{\code{spacing}}{ relative space between symbols (default: 0.2).} \item{\code{shading}}{ use gray shades to encode value instead of highlighting (default: FALSE).} \item{\code{shading.function}}{ a function that accepts a single argument in range [.1, .8] and returns a valid corresponding color (e.g., using \code{rgb}). } \item{\code{frame}}{ plot a grid to separate symbols (default: \code{FALSE}).} \item{\code{mar}}{ margins (see \code{par}).} \item{\code{gp_labels}}{ gpar object for labels (see \code{gpar}).} \item{\code{gp_panels}}{ gpar object for panels (see \code{gpar}).} \item{\code{newpage}}{ a logical indicating whether to start the plot on a new page (see \code{grid.newpage}). } \item{\code{pop}}{a logical indicating whether to pop the created viewports (see \code{pop.viewport})? } } }} \details{ The plot is organized as a matrix of symbols. The symbols are drawn by a panel function, where all symbols of a row are drawn by one call of the function (using vectorization). The interface for the panel function is \code{panel.myfunction(value, spacing, hl)}. \code{value} is the vector of values for a row scaled between 0 and 1, \code{spacing} contains the relative space between symbols and \code{hl} is a logical vector indicating which symbol should be highlighted. Cut lines can be added to an existing bertin plot using \code{bertin_cut_line(x=NULL, y=NULL)}. \code{x}/\code{y} is can be a number indicating where to draw the cut line between two columns/rows. If both \code{x} and \code{y} is specified then one can select a row/column and the other can select a range to draw a line which does only span a part of the row/column. It is important to call \code{bertinplot()} with the option \code{pop=FALSE}. } %\value{ %} \references{ de Falguerolles, A., Friedrich, F., Sawitzki, G. (1997): A Tribute to J. Bertin's Graphical Data Analysis. In: Proceedings of the SoftStat '97 (Advances in Statistical Software 6), 11--20. } \seealso{ \code{\link{ser_permutation}}, \code{\link{seriate}}, Package \pkg{grid}. } \author{Michael Hahsler} \examples{ data("Irish") scale_by_rank <- function(x) apply(x, 2, rank) x <- scale_by_rank(Irish[,-6]) ## use the the sum of absolute rank differences order <- c( seriate(dist(x, "minkowski", p = 1)), seriate(dist(t(x), "minkowski", p = 1)) ) ## plot bertinplot(x, order) ## some alternative displays bertinplot(x, order, options = list(shading = TRUE, panel = panel.blocks)) bertinplot(x, order, options = list(panel = panel.lines)) bertinplot(x, order, options = list(panel = panel.squares)) bertinplot(x, order, options = list(panel = panel.circles, spacing = -0.5)) ## plot with cut lines (we manually set the order here) order <- ser_permutation(c(21, 16, 19, 18, 14, 12, 20, 15, 17, 26, 13, 41, 7, 11, 5, 23, 28, 34, 31, 1, 38, 40, 3, 39, 4, 27, 24, 8, 37, 36, 25, 30, 33, 35, 2, 22, 32, 29, 10, 6, 9), c(4, 2, 1, 6, 8, 7, 5, 3)) bertinplot(x, order, options=list(pop=FALSE)) bertin_cut_line(,4) ## horizontal line between rows 4 and 5 bertin_cut_line(,7) ## separate "Right to Life" from the rest bertin_cut_line(14,c(0,4)) ## separate a block of large values (vertically) } \keyword{hplot} \keyword{cluster} seriation/man/Chameleon.Rd0000644000176200001440000000252112606356654015221 0ustar liggesusers\name{Chameleon} \alias{Chameleon} \alias{chameleon} \alias{chameleon_ds4} \alias{chameleon_ds5} \alias{chameleon_ds7} \alias{chameleon_ds8} \docType{data} \title{2D Data Sets used for the CHAMELEON Clustering Algorithm} \description{ Several 2D data sets used to evaluate the CHAMELEON clustering alogrithm in the paper by Karypis et al (1999) and used by iVAT, an ordering-based tool to asses cluster tendency (Havens and Bezdek, 2012). } \usage{data(Chameleon)} \format{ \code{chameleon_ds4}: The format is a 8,000 x 2 data.frame. \code{chameleon_ds5}: The format is a 8,000 x 2 data.frame. \code{chameleon_ds7}: The format is a 10,000 x 2 data.frame. \code{chameleon_ds8}: The format is a 8,000 x 2 data.frame. } %\details{ %} \source{ The data was obtained from \url{http://glaros.dtc.umn.edu/gkhome/cluto/cluto/download} } \references{ Karypis, G., EH. Han, V. Kumar (1999): CHAMELEON: A Hierarchical Clustering Algorithm Using Dynamic Modeling, \emph{IEEE Computer,} \bold{32}(8): 68--75. Havens, T.C. and Bezdek, J.C. (2012): An Efficient Formulation of the Improved Visual Assessment of Cluster Tendency (iVAT) Algorithm, \emph{IEEE Transactions on Knowledge and Data Engineering,} \bold{24}(5), 813--822. } \examples{ data(Chameleon) plot(chameleon_ds4, cex=.1) } \keyword{datasets} seriation/man/permute.Rd0000644000176200001440000000460712606356654015016 0ustar liggesusers\name{permute} \alias{permute} \alias{permute.dist} \alias{permute.numeric} \alias{permute.list} \alias{permute.matrix} \alias{permute.array} \alias{permute.data.frame} \alias{permute.hclust} \alias{permute.dendrogram} \title{Permute the Order in Various Objects} \description{ Provides the generic function and methods for permuting the order of various objects including vectors, dendrograms (also \code{hclust} objects), the order of observations in a \code{dist} object, the rows and columns of a matrix, all dimensions of an array given a suitable \code{ser_permutation} object. } \usage{ permute(x, order, ...) } \arguments{ \item{x}{an object (a list, a vector, a \code{dist} object, a matrix, an array or any other object which provides \code{dim} and standard subsetting with \code{"["}).} \item{order}{an object of class \code{ser_permutation} which contains suitable permutation vectors for \code{x}.} \item{...}{ additional arguments for the permutation function.} } \details{ The permutation vectors in \code{ser_permutation} are suitable if the number of permutation vectors matches the number of dimensions of \code{x} and if the length of each permutation vector has the same length as the corresponding dimension of \code{x}. For 1-dimensional/1-mode data (list, vector, \code{dist}), \code{order} can also be a single permutation vector of class \code{ser_permutation_vector} or data which can be automatically coerced to this class (e.g. a numeric vector). For \code{dendrograms} and \code{hclust}, subtrees are rotated to represent the order best possible. If the order is not achived perfectly then the user is warned. This behavior can be changed with the extra parameter \code{incompatible} which can take the values \code{"warn"} (default), \code{"stop"} or \code{"ignore"}. } \seealso{ \code{\link{ser_permutation}}, \code{\link{dist}} in package \pkg{stats}. } \author{Michael Hahsler} \examples{ ## permute matrix m <- matrix(rnorm(10), 5, 2, dimnames = list(1:5, 1:2)) m ## permute rows and columns permute(m, ser_permutation(5:1, 2:1)) ## permute only columns permute(m, ser_permutation(NA, 2:1)) ## permute objects in a dist object d <- dist(m) d permute(d, ser_permutation(c(3,2,1,4,5))) ## permute a list l <- list(a=1:5, b=letters[1:3], c=0) l permute(l, c(2,3,1)) ## permute a dendrogram hc <- hclust(d) plot(hc) plot(permute(hc, 5:1)) } \keyword{manip} seriation/man/seriation_methods.Rd0000644000176200001440000000532313502520047017032 0ustar liggesusers\name{seriation_methods} \alias{registry_seriate} \alias{set_seriation_method} \alias{get_seriation_method} \alias{list_seriation_methods} \alias{show_seriation_methods} \title{Registry for Seriation Methods} \description{ A registry to manage methods for seriation. } \usage{ list_seriation_methods(kind) show_seriation_methods(kind) get_seriation_method(kind, name) set_seriation_method(kind, name, definition, description = NULL, control = list(), ...) } \arguments{ \item{kind}{the data type the method works on. For example, \code{"dist"}, \code{"matrix"} or \code{"array"}.} \item{name}{a short name for the method used to refer to the method in \code{seriate()}.} \item{definition}{a function containing the method's code.} \item{description}{a description of the method. For example, a long name.} \item{control}{a list with control arguments and default values.} \item{...}{further information that is stored for the method in the registry.} } \details{ The functions below are convenience function for the registry \code{registry_seriate}. \code{list_seriation_method()} lists all available methods for a given data type (\code{kind}). The result is a vector of character strings with the short names of the methods. \code{show_seriation_method()} shows all available methods including a description. \code{get_seriation_method()} returns information (including the implementing function) about a given method in form of an object of class \code{"seriation_method"}. With \code{set_seriation_method()} new seriation methods can be added by the user. The implementing function (\code{definition}) needs to have the formal arguments \code{x, control}, where \code{x} is the data object and \code{control} contains a list with additional information for the method passed on from \code{seriate()}. The implementation has to return a list of objects which can be coerced into \code{ser_permutation_vector} objects (e.g., integer vectors). The elements in the list have to be in corresponding order to the dimensions of \code{x}. } \author{Michael Hahsler} \examples{ ## registry registry_seriate ## convenience functions show_seriation_methods("matrix") list_seriation_methods("matrix") get_seriation_method("matrix", "BEA") ## define a new method ## create a identity function which returns the identity order seriation_method_identity <- function(x, control) { lapply(dim(x), seq) } ## set new method set_seriation_method("matrix", "identity", seriation_method_identity, "Identity order") set_seriation_method("array", "identity", seriation_method_identity, "Identity order") show_seriation_methods("matrix") ##use all criterion methods (including the new one) seriate(matrix(1:12, ncol=3), "identity") } \keyword{misc} seriation/man/Zoo.Rd0000644000176200001440000000302012606356654014070 0ustar liggesusers\name{Zoo} \alias{Zoo} \docType{data} \title{Zoo Data Set} \description{ A database containing characteristics of different animals. The database was created and donated by Richard S. Forsyth and is available from the UCI Machine Learning Repository (Newman et al, 1998). } \usage{data("Zoo")} \format{ A data frame with 101 observations on the following 17 variables. \describe{ \item{\code{hair}}{\{0, 1\}} \item{\code{feathers}}{\{0, 1\}} \item{\code{eggs}}{\{0, 1\}} \item{\code{milk}}{\{0, 1\}} \item{\code{airborne}}{\{0, 1\}} \item{\code{aquatic}}{\{0, 1\}} \item{\code{predator}}{\{0, 1\}} \item{\code{toothed}}{\{0, 1\}} \item{\code{backbone}}{\{0, 1\}} \item{\code{breathes}}{\{0, 1\}} \item{\code{venomous}}{\{0, 1\}} \item{\code{fins}}{\{0, 1\}} \item{\code{legs}}{Numeric (set of values: \{0, 2, 4, 5, 6, 8\})} \item{\code{tail}}{\{0, 1\}} \item{\code{domestic}}{\{0, 1\}} \item{\code{catsize}}{\{0, 1\}} \item{\code{class}}{a factor with levels \code{amphibian} \code{bird} \code{fish} \code{insect} \code{invertebrate} \code{mammal} \code{reptile}} } } %\details{ %} \source{ D.J. Newman, S. Hettich, C.L. Blake and C.J. Merz (1998): UCI Repository of machine learning databases, \url{http://www.ics.uci.edu/~mlearn/MLRepository.html}, University of California, Irvine, Dept. of Information and Computer Sciences. } \examples{ data("Zoo") x <- scale(Zoo[, -17]) d <- dist(x) pimage(d) order <- seriate(d, method = "tsp") pimage(d, order) } \keyword{datasets} seriation/man/permutation_matrix.Rd0000644000176200001440000000150612606356654017263 0ustar liggesusers\name{permutation_matrix} \alias{permutation_matrix2vector} \alias{permutation_vector2matrix} \title{Conversion Between Permutation Vector and Permutation Matrix} \description{ Converts between permutation vectors and matrices. } \usage{ permutation_matrix2vector(x) permutation_vector2matrix(x) } \arguments{ \item{x}{A permutation vector (any object that can be converted into a permutation vector, e.g., a integer vector or a \code{hclust} object) or a matrix representing a permutation. Arguments are checked.} } \seealso{ \code{\link{ser_permutation}}, \code{\link{permute}} } \author{Michael Hahsler} \examples{ ## create a random permutation vector pv <- sample(1:5) pv ## convert into a permutation matrix pm <- permutation_vector2matrix(pv) pm ## convert back permutation_matrix2vector(pm) } \keyword{manip} seriation/man/Munsingen.Rd0000644000176200001440000000422612606356654015275 0ustar liggesusers\name{Munsingen} \alias{Munsingen} \docType{data} \encoding{UTF-8} \title{Hodson's Munsingen Data Set} \description{ This data set contains a grave times artifact incidence matrix for the Celtic Münsingen-Rain cemetery in Switzerland as provided by Hodson (1968) and published by Kendall 1971. } \usage{data("Munsingen")} \format{ A 59 x 70 0-1 matrix. Rows (graves) and columns (artifacts) are in the order determined by Hodson (1968). } \references{ Hodson, F.R. (1968): \emph{The La Tene Cemetery at Münsingen-Rain}. Stämpfli, Bern. Kendall, D.G. (1971): Seriation from abundance matrices. In: Hodson, F.R., Kendall, D.G. and Tautu, P., (Editors). \emph{Mathematics in the Archaeological and Historical Sciences,} Edinburgh University Press, Edinburgh, 215--232. } \examples{ data("Munsingen") ## Seriation method after Kendall (1971) ## Kendall's square symmetric matrix S and SoS S <- function(x, w = 1) { sij <- function(i , j) w * sum(pmin(x[i,], x[j,])) h <- nrow(x) r <- matrix(ncol = h, nrow =h) for(i in 1:h) for (j in 1:h) r[i,j] <- sij(i,j) r } SoS <- function(x) S(S(x)) ## Kendall's horse shoe (Hamiltonian arc) horse_shoe_plot <- function(mds, sigma, threshold = mean(sigma), ...) { plot(mds, main = paste("Kendall's horse shoe with th =", threshold), ...) l <- which(sigma > threshold, arr.ind=TRUE) for(i in 1:nrow(l)) lines(rbind(mds[l[i,1],], mds[l[i,2],])) } ## shuffle data x <- Munsingen[sample(nrow(Munsingen)),] ## calculate matrix and do isoMDS (from package MASS) sigma <- SoS(x) library("MASS") mds <- isoMDS(1/(1+sigma))$points ## plot Kendall's horse shoe horse_shoe_plot(mds, sigma) ## find order using a TSP library("TSP") tour <- solve_TSP(insert_dummy(TSP(dist(mds)), label = "cut"), method = "2-opt", control = list(rep = 15)) tour <- cut_tour(tour, "cut") lines(mds[tour,], col = "red", lwd = 2) ## create and plot order order <- ser_permutation(tour, 1:ncol(x)) bertinplot(x, order, options= list(panel=panel.circles, rev = TRUE)) ## compare criterion values rbind( random = criterion(x), reordered = criterion(x, order), Hodson = criterion(Munsingen) ) } \keyword{datasets} seriation/man/get_order.Rd0000644000176200001440000000451212756134261015274 0ustar liggesusers\name{get_order} \alias{get_order} \alias{get_order.integer} \alias{get_order.hclust} \alias{get_order.ser_permutation_vector} \alias{get_order.ser_permutation} \alias{get_rank} \alias{get_permutation_matrix} \title{Extracting Order Information from a Permutation Object} \description{ Method to get the order information from an object of class \code{ser_permutation} or \code{ser_permutation_vector}. Order information can be extracted as an integer permutation vector, a vector containing the object ranks or a permutation matrix. } \usage{ get_order(x, \ldots) \method{get_order}{ser_permutation_vector}(x, \ldots) \method{get_order}{ser_permutation}(x, dim = 1, \ldots) get_rank(x, \ldots) get_permutation_matrix(x, \ldots) } \arguments{ \item{x}{ an object of class \code{ser_permutation} or \code{ser_permutation_vector}.} \item{dim}{ order information for which dimension should be returned?} \item{\ldots}{further arguments are ignorred for \code{get_order}. For \code{get_rank} and for \code{get_permutation_matrix} the additional arguments are passed on to \code{get_order} (e.g., as \code{dim}).} } \details{ \code{get_order} returns the seriation as an integer vector containing the order of the objects after permutation. That is, the index of the first, second, \eqn{..., n}-th object. These permuation vectors can directly be used to reorder objects using subsetting with \code{"["}. \emph{Note:} In \pkg{seriation} we usually use these order-based permutation vectors. \code{get_rank} returns the seriation as an integer vector containing the rank/position for each objects in the permutation. That is, position of the first, second, \eqn{..., n}-th object after permutation. Note: Use \code{order()} to convert ranks back to an order. \code{get_permutation_matrix} returns a \eqn{n \times n}{n x n} permutation matrix. } \value{ Returns an integer permutation vector/a permutation matrix. } \seealso{ \code{\link{ser_permutation_vector}}, \code{\link{ser_permutation}} } \author{Michael Hahsler} \examples{ ## permutation_vector o <- ser_permutation_vector(sample(10)) o get_order(o) get_rank(o) get_permutation_matrix(o) ## permutation o2 <- ser_permutation(o, sample(5)) o2 get_order(o2, dim = 2) get_rank(o2, dim = 2) get_permutation_matrix(o2, dim = 2) } \keyword{manip}% at least one, from doc/KEYWORDS seriation/man/Irish.Rd0000644000176200001440000000123512606356654014405 0ustar liggesusers\name{Irish} \alias{Irish} \docType{data} \title{Irish Referendum Data Set} \description{ A data matrix containing the results of 8 referenda for 41 Irish communities used in Falguerolles et al (1997). } \usage{data(Irish)} \format{ The format is a 41 x 9 matrix. Two values are missing. } \details{ Column 6 contains the size of the Electorate in 1992. } \source{ The data was kindly provided by Guenter Sawitzki. } \references{ de Falguerolles, A., Friedrich, F., Sawitzki, G. (1997): A Tribute to J. Bertin's Graphical Data Analysis. In: Proceedings of the SoftStat '97 (Advances in Statistical Software 6), 11--20. } \examples{ data(Irish) } \keyword{datasets} seriation/man/pimage.Rd0000644000176200001440000001127112766073147014572 0ustar liggesusers\name{pimage} \alias{pimage} \alias{pimage.matrix} \alias{pimage.dist} \title{Permutation Image Plot} \description{ Provides methods for plotting image plots for matrix and \code{dist} objects given a permutation. By default, no permutation is performed. This plot can also be used as a more versatile replacement of \code{image} plot in \pkg{graphics} based on \pkg{grid}. } \usage{ pimage(x, order = NULL, col = NULL, main ="", xlab = "", ylab = "", axes = "auto", zlim=NULL, key=TRUE, key.lab="", symkey=TRUE, upper.tri = TRUE, lower.tri = TRUE, prop = NULL, ..., newpage=TRUE, pop=TRUE, gp=NULL) } \arguments{ \item{x}{a matrix or an object of class \code{dist}.} \item{order}{an object of class \code{ser_permutation}. If \code{NULL} the order in \code{x} is plotted.} \item{col}{a list of colors used. If \code{NULL}, a gray scale is used (for matrix larger values are displayed darker and for \code{dist} smaller distances are darker). For matrices containing logical data, black and white is used. For matrices containing negative values a symmetric diverging color palette is used.} \item{main}{plot title.} \item{xlab, ylab}{labels for the x and y axes.} \item{axes}{ a character string indicating if axes labels (column and row names of \code{x}) should be potted. Possible values are \code{"auto"} (only plot if less then 25 labels), \code{"x"}, \code{"y"}, \code{"both"} and \code{"none"}.} \item{zlim}{ vector with two elements giving the range (min, max) for representing the values in the matrix. } \item{key}{ logical; add a color key? No key is available for logical matrices. } \item{key.lab}{ string plotted next to the color key.} \item{symkey}{ logical; if \code{x} contains negative values, should the color palate be symmetric (zero is in the middle)>} \item{upper.tri, lower.tri}{ a logical indicating whether to show the upper or lower triangle of the distance matrix. } \item{prop}{logical; draw the cells in the image proportional (defaults to \code{TRUE} for \code{dist} and \code{FALSE} for matrix).} \item{\dots}{further arguments passed on to \code{image} in \pkg{graphics}.} \item{newpage, pop}{two logical. Start plot on a new page and pop the viewports after plotting (see \pkg{grid}).} \item{gp}{a \code{gpar} object (see \pkg{grid}).} } \details{ Plots a matrix in its original row and column orientation. This means, in a plot the columns become the x-coordinates and the reversed rows the y-coordinates. If \code{x} is of class \code{dist} it is converted to full-storage representation before plotting. The viewports used for plotting are called: \code{"plot"}, \code{"image"} and \code{"colorkey"}. } \seealso{ \code{\link{seriate}}, \code{\link{hmap}}, \code{\link{dissplot}} and \code{\link[graphics]{image}}.} \author{Christian Buchta and Michael Hahsler} \examples{ x <- matrix(sample(c(FALSE, TRUE), 300, rep=TRUE), ncol=10, dimnames = list(1:30, LETTERS[1:10])) ## matrix (large values are dark/black) pimage(x, main = "Random data", key = FALSE) ## plot seriated matrix (use red, proportional display and plot all axes) pimage(x, seriate(x), col = c("white", "red"), prop = TRUE, axes="both", main = "Reordered data", key = FALSE) ## show correlation (for neg. values a diverging color scheme is ## used automatically) pimage(cor(x), prop=TRUE) ## distances (note that low distances are represented dark!) d <- dist(x, method = "binary") pimage(d, upper.tri = FALSE, main = "Distances") pimage(d, seriate(d), upper.tri = FALSE, main = "Distances", axes = "both") ## add to the plot using grid (use pop = FALSE) library(grid) pimage(x, pop = FALSE) downViewport(name = "image") ## highlight cell 7/5 with a red arrow grid.lines(x = c(5, 7), y = c(3, 5), arrow = arrow(), default.units = "native", gp = gpar(col="red", lwd = 3)) ## add a red box around rows 15 and 16 grid.rect(x = 0.5, y = 15.5, width = ncol(x), height = 2, just = "left", default.units = "native", gp = gpar(col="red", lwd = 3, fill = NA)) ## remove the viewports popViewport(0) ## put several pimages on a page (uses viewports and newpage = FALSE) library(grid) grid.newpage() pushViewport(viewport(layout=grid.layout(nrow = 1, ncol = 2))) pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 1)) ## seriate matrix o <- seriate(x) pimage(x, o, main = "Random data", prop = TRUE, axes = "both", key = FALSE, newpage = FALSE) upViewport(1) pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 2)) ## add the reordered disimilarity matrix for rowa pimage(d, o[[1]], upper.tri = FALSE, main = "Distances", axes = "both", key = FALSE, newpage = FALSE) upViewport(1) popViewport(0) } \keyword{hplot} seriation/man/dissimilarity.Rd0000644000176200001440000001302712750164770016213 0ustar liggesusers\name{dissimilarity} \alias{dist} \alias{ser_dist} \alias{ser_cor} \alias{ser_align} \title{Dissimilarities and Correlations Between Seriation Orders} \description{ Calculates dissimilarities/correlations between seriation orders in a list. } \usage{ ser_cor(x, y = NULL, method = "spearman", reverse = TRUE, test = FALSE) ser_dist(x, y = NULL, method = "spearman", reverse = TRUE, ...) ser_align(x, method = "spearman") } \arguments{ \item{x}{set of seriation orders as a list with elements which can be coerced into \code{ser_permutation_vector} objects. } \item{y}{ if not \code{NULL} then a single seriation order can be specified. In this case \code{x} has to be a single seriation order and not a list. } \item{method}{ a character string with the name of the used measure. Available measures are: \code{"kendall"}, \code{"spearman"}, \code{"manhattan"}, \code{"euclidean"}, \code{"hamming"}, \code{"ppc"} (positional proximity coefficient), and \code{"aprd"} (absolute pairwise rank differences).} \item{reverse}{a logical indicating if the orders should also be checked in reverse order and the best value (highest correlation, lowest distance) is reported. This only affect ranking-based measures and not precedence invariant measures (e.g., ppc, aprd). } \item{test}{a logical indicating if a correlation test should be performed. } \item{...}{Further arguments passed on to the method. } } \details{ \code{ser_cor} calculates the correlation between two sequences (orders). Note that a seriation order and its reverse are identical and purely an artifact due to the method that creates the order. This is a major difference to rankings. For ranking-based correlation measures (Spearman and Kendall) the absolute value of the correlation is returned for \code{reverse = TRUE} (in effect returning the correltation for the reversed order). If \code{test = TRUE} then the appropriate test for association is performed and a matrix with p-values is returned as the attribute \code{"p-value"}. Note that no correction for multiple testing is performed. For \code{ser_dist}, the correlation coefficients (Kendall's tau and Spearman's rho) are converted into a dissimilarity by taking one minus the correlation value. Note that Manhattan distance between the ranks in a linear order is equivalent to Spearman's footrule metric (Diaconis 1988). \code{reverse = TRUE} returns the pairwise minima using also reversed orders. The positional proximity coefficient (ppc) is a precedence invariant measure based on product of the squared positional distances in two permutations defined as (see Goulermas et al 2016): \deqn{d_{ppc}(R, S) = 1/h \sum_{j=2}^n \sum_{i=1}^{j-1} (\pi_R(i)-\pi_R(j))^2 * (\pi_S(i)-\pi_S(j))^2,} where \eqn{R} and \eqn{S} are two seriation orders, \eqn{pi_R} and \eqn{pi_S} are the associated permutation vectors and \eqn{h} is a normalization factor. The associatied generalized correlation coefficient is defined as \eqn{1-d_{ppc}}. For this precedence invariant measure \code{reverse} is ignored. The absolute pairwise rank difference (aprd) is also precedence invariant and defined as a distance measure: \deqn{d_{aprd}(R, S) = \sum_{j=2}^n \sum_{i=1}^{j-1} | |\pi_R(i)-\pi_R(j)| - |\pi_S(i)-\pi_S(j)| |^p,} where \eqn{p} is the power which can be passed on as parameter \code{p} and is by default set to 2. For this precedence invariant measure \code{reverse} is ignored. \code{ser_align} tries to normalize the direction in a list of seriations such that ranking-based methods can be used. We add for each permutation also the reversed order to the set and then use a modified version of Prim's algorithm for finding a minimum spanning tree (MST) to choose if the original seriation order or its reverse should be used. We use the orders first added to the MST. Every time an order is added, its reverse is removed from the possible remaining orders. } \value{ \code{ser_dist} returns an object of class \code{dist}. \code{ser_align} returns a new list with elements of class \code{ser_permutation}. } \references{ P. Diaconis (1988): Group Representations in Probability and Statistics. Institute of Mathematical Statistics, Hayward, CA. J.Y. Goulermas, A. Kostopoulos, and T. Mu (2016): A New Measure for Analyzing and Fusing Sequences of Objects. IEEE Transactions on Pattern Analysis and Machine Intelligence 38(5):833-48. } \seealso{ \code{\link{ser_permutation_vector}} } \author{Michael Hahsler} \examples{ set.seed(1234) ## seriate dist of 50 flowers from the iris data set data("iris") x <- as.matrix(iris[-5]) x <- x[sample(1:nrow(x), 50),] rownames(x) <- 1:50 d <- dist(x) ## Create a list of different seriations methods <- c("HC_single", "HC_complete", "OLO", "GW", "R2E", "VAT", "TSP", "Spectral", "SPIN", "MDS", "Identity", "Random") os <- sapply(methods, function(m) { cat("Doing", m, "... ") tm <- system.time(o <- seriate(d, method = m)) cat("took", tm[3],"s.\n") o }) ## Compare the methods using distances. Default is based on ## Spearman's rank correlation coefficient. Reverse orders are considered ## equivalent. ds <- ser_dist(os) hmap(ds, margin=c(7,7)) ## Compare using actual correlation between orders. Reversed orders have ## negative correlation! cs <- ser_cor(os, reverse = FALSE) hmap(cs, margin=c(7,7)) ## Also check reversed seriation orders. ## Now all but random and identity are highly positive correlated cs2 <- ser_cor(os, reverse = TRUE) hmap(cs2, margin=c(7,7)) ## Use Manhattan distance of the ranks (i.e., Spearman's foot rule) ds <- ser_dist(os, method="manhattan") plot(hclust(ds)) } \keyword{cluster} seriation/man/Townships.Rd0000644000176200001440000000160312606356654015324 0ustar liggesusers\name{Townships} \alias{Townships} \docType{data} \title{Bertin's Characteristics of Townships} \description{ This data contains nine characteristics for 16 townships. The data set was used by Bertin (1981) to illustrate that the conciseness of presentation can be improved by seriating the rows and columns. } \usage{data("Townships")} \format{ A matrix with 16 0-1 variables (columns) indicating the presence (\code{1}) or absence (\code{0}) of characteristics of townships (rows). } \references{ Bertin, J. (1981): \emph{Graphics and Graphic Information Processing}. Berlin, Walter de Gruyter. } \author{Michael Hahsler} \examples{ data("Townships") ## original data pimage(Townships) criterion(Townships) ## seriated data order <- seriate(Townships, method = "BEA", control = list(rep = 5)) pimage(Townships, order) criterion(Townships, order) } \keyword{datasets} seriation/man/uniscale.Rd0000644000176200001440000000306413473553301015123 0ustar liggesusers\name{uniscale} \alias{uniscale} \alias{orderplot} \title{Unidimensional Scaling from Seriation Results} \description{ Performs (approximate) unidimensional scaling by first performin seriation to obtain a permutation and the using the permutation to calulate the configuration. } \usage{ uniscale(d, order = NULL, method = "QAP_LS", rep = 10, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{d}{a dissimilarity matrix.} \item{order}{a precomputed permutation (configuration) order. If \code{NULL}, then seriation is performed using the method specified in \code{method}. } \item{method}{seriation method used if \code{o} is \code{NULL}. } \item{rep}{Number of repetitions of the seriation heuristic.} \item{\dots}{additional arguments are passed on to the seriation method.} } \details{ Uses the method describes in Maier and De Leeuw (2015) to calculate the minimum stress configuration for either a given configuration/permutation/order or for a permutation computed via a seriation method. The code is similar to \code{uniscale} in \pkg{smacof}, but scales to larger datasets since it does not check all permutations. } \value{ A vector with the fitted configuration. } \references{ Mair P., De Leeuw J. (2015). Unidimensional scaling. In \emph{Wiley StatsRef: Statistics Reference Online,} Wiley, New York. } \author{ Michael Hahsler with code from Patrick Mair (from \pkg{smacof}). } \examples{ data(SupremeCourt) d <- as.dist(SupremeCourt) sc <- uniscale(d) sc orderplot(sc) } \keyword{optimize}% use one of RShowDoc("KEYWORDS") seriation/man/Wood.Rd0000644000176200001440000000205112606356654014234 0ustar liggesusers\name{Wood} \alias{Wood} \docType{data} \title{Gene Expression Data for Wood Formation in Poplar Trees} \description{ A data matrix containing a sample of the normalized gene expression data for 6 locations in the stem of Popla trees published in the study by Herzberg et al (2001). The sample of 136 genes selected by Caraux and Pinloche (2005). } \usage{data(Wood)} \format{ The format is a 136 x 6 matrix. } \source{ The data was obtained from \url{http://www.atgc-montpellier.fr/permutmatrix/manual/Exemples/Wood/Wood.htm}. } \references{ Hertzberg M., H. Aspeborg, J. Schrader, A. Andersson, R.Erlandsson, K. Blomqvist, R. Bhalerao, M. Uhlen, T. T. Teeri, J. Lundeberg, Bjoern Sundberg, P. Nilsson and Goeran Sandberg (2001): A transcriptional roadmap to wood formation, \emph{PNAS,} \bold{98}(25), 14732--14737. Caraux G. and Pinloche S. (2005): PermutMatrix: a graphical environment to arrange gene expression profiles in optimal linear order, \emph{Bioinformatics,} \bold{21}(7) 1280--1281. } \examples{ data(Wood) head(Wood) } \keyword{datasets} seriation/man/data.Rd0000644000176200001440000001016412606356654014241 0ustar liggesusers\name{seriation_data} \alias{create_lines_data} \alias{create_ordered_data} \title{Create Simulated Data for Seriation Evaluation} \description{ Several functions to create simulated data to evaluate different aspects of seriation algorithms and criterion functions. } \usage{ create_lines_data(n = 250) create_ordered_data(n = 250, k = 2, size = NULL, spacing = 6, path = "linear", sd1 = 1, sd2 = 0) } \arguments{ \item{n}{number of data points to create.} \item{k}{number of Gaussian components.} \item{size}{relative size (number of points) of components (length of k). If \code{NULL} then all components have the same size. } \item{spacing}{ space between the centers of components. The default of 6 means that the components will barely touch at \code{ds1=1} (3 standard deviations for each Gaussian component). } \item{path}{ Are the components arranged along a \code{"linear"} or \code{"circular"} path? } \item{sd1}{ variation in the direction along the components. A value greater than one means the components are mixing. } \item{sd2}{ variation perpendicular to the direction along the components. A value greater than 0 will introduce anti-Robinson violation events. } } \details{ \code{create_lines_data} creates the lines data set used in for iVAT in Havens and Bezdeck (2012). \code{create_ordered_data} is a versatile function which creates "orderable" 2D data using Gaussian components along a linear or circular path. The components are equally spaced (\code{spacing}) along the path. The default spacing of 6 ensures that 2 adjacent components with a standard deviation of one along the direction of the path will barely touch. The standard deviation along the path is set by \code{sd1}. The standard deviation perpendicular to the path is set by \code{sd2}. A value larger than zero will result in the data not being perfectly orderable (i.e., the resulting distance matrix will not be a perfect pre-anti-Robinson matrix and contain anti-Robinson violation events after seriation). Note that a circular path always creates anti-Robinson violation since the circle has to be broken at some point to create a linear order. } \seealso{ \code{\link{seriate}}, \code{\link{criterion}}, \code{\link{VAT}}. } \references{ Havens, T.C. and Bezdek, J.C. (2012): An Efficient Formulation of the Improved Visual Assessment of Cluster Tendency (iVAT) Algorithm, \emph{IEEE Transactions on Knowledge and Data Engineering,} \bold{24}(5), 813--822. } \author{Michael Hahsler} \examples{ ## lines data set from Havens and Bezdek (2011) x <- create_lines_data(250) plot(x, xlim=c(-5,5), ylim=c(-3,3), cex=.2, col = attr(x, "id")) d <- dist(x) pimage(d, seriate(d, "OLO_single"), col = bluered(100, bias=.5), key = TRUE) ## create_ordered_data can produce many types of "orderable" data ## perfect pre-Anti-Robinson matrix (with a single components) x <- create_ordered_data(250, k = 1) plot(x, cex=.2, col = attr(x, "id")) d <- dist(x) pimage(d, seriate(d, "MDS"), col = bluered(100, bias=.5), key = TRUE) ## separated components x <- create_ordered_data(250, k = 5) plot(x, cex=.2, col = attr(x, "id")) d <- dist(x) pimage(d, seriate(d, "MDS"), col = bluered(100, bias=.5), key = TRUE) ## overlapping components x <- create_ordered_data(250, k = 5, sd1 = 2) plot(x, cex=.2, col = attr(x, "id")) d <- dist(x) pimage(d, seriate(d, "MDS"), col = bluered(100, bias=.5), key = TRUE) ## introduce anti-Robinson violations (a non-zero y value) x <- create_ordered_data(250, k = 5, sd1 = 2, sd2 = 5) plot(x, cex=.2, col = attr(x, "id")) d <- dist(x) pimage(d, seriate(d, "MDS"), col = bluered(100, bias=.5), key = TRUE) ## circular path (has always violations) x <- create_ordered_data(250, k = 5, path = "circular", sd1=2) plot(x, cex=.2, col = attr(x, "id")) d <- dist(x) pimage(d, seriate(d, "OLO"), col = bluered(100, bias=.5), key = TRUE) ## circular path (with more violations violations) x <- create_ordered_data(250, k = 5, path = "circular", sd1=2, sd2=1) plot(x, cex=.2, col = attr(x, "id")) d <- dist(x) pimage(d, seriate(d, "OLO"), col = bluered(100, bias=.5), key = TRUE) } \keyword{data} seriation/man/register_DendSer.Rd0000644000176200001440000000414312673145545016557 0ustar liggesusers\name{register_DendSer} \alias{register_DendSer} \alias{DendSer} \alias{dendser} \title{Register Seriation Methods from Package DendSer} \description{ Register the DendSer dendrogram seriation method and the ARc criterion (Earle and Hurley, 2015). } \usage{ register_DendSer() } \details{ Registers the method \code{"DendSer"} for \code{seriate}. DendSer is a fast heuristic for reordering dendrograms developed by Earle and Hurley (2015) able to use different criteria. \code{control} for \code{seriate} with method \code{"DendSer"} accepts the following parameters: \describe{ \item{\code{"h"} or \code{"method"}}{A dendrogram or a method for hierarchical clustering (see \code{hclust}). Default: complete-link.} \item{\code{"criterion"}}{A seriation criterion to optimize (see \code{list_criterion_methods("dist")}). Default: \code{"BAR"} (Banded anti-Robinson from with 20\% band width).} \item{\code{"verbose"}}{print progress information.} \item{\code{"DendSer_args"}}{additional arguments for \code{DendSer}.} } For convenience the following methods (for differnt cost functions) are also provided: \code{"DendSer_ARc"} (anti-robinson form), \code{"DendSer_BAR"} (banded anti-Robinson form), \code{"DendSer_LS"} (leaf seriation), \code{"DendSer_PL"} (path length). Note: Package \pkg{DendSer} needs to be installed. } %\value{ %} \references{ D. Earle, C. B. Hurley (2015): Advances in dendrogram seriation for application to visualization. \emph{Journal of Computational and Graphical Statistics,} \bold{24}(1), 1--25. } \author{ Michael Hahsler based on code by Catherine B. Hurley and Denise Earle } \seealso{ \code{\link{seriate}}, \code{\link[DendSer]{DendSer}} in \pkg{DendSer}. } \examples{ \dontrun{ register_DendSer() list_seriation_methods("dist") d <- dist(random.robinson(20, pre=TRUE)) ## use Banded AR form with default clustering (complete-link) o <- seriate(d, "DendSer_BAR") pimage(d, o) ## use different hclust method (Ward) and AR as the cost function for ## dendrogram reordering o <- seriate(d, "DendSer", control = list(method = "ward.D2", criterion = "AR")) pimage(d, o) } } \keyword{optimize} \keyword{cluster} seriation/man/register_GA.Rd0000644000176200001440000000567212650516356015527 0ustar liggesusers\name{register_GA} \alias{register_GA} \alias{GA} \alias{ga} \alias{gaperm_mixedMutation} \title{Register a Genetic Algorithm Seriation Method} \description{ Register a GA-based seriation metaheuristic. } \usage{ register_GA() } \details{ Registers the method \code{"GA"} for \code{seriate}. This method can be used to optimize any criterion in package \pkg{seriation}. \code{control} for \code{seriate} with method \code{"GA"} accepts the following parameters: \describe{ \item{\code{"criterion"}}{ criterion to optimize. Default: BAR} \item{\code{"suggestions"}}{ suggestions to warm start the GA. \code{NA} means no warm start. Default: TSP, QAP_LS and Spectral. } \item{\code{"selection"}}{ Selection operator (see \pkg{GA}). Default: non-linear rank selection} \item{\code{"crossover"}}{ Crossover operator (see \pkg{GA}). Default: ordered crossover (OX)} \item{\code{"mutation"}}{ Mutation operator (see \pkg{GA}). Default: a mixture of the simple insertion (80\% chance) and simple inversion (20\% chance) operators.} \item{\code{"pmutation"}}{ proability for permutations. Default: .5} \item{\code{"pcrossover"}}{ probability for crossover. Default: .2} \item{\code{"popsize"}}{ the population size. Default: 100} \item{\code{"maxiter"}}{ maximum number of generations. Default: 1000 } \item{\code{"run"}}{ stop after \code{run} generations without improvement. Default: 50 } \item{\code{"parallel"}}{ use multiple cores? Default: TRUE} \item{\code{"verbose"}}{ Report progress? Default: TRUE} } The GA uses by default the ordered cross-over (OX) operator. For mutation, the GA uses a mixture of simple insertion and simple inversion operators. This mixed operator is created using \code{seriation::gaperm_mixedMutation(ismProb = .8)}, where \code{ismProb} is the probability that the simple insertion mutation operator is used. See package \pkg{GA} for a description of other available cross-over and mutation operators for permutaitons. The appropriate operator functions in \pkg{GA} start with \code{gaperm_}. We warm start the GA using \code{"suggestions"} given by several heuristics. Set \code{"suggestions"} to \code{NA} to start with a purely random initial population. \bold{Note:} Package \pkg{GA} needs to be installed. } %\value{ %} \references{ Luca Scrucca (2013): GA: A Package for Genetic Algorithms in R. \emph{Journal of Statistical Software,} \bold{53}(4), 1--37. URL \url{http://www.jstatsoft.org/v53/i04/}. } \author{ Michael Hahsler } \seealso{ \code{\link{seriate}}, \code{\link[GA]{ga}} in \pkg{GA}. } \examples{ \dontrun{ register_GA() list_seriation_methods("dist") d <- dist(random.robinson(50, pre=TRUE, noise=.1)) ## use default settings: Banded AR form o <- seriate(d, "GA") pimage(d, o) ## optimize for linear sertiation criterion (LS) o <- seriate(d, "GA", control = list(criterion = "LS")) pimage(d, o) ## no warm start o <- seriate(d, "GA", control = list(criterion = "LS", suggestions = NA)) pimage(d, o) } } \keyword{optimize} \keyword{cluster} seriation/man/permutation_vector.Rd0000644000176200001440000000507612606356654017267 0ustar liggesusers\name{permutation_vector} \alias{ser_permutation_vector} \alias{permutation_vector} \alias{print.ser_permutation_vector} \alias{rev.ser_permutation_vector} \alias{get_method} \alias{length.ser_permutation_vector} \title{Class ser_permutation_vector -- A Single Permutation Vector for Seriation} \description{ The class \code{ser_permutation_vector} represents a single permutation vector. } \usage{ ## constructor ser_permutation_vector(x, method = NULL) } \arguments{ \item{x}{ an object which contains a permutation vector (currently an integer vector or an object of class \code{hclust}). The value \code{NA} creates an identity permutation. } \item{method}{ a string representing the method used to obtain the permutation vector} } \details{ A permutation vector maps a set of \eqn{n} objects \eqn{\{O_1, O_2, ..., O_n\}}{{O_1, O_2, ..., O_n}} onto itself. In \pkg{seriation} we represent a permutation \eqn{\pi}{\pi} as a vector which lists the objects in their permuted order. For example, the permutation vector \eqn{\langle3, 1, 2\rangle}{<3, 1, 2>} indicates that in first position is the object with index 3 then the object with index 1 and finally the object with index 2. A permutation vector can be extracted from a permuation vector object via \code{get_order()}. Such a permutation vector can be directly used to subset the list of original objects with \code{"["} to apply the permutation. \emph{Note:} An alternative way to specify a permutation is via a list of the ranks of the objects after permutation (see \code{get_rank()}). \code{ser_permutation_vector} objects are usually packed into a \code{ser_permutation} object which is a collection of \eqn{k} permutation vectors for \eqn{k}-mode data. The constructor \code{ser_permutation_vector} checks if the permutation vector is valid (i.e. if all integers occur exactly once). The following functions are implemented: \code{print}, \code{rev}, \code{length}, \code{get_order}, \code{get_rank}, \code{get_method}. } \value{ An object of class \code{ser_permutation_vector}. } \seealso{ \code{\link{ser_permutation}}, \code{\link{get_order}}, \code{\link{get_rank}}, \code{\link{get_permutation_matrix}}, \code{\link{permutation_vector2matrix}}. } \author{Michael Hahsler} \examples{ p <- ser_permutation_vector(sample(10), "random") p ## some methods length(p) get_method(p) get_order(p) get_rank(p) get_permutation_matrix(p) r <- rev(p) r get_order(r) ## create a indentity permutation vector (with unknown length) ip <- ser_permutation_vector(NA) ip } \keyword{classes}% at least one, from doc/KEYWORDS seriation/man/VAT.Rd0000644000176200001440000000427012606356654013763 0ustar liggesusers\name{VAT} \alias{path_dist} \alias{iVAT} \alias{VAT} \title{Visual Analysis for Cluster Tendency Assessment (VAT/iVAT)} \description{ Implements Visual Analysis for Cluster Tendency Assessment (VAT; Bezdek and Hathaway, 2002) and Improved Visual Analysis for Cluster Tendency Assessment (iVAT; Wang et al, 2010). } \usage{ VAT(x, ...) iVAT(x, ...) path_dist(x) } \arguments{ \item{x}{a \code{dist} object.} \item{...}{further arguments are passed on to \code{pimage}.} } \details{ \code{path_dist} redefines the distance between two objects as the minimum over the largest distances in all possible paths between the objects as used for iVAT. } \seealso{ \code{\link{seriate}}, \code{\link{pimage}}, \code{\link{create_lines_data}}. } \references{ Bezdek, J.C. and Hathaway, R.J. (2002): VAT: a tool for visual assessment of (cluster) tendency. \emph{Proceedings of the 2002 International Joint Conference on Neural Networks (IJCNN '02)}, Volume: 3, 2225--2230. Havens, T.C. and Bezdek, J.C. (2012): An Efficient Formulation of the Improved Visual Assessment of Cluster Tendency (iVAT) Algorithm, \emph{IEEE Transactions on Knowledge and Data Engineering,} \bold{24}(5), 813--822. Wang L., U.T.V. Nguyen, J.C. Bezdek, C.A. Leckie and K. Ramamohanarao (2010): iVAT and aVAT: Enhanced Visual Analysis for Cluster Tendency Assessment, \emph{Proceedings of the PAKDD 2010, Part I, LNAI 6118,} 16--27. } \author{Michael Hahsler} \examples{ ## lines data set from Havens and Bezdek (2011) x <- create_lines_data(250) plot(x, xlim=c(-5,5), ylim=c(-3,3), cex=.2) d <- dist(x) ## create regular VAT VAT(d, colorkey = TRUE, main = "VAT") ## same as: pimage(d, seriate(d, "VAT")) ## create iVAT which shows visually the three lines iVAT(d, main = "iVAT") ## same as: ## d_path <- path_dist(d) ## pimage(d_path, seriate(d_path, "VAT")) ## compare with dissplot (shows banded structures and relationship between ## center line and the two outer lines) dissplot(d, method="OLO_single", main = "Dissplot", col = bluered(100, bias = .5)) ## compare with optimally reordered heatmap hmap(d, method="OLO_single", main = "Heat map (opt. leaf ordering)", col = bluered(100, bias = .5)) } \keyword{cluster} \keyword{manip} seriation/man/Psych24.Rd0000644000176200001440000000246512606356654014571 0ustar liggesusers\name{Psych24} \alias{Psych24} \docType{data} \title{Results of 24 Psychological Test for 8th Grade Students} \description{ A data set collected by Holzinger and Swineford (1939) which consists of the results of 24 psychological tests given to 145 seventh and eighth grade students in a Chicago suburb. This data set contains the correlation matrix for the 24 test results. The data set was also used as an example for visualization of cluster analysis by Ling (1973). } \usage{data("Psych24")} \format{ A 24 x 24 correlation matrix. } %\details{ %} \references{ Holzinger, K. L., Swineford, F. (1939): A study in factor analysis: The stability of a bi-factor solution. \emph{Supplementary Educational Monograph,} No. \bold{48}. Chicago: University of Chicago Press. Ling, R. L. (1973): A computer generated aid for cluster analysis. \emph{Communications of the ACM}, \bold{16}(6), pp. 355--361. } \examples{ data("Psych24") ## create a dist object and also get rid of the one negative entry in the ## correlation matrix d <- as.dist(1 - abs(Psych24)) pimage(d) ## do hclust as in Ling (1973) hc <- hclust(d, method = "complete") plot(hc) pimage(d, hc) ## use seriation order <- seriate(d, method = "tsp") #order <- seriate(d, method = "tsp", control = list(method = "concorde")) pimage(d, order) } \keyword{datasets} seriation/man/reorder_hclust.Rd0000644000176200001440000000347712606356654016365 0ustar liggesusers\name{reorder.hclust} \alias{reorder} \alias{reorder.hclust} \title{Reorder Dendrograms using Optimal Leaf Ordering} \description{ Reorder method for dendrograms for optimal leaf ordering. } \usage{ \method{reorder}{hclust}(x, dist, method = "OLO", ...) } \arguments{ \item{x}{an object of class \code{hclust}.} \item{dist}{an object of class \code{dist} with dissimilarities between the objects in \code{x}.} \item{method}{ a character string with the name of the used measure Available are: \code{"OLO"} (optimal leaf ordering; Bar-Joseph et al., 2001) and \code{"GW"} (Gruvaeus and Wainer, 1972).} \item{...}{ further arguments are currently ignored.} } \details{ Minimizes the distance between neighboring objects (leaf nodes) in the dendrogram by flipping the order of subtrees. The algorithm by Gruvaeus and Wainer is implemented in package \pkg{gclus} (Hurley 2004). } \value{ A reordered \code{hclust} object. } \references{ Bar-Joseph, Z., E. D. Demaine, D. K. Gifford, and T. Jaakkola. (2001): Fast Optimal Leaf Ordering for Hierarchical Clustering. \emph{Bioinformatics,} \bold{17}(1), 22--29. Gruvaeus, G. and Wainer, H. (1972): Two Additions to Hierarchical Cluster Analysis, \emph{British Journal of Mathematical and Statistical Psychology,} \bold{25}, 200--206. Hurley, Catherine B. (2004): Clustering Visualizations of Multidimensional Data. \emph{Journal of Computational and Graphical Statistics,} \bold{13}(4), 788--806. } \seealso{ \code{\link[gclus]{reorder.hclust}} } \author{Michael Hahsler} \examples{ ## cluster European cities by distance data("eurodist") d <- as.dist(eurodist) hc <- hclust(eurodist) ## plot original dendrogram and the reordered dendrograms plot(hc) plot(reorder(hc, d, method = "GW")) plot(reorder(hc, d, method = "OLO")) } \keyword{optimize} \keyword{cluster} seriation/DESCRIPTION0000644000176200001440000000366213531266512013770 0ustar liggesusersPackage: seriation Type: Package Title: Infrastructure for Ordering Objects Using Seriation Version: 1.2-8 Date: 2019-08-27 Authors@R: c( person("Michael", "Hahsler", role = c("aut", "cre", "cph"), email = "mhahsler@lyle.smu.edu"), person("Christian", "Buchta", role = c("aut", "cph")), person("Kurt", "Hornik", role = c("aut", "cph")), person("Fionn", "Murtagh", role = c("ctb", "cph")), person("Michael", "Brusco", role = c("ctb", "cph")), person("Stephanie", "Stahl", role = c("ctb", "cph")), person("Hans-Friedrich", "Koehn", role = c("ctb", "cph"))) Description: Infrastructure for ordering objects with an implementation of several seriation/sequencing/ordination techniques to reorder matrices, dissimilarity matrices, and dendrograms. Also provides (optimally) reordered heatmaps, color images and clustering visualizations like dissimilarity plots, and visual assessment of cluster tendency plots (VAT and iVAT). Classification/ACM: G.1.6, G.2.1, G.4 URL: https://github.com/mhahsler/seriation BugReports: https://github.com/mhahsler/seriation/issues Depends: R (>= 2.14.0) Imports: TSP, qap, grid, cluster, gclus, dendextend, colorspace, MASS, gplots, registry, methods, stats, grDevices Suggests: biclust, testthat, DendSer, GA License: GPL-3 Copyright: The code in src/bea.f is Copyright (C) 1991 F. Murtagh; src/bbwrcg.f, src/arsa.f and src/bburcg.f are Copyright (C) 2005 M. Brusco, H.F. Koehn, and S. Stahl. All other code is Copyright (C) Michael Hahsler, Christian Buchta, and Kurt Hornik. NeedsCompilation: yes Packaged: 2019-08-27 17:04:01 UTC; hahsler Author: Michael Hahsler [aut, cre, cph], Christian Buchta [aut, cph], Kurt Hornik [aut, cph], Fionn Murtagh [ctb, cph], Michael Brusco [ctb, cph], Stephanie Stahl [ctb, cph], Hans-Friedrich Koehn [ctb, cph] Maintainer: Michael Hahsler Repository: CRAN Date/Publication: 2019-08-27 17:50:02 UTC seriation/build/0000755000176200001440000000000013531261200013337 5ustar liggesusersseriation/build/vignette.rds0000644000176200001440000000034013531261200015673 0ustar liggesusersuQ0 ?`HLx=&x1ăq#cxN&گCr dZZ|n p5ga0eR*3 Hz!'Ukh&( ޥ6G#WZkyD+27Z{Eϙ`cEIBk]j$Mx@hEӒ^F$ s|5seriation/tests/0000755000176200001440000000000012636302712013413 5ustar liggesusersseriation/tests/testthat/0000755000176200001440000000000013531266512015255 5ustar liggesusersseriation/tests/testthat/test-dissimilarity.R0000644000176200001440000000356012712422001021232 0ustar liggesuserslibrary(seriation) ## FIXME add tests for ser_align set.seed(0) x <- list( a = 1:100, b = 100:1, c = sample(100), d = sample(100) ) context("ser_dist") ## Default is Spearman ## first two are equal with reverse d <- ser_dist(x) expect_true(all(d >= 0)) expect_equal(d[1], 0) ## first two are largest distance (2) w/o reverse d_norev <- ser_dist(x, reverse = FALSE) expect_true(all(d_norev >= 0)) expect_equal(d_norev[1], 2) ## x,y interface d <- ser_dist(x[[1]], x[[2]]) expect_equal(d[1], 0) ## Manhattan is 100 times 50 difference d <- ser_dist(x, method = "Manhattan", reverse = FALSE) expect_true(all(d >=0)) expect_equal(d[1], 100*50) d <- ser_dist(x, method = "Manhattan") expect_true(all(d >=0)) expect_equal(d[1], 0) ## Hamming is 100 d <- ser_dist(x, method = "Hamming", reverse = FALSE) expect_true(all(d >=0)) expect_equal(d[1], 100) d <- ser_dist(x, method = "Hamming") expect_true(all(d >=0)) expect_equal(d[1], 0) ## PPC (reverse has no effect on PPC) d <- ser_dist(x, method = "PPC") expect_true(all(d >=0)) expect_equal(d[1], 0) ## test correlations context("ser_cor") ## Default is Spearman ## sequence with its reverse co <- ser_cor(x[[1]], x[[2]], reverse = FALSE) expect_equal(co, rbind(c(1,-1), c(-1,1))) co <- ser_cor(x, reverse = FALSE) expect_identical(dim(co), rep(length(x), 2)) expect_true(all(co >=-1 & co <=1)) expect_equivalent(co[1:2,1:2], rbind(c(1,-1), c(-1,1))) co <- ser_cor(x) expect_true(all(co >=-1 & co <=1)) expect_equivalent(co[1:2,1:2], rbind(c(1,1), c(1,1))) ### PPC co <- ser_cor(x, method ="PPC") expect_true(all(co >=-1 & co <=1)) expect_equivalent(co[1:2,1:2], rbind(c(1,1), c(1,1))) ## test p-value co <- ser_cor(x, test = TRUE) expect_equivalent(attr(co, "p-value")[1:2,1:2], matrix(0, nrow=2, ncol=2)) co <- ser_cor(x, reverse = TRUE, test = TRUE) expect_equivalent(attr(co, "p-value")[1:2,1:2], matrix(0, nrow=2, ncol=2)) seriation/tests/testthat/test-permuation_vector.R0000644000176200001440000000534212706530423022124 0ustar liggesuserslibrary(seriation) set.seed(0) context("ser_permutation_vector") p <- sample(1:10) sp <- ser_permutation_vector(p, method="valid") expect_identical(length(sp), 10L) expect_identical(get_order(sp), p) expect_identical(get_order(rev(sp)), rev(p)) expect_error(ser_permutation_vector(c(1:10, 12L), method="invalid"), "Invalid permutation vector!") expect_error(ser_permutation_vector(c(1:10, 3L), method="invalid"), "Invalid permutation vector!") context("ser_permutation") expect_identical(length(ser_permutation(sp)), 1L) expect_identical(length(ser_permutation(sp, sp)), 2L) hc <- hclust(dist(runif(10))) expect_identical(length(ser_permutation(sp, hc)), 2L) hc <- ser_permutation_vector(hc, method="hc") expect_identical(length(ser_permutation(sp, hc, sp)), 3L) expect_identical(length(ser_permutation(ser_permutation(sp), 1:10)), 2L) context("permute") ## vector expect_identical(permute(1:10, ser_permutation(1:10)), 1:10) expect_identical(permute(LETTERS[1:10], ser_permutation(1:10)), LETTERS[1:10]) expect_identical(permute(1:10, ser_permutation(10:1)), 10:1) expect_identical(permute(LETTERS[1:10], ser_permutation(10:1)), LETTERS[10:1]) expect_error(permute(1:10, ser_permutation(1:11))) ## matrix m <- matrix(runif(9), ncol=3) expect_identical(permute(m, ser_permutation(1:3, 3:1)), m[,3:1]) expect_identical(permute(m, ser_permutation(3:1, 3:1)), m[3:1,3:1]) expect_error(permute(m, ser_permutation(1:10, 1:9))) expect_error(permute(m, ser_permutation(1:9, 1:11))) ## dist d <- dist(matrix(runif(25), ncol=5)) attr(d, "call") <- NULL ### permute removes the call attribute expect_identical(permute(d, ser_permutation(1:5)), d) ### is_equivalent_to ignores attributes expect_equivalent(permute(d, ser_permutation(5:1)), as.dist(as.matrix(d)[5:1,5:1])) expect_error(permute(d, ser_permutation(1:8))) ## list l <- list(a = 1:10, b = letters[1:5], 25) expect_identical(permute(l, 3:1), rev(l)) ## dendrogram dend <- as.dendrogram(hclust(d)) expect_equal(dend, permute(dend, order.dendrogram(dend))) expect_equal(rev(dend), permute(dend, rev(order.dendrogram(dend)))) # chances are that a random order will not be perfect o <- sample(5) expect_warning(permute(dend, o)) ## hclust hc <- hclust(d) expect_equal(hc, permute(hc, get_order(hc))) ### Note: rev for hclust adds labels! (So we only compare merge, height and order) #expect_equal(rev(hc), permute(hc, rev(get_order(hc)))) expect_equal(rev(hc)[1:3], permute(hc, rev(get_order(hc)))[1:3]) expect_warning(permute(hc, o)) context("permutation_matrix2vector") pv <- 1:5 pm <- permutation_vector2matrix(pv) expect_true(all(diag(pm) == 1)) pv <- sample(1:100) ## convert into a permutation matrix pm <- permutation_vector2matrix(pv) ## convert back expect_identical(permutation_matrix2vector(pm), pv) seriation/tests/testthat/test-seriate.R0000644000176200001440000000151212606356654020021 0ustar liggesuserslibrary(seriation) x <- matrix(c( 1,1,0,0,0, 1,1,1,0,0, 0,0,1,1,1, 1,0,1,1,1 ), byrow=TRUE, ncol=5) d <- dist(x) context("seriate_dist") methods <- list_seriation_methods(kind = "dist") os <- sapply(methods, function(m) { cat("Doing ", m, " ... ") tm <- system.time(o <- seriate(d, method = m)) cat("took ", tm[3],"s.\n") o }) ### Stress test to find memory access problems with randomized algorithms #context("memory stress test") #replicate(1000, seriate(d, method="bburcg")) #replicate(1000, seriate(d, method="bbwrcg")) #replicate(1000, seriate(d, method="arsa")) context("seriate_matrix") methods <- list_seriation_methods(kind = "matrix") os <- lapply(methods, function(m) { cat("Doing ", m, " ... ") tm <- system.time(o <- seriate(x, method = m)) cat("took ", tm[3],"s.\n") o }) names(os) <- methods seriation/tests/testthat/test-DendSer_GA.R0000644000176200001440000000025312644271517020255 0ustar liggesuserslibrary(seriation) ## just check if we can register them ## somehow this registers them before! #context("DendSer") #register_DendSer() #context("GA") #register_GA() seriation/tests/testthat/test-criterion.R0000644000176200001440000000463012756150323020356 0ustar liggesuserslibrary(seriation) m <- matrix(c( 1,1,0,0,0, 1,1,1,0,0, 0,0,1,1,1, 1,0,1,1,1 ), byrow=TRUE, ncol=5) d <- dist(m) as.matrix(d) context("criterion") expect_equal(criterion(d,method="AR_events"), structure(2, names="AR_events")) ## 2 expect_equal(criterion(d,method="Path_length"), structure(4, names="Path_length")) ## 1+2+1=4 expect_equal(criterion(d,method="Lazy_path_length"), structure(8, names="Lazy_path_length")) ## (4-1)*1 + (4-2)*2+ (4-3)*1 = 8 expect_true(round(criterion(d, method="AR_deviations"), 6) - 0.504017 < 1e-10) ## 2.000000 - 1.732051 + 2.236068 - 2.000000 = 0.504017 expect_equal(criterion(d, method="Gradient_raw"), structure(4,names="Gradient_raw")) ## 6 - 2 = 4 expect_true(round(criterion(d, method="Gradient_weighted"), 6) - 3.968119 < 1e-10) ## -1 *(1.000000 - 2.236068 + 1.000000 - 2.000000 + 2.236068 - 2.000000 + 2.000000 - 1.732051 + 1.000000 - 1.732051 + 1.000000 - 2.000000 + 1.732051 - 2.000000 + 2.000000 - 2.236068) ## = 3.968119 ## test stress expect_equal(round(criterion(d, method="Neumann"), 3), structure(7.787, names="Neumann_stress")) expect_equal(round(criterion(d, method="Moore"), 3), structure(11.539, names="Moore_stress")) expect_equal(criterion(m, method="Neumann"), structure(22, names="Neumann_stress")) expect_equal(criterion(m, method="Moore"), structure(44, names="Moore_stress")) ## RGAR ## for w = 2 -> 1/4 ## for w = 3 -> 2/8 expect_error(criterion(d, method="RGAR", w=1)) expect_error(criterion(d, method="RGAR", w=4)) expect_equivalent(criterion(d, method="RGAR", pct=0), .25) expect_equivalent(criterion(d, method="RGAR", w=2), .25) expect_equivalent(round(criterion(d, method="RGAR", pct=100), 3), .25) expect_equivalent(round(criterion(d, method="RGAR", w=3), 3), .25) expect_equivalent(criterion(d, method="RGAR", w=3, relative = FALSE), 2) ### BAR expect_error(criterion(d, method="BAR", b=0), "Band") expect_error(criterion(d, method="BAR", b=4), "Band") # b=1 -> Ham. path length expect_equivalent(criterion(d, method="BAR", b=1), criterion(d, method="Path_length")) # b = n-1 -> ARc expect_equivalent(round(criterion(d, method="BAR", b=3), 3), 21.936) ### Cor R m <- diag(100) expect_equivalent(criterion(m, method="Cor_R"), 1.0) expect_equivalent(criterion(m[nrow(m):1,], method="Cor_R"), -1.0) # this should be close to 0 set.seed(1234) r <- replicate(100, criterion(m[sample(nrow(m)),], method="Cor_R")) # hist(r) expect_true(abs(mean(r)) < 0.1) seriation/tests/testthat.R0000644000176200001440000000010212636327277015404 0ustar liggesuserslibrary("testthat") library("seriation") test_check("seriation") seriation/src/0000755000176200001440000000000013531261201013030 5ustar liggesusersseriation/src/bea.f0000644000176200001440000002622513473550324013751 0ustar liggesusers subroutine rbea(n,m,a,istart,b,ib,ifin) c Reorder rows using BEA, bond energy algorithm. dimension a(n,m), b(n,m), ib(n), ifin(n) c------------------------------------------------------------------------------ c a(n,m) input matrix, rows of which are to be permuted c istart 1st row to be placed c b(n,m) permuted rows to be stored in this array c ib(n) integer list giving permutation carried out c ifin(n) book-keeping vector: is row still active, or has it been c placed (resp. = 1, = 0). c------------------------------------------------------------------------------ c Bond energy algorithm -- see: c c (1) W.T. McCormick, P.J. Schweitzer and T.W. White, c "Problem decomposition and data reorganization by a clustering c technique", Oper. Res., vol. 20, pp. 993-1009, Sept./Oct. 1972. c (2) P. Arabie and L.J. Hubert, c "The bond energy algorithm revisited", IEEE Trans. Syst. Man c Cybern., vol. 20, pp. 268-274, 1990. c (3) P. Arabie, S. Schleutermann, J. Daws and L. Hubert, c "Marketing applications of sequencing and partitioning of c nonsymmetric and/or two-mode matrices", in W. Gaul and M. Schader, c Eds., Data Analysis, Decision Support, and Expert Knowledge c Representation in Marketing, Springer Verlag, 1988, pp. 215-224. c c Implemented by F. Murtagh, Sept. 1991. c------------------------------------------------------------------------------ c c Flags to indicate if row already chosen; 1 = not yet chosen/placed. do 200 i = 1, n ifin(i) = 1 200 continue c c Anticipate 1st placement. 'nplace' = # rows placed. 'nrem' = # remaining. nplace = 1 nrem = n-1 c c Place 1st row ifin(istart) = 0 ib(nplace) = istart do 300 j = 1, m b(1,j) = a(istart,j) 300 continue c 400 continue sim = -100000.0 insrt = 0 c 'nplace' rows have been placed. c Now want next placement. Have 'nrem' rows still to place. do 900 irow = 1, n if (ifin(irow).eq.1) then c For all still-to-be-placed rows... c 1. Place right at beg.: sim1 = 0.0 do 500 j = 1, m sim1 = sim1 + a(irow,j)*b(1,j) 500 continue c 2. Place right at end: if (nplace.gt.1) then sim2 = 0.0 do 600 j = 1, m sim2 = sim2 + a(irow,j)*b(nplace,j) 600 continue endif c 3. Place between k and k+1, where k = 1, ..., nplace-1: if (nplace.ge.2) then do 800 k = 1, nplace-1 c Path length involves sim with k'th and with k+1'th rows c in 'b'; i.e. b(k,j) and b(k+1,j), for all j. c Sim is with a(irow,j), for all j. sim3 = 0.0 do 700 j = 1, m sim3 = sim3 + a(irow,j)*(b(k,j)+b(k+1,j)) 700 continue if (sim3.gt.sim) then sim = sim3 insrt = k iplrow = irow endif 800 continue endif c c Scale up 'sim1' and 'sim2' relative to 'sim', since former c are based on one link only sim1 = sim1*2.0 sim2 = sim2*2.0 c Use 'sim' and 'insrt' to store final info on row to place. if (sim1.gt.sim) then sim = sim1 insrt = 0 iplrow = irow endif c .ge. in following, to force tied case to end if (sim2.ge.sim) then sim = sim2 insrt = nplace+1 iplrow = irow endif endif 900 continue c c So now, we want to make placement in location 'insrt+1' c 1. This happens to be right at beginning: if (insrt.eq.0) then c Shift right do 1100 l = nplace+1, 2, -1 ib(l) = ib(l-1) do 1000 j = 1, m b(l,j) = b(l-1,j) 1000 continue 1100 continue do 1200 j = 1, m b(1,j) = a(iplrow,j) 1200 continue ifin(iplrow) = 0 nplace = nplace + 1 nrem = nrem - 1 ib(1) = iplrow goto 1900 endif c c 2. Placement happens to be right at end of all current placements: if (insrt.eq.nplace+1) then c Insert after all current placements. do 1300 j = 1, m b(nplace+1,j) = a(iplrow,j) 1300 continue ifin(iplrow) = 0 nplace = nplace + 1 nrem = nrem -1 ib(nplace) = iplrow goto 1900 endif c c 3. If we get to here, new placement is somewhere in the middle. c Shift rows 'insrt+1' to 'nplace', in 'b', right. do 1500 l = nplace+1, insrt+2, -1 ib(l) = ib(l-1) do 1400 j = 1, m b(l,j) = b(l-1,j) 1400 continue 1500 continue do 1600 j = 1, m b(insrt+1,j) = a(iplrow,j) 1600 continue nplace = nplace + 1 nrem = nrem -1 ifin(iplrow) = 0 ib(insrt+1) = iplrow goto 1900 c 1900 continue if (nrem.ge.1) goto 400 c return end c------------------------------------------------------------------------------ subroutine cbea(n,m,a,jstart,b,jb,jfin) c Reoder cols. using BEA, bond energy algorithm. c See references at beg. of routine 'rbea'. dimension a(n,m), b(n,m), jb(m), jfin(m) c------------------------------------------------------------------------------ c a(n,m) input matrix, cols. of which are to be permuted c jstart 1st col. to be placed c b(n,m) permuted cols. to be stored in this array c jb(m) integer list giving permutation carried out c jfin(m) book-keeping vector: is col. still active, or has it been c placed (resp. = 1, = 0). c------------------------------------------------------------------------------ c c Flags to indicate if col. already chosen do 200 j = 1, m jfin(j) = 1 200 continue c c 'nplace' cols. placed (anticipating!); 'nrem' cols. still to be placed. nplace = 1 nrem = m-1 c c Place 1st col. jfin(jstart) = 0 jb(nplace) = jstart do 300 i = 1, n b(i,1) = a(i,jstart) 300 continue c 400 continue sim = -100000.0 insrt = 0 c 'nplace' cols. have been placed. c Now want next placement. Have 'nrem' cols. still to place. do 900 jcol = 1, m if (jfin(jcol).eq.1) then c For all still-to-be-placed cols... c 1. Place right at beg.: sim1 = 0.0 do 500 i = 1, n sim1 = sim1 + a(i,jcol)*b(i,1) 500 continue c 2. Place right at end: if (nplace.gt.1) then sim2 = 0.0 do 600 i = 1, n sim2 = sim2 + a(i,jcol)*b(i,nplace) 600 continue endif c 3. Place between k and k+1, where k = 1, ..., nplace-1: if (nplace.ge.2) then do 800 k = 1, nplace-1 c Path length involves sim with k'th and with k+1'th cols. c in 'b'; i.e. b(i,k) and b(i,k+1), for all i. c Sim is with a(i,jcol), for all i. sim3 = 0.0 do 700 i = 1, n sim3 = sim3 + a(i,jcol)*(b(i,k)+b(i,k+1)) 700 continue if (sim3.gt.sim) then sim = sim3 insrt = k jplcol = jcol endif 800 continue endif c c Scale up 'sim1' and 'sim2' rel. to 'sim' since former are c based on only one link sim1 = 2.0*sim1 sim2 = 2.0*sim2 c Use 'sim' and 'insrt' to store final info. on col. to be placed. if (sim1.gt.sim) then sim = sim1 insrt = 0 jplcol = jcol endif c .ge. in following, to force tied case to end if (sim2.ge.sim) then sim = sim2 insrt = nplace+1 jplcol = jcol endif endif 900 continue c c So now, we want to make placement in location 'insrt+1'. c 1. This happens to be right at beginning. if (insrt.eq.0) then c Shift right do 1100 l = nplace+1, 2, -1 jb(l) = jb(l-1) do 1000 i = 1, n b(i,l) = b(i,l-1) 1000 continue 1100 continue do 1200 i = 1, n b(i,1) = a(i,jplcol) 1200 continue jfin(jplcol) = 0 nplace = nplace + 1 nrem = nrem - 1 jb(1) = jplcol goto 1900 endif c c 2. Placement happens to be right at end of already placed cols. if (insrt.eq.nplace+1) then do 1300 i = 1, n b(i,nplace+1) = a(i,jplcol) 1300 continue jfin(jplcol) = 0 nplace = nplace + 1 nrem = nrem -1 jb(nplace) = jplcol goto 1900 endif c c 3. New col. placement happens to be somewhere in the middle. c Shift cols. 'insrt+1' to 'nplace', in 'b', right. do 1500 l = nplace+1, insrt+2, -1 jb(l) = jb(l-1) do 1400 i = 1, n b(i,l) = b(i,l-1) 1400 continue 1500 continue do 1600 i = 1, n b(i,insrt+1) = a(i,jplcol) 1600 continue nplace = nplace + 1 nrem = nrem -1 jfin(jplcol) = 0 jb(insrt+1) = jplcol goto 1900 c 1900 continue if (nrem.ge.1) goto 400 c return end c-------------------------------------------------------------------------- subroutine energy(n,m,b,ener) dimension b(n,m) c Det. "bond energy" of array b c I.e. product of each elt. with its 4 nearest neighbors, c summed over all elts. ener = 0.0 c Corner elts. ener = ener + b(1,1)*(b(1,2)+b(2,1)) ener = ener + b(1,m)*(b(1,m-1)+b(2,m)) ener = ener + b(n,1)*(b(n-1,1)+b(n,2)) ener = ener + b(n,m)*(b(n-1,m)+b(n,m-1)) c Next non-corner border elts. do 100 j = 2, m-1 ener = ener + b(1,j)*(b(1,j-1)+b(1,j+1)+b(2,j)) ener = ener + b(n,j)*(b(n,j-1)+b(n,j+1)+b(n-1,j)) 100 continue do 200 i = 2, n-1 ener = ener + b(i,1)*(b(i-1,1)+b(i+1,1)+b(i,2)) ener = ener + b(i,m)*(b(i-1,m)+b(i+1,m)+b(i,m-1)) 200 continue c Finally, all non-border elts. do 400 i = 2, n-1 do 300 j = 2, m-1 ener = ener + b(i,j)*(b(i-1,j)+b(i+1,j)+b(i,j-1)+b(i,j+1)) 300 continue 400 continue c return end seriation/src/pathdist.c0000644000176200001440000000275012606356654015043 0ustar liggesusers/* * seriation - Infrastructure for seriation * Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License along * with this program; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ #include #include #include "lt.h" /* Calculate the path distance for iVAT */ /* Note this changes A! */ /* FIXME: INF and NA */ SEXP pathdist_floyd(SEXP R_x) { int *dimX = INTEGER( GET_DIM(R_x) ); int i, j, k, n = dimX[0]; SEXP R_y; double *x = REAL(R_x); double *y; PROTECT(R_y = allocMatrix(REALSXP, dimX[0], dimX[1])); y = REAL(R_y); /* initialize y with paths of length 1 */ for(i=0; i #include /* compute the lenght of an order, i.e. the sum of * the edge weights along the path defined by the * order. * * note that the order is a tour with the leg between * the first and the last city omitted. * * ceeboo 2005 */ static double orderLength(double *x, int *o, int n) { double v, z; int i, j, k; z = 0; /* path length */ i = o[0]; for (k = 0; k < n-1; k++) { j = o[k+1]; if (i > j) v = x[i+j*(n-1)-j*(j+1)/2-1]; else if (i == j) return NA_REAL; else v = x[j+i*(n-1)-i*(i+1)/2-1]; if (!R_FINITE(v)) return NA_REAL; z += v; i = j; } return z; } /* R wrapper */ SEXP order_length(SEXP R_dist, SEXP R_order) { int n, k; int *o; SEXP R_obj; n = 1 + (int) sqrt(2 * LENGTH(R_dist)); if (LENGTH(R_dist) < 1 || LENGTH(R_dist) != n*(n-1)/2) error("order_cost: invalid length"); if (LENGTH(R_order) != n) error("order_length: \"dist\" and \"order\" do not match"); o = Calloc(n, int); for (k = 0; k < n; k++) /* offset to C indexing */ o[k] = INTEGER(R_order)[k]-1; PROTECT(R_obj = NEW_NUMERIC(1)); REAL(R_obj)[0] = orderLength(REAL(R_dist), o, n); Free(o); UNPROTECT(1); return R_obj; } /* check validity of a merge tree representation */ int checkRmerge(int *x, int n) { int k, v; if (x[0] > 0 || x[n-1] > 0) /* initial merge */ return 0; for (k = 0; k < 2*(n-1); k++) { v = x[k]; if (v < -n || v > n-1) return 0; if (v > 0 && v > k+1) return 0; } return 1; } /* Z. Bar-Joseph, E. D. Demaine, D. K. Gifford, and T. Jaakkola. * (2001) Fast Optimal Leaf Ordering for Hierarchical Clustering. * Bioinformatics, Vol. 17 Suppl. 1, pp. 22-29. * * this implementation builds on the improvements of a more recent paper * available at the website of Bar-Joseph! * * as input we exepct a matrix with the distances in the lower triangle, * a merge tree, i.e. two arrays holding n-1 indexes of the left and right * subtrees (or leaves) merged at the kth step (for details see dist and * hclust). * * returns a list with a matrix (merge) and two vectors (order and length). * * The algorithm has the following stages: * * 1) find a leaf ordering consistent with the supplied merge tree. * the order of the leaves of a tree consists of the order of the * leaves in the left subtree followed by the order of the leaves * in the right subtree. * * note that the tree (leaf) indexes must have an offset of one because * the leaves are coded as negative numbers. subtrees are referenced by * their position in the merge sequence (see hclust). this sucks! * * we compute for each left and right subtree the offset of the leftmost * leaf in the total order of leaves, and the number of leaves in both * trees, i.e. in the parent tree. * * 2) recursively compute for each pair of outer endpoints, i.e. a left * endpoint from the left subtree and a right endpoint from the right * subtree the length of the optimal ordering of the leaves. * * the temporary tables are stored in the lower triangle as well as the * similarities. the lengths of the best linear orderings are stored in * the upper triangle. * * for the improved computations at the root the diagonal is used as * storage for temporary results. * * the time complexity of finding all the partial optimal leaf orderings * is O(n^3). * * the suggested improvement based on early termination of the search is * currently not implemented. however, ties are broken randomly. * * 3) recursively find the total optimal leaf ordering. * * 4) find the merge tree corresponding to the optimal ordering. * * fixme: using similarities would allow a remapping of non-finite * values to zero and thus sanitizing of overflows. also for * missing values this would be a more user friendly approach. * * (C) ceeboo 2005 */ static int calcAllOrder(double *x, int *e, int *oi, int *ok, int *oj, int ci, int ck, int cj, int n) { int i, ii, j, jj, k, kk, h = 0, l; double s, z; for (i = 0; i < ci; i++) { ii = oi[i]; for (j = 0; j < cj; j++) { jj = oj[j]; l = 0; z = R_PosInf; for (k = 0; k < ck; k++) { kk = ok[k]; if (ii > kk) s = x[kk+ii*n]; else s = x[ii+kk*n]; if (kk > jj) s += x[kk+jj*n]; else s += x[jj+kk*n]; if (s < z) { z = s; h = kk; l = 1; } else if (s == z) { if (unif_rand() > (double) l/(l+1)) h = kk; l++; } } if (!R_FINITE(z)) return 0; /* error */ if (ii > jj) x[jj+ii*n] = z; else x[ii+jj*n] = z; e[ii+jj*n] = h; } } return 1; } static int calcEndOrder(double *x, int *e, int *oi, int *ok, int ci, int ck, int n) { int i, ii, k, kk, h = 0, l; double s, z; for (i = 0; i < ci; i++) { ii = oi[i]; l = 0; z = R_PosInf; for (k = 0; k < ck; k++) { kk = ok[k]; if (ii > kk) s = x[kk+ii*n]; else s = x[ii+kk*n]; if (s < z) { z = s; h = kk; l = 1; } else if (s == z) { if (unif_rand() > (double) l/(l+1)) h = kk; l++; } } if (!R_FINITE(z)) return 0; x[ii+ii*n] = z; e[ii+ii*n] = h; } return 1; } static int debug = FALSE; SEXP order_optimal(SEXP R_dist, SEXP R_merge) { int n, i, ii, j, jj, k, kk, h, a = 0, b = 0; int cl = 0, cll = 0, clr = 0, cr = 0, crl = 0, crr = 0; int *l, *r, *c, *e; int *left, *right, *o, *ol = 0, *oll = 0, *olr = 0, *or = 0, *orl = 0, *orr = 0; double s, z, zz; double *x; SEXP R_obj; n = 1 + (int) sqrt(2 * LENGTH(R_dist)); if (LENGTH(R_dist) < 3 || LENGTH(R_dist) != n*(n-1)/2) error("order_optimal: invalid length"); if (LENGTH(GET_DIM(R_merge)) != 2) error("order_optimal: \"merge\" invalid"); if (INTEGER(GET_DIM(R_merge))[0] != n-1) error("order_optimal: \"dist\" and \"merge\" do not conform"); if (!checkRmerge(INTEGER(R_merge), n)) error("order_optimal: \"merge\" invalid"); /* copy similarities into lower triangle */ x = Calloc(n*n, double); /* data + part order lengths + temporary */ k = 0; for (i = 0; i < n-1; i++) for (j = i+1; j < n; j++) { z = REAL(R_dist)[k++]; if (!R_FINITE(z)) { Free(x); error("order_optimal: \"dist\" invalid"); } else x[j+i*n] = z; } PROTECT(R_obj = NEW_LIST(3)); /* result list */ SET_ELEMENT(R_obj, 0, duplicate(R_merge)); /* merge */ SET_ELEMENT(R_obj, 1, NEW_INTEGER(n)); /* order */ SET_ELEMENT(R_obj, 2, NEW_NUMERIC(1)); /* length */ left = INTEGER(VECTOR_ELT(R_obj, 0)); right = INTEGER(VECTOR_ELT(R_obj, 0))+n-1; o = INTEGER(VECTOR_ELT(R_obj, 1)); GetRNGstate(); l = Calloc(n, int); /* offset of leftmost leaf of left tree */ r = Calloc(n, int); /* offset of leftmost leaf of right tree; * reverse mapping of order */ c = Calloc(n-1, int); /* number of leaves in a tree */ e = Calloc(n*n, int); /* inner endpoints */ /* for each tree count the number of leaves. */ for (k = 0; k < n-1; k++) { if (left[k] > 0) c[k] += c[left[k]-1]; else c[k] = 1; if (right[k] > 0) c[k] += c[right[k]-1]; else c[k] += 1; } /* backpropagate the counts to obtain the current * leaf order and the offset of the leftmost leaf * of the left and right subtree. */ for (k = n-2; k >= 0; k--) { if (left[k] > 0) { h = l[k] + c[left[k]-1]; if (right[k] > 0) l[right[k]-1] = h; else o[h] = -right[k]-1; l[left[k]-1] = l[k]; } else { h = l[k] + 1; if (right[k] > 0) l[right[k]-1] = h; else o[h] = -right[k]-1; o[l[k]] = -left[k]-1; } r[k] = h; } /* determine for each subtree the optimal order * for each pair of left and right endpoints * (leaves). this is done in the order provided * by the merge tree. */ for (k = 0; k < n-1; k++) { ol = o + l[k]; /* order of left subtree */ or = o + r[k]; /* order of right subtree */ cl = r[k] - l[k]; /* number of leaves in left subtree */ cr = c[k] - cl; /* number of leaves in right subtree */ if (cl > 1) { /* a left tree */ h = left[k]-1; oll = o + l[h]; olr = o + r[h]; cll = r[h] - l[h]; clr = c[h] - cll; } else { /* a left leaf */ oll = olr = ol; cll = clr = cl; } if (cr > 1) { /* a right tree */ h = right[k]-1; orl = o + l[h]; orr = o + r[h]; crl = r[h] - l[h]; crr = c[h] - crl; } else { /* a right leaf */ orl = orr = or; crl = crr = cr; } if (k == n-2) /* optimized search at the root */ break; /* compute temporary sums for all endpoints */ if (!calcAllOrder(x, e, oll, olr, or, cll, clr, cr, n)) { Free(x); Free(r); Free(l); Free(c); Free(e); error("order_optimal: non-finite values"); } if (olr != oll) if (!calcAllOrder(x, e, olr, oll, or, clr, cll, cr, n)) { Free(x); Free(r); Free(l); Free(c); Free(e); error("order_optimal: non-finite values"); } /* copy temporary sums to lower triangle */ for (i = 0; i < cl; i++) { ii = ol[i]; for (j = 0; j < cr; j++) { jj = or[j]; if (ii > jj) x[ii+jj*n] = x[jj+ii*n]; else x[jj+ii*n] = x[ii+jj*n]; } } /* compute best orders for all endpoints */ if (!calcAllOrder(x, e, orl, orr, ol, crl, crr, cl, n)) { Free(x); Free(r); Free(l); Free(c); Free(e); error("order_optimal: non-finite values"); } if (orr != orl) if (!calcAllOrder(x, e, orr, orl, ol, crr, crl, cl, n)) { Free(x); Free(r); Free(l); Free(c); Free(e); error("order_optimal: non-finite values"); } /* now that we know both endpoints we can store * the inner endpoint from the left tree at the * correct addresse. */ for (i = 0; i < cr; i++) { ii = or[i]; for (j = 0; j < cl; j++) { jj = ol[j]; kk = e[ii+jj*n]; if (ii > jj) x[ii+jj*n] = (double) e[jj+kk*n]; else x[jj+ii*n] = (double) e[jj+kk*n]; } } /* copy back */ for (i = 0; i < cl; i++) { ii = ol[i]; for (j = 0; j < cr; j++) { jj = or[j]; if (ii > jj) e[ii+jj*n] = (int) x[ii+jj*n]; else e[ii+jj*n] = (int) x[jj+ii*n]; } } } /* find the best linear order for each endpoint * of the left and right subtree of the root */ if (!calcEndOrder(x, e, oll, olr, cll, clr, n)) { Free(x); Free(r); Free(l); Free(c); Free(e); error("order_optimal: non-finite values"); } if (olr != oll) if (!calcEndOrder(x, e, olr, oll, clr, cll, n)) { Free(x); Free(r); Free(l); Free(c); Free(e); error("order_optimal: non-finite values"); } if (!calcEndOrder(x, e, orl, orr, crl, crr, n)) { Free(x); Free(r); Free(l); Free(c); Free(e); error("order_optimal: non-finite values"); } if (orr != orl) if (!calcEndOrder(x, e, orr, orl, crr, crl, n)) { Free(x); Free(r); Free(l); Free(c); Free(e); error("order_optimal: non-finite values"); } /* find the best linear order at the root */ k = 0; z = R_PosInf; for (i = 0; i < cl; i++) { ii = ol[i]; zz = x[ii+ii*n]; for (j = 0; j < cr; j++) { jj = or[j]; s = zz + x[jj+jj*n]; if (ii > jj) s += x[ii+jj*n]; else s += x[jj+ii*n]; if (s < z) { z = s; a = ii; b = jj; k = 1; } else if (s == z) { if (unif_rand() > (double) k/(k+1)) { a = ii; b = jj; } k++; } } if (!R_FINITE(z)) { Free(x); Free(r); Free(l); Free(c); Free(e); error("order_optimal: non-finite values"); } } REAL(VECTOR_ELT(R_obj, 2))[0] = z; /* set length */ /* the order can be found by double recursion. * for this we use a stack, one for the left * and one for the right endpoints. */ l[0] = b; /* push endpoints of right tree on the stack*/ r[0] = e[b+b*n]; i = e[a+a*n]; /* start with endpoints of left tree */ j = a; h = 0; k = 1; while (h < n) { if (i == j) { /* backtrack */ o[h++] = i; k--; if (k < 0) break; i = l[k]; /* pop endpoints */ j = r[k]; } else { l[k] = e[j+i*n]; /* push endpoints of right tree on the stack */ r[k] = j; k++; j = e[i+j*n]; /* recurse left tree */ } } /* adjust the merge tree to the optimal order * * 1) for each pair of leaves from a left and right * subtree the order relation is the same. thus, * use the leftmost leaves as representatives. * * 2) if the order is reversed we must swap the * subtrees at the parent. */ for (k = 0; k < n; k++) /* reverse mapping of optimal order */ r[o[k]] = k; for (k = 0; k < n-1; k++) { if (left[k] > 0) /* left leaf in left subtree */ i = l[left[k]-1]; else i = -left[k]-1; if (right[k] > 0) /* left leaf in right subtree */ j = l[right[k]-1]; else j = -right[k]-1; if (r[i] > r[j]) { /* swap the subtrees */ h = right[k]; right[k] = left[k]; left[k] = h; } l[k] = i; /* left leaf in parent tree */ } for (k = 0; k < n; k++) /* offset to R indexing */ o[k]++; if (debug) { i = e[a+a*n]; j = e[b+b*n]; if (i > j) x[j+i*n] = z; else x[i+j*n] = z; for (k = 0; k < n-1; k++) { if (left[k] > 0) l[k] = l[left[k]-1]; else l[k] = -left[k]-1; if (right[k] > 0) r[k] = r[right[k]-1]; else r[k] = -right[k]-1; i = l[k]; j = r[k]; if (i > j) z = x[j+i*n]; else z = x[i+j*n]; Rprintf(" %3i | %4i %4i | %3i %3i | %f\n", k+1, left[k], right[k], i+1, j+1, z); } } Free(x); Free(l); Free(r); Free(c); Free(e); PutRNGstate(); UNPROTECT(1); return R_obj; } /**/ seriation/src/init.c0000644000176200001440000000532613475760615014171 0ustar liggesusers#include #include #include // for NULL #include /* .Call calls */ extern SEXP ar(SEXP, SEXP, SEXP); extern SEXP bar(SEXP, SEXP, SEXP); extern SEXP gradient(SEXP, SEXP, SEXP); extern SEXP inertia_criterion(SEXP, SEXP); extern SEXP lazy_path_length(SEXP, SEXP); extern SEXP least_squares_criterion(SEXP, SEXP); extern SEXP order_greedy(SEXP); extern SEXP order_length(SEXP, SEXP); extern SEXP order_optimal(SEXP, SEXP); extern SEXP pathdist_floyd(SEXP); extern SEXP reorder_dist(SEXP, SEXP); extern SEXP rgar(SEXP, SEXP, SEXP, SEXP); extern SEXP stress(SEXP, SEXP, SEXP, SEXP); /* .Fortran calls */ extern void F77_NAME(arsa)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(bburcg)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(bbwrcg)(void *, void *, void *, void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(cbea)(void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(rbea)(void *, void *, void *, void *, void *, void *, void *); extern void F77_NAME(energy)(void *, void *, void *, void *); static const R_CallMethodDef CallEntries[] = { {"ar", (DL_FUNC) &ar, 3}, {"bar", (DL_FUNC) &bar, 3}, {"gradient", (DL_FUNC) &gradient, 3}, {"inertia_criterion", (DL_FUNC) &inertia_criterion, 2}, {"lazy_path_length", (DL_FUNC) &lazy_path_length, 2}, {"least_squares_criterion", (DL_FUNC) &least_squares_criterion, 2}, {"order_greedy", (DL_FUNC) &order_greedy, 1}, {"order_length", (DL_FUNC) &order_length, 2}, {"order_optimal", (DL_FUNC) &order_optimal, 2}, {"pathdist_floyd", (DL_FUNC) &pathdist_floyd, 1}, {"reorder_dist", (DL_FUNC) &reorder_dist, 2}, {"rgar", (DL_FUNC) &rgar, 4}, {"stress", (DL_FUNC) &stress, 4}, {NULL, NULL, 0} }; static const R_FortranMethodDef FortranEntries[] = { {"arsa", (DL_FUNC) &F77_NAME(arsa), 15}, {"bburcg", (DL_FUNC) &F77_NAME(bburcg), 10}, {"bbwrcg", (DL_FUNC) &F77_NAME(bbwrcg), 10}, {"cbea", (DL_FUNC) &F77_NAME(cbea), 7}, {"rbea", (DL_FUNC) &F77_NAME(rbea), 7}, {"energy", (DL_FUNC) &F77_NAME(energy), 4}, {NULL, NULL, 0} }; void R_init_seriation(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, FortranEntries, NULL); R_useDynamicSymbols(dll, FALSE); } seriation/src/RNG_wrapper.c0000644000176200001440000000052012606356654015402 0ustar liggesusers/* FORTRAN Wrapper for R RNG */ #include void F77_SUB(getrngstate)(void) { GetRNGstate(); } void F77_SUB(putrngstate)(void) { PutRNGstate(); } /* Note: R's unif_rand returns 0<=x<=1 while FORTRAN's RAND returns 0<=x<1 */ void F77_SUB(unifrand)(float* x) { do{ *x = (float) unif_rand(); }while(*x >= 1.0 || *x <0.0); } seriation/src/criterion.c0000644000176200001440000002053113055155356015211 0ustar liggesusers/* * seriation - Infrastructure for seriation * Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License along * with this program; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ #include #include #include #include #include "lt.h" typedef enum {false = 0, true = 1} bool; /* * path length can be found in optimal.c */ /* * least-squares criterion */ SEXP least_squares_criterion(SEXP R_dist, SEXP R_order) { double sum = 0.0; int p = INTEGER(getAttrib(R_dist, install("Size")))[0]; int *o = INTEGER(R_order); double *dist = REAL(R_dist); double x = 0.0; SEXP R_out; /* since d ist symmetric we only need to sum up half the matrix */ for (int i = 1; i <= p; i++) { for (int j = 1; j < i; j++) { x = (dist[LT_POS(p, o[i-1], o[j-1])] - abs(i-j)); sum += x*x; } } sum *= 2.0; PROTECT(R_out = allocVector(REALSXP, 1)); REAL(R_out)[0] = sum; UNPROTECT(1); return(R_out); } /* * inertia criterion */ SEXP inertia_criterion(SEXP R_dist, SEXP R_order) { double sum = 0.0; int p = INTEGER(getAttrib(R_dist, install("Size")))[0]; int *o = INTEGER(R_order); double *dist = REAL(R_dist); int x = 0; SEXP R_out; /* since d ist symmetric we only need to sum up half the matrix */ for (int i = 1; i <= p; i++) { for (int j = 1; j < i; j++) { x = abs(i-j); sum += dist[LT_POS(p, o[i-1], o[j-1])] * x*x; } } sum *= 2.0; PROTECT(R_out = allocVector(REALSXP, 1)); REAL(R_out)[0] = sum; UNPROTECT(1); return(R_out); } /* * Anti-Robinson Events */ SEXP ar(SEXP R_dist, SEXP R_order, SEXP R_which) { /* * which indicates the weighing scheme * 1 ... no weighting (i) * 2 ... abs. deviations (s) * 3 ... weighted abs. deviations (w) */ int p = INTEGER(getAttrib(R_dist, install("Size")))[0]; int *o = INTEGER(R_order); double *dist = REAL(R_dist); int which = INTEGER(R_which)[0]; double sum = 0.0; double d_ij = 0.0; double d_ik = 0.0; SEXP R_out; /* sum_i=1^p sum_j d_ik) * weight */ for (int i = 1; i < (p-1); i++) { for(int j = i+1; j < p; j++) { d_ij = dist[LT_POS(p, o[i-1], o[j-1])]; for(int k = j+1; k <= p; k++) { d_ik = dist[LT_POS(p, o[i-1], o[k-1])]; if(d_ij > d_ik) { if(which == 1) { sum++; }else if(which == 2) { sum += fabs(d_ij - d_ik); }else if(which == 3) sum += abs(o[j-1]-o[k-1]) * fabs(d_ij - d_ik); } } } } PROTECT(R_out = allocVector(REALSXP, 1)); REAL(R_out)[0] = sum; UNPROTECT(1); return(R_out); } /* * Relative Generalized Anti-Robinson Events */ SEXP rgar(SEXP R_dist, SEXP R_order, SEXP R_w, SEXP R_relative) { int n = INTEGER(getAttrib(R_dist, install("Size")))[0]; int *o = INTEGER(R_order); int relative = INTEGER(R_relative)[0]; double *dist = REAL(R_dist); /* w is in [2, n-1] (window size) */ int w = INTEGER(R_w)[0]; double d_ij = 0.0; double d_ik = 0.0; int ar = 0; /* AR events */ int total = 0; /* total number of possible AR events */ int i, j, k; SEXP R_out; /* sum_i=1^n sum_{(i-w)<=j d_ik) * weight */ for (i = 1; i <= (n-2); i++) { /* Rprintf("i2=%d\n", i); */ for(j = i+1; j <= MIN(i+w-1, n-1); j++) { /* Rprintf("j2=%d\n", j); */ d_ij = dist[LT_POS(n, o[i-1], o[j-1])]; for(k = j+1; k <= MIN(i+w, n); k++) { /* Rprintf("k2=%d\n\n", k); */ d_ik = dist[LT_POS(n, o[i-1], o[k-1])]; total++; if(d_ij > d_ik) ar++; } } } /* Note: total = (2/3-n)*w + n*w^2 - 2/3*w^3 */ PROTECT(R_out = allocVector(REALSXP, 1)); if(relative) REAL(R_out)[0] = (double) ar / (double) total; else REAL(R_out)[0] = (double) ar; UNPROTECT(1); return(R_out); } /* * Gradient Measure */ SEXP gradient(SEXP R_dist, SEXP R_order, SEXP R_which) { /* * which indicates the weighing scheme * 1 ... no weighting * 2 ... weighted */ int p = INTEGER(getAttrib(R_dist, install("Size")))[0]; int *o = INTEGER(R_order); double *dist = REAL(R_dist); int which = INTEGER(R_which)[0]; double sum = 0.0; double d_ij = 0.0; double d_ik = 0.0; double d_kj = 0.0; double diff; SEXP R_out; int i, k, j; /* sum_i 1) { /* weighted */ sum += diff; }else{ /* unweighted */ if(diff > 0) sum += 1.0; else if(diff < 0) sum -= 1.0; } /* second sum */ d_kj = dist[LT_POS(p, o[k-1], o[j-1])]; /* diff = d_kj - d_ij; seems to be wrong in the book*/ diff = d_ij - d_kj; if(which > 1) { /* weighted */ sum += diff; }else{ /* unweighted */ if(diff > 0) sum += 1.0; else if(diff < 0) sum -= 1.0; } } } } PROTECT(R_out = allocVector(REALSXP, 1)); REAL(R_out)[0] = sum; UNPROTECT(1); return(R_out); } /* * Lazy Path length (see Earle and Hurley 2015) */ SEXP lazy_path_length(SEXP R_dist, SEXP R_order) { double tour_length = 0.0; SEXP R_tour_length; double segment; bool posinf = false; bool neginf = false; int *order = INTEGER(R_order); int n = INTEGER(getAttrib(R_dist, install("Size")))[0]; double *dist = REAL(R_dist); if (n != LENGTH(R_order)) error("length of distance matrix and tour do not match"); for (int i = 1; i <= n-1; i++) { segment = dist[LT_POS(n, order[i-1], order[i])]; // check Inf if (segment == R_PosInf) posinf = true; else if (segment == R_NegInf) neginf = true; else tour_length += (n-i) * segment; } // do not close tour! // inf if (posinf && neginf) tour_length = NA_REAL; else if (posinf) tour_length = R_PosInf; else if (neginf) tour_length = R_NegInf; // create R object PROTECT(R_tour_length = NEW_NUMERIC(1)); REAL(R_tour_length)[0] = tour_length; UNPROTECT(1); return R_tour_length; } /* * Banded Anti-Robinson Form (see Earle and Hurley, 2015) */ SEXP bar(SEXP R_dist, SEXP R_order, SEXP R_b) { int n = INTEGER(getAttrib(R_dist, install("Size")))[0]; int *o = INTEGER(R_order); double *dist = REAL(R_dist); /* 1 <= b < n */ int b = INTEGER(R_b)[0]; double ar = 0; int i, j; SEXP R_out; /* sum_{|i-j|<=b} (b+1-|i-j|) d_{ij} */ for (i = 1; i <= n-1; i++) { for (j = i+1; j <= MIN(i+b, n); j++) { ar += (b+1-abs(i-j)) * dist[LT_POS(n, o[i-1], o[j-1])]; } } // create R object PROTECT(R_out = NEW_NUMERIC(1)); REAL(R_out)[0] = ar; UNPROTECT(1); return R_out; } seriation/src/stress.c0000644000176200001440000002237012606356654014546 0ustar liggesusers/* * seriation - Infrastructure for seriation * Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License along * with this program; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ #include #include /* compute the stress measure based on Moor Neighborhoods, i.e. the * sums of the squared distances of a point to its eight (five at the * margins and three at the corners) adjacent neighbors as defined by * the row and column indexes (or subsets of it). * * this function counts each edge distance only once! so, if you * prefer the measure from the paper you have to take twice the * value. * * note that NAs are omitted. however, the function does not return * NA if there was no legal edge at all. */ double stressMoore(double *x, int *r, int *c, int nr, int nc, int nrx) { double d, v, z; int i, j, l, ll, k, kk; z = 0; l = r[0]; for (i = 0; i < nr-1; i++) { ll = r[i+1]; k = c[0] * nrx; for (j = 0; j < nc-1; j++) { kk = c[j+1] * nrx; v = x[l+k]; if (!ISNAN(v)) { d = v - x[ll+k]; if (!ISNAN(d)) z += d * d; d = v - x[ll+kk]; if (!ISNAN(d)) z += d * d; d = v - x[l+kk]; if (!ISNAN(d)) z += d * d; } d = x[ll+k] - x[l+kk]; k = kk; if (!ISNAN(d)) z += d * d; } d = x[l+k] - x[ll+k]; l = ll; if (!ISNAN(d)) z += d * d; R_CheckUserInterrupt(); } k = c[0] * nrx; for (j = 0; j < nc-1; j++) { kk = c[j+1] * nrx; d = x[l+k] - x[l+kk]; k = kk; if (!ISNAN(d)) z += d * d; } return z; } /* same as above but use a von Neumann neighborhood, i.e. the * neighboring points on the diagonals are excluded. */ double stressNeumann(double *x, int *r, int *c, int nr, int nc, int nrx) { double d, v, z; int i, j, l, ll, k, kk; z = 0; l = r[0]; for (i = 0; i < nr-1; i++) { ll = r[i+1]; k = c[0] * nrx; for (j = 0; j < nc-1; j++) { kk = c[j+1] * nrx; v = x[l+k]; if (!ISNAN(v)) { d = v - x[ll+k]; if (!ISNAN(d)) z += d * d; d = v - x[l+kk]; if (!ISNAN(d)) z += d * d; } k = kk; } d = x[l+k] - x[ll+k]; l = ll; if (!ISNAN(d)) z += d * d; R_CheckUserInterrupt(); } k = c[0] * nrx; for (j = 0; j < nc-1; j++) { kk = c[j+1] * nrx; d = x[l+k] - x[l+kk]; k = kk; if (!ISNAN(d)) z += d * d; } return z; } /* R wrapper to the stress functions */ SEXP stress(SEXP R_x, SEXP R_r, SEXP R_c, SEXP R_type) { int nrx, nr, nc; int k; int *r, *c; SEXP R_obj; /* Translation form character to int index not needed * R part makes sure it is int! PROTECT(R_r = arraySubscript(0, R_r, GET_DIM(R_x), getAttrib, (STRING_ELT), R_x)); PROTECT(R_c = arraySubscript(1, R_c, GET_DIM(R_x), getAttrib, (STRING_ELT), R_x)); */ nrx = INTEGER(GET_DIM(R_x))[0]; /* number of rows */ nr = LENGTH(R_r); nc = LENGTH(R_c); /* remap R indexes to C indexes * this sucks! */ r = Calloc(nr, int); c = Calloc(nc, int); /* copy and shift indexes */ for (k = 0; k < nr; k++) r[k] = INTEGER(R_r)[k]-1; for (k = 0; k < nc; k++) c[k] = INTEGER(R_c)[k]-1; PROTECT(R_obj = NEW_NUMERIC(1)); switch (INTEGER(R_type)[0]) { case 1: REAL(R_obj)[0] = stressMoore(REAL(R_x), r, c, nr, nc, nrx); break; case 2: REAL(R_obj)[0] = stressNeumann(REAL(R_x), r, c, nr, nc, nrx); break; default: Free(r); Free(c); error("stress: type not implemented"); } Free(r); Free(c); /* UNPROTECT(3); */ UNPROTECT(1); return R_obj; } /* NOTE: currently unused */ /* calculate the Moore distances between all pairs of rows or columns. * of a matrix. for a given (fixed) row or column ordering the distances * could be used to search for an optimal column or row ordering using * an alternating scheme. * * if the calculation are over the rows ncx = 1, otherwise the roles * of rows and columns are swapped and nrx = 1. * * the caller must provide the result array d and the temporary array t. * * the distances are arranged in lower triangular column format (compare * the R function dist). * * note that the edge distances are computed only once! * * (C) ceeboo 2005, 2006 */ void distMoore(double *x, int *r, int *c, int nr, int nc, int nrx, int ncx, double *d, double *t) { double v, w, z; int i, ii, j, jj, k, kk, kkk, l; for (k = 0; k < nr*(nr-1)/2; k++) /* initialize distances */ d[k] = 0; for (i = 0; i < nr; i++) { z = 0; ii = r[i] * ncx; kk = c[0] * nrx; for (k = 0; k < nc-1; k++) { kkk = c[k+1] * nrx; w = x[ii+kk] - x[ii+kkk]; if (!ISNAN(w)) z += w * w; kk = kkk; } t[i] = z; R_CheckUserInterrupt(); } l = 0; for (i = 0; i < nr-1; i++) { ii = r[i] * ncx; for (j = i+1; j < nr; j++) { z = t[i] + t[j]; jj = r[j] * ncx; kk = c[0] * nrx; for (k = 0; k < nc-1; k++) { kkk = c[k+1] * nrx; v = x[ii+kk]; if (!ISNAN(v)) { w = v - x[jj+kk]; if (!ISNAN(w)) z += w * w; w = v - x[jj+kkk]; if (!ISNAN(w)) z += w * w; } w = x[jj+kk] - x[ii+kkk]; if (!ISNAN(w)) z += w * w; kk = kkk; } w = x[ii+kk] - x[jj+kk]; if (!ISNAN(w)) z += w * w; d[l++] = z; R_CheckUserInterrupt(); } } } /* calculate the von Neumann distances over the rows or columns of a * matrix. * * compare above. */ void distNeumann(double *x, int *r, int *c, int nr, int nc, int nrx, int ncx, double *d, double *t) { double w, z; int i, ii, j, jj, k, kk, kkk, l; for (k = 0; k < nr*(nr-1)/2; k++) /* initialize distances */ d[k] = 0; for (i = 0; i < nr; i++) { z = 0; ii = r[i] * ncx; kk = c[0] * nrx; for (k = 0; k < nc-1; k++) { kkk = c[k+1] * nrx; w = x[ii+kk] - x[ii+kkk]; if (!ISNAN(w)) z += w * w; kk = kkk; } t[i] = z; R_CheckUserInterrupt(); } l = 0; for (i = 0; i < nr-1; i++) { ii = r[i] * ncx; for (j = i+1; j < nr; j++) { z = t[i] + t[j]; jj = r[j] * ncx; for (k = 0; k < nc-1; k++) { kk = c[k] * nrx; w = x[ii+kk]- x[jj+kk]; if (!ISNAN(w)) z += w * w; } kk = c[k] * nrx; w = x[ii+kk] - x[jj+kk]; if (!ISNAN(w)) z += w * w; d[l++] = z; R_CheckUserInterrupt(); } } } /* R wrapper */ SEXP stress_dist(SEXP R_x, SEXP R_r, SEXP R_c, SEXP R_bycol, SEXP R_type) { int nrx, nr, nc; int k; int *r, *c; double *d, *t; SEXP R_obj = R_NilValue; /* compiler hack */ /* Translation form character to int index not needed * R part makes sure it is int! PROTECT(R_r = arraySubscript(0, R_r, GET_DIM(R_x), getAttrib, (STRING_ELT), R_x)); PROTECT(R_c = arraySubscript(1, R_c, GET_DIM(R_x), getAttrib, (STRING_ELT), R_x)); */ nrx = INTEGER(GET_DIM(R_x))[0]; /* number of rows */ nr = LENGTH(R_r); nc = LENGTH(R_c); /* remap R indexes to C indexes * this sucks! */ r = Calloc(nr, int); c = Calloc(nc, int); /* copy and shift indexes */ for (k = 0; k < nr; k++) r[k] = INTEGER(R_r)[k]-1; for (k = 0; k < nc; k++) c[k] = INTEGER(R_c)[k]-1; switch(LOGICAL(R_bycol)[0]) { case 0: PROTECT(R_obj = NEW_NUMERIC(nr*(nr-1)/2)); d = REAL(R_obj); t = Calloc(nr, double); switch(INTEGER(R_type)[0]) { case 1: distMoore(REAL(R_x), r, c, nr, nc, nrx, 1, d, t); break; case 2: distNeumann(REAL(R_x), r, c, nr, nc, nrx, 1, d, t); break; default: Free(r); Free(c); Free(t); error("stress_dist: \"type\" not implemented"); } Free(t); break; case 1: PROTECT(R_obj = NEW_NUMERIC(nc*(nc-1)/2)); d = REAL(R_obj); t = Calloc(nc, double); switch(INTEGER(R_type)[0]) { case 1: distMoore(REAL(R_x), c, r, nc, nr, 1, nrx, d, t); break; case 2: distNeumann(REAL(R_x), c, r, nc, nr, 1, nrx, d, t); break; default: Free(r); Free(c); Free(t); error("stress_dist: type not implemented"); } Free(t); break; default: Free(r); Free(c); error("stress_dist: \"bycol\" invalid"); } Free(r); Free(c); /* UNPROTECT(3); */ UNPROTECT(1); return R_obj; } seriation/src/bbwrcg.f0000644000176200001440000003022313475271671014470 0ustar liggesusersC ANTI-ROBINSON SERIATION C branch-and-bound C by Brusco, and Stahl, S. C R Interface by Michael Hahsler C PROGRAM DYNAMIC C SUBROUTINE dynamic(N, A, EPS, X) SUBROUTINE bbwrcg(N, A, EPS, X, Q, D, DD, S, UNSEL, IVERB) IMPLICIT INTEGER(A-Z) C DOUBLE PRECISION TIMEA,TIMEB,TIMTOT,A(50,50),EPS DOUBLE PRECISION EPS, A(N,N), D(N,N,N), 1 DD(N,N,N),ZBEST,Z,ACT,DELTA,ZBD,IDX1,IDX2 REAL S1 INTEGER X(N),Q(N),S(N),UNSEL(N) C EPS is unused this is to supress the warning. EPS = 1.0d-07 C Initialize R RNG CALL getrngstate() OLDM=0 CHECKS=0 C C ################################################################# C 10/13/01 This program fits an "weighted" row gradient criterion C to a symmetric proximity matrix. Count +1 if the anti- C Robinson triple is satisfied, -1 if its not, and 0 for C ties. Only look at upper half of matrix C 07/20/02: Improved symmetry test implemented. C 07/26/03: Fixed the incorrect symmetry test, added an interchange test C avoid use of so many "IF" statements using F & D matrices C 12/24/03: Add insertion test to interchange test. C 07/09/15: Fixed memory issue (MFH) C ################################################################# C C OPEN(1,FILE='AMAT.DAT') ! Dissimilarity matrix C OPEN(2,FILE='SEQ.OUT') ! Output file C EPS = 1.0d-07 C READ(1,*) N ! Read number of objects C WRITE(*,*) 'TYPE 1 FOR HALF MATRIX OR TYPE 2 FOR FULL MATRIX' C READ(*,*) ITYPE C ITYPE = 2 C IF(ITYPE.EQ.2) THEN C READ(1,*) ((A(I,J),J=1,N),I=1,N) C ELSE C DO J = 2,N C READ(1,*) (A(I,J),I=1,J-1) C END DO C DO J = 2,N C DO I = 1,J-1 C A(J,I) = A(I,J) C END DO C END DO C END IF C CALL GETTIM (IHR, IMIN, ISEC, I100) C CALL GETDAT (IYR, IMON, IDAY) C TIMEA=DFLOAT(86400*IDAY+3600*IHR+60*IMIN+ISEC)+DFLOAT(I100)/100. DO I = 1,N A(I,I) = 0.0D0 END DO C DO 848 I = 1,N DO 849 J = 1,N IF(I.EQ.J) GO TO 849 DO 850 K = 1,N IF(I.EQ.K.OR.J.EQ.K) GO TO 850 C bbwrg C D(I,J,K) = A(I,K) - A(I,J) D(I,J,K) = 2.*A(I,K) - A(I,J) - A(J,K) 850 CONTINUE 849 CONTINUE 848 CONTINUE C DO 851 I = 1,N DO 852 J = 1,N IF(I.EQ.J) GO TO 852 DO 853 K = 1,N IF(I.EQ.K.OR.J.EQ.K) GO TO 853 ACT=D(I,J,K) IF(D(I,K,J).GT.ACT) ACT = D(I,K,J) IF(D(J,I,K).GT.ACT) ACT = D(J,I,K) DD(I,J,K) = ACT 853 CONTINUE 852 CONTINUE 851 CONTINUE C ZBEST = 0.0D0 C DO 3500 JJJ = 1,100 DO 3500 JJJ = 1,20 DO I = 1,N UNSEL(I) = I Q(I) = 0 END DO NNSEL = N C 3501 CALL RANDOM(S1) C 3501 S1 = rand() 3501 CALL unifrand(S1) ISEL = INT(1. + S1*FLOAT(NNSEL)) IF(ISEL.GT.NNSEL) ISEL = NNSEL Q(NNSEL) = UNSEL(ISEL) DO J = ISEL,NNSEL-1 UNSEL(J) = UNSEL(J+1) END DO NNSEL = NNSEL - 1 IF(NNSEL.GT.0) GO TO 3501 C WRITE(*,72) (Q(J),J=1,N) C 72 FORMAT(20I3) Z = 0.0D0 DO I = 1,N-2 R1 = Q(I) DO J = I+1,N-1 R2 = Q(J) DO K = J+1,N R3 = Q(K) Z = Z + D(R1,R2,R3) END DO END DO END DO 3502 ITRIG = 0 DO II = 1,N-1 DO JJ = II+1,N C R interrupt CALL rchkusr() C R3 = Q(JJ) R2 = Q(II) DELTA=0.0D0 DO I = 1,II-1 R1 = Q(I) DELTA = DELTA + D(R1,R3,R2) - D(R1,R2,R3) DO J = II+1,JJ-1 R4 = Q(J) DELTA = DELTA + D(R1,R3,R4) - D(R1,R2,R4) DELTA = DELTA + D(R1,R4,R2) - D(R1,R4,R3) END DO END DO DO J = II+1,JJ-1 R4 = Q(J) DELTA = DELTA + D(R3,R4,R2) - D(R2,R4,R3) DO K = JJ+1,N R5 = Q(K) DELTA = DELTA + D(R4,R2,R5) - D(R4,R3,R5) DELTA = DELTA + D(R3,R4,R5) - D(R2,R4,R5) END DO END DO DO K = JJ + 1,N R5 = Q(K) DELTA = DELTA + D(R3,R2,R5) - D(R2,R3,R5) END DO DO I = II+1,JJ-2 DO J = I+1,JJ-1 R4A = Q(I) R4B = Q(J) DELTA = DELTA + D(R4A,R4B,R2) - D(R4A,R4B,R3) DELTA = DELTA + D(R3,R4A,R4B) - D(R2,R4A,R4B) END DO END DO IF(DELTA.GT.0) THEN Z = Z + DELTA Q(II) = R3 Q(JJ) = R2 ITRIG = 1 END IF END DO END DO IF(ITRIG.EQ.1) GO TO 3502 IF(Z.GT.ZBEST) ZBEST = Z 3500 CONTINUE C WRITE(2,3505) ZBEST IF (IVERB == 1) THEN C WRITE(*,3505) ZBEST CALL dblepr('HEURISTIC OBJ VALUE', -1, DBLE(ZBEST), 1) ENDIF C 3505 FORMAT(' HEURISTIC OBJ VALUE ',F20.4) Z = ZBEST-1 DO I = 1,N Q(I) = 0 END DO C M=1 Q(M)=1 S(1)=1 trig=1 DO K = 2,N Q(K)=0 END DO C 1 M = M + 1 C C CHECKS=CHECKS+1 IF (IVERB == 1 .AND. M .GT. OLDM) THEN C WRITE (*,6000) M+1, CHECKS CALL intpr('reached position', -1, M+1, 1) CALL intpr('with following number of checks', -1, CHECKS, 1) C 6000 FORMAT('reached position ', I5, ' with ', I9, ' checks') OLDM=M ENDIF C C R interrupt CALL rchkusr() C C main loop C 2 Q(M)=Q(M)+1 C C MFH: Make sure to not get out of bounds with S(Q(M)) - 7/9/15 IF(Q(M).GT.N) GO TO 222 IF(S(Q(M)).EQ.1) GO TO 2 ! REDUNDANCY 222 IF(M.EQ.1.AND.Q(M).GT.N) GO TO 9 ! TERMINATE IF(M.GT.1.AND.Q(M).GT.N) GO TO 7 ! GO TO RETRACTION C only for bbwrcg IF(TRIG.EQ.0.AND.Q(M).EQ.2) GO TO 2 ! SYMMETRY FATHOM C S(Q(M))=1 IF(M.EQ.1) GO TO 1 IF(M.EQ.N-1) THEN CALL EVALBBWRCG(ZBD,Q,N,D) IF(ZBD.GT.Z) THEN Z=ZBD IF (IVERB == 1) THEN C WRITE(*,*) 'Eval =',z CALL dblepr('Eval', -1, DBLE(z), 1) ENDIF DO I = 1,N X(I)=Q(I) END DO END IF Q(N)=0 S(Q(M))=0 GO TO 2 ELSE DO 251 MM = M-1,1,-1 ! Insertion Test R3=Q(M) IDX1=0 IDX2=0 DO I = 1,MM-1 R1=Q(I) DO J = MM,M-1 R4=Q(J) IDX1=IDX1+D(R1,R4,R3) IDX2=IDX2+D(R1,R3,R4) C END DO C END DO C DO 250 I = 1,N IF(S(I).EQ.1) GO TO 250 R5=I C DO J = MM,M-1 R4=Q(J) IDX1=IDX1+D(R4,R3,R5) IDX2=IDX2+D(R3,R4,R5) END DO C 250 CONTINUE C DO J = MM, M-2 DO JJ = J+1, M-1 R4A=Q(J) R4B=Q(JJ) IDX1=IDX1+D(R4A,R4B,R3) IDX2=IDX2+D(R3,R4A,R4B) END DO END DO IF(IDX1.LT.IDX2) THEN S(Q(M))=0 C ism2 = ism2 + 1 GO TO 2 END IF 251 CONTINUE C go to 253 C DO 151 MM = M-2,1,-1 ! Interchange Test R3=Q(M) R2=Q(MM) IDX1=0 IDX2=0 DO J = MM+1,M-1 R4 = Q(J) IDX1=IDX1+D(R2,R4,R3) IDX2=IDX2+D(R3,R4,R2) END DO DO I = 1,MM-1 R1=Q(I) IDX1=IDX1+D(R1,R2,R3) IDX2=IDX2+D(R1,R3,R2) DO J = MM+1,M-1 R4=Q(J) IDX1=IDX1+D(R1,R2,R4) IDX2=IDX2+D(R1,R3,R4) C IDX1=IDX1+D(R1,R4,R3) IDX2=IDX2+D(R1,R4,R2) C END DO C END DO C DO 150 I = 1,N IF(S(I).EQ.1) GO TO 150 R5=I IDX1=IDX1+D(R2,R3,R5) IDX2=IDX2+D(R3,R2,R5) C DO J = MM+1,M-1 R4=Q(J) IDX1=IDX1+D(R2,R4,R5) IDX2=IDX2+D(R3,R4,R5) C IDX1=IDX1+D(R4,R3,R5) IDX2=IDX2+D(R4,R2,R5) END DO C 150 CONTINUE C DO J = MM+1, M-2 DO JJ = J+1, M-1 R4A=Q(J) R4B=Q(JJ) IDX1=IDX1+D(R4A,R4B,R3) IDX2=IDX2+D(R4A,R4B,R2) IDX1=IDX1+D(R2,R4A,R4B) IDX2=IDX2+D(R3,R4A,R4B) END DO END DO IF(IDX1.LT.IDX2) THEN C ism = ism + 1 S(Q(M))=0 GO TO 2 END IF 151 CONTINUE C CALL BOUND2BBWRCG(ZBD,N,Q,M,D,S,DD) IF(ZBD.LE.Z) THEN S(Q(M))=0 C ism3 = ism3 + 1 GO TO 2 END IF IF(Q(M).EQ.1) TRIG=1 GO TO 1 END IF C 7 IF(Q(M).EQ.1) TRIG=0 C MFH: Make sure to not get out of bounds with S(Q(M)) - 6/9/15 IF(Q(M).GT.N) GO TO 777 S(Q(M))=0 777 Q(M)=0 M=M-1 IF(Q(M).EQ.1) TRIG=0 S(Q(M))=0 C C WRITE(*,*) 'X',(X(J),J=1,N) C WRITE(*,*) 'Q',(Q(J),J=1,N) C GO TO 2 C 9 CALL GETTIM (IHR, IMIN, ISEC, I100) C CALL GETDAT (IYR, IMON, IDAY) C TIMEB=DFLOAT(86400*IDAY+3600*IHR+60*IMIN+ISEC)+DFLOAT(I100)/100. C TIMTOT=TIMEB-TIMEA C write(*,*) ism,ism2,ism3 C WRITE(*,69) Z,TIMTOT C 9 WRITE(*,69) Z C WRITE(2,69) Z,TIMTOT C WRITE(2,70) (X(I),I=1,N) C 69 FORMAT(' MAXIMUM UNWEIGHTED ROW GRADIENT INDEX ',I20) C 69 FORMAT(' MAXIMUM UNWEIGHTED ROW GRADIENT INDEX ',I7,' CPU TIME ', C 1 F8.2) C 70 FORMAT(30I3) C 9 IF (IVERB == 1) THEN C PRINT *, 'total number of checks: ', CHECKS CALL intpr('total number of checks', -1, CHECKS, 1) ENDIF C Return R RNG CALL Putrngstate() RETURN END C SUBROUTINE BOUND2BBWRCG(ZBD,N,Q,M,D,S,DD) IMPLICIT INTEGER(A-Z) DOUBLE PRECISION D(N,N,N),ZBD,DD(N,N,N),Z1,Z2,Z3,ZA,ZB, 1 ZCT,N4 C ACT is now unused INTEGER Q(N),S(N) Z1=0 DO I = 1,M-2 R1=Q(I) DO J = I+1,M-1 R2=Q(J) DO K = J+1,M R3=Q(K) Z1=Z1+D(R1,R2,R3) END DO END DO END DO C Z2=0 DO I = 1,M-1 R1=Q(I) DO J = I+1,M R2=Q(J) DO 60 K = 1,N IF(S(K).EQ.1) GO TO 60 R3=K Z2=Z2+D(R1,R2,R3) 60 CONTINUE END DO END DO C Z3=0 DO 90 I = 1,N-1 IF(S(I).EQ.1) GO TO 90 R2=I DO 91 J = I+1,N IF(S(J).EQ.1) GO TO 91 R3=J ZA=0 ZB=0 DO 92 K = 1,M R1=Q(K) ZA=ZA+D(R1,R2,R3) ZB=ZB+D(R1,R3,R2) 92 CONTINUE ZCT=ZA IF(ZB.GT.ZCT) ZCT=ZB Z3=Z3+ZCT 91 CONTINUE 90 CONTINUE C N4=0 DO 93 I = 1,N-2 IF(S(I).EQ.1) GO TO 93 R1=I DO 94 J = I+1,N-1 IF(S(J).EQ.1) GO TO 94 DO 95 K = J+1,N IF(S(K).EQ.1) GO TO 95 C ACT=D(I,J,K) C IF(D(I,K,J).GT.ACT) ACT=D(I,K,J) C IF(D(J,I,K).GT.ACT) ACT=D(J,I,K) C N4=N4+ACT N4 = N4 + DD(I,J,K) 95 CONTINUE 94 CONTINUE 93 CONTINUE C N1=N*(N-1)*(N-2)/3 ! This bound is OK! The N1 is total C N2=M*(M-1)*(M-2)/3 ! and N2 and N3 are truly computed terms. C N3=(N-M)*(M*(M-1)) ! So N1-N2-N3 assumes +1 for rest, which ZBD=Z1+Z2+Z3+n4 ! (N-M)*(N-M-1)*(N-M-2)/3 +n4 C WRITE(*,98) N,M,N1,N2,N3,Z1,Z2,N1-N2-N3,ZBD C 98 FORMAT(9I7) RETURN END C SUBROUTINE EVALBBWRCG(ZBD,Q,N,D) IMPLICIT INTEGER(A-Z) DOUBLE PRECISION D(N,N,N),ZBD INTEGER Q(N) ZBD=0 DO 85 I = 1,N DO J = 1,N-1 IF(Q(J).EQ.I) GO TO 85 END DO Q(N)=I 85 CONTINUE DO I = 1,N-2 R1=Q(I) DO J = I+1,N-1 R2=Q(J) DO K = J+1,N R3=Q(K) ZBD=ZBD+D(R1,R2,R3) END DO END DO END DO RETURN END seriation/src/lt.h0000644000176200001440000000111112642502737013630 0ustar liggesusers /* LT_POS to access a lower triangle matrix by C. Buchta * modified by M. Hahsler * n ... number of rows/columns * i,j ... column and row index (starts with 1) */ #ifndef LT_POS #define LT_POS(n, i, j) \ (i)==(j) ? 0 : (i)<(j) ? n*((i)-1) - (i)*((i)-1)/2 + (j)-(i) -1 \ : n*((j)-1) - (j)*((j)-1)/2 + (i)-(j) -1 #endif /* M_POS to access matrix column-major order by i and j index (starts with 1) */ #ifndef M_POS #define M_POS(n, i, j) ((i)+(n)*(j)) #endif /* * MIN/MAX */ #define MIN(X,Y) ((X) < (Y) ? (X) : (Y)) #define MAX(X,Y) ((X) > (Y) ? (X) : (Y)) seriation/src/greedy.c0000644000176200001440000000752312606356654014505 0ustar liggesusers/* * seriation - Infrastructure for seriation * Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License along * with this program; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ #include #include /* greedy endpoint ordering based on arbitrary similarities. * this is trivial. * * input is a lower triangular distance matrix. returns the * merge tree), the corresponding order, and the height (see * hclust). * * note that the height need not be monotonically increasing! * * (C) ceeboo 2005 */ typedef struct { double v; int i; } MDS; static MDS minDist(double *x, int j, int *c, int *p, int n) { int i, k, l; double v; MDS m; m.v = R_PosInf; l = 0; for (k = 0; k < n; k++) { i = c[k]; if (i > j) v = x[i+p[j]]; else v = x[j+p[i]]; if (v < m.v) { m.v = v; m.i = i; l = 1; } else if (v == m.v) { if (unif_rand() > (double) l/(l+1)) m.i = i; l++; } } return m; } /* swap */ static void swap(int *x1, int *x2) { int x = *x1; *x1 = *x2; *x2 = x; } SEXP order_greedy(SEXP R_dist) { int n, i, j, h, k; int *left, *right, *order, *c, *p; double *x, *height; MDS l, ll, r, rr = {0.0, 0}; SEXP R_obj; n = 1 + (int) sqrt(2 * LENGTH(R_dist)); if (LENGTH(R_dist) != n*(n-1)/2) error("order_greedy: \"dist\" invalid length"); PROTECT(R_obj = NEW_LIST(3)); SET_ELEMENT(R_obj, 0, allocMatrix(INTSXP, n-1, 2)); /* merge */ SET_ELEMENT(R_obj, 1, NEW_INTEGER(n)); /* order */ SET_ELEMENT(R_obj, 2, NEW_NUMERIC(n-1)); /* height */ left = INTEGER(VECTOR_ELT(R_obj, 0)); right = INTEGER(VECTOR_ELT(R_obj, 0))+n-1; order = INTEGER(VECTOR_ELT(R_obj, 1)); height = REAL(VECTOR_ELT(R_obj, 2)); x = REAL(R_dist); /* distance matrix */ GetRNGstate(); p = Calloc(n-1, int); /* column pointers */ c = Calloc(n, int); for (k = 0; k < n-1; k++) { c[k] = k; /* candidate leaves */ p[k] = k*(n-1)-k*(k+1)/2-1; order[k] = k; /* here backreference */ } c[k] = k; order[k] = k; i = (int) (unif_rand() * n); /* initial leaf */ h = l.i = ll.i = r.i = rr.i = i; for (k = 0; k < n-1; k++) { swap(c+order[h], c+n-k-1); swap(order+h, order+c[order[h]]); if (ll.i == h) ll = minDist(x, l.i, c, p, n-k-1); if (k == 0) rr = ll; else if (rr.i == h) rr = minDist(x, r.i, c, p, n-k-1); if (!R_FINITE(ll.v) || !R_FINITE(rr.v)) { Free(c); Free(p); error("order_greedy: non-finite values"); } if (ll.v < rr.v) { l = ll; h = l.i; left[k] = -h-1; right[k] = k; height[k] = l.v; } else { r = rr; h = r.i; left[k] = k; right[k] = -h-1; height[k] = r.v; } } left[0] = -i-1; /* in each step a leaf was merged. so, we can simply * descend the tree and place it on the next left * or right position. */ i = 0; j = n-1; for (k = n-2; k >= 0; k--) if (left[k] > 0) order[j--] = -right[k]; else order[i++] = -left[k]; order[j] = -right[0]; Free(c); Free(p); PutRNGstate(); UNPROTECT(1); return R_obj; } /**/ seriation/src/dist.c0000644000176200001440000000321412606356654014162 0ustar liggesusers/* * seriation - Infrastructure for seriation * Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License along * with this program; if not, write to the Free Software Foundation, Inc., * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */ #include #include #include "lt.h" /* * Reorder a dist object with a given order * Beware: all checking and attribute stuff has to be done in the R wrapper */ SEXP reorder_dist(SEXP R_dist, SEXP R_order) { SEXP R_dist_out; int n = INTEGER(getAttrib(R_dist, install("Size")))[0]; int n_out = LENGTH(R_order); int *o = INTEGER(R_order); PROTECT(R_dist_out = allocVector(REALSXP, n_out*(n_out-1)/2)); double *dist = REAL(R_dist); double *dist_out = REAL(R_dist_out); for (int i = 1; i <= n_out; i++) { for (int j = (i+1); j <=n_out; j++) { if(o[i-1] == o[j-1]) dist_out[LT_POS(n_out, i, j)] = 0.0; else dist_out[LT_POS(n_out, i, j)] = dist[LT_POS(n, o[i-1], o[j-1])]; } } UNPROTECT(1); return R_dist_out; } seriation/src/bburcg.f0000644000176200001440000003001113475271311014450 0ustar liggesusersC ANTI-ROBINSON SERIATION C branch-and-bound C by Brusco, M. and Stahl, S. C R Interface by Michael Hahsler C PROGRAM DYNAMIC C SUBROUTINE dynamic(N, A, EPS, X) SUBROUTINE bburcg(N, A, EPS, X, Q, D, DD, S, UNSEL, IVERB) IMPLICIT INTEGER(A-Z) C DOUBLE PRECISION TIMEA,TIMEB,TIMTOT,A(50,50),EPS DOUBLE PRECISION A(N,N), EPS REAL S1 INTEGER X(N),Q(N),D(N,N,N),S(N),DD(N,N,N),UNSEL(N) C Initialize R RNG CALL getrngstate() OLDM=0 CHECKS=0 C C ################################################################# C 10/13/01 This program fits an "unweighted" row gradient criterion C to a symmetric proximity matrix. Count +1 if the anti- C Robinson triple is satisfied, -1 if its not, and 0 for C ties. Only look at upper half of matrix C 07/20/02: Improved symmetry test implemented. C 07/26/03: Fixed the incorrect symmetry test, added an interchange test C avoid use of so many "IF" statements using F & D matrices C 12/24/03: Add insertion test to interchange test. C 07/09/15: Fixed memory issue (MFH) C ################################################################# C C OPEN(1,FILE='AMAT.DAT') ! Dissimilarity matrix C OPEN(2,FILE='SEQ.OUT') ! Output file C EPS = 1.0d-07 C READ(1,*) N ! Read number of objects C WRITE(*,*) 'TYPE 1 FOR HALF MATRIX OR TYPE 2 FOR FULL MATRIX' C READ(*,*) ITYPE C ITYPE = 2 C IF(ITYPE.EQ.2) THEN C READ(1,*) ((A(I,J),J=1,N),I=1,N) C ELSE C DO J = 2,N C READ(1,*) (A(I,J),I=1,J-1) C END DO C DO J = 2,N C DO I = 1,J-1 C A(J,I) = A(I,J) C END DO C END DO C END IF C CALL GETTIM (IHR, IMIN, ISEC, I100) C CALL GETDAT (IYR, IMON, IDAY) C TIMEA=DFLOAT(86400*IDAY+3600*IHR+60*IMIN+ISEC)+DFLOAT(I100)/100. DO I = 1,N A(I,I) = 0.0D0 END DO C DO 848 I = 1,N DO 849 J = 1,N IF(I.EQ.J) GO TO 849 DO 850 K = 1,N IF(I.EQ.K.OR.J.EQ.K) GO TO 850 IF(A(I,K).GT.A(I,J)+EPS) D(I,J,K)=1 IF(A(I,K).LT.A(I,J)-EPS) D(I,J,K)=-1 C for bburcg IF(A(I,K).GT.A(J,K)+EPS) D(I,J,K)=D(I,J,K)+1 IF(A(I,K).LT.A(J,K)-EPS) D(I,J,K)=D(I,J,K)-1 C 850 CONTINUE 849 CONTINUE 848 CONTINUE C DO 851 I = 1,N DO 852 J = 1,N IF(I.EQ.J) GO TO 852 DO 853 K = 1,N IF(I.EQ.K.OR.J.EQ.K) GO TO 853 ACT=D(I,J,K) IF(D(I,K,J).GT.ACT) ACT = D(I,K,J) IF(D(J,I,K).GT.ACT) ACT = D(J,I,K) DD(I,J,K) = ACT 853 CONTINUE 852 CONTINUE 851 CONTINUE C ZBEST = 0 DO 3500 JJJ = 1,20 DO I = 1,N UNSEL(I) = I Q(I) = 0 END DO NNSEL = N C 3501 CALL RANDOM(S1) C 3501 S1 = rand() 3501 CALL unifrand(S1) ISEL = INT(1. + S1*FLOAT(NNSEL)) IF(ISEL.GT.NNSEL) ISEL = NNSEL Q(NNSEL) = UNSEL(ISEL) DO J = ISEL,NNSEL-1 UNSEL(J) = UNSEL(J+1) END DO NNSEL = NNSEL - 1 IF(NNSEL.GT.0) GO TO 3501 C WRITE(*,72) (Q(J),J=1,N) C 72 FORMAT(20I3) Z = 0 DO I = 1,N-2 R1 = Q(I) DO J = I+1,N-1 R2 = Q(J) DO K = J+1,N R3 = Q(K) Z = Z + D(R1,R2,R3) END DO END DO END DO 3502 ITRIG = 0 DO II = 1,N-1 DO JJ = II+1,N C R interrupt CALL rchkusr() C R3 = Q(JJ) R2 = Q(II) DELTA=0 DO I = 1,II-1 R1 = Q(I) DELTA = DELTA + D(R1,R3,R2) - D(R1,R2,R3) DO J = II+1,JJ-1 R4 = Q(J) DELTA = DELTA + D(R1,R3,R4) - D(R1,R2,R4) DELTA = DELTA + D(R1,R4,R2) - D(R1,R4,R3) END DO END DO DO J = II+1,JJ-1 R4 = Q(J) DELTA = DELTA + D(R3,R4,R2) - D(R2,R4,R3) DO K = JJ+1,N R5 = Q(K) DELTA = DELTA + D(R4,R2,R5) - D(R4,R3,R5) DELTA = DELTA + D(R3,R4,R5) - D(R2,R4,R5) END DO END DO DO K = JJ + 1,N R5 = Q(K) DELTA = DELTA + D(R3,R2,R5) - D(R2,R3,R5) END DO DO I = II+1,JJ-2 DO J = I+1,JJ-1 R4A = Q(I) R4B = Q(J) DELTA = DELTA + D(R4A,R4B,R2) - D(R4A,R4B,R3) DELTA = DELTA + D(R3,R4A,R4B) - D(R2,R4A,R4B) END DO END DO IF(DELTA.GT.0) THEN Z = Z + DELTA Q(II) = R3 Q(JJ) = R2 ITRIG = 1 END IF END DO END DO IF(ITRIG.EQ.1) GO TO 3502 IF(Z.GT.ZBEST) ZBEST = Z 3500 CONTINUE C WRITE(2,3505) ZBEST IF (IVERB == 1) THEN C WRITE(*,3505) ZBEST CALL dblepr('HEURISTIC OBJ VALUE', -1, DBLE(ZBEST), 1) ENDIF C 3505 FORMAT(' HEURISTIC OBJ VALUE ',I12) Z = ZBEST-1 DO I = 1,N Q(I) = 0 END DO C M=1 Q(M)=1 S(1)=1 trig=1 DO K = 2,N Q(K)=0 END DO C 1 M = M + 1 C C CHECKS=CHECKS+1 IF (IVERB == 1 .AND. M .GT. OLDM) THEN C WRITE (*,6000) M+1, CHECKS CALL intpr('reached position', -1, M+1, 1) CALL intpr('with following number checks', -1, CHECKS, 1) C 6000 FORMAT(' reached position ', I5, ' with ', I9, ' checks') OLDM=M ENDIF C C R interrupt CALL rchkusr() C C main loop C 2 Q(M)=Q(M)+1 C C MFH: Make sure to not get out of bounds with S(Q(M)) - 9/24/12 IF(Q(M).GT.N) GO TO 222 IF(S(Q(M)).EQ.1) GO TO 2 ! REDUNDANCY 222 IF(M.EQ.1.AND.Q(M).GT.N) GO TO 9 ! TERMINATE IF(M.GT.1.AND.Q(M).GT.N) GO TO 7 ! GO TO RETRACTION C only for bburcg IF(TRIG.EQ.0.AND.Q(M).EQ.2) GO TO 2 ! SYMMETRY FATHOM C S(Q(M))=1 IF(M.EQ.1) GO TO 1 IF(M.EQ.N-1) THEN CALL EVALBBURCG(ZBD,Q,N,D) IF(ZBD.GT.Z) THEN Z=ZBD IF (IVERB == 1) THEN C WRITE(*,*) 'Eval =',z CALL dblepr('Eval', -1, DBLE(Z), 1) ENDIF DO I = 1,N X(I)=Q(I) END DO END IF Q(N)=0 S(Q(M))=0 GO TO 2 ELSE DO 251 MM = M-1,1,-1 ! Insertion Test R3=Q(M) IDX1=0 IDX2=0 DO I = 1,MM-1 R1=Q(I) DO J = MM,M-1 R4=Q(J) IDX1=IDX1+D(R1,R4,R3) IDX2=IDX2+D(R1,R3,R4) C END DO C END DO C DO 250 I = 1,N IF(S(I).EQ.1) GO TO 250 R5=I C DO J = MM,M-1 R4=Q(J) IDX1=IDX1+D(R4,R3,R5) IDX2=IDX2+D(R3,R4,R5) END DO C 250 CONTINUE C DO J = MM, M-2 DO JJ = J+1, M-1 R4A=Q(J) R4B=Q(JJ) IDX1=IDX1+D(R4A,R4B,R3) IDX2=IDX2+D(R3,R4A,R4B) END DO END DO IF(IDX1.LT.IDX2) THEN S(Q(M))=0 C ism2 = ism2 + 1 GO TO 2 END IF 251 CONTINUE C go to 253 C DO 151 MM = M-2,1,-1 ! Interchange Test R3=Q(M) R2=Q(MM) IDX1=0 IDX2=0 DO J = MM+1,M-1 R4 = Q(J) IDX1=IDX1+D(R2,R4,R3) IDX2=IDX2+D(R3,R4,R2) END DO DO I = 1,MM-1 R1=Q(I) IDX1=IDX1+D(R1,R2,R3) IDX2=IDX2+D(R1,R3,R2) DO J = MM+1,M-1 R4=Q(J) IDX1=IDX1+D(R1,R2,R4) IDX2=IDX2+D(R1,R3,R4) C IDX1=IDX1+D(R1,R4,R3) IDX2=IDX2+D(R1,R4,R2) C END DO C END DO C DO 150 I = 1,N IF(S(I).EQ.1) GO TO 150 R5=I IDX1=IDX1+D(R2,R3,R5) IDX2=IDX2+D(R3,R2,R5) C DO J = MM+1,M-1 R4=Q(J) IDX1=IDX1+D(R2,R4,R5) IDX2=IDX2+D(R3,R4,R5) C IDX1=IDX1+D(R4,R3,R5) IDX2=IDX2+D(R4,R2,R5) END DO C 150 CONTINUE C DO J = MM+1, M-2 DO JJ = J+1, M-1 R4A=Q(J) R4B=Q(JJ) IDX1=IDX1+D(R4A,R4B,R3) IDX2=IDX2+D(R4A,R4B,R2) IDX1=IDX1+D(R2,R4A,R4B) IDX2=IDX2+D(R3,R4A,R4B) END DO END DO IF(IDX1.LT.IDX2) THEN C ism = ism + 1 S(Q(M))=0 GO TO 2 END IF 151 CONTINUE C CALL BOUND2BBURCG(ZBD,N,Q,M,D,S,DD) IF(ZBD.LE.Z) THEN S(Q(M))=0 C ism3 = ism3 + 1 GO TO 2 END IF IF(Q(M).EQ.1) TRIG=1 GO TO 1 END IF C 7 IF(Q(M).EQ.1) TRIG=0 C MFH: Make sure to not get out of bounds with S(Q(M)) - 6/9/15 IF(Q(M).GT.N) GO TO 777 S(Q(M))=0 777 Q(M)=0 M=M-1 IF(Q(M).EQ.1) TRIG=0 S(Q(M))=0 C C WRITE(*,*) 'X',(X(J),J=1,N) C WRITE(*,*) 'Q',(Q(J),J=1,N) C GO TO 2 C 9 CALL GETTIM (IHR, IMIN, ISEC, I100) C CALL GETDAT (IYR, IMON, IDAY) C TIMEB=DFLOAT(86400*IDAY+3600*IHR+60*IMIN+ISEC)+DFLOAT(I100)/100. C TIMTOT=TIMEB-TIMEA C write(*,*) ism,ism2,ism3 C WRITE(*,69) Z,TIMTOT C 9 WRITE(*,69) Z C WRITE(2,69) Z,TIMTOT C WRITE(2,70) (X(I),I=1,N) C 69 FORMAT(' MAXIMUM UNWEIGHTED ROW GRADIENT INDEX ',I20) C 69 FORMAT(' MAXIMUM UNWEIGHTED ROW GRADIENT INDEX ',I7,' CPU TIME ', C 1 F8.2) C 70 FORMAT(30I3) C 9 IF (IVERB == 1) THEN C PRINT *, 'total number of checks: ', CHECKS CALL intpr('total number of checks', -1, CHECKS, 1) ENDIF C Return R RNG CALL Putrngstate() RETURN END C SUBROUTINE BOUND2BBURCG(ZBD,N,Q,M,D,S,DD) IMPLICIT INTEGER(A-Z) INTEGER Q(N),D(N,N,N),S(N),DD(N,N,N) Z1=0 DO I = 1,M-2 R1=Q(I) DO J = I+1,M-1 R2=Q(J) DO K = J+1,M R3=Q(K) Z1=Z1+D(R1,R2,R3) END DO END DO END DO C Z2=0 DO I = 1,M-1 R1=Q(I) DO J = I+1,M R2=Q(J) DO 60 K = 1,N IF(S(K).EQ.1) GO TO 60 R3=K Z2=Z2+D(R1,R2,R3) 60 CONTINUE END DO END DO C Z3=0 DO 90 I = 1,N-1 IF(S(I).EQ.1) GO TO 90 R2=I DO 91 J = I+1,N IF(S(J).EQ.1) GO TO 91 R3=J ZA=0 ZB=0 DO 92 K = 1,M R1=Q(K) ZA=ZA+D(R1,R2,R3) ZB=ZB+D(R1,R3,R2) 92 CONTINUE ZCT=ZA IF(ZB.GT.ZCT) ZCT=ZB Z3=Z3+ZCT 91 CONTINUE 90 CONTINUE C N4=0 DO 93 I = 1,N-2 IF(S(I).EQ.1) GO TO 93 R1=I DO 94 J = I+1,N-1 IF(S(J).EQ.1) GO TO 94 DO 95 K = J+1,N IF(S(K).EQ.1) GO TO 95 C ACT=D(I,J,K) C IF(D(I,K,J).GT.ACT) ACT=D(I,K,J) C IF(D(J,I,K).GT.ACT) ACT=D(J,I,K) C N4=N4+ACT N4 = N4 + DD(I,J,K) 95 CONTINUE 94 CONTINUE 93 CONTINUE C N1=N*(N-1)*(N-2)/3 ! This bound is OK! The N1 is total C N2=M*(M-1)*(M-2)/3 ! and N2 and N3 are truly computed terms. C N3=(N-M)*(M*(M-1)) ! So N1-N2-N3 assumes +1 for rest, which ZBD=Z1+Z2+Z3+n4 ! (N-M)*(N-M-1)*(N-M-2)/3 +n4 C WRITE(*,98) N,M,N1,N2,N3,Z1,Z2,N1-N2-N3,ZBD C 98 FORMAT(9I7) RETURN END C SUBROUTINE EVALBBURCG(ZBD,Q,N,D) IMPLICIT INTEGER(A-Z) INTEGER Q(N),D(N,N,N) ZBD=0 DO 85 I = 1,N DO J = 1,N-1 IF(Q(J).EQ.I) GO TO 85 END DO Q(N)=I 85 CONTINUE DO I = 1,N-2 R1=Q(I) DO J = I+1,N-1 R2=Q(J) DO K = J+1,N R3=Q(K) ZBD=ZBD+D(R1,R2,R3) END DO END DO END DO RETURN END seriation/src/arsa.f0000644000176200001440000001732713475266711014161 0ustar liggesusersC ANTI-ROBINSON SERIATION C simulated annealing algorithm - provides an initial permutation C by Brusco, M., Koehn, H.F., and Stahl, S. C R Interface by Michael Hahsler C PROGRAM SANNEAL SUBROUTINE arsa(N, A, COOL, TMIN, NREPS, IPERM, D, U, 1 S, T, SB, ZMAX, RULE, TRYMULT, IVERB) IMPLICIT DOUBLE PRECISION(A-H,O-Z) DIMENSION A(N,N) DIMENSION IPERM(N) DOUBLE PRECISION D(N,N) REAL S1, RCRIT INTEGER U(N), S(N), UNSEL, T(NREPS,N), SB(N), Q, NREPS EPS = 1.0D-08 C Defaults C RULE = .5 C COOL = .95 C TMIN = .0001d0 C Initialize R RNG CALL getrngstate() DO I = 1,N-1 DO J = I+1,N D(I,J) = DFLOAT(J-I) D(J,I) = D(I,J) END DO END DO DO 999 III = 1,NREPS DO I = 1,N U(I) = I T(III,I) = 0 END DO UNSEL = N DO 1 I = 1,N C S1 = rand() CALL unifrand(S1) ISET = INT(S1 * FLOAT(UNSEL) + 1.) IF(ISET.GT.UNSEL) ISET = UNSEL T(III,I) = U(ISET) C DO J = ISET,UNSEL C out of bounds error reported by Rohan Shah (9/13/12) DO J = ISET,UNSEL-1 U(J) = U(J+1) END DO UNSEL = UNSEL - 1 1 CONTINUE 999 CONTINUE C ZMIN = 9.9D+20 ZAVG = 0. ZMAX = 0. DO 1000 III = 1,NREPS DO I = 1,N S(I) = T(III,I) END DO Z = 0.0D0 DO I = 1,N-1 K = S(I) DO J = I+1,N L = S(J) Z = Z + D(I,J) * A(K,L) END DO END DO ZBEST = Z TMAX = 0.0D0 C DO LLL = 1,5000 C Find initial TMAX using N*10 tries DO LLL = 1,N*10 C S1 = rand() CALL unifrand(S1) I1 = INT(S1 * FLOAT(N) + 1.) IF(I1.GT.N) I1 = N C 199 S1 = rand() 199 CALL unifrand(S1) J1 = INT(S1 * FLOAT(N) + 1.) IF(J1.GT.N) J1 = N IF(I1.EQ.J1) GO TO 199 IF(I1.GT.J1) THEN JDUM = J1 J1 = I1 I1 = JDUM END IF K = S(I1) M = S(J1) DELTA = 0.0D0 DO 1250 L1 = 1,N IF(I1.EQ.L1.OR.J1.EQ.L1) GO TO 1250 L=S(L1) DELTA=DELTA+(D(L1,I1)-D(L1,J1))*(A(L,M)-A(L,K)) 1250 CONTINUE IF(DELTA.LT.0) THEN IF(ABS(DELTA).GT.TMAX) TMAX = ABS(DELTA) END IF END DO C TMAX = Z ILOOP = INT(TRYMULT*N) NLOOP = INT((LOG(TMIN)-LOG(TMAX))/LOG(COOL)) IF (IVERB == 1) THEN CALL intpr('Steps needed', -1, NLOOP, 1) CALL intpr('Temp', -1, NLOOP, 0) ENDIF TEMP = TMAX DO I = 1,N SB(I) = S(I) END DO C DO 2000 IJK = 1,NLOOP IF (IVERB == 1) THEN CALL dblepr('', -1, DBLE(TEMP), 1) ENDIF C R interrupt CALL rchkusr() C DO 2001 KKK = 1,ILOOP C S1 = rand() CALL unifrand(S1) IF(S1.LE.RULE) THEN ! INTERCHANGE / INSERTION / OR BOTH C S1 = rand() CALL unifrand(S1) I1 = INT(S1 * FLOAT(N) + 1.) IF(I1.GT.N) I1 = N C 99 S1 = rand() 99 CALL unifrand(S1) J1 = INT(S1 * FLOAT(N) + 1.) IF(J1.GT.N) J1 = N IF(I1.EQ.J1) GO TO 99 IF(I1.GT.J1) THEN JDUM = J1 J1 = I1 I1 = JDUM END IF K = S(I1) M = S(J1) DELTA = 0.0D0 DO 250 L1 = 1,N IF(I1.EQ.L1.OR.J1.EQ.L1) GO TO 250 L=S(L1) DELTA=DELTA+(D(L1,I1)-D(L1,J1))*(A(L,M)-A(L,K)) 250 CONTINUE IF(DELTA.GT.-EPS) THEN Z = Z + DELTA S(I1) = M S(J1) = K IF(Z.GT.ZBEST) THEN ZBEST = Z DO I = 1,N SB(I) = S(I) END DO END IF ELSE C S1 = rand() CALL unifrand(S1) RCRIT = REAL(EXP(DELTA/TEMP)) IF(S1.LE.RCRIT) THEN Z = Z + DELTA S(I1) = M S(J1) = K END IF END IF ELSE ! INSERTION C S1 = rand() CALL unifrand(S1) I1 = INT(S1 * FLOAT(N) + 1.) ! OBJECT POSITION IS I1 IF(I1.GT.N) I1 = N C 599 S1 = rand() 599 CALL unifrand(S1) J1 = INT(S1 * FLOAT(N) + 1.) IF(J1.GT.N) J1 = N IF(I1.EQ.J1) GO TO 599 K = S(I1) DELTA = 0.0D0 IF(J1.GT.I1) THEN SPAN = DFLOAT(J1-I1) DO L = I1+1,J1 Q = S(L) DO I = J1+1,N M = S(I) DELTA = DELTA + A(M,Q) END DO DO I = 1,I1-1 M = S(I) DELTA = DELTA - A(M,Q) END DO END DO DO I = 1,I1-1 M = S(I) DELTA = DELTA + SPAN*A(M,K) END DO DO I = J1+1,N M = S(I) DELTA = DELTA - SPAN*A(K,M) END DO SPAN2 = SPAN+1 DO I = I1+1,J1 SPAN2 = SPAN2-2 M = S(I) DELTA = DELTA + SPAN2*A(K,M) END DO ELSE SPAN = DFLOAT(I1-J1) DO L = J1,I1-1 Q = S(L) DO I = I1+1,N M = S(I) DELTA = DELTA - A(M,Q) END DO DO I = 1,J1-1 M = S(I) DELTA = DELTA + A(M,Q) END DO END DO DO I = 1,J1-1 M = S(I) DELTA = DELTA - SPAN*A(M,K) END DO DO I = I1+1,N M = S(I) DELTA = DELTA + SPAN*A(K,M) END DO SPAN2 = SPAN+1 DO I = J1,I1-1 SPAN2 = SPAN2-2 M = S(I) DELTA = DELTA - SPAN2*A(K,M) END DO END IF IF(DELTA.GT.-EPS) THEN Z = Z + DELTA IF(J1.GT.I1) THEN DO L = I1,J1-1 S(L)=S(L+1) END DO S(J1) = K ELSE DO L = I1,J1+1,-1 S(L)=S(L-1) END DO S(J1) = K END IF IF(Z.GT.ZBEST) THEN ZBEST = Z DO I = 1,N SB(I) = S(I) END DO END IF ELSE C S1 = rand() CALL unifrand(S1) RCRIT = REAL(EXP(DELTA/TEMP)) IF(S1.LE.RCRIT) THEN Z = Z + DELTA IF(J1.GT.I1) THEN DO L = I1,J1-1 S(L)=S(L+1) END DO S(J1) = K ELSE DO L = I1,J1+1,-1 S(L)=S(L-1) END DO S(J1) = K END IF END IF END IF C END IF 2001 CONTINUE TEMP = TEMP*COOL 2000 CONTINUE IF(ZBEST.LT.ZMIN) ZMIN = ZBEST IF(ZBEST.GT.ZMAX) THEN ZMAX = ZBEST DO I = 1,N IPERM(I) = SB(I) END DO END IF IF (IVERB == 1) THEN CALL intpr('Rep', -1, III, 1) CALL dblepr('ZMAX', -1, DBLE(ZMAX), 1) END IF 1000 CONTINUE C Return R RNG CALL Putrngstate() RETURN END seriation/vignettes/0000755000176200001440000000000013531261200014250 5ustar liggesusersseriation/vignettes/classes.pdf0000644000176200001440000007141712606356654016436 0ustar liggesusers%PDF-1.4 %äüöß 2 0 obj <> stream xUKk1 ϯ90Sc aw)f[)4J留nl燤ﳬ@[[1נҁןUicJkxRiN*tk7]SpUgn)ĺ$DfW%D $[:ծ##& Xpf$> stream x| `U{UuJӝT@$rI7I!Ish:Ґt"(댣#xp 3*ˆΌ̸nd\]'Bޫt'DoTzw}@#n/I!+ ^Ql\u<@"9[w.o=֎8|h1^߁?ߏ]kɟ%Ģ{Sgs \/~|W.oǎE4!SM@8r9y! x0 ^{ Ix(^'.()lIK'_v:ɿc{*@xc/{nNҋm8&fg8~xIt,i#`DH&G&z4Sϥ'Da"Y vSMv-7mx(./^'&^G0h=er5t-&k5y?WW[-ڄ3A/Oi9]@ߪ*zJ $!w4|{@?"T[E[E xσ1[x}B6%T2d$P$|AW-@4bcEtBLl]R|`hqC>‹.Y>܅+5}ݍr3}LlMhsq9°! &OO Ei!FJ1 f*:+ᇨ :P"=]8+ѐGV#A]VDqa"u7E&H (}2 PbUۄ:6e zU 6Ҵ͸\uD1WZM J%j1M ]tF'hΖdo؍>ƸnJO]6ݡjxҭf1Ub3\)xa0'hcA${^L̇zV[ -%v CU /> F`"KN|(Fl6c`J_3$ K1짇ČkKYVʗ rHKn)#h(^d}ؒ6PG{gG̟I˞X&M['ꏅE)]d*))INJNNI6&JSZ˒䲔2hebI)fɳg4w'N-NޝXb2L$lL`6I"j)Ě*fefE#-tlq崌V?2K}u{kMVB |bߒi}1;TU%'{tbj7nĊrcboߒrǂJ<4T IiCak)$fI`L<;ڻ`;lV1X2ekY[{5ݱcEڅ<+??~Ll5O$ǦD(v*[c>2:O 3d-/{=9h&3yç'2DbyceQG*v6#%1JӹGh> 1Yg~upx wm'x=&b_l^n3;QⳍLKbHr@2Rƴ:po%;cR FVlr#rڗr6oę@]'>u53ּ8]:|x|08bxk#ܽغ֠Џ b+AsSДw3f6i-sT8\[0Tl]cl-䘔UEh`dՖWvue«t%xq-=ť[FnCۢ#L\Ս҃$tنTXo;919IHB'0Wfa4=e){U6z42-mjN4 MД*@PdKFdlVY-c-XzzǥWR҃ 'Z0!.F=FK]d 9 kM-WG-ƄBa1ɘ<KY>ETxף0ϏLLag/9UZ8meN"eQ_ޠPyr[[(fVWT Z 7,;΂ o+0/, $jqz" \qVS6sMҢ7ÿK#~V͜FrM^]#6QˈrL0i CD"1'M]–ԔԚLZ$r3na~/28K#dM }i%MO陓Yӑ'&O˩M8QOfW X}ݴ:=?OZe/xL/x]ҟS4%TنRT~7`>xf&US"&ge?UJSW͙31^=ËGn/ɕ $.9̶ܟu(gmZI;קCBi 1ltQc>wQٶ Y.eA b4k{(M9н}PUu_m{_^mW/JcSCfZ WYU4si y$ yX̲ *I2HXI"I0ڹ fs+}ڮg/El<]X))sx % cuNGp\@/x2NbE 2Aؚx#EaV½=fx>`I/LB'+,lEjz _|*ܧz̴xH^ogc0H2&c*[urVE|;չ7rAK -n\ë?9W_WhGyxb݂:f5 1CCyW+޻~n8YstO$UY4X/)DjJIO!<}2֫0Z(BfFrRrJ"H?OKL!` I4){+lL̷GVgiB n1t;EhPi=Bo}]f`m @ թxh꼇^:3R?I_}KKXK؉S8jK͋\_dEdn%qyDN$Wj' gF+8o)ظXNgD)yz-0^A=m%^1itYT&ؘ㓉2̨̫姘Wm=) ~7=G!"SG$T^ee@wm{ >ĔAz6oggtr )˃a "^ t)w.J[,,Ǹz.EuyisƦUqe <.WhhLE._V:!/ZrQu+j2D q*/Wh5\h b>QhgF:Q@W ({aDCR4yW8p\O]^a:HE@i Gz\7 x^NC|m/Afvwv{$=HG;ttFCHvq>SǪty2wp5,퀳}( L8$d@Gd :Ψ !?2򅞀Xpw;z~Nt6;IDr2/@".@4CXeV <@SNͫb`_@;JdyBFePG\1Zpcꌠa< PWtd XEC]n$f+sb$edsuM@_#F w.W|qn.3uB^vF /7BREwt@.ba[!CHbT e_`k#1+ruzـ;Rf 9fWDp?u1(~.pLT ix:1ycTs1#N=0V.RbT ~= lgBt(3JK |{CkQ8j"{ YuΙs h78*3{Bev]CUq,hjvȍJݜ:5TϭkU㺆FR_7ΉD|Nˆq4WW:B<ـ4QfŮ4ٛusJҨA u 3c@BՍM jg:ȉVlq̱7϶*HUnV2i(ylqL{}2lv簹 چ9yF܆A@UlJunUϱ2uL4M2[Php4JK5ǺfGDz.nucC㲹؁,j.Wet~Q׵8YdFs#8{\ēAو8q` ;sѻ׺m=Ө;k$.\x%,h-aت^>лq'Rg3`@Hd H-+yJՉp"> sPrt3 |'`2Q\@߆C65Pb0.򆃸Ky;˸$>?j]>wdRT(9qO "cEW2ιt:AV)gSɱ:H9:H>ғS G! X"KDk%Q+ɚZIj%|Kc8_咬K9Kqw.d@9I>%LٗLI9IdRN$;jdbgUu$4?HVGʹTGr|uUu$Y)R1g(|G|G9G Ht r>N{rU[+a,,ؠ4RM$HŤDBF7JRXl L9"V#~_-;K!͋O/YwΔπ~N y-5~pᚯDZ[Kp<ҍ38ũy HA*~qN< ©QbT9y\0 pI*Q뢫Ɯj;_!Đ^H9^}2_ ^6Q)C^\3#ZN6ƐryQVR-,9|ǂ\6C W0`T Be1aFk(5빰ɾ.(~m>y+{uqb_-U0͚8.N->.Sz-\խ5ki4 pkR>ӽihH:b?<(6[]e/\⼤[g5.]?G=S(>#iT1,0#迚31LXOG94AZFC> nS0>NDGk!4+5i98vfk9.qzX,DᔵxhtTZZGӤ {tF=3v8~g<ɐX3ܜ6'jvh-j!7tI'tҹbg sQ 3Ghb9 ~uvqeNc]gb߉5*2L{Ɲae4ߣI0<;>3:ܯKCc}U͡.=Fy ':Eu b6:s PYu{wuSds:!g]jGu#nԐkF2Y7;M8i:k6pfฦKYBMțͨEɩϴr;2}jzu6I֨[cTt,599pRNqrؑ~nwj9&јs9|CYqqVx11k8';GeHM3wj~T=݂8:p~]u\jkOǡ[ud :tsj4B]Wa~nݨZƪ-wkDUZ J W&=|4<~k?^Օ.^-0n!<%eƥ#ze leHDur?Կ|aVOtC$]Ä!u zId`qL3:S*zݟ:Sy<ys${[yJ}O}}ktI&O>vNӠ!>e\|LIt6O9vv'>r܉ M$6;i9Vv檜˹l^55}47?VR%Ă h!, H,}E|kUxك|4 9x%x{r}g{g bBvRYi H#"Mɘ3$>DLeR}ln>4Lla${:5p$~, ;X'.Uc_Zc*|i>EE-O|g*U* |8ǽ 2YJrW>—T8‡* gI{a|]>C }3eo3-3z3Y:x^GHfHoÌi=>^yyxeK%ˋeR F_{`fi /Tx^~5Iz~5W$xҳTi ٝ"I)2{J]*< O?S*lφ_,x<>؊|lYH)B*<&~.F`Ra 6>XKZ|QG*~[HoܷR\sGfc ?+UpU܃KQ)p7v= ]]Yp(TvnS'*ܪU-%ҏTAUJ*;nRae( *PzrzmzTX #RwDr!p U X]}KUXOwQ UhG*xdDw,SMWkZ"f2\"+U\ .Ƿsa ` vb sUpCK4_#5e8pY45HM}`ss~vT gY0$Ͳ@ fA 6fdjMRM*T`Dvi/۴Tɦ´KMҴTSY0=0Ip a|pi| TːCs8(ˀq+ű) k+SM*T MPe0:I: .¨LmFC%pA1pPl"b0 m2Cވ)FK#r`.wF3[rilB[Vdb_f dx i*Xݢ&ω&3VF1AJ%$jYR $UHP ɒAI&}pb2Jt|;]  endstream endobj 6 0 obj 8718 endobj 7 0 obj <> endobj 8 0 obj <> stream x]n0E|"& BJIX~R1q}=ya5ڧnx6hI`j)-=o96I[fck,-f:I8mlQw!n~3TS09O}GHjݪP~Y_be1̶zsbeT & \ٻ*B+M87ϐw 9Q{ "##qYO{s,~y`w~@_#1p[c37[tU, fݗ endstream endobj 9 0 obj <> endobj 10 0 obj <> stream x| t[յ+YG,Wƙ"Ŗ[H5r!L MH@JCJ˔-t-tZC?$7s;N0{ιyNVQ?2#7HWrc iן⿇w( o!wm#? u=CpMy+B ? _>z)z!_l- 0ÞxۣxnP7/Ec~ĵ~ 09Q!ۈ+~ ps7ra58"&Пa}SZ vrq5&v u].+׸]e/_7\zy{Wp 77f|)>[BP\@vX|Eu93 ~Gh*O8$˕rt-~M^n@p/j vw5n#f0ο_Co@_ow\X{ZKX>2i{ wpE_j䢝Ux!nF?GsH|QDf& 6kF=Ѓn:YF0!dW:^!:>e*^Գ7{tɞBr8c/+TU{αլbu7Z ,úyB< ;28 ;H%^ K<\e5[:ǥ,?( 1j9h6FP^D(+/k$rܕ_Ѡ' V0Wr}Cvkjݾ7Ͻ}νjųv+7G?6n? dҚ 9ʂa2..~K~Ade,_p Wa[ ʹ2."Xm.+/?oV-W͟Wi/6fpqͧ_?ܲvb]s͕r+[8bkKG*+* /U'AG3AKKըAp9Ո+_TcѠ17tlqsGU0~$ACZB*,\P9^ȷhAfZ1p9~u޺p|&yB~oA8^~M&4$o?zze$4xl· }۱QÍ:]V٨aᛍ;tz Qg5;*s c2S̪-`M+m$3ǭqTHH$#9aG\?o6aؚg^ ,(fV]3K?pCqC^spx $zr\)X##N@`:*W||#/@m aA*G;E|I|R bmf>K>iD%fтKfK0 B{o ϴK{72[k> Ԑ3Tz"`_U2^pCk%==y375d'_]P`-R|@GbtұA*/98Z$@1/l1fgBt6\ˬbeEEYp+++EA*u,xG&[YK 5:M>/!UHSE*+c?<@2.y)zKi/˘* 423&lLIcҚL:1MSh1L9p) -\SEQ{=)Fudт#Õ ߙ9<~a0 ?vgY%'Kr^ÇN/i,t3xS}]zj͐WB?*Futc49}јc$z@'YZ8vD8xPsgsrP)۠2rU%44'C>Ӌ^H/&zɡ3KۅJ>j7e^&1j9Ҫϰjn_])b#<+.d~ 9:yl|S׺OxpQ˓}nOTtG+ w]ROtA-A,pCbq"qۤ‚|1۠ςCFl.1R+*t^KJe:0 84d;j37; Td LօyyswsoK+4{/w]O"yTDuJzT 3"e*S 'pf7M9 ٢oiPh{4抻lw΂e(.2+ g[&8 C,&smnf ⦚c#OGAÎ25g6eAql\).L틖B %M-10mg \5_?{|KÑaGޱ ×ؠeK1ѥdtRJ,,dvl*rU+hJGOM99cc7]73d:#Juhn.tV*` t-m ~&/G^Is ;hȄP".iZ)SyO]0]}uQzF 0~YGuA8 A!!۰2}UF4/UulBzK32X@tTg)T*oU<*_1US"5Ȟ:BbuGƂ$#ulB'y04EcT-͕6Jx"R[[#9GF^ zql!l]@=cHxPZ:fg٨qK z%_$ 0}p|qd'uuel֗c`$,\ҠP9d@$ <&@D"X[њxd4"AM؟ha`c*sJMRu#kFjKP4K}R  IΘLe%IsTg&BAJ2 s9|gmyi `xDGA#w4'< O 8F/Hf3Nbh,_ &2iQNC0 (J@;x*] Ԅ9H|ȞANiFbRv ?4eFDQ#~ XF_DGR|t`M*_ 2FF¾ #Hy"c~&E# 0C\YV=@y&Ň<##dj ؀(L3IH?RbcOC- yFz0I'|xb0ccPUD=$q#O|*%0=I>؀F)愊ӿ `tvI|cGbdKšN> 662L/~$ul@u2 oH@Hh303Q< i$PK{O TӬƜ"ᙬiPQ#y= VQwg8 GuTHA#[˝.O^jl>6n z]RwZ)u5%׊^W_:{:\ԱUZ RG[gVU"t6-sq[G{'0+9giiWỲ:]  jYֺmMnXwmKDH p 8$2oCZsjEZv5;m]b\RxQ:mvl$P0E:r:;R_@m&7݃&:M]}%I%.FpŸ& ĥxݽ+\vG- R{v0X R6kz@ݪ.g l GԷVR#KJ3UpkWYcC8 ةdMczYHI1?d8M%d>gG`(yR3`"3)6'IXL$(Ƃc8SL)-N 1< Tp?`c,cPTљdr_$AayNg[^:(ut.uIA9A:HM^)<3)P 9ZIJJQ+[D=Z\Zk%k%2.8ZVξV"RfN*<$q%KyKdBL$λd"d"j${DLҹLdڒI,%q;u^Mv.9ꈤ%?$#|#YITi#|#ꬓ%U>g(|ș ,  ɵ/hIx+H jع]\ BP֪i4}6Ԅ"(6 A4HBȋfýw.BB&!?j | hMኳ~3W@ E ƀ0 4{>f þeh alI$0\3x'PgS1,q(>XVw@K ~2d5L“2'L4 DŽjehק| EMi Þ lI'|7gn~f{?AZ؏bj'f ³(;|j vPXǦhei䟧w:[z`S#%K*.|OoAxB(VZ,x0|!-A{WdTªk)S0y `M>Tp(&*b?yC{VxW|X=[ؘ^_^Q#, !%$шI)h&':+Q5>e k4*4(hg XI L2&y(ӡ=:tbTlM22HvO#=%g- ìă;ju,uRs єG'_iKK#tV`Y;JϠcWJTeDQ2[B^F86tyce 2sQZf0'hOMJZc9 sd0 ͓}Mцrx`;$!vO珳EDLԙRlT:yS=ii,pJu˰y%OP;,gIIcR{318\U(%syIS2%$i0=LtU{}dsNY+iɕx#2yϤHRZϤiC[J;O'YᶋY\ GMpr3-PJnHif)vp֭ZXjT]*|P/KQcwWbalIIie(߄ic)(,fpTT)ͰJ弙Qr2M+I[us1Mu0>У R+?1YT]+8W|#CMLFj٫K)'d)3R(pצ ߥZ7ɏQvO,] lݗ*KSKUNq6Y8JMPp%iO`3þ6rJre9Tޞ|rgVj4gJ@­ 64.-)gV]'v ;vɪ7]}([y'ʬz}>Wjx*:0Lֳ3=N"(e;)Zɳ(K+=Zh'90{z6N oT뛦 '?@IY2cRAaZO֨xc(^ ՀW Mz(F4@u0 GGi=/t{_~Zy}~ 2m?HAA+yoO^G:uXȗWN+W+; 9Jd 4ok_+3 A[ WJNwsu]t+ehe"Nf. wȔ.S]2e. ]&s2e*ƭm'H~xL|؇8P P~첈]]| w^OT;'w;U-=o`N 2ko=U*5p{MƷ-+L-2ś'MRF|7K7o7m̀2[reYƛdo( p O8[pLfᨌ#28D䈌ŵ26a'*Ãp10e>/dX#zޭ*q` p_W#|-l k$ڀWªv| ܮJe^a˫2/[}22{v*e2qmx/q-=b]{psS\,".qA>η|3qĹۈ26&- flE cd's a@F,8J1\E#ss8ߍwpIeП endstream endobj 11 0 obj 8294 endobj 12 0 obj <> endobj 13 0 obj <> stream x]n E|t;dYJD0vj0Y0i+u:3s/KT7F+Y7+0*͒K%ܽ :"ma.K7G9W+*=GhcVU\yK7A\Fr[OCU,a1X//fɎ, >;륉><9~ _sO{#@H|@~"ggy 3IOT\ܬ1 `2Jߙ٠+oҌ, endstream endobj 14 0 obj <> endobj 15 0 obj <> stream x{ |Tw;ܼfaHr2 I $ nf2s'Hfƙ 1Ej b_*RV)* Znn[Z+Բ]v#\|߽ "cafceN6 +X3sDy.۽>"8'{w|>BRg.ϳ—؃paO?⼬o rF !8%nW,/ƹ43 g_v.+Gn'Ϝ'dy747"oJǡu C/{q(9>ۋ3/.߁+u2+/r'9&"6r[F*!o:rsCc!-Lo~?Ia$͇R؋c]6 )"ܛ$Loa.L&}F;ydn΁+/ 'In*rw"y<n)Žr $_n\q0O9(ٸ#]s4لd~TRTr/rU,RCtazFQv@nn-ߝ҃L%BtKgHoDq[`;rJw ɔe| G )QjB0 9HفN-yw$4*C]\BFy6E/Y2Е=,&9ISɘ" 2;oYp//}bo1/M:p֤au7Zm83\u[ۣD}@rI-(A2{=Rut3t<9k9bSy˓a?2?Uo =iܠ vn qy]/<7}z_EY#=\Ff-3a,=+ulF}Y$-3 QΠkO9NS{psB@>;*剘:"4yk_{~}{^!Ͽ{cc{?:ǥU.ϓ G߆ц]t]fZWQ!U"v6iE|msm1fѨbZQ~ q2S %J訧L ROU3^^ߙ/La߫K [c%J^jiEEi$"qeJ2톜ܚUVUIUe[ŭi[ӷfdtE}CdBa&\0/HZRU6W=PtՌ5d\^5j+rT Q5\5GM_7 ۷|c?b%-yKt:-}c歾uygyV7t!4]$Z=S0dS5lP<13sgu,$,>>NãwPG8ؔ;mGt6([Ƕmv)?qns]mM֒OK!4ؖ9z4E9ڬ) PgηstHSՑ *9tXVd7|blȖYp(tع|3^ 0zw/f%|{̭g\Aڮ3=U7u3Ej-iY|Fhy4 I1ZG;K|;k)p='ߞ={_YG&՗22[1C ;1?ݮ;N5{"E+ MǓՏ3dy/!reG5f6+y< GNhXZ2EpZЫB#skʆoBrI> ZHp'sMoV~ΐg uYYcY)#ރ3PT-).ia Y--[/Sj 5.$t@~*&5 bXH4ZP/),RMg|v=S(/sUgåsc~nz3w3'r9\zfse!J%eFӏ@N׸zi-bu;h&ʁ~o犿Z>)2yWʔ!x2$>Lz<ݫ?D%\r5g)Yp%w=BB r1?N.0>ZԽN[g ),RzX(w|>ic=ן<jcz~ _iX_ُr'LrS.ml$i9?& )r|*2T6fm# m ^y۴@f6ܼ֓66m8=3ƙoQ66ihc1,z1z"RJ+ K H8]fwWK~A’CˡZ|zZ?6\}9$uIJÒ+$K>%O`Ga\pC .a0\)¾_q jD55\_?X ܲ7ꕫrQ1ʰ,K=r`Z `_X 쑼d 5V4U %8u%,ιK mKie_XtI#B뤀w2QC0S/,!i\~݌Xx 5z6KKA4DPc>TKr#"BF䨞@)@eWTRR<+}.'zqE(?^_?bd72/b`(t LJz#2AL:`F3=!_/0Af|!J!cd*$gNa4k!),ڇjO"MCA舨CǺ5w0G2; HY B٨@rEщ\=2@"@ !RI>W#kZC60J\Ir!i [ e UL%1ZQGsGpH]\U PWwDJ#}~FxzˍHDdJ\S#DcCÒ/E*NHIKaHjhxsr &s+ BŰ섋I$!?~Nb{t1,a(uٝzu%0xjy#Y=5/;,Ae  ~=W#\C(ΆՈC3 آzB=[GF-Rk\SL-30}'@@r}h0ɇ.&dWmQ.f̹xYrrj{eFBlz*Y'7Žxc{&W/׬nZKfWYS)kD1.Cմ0.&Q?TG1Phw՗e$xI =aaƗϸ4Dn%v_q 4P#迪SqЕ RpQn^%ƲG..U#>4Ҏ3JgN H۳㚄uwV W]lh\c`TW -9-GvEm u!g8pm=ш++pN-V*vT+B=[QdmtT^62eoE6ͧLwRP;bǥP-`վt~f(?NF9VVX1(+uW,FYiyX<#Y~qܡN`Vî6Txe{͞s"|s'Vj44'J@- v`\|U}ZRNb6vXUoPsLXzX}րXU`u` V z'aZOVkxC$\ ՀWdQldrW7sӵH)|q}]kݗ4Ĥ~S$^V?(w'uD!/:UEJ}%J̾t~r}%qOC_I+|<}%|ؾR:]˾R<ޒJ}/]RJ]Irwi]/])A.|j2.88L2I[I]L+2ƭm+|#qJR#ޑċ=w$~ѥ~hfraGObZv|ī\ve1sõD.o!NYUU :0Z+n'&_m=K?;wFꂷS#=o?¯Fe6s ^Ex}#<_xU)pr^9Q(Bu^b^?xQ)?T Sy*GL0\S`Q=Fx9xv3oʅk,ᰅr8GSULxzþlx ~jT *lأe c؍ G z4]إN8KL6,^!,ςEPBn^+< 0^0Bu7 u ܘ5iBmԤATsR\o(f{lrʆʊr p}yp}A dA1Y &E(@AB R k8 LGMMW`6U GlV<@F4!CtNi FHU`RrA7y> endobj 18 0 obj <> stream x]n E|tW#YRۑCu)R& }&m.@g{pInɛd(tsxWmXsWq, n=`{-|uRS,yu 6WPw7k`yʒ+=¾Z*_',xF N+"MK^%-YA~ Y*8GF>lw[=qH5tg|#F~"o\y&!7M|}b|f7BLcb>6wvČ+ endstream endobj 19 0 obj <> endobj 20 0 obj <> endobj 21 0 obj <> endobj 1 0 obj <>/Contents 2 0 R>> endobj 4 0 obj <> endobj 22 0 obj <> endobj 23 0 obj < /Producer /CreationDate(D:20080118113641-06'00')>> endobj xref 0 24 0000000000 65535 f 0000028266 00000 n 0000000019 00000 n 0000000679 00000 n 0000028409 00000 n 0000000699 00000 n 0000009502 00000 n 0000009523 00000 n 0000009720 00000 n 0000010099 00000 n 0000010336 00000 n 0000018717 00000 n 0000018739 00000 n 0000018948 00000 n 0000019305 00000 n 0000019532 00000 n 0000027373 00000 n 0000027395 00000 n 0000027589 00000 n 0000027945 00000 n 0000028159 00000 n 0000028211 00000 n 0000028508 00000 n 0000028592 00000 n trailer < ] /DocChecksum /BF659B2F14228BD45261F1C57B60F30E >> startxref 28771 %%EOF seriation/vignettes/classes.odg0000644000176200001440000002551712606356654016436 0ustar liggesusersPK28.++mimetypeapplication/vnd.oasis.opendocument.graphicsPK28Configurations2/statusbar/PK28'Configurations2/accelerator/current.xmlPKPK28Configurations2/floater/PK28Configurations2/popupmenu/PK28Configurations2/progressbar/PK28Configurations2/menubar/PK28Configurations2/toolbar/PK28Configurations2/images/Bitmaps/PK28 content.xml[[o6~>dm$>, SKHV}_! eY8 Ś8f83"7,1+ ͯtۜ#|uc\& 2&yeD4y+}%E%)9p%-ph-UKRjNVªvwTe.EwGªvv2PUNUޕP@=+PEإ$J_WUvkn]e/ Kp[VذTHőS+-۴F6jUM7fAx`.iRuzu]5bLCō#[).obԱlb4O)mM r s̳"=)eLNG(Ziv 4-0=vq ǒVGOg& ;dʌ#Ar29t4ݫ M!/6ڑ!VryAhqg>^$sQ֭q*$jb<C*q\cbynb @` X&$KX(lJ!} 5e((5PJVo"PubR=cXcZKPZ ,,S8LYdܷ3$`0uOFd^3NrA)׿ )HqR:ba$lI̻$K2#y0Vq _ s1ClqP2V$li-k)m|\V04w$>ܗAސI偘8(hmSp%VNQ-m[쎦f>(X_7zK/4la@x9O:d6Ż=A /3AyBPTCq9qP^K~7= s2NAI/Am}o&Tˀ2PL 𔔵zVں*{-&MqI& uy+Yߟgn O Pn&)1y ڞ^SLsn2C) @<'aޟ<St:[`5o!b٦..]"_ !%Br%>yyz~1wD}i{v1/+Q+aF8kM}yAlL+l~oͮ*GLּmҪ;z'њ8lJh)cYވqIV+$b,u\mg6}ogo N[n*y4P{3]OdNkܠߋp}EO DY>ÛuٯAF~v)o[|͏cci+i3ͱY}m0QU{">qZ;~#r'ȭ9$ 'N^aak9~z~mf}7XX7ۜ~ 4(W%yUr2qUVPTL h0shLPFx̝з@= y._ݳ~=ɝˤ[b-::kϑɯ@#ɝ7D]CwBTݳ!bAwA)?7^/&(SQ]zK{Mh6|\-tH#%-# =Q1f? HB0k[E7鐯nDW[^$]i4#sZ90}''uR=2طùwC== ςt^3mInz 3'&0G;ɗئzz陋ɷWg3Wk+L?z+ங?g:Ja_N0<,L+qq-Loaj`l)DUxi@X_Q$.;Y:H(Hc o+F@^*JzH낔09P0 Pxf3ؒ*57CW-&Eƽ:Ca auX%e~tCwK!,EQo{ʊfZ@ y X鉥,h}{OKMnNFoPK0J:PK28 styles.xml\_o6ߧ04to$ic/Nѭ HwZl6(PTKqodGR([rƉ@-PԼ;Q c/,oZ#, ja}}e隅!<`~XةR8NZ2JI:Qӹ,qa47j*=\)?RfgVʦuѦLMu5~H2gQ⁒naH掳lƛ1+Ǜf^qR{Na'uM,Zb$ު&ʼ Ӧ_uj_#9ϔr=U.rr>P*xu.[$6c@ovulhoo8AuQDEM瀆eʗqGvt[Ť3RHռ,JMQwuUa>R,5=,,w&}c'\me4/#="rV%k[n8Rcv!(.Z$2iUD5r$} VJB KTpB"jO-(dp(8gy@HGA"2(+KR@iTqE؆&eP i A K-L@jqh+{c /,"4"| y(U@3&BQ2@+,>|nOsxFM.tPA9Qp GP!rܬ?<1)*KXmm kc] RzdwlWe!a!<\? gWFF_p, t_.z`0&PZFPfj$(697s%B/M2C!%{NVkCq]@$6 d]m!]/,z$0(T+ˌR,FZ(lG-[oaoђQO9mzFCfX0C:%(,\ %HlS2S8Bx*WGCUx:}u4NώӞ{4.Bmnik!07t"+n> ,ڀn5ce+Jcorlq,[M[!mDQ"Aw@0dS"XsvN,>=+]嬈+<VEG=63Y6;onECa Vȥ 1(1l)oEE5҉e2悊ya˯"j>)hT{S霱wٗ)i\ϻ\.3@So3$%*ȡJKCפZ<['yd~7OPzG5K!5p+!rѵC&QFzKm0ɂ<̼8yL'eyNo;o{6 ۞xmjJ:Ӿr:WʐSzմIOfrS4ݛZMzu]IGs:isuǨ_Z`tt oW`{l6\#6TD#Ҍ~5W*ޣhW2UY}͒IӖvv_gBPpmY&jɵte۱=[5_wikջo'm #bcОhAW_ aKsp/ȿ[q*eZ2ћNNRB%޶9$_}6{5+ki=ogY#%Vb\[նrb[W@SaSnPKmEPK28meta.xml0} j!ɂCJ]m犵'[mM@g(^nmmeH8 @2Ņ<'/ՇBN-HZu0Hc {-0T-jUIB4ȭw^(5gL<>;\SahU0DOpkS]i0C~(}N_,>dq؋Ӏ."8C1A$;BM|bYkwU};kA4GYo@#'!>VV_I$[dnv36]zw.v/CmTPK?ώtPK28Thumbnails/thumbnail.png}Vy4_hB EdM!Kh([P- 0T2c1YdRcyu{],f8D0h` p 2ʏ %ng,=wo.L'cY{Q0/ux3 MP ̀gЂ_We]6^x̃hVOqwߴniIs,]KݴeZ7AurzǧJR`_*z*xN `f$D!ο7]r RH)iF-m^\}n֢jXnXj'(LB[,7d-Z;''KgYL'Lw&& ZBC9]~~:+MՌZ|~4r/Q;?Oy}R026N_tqܮWz>W]xsNĿhݾZySci';P6 mKj)n]|}goTz.z3H"G] R+EY\J/o"tpKBb{T±_8]hE0!M_MgcBFfvNhdzlB^( .$#HQ5 2QEVV&5[K#v%=~cּE9\@3seS) ;ktMQRS&+񣕷ҍ.h.t,lp87YSٽ׸=s`bv2\[ } Yx <^յuĮϚO|zC=l^\J gX5bK3Lk-Med "07}g`ǼN<-iWaQ i9ۓ>[VD앒krɊ sݢ{ iz3'PW;4lޞCrlUh/_dt\VJegpB^6ZE,|Bۧqksd4xWQ3^#U>i4%Wݭ,2L)wvBbxh 0t5TH\Mڛ^"|Z/.1;BFe+iǤ|G[]k*(.Lm,0{*572, |OQUݐZe;wTr9+@0/m}=Fc|@d1QpB |wdw{M-RlG"Ea @c*& .$Ah4Ke\PΗTUjt> dȴ sv5@:vF`͎&w5j5m^\ELfFOY2OJNF6iBa#UW+8p8[r;-}%vgcRAUشf!3c_<Ã,T>qgT?oDHnlEG?Z.]uӪ|GnЫ_#ѝϘ fggǧyʍfjs]۱ә#@U36w!CC:_ (@ 5lIO+rnai b(Bc~[rf%zQPKLK PK28 settings.xmlZ[s6~0}hC0$]!aI7a+F,Jd qg<`Kwn>DRKjGyz"w(}sx(|~@g ɾaCaْ &!WUaqoqorZ<6R U `&d¯OsM[Td."o5zo#RAwh&3gQ eLCn,? Td CяkRS?]Z>,ÂrەrN|t4!2AGţPP'Sx q$56h }X^XE\;hoOEDP])2Pgy }|ޥYBȌRfT*xhk'Mz )u {*~`<xS{.]D/t*h GBeрF]2K+?c-5ӊ暨^0ӢBϠgRݓښpqsvթj$hIʣQ㮭G|hr'`!i"(>l&e38/4- 0 : TlMC`g~pPA5F&λ湏kpqW@\XAFL.} -N\-fj.0f T yb`yʝ뛣V4cՊą0$c.mʛwS<&Bϒ8b<(sT)i]EX|H!_Tʝz18{oIjN7IQׂpqr՛5\AkagMv@|6s-,2O\څ'.?PKANPK28.++mimetypePK28QConfigurations2/statusbar/PK28'Configurations2/accelerator/current.xmlPK28Configurations2/floater/PK28Configurations2/popupmenu/PK28NConfigurations2/progressbar/PK28Configurations2/menubar/PK28Configurations2/toolbar/PK28Configurations2/images/Bitmaps/PK280J: 1content.xmlPK28mE styles.xmlPK28?ώt[meta.xmlPK28LK PThumbnails/thumbnail.pngPK28gEj% settings.xmlPK28AN%META-INF/manifest.xmlPKK'seriation/vignettes/seriation.bib0000644000176200001440000004414213236106744016745 0ustar liggesusersThis file was created with JabRef 2.2. Encoding: ISO8859_1 @INCOLLECTION{seriation:Garfinkel:1985, author = {R. S. Garfinkel}, title = {Motivation and Modeling}, year = {1985}, chapter = {2}, pages = {17--36}, crossref = {seriation:Lawler:1985}, owner = {hahsler}, timestamp = {2007.03.27} } @INCOLLECTION{seriation:Arabie:1996, author = {P. Arabie and L. J. Hubert}, title = {An Overview of Combinatorial Data Analysis}, booktitle = {Clustering and Classification}, publisher = {World Scientific}, year = {1996}, editor = {P. Arabie and L. J. Hubert and G. De Soete}, pages = {5--63}, address = {River Edge, NJ}, owner = {hahsler}, timestamp = {2007.07.04} } @ARTICLE{seriation:Arabie:1990, author = {P. Arabie and L. J. Hubert}, title = {The Bond Energy Algorithm Revisited}, journal = {{IEEE} Transactions on Systems, Man, and Cybernetics}, year = {1990}, volume = {20}, pages = {268--74}, number = {1}, owner = {hahsler}, timestamp = {2007.04.10} } @ARTICLE{seriation:Bar-Joseph:2001, author = {Z. Bar-Joseph and E. D. Demaine and D. K. Gifford and T. Jaakkola}, title = {Fast Optimal Leaf Ordering for Hierarchical Clustering}, journal = {Bioinformatics}, year = {2001}, volume = {17}, pages = {22--29}, number = {1}, owner = {hahsler}, timestamp = {2007.03.27} } @INPROCEEDINGS{seriation:Bertin:1999, author = {J. Bertin}, title = {Graphics and Graphic Information Processing}, booktitle = {Readings in Information Visualization}, year = {1999}, editor = {S. K. Card and J. D. Mackinlay and B. Shneiderman}, pages = {62--65}, address = {San Francisco, CA, USA}, publisher = {Morgan Kaufmann Publishers Inc.}, book = {Readings in Information Visualization: Using Vision to Think}, isbn = {1-55860-533-9} } @BOOK{seriation:Bertin:1981, title = {Graphics and Graphic Information Processing}, publisher = {Walter de Gruyter}, year = {1981}, author = {Bertin, J}, address = {Berlin}, note = {Translated by William J. Berg and Paul Scott}, owner = {hahsler}, timestamp = {2007.04.05} } @ARTICLE{seriation:Brusco:2007, author = {Brusco, M. and K{\"o}hn, H. F. and Stahl, S.}, title = {Heuristic Implementation of Dynamic Programming for Matrix Permutation Problems in Combinatorial Data Analysis}, journal = {Psychometrika}, year = {2008}, volume = {73}, number = {3}, pages = {503--522}, owner = {hahsler}, timestamp = {2007.07.12} } @BOOK{seriation:Brusco:2005, title = {Branch-and-Bound Applications in Combinatorial Data Analysis}, publisher = {Springer}, year = {2005}, author = {Michael Brusco and Stephanie Stahl}, owner = {hahsler}, timestamp = {2007.07.04} } @ARTICLE{seriation:Caraux:2005, author = {Caraux, G. and Pinloche, S.}, title = {Permutmatrix: A Graphical Environment to Arrange Gene Expression Profiles in Optimal Linear Order}, journal = {Bioinformatics}, year = {2005}, volume = {21}, pages = {1280--1281}, number = {7}, owner = {hahsler}, timestamp = {2007.03.19} } @ARTICLE{seriation:Chen:2002, author = {Chun-Houh Chen}, title = {Generalized Association Plots: Information Visualization via Iteratively Generated Correlation Matrices}, journal = {Statistica Sinica}, year = {2002}, volume = {12}, pages = {7--29}, number = {1}, owner = {hahsler}, timestamp = {2007.03.19} } @MANUAL{seriation:Chessel:2007, title = {\pkg{ade4}: Analysis of Ecological Data : Exploratory and Euclidean methods in Multivariate data analysis and graphical display}, author = {Daniel Chessel and Anne-Beatrice Dufour and Stephane Dray}, year = {2007}, note = {R package version 1.4-3}, url = {http://CRAN.R-project.org/package=ade4}, owner = {hahsler}, timestamp = {2007.08.07} } @article{seriation:Dray:2007, author = "Stephane Dray and Anne-Beatrice Dufour", title = "The ade4 Package: Implementing the Duality Diagram for Ecologists", journal = "Journal of Statistical Software", volume = "22", number = "4", day = "4", month = "6", year = "2007", URL = "http://www.jstatsoft.org/v22/i04", } @ARTICLE{seriation:Eisen:1998, author = {Michael B. Eisen and Paul T. Spellman and Patrick O. Browndagger and David Botstein}, title = {Cluster Analysis and Display of Genome-wide Expression Patterns}, journal = {Proceedings of the National Academy of Science of the United States}, year = {1998}, volume = {95}, pages = {14863--14868}, number = {25}, month = {December}, owner = {hahsler}, timestamp = {2007.04.05} } @INPROCEEDINGS{seriation:Falguerolles:1997, author = {Antoine de Falguerolles and Felix Friedrich and G{\"u}nther Sawitzki}, title = {A Tribute to {J}. {B}ertin's Graphical Data Analysis}, booktitle = {SoftStat '97 (Advances in Statistical Software 6)}, year = {1997}, editor = {W. Bandilla and F. Faulbaum}, pages = {11--20}, publisher = {Lucius \& Lucius}, owner = {hahsler}, timestamp = {2007.02.22} } @ARTICLE{seriation:Gale:1984, author = {N. Gale and W. C. Halperin and C. M. Costanzo}, title = {Unclassed Matrix Shading and Optimal Ordering in Hierarchical Cluster Analysis}, journal = {Journal of Classification}, year = {1984}, volume = {1}, pages = {75--92}, owner = {hahsler}, timestamp = {2007.04.06} } @ARTICLE{seriation:Gruvaeus:1972, author = {Gruvaeus, G. and Wainer, H.}, title = {Two Additions to Hierarchical Cluster Analysis}, journal = {British Journal of Mathematical and Statistical Psychology}, year = {1972}, volume = {25}, pages = {200--206}, owner = {hahsler}, timestamp = {2007.03.27} } @MANUAL{seriation:Hahsler:2007b, title = {\pkg{TSP}: Traveling Salesperson Problem (TSP)}, author = {Michael Hahsler and Kurt Hornik}, year = {2007}, url = {http://CRAN.R-project.org/package=TSP}, note = {R package version 0.2-2} } @ARTICLE{seriation:Hahsler:2007, AUTHOR = {Michael Hahsler and Kurt Hornik}, TITLE = {{TSP} -- {I}nfrastructure for the Traveling Salesperson Problem}, JOURNAL = {Journal of Statistical Software}, YEAR = {2007}, VOLUME = {23}, PAGES = {1-21}, NUMBER = {2}, MONTH = {December}, URL = "http://www.jstatsoft.org/v23/i02", } @BOOK{seriation:Hartigan:1975, title = {Clustering Algorithms}, publisher = {Wiley}, year = {1975}, author = {John A. Hartigan}, owner = {hahsler}, timestamp = {2007.04.10} } @ARTICLE{seriation:Hartigan:1967, author = {J. A. Hartigan}, title = {Representation of Similarity Matrices by Trees}, journal = {Journal of the American Statistical Association}, year = {1967}, volume = {62}, pages = {1140--1158}, number = {320}, owner = {hahsler}, timestamp = {2007.04.10} } @ARTICLE{seriation:Held:1962, author = {M. Held and R. M. Karp}, title = {A Dynamic Programming Approach to Sequencing Problems}, journal = {Journal of {SIAM}}, year = {1962}, volume = {10}, pages = {196--210}, owner = {hahsler}, timestamp = {2007.03.27} } @ARTICLE{seriation:Hubert:1974, author = {L. J. Hubert}, title = {Some Applications of Graph Theory and Related Nonmetric Techniques to Problems of Approximate Seriation: The Case of Symmetric Proximity Measures}, journal = {British Journal of Mathematical Statistics and Psychology}, year = {1974}, volume = {27}, pages = {133--153}, owner = {hahsler}, timestamp = {2007.03.26} } @BOOK{seriation:Hubert:2001, title = {Combinatorial Data Analysis: Optimization by Dynamic Programming}, publisher = {Society for Industrial Mathematics}, year = {2001}, author = {Lawrence Hubert and Phipps Arabie and Jacqueline Meulman}, owner = {hahsler}, timestamp = {2007.07.04} } @ARTICLE{seriation:Hubert:1981, author = {L. J. Hubert and R. G. Golledge}, title = {Matrix Reorganization and Dynamic Programming: Applications to Paired Comparisons and Unidimensional Seriation}, journal = {Psychometrika}, year = {1981}, volume = {46}, pages = {429--441}, number = {4}, owner = {hahsler}, timestamp = {2007.03.26} } @MANUAL{seriation:Hurley:2007, title = {\pkg{gclus}: Clustering Graphics}, author = {Catherine Hurley}, year = {2007}, url = {http://CRAN.R-project.org/package=gclus}, note = {R package version 1.2} } @INPROCEEDINGS{seriation:Ihm:2005, author = {Peter Ihm}, title = {A Contribution to the History of Seriation in Archaeology}, booktitle = {Classification - the Ubiquitous Challenge, Proceedings of the 28th Annual Conference of the Gesellschaft f{\"u}r Klassifikation e.V., University of Dortmund, March 9--11, 2004}, year = {2005}, editor = {Weihs, Claus and Gaul, Wolfgang}, series = {Studies in Classification, Data Analysis, and Knowledge Organization}, pages = {307--316} } @INCOLLECTION{seriation:Kendall:1971, author = {Kendall, D. G.}, title = {Seriation from Abundance Matrices}, booktitle = {Mathematics in the Archaeological and Historical Sciences}, year = {1971}, editor = {F.R. Hodson and D.G. Kendall and P. Tautu}, pages = {214--252}, owner = {hahsler}, timestamp = {2007.03.19} } @INCOLLECTION{seriation:Leeuw:2005, author = {Jan de Leeuw}, title = {Unidimensional Scaling}, booktitle = {Encyclopedia of Statistics in Behavioral Science}, publisher = {Wiley}, year = {2005}, editor = {B.S. Everitt and D.C. Howelll}, volume = {4}, owner = {hahsler}, timestamp = {2007.03.19} } @ARTICLE{seriation:Lenstra:1974, author = {J. K. Lenstra}, title = {Clustering a Data Array and the Traveling-Salesman Problem}, journal = {Operations Research}, year = {1974}, volume = {22}, pages = {413--414}, number = {2}, owner = {hahsler}, timestamp = {2007.04.16} } @ARTICLE{seriation:Lin:1973, author = {S. Lin and B. W. Kernighan}, title = {An Effective Heuristic Algorithm for the Traveling-Salesman Problem}, journal = {Operations Research}, year = {1973}, volume = {21}, pages = {498--516}, number = {2}, owner = {hahsler}, timestamp = {2007.03.27} } @ARTICLE{seriation:Ling:1973, author = {Robert L. Ling}, title = {A Computer Generated Aid for Cluster Analysis}, journal = {Communications of the {ACM}}, year = {1973}, volume = {16}, pages = {355--361}, number = {6}, address = {New York, NY, USA}, publisher = {ACM Press} } @ARTICLE{seriation:Marcotorchino:1987, author = {F. Marcotorchino}, title = {Block Seriation Problems: A Unified Approach}, journal = {Applied Stochastic Models and Data Analysis}, year = {1987}, volume = {3}, pages = {73--91}, owner = {hahsler}, timestamp = {2007.04.17} } @ARTICLE{seriation:McCormick:1972, author = {William T. McCormick and Paul J. Schweitzer and Thomas W. White}, title = {Problem Decomposition and Data Reorganization by a Clustering Technique}, journal = {Operations Research}, year = {1972}, volume = {20}, pages = {993--1009}, number = {5}, owner = {hahsler}, timestamp = {2007.04.10} } @MANUAL{seriation:Meyer:2007, title = {\pkg{proxy}: Distance and Similarity Measures}, author = {David Meyer and Christian Buchta}, year = {2007}, url = "http://CRAN.R-project.org/package=proxy", note = {R package version 0.1} } @BOOK{seriation:Murtagh:1985, title = {Multidimensional Clustering Algorithms}, publisher = {Physica-Verlag}, year = {1985}, author = {Fionn Murtagh}, volume = {4}, series = {Compstat Lectures}, address = {Vienna}, owner = {hahsler}, timestamp = {2007.04.10} } @ARTICLE{seriation:Niermann:2005, author = {Niermann, Stefan}, title = {Optimizing the Ordering of Tables With Evolutionary Computation}, journal = {The American Statistician}, year = {2005}, volume = {59}, pages = {41--46}, number = {1}, owner = {hahsler}, timestamp = {2007.03.16} } @MANUAL{seriation:Oksanen:2007, title = {\pkg{vegan}: Community Ecology Package}, author = {Jari Oksanen and Roeland Kindt and Pierre Legendre and Bob O'Hara}, year = {2007}, note = {R package version 1.8-6}, owner = {hahsler}, url = {http://CRAN.R-project.org/package=vegan}, timestamp = {2007.08.07} } @ARTICLE{seriation:Padberg:1990, author = {M. Padberg and G. Rinaldi}, title = {Facet Identification for the Symmetric Traveling Salesman Polytope}, journal = {Mathematical Programming}, year = {1990}, volume = {47}, pages = {219--257}, number = {2}, address = {Secaucus, NJ, USA}, issn = {0025-5610}, owner = {hahsler}, publisher = {Springer-Verlag New York, Inc.}, timestamp = {2007.03.27} } @ARTICLE{seriation:Petrie:1899, author = {Petrie, F. W. M.}, title = {Sequences in Prehistoric Remains}, journal = {Journal of the Anthropological Institute}, year = {1899}, volume = {29}, pages = {295--301}, owner = {hahsler}, timestamp = {2007.03.19} } @ARTICLE{seriation:Robinson:1951, author = {W. S. Robinson}, title = {A Method for Chronologically Ordering Archaeological Deposits}, journal = {American Antiquity}, year = {1951}, volume = {16}, pages = {293--301}, owner = {hahsler}, timestamp = {2007.03.19} } @ARTICLE{seriation:Rosenkrantz:1977, author = {Daniel J. Rosenkrantz and Richard E. Stearns and Philip M. Lewis, II}, title = {An Analysis of Several Heuristics for the Traveling Salesman Problem}, journal = {{SIAM} Journal on Computing}, year = {1977}, volume = {6}, pages = {563--581}, number = {3}, owner = {hahsler}, timestamp = {2007.03.27} } @ARTICLE{seriation:Rousseeuw:1987, author = {Rousseeuw, P. J.}, title = {Silhouettes: A Graphical Aid to the Interpretation and Validation of Cluster Analysis}, journal = {Journal of Computational and Applied Mathematics}, year = {1987}, volume = {20}, pages = {53--65}, number = {1}, owner = {hahsler}, timestamp = {2007.04.10} } @BOOK{seriation:Sneath:1973, title = {Numerical Taxonomy}, publisher = {Freeman and Company}, year = {1973}, author = {Peter H. A. Sneath and Robert R. Sokal}, address = {San Francisco}, owner = {hahsler}, timestamp = {2007.04.06} } @ARTICLE{seriation:Strehl:2003, author = {Strehl, A. and Ghosh, J.}, title = {Relationship-based Clustering and Visualization for High-dimensional Data Mining}, journal = {{INFORMS} Journal on Computing}, year = {2003}, volume = {15}, pages = {208--230}, number = {2}, owner = {hahsler}, timestamp = {2007.04.10} } @BOOK{seriation:Gutin:2002, title = {The Traveling Salesman Problem and Its Variations}, publisher = {Kluwer}, year = {2002}, editor = {G. Gutin and A. P. Punnen}, volume = {12}, series = {Combinatorial Optimization}, address = {Dordrecht}, owner = {hahsler}, timestamp = {2006.11.29} } @BOOK{seriation:Lawler:1985, title = {The Traveling Salesman Problem}, publisher = {Wiley}, year = {1985}, editor = {Lawler, E. L. and Lenstra, J. K. and Rinnooy Kan, A. H. G. and Shmoys, D. B.}, address = {New York}, owner = {hahsler}, timestamp = {2007.03.27} } @Book{seriation:Fowler:2004, author = {Martin Fowler}, title = {UML Distilled: A Brief Guide to the Standard Object Modeling Language}, publisher = {Addison-Wesley Professional}, edition = {third}, year = 2004, } @article{seriation:Jurman:2008, author = {Jurman, Giuseppe and Merler, Stefano and Barla, Annalisa and Paoli, Silvano and Galea, Antonio and Furlanello, Cesare }, journal = {Bioinformatics}, month = {January}, number = {2}, pages = {258--264}, priority = {3}, title = {Algebraic Stability Indicators for Ranked Lists in Molecular Profiling}, volume = {24}, year = {2008} } @Manual{seriation:Hornik+Meyer:2008, title = {\pkg{relations}: Data Structures and Algorithms for Relations}, author = {Kurt Hornik and David Meyer}, year = {2008}, url = {http://CRAN.R-project.org/package=relations}, note = {R package version 0.3-1}, } @article{seriation:Hahsler+Hornik:2008, author = {Michael Hahsler and Kurt Hornik and Christian Buchta}, title = {Getting Things in Order: An Introduction to the {R} Package seriation}, journal = {Journal of Statistical Software}, year = {2008}, volume = {25}, pages = {1--34}, number = {3}, month = {March}, issn = {1548-7660}, url = {http://www.jstatsoft.org/v25/i03}, } @article{seriation:Hahsler+Kornik:2011, author = {Michael Hahsler and Kurt Hornik}, title = {Dissimilarity Plots: {A} Visual Exploration Tool for Partitional Clustering}, journal = {Journal of Computational and Graphical Statistics}, year = {2011}, volume = {10}, number = {2}, pages = {335--354}, } @article{hahsler:Hahsler2016d, author = {Michael Hahsler}, title = {An Experimental Comparison of Seriation Methods For One-Mode Two-Way Data}, journal = {European Journal of Operational Research}, year = {2017}, volume = {257}, pages = {133--143}, number = {}, month = {February}, } @INPROCEEDINGS{seriation:Ding:2004, author = {Chris Ding and Xiaofeng He}, title = {Linearized cluster assignment via spectral ordering}, booktitle = {Proceedings of the Twenty-first International Conference on Machine Learning (ICML '04)}, year = {2004}, pages = {30}, publisher = {ACM Press} } @INBOOK{seriation:Burkard:1998, author = {Rainer E. Burkard and Eranda Cela and Panos M. Pardalos and Leonidas S. Pitsoulis}, title = {The Quadratic Assignment Problem}, year = {1998}, booktitle = {Handbook of Combinatorial Optimization}, editor = {P. Pardalos and D.-Z. Du}, publisher = {Springer Verlag} } @inproceedings{seriation:Barnard:1993, author = {Barnard, S. T. and Pothen, A. and Simon, H. D.}, title = {A Spectral Algorithm for Envelope Reduction of Sparse Matrices}, booktitle = {Proceedings of the 1993 ACM/IEEE Conference on Supercomputing}, series = {Supercomputing '93}, year = {1993}, location = {Portland, Oregon, USA}, pages = {493--502}, publisher = {ACM}, address = {New York, NY, USA}, } @article {seriation:Hubert:1976, author = {Hubert, Lawrence and Schultz, James}, title = {Quadratic Assignment as a General Data Analysis Strategy}, journal = {British Journal of Mathematical and Statistical Psychology}, volume = {29}, number = {2}, publisher = {Blackwell Publishing Ltd}, issn = {2044-8317}, pages = {190--241}, year = {1976}, } seriation/vignettes/seriation.Rnw0000644000176200001440000024016713236107323016756 0ustar liggesusers\documentclass[nojss]{jss} \usepackage[english]{babel} %\documentclass[fleqn, a4paper]{article} %\usepackage{a4wide} %\usepackage[round,longnamesfirst]{natbib} %\usepackage{graphicx,keyval,thumbpdf,url} %\usepackage{hyperref} %\usepackage{Sweave} \SweaveOpts{strip.white=true} \AtBeginDocument{\setkeys{Gin}{width=0.6\textwidth}} \usepackage[utf8]{inputenc} %% end of declarations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \usepackage{amsmath} \usepackage{amsfonts} %\newcommand{\strong}[1]{{\normalfont\fontseries{b}\selectfont #1}} \newcommand{\class}[1]{\mbox{\textsf{#1}}} \newcommand{\func}[1]{\mbox{\texttt{#1()}}} %\newcommand{\code}[1]{\mbox{\texttt{#1}}} %\newcommand{\pkg}[1]{\strong{#1}} \newcommand{\samp}[1]{`\mbox{\texttt{#1}}'} %\newcommand{\proglang}[1]{\textsf{#1}} \newcommand{\set}[1]{\mathcal{#1}} \newcommand{\sQuote}[1]{`{#1}'} \newcommand{\dQuote}[1]{``{#1}''} \newcommand\R{{\mathbb{R}}} \DeclareMathOperator*{\argmin}{argmin} \DeclareMathOperator*{\argmax}{argmax} %% almost as usual \author{Michael Hahsler\\Southern Methodist University \And Kurt Hornik\\Wirtschaftsuniversit\"at Wien \AND Christian Buchta\\Wirtschaftsuniversit\"at Wien} \title{Getting Things in Order:\\ An Introduction to the \proglang{R}~Package~\pkg{seriation}} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Michael Hahsler, Kurt Hornik, Christian Buchta} %% comma-separated \Plaintitle{Getting Things in Order: An Introduction to the R Package seriation} %% without formatting \Shorttitle{Getting Things in Order} %% a short title (if necessary) %% an abstract and keywords \Abstract{Seriation, i.e., finding a suitable linear order for a set of objects given data and a loss or merit function, is a basic problem in data analysis. Caused by the problem's combinatorial nature, it is hard to solve for all but very small sets. Nevertheless, both exact solution methods and heuristics are available. In this paper we present the package~\pkg{seriation} which provides an infrastructure for seriation with \proglang{R}. The infrastructure comprises data structures to represent linear orders as permutation vectors, a wide array of seriation methods using a consistent interface, a method to calculate the value of various loss and merit functions, and several visualization techniques which build on seriation. To illustrate how easily the package can be applied for a variety of applications, a comprehensive collection of examples is presented.} \Keywords{combinatorial data analysis, seriation, permutation, \proglang{R}} \Plainkeywords{combinatorial data analysis, seriation, permutation, R} %% without formatting \Address{ Michael Hahsler\\ Engineering Management, Information, and Systems\\ Lyle School of Engineering\\ Southern Methodist University\\ P.O. Box 750123 \\ Dallas, TX 75275-0123\\ E-mail: \email{mhahsler@lyle.smu.edu}\\ URL: \url{http://lyle.smu.edu/~mhahsler} Kurt Hornik\\ Department f\"ur Statistik \& Mathematik\\ Wirtschaftsuniversit\"at Wien\\ 1090 Wien, Austria\\ E-mail: \email{kurt.hornik@wu.ac.at}\\ URL: \url{http://statmath.wu.ac.at/~hornik/} Christian Buchta\\ Department f\"ur Welthandel\\ Wirtschaftsuniversit\"at Wien\\ 1090 Wien, Austria\\ E-mail: \email{christian.buchta@wu.ac.at}\\ URL: \url{http://www.wu.ac.at/itf/institute/staff/buchta} } \hyphenation{Brusco} \sloppy %% \VignetteIndexEntry{An Introduction to the R package seriation} \begin{document} %\title{Getting Things in Order: An introduction to the %R~package~\pkg{seriation}} %\author{Michael Hahsler, Kurt Hornik and Christian Buchta} \maketitle %\abstract{Seriation, i.e., finding a suitable linear order for a set of % objects given data and a loss or merit function, is a basic problem in % data analysis. Caused by the problem's combinatorial nature, it is % hard to solve for all but very small sets. Nevertheless, both exact % solution methods and heuristics are available. In this paper we % present the package~\pkg{seriation} which provides an infrastructure % for seriation with \proglang{R}. The infrastructure comprises data % structures to represent linear orders as permutation vectors, a wide % array of seriation methods using a consistent interface, a method to % calculate the value of various loss and merit functions, and several % visualization techniques which build on seriation. To illustrate how % easily the package can be applied for a variety of applications, a % comprehensive collection of examples is presented.} % <>= options(scipen=3, digits=4) ### for sampling set.seed(1234) @ \section{Introduction} A basic problem in data analysis, called \emph{seriation} or sometimes \emph{sequencing}, is to arrange all objects in a set in a linear order given available data and some loss or merit function in order to reveal structural information. Together with cluster analysis and variable selection, seriation is an important problem in the field of \emph{combinatorial data analysis}~\citep{seriation:Arabie:1996}. Solving problems in combinatorial data analysis requires the solution of discrete optimization problems which, in the most general case, involves evaluating all feasible solutions. Due to the combinatorial nature, the number of possible solutions grows with problem size (number of objects, $n$) by the order~$O(n!)$. This makes a brute-force enumerative approach infeasible for all but very small problems. To solve larger problems (currently with up to 40 objects), partial enumeration methods can be used. For example, \cite{seriation:Hubert:2001} propose dynamic programming and \cite{seriation:Brusco:2005} use a branch-and-bound strategy. For even larger problems only heuristics can be employed. It has to be noted that seriation has a rich history in archeology. \cite{seriation:Petrie:1899} was the first to use seriation as a formal method. He applied it to find a chronological order for graves discovered in the Nile area given objects found there. He used a cross-tabulation of grave sites and objects and rearranged the table using row and column permutations till all large values were close to the diagonal. In the rearranged table graves with similar objects are closer to each other. Together with the assumption that different objects continuously come into and go out of fashion, the order of graves in the rearranged table suggests a chronological order. Initially, the rearrangement of rows and columns of this contingency table was done manually and the adequacy was only judged subjectively by the researcher. Later, \cite{seriation:Robinson:1951}, \cite{seriation:Kendall:1971} and others proposed measures of agreement between rows to quantify optimality of the resulting table. A comprehensive description of the development of seriation in archeology is presented by \cite{seriation:Ihm:2005}. Techniques related to seriation are also popular in several other fields. Especially in ecology scaling techniques are used under the name \emph{ordination}. For these applications several \proglang{R} packages already exist (e.g., \pkg{ade4}~\citep{seriation:Chessel:2007,seriation:Dray:2007} and \pkg{vegan}~\citep{seriation:Oksanen:2007}). This paper describes the new package \pkg{seriation} which differs from existing packages in the following ways: \begin{itemize} \item \pkg{seriation} provides a flexible infrastructure for seriation; \item \pkg{seriation} focuses on seriation as a combinatorial optimization problem. \end{itemize} This paper starts with a formal introduction of the seriation problem as a combinatorial optimization problem in Section~\ref{sec:seriation}. In Section~\ref{sec:methods} we give an overview of seriation methods. In Section~\ref{sec:infrastructure} we present the infrastructure provided by the package~\pkg{seriation}. Several examples and applications for seriation are given in Section~\ref{sec:example}. Section~\ref{sec:conclusion} concludes. A previous version of this manuscript was published in the \emph{Journal of Statistical Software} \citep{seriation:Hahsler+Hornik:2008}. \section{Seriation as a combinatorial optimization problem} \label{sec:seriation} To seriate a set of $n$ objects $\{O_1,\dots,O_n\}$ one typically starts with an $n \times n$ symmetric dissimilarity matrix~$\mathbf{D} = (d_{ij})$ where $d_{ij}$ for $1 \le i,j \le n$ represents the dissimilarity between objects $O_i$ and $O_j$, and $d_{ii} = 0$ for all~$i$. We define a permutation function $\Psi$ as a function which reorders the objects in $\mathbf{D}$ by simultaneously permuting rows and columns. The seriation problem is to find a permutation function $\Psi^*$ %$\{1,\dots,n\} \rightarrow \{1,\dots,n\}$, i.e. a %bijection that maps the set of indices of the objects (and equally of rows and %columns of $\mathbf{D}$) onto itself, which optimizes the value of a given loss function~$L$ or merit function~$M$. This results in the optimization problems \begin{equation} \Psi^* = \argmin_\Psi L(\Psi(\mathbf{D})) \quad \text{or} \quad \Psi^* = \argmax_\Psi M(\Psi(\mathbf{D})), \end{equation} respectively. %This is clearly a hard discrete optimization problem since the number of %possible permutations is $n!$ which makes an exhaustive %search for sets with a medium to large number of objects infeasible. %Partial enumeration methods and heuristics can be used. Such methods are %presented in Section~\ref{sec:methods}. %But first, we review commonly used loss functions in the following section. %\marginpar{two-mode data missing} A symmetric dissimilarity matrix is known as \emph{two-way one-mode} data since it has columns and rows (two-way) but only represents one set of objects (one-mode). Seriation is also possible for two-way two-mode data which are represented by a general nonnegative matrix. In such data columns and rows represent two sets of objects which are reordered simultaneously. For loss/merit functions for two-way two-mode data the optimal order of columns can depend of the order of rows and vice versa or it can be independent allowing for breaking the optimization down into two separate problems, one for the columns and one for the rows. Another way to deal with the seriation for two-way two-mode data is to calculate two dissimilarity matrices, one for each mode, and then solve two seriation problems for two-way one-mode data. Furthermore, seriation can be generalized to $k$-way $k$-mode data in the form of a $k$-dimensional array by defining suitable loss/merit functions for such data or by breaking the problem down into several lower dimensional independent problems. To assess the complexity of seriation of $k$-way $k$-mode data, let us assume the data is a $k$-dimensional array with the dimensions containing $n_1, n_2, \ldots, n_k$ objects. If the loss/merit function allows for separating the problem into $k$ independent problems, the problem size is just the sum of the individual problems. By using complete enumeration the size is $O(\sum_{i=1}^k{n_i!})$. If the problem is not separable and the optimal seriation of each dimension depends on the order of the objects of the other dimensions, the problem size is $O((\sum_{i=1}^k{n_i})!)$. For example for $k=5$ and all dimensions containing 5 objects, the search space for separable dimensions is only 600 while without separability it is larger than $10^{25}$ clearly too big to be solvable in reasonable time. This shows that for data with even only a few dimensions and a few objects each, finding the optimal solution is infeasible and loss/merit functions which allow for separating the problem are highly desirable. In the following subsections, we review some commonly employed loss/merit functions. Most functions are used for two-way one-mode data but the measure of effectiveness and stress can be also used for two-way two-mode data. For the implementation of various loss or merit measures see function~\func{criterion} in Section~\ref{sec:infrastructure}. %\section{Loss functions} %\label{sec:criteria} %In the literature several loss functions are suggested. %We review the most commonly used functions. \subsection{Column/row gradient measures} A symmetric dissimilarity matrix where the values in all rows and columns only increase when moving away from the main diagonal is called a perfect \emph{anti-Robinson matrix} after the statistician \cite{seriation:Robinson:1951}. Formally, an $n \times n$ dissimilarity matrix $\mathbf{D}$ is in anti-Robinson form if and only if the following two gradient conditions hold~\citep{seriation:Hubert:2001}: \begin{align} \text{within rows:} & \quad d_{ik} \le d_{ij} \quad \text{for} \quad 1 \le i < k < j \le n; \\ \text{within columns:} & \quad d_{kj} \le d_{ij} \quad \text{for} \quad 1 \le i < k < j \le n. \end{align} In an anti-Robinson matrix the smallest dissimilarity values appear close to the main diagonal, therefore, the closer objects are together in the order of the matrix, the higher their similarity. This provides a natural objective for seriation. It has to be noted that $\mathbf{D}$ can be brought into a perfect anti-Robinson form by row and column permutation whenever $\mathbf{D}$ is an ultrametric or $\mathbf{D}$ has an exact Euclidean representation in a single dimension~\citep{seriation:Hubert:2001}. However, for most data only an approximation to the anti-Robinson form is possible. A suitable merit measure which quantifies the divergence of a matrix from the anti-Robinson form was given by \cite{seriation:Hubert:2001} as \begin{equation} M(\mathbf{D}) = \sum_{i y. \end{cases} \end{equation} It results in the raw number of triples satisfying the gradient constraints minus triples which violate the constraints. The second function is defined as: \begin{equation} f(z,y) = |y-z|\mathrm{sign}(y-z) = y-z \end{equation} It weighs each satisfaction or violation by its magnitude given by the absolute difference between the values. \subsection{Anti-Robinson events} An even simpler loss function can be created in the same way as the gradient measures above by concentrating on violations only. \begin{equation} L(\mathbf{D}) = \sum_{i y \quad \text{and} \\ 0 \quad \text{otherwise.} \end{cases} \end{equation} $I(\cdot)$ is an indicator function returning $1$ only for violations. \cite{seriation:Chen:2002} presented a formulation for an equivalent loss function and called the violations \emph{anti-Robinson events}. \cite{seriation:Chen:2002} also introduced a weighted versions of the loss function resulting in \begin{equation} f(z, y) = |y-z|I(z, y) \end{equation} using the absolute deviations as weights. \subsection{Hamiltonian path length} The dissimilarity matrix $\mathbf{D}$ can be represented as a finite weighted graph $G = (\Omega,E)$ where the set of objects~$\Omega$ constitute the vertices and each edge~$e_{ij} \in E$ between the objects $O_i, O_j \in \Omega$ has a weight~$w_{ij}$ associated which represents the dissimilarity~$d_{ij}$. Such a graph can be used for seriation~\citep[see, e.g.,][]{seriation:Hubert:1974,seriation:Caraux:2005}. An order~$\Psi$ of the objects can be seen as a path through the graph where each node is visited exactly once, i.e., a Hamiltonian path. Minimizing the Hamiltonian path length results in a seriation optimal with respect to dissimilarities between neighboring objects. The loss function based on the Hamiltonian path length is: \begin{equation} L(\mathbf{D}) = \sum_{i=1}^{n-1} d_{i,i+1}. \end{equation} Note that the length of the Hamiltonian path is equal to the value of the \emph{minimal span loss function} \citep[as used by][]{seriation:Chen:2002}, and both notions are related to the \emph{traveling salesperson problem}~\citep{seriation:Gutin:2002}. \subsection{Inertia criterion} Another way to look at the seriation problem is not to focus on placing small dissimilarity values close to the diagonal, but to push large values away from it. A function to quantify this is the moment of inertia of dissimilarity values around the diagonal \citep{seriation:Caraux:2005} defined as \begin{equation} M(\mathbf{D}) = \sum_{i=1}^n \sum_{j=1}^n d_{ij}|i-j|^2. \end{equation} $|i-j|^2$ is used as a measure for the distance to the diagonal and $d_{ij}$ gives the weight. This is a merit function since the sum increases when higher dissimilarity values are placed farther away from the diagonal. \subsection{Least squares criterion} Another natural loss function for seriation is to quantify the deviations between the dissimilarities in $\mathbf{D}$ and the rank differences of the objects. Such deviations can be measured, e.g, by the sum of squares of deviations \citep{seriation:Caraux:2005} defined by \begin{equation} L(\mathbf{D}) = \sum_{i=1}^n \sum_{j=1}^n (d_{ij} - |i-j|)^2, \end{equation} where $|i-j|$ is the rank difference or gap between $O_i$ and $O_j$. The least squares criterion defined here is related to uni-dimensional scaling~\citep{seriation:Leeuw:2005}, where the objective is to place all $n$ objects on a straight line using a position vector~$\mathbf{z} = z_1,z_2,\ldots,z_n$ such that the dissimilarities in $\mathbf{D}$ are preserved by the relative positions in the best possible way. The optimization problem of uni-dimensional scaling is to find the position vector~$\mathbf{z^*}$ which minimizes $\sum_{i=1}^n \sum_{j=1}^n (d_{ij} - |z_i-z_j|)^2$. This is close to the seriation problem, but in addition to the ranking of the objects also takes the distances between objects on the resulting scale into account. Note that if Euclidean distance is used to calculate $\mathbf{D}$ from a data matrix~$\mathbf{X}$, using the order of the elements in $\mathbf{X}$ as they occur projected on the first principal component of $\mathbf{X}$ minimizes the loss function of uni-dimensional scaling (using squared distances). Using this order, also provides a good solution for the least square seriation criterion. \subsection{Linear Seriation Criterion} The Linear Seriation Criterion (Hubert and Schultz 1976) weights the distances with the absolute rank differences. $$L(\mathbf{D}) \sum_{i=1}^n \sum_{j=1}^n d_{ij} (-|i-j|)$$ \subsection{2-Sum Problem} The 2-Sum loss criterion \citep{seriation:Barnard:1993} multiplies the similarity between objects with the squared rank differences. $$L(\mathbf{D}) \sum_{i,j=1}^p \frac{1}{1+d_{ij}} (i-j)^2,$$ where $s_{ij} = \frac{1}{1+d_{ij}}$ represents the similarity between objects $i$ and $j$. \subsection{Measure of effectiveness} \label{sec:ME} \cite{seriation:McCormick:1972} defined the \emph{measure of effectiveness (ME)} for an $n \times m$ matrix~$\mathbf{X} = (x_{ij})$ as \begin{equation} M(\mathbf{X}) = \frac{1}{2} \sum_{i=1}^{n} \sum_{j=1}^{m} x_{ij}[x_{i,j+1}+x_{i,j-1}+ x_{i+1,j}+x_{i-1,j}] \label{equ:ME} \end{equation} with, by convention $x_{0,j}=x_{n+1,j}=x_{i,0}=x_{i,m+1}=0$. ME is maximized if each element is as closely related numerically to its four neighboring elements as possible. ME was developed for two-way two-mode data, however, ME can also be used for a symmetric matrix (one-mode data) and gets maximal only if all large values are grouped together around the main diagonal. Note that the definition in equation~(\ref{equ:ME}) can be rewritten as \begin{equation} M(\mathbf{X}) = \frac{1}{2} \sum_{i=1}^{n} \sum_{j=1}^{m} x_{ij}[x_{i,j+1}+x_{i,j-1}] + \sum_{i=1}^{n} \sum_{j=1}^{m} x_{ij}[x_{i+1,j}+x_{i-1,j}] \end{equation} showing that the contributions of column and row order to the merit function are independent. \subsection{Stress} \label{sec:stress} Stress measures the conciseness of the presentation of a matrix (two-mode data) and can be seen as a purity function which compares the values in a matrix with their neighbors. The stress measures used here are computed as the sum of squared distances of each matrix entry from its adjacent entries. \cite{seriation:Niermann:2005} defined for an $n \times m$ matrix~$\mathbf{X} = (x_{ij})$ two types of neighborhoods: \begin{itemize} \item The Moore neighborhood comprises the (at most) eight adjacent entries. The local stress measure for element~$x_{ij}$ is defined as \begin{equation} \sigma_{ij} = \sum_{k=\max(1,i-1)}^{\min(n,i+1)} \sum_{l=\max(1,j-1)}^{\min(m,j+1)} (x_{ij} - x_{kl})^2 \end{equation} \item The Neumann neighborhood comprises the (at most) four adjacent entries resulting in the local stress of $x_{ij}$ of \begin{equation} \sigma_{ij} = \sum_{k=\max(1,i-1)}^{\min(n,i+1)} (x_{ij} - x_{kj})^2 + \sum_{l=\max(1,j-1)}^{\min(m,j+1)} (x_{ij} - x_{il})^2 %(x_{ij} - x(i-1,j))^2 + (x_{ij} - x(i+1,j))^2 + %(x_{ij} - x(i,j-1))^2 + (x_{ij} - x(i,j+1))^2 \end{equation} \end{itemize} Both local stress measures can be used to construct a global measure for the whole matrix by summing over all entries which can be used as a loss function: \begin{equation} L(\mathbf{X}) = \sum_{i=1}^n \sum_{j=1}^m \sigma_{ij} \end{equation} The major difference between the Moore and the Neumann neighborhood is that for the later the contributions of row and column order to stress are independent. Stress can be also used as a loss function for symmetric proximity matrices (one-mode data). %, %since it can only be optimal, if large values are %concentrated around the main diagonal. Note also, that stress with Neumann neighborhood is related to the measure of effectiveness defined above (in Section~\ref{sec:ME}) since both measures are optimal if for each cell the cell and its four neighbors are numerically as similar as possible. \section{Seriation methods} \label{sec:methods} Solving the discrete optimization problem for seriation with most loss/merit functions is clearly very hard. The number of possible permutations for $n$ objects is $n!$ which makes an exhaustive search for sets with a medium to large number of objects infeasible. In this section, we describe some methods (partial enumeration, heuristics and other methods) which are typically used for seriation. For each method we state for which type of loss/merit functions it is suitable and whether it finds the optimum or is a heuristic. For the implementation of various seriation methods see function~\func{seriate} in Section~\ref{sec:infrastructure}. \subsection{Partial enumeration methods} Partial enumeration methods search for the exact solution of a combinatorial optimization problem. Exploiting properties of the search space, only a subset of the enormous number of possible combinations has to be evaluated. Popular partial enumeration methods which are used for seriation are \emph{dynamic programming}~\citep{seriation:Hubert:2001} and \emph{branch-and-bound}~\citep{seriation:Brusco:2005}. Dynamic programming recursively searches for the optimal solution checking and storing $2^n-1$ results. Although $2^n-1$ grows at a lower rate than $n!$ and is for $n \gg 3$ considerably smaller, the storage requirements of $2^n-1$ results still grow fast, limiting the maximal problem size severely. For example, for $n=30$ more than one billion results have to be calculated and stored, clearly a number too large for the main memory capacity of most current computers. Branch-and-bound has only very moderate storage requirements. The forward-branching procedure~\citep{seriation:Brusco:2005} starts to build partial permutations from left (first position) to right. At each step, it is checked if the permutation is valid and several fathoming tests are performed to check if the algorithm should continue with the partial permutation. The most important fathoming test is the boundary test, which checks if the partial permutation can possibly lead to a complete permutation with a better solution than the currently best one. In this way large parts of the search space can be omitted. However, in contrast to the dynamic programming approach, the reduction of search space is strongly data dependent and poorly structured data can lead to very poor performance. With branch-and-bound slightly larger problems can be solved than with dynamic programming in reasonable time. \cite{seriation:Brusco:2005} state that depending on the data, in some cases proximity matrices with 40 or more objects can be handled with current hardware. Partial enumeration methods can be used to find the exact solution independently of the loss/merit function. However, partial enumeration is limited to only relatively small problems. \subsection{Traveling salesperson problem solver} Seriation by minimizing the length of a Hamiltonian path through a graph is equal to solving a traveling salesperson problem. The traveling salesperson or salesman problem (TSP) is a well known and well researched combinatorial optimization problem~\citep[see, e.g.,][]{seriation:Gutin:2002}. The goal is to find the shortest tour that, starting from a given city, visits each city in a given list exactly once and then returns to the starting city. In graph theory a TSP tour is called a \emph{Hamiltonian cycle.} But for the seriation problem, we are looking for a Hamiltonian path. \cite{seriation:Garfinkel:1985} described a simple transformation of the TSP to find the shortest Hamiltonian path. An additional row and column of 0's is added (sometimes this is referred to as a \emph{dummy city}) to the original $n \times n$ dissimilarity matrix~$\mathbf{D}$. The solution of this $(n+1)$-city TSP, gives the shortest path where the city representing the added row/column cuts the cycle into a linear path. As the general seriation problem, solving the TSP is difficult. In the seriation case with $n+1$ cities, $n!$ tours have to be checked. However, despite this vast searching space, small instances can be solved efficiently using dynamic programming \citep{seriation:Held:1962} and larger instances of several hundred objects can be solved using \emph{branch-and-cut} algorithms~\citep{seriation:Padberg:1990}. For even larger instances or if running time is critical, a wide array of heuristics are available, ranging from simple nearest neighbor approaches to construct a tour~\citep{seriation:Rosenkrantz:1977} to complex heuristics like the Lin-Kernighan heuristic~\citep{seriation:Lin:1973}. A comprehensive overview of heuristics and exact methods can be found in \cite{seriation:Gutin:2002}. \subsection{Bond energy algorithm} The \emph{bond energy algorithm}~\citep[BEA;][]{seriation:McCormick:1972} is a simple heuristic to rearrange columns and rows of a matrix (two-way two-mode data) such that each entry is as closely numerically related to its four neighbors as possible. To achieve this, BEA tries to maximize the measure of effectiveness (ME) defined in Section~\ref{sec:ME}. For optimizing the ME, columns and rows can be treated separately since changing the order of rows does not influence the ME contributions of the columns and vice versa. BEA consists of the following three steps: \begin{enumerate} \item Place one randomly chosen column. \item Try to place each remaining column at each possible position left, right and between the already placed columns and calculate every time the increase in ME. Choose the column and position which gives the largest increase in ME and place the column. Repeat till all columns are placed. \item Repeat procedure with rows. \end{enumerate} This greedy algorithm works fast and only depends on the choice of the first column/row. This dependence can be reduced by repeating the procedure several times with different choices and returning the solution with the highest ME. Although \cite{seriation:McCormick:1972} use BEA also for non-binary data, \cite{seriation:Arabie:1990} argue that the measure of effectiveness only serves its intended purpose of finding an arrangement which is close to Robinson form for binary data and should therefore only be used for binary data. \cite{seriation:Lenstra:1974} notes that the optimization problem of BEA can be stated as two independent traveling salesperson problems (TSPs). For example, the row TSP for an $n \times m$ matrix~$\mathbf{X}$ consists of $n$ cities with an $n \times n$ distance matrix~$\mathbf{D}$ where the distances are \begin{displaymath} d_{ij} = -\sum_{k=1}^m x_{ik}x_{jk}. \end{displaymath} BEA is in fact a simple suboptimal TSP heuristic using this distances and instead of BEA any TSP solver can be used to obtain an order. With an exact TSP solver, the optimal solution can be found. \subsection{Hierarchical clustering} \label{sec:hierarchical_clustering} Hierarchical clustering produces a series of nested clusterings which can be visualized by a dendrogram, a tree where each internal node represents a split into subtrees and has a measure of similarity/dissimilarity attached to it. As a simple heuristic to find a linear order of objects, the order of the leaf nodes in a dendrogram structure can be used. This idea is used, e.g., by heat maps to reorder rows and columns with the aim to place more similar objects and variables closer together. %For hierarchical clustering several methods are available (e.g., %single linkage, average linkage, complete linkage, ward method) resulting in %different dendrograms. %However, The order of leaf nodes in a dendrogram is not unique. A binary (two-way splits only) dendrogram for $n$ objects has $2^{n-1}$ internal nodes and at each internal node the left and right subtree (or leaves) can be swapped resulting in $2^{n-1}$ distinct leaf orderings. To find a unique or optimal order, an additional criterion has to be defined. \cite{seriation:Gruvaeus:1972} suggest to obtain a unique order by requiring to order the leaf nodes such that at each level the objects at the edge of each cluster are adjacent to that object outside the cluster to which it is nearest. \cite{seriation:Bar-Joseph:2001} suggest to rearrange the dendrogram such that the Hamiltonian path connecting the leaves is minimized and called this the optimal leaf order. The authors also present a fast algorithm with time complexity $O(n^4)$ to solve this optimization problem. Note that this problem is related to the TSP described above, however, the given dendrogram structure significantly reduces the number of permissible permutations making the problem easier. Although hierarchical clustering solves an optimization problem different to the seriation problem discussed in this paper, hierarchical clustering still can produce useful orderings, e.g., for visualization. \subsection{Rank-two ellipse seriation} \cite{seriation:Chen:2002} proposes to generate a sequence of correlation matrices $R^1, R^2, \ldots$. $R^1$ is the correlation matrix of the original distance matrix $\mathbf{D}$ and \begin{equation} R^{n+1} = \phi R^n, \end{equation} where $\phi(\cdot)$ calculates a correlation matrix. \cite{seriation:Chen:2002} shows that the rank of the matrix $R^n$ falls with increasing $n$ and that if the sequence is continued till the first matrix in the sequence has a rank of 2, projecting all points in this matrix on its first two eigenvectors, all points will fall on an ellipse. \cite{seriation:Chen:2002} suggests to use the order of the points on this ellipse as a seriation where the ellipse can be cut at any of the two interception points (top or bottom) with the vertical axis. Although the rank-two ellipse seriation procedure does not try to solve a combinatorial optimization problem, it still provides for some cases a useful ordering. \subsection{Spectral Seriation} Spectral seriation uses a relaxation to minimize the 2-Sum Problem \citep{seriation:Barnard:1993}. Rewriting the minimization problem using a permutation vector $\pi$, its inverse, rescaling to $\mathrm{q}$ and using a Lagrangian multiplier for the constraint on the permutation yields \citep{seriation:Ding:2004} the following equivalent optimization problem: $$\mathrm{min}_\mathbf{q} \frac{\mathbf{q}^T L_\mathbf{S}\mathbf{q}}{\mathbf{q}^T\mathbf{q}}$$ where $L_\mathbf{S}$ is the Laplacian of $\mathbf{S}$. The optimal order can be recovered by the sorting order of the Fiedler vector (i.e., the second smallest eigenvector of the Laplacian of the similarity matrix). \subsection{Quadratic Assignment Problem} Both, the linear seriation criterion and the 2-Sum problem formulation can be written as a Quadratic Assignment Problem (QAP). However, the QAP is in general NP-hard. Methods include QIP, linearization, branch and bound and cutting planes as well as heuristics including Tabu search, simulated annealing, genetic algorithms, and ant systems \citep{seriation:Burkard:1998}. \section{The package infrastructure} \label{sec:infrastructure} The \pkg{seriation} package provides the data structures and some algorithms to efficiently handle seriation with \proglang{R}. As the input data for seriation \proglang{R} already provides \begin{itemize} \item for two-way one-mode data the class \code{dist}, \item for two-way two-mode data the class \code{matrix}, and \item for $k$-way $k$-mode data the class \code{array}. \end{itemize} \begin{figure}[tp] \centerline{ %\includegraphics[width=12cm]{infrastructure}} \includegraphics[width=10cm]{classes}} \caption{UML class diagram of the data structures for permutations provided by \pkg{seriation}} \label{fig:infrastructure} \end{figure} However, \proglang{R} provides no classes for representing permutation vectors. \pkg{seriation} adds the necessary data structure (using the S3 class system) as depicted in the UML class diagram \citep{seriation:Fowler:2004} in Figure~\ref{fig:infrastructure}. In this diagram classes are represented by rectangles and different symbols are used to state the type of relationship between the classes. The class \code{ser\_permutation} in Figure~\ref{fig:infrastructure} represents the permutation information for $k$-mode data (including the cases of $k=1$ and $k=2$). It consists of $k$ permutation vectors (class \code{ser\_permutation\_vector}). This relationship is represented by the solid diamond and the star above the connection between the two classes. Class \code{ser\_permutation\_vector} is defined \emph{abstract} and only its concrete implementations (classes connected with the triangle symbol) are used to store a permutation vector. This design with an abstract class was chosen to allow to use different representations for the permutation vectors. Currently, the permutation vector can be stored as a simple integer vector or as an object of class \code{hclust} (defined in package \pkg{stats}). \code{hclust} describes a hierarchical clustering tree (dendrogram) including an ordering for the tree's node leaves which provides a permutation for all objects (see Section~\ref{sec:hierarchical_clustering}). Class \code{ser\_permutation\_vector} has a constructor \func{ser\_permutation\_vector} which converts data into the correct concrete subclass of \code{ser\_permutation\_vector} and checks if it contains a proper permutation vector. For \code{ser\_permutation\_vector} the methods \func{print}, \func{length} for the length of the permutation vector, \func{get\_method} to get the method used to generate the permutation, and \func{get\_order} to access the raw (integer) permutation vector are available. To use an additional class to represent permutations as a concrete subclass of \code{ser\_permutation\_vector} only an appropriate accessor method \func{get\_order} has to be implemented for the new class. For \code{ser\_permutation} a constructor is provided which can bind $k$ \code{ser\_permutation\_vector} objects together into an object for $k$-mode data. \code{ser\_permutation} is implemented as a list of length~$k$ and each element contains a \code{ser\_permutation\_vector} object. Methods like \func{length}, accessing elements with \code{[[}, % ]] \code{[[<-}, % ]] subsetting with \code{[}, and combining with \func{c} work as expected. Also a \func{print} method is provided. Finally, direct access to the raw permutation vectors is available using \func{get\_order}. Here a second argument (which defaults to $1$) specifies the dimension (mode) for which the order vector is requested. All seriation algorithms are available via the function \func{seriate} defined as: \begin{quotation} \code{seriate(x, method = NULL, control = NULL, ...)} \end{quotation} where \code{x} is the input data, \code{method} is a string defining the seriation method to be used and \code{control} can contain a list with additional information for the algorithm. \func{seriate} returns an object of class \code{ser\_permutation} with a length conforming to the number of dimensions of~\code{x}. Typical input data are a dissimilarity matrix (class~\code{dist}; see package \pkg{stats} for more information) for one-mode two-way data, \code{matrix} for two-mode two-way data and \code{array} for $k$-mode $k$-way data. For \code{matrix} and \code{array} the additional argument \code{margin} can be used to restrict the dimensions which should be seriated (e.g., with \code{margin = 1} only the first dimension, i.e., the columns of a matrix, are seriated). %\begin{landscape} \begin{table}[tp] \centering \begin{tabular}{p{5cm}p{3cm}p{4cm}l} \hline Algorithm & \code{method} & Optimizes & Input data \\ \hline Simulated annealing & \code{"ARSA"} & Linear seriation crit.&\code{dist} \\ Branch-and-bound & \code{"BBURCG"} & Gradient measure &\code{dist} \\ Branch-and-bound & \code{"BBWRCG"} & Gradient measure (weighted)& \code{dist} \\ TSP solver & \code{"TSP"} & Hamiltonian path length& \code{dist} \\ Optimal leaf ordering & \code{"OLO"} \code{"OLO_single"} \code{"OLO_average"} \code{"OLO_complete"} & Hamiltonian path length (restricted)& \code{dist} \\ Gruvaeus and Wainer & \code{"GW"} \code{"GW_single"} \code{"GW_average"} \code{"GW_complete"} & Hamiltonian path length (restricted) & \code{dist} \\ MDS & \code{"MDS"} \code{"MDS_metric"} \code{"MDS_nonmetric"} \code{"MDS_angle"} & Least square crit.& \code{dist} \\ Spectral seriation & \code{"Spectral"} \code{"Spectral_norm"} & 2-Sum crit. & \code{dist} \\ QAP & \code{"QAP_2SUM"} & 2-Sum crit. & \code{dist} \\ & \code{"QAP_LS"} & Linear seriation crit. & \code{dist} \\ & \code{"QAP_BAR"} & Banded AR form & \code{dist} \\ & \code{"QAP_Inertia"} & Inertia crit. & \code{dist} \\ Genetic Algorithm & \code{"GA"}* & various & \code{dist} \\ DendSer & \code{"DendSer"}* & various & \code{dist} \\ Hierarchical clustering & \code{"HC"} \code{"HC_single"} \code{"HC_average"} \code{"HC_complete"} & Other& \code{dist} \\ Rank-two ellipse seriation & \code{"R2E"} & Other& \code{dist} \\ Sorting Points Into Neighborhoods & \code{"SPIN_NH"} \code{"SPIN_STS"} & Other& \code{dist} \\ Visual Assessment of (Clustering) Tendency & \code{"VAT"}& Other& \code{dist} \\ \hline Bond Energy Algorithm & \code{"BEA"} & Measure of effectiveness & \code{matrix} \\ TSP to optimize ME & \code{"BEA\_TSP"} & Measure of effectiveness& \code{matrix} \\ Principal component analysis& \code{"PCA"} \code{"PCA_angle"}& Least square crit.& \code{matrix} \\ \hline \end{tabular} \caption{Currently implemented methods for \func{seriation} (* methods need to be registered).} \label{tab:methods} \end{table} %\end{landscape} Various seriation methods were already introduced in this paper in Section~\ref{sec:methods}. In Table~\ref{tab:methods} we summarize the methods currently available in the package for seriation. The code for the simulated annealing heuristic~\citep{seriation:Brusco:2007} and the two branch-and-bound implementations~\citep{seriation:Brusco:2005} was obtained from the authors. The TSP solvers (exact solvers and a variety of heuristics) is provided by package \pkg{TSP}~\citep{seriation:Hahsler:2007, seriation:Hahsler:2007b}. For optimal leaf ordering we implemented the algorithm by~\cite{seriation:Bar-Joseph:2001}. The BEA code was kindly provided by Fionn Murtagh. For the Gruvaeus and Wainer algorithm, the implementation in package \pkg{gclus}~\citep{seriation:Hurley:2007} is used. For the rank-two ellipse seriation we implemented the algorithm by~\cite{seriation:Chen:2002}. Spectral seriation is described by~\cite{seriation:Ding:2004}. Note that some methods implemented (e.g., the rank-two ellipse seriation) do not fall within the combinatorial optimization framework of this paper and thus are not dealt with here in detail. They are included in the package since they can be useful for various applications. A detailed empirical comparison of seriation methods and crieria can be found in the study by \cite{hahsler:Hahsler2016d}. %Over time more methods will be %added to the package. To calculate the value of a loss/merit function for data and a certain permutation, the function \begin{quotation} \code{criterion(x, order = NULL, method = NULL, ...)} \end{quotation} is provided. \code{x} is the data object, \code{order} contains a suitable object of class \code{ser\_permutation} (if omitted no permutation is performed) and \code{method} specifies the type of loss/merit function. A vector of several methods can be used resulting in a named vector with the values of the requested functions. If \code{method} is omitted (\code{method = NULL}), the values for all applicable loss/merit functions are calculated and returned. We already defined different loss/merit functions for seriation in Section~\ref{sec:seriation}. In Table~\ref{tab:criteria} we indicate the loss/merit functions currently available in the package. \begin{table}[t] \centering \begin{tabular}{llll} \hline Name & \code{method} & merit/loss & Input data \\ \hline Anti-Robinson events& \code{"AR\_events"} & loss & \code{dist} \\ Anti-Robinson deviations& \code{"AR\_deviations"} & loss & \code{dist} \\ Banded Anti-Robinson& \code{"BAR"} & loss & \code{dist} \\ Gradient measure& \code{"Gradient\_raw"} & merit & \code{dist} \\ Gradient measure (weighted)& \code{"Gradient\_weighted"} & merit & \code{dist} \\ Hamiltonian path length & \code{"Path\_length"} & loss & \code{dist} \\ Inertia criterion& \code{"Inertia"} & merit & \code{dist} \\ Least squares criterion& \code{"Least\_squares"} & loss & \code{dist} \\ Linear Seriation criterion& \code{"LS"} & loss & \code{dist} \\ 2-Sum criterion& \code{"2SUM"} & loss & \code{dist} \\ \hline Measure of effectiveness& \code{"ME"} & merit & \code{matrix} \\ Stress (Moore neighborhood)& \code{"Moore\_stress"} & loss & \code{matrix} \\ Stress (Neumann neighborhood)& \code{"Neumann\_stress"} & loss & \code{matrix} \\ \hline \end{tabular} \caption{Implemented loss/merit functions in function \func{criterion}.} \label{tab:criteria} \end{table} All methods for \func{seriate} and \func{criterion} are managed by a registry mechanism which makes the seriation framework easily extensible for users. For example, a new seriation method can be registered using \func{set\_seriation\_method} and then used in the same way as the built-in methods with \func{seriate}. All available methods in the registry can be viewed using \func{list\_seriation\_methods} and \func{show\_seriation\_methods}. For criterion methods, the same interface is available by just substituting `seriation' by `criterion' in the function names. An example for how to add new methods can be found in section~\ref{sec:registering} of this paper. In addition the package offers the (generic) function \begin{quotation} \code{permute(x, order)} \end{quotation} where \code{x} is the data (a \code{dist} object, a matrix, an array, a list or a numeric vector) to be reordered and \code{order} is a \code{ser\_permutation} object of suitable length. %The permutation for %\code{dist} objects uses package \pkg{proxy}~\citep{seriation:Meyer:2007}. For visualization, the package offers several options: \begin{itemize} \item Matrix shading with \func{pimage}. In contrast to the standard \func{image} in package~\pkg{graphics}, \func{pimage} displays the matrix as is with the first element in the top left-hand corner and using a gamma-corrected gray scale. \item Different heat maps (e.g., with optimally reordered dendrograms) with \func{hmap}. \item Visualization of data matrices in the spirit of~\cite{seriation:Bertin:1981} with \func{bertinplot}. \item \emph{Dissimilarity plot}, a new visualization to judge the quality of a clustering using matrix shading and seriation with \func{dissplot}. \end{itemize} We will introduce the package usage and the visualization options in the examples in the next section. \section{Examples and applications} \label{sec:example} We start this section with a simple first session to demonstrate the basic usage of the package. Then we present and discuss several seriation applications. \subsection{A first session using seriation} In the following example, we use the well known iris data set (from \proglang{R}'s \pkg{datasets} package) which gives the measurements in centimeters of the variables sepal length and width and petal length and width, respectively, for 50 flowers from each of 3 species of the iris family (Iris setosa, versicolor and virginica). First, we load the package \pkg{seriation} and the iris data set. We remove the species classification and reorder the objects randomly since they are already sorted by species in the data set. Then we calculate the Euclidean distances between objects. <>= set.seed(1234) @ <<>>= library("seriation") data("iris") x <- as.matrix(iris[-5]) x <- x[sample(seq_len(nrow(x))),] d <- dist(x) @ To seriate the objects given the dissimilarities, we just call \func{seriate} with the default settings. <<>>= o <- seriate(d) o @ The result is an object of class \code{ser\_permutation} for one-mode data. The permutation vector length is $150$ for the $150$ objects in the iris data set and the used seriation method is \code{"ARSA"}, a simulated annealing heuristic (see~Table~\ref{tab:methods}). The actual order can be accessed using \func{get\_order}. In the following we show the first 15 elements in the permutation vector. <<>>= head(get_order(o), 15) @ To visually inspect the effect of seriation on the distance matrix, we use matrix shading with \func{pimage} (the result is shown in Figure~\ref{fig:pimage1}). <>= pimage(d, main = "Random") @ <>= pimage(d, o, main = "Reordered") @ \begin{figure} \centering \includegraphics[width=7.5cm]{seriation-pimage1} \includegraphics[width=7.5cm]{seriation-pimage1-2} \caption{Matrix shading of the distance matrix for the iris data.} \label{fig:pimage1} \end{figure} We can also compare the improvement for different loss/merit functions using \func{criterion}. <<>>= cbind(random = criterion(d), reordered = criterion(d, o)) @ Naturally, the reordered dissimilarity matrix achieves better values for all criteria. Note that the gradient measures, inertia and the measure of effectiveness are merit functions and for these measures larger values are better (use \code{show\_criterion\_methods("dist")} to find out which measures are loss and merit functions). To visually compare the original data matrix and the result of seriation, we can also use \func{pimage}. We standardize the data using scale such that the visualized value is the number of standard diviations an object differs from the variable mean. For matrices containing negative values, \code{pimage} uses automatically a divergent palette. After using \func{pimage} for the original random data matrix, we create a suitable \code{ser\_permutation} object for the original two-mode data. Since the seriation above only produced an order for the rows of the data, we add an identity permutation vector for the columns (represented by \code{NA}) to the permutations object using the combine function \func{c}. This new permutation object for $2$-mode data is used for displaying the reordered scaled data. The two plots are shown in Figure~\ref{fig:pimage2}. <>= pimage(scale(x), main = "Random") @ <>= o_2mode <- c(o, NA) pimage(scale(x), o_2mode, main = "Reordered") @ \begin{figure} \centering \includegraphics[width=7.5cm]{seriation-pimage2} \includegraphics[width=7.5cm]{seriation-pimage2-2} \caption{Matrix shading of the iris data matrix.} \label{fig:pimage2} \end{figure} \subsection{Comparing different seriation methods} To compare different seriation methods we use again the randomized iris data set and the distance matrix \code{d} from the previous example. We include in the comparison several seriation methods for dissimilarity matrices described in Section~\ref{sec:methods}. <<>>= methods <- c("TSP","R2E", "ARSA", "HC", "GW", "OLO") o <- sapply(methods, FUN = function(m) seriate(d, m)) @ <>= timing <- sapply(methods, FUN = function(m) system.time(seriate(d, m)), simplify = FALSE) @ \begin{table} \centering \begin{tabular}{lcccccc} \hline Seriation Method & \Sexpr{methods[1]}& \Sexpr{methods[2]}& \Sexpr{methods[3]}& \Sexpr{methods[4]}& \Sexpr{methods[5]}& \Sexpr{methods[6]} \\ \hline Execution time [sec] & \Sexpr{round(timing[[methods[1]]][1],4)}& \Sexpr{round(timing[[methods[2]]][1],4)}& \Sexpr{round(timing[[methods[3]]][1],4)}& \Sexpr{round(timing[[methods[4]]][1],4)}& \Sexpr{round(timing[[methods[5]]][1],4)}& \Sexpr{round(timing[[methods[6]]][1],4)}\\ \hline \end{tabular} %%% fix me: for the vignette we need something else \caption{Execution time of seriation of the iris data set for different methods.} \label{tab:timings} \end{table} Table~\ref{tab:timings} contains the execution times for running seriation with the different methods. Except for the simulated annealing method (ARSA) the seriation only takes a fraction of a second. The direction of the resulting orderings is first normalized (aligned) and then the orderings are displayed using matrix shading (see Figure~\ref{fig:pimage3}). <>= o <- ser_align(o) for(s in o) pimage(d, s, main = get_method(s), key = FALSE) @ <>= o <- ser_align(o) for(i in 1:length(o)) { pdf(file=paste("seriation-pimage_comp_", i , ".pdf", sep="")) pimage(d, o[[i]], main = get_method(o[[i]]), key = FALSE) dev.off() } @ \begin{figure} \centering \includegraphics[width=.3\linewidth]{seriation-pimage_comp_1.pdf} \includegraphics[width=.3\linewidth]{seriation-pimage_comp_2.pdf} \includegraphics[width=.3\linewidth]{seriation-pimage_comp_3.pdf}\\ \includegraphics[width=.3\linewidth]{seriation-pimage_comp_4.pdf} \includegraphics[width=.3\linewidth]{seriation-pimage_comp_5.pdf} \includegraphics[width=.3\linewidth]{seriation-pimage_comp_6.pdf} \caption{Image plot of the distance matrix for the iris data using rearrangement by different seriation methods.} \label{fig:pimage3} \end{figure} The first row of matrices in Figure~\ref{fig:pimage3} contains the orders obtained by a TSP solver the rank-two ellipse seriation by Chen and using the simulated annealing method (ARSA). The results of Chen and ARSA are very similar (except that the order is reversed). The TSP solver produces a smoother image with some lighter lines visible. The reason for these lines is that the TSP only optimizes distances locally between two neighboring objects. Therefore it is possible that in a quite homogeneous block several objects are enclosed gradually getting more different and then getting more similar again (see, e.g., the light line close to the upper left corner of the TSP image in Figure~\ref{fig:pimage3}). The second row of Figure~\ref{fig:pimage3} contains three images based on hierarchical clustering. The visual impression gets better from left (just hierarchical clustering) to right (first using the Gruvaeus Wainer heuristic and then optimal leaf ordering to rearrange the branches of the dendrogram obtained by hierarchical clustering). The most striking feature in the image for hierarchical clustering (HC in Figure~\ref{fig:pimage3}) is the distinct cross going right through the center of the plot. This indicates that several relatively dissimilar objects are caught in an otherwise homogeneous block. This effect vanishes after rearranging the dendrogram branches (see GW and OLO in Figure~\ref{fig:pimage3}). %' To investigate this effect, %' we plot the dendrogram obtained by hierarchical clustering which is used %' to order the objects and compare it to the dendrogram rearranged %' using the Gruvaeus Wainer heuristic. %' %' <>= %' plot(o[["HC"]], labels = FALSE, main = "Dendrogram HC") %' plot(o[["GW"]], labels = FALSE, main = "Dendrogram GW") %' @ %' <>= %' def.par <- par(no.readonly = TRUE) %' pdf(file="seriation-pimage3_dendrogram.pdf", width=9, height=4) %' layout(t(1:2)) %' plot(o[["HC"]], labels = FALSE, main = "Dendrogram HC") %' symbols(74.7,.5, rect = matrix(c(4, 3), ncol=2), add= TRUE, %' inches = FALSE, lwd =2) %' %' plot(o[["GW"]], labels = FALSE, main = "Dendrogram GW") %' symbols(98.7,.5, rect = matrix(c(4, 3), ncol=2), add= TRUE, %' inches = FALSE, lwd =2) %' par(def.par) %' tmp <- dev.off() %' @ %' %' \begin{figure} %' \centering %' \includegraphics[width=\linewidth, trim=0 80 0 0, clip=TRUE]{seriation-pimage3_dendrogram} %' \caption{Dendrograms for the seriation with HC and GW.} %' \label{fig:pimage3_dendrogram} %' \end{figure} %' %' Comparing the two dendrograms in Figure~\ref{fig:pimage3_dendrogram}, we see %' that the branch left from the top is almost unchanged. The branch which is %' responsible for the light cross in the shaded image is highlighted by a box. %' The Gruvaeus Wainer heuristic rotates the highlighted branch towards the right %' since the objects in it are more similar to the objects in there. Finally, we compare the values of the loss/merit functions for the different seriation methods. <<>>= crit <- sapply(o, FUN = function(x) criterion(d, x)) t(crit) @ <>= def.par <- par(no.readonly = TRUE) m <- c("Path_length", "AR_events", "Moore_stress") layout(matrix(seq_along(m), ncol=1)) #tmp <- apply(crit[m,], 1, dotchart, sub = m) tmp <- lapply(m, FUN = function(i) dotchart(crit[i,], sub = i)) par(def.par) @ \begin{figure} \centering \includegraphics[width=14cm]{seriation-crit1} \caption{Comparison of different methods and seriation criteria} \label{fig:crit1} \end{figure} For easier comparison, Figure~\ref{fig:crit1} contains a plot of the criteria Hamiltonian path length, anti-Robinson events (\code{AR\_events}) and stress using the Moore neighborhood. Clearly, the methods which directly try to minimize the Hamiltonian path length (hierarchical clustering with optimal leaf ordering (\code{OLO}) and the TSP heuristic) provide the best results concerning the path length. For the number of anti-Robinson events, using the simulated annealing heuristic (\code{ARSA}) provides the best result. Regarding stress, the simulated annealing heuristic also provides the best result although, it does not directly minimize this loss function. \subsection{Registering new methods} \label{sec:registering} New methods to calculate criterion values and to compute a seriation can be easily added by the user via the method registry mechanism provided in \pkg{seriation}. Here we give a simple example of how to implement and register a new seriation method. In the registry we distinguish between methods for different types of input data. With the following two commands we produce a short overview of the the first few available seriation methods for input data of class \code{dist} and \code{matrix}. <<>>= show_seriation_methods("dist")[1:3] show_seriation_methods("matrix")[1:3] @ The overview is intended to make it convenient for the user to choose an appropriate method. It contains the name of the method used as the \code{method} argument for \func{seriate} and a short description. To get just the names the following function is also available: <<>>= list_seriation_methods("dist") @ To add a new seriation method, we first have to implement the seriation code as a function with the two formal arguments \code{x} and \code{control}. \code{x} is the data object and \code{control} contains a list with additional information for the method passed on from \func{seriate}. The function has to return a list of objects which can be coerced into \code{ser\_permutation\_vector} objects (e.g., a list of integer vectors). The elements in the list have to be in order corresponding to the dimensions of \code{x}. In this example we just create a method to return a permutation which reverses the original order of the objects, i.e., which returns the reverse identity order. <<>>= seriation_method_reverse <- function(x, control = NULL) { lapply(dim(x), function(n) rev(seq(n))) } @ The function produces integer sequences of the correct lengths, one for each dimension of \code{x} (\code{control} is not used). Since the function works for \code{matrix} and \code{array} we can register it for both data types under the short name `Reverse'. <<>>= set_seriation_method("matrix", "Reverse", seriation_method_reverse, "Reverse identity order") set_seriation_method("array", "Reverse", seriation_method_reverse, "Reverse identity order") @ Now the new seriation method is registered and can be found by the user and applied to data. <<>>= show_seriation_methods("matrix") o <- seriate(matrix(1, ncol=3, nrow=4), "reverse") o get_order(o, 1) get_order(o, 2) @ Criterion methods can be added in the same way. We refer the interested reader to the documentation accompanying the package for detailed information and an example. If you have implemented a new criterion or seriation method, please consider submitting the code to one of the maintainers of \pkg{seriation} for inclusion in a future release of the package. \subsection{Heat maps} A heat map is a shaded/color coded data matrix with a dendrogram added to one side and to the top to indicate the order of rows and columns. Typically, reordering is done according to row or column means within the restrictions imposed by the dendrogram. Heat maps recently became popular for visualizing large scale genome expression data obtained via DNA microarray technology \citep[see, e.g.,][]{seriation:Eisen:1998}. From Section~\ref{sec:hierarchical_clustering} we know that it is possible to find the optimal ordering of the leaf nodes of a dendrogram which minimizes the distances between adjacent objects in reasonable time. Such an order might provide an improvement over using simple reordering such as the row or column means with respect to presentation. In \pkg{seriation} we provide the function \func{hmap} which uses optimal ordering and can also use seriation directly on distance matrices without using hierarchical clustering to produce dendrograms first. For the following example, we use again the randomly reordered iris data set \code{x} from the examples above. To make the variables (columns) comparable, we use standard scaling. <<>>= x <- scale(x, center = FALSE) @ To produce a heat map with optimally reordered dendrograms (using by default Optimal Leaf Ordering), the function \func{hmap} can be used with its default settings. <>= hmap(x, margin =c(7, 4), cexCol=1, labRow = FALSE) @ With these settings, the Euclidean distances between rows and between columns are calculated (with \func{dist}), hierarchical clustering (\func{hclust}) is performed, the resulting dendrograms are optimally reordered, and \func{heatmap.2} in package \pkg{gplots} is used for plotting (see Figure~\ref{fig:heatmap}(a) for the resulting plot). <>= hmap(x, method = "MDS") @ If a seriation method is used that does not depend on dendrograms, instead of hierarchical clustering, seriation on the dissimilarity matrices for rows and columns is performed and the reordered matrix with the reordered dissimilarity matrices to the left and on top is displayed (see Figure~\ref{fig:heatmap}(b)). A \code{method} argument can be used to choose different seriation methods. <>= #bitmap(file = "seriation-heatmap1.png", type = "pnggray", # height = 6, width = 6, res = 300, pointsize=14) pdf(file = "seriation-heatmap1.pdf") hmap(x, margin = c(7, 4), labRow = FALSE, cexCol=1) tmp <- dev.off() @ <>= pdf(file = "seriation-heatmap2.pdf") hmap(x, method="MDS") tmp <- dev.off() @ \begin{figure} \begin{minipage}[b]{.48\linewidth} \centering \includegraphics[width=\linewidth]{seriation-heatmap1} \\ (a) \end{minipage} \begin{minipage}[b]{.48\linewidth} \centering \includegraphics[width=\linewidth]{seriation-heatmap2} \\ (b) \end{minipage} \caption{Two presentations of the rearranged iris data matrix. (a) as an optimally reordered heat map and (b) as a seriated data matrix with reordered dissimilarity matrices to the left and on top.} \label{fig:heatmap} \end{figure} \subsection{Bertin's permutation matrix} \cite{seriation:Bertin:1981,seriation:Bertin:1999} introduced permutation matrices to analyze multivariate data with medium to low sample size. The idea is to reveal a more homogeneous structure in a data matrix~$\mathbf{X}$ by simultaneously rearranging rows and columns. The rearranged matrix is displayed and cases and variables can be grouped manually to gain a better understanding of the data. %To quantify homogeneity, a purity function %\begin{displaymath} % \phi = \Phi(\mathbf{X}) %\end{displaymath} %is defined. Let $\Pi$ be the set of all permutation functions %$\pi$ for matrix $\mathbf{X}$. %Note that function $\pi$ performs row and column permutations on a matrix. %The optimal permutation with respect to %purity can be found by %\begin{displaymath} % \pi^* = \argmax\nolimits_{\pi \in \Pi} \Phi(\pi(\mathbf{X})). %\end{displaymath} %Since, depending on the purity function, finding the optimal %solution can be hard, often a near optimal solution is also acceptable %for visualization. % %A possible purity function $\Phi$ is: %Given distances between rows and columns of the data matrix, define purity as %the sum of distances of adjacent rows/columns. Using this purity function, %finding the optimal permutation $\pi^*$ means solving two (independent) TSPs, %one for the columns and one for the rows. To find a rearrangement of columns and rows which reveals structure a purity function is used. A possible purity function is: Given distances between rows and columns of the data matrix, define purity as the sum of distances of adjacent rows/columns. Using this purity function, finding the optimal permutation means solving two (independent) TSPs, one for the columns and one for the rows which can be done very conveniently using the infrastructure provided by \pkg{seriation}. As an example, we use the results of $8$ constitutional referenda for $41$ Irish communities~\citep{seriation:Falguerolles:1997}\footnote{The Irish data set is included in this package. The original data and the text of the referenda can be obtained from~\url{http://www.electionsireland.org/}}. To make values comparable across columns (variables), the ranks of the values for each variable are used instead of the original values. <<>>= data("Irish") orig_matrix <- apply(Irish[,-6], 2, rank) @ For seriation, we calculate distances between rows and between columns using the sum of absolute rank differences (this is equal to the Minkowski distance with power $1$). Then we apply seriation (using a TSP heuristic) to both distance matrices and combine the two resulting \code{ser\_permutation} objects into one object for two-mode data. The original and the reordered matrix are plotted using \func{bertinplot}. <<>>= o <- c( seriate(dist(orig_matrix, "minkowski", p = 1), method ="TSP"), seriate(dist(t(orig_matrix), "minkowski", p = 1), method = "TSP") ) o @ <>= bertinplot(orig_matrix) bertinplot(orig_matrix, o) @ <>= bertinplot(orig_matrix) @ <>= bertinplot(orig_matrix, o) @ \begin{figure} \centering \includegraphics[width=15cm, trim=60 60 0 0]{seriation-bertin1} \\ (a) \includegraphics[width=15cm, trim=60 60 0 0]{seriation-bertin2} \\ (b) \caption{Bertin plot for the (a) original arrangement and the (b) reordered Irish data set.} \label{fig:bertin} \end{figure} The original matrix and the rearranged matrix are shown in Figure~\ref{fig:bertin} as a matrix of bars where high values are highlighted (filled blocks). Note that following Bertin, the cases (communities) are displayed as the columns and the variables (referenda) as rows. Depending on the number of cases and variables, columns and rows can be exchanged to obtain a better visualization. Although the columns are already ordered (communities in the same city appear consecutively) in the original data matrix in Figure~\ref{fig:bertin}(a), it takes some effort to find structure in the data. For example, it seems that the variables `Marriage', `Divorce', `Right to Travel' and `Right to Information' are correlated since the values are all high in the block made up by the columns of the communities in Dublin. The reordered matrix confirms this but makes the structure much more apparent. Especially the contribution of low values (which are not highlighted) to the overall structure becomes only visible after rearrangement. \subsection{Binary data matrices} Binary or $0$-$1$ data matrices are quite common. Often such matrices are called \emph{incidence matrices} since a $1$ in a cell indicates the incidence of an event. In archeology such an event could be that a special type of artifact was found at a certain archaeological site. This can be seen as a simplification of a so-called \emph{abundance matrix} which codes in each cell the (relative) frequency or quantity of an artifact type at a site. See \cite{seriation:Ihm:2005} for a comparison of incidence and abundance matrices in archeology. Here we are interested in binary data. For the example we use an artificial data set from~\cite{seriation:Bertin:1981} called \emph{Townships}. The data set contains $9$ binary characteristics (e.g., has a veterinary or has a high school) for $16$ townships. The idea of the data set is that townships evolve from a rural to an urban environment over time. After loading the data set (which comes with the package), we use \func{bertinplot} to visualize the data (\func{pimage} could also be used but \func{bertinplot} allows for a nicer visualization). Bars, the standard visualization of \func{bertinplot}, do not make much sense for binary data. We therefore use the panel function \func{panel.squares} without spacing to plot black squares. <>= data("Townships") bertinplot(Townships, options = list(panel=panel.squares, spacing = 0, frame = TRUE)) @ The original data in Figure~\ref{fig:binary}(a) does not reveal structure in the data. To improve the display, we run the bond energy algorithm (BEA) for columns and rows $10$ times with random starting points and report the best solution. <>= ## to get consistent results set.seed(5) @ <>= o <- seriate(Townships, method = "BEA", control = list(rep = 10)) bertinplot(Townships, o, options = list(panel=panel.squares, spacing = 0, frame = TRUE)) @ The reordered matrix is displayed in Figure~\ref{fig:binary}(b). A clear structure is visible. The variables (rows in a Bertin plot) can be split into the three categories describing different evolution states of townships: \begin{enumerate} \item Rural: No doctor, one-room school and possibly also no water supply \item Intermediate: Land reallocation, veterinary and agricultural cooperative \item Urban: Railway station, high school and police station \end{enumerate} The townships also clearly fall into these three groups which tentatively can be called villages (first~$7$), towns (next~5) and cities (final~2). The townships B and C are on the transition to the next higher group. \begin{figure} \centering \includegraphics[width=12cm, trim=0 40 0 30]{seriation-binary1} \\ (a) \includegraphics[width=12cm, trim=0 40 0 30]{seriation-binary2} \\ (b) \caption{The townships data set in original order (a) and reordered using BEA (b).} \label{fig:binary} \end{figure} <<>>= rbind(original = criterion(Townships), reordered = criterion(Townships, o)) @ BEA tries to maximize the measure of effectiveness which is much higher in the reordered matrix (in fact, 65 is the maximum for the data set). Also the two types of stress are improved significantly. \subsection{Dissimilarity plot} Assessing the quality of an obtained cluster solution has been a research topic since the invention of cluster analysis. This is especially important since all popular cluster algorithms produce a clustering even for data without a ``cluster'' structure. %A method to judge the quality of a cluster solution is by inspecting a %visualization. For hierarchical clustering %dendrogramms~\cite{seriation:Hartigan:1967} are available which show the %hierarchical structure of the clustering as a binary tree and cluster quality %can be judged by looking at the dissimilarities between objects in a cluster %and objects in other clusters. However, such a visualization is %only possible for heirarchical/nested clusterings. % %\marginpar{Cite Pison et al 1999 and Kaufmann and Rousseeuw} %For the an arbitrary partitional clustering, the original objects can %be displayed in a 2 dimensional scatter plot %after using dimensionality reduction (e.g., PCA, MDS). %Objects belonging to the same cluster can be marked and thus, if the %dimensionality reduction preserves a large proportion of the %variavility in the original data, the separation between clusters can be %visually judged. % %Silhouettes Matrix shading is an old technique to visualize clusterings by displaying the rearranged matrices~\citep[see, e.g.,][]{seriation:Sneath:1973,seriation:Ling:1973,seriation:Gale:1984}. Initially matrix shading was used in connection with hierarchical clustering, where the order of the dendrogram leaf nodes was used to arrange the matrix. However, with some extensions, matrix shading can also be used with any partitional clustering method. \cite{seriation:Strehl:2003} suggest a matrix shading visualization called \emph{CLUSION} where the dissimilarity matrix is arranged such that all objects pertaining to a single cluster appear in consecutive order in the matrix. The authors call this \emph{coarse seriation}. The result of a ``good'' clustering should be a matrix with low dissimilarity values forming blocks around the main diagonal. However, using coarse seriation, the order of the clusters has to be predefined and the objects within each cluster are unordered. The dissimilarity plots implemented by the function \func{dissplot} in \pkg{seriation} improve \emph{CLUSION} using seriation methods. It aims at visualizing global structure (similarity between different clusters is reflected by their position relative to each other) as well as the micro structure within each cluster (position of objects). To position the clusters in the dissimilarity plot, an inter-cluster dissimilarity matrix is calculated using the average between cluster dissimilarities. \func{seriate} is used on this inter-cluster dissimilarity matrix to arrange the clusters relative to each other resulting in on average more similar clusters to appear closer together in the plot. Within each cluster, \func{seriate} is used again on the sub-matrix of the dissimilarity matrix concerning only the objects in the cluster. For the example, we use again Euclidean distance between the objects in the iris data set. <<>>= data("iris") iris <- iris[sample(seq_len(nrow(iris))),] d <- dist(as.matrix(iris[-5]), method = "euclidean") @ First, we use \func{dissplot} without a clustering. We set \code{method} to \code{NA} to prevent reordering and display the original matrix (see Figure~\ref{fig:dissplot1}(a)). Then we omit the method argument which results in using the default seriation technique from \func{seriate}. Since we did not provide a clustering, the whole matrix is reordered in one piece. From the result shown in Figure~\ref{fig:dissplot1}(b) it seems that there is a clear structure in the data which suggests a two cluster solution. <>= ## plot original matrix dissplot(d, method = NA) @ <>= ## plot reordered matrix dissplot(d, options = list(main = "Dissimilarity plot with seriation")) @ <>= pdf(file = "seriation-dissplot1.pdf") <> tmp <- dev.off() pdf(file = "seriation-dissplot2.pdf") <> tmp <- dev.off() @ \begin{figure} \begin{minipage}[b]{.48\linewidth} \centering \includegraphics[width=\linewidth]{seriation-dissplot1} \\ (a) \end{minipage} \begin{minipage}[b]{.48\linewidth} \centering \includegraphics[width=\linewidth]{seriation-dissplot2} \\ (b) \end{minipage} \caption{Two dissimilarity plots. (a) the original dissimilarity matrix and (b) the seriated dissimilarity matrix.} \label{fig:dissplot1} \end{figure} Next, we create a cluster solution using the $k$-means algorithm. Although we know that the data set should contain $3$ groups representing the three species of iris, we let $k$-means produce a $10$ cluster solution to study how such a misspecification can be spotted using \func{dissplot}. <>= set.seed(1234) @ <<>>= l <- kmeans(d, 10)$cluster #$ @ We create a standard dissimilarity plot by providing the cluster solution as a vector of labels. The function rearranges the matrix and plots the result. Since rearrangement can be a time consuming procedure for large matrices, the rearranged matrix and all information needed for plotting is returned as the result. <>= res <- dissplot(d, labels = l, options = list(main = "Dissimilarity plot - standard")) @ <>= pdf(file = "seriation-dissplot3.pdf") ## visualize the clustering <> tmp <- dev.off() pdf(file = "seriation-dissplot4.pdf") ## threshold plot(res, options = list(main = "Dissimilarity plot - threshold", threshold = 1.5)) tmp <- dev.off() @ \begin{figure} \centering \includegraphics[width=10cm]{seriation-dissplot3}\\ (a) \includegraphics[width=10cm]{seriation-dissplot4}\\ (b) \caption{Dissimilarity plot for $k$-means solution with 10 clusters. (a) standard plot and (b) plot with threshold.} \label{fig:dissplot3} \end{figure} <<>>= res @ The resulting plot is shown in Figure~\ref{fig:dissplot3}(a). The inter-cluster dissimilarities are shown as solid gray blocks and the average object dissimilarity within each cluster as gray triangles below the main diagonal of the matrix. Since the clusters are arranged such that more similar clusters are closer together, it is easy to see in Figure~\ref{fig:dissplot3}(a) that clusters 6, 3 and 1 as well as clusters 10, 9, 5, 7, 8, 4 and 2 are very similar and form two blocks. This suggests again that a two cluster solution would be reasonable. Since slight variations of gray values are hard to distinguish, we plot the matrix again (using \func{plot} on the result above) and use a threshold on the dissimilarity to suppress high dissimilarity values in the plot. <>= plot(res, options = list(main = "Seriation - threshold", threshold = 1.5)) @ In the resulting plot in Figure~\ref{fig:dissplot3}(b), we see that the block containing 10, 9, 5, 7, 8, 4 and 2 is very well defined and cleanly separated from the other block. This suggests that these clusters should form together a cluster in a solution with less clusters. The other block is less well defined. There is considerable overlap between clusters 6 and 3, but also cluster 3 and 1 share similar objects. Using the information stored in the result of \func{dissplot} and the class information available for the iris data set, we can analyze the cluster solution and the interpretations of the dissimilarity plot. <<>>= #names(res) table(iris[res$order, 5], res$label)[,res$cluster_order] #$ @ As the plot in Figure~\ref{fig:dissplot3} indicated, the clusters 10, 9, 5, 7, 8, 4 and 2 should be a single cluster containing only flowers of the species Iris setosa. The clusters 6, 3 and 1 are more problematic since they contain a mixture of Iris versicolor and virginica. To illustrate the results of the dissimilarity plot in case a clustering with a $k$ smaller than the actual number of groups in the data is used, we use the Ruspini data set which consists of 75 points in four groups and is also often used to illustrate clustering techniques. We load the data set, calculate distances, perform $k$-means clustering with $k=3$ (although the real number of groups is 4) and produce a dissimilarity plot. <>= data("ruspini", package="cluster") d <- dist(ruspini) l <- kmeans(d, 3)$cluster dissplot(d, labels = l) @ \begin{figure} \centering \includegraphics[width=10cm]{seriation-ruspini}\\ \caption{Dissimilarity plot for $k$-means solution with 3 clusters for the Ruspini data set with 4 groups.} \label{fig:ruspini} \end{figure} The dissimilarity plot in Figure~\ref{fig:ruspini} shows that cluster 3 actually should be two separate clusters represented by the two clearly visible darker triangles next to the main diagonal. The dissimilarity plot using seriation is a useful tool to inspect the result of clustering. It is especially useful to spot misspecifications of the number of clusters employed. A more detailed treatment of dissimilarity plots as a tool for exploring partitional clustering can be found in \cite{seriation:Hahsler+Kornik:2011}. \section{Conclusion} \label{sec:conclusion} In this paper we presented the infrastructure provided by the package~\pkg{seriation}. The infrastructure contains the necessary data structures to store the linear order for one-, two- and $k$-mode data. It also provides a wide array of seriation methods for different input data, e.g., dissimilarities, binary and general data matrices focusing on combinatorial optimization. New seriation methods can be easily incorporated into the \pkg{seriation} framework by the user with the method registry mechanism provided. Based on seriation, \pkg{seriation} features several visualization techniques. In particular, the optimally reordered heat map, the Bertin plot and the dissimilarity plot present clear improvements over standard plots. A natural extension to \pkg{seriation} is the synthesis of ensembles of seriations into a ``consensus'' one. Such ensembles do not only arise when using different seriation methods, but also when varying data or control parameters to obtain more robust solutions (see e.g.~\cite{seriation:Jurman:2008} for a recent application of such ideas in a molecular profiling context). The \proglang{R}~extension package \pkg{relations}~\citep{seriation:Hornik+Meyer:2008} contains a variety of methods for obtaining consensus \emph{relations}, covering consensus seriation (where the relations are linear orders on the objects) as a special case. Future work on \pkg{seriation} will focus on adding further seriation methods, such as for example methods for higher dimensional arrays and methods for block seriation which aim at finding simultaneous partitions of rows and columns in a data matrix~\citep[see, e.g.,][]{seriation:Marcotorchino:1987}. \section*{Acknowledgments} The authors would like to thank Michael Brusco, Hans-Friedrich K{\"o}hn and Stephanie Stahl for their seriation code, Fionn Murtagh for his BEA implementation and the anonymous reviewers for their valuable comments and suggestions. % %\bibliographystyle{abbrvnat} \bibliography{seriation} % \end{document} seriation/R/0000755000176200001440000000000013476472035012463 5ustar liggesusersseriation/R/seriate_SPIN.R0000644000176200001440000001375013502515343015067 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## SPIN (Tsafrir et al. 2005) ## Weight matrix ## pimage(create_x(n=150, sigma=20, verbose=TRUE)) create_W <- function(n, sigma, verbose=FALSE) { w <- function(i, j, n, sigma) exp(-1*(i-j)^2/n/sigma) W <- outer(1:n, 1:n, FUN = w, n=n, sigma=sigma) ## make doubly stochastic for(i in 1:1000) { #cat(i, ".") W <- sweep(W, MARGIN = 1, STATS = rowSums(W), "/") W <- sweep(W, MARGIN = 2, STATS = colSums(W), "/") if(all(round(rowSums(W), 5) == 1) && all(round(colSums(W), 5) == 1)) break } if(verbose) cat("It took", i, "iterations to make W doubly stochastic!\n") if(i >999) warning("Weight matrix did not converge to doubly stochastic in 1000 itermation!") W } .spin_contr <- list( sigma = seq(20,1, length.out = 10), step = 5, W_function = NULL, verbose = FALSE ) ## SPIN: Neighborhood algorithms seriate_dist_SPIN <- function(x, control = NULL) { param <- .get_parameters(control, .spin_contr) W_function <- if(is.null(param$W_function)) create_W else param$W_function sigma <- param$sigma step <- param$step verbose <- param$verbose D <- as.matrix(x) n <- nrow(D) ## weight matrix W <- W_orig <- W_function(n, sigma[1], verbose) energy_best <- Inf for(i in 1:(length(sigma)*step)) { if(verbose) cat("Iteration", i, "... ") M <- D %*% W ## heuristic for the linear assignment problem ## (second argument to order breakes ties randomly) P <- permutation_vector2matrix( order(apply(M, MARGIN = 1, which.min), sample(1:n))) #if(verbose) print(table(apply(M, MARGIN = 1, which.min))) energy_new <- sum(diag(P %*% M)) if(verbose) cat("best energy:", energy_best, "new energy: ", energy_new, "\n") ## was energy improved? if(energy_new < energy_best) { energy_best <- energy_new P_best <- P } ## adapt sigma if(!(i %% step) && i != length(sigma)*step) { s <- sigma[i/step+1] if(verbose) cat("\nReducing sigma to:", s, "\n") W_orig <- W_function(n, s, verbose) ## recalculate best energy W <- crossprod(P, W_orig) ### t(P) %*% W M <- D %*% W energy_best <- sum(diag(P %*% M)) if(verbose) cat("best energy is now:", energy_best, "\n\n") }else { W <- crossprod(P, W_orig) ### t(P) %*% W } } if(verbose) cat("Best Energy:", energy_best, "\n") o <- permutation_matrix2vector(P_best) names(o) <- names(x)[o] o } ## SPIN: Side-to-Side algorithm ## this is the weight: pimage(tcrossprod(1:n - (n+1)/2)) .spin_sts_contr <- list( step = 25, nstart = 10, X = function(n) 1:n - (n+1)/2, verbose = FALSE ) seriate_dist_SPIN_STS <- function(x, control = NULL) { param <- .get_parameters(control, .spin_sts_contr) step <- param$step verbose <- param$verbose nstart <- param$nstart X <- param$X D <- as.matrix(x) n <- nrow(D) ## X for weights W = X %*% t(X) (colunm vector) if(is.function(X)) X <- X(n) if(!is.numeric(X) || length(X) != n) stop("Invalid weight vector X.") W <- tcrossprod(X) ## X %*% t(X) .STS_run <- function() { if(verbose) cat("\nStarting new run\n") ## start with random permutation o_best <- o <- sample(1:n) #P_best <- P <- permutation_vector2matrix(o) #X_current <- crossprod(P, X) X_current <- X[o] #energy_best <- sum(diag(P %*% D %*% t(P) %*% W)) energy_best <- sum(diag(D[o,o] %*% W)) for(i in 1:step) { if(verbose) cat("Iteration", i, "... ") ## permutation matrix that orders S in descending order (break ties) S <- D %*% X_current o <- order(S, sample(1:n), decreasing = TRUE) #P <- permutation_vector2matrix(o) #X_current <- crossprod(P, X) ## t(P) %*% X X_current <- X[o] ## t(P) %*% X ## calculate energy F(P) #energy_new <- sum(diag(P %*% D %*% t(P) %*% W)) energy_new <- sum(diag(D[o,o] %*% W)) if(verbose) cat("best energy:", energy_best, "new energy: ", energy_new) ## was energy improved? if(energy_new < energy_best) { energy_best <- energy_new #P_best <- P o_best <- o if(verbose) cat(" - update") } if(verbose) cat("\n") } if(verbose) cat("Best Energy:", energy_best, "\n") #o <- permutation_matrix2vector(P_best) o <- o_best attr(o, "energy") <- energy_best o } res <- replicate(nstart, .STS_run(), simplify = FALSE) energy <- sapply(res, attr, "energy") if(verbose) cat("Overall best Energy:", min(energy), "\n") o <- res[[which.min(energy)]] names(o) <- names(x)[o] o } set_seriation_method("dist", "SPIN_NH", seriate_dist_SPIN, "Sorting Points Into Neighborhoods (SPIN) (Tsafrir 2005). Nighborhood algorithm to concentrate low distance values around the diagonal with a Gaussian weight matrix W_{ij} = exp(-(i-j)^2/(n*sigma)), where n is the size of the dissimilarity matrix and sigma is the variance around the diagonal that control the influence of global (large sigma) or local (small sigma) structure.", .spin_contr) set_seriation_method("dist", "SPIN_STS", seriate_dist_SPIN_STS, "Sorting Points Into Neighborhoods (SPIN) (Tsafrir 2005). Side-to-Side algorithm which tries to push out large distance values.", .spin_sts_contr) seriation/R/permutation_vector.R0000644000176200001440000001072112662602052016526 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## S3 permutation and permutations classes ## permutations consists of instances of permutation ## permutation_vector ## constructor (NA is identity vector) ser_permutation_vector <- function(x, method = NULL) { if(inherits(x, "ser_permutation_vector")) return(x) ## make sure it's an integer vector if(is.vector(x) && !is.integer(x)) x <- as.integer(x) if(.is_identity_permutation(x)) attr(x, "method") <- "identity permutation" if(!is.null(method)) attr(x, "method") <- method class(x) <- c("ser_permutation_vector", class(x)) .valid_permutation_vector(x) x } ## accessors get_order <- function(x, ...) UseMethod("get_order") get_order.ser_permutation_vector <- function(x, ...) NextMethod() get_order.hclust <- function(x, ...) x$order get_order.dendrogram <- function(x, ...) order.dendrogram(x) get_order.integer <- function(x, ...) { o <- as.integer(x) if(.is_identity_permutation(x)) stop("Cannot get order from identity permutation.") #names(o) <- names(x)[o] o } ## returns the order of objects (index of first, second, etc. object) get_order.default <- function(x, ...) stop(gettextf("No permutation accessor implemented for class '%s'. ", class(x))) ## returns for each object its rank (rank of first, second, etc. object) get_rank <- function(x, ...) order(get_order(x, ...)) get_permutation_matrix <- function(x, ...) permutation_vector2matrix(get_order(x, ...)) ## c will create a ser_permutation! c.ser_permutation_vector <- function(..., recursive = FALSE) do.call("ser_permutation", list(...)) ## convert to permuation matrix permutation_vector2matrix <- function(x) { x <- get_order(x) .valid_permutation_vector(x) n <- length(x) pm <- matrix(0, nrow = n, ncol = n) for(i in 1:n) pm[i, x[i]] <- 1 pm } permutation_matrix2vector <- function(x) { .valid_permutation_matrix(x) o <- apply(x, MARGIN = 1, FUN = function(r) which(r==1)) o } ## reverse rev.ser_permutation_vector <- function(x) { if(is(x, "hclust")) { x$order <- rev(x$order); x } else ser_permutation_vector(rev(get_order(x)), method=get_method(x)) } ## currently method is an attribute of permutation get_method <- function(x, printable = FALSE) { method <- attr(x, "method") if(printable && is.null(method)) method <- "unknown" method } ## print et al length.ser_permutation_vector <- function(x) if(!.is_identity_permutation(x)) length(get_order(x)) else 0L print.ser_permutation_vector <- function(x, ...) { writeLines( c(gettextf("object of class %s", paste(sQuote(class(x)), collapse = ", ")), gettextf("contains a permutation vector of length %d", length(x)), gettextf("used seriation method: '%s'", get_method(x, printable = TRUE)))) invisible(x) } ## fake summary (we dont really provide a summary, ## but summary produces now a reasonable result --- same as print) summary.ser_permutation_vector <- function(object, ...) { object } ## helpers .is_identity_permutation <- function (x) if(is(x, "integer") && length(as.vector(x))==1 && is.na(x[1])) TRUE else FALSE .valid_permutation_vector <- function(x) { ## identity vector if(.is_identity_permutation(x)) return() perm <- get_order(x) valid <- TRUE tab <- table(perm) if(any(tab != 1)) valid <- FALSE if(length(tab) != length(perm) || any(names(tab) != sequence(length(perm)))) valid <- FALSE if(!valid) stop("Invalid permutation vector!\nVector: ", paste(perm, collapse=", ")) } .valid_permutation_matrix <- function(x) { if(any(rowSums(x)!=1) || any(colSums(x)!=1) || any(x!=1 & x!=0)) stop("Not a valid permutation matrix") } seriation/R/pimage.R0000644000176200001440000001166712766073670014066 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## image method that makes a proper image plot of a matrix. ## the rows and columns are swapped and the order of the ## columns (original rows) is reversed. pimage <- function(x, order=NULL, col=NULL, main="", xlab="", ylab="", axes="auto", zlim=NULL, key=TRUE, key.lab="", symkey=TRUE, upper.tri=TRUE, lower.tri=TRUE, prop=NULL, ..., newpage=TRUE, pop=TRUE, gp=NULL) UseMethod("pimage") ### Note for matrix large values are dark, for dist large values are light! pimage.matrix <- function(x, order=NULL, col=NULL, main="", xlab="", ylab="", axes="auto", zlim=NULL, key=TRUE, key.lab="", symkey=TRUE, upper.tri=TRUE, lower.tri=TRUE, prop = NULL, ..., newpage=TRUE, pop=TRUE, gp=NULL) { x <- as.matrix(x) ### check data if(all(is.na(x))) stop("all data missing in x.") if(any(is.infinite(x))) stop("x contains infinite entries.") ### no key for logical data! if(is.logical(x)) key <- FALSE if(is.null(col)) { if(is.logical(x)) col <- c("white","black") else if(any(x<0, na.rm = TRUE)) { col <- .diverge_pal(100) if(is.null(zlim) && symkey) zlim <- max(abs(range(x, na.rm = TRUE))) * c(-1,1) } else col <- .sequential_pal(100) } if(!is.null(order)) x <- permute(x, order) if(is.null(prop)) prop <- FALSE if(is.null(gp)) gp <- gpar() if(is.null(zlim)) zlim <- range(x, na.rm=TRUE) if(any(!upper.tri || !lower.tri) && nrow(x)!=ncol(x)) stop("Upper or lower triangle can only be suppressed for square matrices!") if(!upper.tri) x[upper.tri(x)] <- NA if(!lower.tri) x[lower.tri(x)] <- NA ## axes m <- pmatch(axes, c("auto", "x", "y", "both", "none")) if(is.na(m)) stop("Illegal vaule for axes. Use: 'auto', 'x', 'y', 'both' or 'none'!") if(m==1L) { axes_row <- nrow(x)<=25; axes_col <- ncol(x)<=25 } else if(m==2L) { axes_row <- FALSE; axes_col <- TRUE } else if(m==3L) { axes_row <- TRUE; axes_col <- FALSE } else if(m==4L) { axes_row <- TRUE; axes_col <- TRUE } else if(m==5L) { axes_row <- FALSE; axes_col <- FALSE } if(is.null(colnames(x))) axes_col <- FALSE if(is.null(rownames(x))) axes_row <- FALSE bottom_mar <- if(axes_col) max(stringWidth(colnames(x)))+unit(3, "lines") else unit(4, "lines") left_mar <- if(axes_row) max(stringWidth(rownames(x)))+unit(3, "lines") else unit(4, "lines") if(newpage) grid.newpage() if(key) { .grid_basic_layout_with_colorkey(main = main, left = left_mar, bottom = bottom_mar, gp=gp) downViewport("colorkey") .grid_colorkey(zlim, col=col, horizontal=FALSE, lab=key.lab) #, gp=gp) upViewport(1) } else .grid_basic_layout(main = main, left = left_mar, bottom = bottom_mar, gp = gp) downViewport("plot") .grid_image(x, col=col, zlim=zlim, prop=prop) #, gp=gp) ## axes and labs downViewport("image") if(axes_col) grid.text(colnames(x), y = unit(-1, "lines"), x=unit(1:ncol(x), "native"), rot=90, just="right") #, gp=gp) #grid.xaxis(at=1:ncol(x), # label=colnames(x)) if(axes_row) grid.text(rownames(x), x = unit(-1, "lines"), y=unit(1:nrow(x), "native"), just="right") #, gp=gp) #grid.yaxis(at=1:nrow(x), # label=rownames(x)) if(xlab!="") grid.text(xlab, y = -1*bottom_mar + unit(1, "lines")) #, gp=gp) if(ylab!="") grid.text(ylab, x = , -1*left_mar + unit(1, "lines"), rot=90) #, gp=gp) if(pop) popViewport(3) else upViewport(3) } pimage.default <- pimage.matrix ## small values are dark pimage.dist <- function(x, order=NULL, col=NULL, main="", xlab="", ylab="", axes="auto", zlim=NULL, key=TRUE, key.lab="", symkey=TRUE, upper.tri=TRUE, lower.tri=TRUE, prop=NULL,..., newpage=TRUE, pop=TRUE, gp=NULL) { if(is.null(col)) col <- rev(.sequential_pal(100)) else col <- rev(col) if(is.null(prop)) prop <- TRUE if(!is.null(order)) x <- permute(x, order) pimage.matrix(x, order=NULL, main=main, xlab=xlab, ylab=ylab, col=col, axes = axes, zlim=zlim, key=key, key.lab=key.lab, symkey=symkey, upper.tri=upper.tri, lower.tri=lower.tri, prop=prop, ..., newpage=newpage, pop=pop, gp=gp) } seriation/R/bertinplot.R0000644000176200001440000001654713414537475015007 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. bertinplot <- function(x, order = NULL, highlight = TRUE, options = NULL) { if(!is.matrix(x)) stop("Argument 'x' must be a matrix.") ## do labels if(!is.null(options$xlab)) rownames(x) <- options$xlab if(!is.null(options$ylab)) colnames(x) <- options$ylab ## order if(!is.null(order)) x <- permute(x, order) ## default plot options user_options <- options options <- list( panel.function = panel.bars, reverse = FALSE, xlab = NULL, ylab = NULL, frame = FALSE, spacing = 0.2, mar = c(5, 4, 8, 8), gp_labels = gpar(), gp_panels = gpar(), shading = FALSE, shading.function = grey, newpage = TRUE, pop = TRUE ) ## check and add the plot options if(!is.null(user_options) && length(user_options) != 0) { o <- pmatch(names(user_options), names(options)) if(any(is.na(o))) stop(sprintf(ngettext(length(is.na(o)), "Unknown plot option: %s", "Unknown plot options: %s"), paste(names(user_options)[is.na(o)], collapse = " "))) options[o] <- user_options } ## note: Bertin switched cols and rows for his display! if(options$reverse) { x <- t(x) } ## panel.blocks has no spacing! if(identical(options$panel.function, panel.blocks)) { options$spacing <- 0 } ## scale each variable in x for plotting (between 0 and 1 or -1 and 1) ## this can deal with 0s, na, nan, but plots inf as na infs <- is.infinite(x) infsign <- sign(x[is.infinite(x)]) scalem <-matrix(apply(abs(x), 2, max, na.rm = TRUE), byrow= TRUE, ncol=ncol(x), nrow= nrow(x)) scalem[scalem==0] <- 1 x <- x/scalem if(any(infs)) x[infs] <- infsign # x <- x/ matrix(apply(abs(x), 2, max, na.rm = TRUE), # byrow= TRUE, ncol=ncol(x), nrow= nrow(x)) ## fix division by zero (if all entries in a row are 0) #x[is.nan(x)] <- 0 ## highlight if(is.logical(highlight) && length(highlight) == 1 && highlight) highlight <- x > matrix(colMeans(x, na.rm = TRUE), ncol=ncol(x), nrow=nrow(x), byrow=TRUE) else if(is.logical(highlight) && length(highlight) == 1 && !highlight) highlight <- matrix(FALSE, ncol = ncol(x), nrow = nrow(x)) else if(any(dim(x) != dim(highlight))) stop("Argument 'highlight' has incorrect dimensions.") ## shading? if(options$shading) { highlight <- map(x, c(.8,.1)) highlight[!is.finite(highlight)] <- 1 highlight <- matrix(options$shading.function(highlight), ncol=ncol(x), nrow=nrow(x)) } ## fill in gp_panels overwrites highlighting and shading if(!is.null(options$gp_panels$fill)) { if(options$shading) warning("shading and fill in gp_panels cannot be used together!") highlight <- matrix(options$gp_panels$fill, ncol=ncol(x), nrow=nrow(x)) } ncol_x <- ncol(x) ## clear page if(options$newpage) grid.newpage() ## create outer viewport xlim <- c(options$spacing, nrow(x) + 1 - options$spacing) pushViewport(plotViewport(margins = options$mar, layout = grid.layout(ncol_x, 1), xscale = xlim, yscale = c(0, ncol_x), default.units = "native", name = "bertin")) for (variable in 1:ncol_x) { value <- x[, variable] hl <- highlight[, variable] ## handle neg. values if(identical(options$panel.function, panel.bars) || identical(options$panel.function, panel.lines)) { ylim <- c(min(value,0, na.rm=TRUE), max(value,0, na.rm=TRUE) + options$spacing) }else{ ylim <- c(0, max(abs(value),0.1, na.rm=TRUE)) } pushViewport(viewport(layout.pos.col = 1, layout.pos.row = variable, xscale = xlim, yscale = ylim, default.units = "native", gp = options$gp_panels)) ## call panel function options$panel.function(value, options$spacing, hl) ## do frame if(options$frame) grid.rect(x = 1:length(value), width = 1, default.units = "native", gp = gpar(fill = NA)) upViewport(1) } spacing_corr <- if(options$spacing <= 0) -options$spacing+0.2 else 0 grid.text(rownames(x), x = 1:nrow(x), y = ncol_x + spacing_corr, rot = 90, just = "left", default.units= "native", gp = options$gp_labels) grid.text(rev(colnames(x)), x = 1 + spacing_corr / nrow(x) / 4, y = 0.5:(ncol_x-0.5)/ncol_x, just = "left", default.units= "npc", gp = options$gp_labels) if (options$pop) popViewport(1) else upViewport(1) } ## panel functions panel.bars <- function(value, spacing, hl) { grid.rect(x = 1:length(value), y = spacing/2, width = 1 - spacing, height = value*(1 - spacing), just = c("centre", "bottom"), default.units = "native", gp = gpar(fill = hl)) } panel.circles <- function(value, spacing, hl) { ## neg. values are dashed lty <- as.integer(value<0)+1L lty[!is.finite(lty)] <- 0L value <- abs(value) value[value==0] <- NA ### hide emply squares grid.circle(x = 1:length(value), y=.5, r = value/2*(1 - spacing), default.units = "native", gp = gpar(fill = hl, lty=lty)) } panel.squares <- function(value, spacing, hl) { ## neg. values are dashed lty <- as.integer(value<0)+1L lty[!is.finite(lty)] <- 0L value[value==0] <- NA ### hide emply squares grid.rect(x = 1:length(value), width = value*(1 - spacing), height = value*(1 - spacing), default.units = "native", just = c("centre", "center"), gp = gpar(fill = hl, lty=lty)) } panel.blocks <- function(value, spacing, hl) { grid.rect(x = 1:length(value), width = 1, height = unit(1, "npc"), default.units = "native", just = c("centre", "center"), gp = gpar(fill = hl)) } panel.lines <- function(value, spacing, hl) { grid.lines(x = c(1:length(value)), y = value*(1-spacing), default.units = "native") } ## add cut lines manually to a bertin plot bertin_cut_line <- function(x = NULL, y = NULL) { if(length(x) <2) x <- rep(x,2) if(length(y) <2) y <- rep(y,2) ## find the bertin Viewport if(inherits(try(seekViewport("bertin"), silent=TRUE), "try-error")) { stop("bertinplot() needs to be called with options=list(pop=FALSE) first!") } if(is.null(x)) x <- unit(c(0,1), units="npc") else x <- x+.5 if(is.null(y)) y <- unit(c(0,1), units="npc") else y <- y grid.lines(x = x, y = y, default.units= "native", gp=gpar(col="grey", lwd=2)) } seriation/R/criterion.matrix.R0000644000176200001440000000746213124212552016102 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## Criterion for the quality of a permutation of a matrix criterion.matrix <- function(x, order = NULL, method = NULL, force_loss = FALSE, ...) .criterion_array_helper(x, order, method, "matrix", force_loss) ## Bond energy (BEA) criterion_ME <- function(x, order = NULL, ...) { ### ... unused if(any(x < 0)) stop("Bond energy (ME) is only defined for nonnegative matrices.") n <- nrow(x) m <- ncol(x) if(!is.null(order)) x <- permute(x, order) mode(x) <- "single" ener <- 0.0 energy <- .Fortran("energy", n = as.integer(n), m = as.integer(m), b = as.matrix(x), ener = as.single(ener), PACKAGE="seriation") 0.5 * as.numeric(energy$ener) } ## the interface to the stress functions allows for ## arbitrary subsetting (see the wrapper in C). ## (C) ceeboo 2005, 2006 .stress <- function(x, order, type="moore") { TYPE <- c(1,2) names(TYPE) <- c("moore", "neumann") if (inherits(x, "dist")) x <- as.matrix(x) if (!is.matrix(x)) stop("Argument 'x' must be a matrix.") if (!is.double(x)) mode(x) <- "double" if(is.null(order)) { rows <- as.integer(1:dim(x)[1]) cols <- as.integer(1:dim(x)[2]) }else{ rows <- get_order(order, 1) cols <- get_order(order, 2) } type <- as.integer(TYPE[type]) x <- .Call("stress", x, rows, cols, type) ## does only half of the matrix! 2 * x } criterion_stress_moore <- function(x, order, ...) .stress(x, order, "moore") criterion_stress_neumann <- function(x, order, ...) .stress(x, order, "neumann") ### A MEASURE OF EFFECTIVENESS FOR THE MOMENT ORDERING ALGORITHM ### by Deutsch & Martin (1971) ### Correlation coefficient R for matrices. criterion_R_matrix <- function(x, order, ...) { if(!is.null(order)) x <- permute(x, order) M <- nrow(x) N <- ncol(x) ## total sum T <- sum(x) ## X_i = i/M; Y_j = j/N X_i <- (1:M)/M Y_j <- (1:N)/N ## X_bar = 1/T sum_i,j a_ij X_i X_bar <- 1/T * sum(crossprod(x, X_i)) ## Y_bar = 1/T sum_i,j a_ij Y_j Y_bar <- 1/T * sum(crossprod(t(x), Y_j)) ## S_X2 = 1/(T-1) sum_i,j a_ij (X_i - X_bar)^2 S_X2 <- 1/(T-1) * sum(crossprod(x, (X_i-X_bar)^2)) ## S_Y2 = 1/(T-1) sum_i,j a_ij (Y_j - Y_bar)^2 S_Y2 <- 1/(T-1) * sum(crossprod(t(x), (Y_j-Y_bar)^2)) ## S_XY = 1/(T-1) sum_i,j a_ij (X_i - X_bar) (Y_j - Y_bar) S_XY <- 1/(T-1) * sum(x * outer(X_i-X_bar, Y_j-Y_bar)) ## R = S_XY/(S_X S_Y) S_XY/(sqrt(S_X2)*sqrt(S_Y2)) } ## register built-ins set_criterion_method("matrix", "ME", criterion_ME, "Measure of effectiveness", TRUE) set_criterion_method("matrix", "Cor_R", criterion_R_matrix, "Correlation Coefficient R", TRUE) set_criterion_method("matrix", "Moore_stress", criterion_stress_moore, "Stress (Moore neighborhood)", FALSE) set_criterion_method("matrix", "Neumann_stress", criterion_stress_neumann, "Stress (Neumann neighborhood)", FALSE) seriation/R/AAAregistry.R0000644000176200001440000000530613502452106014750 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## setup registries ## seriate registry_seriate <- registry(registry_class="seriation_registry", entry_class="seriation_method") registry_seriate$set_field("kind", type = "character", is_key = TRUE, index_FUN = match_partial_ignorecase) registry_seriate$set_field("name", type = "character", is_key = TRUE, index_FUN = match_partial_ignorecase) registry_seriate$set_field("fun", type = "function", is_key = FALSE) registry_seriate$set_field("description", type = "character", is_key = FALSE) registry_seriate$set_field("control", type = "list", is_key = FALSE) print.seriation_method <- function(x, ...) { writeLines(c( gettextf("name: %s", x$name), gettextf("kind: %s", x$kind), gettextf("description: %s", x$description))) if(length(x$control)>0) { writeLines("control (default values):") contr <- lapply(x$control, FUN = function(p) capture.output(dput(p, control = list()))[1]) print(as.data.frame(contr)) } else writeLines("control: no parameters registered.") invisible(x) } ## criterion registry_criterion <- registry(registry_class="criterion_registry", entry_class="criterion_method") registry_criterion$set_field("kind", type = "character", is_key = TRUE, index_FUN = match_partial_ignorecase) registry_criterion$set_field("name", type = "character", is_key = TRUE, index_FUN = match_partial_ignorecase) registry_criterion$set_field("fun", type = "function", is_key = FALSE) registry_criterion$set_field("description", type = "character", is_key = FALSE) registry_criterion$set_field("merit", type = "logical", is_key = FALSE) print.criterion_method <-function(x, ...) { writeLines(c( gettextf("name: %s", x$name), gettextf("kind: %s", x$kind), gettextf("description: %s", x$description), gettextf("merit: %s", x$merit))) invisible(x) } seriation/R/AAAcolors.R0000644000176200001440000000260112606356654014413 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. greenred <- function(n, bias = 1) grDevices::colorRampPalette(c("green", "black", "red"), bias = bias, space = "Lab")(n) ### Lab looks a little purple here! bluered <- function(n, bias = 1) grDevices::colorRampPalette(c("blue", "white", "red"), bias = bias)(n) grays <- function(n, power = 1) colorspace::sequential_hcl(n, c.=c(0), l=c(95, 40), power = power) greys <- grays ## define default colors .sequential_pal <- function(n=100, power=1) greys(n, power) .diverge_pal <- function(n=100, bias=1) bluered(n, bias) seriation/R/seriate.matrix.R0000644000176200001440000000357012763634231015546 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## seriate matrices seriate.matrix <- function(x, method = "PCA", control = NULL, margin = c(1,2), ...) .seriate_array_helper(x, method, control, margin, datatype = "matrix", defmethod = "BEA_TSP", ...) seriate_matrix_identity <- function(x, control) { control <- .get_parameters(control, NULL) l <- lapply(dim(x), seq) for(i in 1:length(dim(x))) names(l[[i]]) <- labels(x)[[i]] l } seriate_matrix_random <- function(x, control) { control <- .get_parameters(control, NULL) l <- lapply(dim(x), FUN = function(l) sample(seq(l))) for(i in 1:length(dim(x))) names(l[[i]]) <- labels(x)[[i]][l[[i]]] l } set_seriation_method("matrix", "Identity", seriate_matrix_identity, "Identity permutation") set_seriation_method("matrix", "Random", seriate_matrix_random, "Random permutation") ## these also work for general arrays! set_seriation_method("array", "Identity", seriate_matrix_identity, "Identity permutation") set_seriation_method("array", "Random", seriate_matrix_random, "Random permutation") seriation/R/AAAinstalled.R0000644000176200001440000000165112644215331015061 0ustar liggesusers####################################################################### # Helper for using optional packages # Copyrigth (C) 2015 Michael Hahsler # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. .installed <- function(pkg) !is(try(utils::installed.packages()[pkg,], silent=TRUE), "try-error") seriation/R/dissimilartiy.R0000644000176200001440000001630212747706005015473 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. .dist_methods <- c("spearman", "kendall", "manhattan", "euclidean", "hamming", "ppc", "aprd") ser_cor <- function(x, y = NULL, method = "spearman", reverse = TRUE, test=FALSE) { ## Note: not all .dist_methods are implemented! method <- match.arg(tolower(method), .dist_methods) ## make sure everything is a permutation vector if(!is.null(y)) x <- list(ser_permutation_vector(x), ser_permutation_vector(y)) else x <- lapply(x, ser_permutation_vector) m <- .lget_rank(x) if(method == "ppc") { if(test) stop("No test for association available for PPC!") return(.ppc(x)) } ## cor based methods co <- cor(m, method = method) if(reverse) co <- abs(co) ## add a correlation test? if(test) { p <- outer(1:ncol(m), 1:ncol(m), FUN = Vectorize( function(i, j) cor.test(m[,i], m[,j], method = method)$p.value)) dimnames(p) <- dimnames(co) attr(co, "p-value") <- p } co } ser_dist <- function(x, y = NULL, method = "spearman", reverse = TRUE, ...) { method <- match.arg(tolower(method), .dist_methods) ## make sure everything is a permutation vector if(!is.null(y)) x <- list(ser_permutation_vector(x), ser_permutation_vector(y)) else x <- lapply(x, ser_permutation_vector) if(!reverse) switch(method, spearman = as.dist(1-ser_cor(x, method="spearman", reverse = FALSE)), kendall = as.dist(1-ser_cor(x, method="kendal", reverse = FALSE)), ### Manhattan == Spearman's footrule manhattan = dist(t(.lget_rank(x)), method="manhattan"), euclidean = dist(t(.lget_rank(x)), method="euclidean"), hamming = .dist_hamming(t(.lget_rank(x))), ppc = as.dist(1-ser_cor(x, method="ppc", reverse = FALSE)), aprd = as.dist(.aprd(x, ...)) ) else switch(method, spearman = as.dist(1-ser_cor(x, method="spearman", reverse = TRUE)), kendall = as.dist(1-ser_cor(x, method="kendal", reverse = TRUE)), ### Manhattan == Spearman's footrule manhattan = .find_best(dist(t(.lget_rank(.add_rev(x))), method="manhattan")), euclidean = .find_best(dist(t(.lget_rank(.add_rev(x))), method="euclidean")), hamming = .find_best(.dist_hamming(t(.lget_rank(.add_rev(x))))), ### positional proximity coefficient is direction invariant ppc = as.dist(1-ser_cor(x, method="ppc", reverse = FALSE)), aprd = as.dist(.aprd(x, ...)) ) } ser_align <- function(x, method = "spearman") { if(!is.list(x) || any(!sapply(x, is, "ser_permutation_vector"))) stop("x needs to be a list with elements of type 'ser_permutation_vector'") .do_rev(x, .alignment(x, method=method)) } .dist_hamming <- function(x) { n <- nrow(x) m <- matrix(nrow=n, ncol=n) for(i in seq_len(n)) for(j in seq(i, n)) m[j, i] <- m[i, j] <- sum(x[i,] != x[j,]) mode(m) <- "numeric" dimnames(m) <- list(rownames(x), rownames(x)) as.dist(m) } ### make a permutation list into a rank matrix (cols are permutations) .lget_rank <- function(x) sapply(x, get_rank) ### add reversed permutations to a list of permutations .add_rev <- function(x) { os <- append(x, lapply(x, rev)) names(os) <- c(labels(x), paste(labels(x), "_rev", sep="")) os } ### reverses permutations in the list given a logical indicator vector .do_rev <- function(x, rev) { for(i in which(rev)) x[[i]] <- rev(x[[i]]) x } ### finds the smallest distance in lists with reversed orders present .find_best <- function(d) { ### find smallest values m <- as.matrix(d) n <- nrow(m)/2 m1 <- m[1:n, 1:n] m2 <- m[(n+1):(2*n), (n+1):(2*n)] m3 <- m[1:n, (n+1):(2*n)] m4 <- m[(n+1):(2*n), 1:n] as.dist(pmin(m1, m2, m3, m4)) } ### find largest values in matrix .find_best_max <- function(d) { m <- as.matrix(d) n <- nrow(m)/2 m1 <- m[1:n, 1:n] m2 <- m[(n+1):(2*n), (n+1):(2*n)] m3 <- m[1:n, (n+1):(2*n)] m4 <- m[(n+1):(2*n), 1:n] pmax(m1, m2, m3, m4) } ### returns TRUE for sequences which should be reversed .alignment <- function(x, method = "spearman") { if(!is.list(x) || any(!sapply(x, is, "ser_permutation_vector"))) stop("x needs to be a list with elements of type 'ser_permutation_vector'") method <- match.arg(tolower(method), .dist_methods) n <- length(x) ## calculate dist (orders + reversed orders) d <- as.matrix(ser_dist(.add_rev(x), method=method, reverse=FALSE)) diag(d) <- NA for(i in 1:n) { d[i, n+i] <- NA d[n+i, i] <- NA } ## start with closest pair take <- which(d == min(d, na.rm = TRUE), arr.ind = TRUE)[1,] #d[, c(take, (take+n) %% (2*n))] <- NA ## mark order and complement as taken d[, c(take, (take+n) %% (2*n))] <- Inf ## keep adding the closest while(length(take) < n) { t2 <- which(d[take,] == min(d[take,], na.rm = TRUE), arr.ind = TRUE)[1, 2] #d[, c(t2, (t2+n) %% (2*n))] <- NA ### closest to all #t2 <- which.min(colSums(d[take,], na.rm = T)) d[, c(t2, (t2+n) %% (2*n))] <- Inf take <- append(take, t2) } ## create indicator vector for the orders which need to be reversed take_ind <- logical(n) take_ind[take[take>n]-n] <- TRUE names(take_ind) <- names(x) take_ind } ## Propositional Proximity Coefficient (1 - generalized corr. coef.) ## Goulermas, Kostopoulos and Mu (2016). A new measure for analyzing and fusing ## sequences of objects, IEEE Transactions on Pattern Analysis and Machine ## Intelligence 38(5):833-48. ## ## x,y ... permutation vectors (ranks) .vppc <- Vectorize(function(x, y) { x <- get_rank(x) y <- get_rank(y) n <- length(x) #sum <- 0 #for(j in 2:n) for(i in 1:(j-1)) sum <- sum + (x[i]-x[j])^2 * (y[i]-y[j])^2 ## use fast matrix algebra instead Ax <- (x %*% rbind(rep_len(1, n)) - tcrossprod(cbind(rep_len(1, n)), x))^2 Ay <- (y %*% rbind(rep_len(1, n)) - tcrossprod(cbind(rep_len(1, n)), y))^2 ## note: Ay is symetric sum <- sum(diag(Ax %*% Ay)) ## scale by theoretical maximum zapsmall(sum / (n^6/15 - n^4/6 + n^2/10)) }) .ppc <- function(x) outer(x, x, .vppc) # Sum of differences of rank differences # # distance(R, S) = # \sum_{i,j} | |\pi_R(i)-\pi_R(j)| - |\pi_S(i)-\pi_S(j)| |^p # .vaprd <- Vectorize(function(x, y, p = 2) { x <- get_rank(x) y <- get_rank(y) n <- length(x) sum <- 0 for(j in 2:n) for(i in 1:(j-1)) sum <- sum + abs(abs(x[i]-x[j]) - abs(y[i]-y[j]))^p ## FIXME: scale by theoretical maximum? sum }) .aprd <- function(x, p = 2) outer(x, x, .vaprd, p=p) seriation/R/uniscale.R0000644000176200001440000000355713056074621014414 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2017 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. # unidimensional scaling: Defrays Decomposition (1978) orderplot <- function (x, main, pch = 19, ...){ if (missing(main)) main <- "Configuration" n <- length(x) plot(x, rep(0, n), axes = FALSE, ann = FALSE, pch = pch, type = "o", ylim = c(-0.2, 0.8), ...) title(main) labs <- names(x) if(is.null(labs)) labs <- 1:n text(x, rep(0, n) + 0.05, labs, srt = 90, adj = c(0, 0.5)) } uniscale <- function(d, order = NULL, method = "QAP_LS", rep = 10, ...) { if(is.null(order)) order <- seriate(d, method = method, rep = rep, ...) x <- get_rank(order) n <- length(x) w <- 1 - diag(n) normDissN <- function (diss, wghts, m){ N <- length(diss) * m dissnorm <- diss/sqrt(sum(wghts * diss^2, na.rm = TRUE)) * sqrt(N) return(dissnorm) } delta <- as.matrix(normDissN(as.dist(d), as.dist(w), 1)) v <- as.matrix(solve((diag(rowSums(w)) - w) + (1/n)) - (1/n)) s <- sign(outer(x, x, "-")) t <- as.vector(v %*% rowSums(delta * w * s)) names(t) <- attr(d, "Labels") t } seriation/R/data.R0000644000176200001440000000445112606356654013525 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ### lines data set from iVAT paper create_lines_data <- function(n=250) { n1 <- n/5*2 n2 <- n/5 n3 <- n/5*2 x1 <- data.frame(x = runif(n1, -5, 5), y = rnorm(n1, mean = 2, sd = .1)) x2 <- data.frame(x = runif(n2, -3, 3), y = rnorm(n2, mean = 0, sd = .1)) x3 <- data.frame(x = runif(n3, -5, 5), y = rnorm(n3, mean = -2, sd = .1)) id <- c(rep(1, times=n1), rep(2, times=n2), rep(3, times=n3)) x <- rbind(x1, x2, x3) o <- sample(nrow(x)) x <- x[o,] id <- id[o] rownames(x) <- 1:nrow(x) attr(x, "id") <- id x } ### ordered data by Michael Hahsler (cite this package) create_ordered_data <- function(n = 250, k=2, size = NULL, spacing = 6, path = "linear", sd1=1, sd2=0) { if(k>n) stop("k needs to be less than n!") path <- match.arg(path, c("linear", "circular")) ## size if(is.null(size)) size <- rep(1, k) else if(length(size) != k) stop("length of size vector and k do not agree!") size <- round(size/sum(size) * n) size[1] <- n - sum(size[-1]) ## create data ids <- rep(1:k, times = size) x <- data.frame( x = rnorm(n, mean = ids*spacing, sd = sd1), y = rnorm(n, mean = 0, sd = sd2) ) ## transform if(path == "circular"){ p <- k*spacing theta <- x[,1]/p * 2*pi r <- p/(2*pi)+ x[,2] x <- cbind(x=r*sin(theta), y=r*cos(theta)) } ## randomize order o <- sample(nrow(x)) x <- x[o , , drop=FALSE] ids <- ids[o] attr(x, "id") <- ids x } seriation/R/permute.R0000644000176200001440000001115112650525437014264 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## generic permute <- function(x, order, ...) UseMethod("permute") ## methods ##permute.default <- function(x, order) ##stop(paste("\npermute not implemented for class: ", class(x))) permute.default <- function(x, order, ...) .permute_kd(x, order, ...) permute.array <- function(x, order, ...) .permute_kd(x, order, ...) permute.matrix <- function(x, order, ...) .permute_kd(x, order, ...) permute.numeric <- function(x, order, ...) .permute_1d(x, order, ...) permute.character <- function(x, order, ...) .permute_1d(x, order, ...) permute.list <- function(x, order, ...) .permute_1d(x, order, ...) ## special cases permute.dist <- function(x, order, ...){ .nodots(...) if(!inherits(order, "ser_permutation")) order <- ser_permutation(order) if(.is_identity_permutation(order[[1]])) return(x) .check_dist_perm(x, order) .rearrange_dist(x, get_order(order, 1)) } permute.data.frame <- function(x, order, ...){ .nodots(...) if(!inherits(order, "ser_permutation_vector")) order <- ser_permutation(order) if(length(order) != 1L) stop("dimensions do not match") perm <- get_order(order[[1L]]) if(nrow(x) != length(perm)) stop("some permutation vectors do not fit dimension of data") x[perm,] } permute.dendrogram <- function(x, order, ...) { .nodots(...) if(length(get_order(order)) != nobs(x)) stop("Length of order and number of leaves in dendrogram do not agree!") x <- dendextend::rotate(x, order = match(get_order(order), order.dendrogram(x))) if(any(order.dendrogram(x) != get_order(order))) warning("Dendrogram cannot be perfectly reordered! Using best approximation.") x } permute.hclust <- function(x, order, ...) { nd <- as.hclust(permute(as.dendrogram(x), order, ...)) x$merge <- nd$merge x$height <- nd$height x$order <- nd$order x } ## helper .check_dist_perm <- function(x, order){ if(length(order) != 1L) stop("dimensions do not match") if(attr(x, "Size") != length(get_order(order, 1))) stop("some permutation vectors do not fit dimension of data") ## check dist if(attr(x, "Diag") || attr(x, "Upper")) stop("'dist' with diagonal or upper triangle matrix not implemented") } .check_matrix_perm <- function(x, order){ if(length(dim(x)) != length(order)) stop("dimensions do not match") if(any(dim(x) != sapply(order, length))) stop("some permutation vectors do not fit dimension of data") } .permute_kd <- function(x, order, ...){ .nodots(...) if(!inherits(order, "ser_permutation")) order <- ser_permutation(order) ## deal with identity permutations todo <- which(sapply(order, .is_identity_permutation)) for(i in todo) order[[i]] <- ser_permutation_vector(seq(dim(x)[i])) .check_matrix_perm(x, order) perm <- lapply(order, get_order) do.call("[", c(list(x), perm, drop=FALSE)) } .permute_1d <- function(x, order, ...) { .nodots(...) if(!inherits(order, "ser_permutation")) order <- ser_permutation(order) if(length(order) != 1) stop("dimensions do not match!") if(.is_identity_permutation(order[[1]])) return(x) perm <- get_order(order, 1) if(length(x) != length(perm)) stop("some permutation vectors do not fit dimension of data!") x[perm] } ## if we used proxy we would say: #.rearrange_dist <- function (x, order) x[[order]] .rearrange_dist <- function (x, order){ ## make C call mode(x) <- "double" ## as.dist seems to make Size numeric and not integer! attr(x, "Size") <- as.integer(attr(x, "Size")) mode(order) <- "integer" d <- .Call("reorder_dist", x, order) labels <- if(is.null(labels(x))) NULL else labels(x)[order] structure(d, class = "dist", Size = length(order), Labels = labels, Diag = FALSE, Upper = FALSE, method = attr(x, "method") ) } seriation/R/seriate_VAT.R0000644000176200001440000000364613502512562014753 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## VAT: a tool for visual assessment of (cluster) tendency ## Bezdek, J.C., Hathaway, R.J. ## Proceedings of the 2002 International Joint Conference on ## Neural Networks, 2002. IJCNN '02. (Volume:3) seriate_dist_VAT <- function(x, control = NULL) { #param <- .get_parameters(control, NULL) .get_parameters(control, NULL) D <- as.matrix(x) N <- nrow(D) P <- rep(NA_integer_, N) I <- rep(FALSE, N) ### J is !I i <- which(D == max(D, na.rm = TRUE), arr.ind = TRUE)[1,1] P[1] <- i I[i] <- TRUE for(r in 2:N) { D2 <- D[I,!I, drop=FALSE] j <- which(D2 == min(D2, na.rm = TRUE), arr.ind = TRUE)[1,2] j <- which(!I)[j] P[r] <- j I[j] <- TRUE } names(P) <- labels(x)[P] P } set_seriation_method("dist", "VAT", seriate_dist_VAT, "Visual assesment of clustering tendency (Bezdek and Hathaway (2002). Creates an order based on Prim's algorithm for finding a minimum spanning tree (MST) in a weighted connected graph representing the distance matrix. The order is given by the order in which the nodes (objects) are added to the MST.") seriation/R/AAAgrid.R0000644000176200001440000002121212712421151014015 0ustar liggesusers####################################################################### # Basic Grid helpers # Copyrigth (C) 2011 Michael Hahsler # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## grid helpers .grid_basic_layout <- function(main = "", left=unit(4, "lines"), right = unit(4, "lines"), bottom = unit(4, "lines"), gp = gpar()){ pushViewport(viewport(layout = grid.layout(4, 3, widths = unit.c( left, # space unit(1, "npc") - left - right, # plot right # space ), heights = unit.c( unit(3, "lines"), # title unit(1, "lines"), # space unit(1, "npc") - unit(4, "lines") - bottom, # plot bottom # space ) ), gp = gp)) pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1, name="main")) gp$cex <- 1.3 gp$fontface <- "bold" grid.text(main, gp = gp) upViewport(1) pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 3, name="plot")) upViewport(2) } .grid_basic_layout_with_colorkey <- function(main = "", left=unit(4, "lines"), right = unit(4, "lines"), bottom = unit(4, "lines"), gp = gpar()){ pushViewport(viewport(layout = grid.layout(4, 3, widths = unit.c( left, # space unit(1, "npc") - left - right, # plot right # space ), heights = unit.c( unit(3, "lines"), # title unit(1, "lines"), # space unit(1, "npc") - unit(4, "lines") - bottom, # plot bottom # space ) ), gp = gp)) pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1, name="main")) gp$cex <- 1.3 gp$fontface <- "bold" grid.text(main, gp = gp) upViewport(1) pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 3)) pushViewport(viewport(layout = grid.layout(1, 3, widths = unit.c( unit(1, "npc") - unit(8, "lines"),# plot unit(1, "lines"), # space unit(1, "lines") # colorkey ), heights = unit.c( unit(1, "npc") # plot ) ))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1, name="plot")) upViewport(1) pushViewport(viewport(layout.pos.col = 3, layout.pos.row = 1, name="colorkey")) upViewport(1) upViewport(2) } ### new version below uses grid.raster .grid_image_old <- function(x, y, z, zlim, col = grey.colors(12, 1, 0), name = "image", gp = gpar()) { if(is.matrix(x)){ z <- x x <- 1:ncol(z) y <- 1:nrow(z) } if(missing(zlim)) zlim <- range(z, na.rm = TRUE) else {# fix data for limits z[z < zlim[1]] <- NA z[z > zlim[2]] <- NA } offset <- if(zlim[1] < 0) -zlim[1] else 0 range <- diff(zlim) div <- 1/length(col) ## create a viewport vp <- viewport( xscale = c(0,(length(x)+1)), yscale = c((length(y)+1),0), default.units = "native", name = name) pushViewport(vp) ## make sure we have a color for the maximal value (see floor +1) col[length(col)+1] <- col[length(col)] ## the highest value is lightest color! xs <- sapply(x, "rep.int", times = length(y)) grid.rect(x = xs, y = y, 1, 1, gp = gpar(fill = col[floor((z + offset)/range/div)+1], col=0), default.units = "native") ## make border gp_border <- gp gp_border$fill <- "transparent" grid.rect(x = (length(x)+1)/2, y = (length(y)+1)/2, width = length(x), height = length(y), default.units = "native", gp = gp_border) upViewport(1) } .grid_image <- function(x, zlim, col = grey.colors(12, 1, 0), prop = FALSE, name = "image", gp = gpar()) { if(missing(zlim)) zlim <- range(x, na.rm = TRUE) else {# fix data for limits x[x < zlim[1]] <- NA x[x > zlim[2]] <- NA } offset <- if(zlim[1] < 0) -zlim[1] else 0 #range <- diff(zlim) ### not al plots have 0 as the minimum! range <- zlim[2]+offset div <- 1/length(col) ## create a viewport if(!prop) { vp <- viewport( #xscale = c(0,ncol(x)), yscale = c(nrow(x),0), xscale = c(0.5,ncol(x)+.5), yscale = c(nrow(x)+.5,0.5), default.units = "native", name = name) pushViewport(vp) }else{ ## ratio if (nrow(x) > ncol(x)) { w <- ncol(x)/nrow(x); h <- 1 } else if (nrow(x) < ncol(x)) { h <- nrow(x)/ncol(x); w <- 1 } else { w <- 1; h <- 1 } vp <- viewport( #xscale = c(0,ncol(x)), yscale = c(nrow(x),0), xscale = c(0.5,ncol(x)+.5), yscale = c(nrow(x)+.5,0.5), width = unit(w, "snpc"), height = unit(h, "snpc"), default.units = "native", name = name) pushViewport(vp) } ## make sure we have a color for the maximal value (see floor +1) col[length(col)+1] <- col[length(col)] ## the highest value is lightest color! x[] <- col[floor((x + offset)/range/div)+1] grid.raster(x, interpolate=FALSE, default.units = "npc", width=1, height=1) ## make border gp_border <- gp gp_border$fill <- "transparent" grid.rect(gp = gp_border) upViewport(1) } .grid_barplot_horiz <- function(height, name = "barplot", xlab="", gp = gpar(), gp_bars = gpar(fill="lightgrey")) { n <- length(height) ## these plots always start at x = 0 or below! lim <- c(min(c(height, 0)), max(height)) ## create a viewport vp <- viewport( xscale = lim , yscale = c(n,0), default.units = "native", name = name, gp =gp) pushViewport(vp) grid.rect(x = 0, y = (1:n)-.5, width = height, height = 1, just = c("left", "center"), default.units = "native", gp =gp_bars) ## hopefully there is space outside for axes grid.xaxis() grid.text(xlab, y = unit(-3, "lines")) upViewport(1) } # new colorkey uses grid.raster .grid_colorkey_old <- function(range, col, threshold = NULL, name = "colorkey", gp = gpar()) { vp <- viewport( xscale = range, yscale = c(0,1), default.units = "native", name = name) pushViewport(vp) n <- length(col) width <- diff(range)/n xs <- seq(range[1] + width/2, range[2] - width/2, length.out = n) ## do not display the part above the threshold col[xs > threshold] <- NA ## col gp_col <- gp gp_col$col <- 0 gp_col$fill <- col grid.rect(x = xs, y = 0, width = width, height = 1, just = c("centre", "bottom"), default.units = "native", gp = gp_col) ## box gp_border <- gp gp_border$fill <- "transparent" grid.rect(x = 0, y = 0, width = 1, height = 1, just = c("left", "bottom"), default.units = "npc", gp = gp_border) grid.xaxis(gp = gp) upViewport(1) } .grid_colorkey <- function(range, col, threshold = NULL, lab = "", name = "colorkey", horizontal=TRUE, gp = gpar()) { ### no color key for only a single value if(diff(range) == 0) { vp <- viewport( xscale = c(0,1), yscale = c(0,1), default.units = "native", name = name) pushViewport(vp) grid.text(label = range[1], x = 0.5, y = 0.5, default.units = "native") return(upViewport(1)) } if(horizontal) vp <- viewport( xscale = range, yscale = c(0,1), default.units = "native", name = name) else vp <- viewport( xscale = c(0,1), yscale = range, default.units = "native", name = name) pushViewport(vp) n <- length(col) #width <- diff(range)/n #xs <- seq(range[1] + width/2, range[2] - width/2, length.out = n) xs <- seq(range[1], range[2], length.out = n) ## do not display the part above the threshold col[xs > threshold] <- NA ## col if(horizontal) grid.raster(t(col), width=1, height=1, interpolate=FALSE) else grid.raster(rev(col), width=1, height=1, interpolate=FALSE) #gp_col <- gp #gp_col$col <- 0 #gp_col$fill <- col #grid.rect(x = xs, y = 0, width = width, height = 1, # just = c("centre", "bottom"), default.units = "native", # gp = gp_col) ## box gp_border <- gp gp_border$fill <- "transparent" grid.rect(gp = gp_border) if(horizontal) grid.xaxis(gp = gp) else grid.yaxis(main = FALSE, gp = gp) if(horizontal) grid.text(lab, y= unit(-2.5, "lines")) else grid.text(lab, x= unit(4, "lines"), rot = 90) upViewport(1) } seriation/R/dissplot.R0000644000176200001440000004246413055430006014442 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## Cluster visualization by proximity matrix shading ## interface dissplot <- function(x, labels = NULL, method = "Spectral", control = NULL, options = NULL, ...) { ## add ... to options options <- c(options, list(...)) ## make x dist if(!inherits(x, "dist")) { if(is.matrix(x) && isSymmetric(x)) x <- as.dist(x) else stop("Argument 'x' cannot safely be coerced to class 'dist'.") } res <- .arrange_dissimilarity_matrix(x, labels = labels, method = method, control = control) ## supress plot? plot <- if(is.null(options$plot)) TRUE else is.null(options$plot) if(plot) plot(res, options, gp = options$gp) invisible(res) } ## work horse .arrange_dissimilarity_matrix <- function(x, labels = NULL, method = NULL, control = NULL) { ## x is already of class dist dim <- attr(x, "Size") diss_measure <- attr(x, "method") ## check labels if(!is.null(labels) && length(labels) != dim) stop("Number of labels in 'labels' does not match dimensions of 'x'.") m <- method ## set everything to NULL first order <- NULL k <- NULL # number of clusters sil <- NULL avgSil <- NULL labels_unique <- NULL cluster_dissimilarities <- NULL ## method$a means method$ aggregation (default is avg) aggregation <- "avg" if(class(method) == "list" && !is.null(method$a)) aggregation <- method$a if(class(method) != "list") method <- list(inter_cluster = m, intra_cluster = m) m <- pmatch(names(method), c("inter_cluster", "intra_cluster", "aggregation")) if(any(is.na(m))) stop("Unknown method component. Use 'inter_cluster', 'intra_cluster' and 'aggregation'.") names(method) <- c("inter_cluster", "intra_cluster", "aggregation")[m] if(class(control[[1]]) != "list"){ control <- list(inter_cluster = control, intra_cluster = control) } if(!is.null(method$inter_cluster) && is.na(method$inter_cluster)) { ## no setiation if(!is.null(labels)) { ## do coarse seriation order <- order(labels) k <- length(unique(labels)) ## calculate cluster_dissimilarities for later cluster_dissimilarities <- .cluster_dissimilarity(x, labels, aggregation) aggregation <- attr(cluster_dissimilarities, "method") ## calculate silhouette values for later use sil <- cluster::silhouette(labels, x) } ## else keep the matrix as is -- do not reorder }else if(is.null(labels)) { ## reorder whole matrix if no labels are given order <- seriate(x, method = method$inter_cluster, control = control$inter)[[1]] method$inter_cluster <- if(!is.null(attr(order, "method"))) attr(order, "method") else method$inter_cluster order <- get_order(order) }else{ ## reorder clusters for given labels ## get number of clusters k k <- length(unique(labels)) ## reorder with average pairwise dissimilarites between clusters cluster_dissimilarities <- .cluster_dissimilarity(x, labels, aggregation) aggregation <- attr(cluster_dissimilarities, "method") if(k>2) { cluster_order <- seriate(as.dist(cluster_dissimilarities), method = method$inter_cluster, control = control$inter)[[1]] method$inter_cluster <- if(!is.null(attr(cluster_order, "method"))) attr(cluster_order, "method") else method$inter_cluster cluster_order <- get_order(cluster_order) }else{ cluster_order <- 1:k } ## calculate silhouette values for later use sil <- cluster::silhouette(labels, x) ## determine order for matrix from cluster order order <- c() if(!is.null(method$intra_cluster) && is.na(method$intra_cluster)) { ## no intra cluster ordering for(i in 1 : k) { order <- c(order, which(labels == cluster_order[i])) } ##method$intra_cluster <- NA }else{ ## intra cluster order for(i in 1 : k) { take <- which(labels == cluster_order[i]) ## only reorder for >1 elements if(length(take) > 1) { if(is.character(method$intra_cluster) && match(tolower(method$intra_cluster), c("sil", "silhouette", "silhouette width"), nomatch = 0) > 0) { intra_order <- order(sil[take, "sil_width"], decreasing = TRUE) method$intra_cluster <- "silhouette width" }else{ ## we use .rearrange_dist instead of permute ## since we take only a subset! block <- .rearrange_dist(x, take) intra_order <- seriate(block, method = method$intra_cluster, control = control$intra)[[1]] method$intra_cluster <- if(!is.null(attr(intra_order, "method"))) attr(intra_order, "method") else method$intra_cluster intra_order <- get_order(intra_order) } order <- c(order, take[intra_order]) }else{ order <- c(order, take) } } } ## reorder cluster_dissimilarities for later cluster_dissimilarities <- cluster_dissimilarities[cluster_order, cluster_order] } ## reorder matrix if(!is.null(order)) { x_reordered <- permute(x, order) labels <- labels[order] } else x_reordered <- x ## prepare for return value cluster_description <- NULL if(!is.null(labels)) { labels_unique <- unique(labels) ## reorder silhouettes sil <- sil[order,] ## calculate avg silhouettes avgSil <- sapply(labels_unique, function(x) mean(sil[sil[,"cluster"]==x, "sil_width"])) ## generate description cluster_description = data.frame( position = c(1 : k), label = labels_unique, size = tabulate(labels)[labels_unique], ## FIXME: this is not the average anymore! aggregated_dissimilarity = diag(cluster_dissimilarities)[labels_unique], avg_silhouette_width = avgSil) } ## clean order from names, etc. attributes(order) <- NULL result <- list( x_reordered = x_reordered, labels = labels, seriation_methods = method, aggregation_method = aggregation, k = k, cluster_dissimilarities = cluster_dissimilarities, sil = sil, order = order, cluster_order = labels_unique, diss_measure = diss_measure, description = cluster_description) class(result) <- "reordered_cluster_dissimilarity_matrix" invisible(result) } ## plot for reordered_cluster_dissimilarity_matrix plot.reordered_cluster_dissimilarity_matrix <- function(x, options = NULL, ...) { m <- as.matrix(x$x_reordered) k <- x$k dim <- attr(x$x_reordered, "Size") labels <- x$labels labels_unique <- unique(labels) ## default plot options options <- .get_parameters(options, list( cluster_labels = TRUE, lines = TRUE, averages = c(FALSE, TRUE), ## (upper.tri, lower.tri); NA means white flip = FALSE, silhouettes = FALSE, col = NULL, threshold = NULL, zlim = NULL, key = TRUE, main = NULL, axes = "auto", gp = gpar(), gp_lines = gpar(), gp_labels = gpar(), newpage = TRUE, pop = TRUE )) if(is.null(options$col)) options$col <- rev(.sequential_pal()) else options$col <- rev(options$col) i <- pmatch(options$axes, c("auto", "x", "y", "both", "none")) if(is.na(i)) stop("Illegal vaule for axes. Use: 'auto', 'x', 'y', 'both' or 'none'!") options$axes <- c("auto", "x", "y", "both", "none")[i] ## clear page if(options$newpage) grid.newpage() ## do we have silhouettes? if(is.null(x$sil)) options$silhouettes <- FALSE ## create panels with avg. dissimilarity ## blank out if NA if(is.na(options$averages[1])) m[upper.tri(m)] <- NA if(is.na(options$averages[2])) m[lower.tri(m)] <- NA options$averages[is.na(options$averages)] <- FALSE if(!is.null(x$cluster_dissimilarities) && !is.null(labels) && any(options$averages)){ for(i in 1 : k) { for( j in 1 : k) { ## check empty clusters if(is.na(labels_unique[i])) next if(is.na(labels_unique[j])) next ## upper panels stay unchanged if(i < j && options$averages[1]) { m[labels == labels_unique[i], labels == labels_unique[j]] <- x$cluster_dissimilarities[i, j] } ## do lower panels if(i > j && options$averages[2]) { m[labels == labels_unique[i], labels == labels_unique[j]] <- x$cluster_dissimilarities[i, j] } ## do diagonal if(i == j) { block <- m[labels == labels_unique[i], labels == labels_unique[j]] if(options$averages[1]) { block[upper.tri(block, diag = TRUE)] <- x$cluster_dissimilarities[i, j] m[labels == labels_unique[i], labels == labels_unique[j]] <- block } if(options$averages[2]) { block[lower.tri(block, diag = TRUE)] <- x$cluster_dissimilarities[i, j] m[labels == labels_unique[i], labels == labels_unique[j]] <- block } } } } } if(options$flip){ m <- m[,ncol(m):1] } if(!options$silhouettes) { pushViewport(viewport(layout = grid.layout(6, 3, widths = unit.c( unit(2, "lines"), # space unit(1, "snpc") - unit(7, "lines"), # image unit(2, "lines") # space ), heights = unit.c( unit(2, "lines"), # title unit(1, "lines"), # space unit(1, "snpc") - unit(7, "lines"), # image unit(1, "lines"), # space unit(1, "lines"), # colorkey unit(2, "lines") # space ) ), gp=options$gp)) main_vp <- viewport(layout.pos.col = 2, layout.pos.row = 1, name="main") image_vp <- viewport(layout.pos.col = 2, layout.pos.row = 3) colorkey_vp <- viewport(layout.pos.col = 2, layout.pos.row = 5, name = "colorkey") }else{ ## with silhouettes pushViewport(viewport(layout = grid.layout(6, 5, widths = unit.c( unit(2, "lines"), # space unit(0.7, "snpc") - unit(2.5, "lines"), # image unit(1, "lines"), # space unit(0.3, "snpc") - unit(2.5, "lines"), # sil unit(2, "lines") # space ), heights = unit.c( unit(2, "lines"), # title unit(2, "lines"), # space unit(0.7, "snpc") - unit(2.5, "lines"), # image unit(1, "lines"), # space unit(1, "lines"), # colorkey unit(2, "lines") # space ) ), gp = options$gp)) main_vp <- viewport(layout.pos.col = 2:4, layout.pos.row = 1, name="main") image_vp <- viewport(layout.pos.col = 2, layout.pos.row = 3) sil_vp <- viewport(layout.pos.col = 4, layout.pos.row = 3, name="sil") colorkey_vp <- viewport(layout.pos.col = 2, layout.pos.row = 5, name="colorkey") } ## main pushViewport(main_vp) grid.text(options$main, gp = gpar(cex = 1.3, fontface = "bold")) upViewport(1) ## silhouette if(options$silhouettes) { ## get and reorder silhouettes s <- x$sil[,"sil_width"] pushViewport(sil_vp) .grid_barplot_horiz(s, xlab = "Silhouette width", gp_bars = gpar(fill = "lightgrey", col = 0)) upViewport(1) } ## image if(is.null(options$zlim)) options$zlim <- range(m, na.rm = TRUE) if(!is.null(options$threshold)) m[m > options$threshold] <- NA pushViewport(image_vp) .grid_image(m, col = options$col, zlim = options$zlim) ## add labels? if(options$axes == "auto" && nrow(m)>25) options$axes <- "none" if(options$axes != "none") { downViewport("image") #grid.text(colnames(m), y = unit(-1, "lines"), # x=unit(1:ncol(m), "native"), rot=90, just="right") grid.text(rownames(m), x = unit(1, "npc") + unit(1, "lines"), y=unit(1:nrow(m), "native"), just="left", gp = options$gp_labels) upViewport(1) } upViewport(1) ## color key? if(options$key) { pushViewport(colorkey_vp) .grid_colorkey(options$zlim, col = options$col, threshold = options$threshold) upViewport(1) } ## plot cluster borders if we have labels and order if(!is.null(labels)) { labels_unique_y <- labels_unique cluster_width_y <- (tabulate(labels)[labels_unique]) #cluster_cuts_y <- cumsum(cluster_width_y) + 0.5 cluster_cuts_y <- cumsum(cluster_width_y) cluster_center_y <- cluster_cuts_y - cluster_width_y / 2 if(options$flip) { labels_unique_x <- rev(labels_unique) cluster_width_x <- (tabulate(labels)[labels_unique_x]) # cluster_cuts_x <- cumsum(cluster_width_x) + 0.5 cluster_cuts_x <- cumsum(cluster_width_x) cluster_center_x<- cluster_cuts_x - cluster_width_x / 2 }else{ labels_unique_x <- labels_unique_y cluster_width_x <- cluster_width_y cluster_cuts_x <- cluster_cuts_y cluster_center_x <- cluster_center_y } if(options$cluster_labels) { seekViewport("image") ## above the plot grid.text(labels_unique_x, x = cluster_center_x, y = unit(1, "npc") + unit(1, "lines"), default.units = "native", gp = options$gp_labels) ## left of the plot grid.text(labels_unique_y, x = unit(-1, "lines"), y = cluster_center_y, default.units = "native", gp = options$gp_labels) upViewport(2) } if(options$lines) { ## draw lines separating the clusters #cluster_cuts <- cluster_cuts[-length(cluster_cuts)] ## remove last line seekViewport("image") for(i in 1:(k-1)) { grid.lines( #x = c(0, dim), x = c(0.5, dim + 0.5), y = cluster_cuts_y[i]+.5, default.units = "native", gp = options$gp_lines) grid.lines( x = cluster_cuts_x[i]+.5, #y = c(0, dim), y = c(0.5, dim + 0.5), default.units = "native", gp = options$gp_lines) } upViewport(2) } } if (options$pop) popViewport(1) else upViewport(1) } ## print for reordered_cluster_dissimilarity_matrix print.reordered_cluster_dissimilarity_matrix <- function(x, ...) { d <- attr(x$x_reordered, "Size") k <- if(!is.null(x$k)) x$k else NA cat(gettextf("object of class '%s'\n", class(x))) cat("matrix dimensions:", d, "x", d, "\n") cat(gettextf("dissimilarity measure: '%s'\n", x$diss_measure)) cat("number of clusters k:", k, "\n") if(!is.null(x$k)) { cat("\ncluster description\n") print(x$description) } cat("\n") cat("used seriation methods\n") cat(gettextf("inter-cluster: '%s'\n", x$seriation_methods$inter)) cat(gettextf("intra-cluster: '%s'\n", x$seriation_methods$intra)) cat("\n") cat(gettextf("dissimilarity aggregation method: '%s'\n", x$aggregation_method)) invisible(x) } ## inter and intra cluster dissimilarity matrix from ## a dissimilarity matrix plus labels .cluster_dissimilarity <- function(x, labels, method=c("avg", "min", "max", "Hausdorff")) { method <- match.arg(method) ## FIXME: Implement Hausdorff linkage <- if(method=="avg") mean else if(method=="min") min else if(method=="max") max else if(method=="Hausdorff") .hausdorff else stop("Unknown method.") if(class(x) != "matrix") x <- as.matrix(x) ## kill self-dissimilarities (which are always 0) diag(x) <- NA k <- length(unique(labels)) diss_matrix <- matrix(nrow = k, ncol = k) ## calculate avg. dissimilarity between clusters for(i in 1:k) { slice <- x[labels == i, , drop = FALSE] for(j in 1:i) { block <- slice[,labels == j, drop = FALSE] val <- linkage(block, na.rm = TRUE) ## fix for clusters of size 1 if(is.nan(val)) val <- 0 diss_matrix[i, j] <- val diss_matrix[j, i] <- val } } attr(diss_matrix, "method") <- method diss_matrix } ## implement Hausdorff distance between two sets from a dissimilarity matrix ##d_H = max{sup_x\inX inf_y\inY d(x,y), sup_y\inY inf_x\inX d(x,y)} .hausdorff <- function(block, na.rm=TRUE) max( apply(block, MARGIN = 1, min, na.rm = na.rm), apply(block, MARGIN = 2, min, na.rm = na.rm)) seriation/R/seriate_TSP.R0000644000176200001440000000276313502510032014754 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## Bridge to package tsp .tsp_control <- list( method="arbitrary insertion", rep = 10, two_opt = TRUE ) seriate_dist_tsp <- function(x, control = NULL){ ## add a dummy city for cutting tsp <- insert_dummy(TSP(x), n = 1, label = "cut_here") if(is.null(control)) control <- .tsp_control tour <- solve_TSP(tsp, method = control$method, control = control) o <- cut_tour(tour, cut = "cut_here", exclude_cut = TRUE) names(o) <- labels(x)[o] o } set_seriation_method("dist", "TSP", seriate_dist_tsp, "Minimize Hamiltonian path length with a TSP solver (see solve_TSP in package TSP for available methods).", .tsp_control) seriation/R/seriate_SA.R0000644000176200001440000000710113502514365014615 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2017 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## Simulated annealing reimplimentation folowing arsa.f by Brusco et al. ## can use any criterion function ### neighborhood functions LS_swap <- function(o, pos = sample.int(length(o), 2)) { tmp <- o[pos[1]] o[pos[1]] <- o[pos[2]] o[pos[2]] <- tmp o } ### insert pos[1] in pos[2] LS_insert <- function(o, pos = sample.int(length(o), 2)) { append(o[-pos[1]], o[pos[1]], after = pos[2]-1) } LS_reverse <- function(o, pos = sample.int(length(o), 2)) { o[pos[1]:pos[2]] <- o[pos[2]:pos[1]] o } LS_mixed <- function(o, pos = sample.int(length(o), 2)) { switch(sample.int(3, 1), LS_swap(o, pos), LS_insert(o, pos), LS_reverse(o, pos) ) } .sa_contr <- list( criterion = "Gradient_raw", init = "Spectral", ## use "Random" for random init. localsearch = LS_insert, cool = 0.5, tmin = 0.0001, nlocal = 10, ## try nlocal x n local search steps verbose = FALSE ) seriate_sa <- function(x, control = NULL) { param <- .get_parameters(control, .sa_contr) n <- attr(x, "Size") if(is.numeric(param$init)) { .check_dist_perm(x, order = param$init) }else{ if(param$verbose) cat("\nObtaining initial solution via:", param$init, "\n") o <- get_order(seriate(x, method = param$init)) } z <- criterion(x, o, method = param$criterion, force_loss = TRUE) if(param$verbose) cat("Initial z =", z, "(converted into loss if necessary)\n") iloop <- param$nlocal*n # find tmax (largest change for a move) znew <- replicate(iloop, expr = { criterion(x, param$localsearch(o), method = param$criterion, force_loss = TRUE) }) tmax <- max(z-znew) if(tmax < 0) nloop <- 1L else nloop <- as.integer((log(param$tmin)-log(tmax))/log(param$cool)) if(param$verbose) cat("Found tmax = ", tmax, "using", nloop, "iterations\n") zbest <- z temp <- tmax for(i in 1:nloop) { m <- 0L for(j in 1:iloop) { onew <- param$localsearch(o) znew <- criterion(x, onew, method = param$criterion, force_loss = TRUE) delta <- z-znew if(delta > 0 || runif(1) < exp(delta/temp)) { o <- onew z <- znew m <- m+1L } } if(param$verbose) { cat("temp = ", round(temp, 4), "\tz =", z, "\t performed moves = ", m, "/", iloop, "\n") } temp <- temp * param$cool } o } set_seriation_method("dist", "SA", seriate_sa, "Minimize a specified seriation measure (criterion) using simulated annealing. Control parameter init specifies an algorithm used to create an initial solution (use \"Random\" for no warm start). localsearch specified the local neighborhood function. Built-in functions are \"LS_insert\", \"LS_swap\", \"LS_reverse\", and \"LS_mix\" (1/3 insertion, 1/3 swap and 1/3 reverse).", .sa_contr) seriation/R/seriate.array.R0000644000176200001440000000404113475270262015353 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## seriate general arrays .seriate_array_helper <- function(x, method = "PCA", control = NULL, margin = seq(length(dim(x))), datatype = "array", defmethod, ...){ ## add ... to control control <- c(control, list(...)) ## margin 1...rows, 2...cols, ... #if(is.null(method)) method <- "PCA" #else if(!is.character(method) || (length(method) != 1L)) stop("Argument 'method' must be a character string.") method <- get_seriation_method(datatype, method) if(!is.null(control$verbose) && control$verbose) cat(method$name, ": ", method$description, "\n\n", sep="") order <- method$fun(x, control) perm <- do.call("ser_permutation", unname(lapply(order, "ser_permutation_vector", method$name)) ) perm[margin] } seriate.array <- function(x, method = "PCA", control = NULL, margin = seq(length(dim(x))), ...) .seriate_array_helper(x, method, control, margin, datatype = "array", defmethod = NA,...) ## we currently have no method and therefore also no default method! ## methods ## Identity is defined in seriate.matrix.R ## no other methods available right now ## register methods ## no methods available right now seriation/R/seriate_spectral.R0000644000176200001440000000504313502514562016131 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## Spectral Seriation ## Ding, C. and Xiaofeng He (2004): Linearized cluster assignment via ## spectral orderingProceedings of the Twenty-first. ## International Conference on Machine learning (ICML '04) ## Minimizes: sum_{i,j} (i-j)^2 * d_{pi_i,pi_j} seriate_dist_spectral <- function(x, control = NULL) { #param <- .get_parameters(control, NULL) .get_parameters(control, NULL) ### calculate Laplacian W <- 1/(1+as.matrix(x)) D <- diag(rowSums(W)) L <- D - W ## The Fiedler vector is the eigenvector with the smallest eigenvalue ## eigen reports eigenvectors/values in decreasing order q <- eigen(L) fiedler <- q$vectors[,ncol(W)-1L] o <- order(fiedler) names(o) <- names(x)[o] o } seriate_dist_spectral_norm <- function(x, control = NULL) { #param <- .get_parameters(control, NULL) .get_parameters(control, NULL) ### calculate normalized Laplacian W <- 1/(1+as.matrix(x)) D_sqrt<- diag(rowSums(1/W^.5)) L <- D_sqrt %*% W %*% D_sqrt z <- eigen(L)$vectors q <- D_sqrt %*% z ## look for the vector with the largest eigenvalue largest_ev <- q[,2L] o <- order(largest_ev) names(o) <- names(x)[o] o } set_seriation_method("dist", "Spectral", seriate_dist_spectral, "Spectral seriation (Ding and He 2004) uses a relaxation to minimize the 2-Sum Problem (Barnard, Pothen, and Simon 1993). It uses the order of the Fiedler vector of the similarity matrix's Laplacian.") set_seriation_method("dist", "Spectral_norm", seriate_dist_spectral_norm, "Spectral seriation (Ding and He 2004) uses a relaxation to minimize the 2-Sum Problem (Barnard, Pothen, and Simon 1993). It uses the order of the Fiedler vector of the similarity matrix's normalized Laplacian.") seriation/R/permutation.R0000644000176200001440000000450212606356654015160 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ###################################################### ## permutations ## constructor ser_permutation <- function(x, ...) { x <- c(list(x), list(...)) x <- lapply(x, FUN = function(obj) { if(is(obj, "ser_permutation")) return(obj) if(is(obj, "ser_permutation_vector")) return(list(obj)) return(list(ser_permutation_vector(obj))) }) x <- unlist(x, recursive = FALSE) class(x) <- c("ser_permutation", "list") x } ## so we can say get_order to permutations get_order.ser_permutation <- function(x, dim = 1, ...) get_order(x[[dim]]) ## print et al print.ser_permutation <- function(x, ...) { writeLines(c( gettextf("object of class %s", paste(sQuote(class(x)), collapse = ", ")), gettextf("contains permutation vectors for %d-mode data\n", length(x)) )) print(data.frame("vector length" = sapply(x, FUN = function(o) if(.is_identity_permutation(o)) NA_integer_ else length(o)), "seriation method" = sapply(x, get_method, printable = TRUE), check.names = FALSE)) invisible(x) } ## fake summary (we dont really provide a summary, ## but summary produces now a reasonable result --- same as print) summary.ser_permutation <- function(object, ...) object c.ser_permutation <- function(..., recursive = FALSE) do.call("ser_permutation", list(...)) ## fixme [[<- needs to check for ser_permutation_vector "[.ser_permutation" <- function(object, i, ...) do.call("ser_permutation", unclass(object)[i]) seriation/R/criterion.dist.R0000644000176200001440000001752313067053145015547 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## Criterion for the quality of a permutation of a dissimilarity ## matrix criterion.dist <- function(x, order = NULL, method = NULL, force_loss = FALSE, ...) { ## check order and x if(!is.null(order)) { if(!inherits(order, "ser_permutation")) order <- ser_permutation(order) .check_dist_perm(x, order) } ## check dist (most C code only works with lower-triangle version) if(attr(x, "Diag") || attr(x, "Upper")) x <- as.dist(x, diag = FALSE, upper = FALSE) if(!is.double(x)) mode(x) <- "double" ## get methods if(is.null(method)) method <- list_criterion_methods("dist") method <- lapply(method, function(m) get_criterion_method("dist", m)) crit <- sapply(method, function(m) structure(m$fun(x, order, ...), names=m$name)) if(force_loss) crit <- crit * sapply(method, FUN = function(m) ifelse(m$merit, -1, 1)) crit } criterion.default <- criterion.dist ## Wrapper to computing the length of the order under a distance matrix, ## e.g. a tour where the leg between the first and last city is omitted. ## that this is a (Hamilton) path. ## ## Note that this corresponds to the sum of distances along the first ## off diagonal of the ordered distance matrix. criterion_path_length <- function(x, order = NULL, ...) { if (is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) .Call("order_length", x, order, PACKAGE = "seriation") } criterion_lazy_path_length <- function(x, order = NULL, ...) { if (is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) .Call("lazy_path_length", x, order, PACKAGE = "seriation") } ## Least squares criterion. measures the difference between the ## dissimilarities between two elements and the rank distance ## (PermutMatrix). criterion_least_squares <- function(x, order = NULL, ...) { if(is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) .Call("least_squares_criterion", x, order, PACKAGE = "seriation") } ## inertia around the diagonal (see PermutMatrix) criterion_inertia <- function(x, order = NULL, ...) { if(is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) .Call("inertia_criterion", x, order, PACKAGE = "seriation") } ## anti-Robinson loss functions (Streng and Schoenfelder 1978, Chen ## 2002) ## method: 1...i, 2...s, 3...w .ar <- function(x, order = NULL, method = 1L) { if(is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) .Call("ar", x, order, as.integer(method), PACKAGE = "seriation") } criterion_ar_events <- function(x, order, ...) .ar(x, order, 1L) criterion_ar_deviations <- function(x, order, ...) .ar(x, order, 2L) #criterion_ar_weighted <- function(x, order, ...) .ar(x, order, 3L) ## w \in [2,n-1] ## or pct \in [0 and 100%]; 0 -> 2 and 100 -> n-1 criterion_rgar <- function(x, order, w=NULL, pct=NULL, relative=TRUE, ...) { if(is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) ### default is to take all if(is.null(w) && is.null(pct)) w <- length(order)-1L else if(is.null(w)) { w <- floor((length(order)-3L)*pct/100)+2L if(w<1) w <- 1 } if(w<2 || w>=length(order)) stop("Window w needs to be 2<=w=length(order)) stop("Band size needs to be 1 <= b < length(order)!") .Call("bar", x, order, as.integer(b), PACKAGE = "seriation") } criterion_gradient_raw <- function(x, order, ...) { if(is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) .Call("gradient", x, order, 1L, PACKAGE = "seriation") } criterion_gradient_weighted <- function(x, order, ...) { if(is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) .Call("gradient", x, order, 2L, PACKAGE = "seriation") } .A_2SUM <- function(n) outer(1:n,1:n, FUN = function(i,j) (i-j)^2) criterion_2SUM <- function(x, order, ...) { if(is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) # this is sum(diag(A%*%B[o,o])) qap::qap.obj(.A_2SUM(attr(x, "Size")), 1/(1+as.matrix(x)), order) } ### Note: We use n-abs(1-j) since QAP needs positive entires in A! .A_LS <- function(n) outer(1:n,1:n, FUN = function(i,j) n-abs(i-j)) criterion_LS <- function(x, order, ...) { if(is.null(order)) order <- 1:attr(x, "Size") else order <- get_order(order) # this is sum(diag(A%*%B[o,o])) qap::qap.obj(.A_LS(attr(x, "Size")), as.matrix(x), order) } ### these measures are calculated on similarity matrices criterion_ME_dist <- function(x, order, ...) criterion(1/(1+as.matrix(x)), c(order, order), "ME") criterion_Moore_stress_dist <- function(x, order, ...) criterion(1/(1+as.matrix(x)), c(order, order), "Moore_stress") criterion_Neumann_stress_dist <- function(x, order, ...) criterion(1/(1+as.matrix(x)), c(order, order), "Neumann_stress") criterion_R_dist <- function(x, order, ...) criterion(1/(1+as.matrix(x)), c(order, order), "Cor_R") ### register methods set_criterion_method("dist", "AR_events" , criterion_ar_events, "Anti-Robinson events", FALSE) set_criterion_method("dist", "AR_deviations", criterion_ar_deviations, "Anti-Robinson deviations", FALSE) ## set_criterion_method("dist", "AR_weighted", criterion_ar_weighted) set_criterion_method("dist", "RGAR", criterion_rgar, "Relative generalized anti-Robinson events", FALSE) set_criterion_method("dist", "BAR", criterion_bar, "Banded Anti-Robinson Form", FALSE) set_criterion_method("dist", "Gradient_raw" , criterion_gradient_raw, "Gradient measure", TRUE) set_criterion_method("dist", "Gradient_weighted", criterion_gradient_weighted, "Gradient measure (weighted)", TRUE) set_criterion_method("dist", "Path_length", criterion_path_length, "Hamiltonian path length", FALSE) set_criterion_method("dist", "Lazy_path_length", criterion_lazy_path_length, "Lazy path length", FALSE) set_criterion_method("dist", "Inertia", criterion_inertia, "Inertia criterion", TRUE) set_criterion_method("dist", "Least_squares", criterion_least_squares, "Least squares criterion", FALSE) set_criterion_method("dist", "ME", criterion_ME_dist, "Measure of effectiveness", TRUE) set_criterion_method("dist", "Cor_R", criterion_R_dist, "Correlation coefficient R", TRUE) set_criterion_method("dist", "Moore_stress", criterion_Moore_stress_dist, "Stress (Moore neighborhood)", FALSE) set_criterion_method("dist", "Neumann_stress", criterion_Neumann_stress_dist, "Stress (Neumann neighborhood)", FALSE) set_criterion_method("dist", "2SUM", criterion_2SUM, "2-SUM objective value (QAP)", FALSE) set_criterion_method("dist", "LS", criterion_LS, "Linear seriation objective value (QAP)", FALSE) seriation/R/seriate_QAP.R0000644000176200001440000000675013502732704014743 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## QAP 2SUM seriation seriate_dist_2SUM <- function(x, control = NULL) { ## param are passed on to QAP do.call(qap::qap, c(list(A = .A_2SUM(attr(x, "Size")), B = 1/(1+as.matrix(x))), control)) } ## QAP Linear seriation seriate_dist_LS <- function(x, control = NULL) { ## param are passed on to QAP do.call(qap::qap, c(list(A = .A_LS(attr(x, "Size")), B = as.matrix(x)), control)) } ## QAP Inertia seriate_dist_Inertia <- function(x, control = NULL) { ## param are passed on to QAP n <- attr(x, "Size") ## inertia uses the same A matrix as 2SUM ## we use n^2 since A needs to be positive do.call(qap::qap, c(list(A = n^2-.A_2SUM(n), B = as.matrix(x)), control)) } ## QAP BAR .qap_bar_contr <- list(b = function(n) max(1, floor(n/5))) seriate_dist_BAR <- function(x, control = NULL) { ## param are passed on to QAP if(is.null(control)) control <- .qap_bar_contr if(is.null(control$b)) control$b <- .qap_bar_contr$b .A_BAR <- function(n, b) { b <- floor(b) if(b<1 || b>=n) stop("b: needs to be 1<=bn) stop("BAR bandwidth is not between 1 and n!") control$b <- NULL ## inertia uses the same A matrix as 2SUM do.call(qap::qap, c(list(A = .A_BAR(n, b = b), B = as.matrix(x)), control)) } set_seriation_method("dist", "QAP_2SUM", seriate_dist_2SUM, "Quadratic assignment problem formulation for seriation solved using a simulated annealing solver to minimize the 2-Sum Problem criterion (Barnard, Pothen, and Simon 1993). Control arguments are passed to qap in package qap.") set_seriation_method("dist", "QAP_LS", seriate_dist_LS, "Quadratic assignment problem formulation for seriation solved using a simulated annealing solver to minimize the Linear Seriation Problem (LS) criterion (Hubert and Schultz 1976).Control arguments are passed to qap in package qap.") set_seriation_method("dist", "QAP_BAR", seriate_dist_BAR, "Quadratic assignment problem formulation for seriation solved using a simulated annealing solver to minimize the banded anti-Robinson form (BAR). Control argument b is the BAR bandwidth (either a function of n or a number). The default for b is n/5. Additional control arguments are passed to qap in package qap.", .qap_bar_contr) set_seriation_method("dist", "QAP_Inertia", seriate_dist_Inertia, "Quadratic assignment problem formulation for seriation solved using a simulated annealing solver to minimize the Inertia criterion. Control arguments are passed to qap in package qap.") seriation/R/hmap.R0000644000176200001440000002061012606356654013534 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. hmap <- function(x, distfun = dist, method = "OLO", control = NULL, zlim = NULL, ...) { args <- list(...) ## dist or matrix is_dist <- is(x, "dist") if(is_dist) { dist_row <- dist_col <- x o_col <- o_row <- seriate(x, method = method, control = control)[[1]] x <- as.matrix(x) } else { if(!is.matrix(x)) x <- as.matrix(x) if(!is.null(args$scale)) { if(args$scale == "row") x <- t(scale(t(x))) if(args$scale == "col") x <- scale(x) } dist_row <- distfun(x) o_row <- seriate(dist_row, method = method, control = control)[[1]] dist_col <- distfun(t(x)) o_col <- seriate(dist_col, method = method, control = control)[[1]] } ## zlim if(!is.null(zlim)) x[xzlim[2]] <- NA ### is hierarchical? then let's do heatmap in gplots if(is(o_col, "hclust")) { ## heatmap by default scales rows: we don't want that! ## options are ignored for now: we use ... if(is.null(args$col)) { if(any(x<0, na.rm = TRUE)) args$col <- .diverge_pal() else args$col <- .sequential_pal() } ## dist uses reversed colors! if(is_dist) args$col <- rev(args$col) args$scale <- "none" if(is.null(args$trace)) args$trace <- "none" if(is.null(args$density.info)) args$density.info <- "none" ## cex if(is.null(args$cexRow)) args$cexRow <- 1 if(is.null(args$cexCol)) args$cexCol <- 1 ## zlim if(!is.null(zlim)) args$breaks <- seq(zlim[1], zlim[2], length.out = length(args$col)+1L) args <- c(list( x=x, Colv = as.dendrogram(o_col), Rowv = as.dendrogram(o_row)), args ) ## FIXME: image throws warning about unsorted breaks ## if breaks are specified! suppressWarnings( ret <- do.call(gplots::heatmap.2, args) ) ret$seriation_method <- method } else { ### we plot seriated distance matrices .hmap_dist(x, method, dist_row, dist_col, o_row, o_col, ...) ## return permutation indices ret <- list(rowInd = o_row, colInd = o_col, seriation_method = method) } return(invisible(ret)) } ## workhorse ## dissimilarity plot with seriation .hmap_dist <- function(x, method, dist_row, dist_col, o_row, o_col, ...) { ## options options <- list(...) options <- .get_parameters(options, list( col = if(any(x<0)) .diverge_pal() else .sequential_pal(), col_dist = .sequential_pal(), prop = FALSE, main = NULL, key = TRUE, key.lab = "", axes = "auto", showdist = "none", symm = FALSE, margins = NULL, zlim = if(any(x<0, na.rm = TRUE)) max(abs(range(x, na.rm=TRUE))) * c(-1,1) else range(x, na.rm = TRUE), newpage = TRUE, gp = gpar() )) options$col_dist <- rev(options$col_dist) .showdist_options <- c("none", "row", "column", "both") options$showdist <- .showdist_options[pmatch(options$showdist, .showdist_options)] if(is.na(options$showdist)) stop("Unknown value for showdist. Use one of: ", paste(dQuote(.showdist_options), collapse = ", ")) ## if symmetric then we only use o_row and dist_row if(length(o_row) == length(o_col) && options$symm == TRUE) { o_col <- o_row dist_col <- dist_row } x <- permute(x, ser_permutation(o_row, o_col)) if(options$showdist == "none") { pimage(x, col=options$col, main=options$main, axes=options$axes, zlim=options$zlim, prop=options$prop, key=options$key, newpage=options$newpage, gp=options$gp) return() } dist_row <- permute(dist_row, o_row) dist_col <- permute(dist_col, o_col) ## axes m <- pmatch(options$axes, c("auto", "x", "col", "y", "row", "both", "none")) if(is.na(m)) stop("Illegal vaule for axes. Use: 'auto', 'x', 'y', 'both' or 'none'!") if(m==1) { axes_row <- nrow(x)<=25; axes_col <- ncol(x)<=25 } else if(m==2 || m==3) { axes_row <- FALSE; axes_col <- TRUE } else if(m==4 || m==5) { axes_row <- TRUE; axes_col <- FALSE } else if(m==6) { axes_row <- TRUE; axes_col <- TRUE } else if(m==7) { axes_row <- FALSE; axes_col <- FALSE } if(is.null(colnames(x))) axes_col <- FALSE if(is.null(rownames(x))) axes_row <- FALSE ## Note: we need a list to store units! if(is.null(options$margins)) { options$margins <- list(unit(1, "lines"), unit(1, "lines")) if(axes_col) options$margins[[1]] <- max(stringWidth(colnames(x))) + unit(2, "lines") if(axes_row) options$margins[[2]] <- max(stringWidth(rownames(x))) + unit(2, "lines") all_names <- c(if(axes_col) colnames(x), if(axes_row) rownames(x), "") options$margins[[3]] <- max(stringWidth(all_names)) + unit(2, "lines") } else options$margins <- list(unit(options$margins[1], "lines"), unit(options$margins[2], "lines"), unit(max(options$margins), "lines")) ## plot if(options$newpage) grid.newpage() ## surrounding viewport pushViewport(viewport(layout=grid.layout(nrow = 3 , ncol = 3, widths = unit.c( unit(1, "lines"), unit(1, "snpc") - options$margins[[3]] - unit(3, "lines"), options$margins[[2]] ), heights = unit.c( unit(3, "lines"), # main unit(1, "snpc") - options$margins[[3]] - unit(3, "lines"), options$margins[[1]] )), width = unit(1, "snpc"), height = unit(1, "snpc"), gp = options$gp)) ## main title if(!is.null(options$main)){ pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 2)) grid.text(options$main, gp = gpar(cex = 1.3)) upViewport(1) } ## plots if(options$prop) { widths <- unit.c( unit(1-ncol(x)/sum(ncol(x), nrow(x)), "npc") - unit(.25, "lines"), unit(.5, "lines"), unit(ncol(x)/sum(ncol(x), nrow(x)), "npc") - unit(.25, "lines") ) heights <- unit.c( unit(1-nrow(x)/sum(ncol(x), nrow(x)), "npc") - unit(.25, "lines"), unit(.5, "lines"), #space unit(nrow(x)/sum(ncol(x), nrow(x)), "npc") - unit(.25, "lines") ) }else{ heights <- widths <- unit.c( unit(1, "null"), unit(.5, "lines"), # space unit(1, "null") ) } pushViewport(viewport(layout=grid.layout(nrow = 3, ncol = 3, widths = widths, heights = heights), width = unit(1, "snpc"), height = unit(1, "snpc"), layout.pos.row = 2, layout.pos.col = 2)) # data pushViewport(viewport(layout.pos.row = 3, layout.pos.col = 3)) .grid_image(x, col = options$col, gp = options$gp, zlim = options$zlim) downViewport("image") if(axes_col) grid.text(colnames(x), y = unit(-1, "lines"), x=unit(1:ncol(x), "native"), rot=90, just="right") # , gp=options$gp) if(axes_row) grid.text(rownames(x), x = unit(1,"npc")+unit(1, "lines"), y=unit(1:nrow(x), "native"), just="left") #, gp=options$gp) popViewport(1) popViewport(1) # rows if(options$showdist %in% c("row", "both")) { pushViewport(viewport(layout.pos.row = 3, layout.pos.col = 1)) .grid_image(as.matrix(dist_row), col = options$col_dist, gp = options$gp) popViewport(1) } # cols if(options$showdist %in% c("column", "both")) { pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 3)) .grid_image(as.matrix(dist_col), col = options$col_dist, gp = options$gp) popViewport(1) } # colorkey if(options$key) { pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 1)) pushViewport(viewport(width = unit(0.5, "npc"), height = unit(1, "lines"))) .grid_colorkey(options$zlim, col = options$col, lab = options$key.lab, gp = options$gp) popViewport(2) } popViewport(2) } seriation/R/hclust_greedy.R0000644000176200001440000000242012606356654015447 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## wrapper to greedy ordering inspired by F. Murtagh ## actually a hierarchical cluster algorithm. ## ceeboo 2005 hclust_greedy <- function(dist) { if (!inherits(dist, "dist")) stop("Argument 'dist' is not of class 'dist'.") if (!is.double(dist)) mode(dist) <- "double" obj <- .Call("order_greedy", dist) names(obj) <- c("merge", "order", "height"); class(obj) <- "hclust" obj } seriation/R/seriate.dist.R0000644000176200001440000000422413475267730015211 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## seriate dist objects seriate.dist <- function(x, method = "Spectral", control = NULL, ...) { if(!all(x>=0)) stop("Negative distances not supported!") ## add ... to control control <- c(control, list(...)) ## check x if(any(is.na(x))) stop("NAs not allowed in x!") if(any(x<0)) stop("No negative values allowed in x!") if(!is.character(method) || (length(method) != 1L)) stop("Argument 'method' must be a character string.") method <- get_seriation_method("dist", method) if(!is.null(control$verbose) && control$verbose) cat(method$name, ": ", method$description, "\n\n", sep="") order <- method$fun(x, control = control) ser_permutation(ser_permutation_vector(order, method = method$name)) } seriate_dist_identity <- function(x, control = NULL) { #param <- .get_parameters(control, NULL) .get_parameters(control, NULL) o <- 1:attr(x, "Size") names(o) <- labels(x) o } seriate_dist_random <- function(x, control = NULL) { #param <- .get_parameters(control, NULL) .get_parameters(control, NULL) o <- 1:attr(x, "Size") names(o) <- labels(x) sample(o) } set_seriation_method("dist", "Identity", seriate_dist_identity, "Identity permutation") set_seriation_method("dist", "Random", seriate_dist_random, "Random permutation") seriation/R/seriate_MDS.R0000644000176200001440000000475613502511143014741 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. .mds_control <- list( method = "cmdscale" ) ## Multidimensional scaling seriate_dist_mds <- function(x, control = NULL){ control <- .get_parameters(control, .mds_control) if(control$method == "cmdscale" ) { sc <- cmdscale(x, k=1) return(order(sc[,1])) }else if(control$method == "isoMDS"){ sc <- MASS::isoMDS(x+1e-6, trace = FALSE, k=1) return(order(sc$points[,1])) }else if(control$method == "sammon") { sc <- MASS::sammon(x+1e-6, trace = FALSE, k=1) return(order(sc$points[,1])) }else stop("unknown method") } seriate_dist_mds_metric <- function(x, control = NULL) seriate_dist_mds(x, control=list(method="cmdscale")) seriate_dist_mds_nonmetric <- function(x, control = NULL) seriate_dist_mds(x, control=list(method="isoMDS")) ## Angle between the first 2 PCS. Fiendly (2002) seriate_dist_angle <- function(x, control = NULL) { .get_parameters(control, NULL) sc <- cmdscale(x, k=2) .order_angle(sc) } set_seriation_method("dist", "MDS", seriate_dist_mds, "Order using the first component found by multidimensional scaling. Element method in control can be \"cmdscale\", \"isoMDS\" or \"sammon\".", .mds_control) set_seriation_method("dist", "MDS_metric", seriate_dist_mds_metric, "Order using the first component found by metric multidimensional scaling (cmdscsale).") set_seriation_method("dist", "MDS_nonmetric", seriate_dist_mds_nonmetric, "Order using the first component found by non-metric multidimensional scaling (isoMDS).") set_seriation_method("dist", "MDS_angle", seriate_dist_angle, "Order by the angle in this space given by the first two components found by MDS (Friendly, 2002).") seriation/R/VAT.R0000644000176200001440000000357312606356654013252 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## calculate path distance from iVAT using a modified version fo Floyd's alg. ## d_ij = smallest value of the largest values of all possible paths between i and j path_dist <- function(x) { #A <- as.matrix(x) #n <- nrow(A) #for(k in 1:n) # for(i in 1:n) # for(j in 1:n) # if(max(A[i,k], A[k,j]) < A[i,j]) A[i,j] <- max(A[i,k], A[k,j]) #d <- as.dist(A) ## make C call m <- as.matrix(x) if(any(is.na(m))) stop("NAs not allowed in x.") if(any(m<0)) stop("Negative values not allowed in x.") mode(m) <- "double" ## replace Inf with large number m[is.infinite(m)] <- .Machine$double.xmax if(any(m<0)) stop("Negative values not allowed in x.") m <- .Call("pathdist_floyd", m, PACKAGE = "seriation") as.dist(m) } VAT <- function(x, ...) { if(!is(x, "dist")) stop("x needs to be of class 'dist'!") pimage(x, seriate(x, "VAT"), ...) } iVAT <- function(x, ...) { if(!is(x, "dist")) stop("x needs to be of class 'dist'!") x <- path_dist(x) pimage(x, seriate(x, "VAT"), ...) }seriation/R/reorder.hclust.R0000644000176200001440000000401512606356654015553 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. reorder.hclust <- function(x, dist, method = "OLO", ...) { method <- match.arg(tolower(method), choices = c("olo", "gw")) ## no reordering for less than 3 objects! if(length(x$order)<3) return(x) switch(method, olo = .seriate_optimal(x, dist), gw = .seriate_gruvaeus(x, dist) ) } ## wrapper for reorder.hclust in gclus .seriate_gruvaeus <- function(hclust, dist) gclus::reorder.hclust(hclust, dist) ## wrapper to the optimal leaf ordering algorithm ## ## ceeboo 2005 .seriate_optimal <- function(hclust, dist) { ## check hclust merge <- hclust$merge if (!is.matrix(merge)) stop("Component 'merge' of argument 'hclust' must be a matrix.") if (length(dim(merge)) != 2) stop("Component 'merge' of argument 'hclust' is invalid.") if (dim(merge)[1] != attr(dist,"Size")-1) stop("Argument 'dist' and component 'merge' of argument 'hclust' do not conform.") mode(merge) <- "integer" obj <- .Call("order_optimal", dist, merge) names(obj) <- c("merge","order","length") ##names(obj$order) <- attr(dist,"Labels") hclust$merge <- obj$merge hclust$order <- obj$order hclust } seriation/R/AAAmap.R0000644000176200001440000000271112606356654013671 0ustar liggesusers####################################################################### # Code to map between ranges for contunuous variables # Copyrigth (C) 2011 Michael Hahsler # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## mapping helper map <- function(x, range = c(0,1), from.range=NA) { if(any(is.na(from.range))) from.range <- range(x, na.rm=TRUE) ## check if all values are the same if(!diff(from.range)) return( matrix(mean(range), ncol=ncol(x), nrow=nrow(x), dimnames = dimnames(x))) ## map to [0,1] x <- (x-from.range[1]) x <- x/diff(from.range) ## handle single values if(diff(from.range) == 0) x <- 0 ## map from [0,1] to [range] if (range[1]>range[2]) x <- 1-x x <- x*(abs(diff(range))) + min(range) x[xmax(range)] <- NA x } seriation/R/criterion.array.R0000644000176200001440000000343113056034450015707 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## Criterion for the quality of a permutation of a array .criterion_array_helper <- function(x, order = NULL, method = NULL, datatype = "array", force_loss = FALSE) { ## check order if(!is.null(order)){ if(!inherits(order, "ser_permutation")) stop("Argument 'order' has to be of class 'ser_permutation'.") .check_matrix_perm(x, order) } ## get methods if(is.null(method)) method <- list_criterion_methods(datatype) method <- lapply(method, function(m) get_criterion_method(datatype, m)) crit <- sapply(method, function(m) structure(m$fun(x, order), names=m$name)) if(force_loss) crit <- crit * sapply(method, FUN = function(m) ((as.integer(m$merit)*-2)+1)) crit } criterion.array <- function(x, order = NULL, method = NULL, force_loss = FALSE, ...) .criterion_array_helper(x, order, method, "array", force_loss) ## methods ## register built-ins seriation/R/seriate_R2E.R0000644000176200001440000000414313502511027014675 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## uses a sequence of correlation matrices and finds the first matrix ## with rank 2. The elements are projected into the plane spanned by the ## first two eigenvectors. All points are lying on a ellipse. The order ## of the elements on the ellipse is returned (see Chen 2002). seriate_dist_chen <- function(x, control = NULL){ .get_parameters(control, NULL) x <- as.matrix(x) rank <- qr(x)$rank ## find the first correlation matrix of rank 2 n <- 0 while(rank > 2){ x <- cor(x) n <- n + 1 rank <- qr(x)$rank } ## project the matrix on the first 2 eigenvectors e <- eigen(x)$vectors[,1:2] ## extract the order ## chen says that he uses the one of the two possible cuts ## that separate the points at rank 1. Since the points just ## separate further towards right and left, cutting on the vertical ## axis of the ellipse yields the same result. right <- which(e[,1] >= 0) right <- right[order(e[right,2], decreasing = TRUE)] left <- which(e[,1] < 0) left <- left[order(e[left,2])] o <- c(right,left) names(o) <- labels(x)[o] o } #set_seriation_method("dist", "Chen", seriate_dist_chen, # "Rank-two ellipse seriation") set_seriation_method("dist", "R2E", seriate_dist_chen, "Rank-two ellipse seriation") seriation/R/bea.R0000644000176200001440000000523713124212551013325 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## BEA FORTRAN code by Fionn Murtagh bea <- function(a, istart=0, jstart=0) { ## Permute rows and colums, using "bond energy algorithm". if(!is.matrix(a)) stop("First input argument must be a matrix.\n") n <- nrow(a) m <- ncol(a) b <- matrix(0.0, n, m) mode(a) <- "single" mode(b) <- "single" ib <- integer(n) jb <- integer(m) ifin <- integer(n) jfin <- integer(m) ener <- 0.0 if (istart == 0) istart <- floor(runif(1,1,n)) if (jstart == 0) jstart <- floor(runif(1,1,m)) bea1 <- .Fortran("rbea", n = as.integer(n), m = as.integer(m), a = as.matrix(a), # input data istart = as.integer(istart), # 1st row placement b = as.matrix(b), # permuted array ib = as.integer(ib), # permuted order of rows ifin = as.integer(ifin), # for book-keeping PACKAGE="seriation") a <- bea1$b bea2 <- .Fortran("cbea", n = as.integer(n), m = as.integer(m), a = as.matrix(a), # input data jstart = as.integer(jstart), # 1st col. placement b = as.matrix(b), # permuted array jb = as.integer(jb), # permuted order of cols. jfin = as.integer(jfin), # for book-keeping PACKAGE="seriation") energy <- .Fortran("energy", n = as.integer(n), m = as.integer(m), b = as.matrix(bea2$b), ener = as.single(ener), PACKAGE="seriation") list(b = bea2$b, ib = bea1$ib, jb = bea2$jb, e = energy$ener) } seriation/R/seriate_BEA.R0000644000176200001440000000546013502517025014703 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## Algorithm B ## F. Murtagh (1985). Multidimensional Cluster Algorithms. Lectures ## in Computational Statistics, Physica Verlag, pp. 15. # # this is actually just the same as BEA # #.seriate_matrix_murtagh <- function(x, control) { # # if(any(x < 0)) stop("Requires a nonnegative matrix.") # # criterion <- as.dist(tcrossprod(x)) # row <- hclust_greedy(-criterion)$order # criterion <- as.dist(crossprod(x)) # col <- hclust_greedy(-criterion)$order # # list(row = row, col = col) #} seriate_matrix_bea_tsp <- function(x, control) { if(any(x < 0)) stop("Requires a nonnegative matrix.") criterion <- as.dist(tcrossprod(x)) row <- seriate(max(criterion)-criterion, method = "TSP", control = control)[[1]] criterion <- as.dist(crossprod(x)) col <- seriate(max(criterion)-criterion, method = "TSP", control = control)[[1]] attr(row, "method") <- "BEA_TSP" attr(col, "method") <- "BEA_TSP" list(row = row, col = col) } ## Bond Energy Algorithm (McCormick 1972) .bea_contr <- list( istart = 0, jstart = 0, rep = 1 ) seriate_matrix_bea <- function(x, control = NULL){ control <- .get_parameters(control, .bea_contr) if(any(x < 0)) stop("Requires a nonnegative matrix.") istart <- control$istart jstart <- control$jstart rep <- control$rep res <- replicate(rep, bea(x, istart = istart, jstart = jstart), simplify = FALSE) best <- which.max(sapply(res, "[[", "e")) res <- res[[best]] row <- res$ib col <- res$jb names(row) <- rownames(x)[row] names(col) <- colnames(x)[col] list(row = row, col = col) } ## register methods set_seriation_method("matrix", "BEA", seriate_matrix_bea, "Bond Energy Algorithm (BEA; McCormick 1972) to maximize the Measure of Effectiveness of a non-negative matrix.", .bea_contr) set_seriation_method("matrix", "BEA_TSP", seriate_matrix_bea_tsp, "Use a TSP to optimize the Measure of Effectiveness (Lenstra 1974). Control is passed on to the seriation method TSP.") seriation/R/register_GA.R0000644000176200001440000000577113502773472015012 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2015 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## registers seriation methods and criteria from package DendSer # Generates a mutation function which mixes simMutation (simple insertion) # with ismMutation (inversion) given the probability. gaperm_mixedMutation <- function(ismProb = .8) { function(object, parent, ...) { if(runif(1)>ismProb) GA::gaperm_simMutation(object, parent, ...) else GA::gaperm_ismMutation(object, parent, ...) } } register_GA <- function() { if(!.installed("GA")) stop("Package 'GA' needs to be installed!") .ga_contr <- list( criterion = "BAR", suggestions = c("TSP", "QAP_LS", "Spectral"), selection = GA::gaperm_nlrSelection, crossover = GA::gaperm_oxCrossover, mutation = seriation::gaperm_mixedMutation(.8), pcrossover = .2, pmutation = .5, popSize = 100, maxiter = 1000, run = 50, parallel = TRUE, verbose = TRUE ) GA_helper <- function(x, control) { n <- attr(x, "Size") control <- .get_parameters(control, .ga_contr) if(control$verbose) cat("\nPreparing suggestions\n") if(is.na(control$suggestions[1])) suggestions <- NULL else suggestions <- t(sapply(control$suggestions, function(method) get_order(seriate(x, method = method)))) if(control$verbose) cat("\nStarting GA\n") ### FIXME: need to be able to set bandwidth for BAR # fitness function f <- function(o) -criterion(x, o, method = control$criterion, force_loss = TRUE) result <- GA::ga(type="permutation", fitness=f, lower=rep(1L, times = n), upper=rep(n, times = n), selection = control$selection, mutation = control$mutation, crossover = control$crossover, pmutation = control$pmutation, pcrossover = control$pcrossover, suggestions = suggestions, names=as.character(1:n), monitor = if(control$verbose) GA::gaMonitor else NULL, parallel = control$parallel, maxiter = control$maxiter, run = control$run, maxFitness = Inf, popSize = control$popSize ) as.integer(result@solution[1,]) } set_seriation_method("dist", "GA", GA_helper, "Use a genetic algorithm to optimize for various criteria.", .ga_contr) } seriation/R/seriate_HC.R0000644000176200001440000001126613502512521014603 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## Hierarchical clustering related seriations .hc_control <- list( hclust = NULL, method = "average" ) .hclust_helper <- function(d, control = NULL){ control <- .get_parameters(control, .hc_control) if(!is.null(control$hclust)) return(control$hclust) return(hclust(d, method = control$method)) } seriate_dist_hc <- function(x, control = NULL) .hclust_helper(x, control) seriate_dist_hc_single <- function(x, control = NULL) .hclust_helper(x, control=list(method="single")) seriate_dist_hc_average <- function(x, control = NULL) .hclust_helper(x, control=list(method="average")) seriate_dist_hc_complete <- function(x, control = NULL) .hclust_helper(x, control=list(method="complete")) seriate_dist_hc_ward <- function(x, control = NULL) .hclust_helper(x, control=list(method="ward.D2")) ## workhorses are in seriation.hclust seriate_dist_gw <- function(x, control = NULL) reorder(seriate_dist_hc(x, control), x, method="GW") seriate_dist_gw_single <- function(x, control = NULL) reorder(seriate_dist_hc_single(x, control), x, method="GW") seriate_dist_gw_average <- function(x, control = NULL) reorder(seriate_dist_hc_average(x, control), x, method="GW") seriate_dist_gw_complete <- function(x, control = NULL) reorder(seriate_dist_hc_complete(x, control), x, method="GW") seriate_dist_gw_ward <- function(x, control = NULL) reorder(seriate_dist_hc_ward(x, control), x, method="GW") seriate_dist_olo <- function(x, control = NULL) reorder(seriate_dist_hc(x, control), x, method="OLO") seriate_dist_olo_single <- function(x, control = NULL) reorder(seriate_dist_hc_single(x, control), x, method="OLO") seriate_dist_olo_average <- function(x, control = NULL) reorder(seriate_dist_hc_average(x, control), x, method="OLO") seriate_dist_olo_complete <- function(x, control = NULL) reorder(seriate_dist_hc_complete(x, control), x, method="OLO") seriate_dist_olo_ward <- function(x, control = NULL) reorder(seriate_dist_hc_ward(x, control), x, method="OLO") .hc_desc <- "Using the order of the leaf nodes in a dendrogram obtained by hierarchical clustering" set_seriation_method("dist", "HC", seriate_dist_hc, .hc_desc, .hc_control) set_seriation_method("dist", "HC_single", seriate_dist_hc_single, paste(.hc_desc, "(single link)")) set_seriation_method("dist", "HC_complete", seriate_dist_hc_complete, paste(.hc_desc, "(complete link).")) set_seriation_method("dist", "HC_average", seriate_dist_hc_average, paste(.hc_desc, "(avg. link).")) set_seriation_method("dist", "HC_ward", seriate_dist_hc_ward, paste(.hc_desc, "(Ward's method).")) .gw_desc <- "Using the order of the leaf nodes in a dendrogram obtained by hierarchical clustering and reordered by the Gruvaeus and Wainer (1972) heuristic" set_seriation_method("dist", "GW", seriate_dist_gw, .gw_desc, .hc_control) set_seriation_method("dist", "GW_single", seriate_dist_gw_single, paste(.gw_desc, "(single link)")) set_seriation_method("dist", "GW_average", seriate_dist_gw_average, paste(.gw_desc, "(avg.link)")) set_seriation_method("dist", "GW_complete", seriate_dist_gw_complete, paste(.gw_desc, "(complete link)")) set_seriation_method("dist", "GW_ward", seriate_dist_gw_ward, paste(.gw_desc, "(Ward's method)")) .olo_desc <- "Using the order of the leaf nodes in a dendrogram obtained by hierarchical clustering and reordered by with optimal leaf ordering (Bar-Joseph et al., 2001)" set_seriation_method("dist", "OLO", seriate_dist_olo, .olo_desc, .hc_control) set_seriation_method("dist", "OLO_single", seriate_dist_olo_single, paste(.olo_desc, "(single link)")) set_seriation_method("dist", "OLO_average", seriate_dist_olo_average, paste(.olo_desc, "(avg. link)")) set_seriation_method("dist", "OLO_complete", seriate_dist_olo_complete, paste(.olo_desc, "(complete link)")) set_seriation_method("dist", "OLO_ward", seriate_dist_olo_ward, paste(.olo_desc, "(Ward's method)")) seriation/R/seriate.R0000644000176200001440000000446613502451261014240 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## Seriation generic and default method. seriate <- function(x, ...) UseMethod("seriate") seriate.default <- function(x, ...) stop(gettextf("seriate not implemented for class '%s'.", class(x))) ## Seriation methods db. get_seriation_method <- function(kind, name) { method <- registry_seriate$get_entry(kind=kind, name=name) if(is.null(method)) stop("Unknown seriation method. Check list_seriation_methods(\"", kind, "\")") method } set_seriation_method <- function(kind, name, definition, description = NULL, control = list(), ...){ ## check formals if(!identical(names(formals(definition)), c("x", "control"))) stop("Seriation methods must have formals 'x' and 'control'.") ## check if entry already exists r <- registry_seriate$get_entry(kind=kind, name=name) if(!is.null(r) && r$name==name) { warning("Entry with name \"", name, "\" for kind \"", kind, "\" already exists! Modifying entry.") registry_seriate$modify_entry(kind=kind, name=name, fun=definition, description=description, control = control) } else { registry_seriate$set_entry(name=name, kind=kind, fun=definition, description=description, control = control) } } list_seriation_methods <- function(kind) sort(as.vector(sapply(registry_seriate$get_entries(kind=kind), "[[", "name"))) show_seriation_methods <- function(kind){ m <- registry_seriate$get_entries(kind=kind) m[sort(names(m))] } seriation/R/seriate_PCA.R0000644000176200001440000000610613502517344014721 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## use the projection on the first pricipal component to determine the ## order .pca_contr <- list( center = TRUE, scale. = FALSE, tol = NULL, verbose = FALSE ) seriate_matrix_fpc <- function(x, control = NULL) { control <- .get_parameters(control, .pca_contr) center <- control$center scale. <- control$scale. tol <- control$tol verbose <- control$verbose pr <- prcomp(x, center = center, scale. = scale., tol = tol) scores <- pr$x[,1] row <- order(scores) if(verbose) cat("row: first principal component explains", pr$sdev[1] / sum(pr$sdev)* 100,"%\n") pr <- prcomp(t(x), center = center, scale. = scale., tol = tol) scores <- pr$x[,1] col <- order(scores) if(verbose) cat("col: first principal component explains", pr$sdev[1] / sum(pr$sdev)* 100,"%\n") names(row) <- rownames(x)[row] names(col) <- colnames(x)[col] list(row = row, col = col) } ## Angle between the first 2 PCS. Fiendly (2002) .order_angle <- function(x) { alpha <- atan2(x[,1], x[,2]) o <- order(alpha) cut <- which.max(abs(diff(c(alpha[o], alpha[o[1]]+2*pi)))) if(cut==length(o)) o else o[c((cut+1):length(o), 1:(cut))] } .angle_contr <- list( center = TRUE, scale. = FALSE, tol = NULL ) seriate_matrix_angle <- function(x, control = NULL) { control <- .get_parameters(control, .angle_contr) center <- control$center scale. <- control$scale. tol <- control$tol pr <- prcomp(x, center = center, scale. = scale., tol = tol) row <- .order_angle(pr$x[,1:2]) pr <- prcomp(t(x), center = center, scale. = scale., tol = tol) col <- .order_angle(pr$x[,1:2]) names(row) <- rownames(x)[row] names(col) <- colnames(x)[col] list(row = row, col = col) } set_seriation_method("matrix", "PCA", seriate_matrix_fpc, "Uses the projection of the data on its first principal component to determine the order. Note that for a distance matrix calculated from x with Euclidean distance, this methods minimizes the least square criterion.", .pca_contr) set_seriation_method("matrix", "PCA_angle", seriate_matrix_angle, "Projects the data on the first two principal components and then orders by the angle in this space. The order is split by the larges gap between adjacent angles.", .angle_contr) seriation/R/criterion.R0000644000176200001440000000513713056032215014574 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## Criterion generic. criterion <- function(x, order = NULL, method = NULL, force_loss = FALSE, ...) UseMethod("criterion") ## Criterion method registry. ## ## For criterion() methods, argument 'method' really allows selecting ## *several* methods ... should perhaps be called 'methods'? ## We thus have a getter which returns a named list of methods from the ## registry, and a setter for single methods. ## set_criterion_method <- function(kind, name, fun, description = NULL, merit = NA, ...) { ## check formals ##if(!identical(names(formals(definition)), ## c("x", "order", "..."))) ## stop("Criterion methods must have formals 'x', 'order', and '...'.") ## check if criterion is already in registry r <- registry_criterion$get_entry(kind=kind, name=name) if(!is.null(r) && r$name==name) { warning("Entry with name ", name, " already exists! Modifying entry.") registry_criterion$modify_entry(kind=kind, name=name, fun=fun, description=description, merit = merit) } else { registry_criterion$set_entry( kind = kind, name=name, fun = fun, description = description, merit = merit) } } get_criterion_method <- function(kind, name) { method <- registry_criterion$get_entry(kind=kind, name=name) if(is.null(method)) stop("Unknown criterion. Check list_criterion_methods(\"", kind, "\")") method } list_criterion_methods <- function(kind){ if(missing(kind)) m <- registry_criterion$get_entries() else m <- registry_criterion$get_entries(kind=kind) sort(as.vector(sapply(m, "[[", "name"))) } show_criterion_methods <- function(kind) { if(missing(kind)) m <- registry_criterion$get_entries() else m <- registry_criterion$get_entries(kind=kind) m[sort(names(m))] } seriation/R/AAAparameter.R0000644000176200001440000000374713475267663015114 0ustar liggesusers####################################################################### # Code to check parameter/control objects # Copyrigth (C) 2011 Michael Hahsler # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## helper to parse parameter lists with defaults .nodots <- function(...) { l <- list(...) if(length(l) > 0L) warning("Unknown arguments: ", paste(names(l), "=",l, collapse=", ")) } .get_parameters <- function(parameter, defaults) { defaults <- as.list(defaults) parameter <- as.list(parameter) ## add verbose if(is.null(defaults$verbose)) defaults$verbose <- FALSE if(length(parameter) != 0) { o <- pmatch(names(parameter), names(defaults)) ## unknown parameter if(any(is.na(o))){ warning(sprintf(ngettext(length(is.na(o)), "Unknown parameter: %s", "Unknown parameters: %s"), paste(names(parameter)[is.na(o)], collapse = ", ")), call. = FALSE, immediate. = TRUE) cat("Available parameter (with default values):\n") cat(rbind(names(defaults)," = ", gsub("\n"," ",as.character(defaults))), sep=c("\t"," ","\n")) } defaults[o[!is.na(o)]] <- parameter[!is.na(o)] } if(defaults$verbose) { cat("Used parameters:\n") cat(rbind(names(defaults)," = ", strtrim(gsub("\n"," ",as.character(defaults)), 50)), sep=c("\t"," ","\n")) cat("\n") } defaults } seriation/R/robinson.R0000644000176200001440000000310112651451030014414 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## recognize Robinson structure is.robinson <- function(x, anti = TRUE, pre = FALSE) { if(is.matrix(x) && !isSymmetric(unname(x))) stop("x needs to be a symmetric matrix!") d <- as.dist(x) if(!anti) d <- max(d) - d ## pre Robinson matrix can be perfectly seriated using ## spectral seriation! if(pre) d <- permute(d, seriate(d, method = "spectral")) unname(criterion(d, method = "AR_events") == 0) } random.robinson <- function(n, anti = TRUE, pre = FALSE, noise = 0) { if(noise < 0 | noise > 1) stop("noise has to be beween 0 and 1.") x <- runif(n) if(!pre) x <- sort(x) if(noise) x <- cbind(x, runif(n, min = 0, max = noise)) m <- as.matrix(dist(x)) if(!anti) m <- max(m)-m m } seriation/R/seriate_ARSA_Branch-Bound.R0000644000176200001440000001031513502452447017365 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2011 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## Brusco: simulated annealing for the Linear Seriation Criterion .arsa_control <- list( cool = 0.5, ## Brusco: 0.95 tmin = 0.0001, ## Brusco: 0.0001 swap_to_inversion = .5, ## Brusco: .5 try_multiplier = 100, ## Brusco: 100 reps = 1L, ## Brusco: 20 verbose = FALSE ) seriate_dist_arsa <- function(x, control = NULL) { param <- .get_parameters(control, .arsa_control) A <- as.matrix(x) # SUBROUTINE arsa(N, A, COOL, TMIN, NREPS, IPERM, R1, R2, D, U, # S, T, SB, ZBEST, verbose) N <- ncol(A) NREPS <- as.integer(param$reps) IPERM <- integer(N) # R1 <- double(N*N/2) # R2 <- double(N*N/2) D <- double(N*N) U <- integer(N) S <- integer(N) T <- integer(NREPS*N) SB <- integer(N) ZBEST <- double(1) ret <- .Fortran("arsa", N, A, as.numeric(param$cool), as.numeric(param$tmin), NREPS, IPERM, D, U, S, T, SB, ZBEST, as.numeric(param$swap_to_insertion), as.numeric(param$try_multiplier), as.integer(param$verbose), PACKAGE="seriation") o <- ret[[6]] names(o) <- labels(x)[o] ### ARSA returns all 0's in some cases if(all(o == 0)) { o <- 1:N warning("ARSA has returned an invalid permutation vector! Check the supplied dissimilarity matrix.") } o } ## Brusco: branch-and-bound - unweighted row gradient .bb_control <- list( eps = 1e-7, verbose = FALSE ) seriate_dist_bburcg <- function(x, control = NULL) { param <- .get_parameters(control, .bb_control) A <- as.matrix(x) N <- ncol(A) # SUBROUTINE bburcg(N, A, EPS, X, Q, D, DD, S, UNSEL, IVERB) X <- integer(N) Q <- integer(N) D <- integer(N*N*N) DD <- integer(N*N*N) S <- integer(N) UNSEL <- integer(N) ret <- .Fortran("bburcg", N, A, param$eps, X, Q, D, DD, S, UNSEL, param$verbose) o <- ret[[4]] names(o) <- labels(x)[o] o } ## Brusco: branch-and-bound - weighted row gradient seriate_dist_bbwrcg <- function(x, control = NULL) { param <- .get_parameters(control, .bb_control) A <- as.matrix(x) N <- ncol(A) # SUBROUTINE bbwrcg(N, A, EPS, X, Q, D, DD, S, UNSEL, IVERB) X <- integer(N) Q <- integer(N) D <- double(N*N*N) DD <- double(N*N*N) S <- integer(N) UNSEL <- integer(N) ret <- .Fortran("bbwrcg", N, A, param$eps, X, Q, D, DD, S, UNSEL, param$verbose) o <- ret[[4]] names(o) <- labels(x)[o] o } set_seriation_method("dist", "ARSA", seriate_dist_arsa, "Minimize the linear seriation criterion using simulated annealing (Brusco et al, 2008).\ncontrol parameters:\n cool (cooling rate)\n tmin (minimum temperature)\n swap_to_inversion (proportion of swaps to inversions for local neighborhood search)\n try_multiplier (local search tries per temperature; multiplied with the number of objects)\n reps (repeat the algorithm with random initialization)\n verbose. Use verbose = TRUE to see the default values for the parameters.", control = .arsa_control) set_seriation_method("dist", "BBURCG", seriate_dist_bburcg, "Minimize the unweighted row/column gradient by branch-and-bound (Brusco and Stahl 2005). This is only feasible for a relatively small number of objects.", control = .bb_control) set_seriation_method("dist", "BBWRCG", seriate_dist_bbwrcg, "Minimize the weighted row/column gradient by branch-and-bound (Brusco and Stahl 2005). This is only feasible for a relatively small number of objects.", control = .bb_control) seriation/R/register_DendSer.R0000644000176200001440000001057513502455637016045 0ustar liggesusers####################################################################### # seriation - Infrastructure for seriation # Copyrigth (C) 2015 Michael Hahsler, Christian Buchta and Kurt Hornik # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License along # with this program; if not, write to the Free Software Foundation, Inc., # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ## registers seriation methods and criteria from package DendSer register_DendSer <- function() { if(!.installed("DendSer")) stop("Package 'DendSer' needs to be installed!") ## seriation methods ## control: # cost (default: costBAR) # ## costLS, costPL, costLPL, costED, costARc, costBAR # h (default is NULL -> complete) .DendSer_control <- list( h = NULL, method = "complete", criterion = NULL, cost = DendSer::costBAR, DendSer_args = NULL, verbose = FALSE ) DendSer_helper <- function(x, control) { n <- attr(x, "Size") control <- .get_parameters(control, .DendSer_control) ## fix cost if it is a criterion from seriation if(!is.null(control$criterion)) control$cost <- DendSer::crit2cost(crit = control$criterion) ## produce hclust if(is.null(control$h)) control$h <- hclust(x, control$method) control$method <- NULL control$criterion <- NULL control$ser_weight <- x if(!is.null(control$DendSer_args)) { control <- c(control, control$DendSer_args) control$DendSer_args <- NULL } do.call(DendSer::DendSer, control) } DendSer_BAR <- DendSer_helper DendSer_PL <- function(x, control) { #control$cost <- DendSer::costPL control$criterion <- "Path_length" DendSer_helper(x, control) } DendSer_LPL <- function(x, control) { #control$cost <- DendSer::costLPL control$criterion <- "Lazy_path_length" DendSer_helper(x, control) } DendSer_ARc <- function(x, control) { control$cost <- DendSer::costARc DendSer_helper(x, control) } ## This is not Least Squares! # DendSer_LS <- function(x, control) { # control$cost <- DendSer::costLS # control$criterion <- "LS" # control$h <- hclust(x) # DendSer_helper(as.matrix(x)[,1], control) # } seriation::set_seriation_method("dist", "DendSer", DendSer_helper, "Dendrogram seriation (Earle and Hurley, 2015).", .DendSer_control) seriation::set_seriation_method("dist", "DendSer_BAR", DendSer_BAR, "Dendrogram seriation with BAR (Earle and Hurley, 2015).", .DendSer_control) seriation::set_seriation_method("dist", "DendSer_PL", DendSer_PL, "Dendrogram seriation (Path length)", .DendSer_control) seriation::set_seriation_method("dist", "DendSer_LPL", DendSer_PL, "Dendrogram seriation (Lazy path length)", .DendSer_control) seriation::set_seriation_method("dist", "DendSer_ARc", DendSer_ARc, "Dendrogram seriation (ARc)", .DendSer_control) # seriation::set_seriation_method("dist", "DendSer_LS", # DendSer_LS, "Dendrogram seriation (Leaf sort)") ## criteria DendSer_crit_ARc <- function(x, order, ...) { x <- as.matrix(x) if (is.null(order)) order <- 1:nrow(x) else order <- get_order(order) DendSer::costARc(x,order,...) } seriation::set_criterion_method("dist", "ARc", DendSer_crit_ARc, "AR cost", FALSE) ## Already in seriation # DendSer_crit_BAR <- function(x, order, ...) { # x <- as.matrix(x) # if (is.null(order)) order <- 1:nrow(x) # else order <- get_order(order) # DendSer::costBAR(x,order,...) # } # # seriation::set_criterion_method("dist", "BAR", DendSer_crit_BAR, # "Banded AR cost", FALSE) # criterion_method_dist_LPL <- function(x, order, ...) { # x <- as.matrix(x) # if (is.null(order)) order <- 1:nrow(x) # else order <- get_order(order) # DendSer::costLPL(x,order,...) # } # # seriation::set_criterion_method("dist", "LPL", criterion_method_dist_LPL, # "Lazy path cost", FALSE) #} } seriation/NEWS.md0000644000176200001440000002025613531260204013346 0ustar liggesusers# seriation 1.2-8 (08/27/2019) ## New features * get_seriation_method now has better information and also show available control parameters. ## Bugfixes * GA: Updated parameter names after change in package ga. # seriation 1.2-7 (06/07/2019) ## Bugfixes * Added missing void * to init.c # seriation 1.2-6 (06/03/2019) ## Bugfixes * Converted print routines in Fortran code to dblepr, intpr, etc. * seriate.matrix also prints now method name for control verbose = TRUE. # seriation 1.2-5 (05/30/2019) ## Bugfixes * Fixed compilation warnings in Fortran code. # seriation 1.2-4 (05/29/2019) ## New features * bertinplot: panel colors can now be specified in highlight and as shading.function. ## Bugfixes * bertinplot: fix white squares when frame = TRUE (by Dirk Seidensticker). * seriation method "BEA" has now a slight code improvement (suggested by RichardKav) # seriation 1.2-3 (02/05/2018) ## Bugfixes * seriation method "BEA" is now not longer masked by "BEA_TSP". Also the FORTRAN calls now work. * SPIN: making the matrix doubly stochastic now checks all rows/columns (reported and fixed by cerebis) # seriation 1.2-2 (05/08/2017) ## New features * Added new seriation method SA which provides simulated annealing for all criterion measures. * Added criterion Cor_R (ME for the moment ordering algorithm by Deutsch and Martin). * Added uniscale to produce a unidimensional scaling configuration given a distance matrix and a permutation. * Criterion gained parameter force_loss (default is FALSE). Merit measures are converted into loss values by multiplying with -1. * Added Supreme Court dataset. ## Changes and bugfixes * Default for seriate (dist) and dissplot is now "Spectal" since it gives a better tradeoff between quality and speed. * Seriaiton method ARSA's control argument nreps is now for consistency called reps. * Criterion: dist objects are now automatically converted into a similarity matrix for ME, Moore\_stress and Neumann\_stress. * pimage now suppresses the color key for logical matrices and checks for all NAs and infinite entries. * Correction: ARSA minimizes the linear seriation criterion (man page and vignette). # seriation 1.2-1 (08/06/2016) ## New features * Added new distance measure called absolute pairwise rank differences. ## Changes and bugfixes * The default setting for ser_dist and ser_cor is now reverse is TRUE. * pimage does now work with matrices containing only a single value. * control parameters for method TSP are now correctly passed on (reported by David Aliyev). # seriation 1.2-0 (2/22/2016) ## New features * RGAR gained parameter pct to specify the window as a percentage. * Added the lazy path length criterion. * Added the banded anti-Robinson form (BAR) criterion. * Added QAP_Inertia and QAP_BAR solver. * Added DendSer using register_DendSer(). * Added GA using register_GA(). ## Changes and bugfixes * Fixed RGAR (w needs to be in [2,n-1]). * Registry now warns and modifies entries with the same name. * Registry now lists methods in alphabetical order. * Seriation method alias Chen was removed. Use R2E. # seriation 1.1-3 (12/18/2015) * Added is.robinson to recognize (pre) Robinson matrices. * Added random.robinson to create random Robinson matrices. * Added seriation methods "QAP_LS" and "QAP_2SUM" (QAP-based seriation). * Added criteria "LS" and "2SUM" from QAP-based seriation. * Fixed Spectral_norm seriation. * hmap now honors zlim also in dendrogram-based maps. * hmap gained option sym for seriation based maps. showdist can now be one of "none" (default), "row", "column", or "both". * ser_cor and ser_dist gained parameter y. ser_cor gained parameter test to perform tests for association. * Added permute method for hclust and dendrogram objects. # seriation 1.1-2 (8/23/2015) * Argument (control and ...) check warns now instead of throwing an error. * seriation_dist, seriation_cor and seriation_align are now shortened to ser_dist, ser_cor and ser_align. * Method "ppc" is now faster and also available in ser_cor. * Fixed ser_cor for "spearman" and "Kendall" (uses now rank correctly). * ser_cor and ser_dist gained parameter reverse to indicate that permuations are also tried in reverse and the best value is reported. # seriation 1.1-1 (7/1/2015) * get_permutation_matrix added. * seriation_dist measure "ppc" (positional proximity coefficient) added. * Fixed bug with permute and ser_permutation_vectors. * Identity permutations (NA) give now an error for get_order and get_permutation_matrix. * Fixed imports for non-base R packages. # seriation 1.1-0 (06/09/2015) * Seriation method 'Identity' added. * Seriation method 'Random' added. * Seriation method 'VAT' added. * Seriation methods 'Spectral' and 'Spectral_norm' added. * Seriation methods 'PCA_angle' and 'MDS_angle' added. * Seriation methods 'SPIN_NH' and 'SPIN_STS' added. * Several aliases for seriation methods added. * Criterion 'RWGAR' added. * permutation_matrix2vector and permutation_vector2matrix added. * Identity permutation (value NA) added. * ser_permutation and ser_permutation_vector can now be used interchangably, * get_rank for permutation vectors added. * seriation_dist and seriation_alignment to calculate dissimilarities between seriation orders added. * Wood data set added. * # Chameleon data sets added. * create_lines_data, create_ordered_data added. * pimage, hmap and dissplot: Simplified and made interfaces more consistent (all use now zlim, consistent default color palettes). * pimage gained axes and prop; NA in matrix now works. * seriation checks now control arguments consistently. * We use now package registry to manage methods. * reorder for hclust added. * iVAT with path distance added. * color palettes (bluered, greenred, greys) added. * Improved speed of C code. * Fixed problem with testthat filenames fixed. * bburg.f/bbwrg.f: memory access problem fixed. # seriation 1.0-14 (12/02/2014) * arsa.f: removed 0 flag in rand() so it compiles under AIX (reported by Lei Zhang) * arsa.f/bburg.f/bbwrg.f: calls now R RNG to be compatible with certain compilers (e.g., Intel FORTRAN) (reported by Rohan Shah) # seriation 1.0-13 (3/11/2014) * Fixed dependence on MASS # seriation 1.0-12 (2/18/2014) * ser_permutation_vectors can now be reversed with rev * get_order: removed the weird labels. * we use now testthat * fixed bug with intra-cluster ordering using silhouette width (reported by Bettina Gruen) * Cleaned up dependencies: TSP, grid, cluster, gclus and colorspace are now imports instead of dependencies. # seriation 1.0-11 (9/6/2013) * service release. # seriation 1.0-10 (2/15/2013) * pimage has now a colorkey and a range argument * fixed bug in ARSA when the distance matrix contains all 0s * added PACKAGE argument to .Fortran calls # seriation 1.0-8 and 1.0-9 (11/6/2012) * get_order: labels are now in the correct order (Bug report by Crt Ahlin) * Replaced Fortran I/O with R I/O for verb=TRUE * Fixed pop/newpage bug in pimage.dist (reported by Bettina Gruen) # seriation 1.0-7 (9/25/2012) * Fixed out-of-bounds bug in arsa.f (reported by Rohan Shah) * Fixed out-of-bounds bug in bburcg.f # seriation 1.0-6 (10/19/2011) * removed deprecated parameter gamma for dissplot() # seriation 1.0-5 (9/2/2011) * bertinplot(): fixed representation for 0, neg. values and highlight. (Bug report by G. Sawitzki). * bertinplot(): added panel.blocks and option for shading * bertinplot(): added bertin_cut_line() # seriation 1.0-4 (6/28/2011) * pimage() now uses grid.raster. * dissplot() now uses grid.raster. # seriation 1.0-3 (1/14/2011) * improved validity check for permutations and added check for dist with neg. entries to seriate.dist. # seriation 1.0-2 (3/13/2010) * service release # seriation 1.0-1 (8/25/2009) * added drop=FALSE in permute for matrix. * fixed reordering for labels. * added permute for character. * added different methods to calculate between cluster dissimilarities (min, max, avg, Hausdorff). * dissplot has now additional options hue, power, gamma, flip and changed behavior for averages. dissplot depends now on colorspace. # Version 1.0-0 (3/24/2009) * many changes and first stable release. # Version 0.1-1 (9/1/2007) * Initial beta release. seriation/MD50000644000176200001440000001320513531266512012564 0ustar liggesusers109d4f2b01f212a7cd0b1cca4e8c041a *DESCRIPTION 34c8e5abe86310bac02c929b10654bc1 *NAMESPACE 270f64439475b1c1a0aa4468c39a68ba *NEWS.md 3d54a38130e4ce777a8cbdbbdfe5fce7 *R/AAAcolors.R 86907cdcf0715b24bf88c2fef3448f39 *R/AAAgrid.R a36061f0103a0462915af6332d192d20 *R/AAAinstalled.R 093aa2e986ab24c3958442aa249bf7e7 *R/AAAmap.R f88ce5e706950943e4705b6523214f1a *R/AAAparameter.R 05050efa4115b9776cafd8215991a6e9 *R/AAAregistry.R a90a87a2e9e74e46a8c7cf5baccf976a *R/VAT.R 60df789a0252a409f21f6ebce80b397b *R/bea.R 8ea79d25decb93fd280d637b9d16acc2 *R/bertinplot.R 3394abc2939dc8fd176b0cd74581b0df *R/criterion.R fe58ce255bec1155820dfa4d9b4dd80e *R/criterion.array.R 8d923f92610040c6116f4ea33e16fbcc *R/criterion.dist.R 318c03e89fdca52d2cd5d350c86f2998 *R/criterion.matrix.R 46183b240b5ef555f7f90bbf78fd1807 *R/data.R b55408287398d79e9537a154a4e8711e *R/dissimilartiy.R 9483b51da0d8e6014c36e0c19620de68 *R/dissplot.R 06680c8658261226b815e9851144f78b *R/hclust_greedy.R d44e8c227425370c35c04071357736d1 *R/hmap.R 1483ae3f8ae3e2e4152f074e2b5a5761 *R/permutation.R 65b55a8f3386ce2679ee6c88bfd6073d *R/permutation_vector.R 944c9afb92461d9c9a84f32c591d9ad5 *R/permute.R f986ae3da4ae78b8f453e7721fb29bb2 *R/pimage.R 7d6bc00e0f435d59eaf6ade153eb8a73 *R/register_DendSer.R e5a405291f968fb8bea700f6bcb42f51 *R/register_GA.R 376864c4f1594768d982fb8ccf1c8e25 *R/reorder.hclust.R d09b7f48f1d34ae50e33e1517df9ae63 *R/robinson.R 3a75de877f539d9d7ae56c41e282c895 *R/seriate.R 807383c6c703691bb6c466a8dc466df1 *R/seriate.array.R 55c68d288f30720efd4ad4346c2c4564 *R/seriate.dist.R 0d34a8390510366bc222733f4d40160b *R/seriate.matrix.R 54ad31f6a1aa29d1b59bd6f2457cf3ed *R/seriate_ARSA_Branch-Bound.R 391e8677807d668d3159f4690257220a *R/seriate_BEA.R c1816256100a8f897cc78ce3029dafb6 *R/seriate_HC.R 14337f1090cc5a180daa67b65b18382b *R/seriate_MDS.R 92de6d3569448e3df9b46231692e44a0 *R/seriate_PCA.R 3db6221f060a8941a6b97ac6bbfcc22d *R/seriate_QAP.R bf81f85fd91eb705e2e2cb3a5abab495 *R/seriate_R2E.R d29fee876f235681f688accb1d11fea0 *R/seriate_SA.R 11c945485d699673253ea9a1b21a0aed *R/seriate_SPIN.R 0d3fa7764485ed23d8d4d57e0aa811b4 *R/seriate_TSP.R 64976ca8bc876c7e6d0d16d28b3c81ca *R/seriate_VAT.R a87cb03b45942189aa5cffc86423d81a *R/seriate_spectral.R 7afaa36c74a337b7073eafd5c2f425b4 *R/uniscale.R 0f8a642b7f1f268b83e39b6d4c70c732 *README.md 2fa4d38a453f131a3192e67440b2f45e *build/vignette.rds 4f812e82bf45b34f8864e5cbbdd899e3 *data/Chameleon.rda 906d0bca2aedd0b37beaadb7a72e0e27 *data/Irish.rda af710936ee1f7dfa741e92b3a4db299f *data/Munsingen.rda 95b83c0665fba53e965c9f72bc02f696 *data/Psych24.rda e4ee428e26e80ce891fc72b1e3c41a54 *data/SupremeCourt.rda 2148e15ce50dd04ff7e8e144f3ebd20a *data/Townships.rda 443babf28bdc6f8d44c9afaa77829d04 *data/Wood.rda 691665da705f9af86930fdb1e4bd54e7 *data/Zoo.rda bfc58954ad470e4e87259e503e5b9bb3 *inst/CITATION ec78b63673305829af7e9bed07c3be8b *inst/doc/seriation.R 0a36b142bde1b91bea2124bfa6a50c7f *inst/doc/seriation.Rnw 95b78ef610075d11f15eff3b908dbd49 *inst/doc/seriation.pdf cadd939fb9deb4742484aeae3ac68bc8 *man/Chameleon.Rd 928cdf6c55993eaf852f764ba6718bd5 *man/Irish.Rd 0705c259c1db15283255ea4592526773 *man/Munsingen.Rd e1288449e557db8faa5ccd98722de65c *man/Psych24.Rd 52a25abc501289d3628b58c716d6bb0a *man/SupremeCourt.Rd 338c48041a9cbfc028ab7620b3d506b3 *man/Townships.Rd e43cc1a4e8e739fae123028d9c055a7e *man/VAT.Rd 17960f6d9017ab43aac393ff29fd945c *man/Wood.Rd 77499ee94ea837444f55a1bbaa246cfe *man/Zoo.Rd 460143d0e27e040edeaada0dc5bdf478 *man/bertinplot.Rd 3b5d96490e3386ada19d29741538d468 *man/col.Rd cd885ec0bf8f71e121360d136054bf2f *man/criterion.Rd 2673de5eb8e6f77cf948d93b7be46c33 *man/criterion_methods.Rd 0d3321cb05f8e82c7f5c6f95d1b338eb *man/data.Rd 42edb802cc4602667f9d37e5c8cbf70b *man/dissimilarity.Rd 10be6759d3a24db64783c22d887b6e01 *man/dissplot.Rd 0ba04af7286f72aa0da5ef3bf78a9fb2 *man/get_order.Rd 53ef56f432c2516d7798ade5963ed0c1 *man/hmap.Rd c663de9add9f48a7aaf2d17673a9f1e5 *man/permutation.Rd 384d6b2d0b99a5e1e435cc574c23ec1c *man/permutation_matrix.Rd e80b98b4fd0fa8f9a1fa22629bb881e3 *man/permutation_vector.Rd 168c85c8738ac00bfeda0a7fe2d224c7 *man/permute.Rd 16b20813cb56e824be3a00df546113d5 *man/pimage.Rd f5398828427e41e2fc3886bfe92e249d *man/register_DendSer.Rd 36603fb87f28e7d920ca8b07ba8dc4e2 *man/register_GA.Rd 5cf063d968fbc19870de477b1becf8bb *man/reorder_hclust.Rd 0c531c895706923d91c9fd3d96fd3f98 *man/robinson.Rd cf1e0d98721312e3a0bae4a30a460016 *man/seriate.Rd 36a7b4dab56c68b5772f7923ef920912 *man/seriation_methods.Rd d9333e0abd05e7c740e58ca5c1fcf022 *man/uniscale.Rd dd4b979a72ea89fe013a9361bbab8526 *src/RNG_wrapper.c a0b10ff4ed36935d3dc63a588fa0830b *src/arsa.f 1c0b2737802bbc0454c0ec97a10bf5a7 *src/bburcg.f 65cf67b614ae114ae4c5c31cd71240e3 *src/bbwrcg.f 086465e5198c048ef5b08a8b8e7c1693 *src/bea.f 452900ef3d8c5f672210a9b9c2ffc8ba *src/criterion.c c369aeb45f31eb9c323f4ab2a5982d74 *src/dist.c 24f94b97113901b88285588bd7328932 *src/greedy.c cfb55fec0d250fcfaef06d0a2a98b02c *src/init.c 425191f429888b2797c315ef4848ccc9 *src/lt.h 35e47d9ec00b94d133287e2baf6dcc29 *src/optimal.c 6551bc5b5b01965b09cdf66ea9b34551 *src/pathdist.c d3254591e98e79feef6bf26ee767e354 *src/stress.c 4810997a63ce3eee7a2d3dddd06a05ca *tests/testthat.R 11b24c882c0ed120d82da3fa3c39d748 *tests/testthat/test-DendSer_GA.R 0b0cbcf205413cf001d544e4695e7dc0 *tests/testthat/test-criterion.R f7572706a606edbe508c73626a867962 *tests/testthat/test-dissimilarity.R ae091d7ea28a460273da31795aae567b *tests/testthat/test-permuation_vector.R fee6bfb4afb69022cef8e73bfa943dc9 *tests/testthat/test-seriate.R b59872d48cf446767be0c79dae8900f8 *vignettes/classes.odg 7f67ca8c5483222bc0a154258388db86 *vignettes/classes.pdf 0a36b142bde1b91bea2124bfa6a50c7f *vignettes/seriation.Rnw 17446bf1c953326c0ee62c31ceae93cf *vignettes/seriation.bib seriation/inst/0000755000176200001440000000000013531261200013215 5ustar liggesusersseriation/inst/doc/0000755000176200001440000000000013531261200013762 5ustar liggesusersseriation/inst/doc/seriation.R0000644000176200001440000002621013531261177016120 0ustar liggesusers### R code from vignette source 'seriation.Rnw' ### Encoding: UTF-8 ################################################### ### code chunk number 1: seriation.Rnw:120-123 ################################################### options(scipen=3, digits=4) ### for sampling set.seed(1234) ################################################### ### code chunk number 2: seriation.Rnw:1025-1026 ################################################### set.seed(1234) ################################################### ### code chunk number 3: seriation.Rnw:1029-1035 ################################################### library("seriation") data("iris") x <- as.matrix(iris[-5]) x <- x[sample(seq_len(nrow(x))),] d <- dist(x) ################################################### ### code chunk number 4: seriation.Rnw:1041-1043 ################################################### o <- seriate(d) o ################################################### ### code chunk number 5: seriation.Rnw:1054-1055 ################################################### head(get_order(o), 15) ################################################### ### code chunk number 6: pimage1 ################################################### pimage(d, main = "Random") ################################################### ### code chunk number 7: pimage1-2 ################################################### pimage(d, o, main = "Reordered") ################################################### ### code chunk number 8: seriation.Rnw:1080-1081 ################################################### cbind(random = criterion(d), reordered = criterion(d, o)) ################################################### ### code chunk number 9: pimage2 ################################################### pimage(scale(x), main = "Random") ################################################### ### code chunk number 10: pimage2-2 ################################################### o_2mode <- c(o, NA) pimage(scale(x), o_2mode, main = "Reordered") ################################################### ### code chunk number 11: seriation.Rnw:1130-1132 ################################################### methods <- c("TSP","R2E", "ARSA", "HC", "GW", "OLO") o <- sapply(methods, FUN = function(m) seriate(d, m)) ################################################### ### code chunk number 12: seriation.Rnw:1135-1137 ################################################### timing <- sapply(methods, FUN = function(m) system.time(seriate(d, m)), simplify = FALSE) ################################################### ### code chunk number 13: pimage3-pre (eval = FALSE) ################################################### ## o <- ser_align(o) ## for(s in o) pimage(d, s, main = get_method(s), key = FALSE) ################################################### ### code chunk number 14: pimage3 ################################################### o <- ser_align(o) for(i in 1:length(o)) { pdf(file=paste("seriation-pimage_comp_", i , ".pdf", sep="")) pimage(d, o[[i]], main = get_method(o[[i]]), key = FALSE) dev.off() } ################################################### ### code chunk number 15: seriation.Rnw:1266-1268 ################################################### crit <- sapply(o, FUN = function(x) criterion(d, x)) t(crit) ################################################### ### code chunk number 16: crit1 ################################################### def.par <- par(no.readonly = TRUE) m <- c("Path_length", "AR_events", "Moore_stress") layout(matrix(seq_along(m), ncol=1)) #tmp <- apply(crit[m,], 1, dotchart, sub = m) tmp <- lapply(m, FUN = function(i) dotchart(crit[i,], sub = i)) par(def.par) ################################################### ### code chunk number 17: seriation.Rnw:1309-1311 ################################################### show_seriation_methods("dist")[1:3] show_seriation_methods("matrix")[1:3] ################################################### ### code chunk number 18: seriation.Rnw:1318-1319 ################################################### list_seriation_methods("dist") ################################################### ### code chunk number 19: seriation.Rnw:1335-1338 ################################################### seriation_method_reverse <- function(x, control = NULL) { lapply(dim(x), function(n) rev(seq(n))) } ################################################### ### code chunk number 20: seriation.Rnw:1346-1351 ################################################### set_seriation_method("matrix", "Reverse", seriation_method_reverse, "Reverse identity order") set_seriation_method("array", "Reverse", seriation_method_reverse, "Reverse identity order") ################################################### ### code chunk number 21: seriation.Rnw:1356-1363 ################################################### show_seriation_methods("matrix") o <- seriate(matrix(1, ncol=3, nrow=4), "reverse") o get_order(o, 1) get_order(o, 2) ################################################### ### code chunk number 22: seriation.Rnw:1397-1398 ################################################### x <- scale(x, center = FALSE) ################################################### ### code chunk number 23: seriation.Rnw:1405-1406 (eval = FALSE) ################################################### ## hmap(x, margin =c(7, 4), cexCol=1, labRow = FALSE) ################################################### ### code chunk number 24: seriation.Rnw:1416-1417 (eval = FALSE) ################################################### ## hmap(x, method = "MDS") ################################################### ### code chunk number 25: seriation.Rnw:1427-1432 ################################################### #bitmap(file = "seriation-heatmap1.png", type = "pnggray", # height = 6, width = 6, res = 300, pointsize=14) pdf(file = "seriation-heatmap1.pdf") hmap(x, margin = c(7, 4), labRow = FALSE, cexCol=1) tmp <- dev.off() ################################################### ### code chunk number 26: seriation.Rnw:1434-1437 ################################################### pdf(file = "seriation-heatmap2.pdf") hmap(x, method="MDS") tmp <- dev.off() ################################################### ### code chunk number 27: seriation.Rnw:1503-1505 ################################################### data("Irish") orig_matrix <- apply(Irish[,-6], 2, rank) ################################################### ### code chunk number 28: seriation.Rnw:1515-1520 ################################################### o <- c( seriate(dist(orig_matrix, "minkowski", p = 1), method ="TSP"), seriate(dist(t(orig_matrix), "minkowski", p = 1), method = "TSP") ) o ################################################### ### code chunk number 29: seriation.Rnw:1525-1527 (eval = FALSE) ################################################### ## bertinplot(orig_matrix) ## bertinplot(orig_matrix, o) ################################################### ### code chunk number 30: bertin1 ################################################### bertinplot(orig_matrix) ################################################### ### code chunk number 31: bertin2 ################################################### bertinplot(orig_matrix, o) ################################################### ### code chunk number 32: binary1 ################################################### data("Townships") bertinplot(Townships, options = list(panel=panel.squares, spacing = 0, frame = TRUE)) ################################################### ### code chunk number 33: seriation.Rnw:1605-1607 ################################################### ## to get consistent results set.seed(5) ################################################### ### code chunk number 34: binary2 ################################################### o <- seriate(Townships, method = "BEA", control = list(rep = 10)) bertinplot(Townships, o, options = list(panel=panel.squares, spacing = 0, frame = TRUE)) ################################################### ### code chunk number 35: seriation.Rnw:1647-1648 ################################################### rbind(original = criterion(Townships), reordered = criterion(Townships, o)) ################################################### ### code chunk number 36: seriation.Rnw:1715-1718 ################################################### data("iris") iris <- iris[sample(seq_len(nrow(iris))),] d <- dist(as.matrix(iris[-5]), method = "euclidean") ################################################### ### code chunk number 37: dissplot1 (eval = FALSE) ################################################### ## ## plot original matrix ## dissplot(d, method = NA) ################################################### ### code chunk number 38: dissplot2 (eval = FALSE) ################################################### ## ## plot reordered matrix ## dissplot(d, options = list(main = "Dissimilarity plot with seriation")) ################################################### ### code chunk number 39: seriation.Rnw:1740-1746 ################################################### pdf(file = "seriation-dissplot1.pdf") ## plot original matrix dissplot(d, method = NA) tmp <- dev.off() pdf(file = "seriation-dissplot2.pdf") ## plot reordered matrix dissplot(d, options = list(main = "Dissimilarity plot with seriation")) tmp <- dev.off() ################################################### ### code chunk number 40: seriation.Rnw:1773-1774 ################################################### set.seed(1234) ################################################### ### code chunk number 41: seriation.Rnw:1776-1778 ################################################### l <- kmeans(d, 10)$cluster #$ ################################################### ### code chunk number 42: dissplot3 (eval = FALSE) ################################################### ## res <- dissplot(d, labels = l, ## options = list(main = "Dissimilarity plot - standard")) ################################################### ### code chunk number 43: seriation.Rnw:1791-1804 ################################################### pdf(file = "seriation-dissplot3.pdf") ## visualize the clustering res <- dissplot(d, labels = l, options = list(main = "Dissimilarity plot - standard")) tmp <- dev.off() pdf(file = "seriation-dissplot4.pdf") ## threshold plot(res, options = list(main = "Dissimilarity plot - threshold", threshold = 1.5)) tmp <- dev.off() ################################################### ### code chunk number 44: seriation.Rnw:1819-1820 ################################################### res ################################################### ### code chunk number 45: seriation.Rnw:1839-1841 (eval = FALSE) ################################################### ## plot(res, options = list(main = "Seriation - threshold", ## threshold = 1.5)) ################################################### ### code chunk number 46: seriation.Rnw:1855-1858 ################################################### #names(res) table(iris[res$order, 5], res$label)[,res$cluster_order] #$ ################################################### ### code chunk number 47: ruspini ################################################### data("ruspini", package="cluster") d <- dist(ruspini) l <- kmeans(d, 3)$cluster dissplot(d, labels = l) seriation/inst/doc/seriation.pdf0000644000176200001440000152755513531261201016477 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 4018 /Filter /FlateDecode /N 80 /First 665 >> stream x[[sܶ~[ib dƒ,Kd++ŖKiYE^r;%QfNgK\c!S &$R3b?dRX(3?x3_?2? Ub?@=ł B%^kQze,T,ǂ b`ҋPk&#S)E Uʡϴ@0`Z{!:a'^(00`)T\1tk狀 c1EkQAB`.H}MYI&h"aQALrѧ`󁹓:ɖ4>&䇡F!2+ʠ*5 3SЋ*@Yx%fh)|!<ehfc*`,X1t@8ce6RPX$% B 2ޠ("PV=/?iZ$H o"[9jϒk{s&e|kOċm1_oسl:O;J"|^o7;ZoV|Ev:/@g&E^$Eʞ=؋>"ddŜf^,gϦlEud̰Ug,Or[ Hg1qY϶\:;aȧ`@?i| P{Efs,[Y;{bǫP$&Xf< %ϘY_oW a%ol~!\ۋ]P s+V]\>\]&rmG0p=+G ]0r@uرX gz8NsWj{K']е\tUf̲do}y2ϡ"?fH7hP$yA^"'B<-@џ~j2^g&/#xDjyQ_~ zU}LjXo7_R@p;6$]Ns$7MQř)gq3=hIY4r\M,|GEMq358S8 vY,|gN9M8;嬉3-8;^oY۳SkVliYlO^=;%,>gsr)Ɍϓ I ڼ:0[/yݽfŜ%饅}'4Iuy" >-yG|eZLN N.i"tW`tɲvn³5@:$*ѤZ-=B-Dψa/(|JPpoz^b\ _#~_~3 s~OtXܐW2n~Oͯï+||W{8g¿lDksQ|s^bIS^[;_Ōp\SpaWySIhfAIiOdk864s`~^w@5ݐv19`QXXY5]5raFXq+?*$Qor#s/(FMm^I-Eྋh'h{[!̡vjڇ\”痘B^*ʼĺ)T{GB 0k҂.] TqSaO}둘X= e/R|ADOB +3P,kt ~"UGCӻ^cjA5,m( iiBF@6A^»\COqƦXH# L?e5)}!8tgg ] D,*+KqKPyq@ = iL?lU~iP2βtY^ٗt5#3~& Nr,wr #dpfK40[ϛvk١`_f=ʌ *CC*JF1;<ц,+S:c}F 뾯~[q{7mkiM8_TGQH+~-뛲mʢL@. VY~NMFٟ;BiXXup0hX[GoG~AoQ}5aUq ‰‰M^IREi'MΜ9X"-ۧo.>qۋ^@nC=ӷ6W{uh;J>@"td]H5 #҄~ beɥt՘!lPBy[ͨܽ%Z~_E`@3Beh*%p,SC980͜Smmq>:8lV2ɰN> $i)w-O뎳cmcrcӻv:C˾d !eA2dv"FH,T 8El$^{Srm%9T9v I%06$M4 Kt@]P:D)ԩy{d}A4j,J?LNH O{^ꏵ1~L~ ݝ  Ql=gMއzҢu9{8-E Ԃ/Ju)SF>3lLZ#%j~΍eBoEv>u?i w,Đ#KFv4Z G'~{wQe;BZ= S)&% zRԞ*o*8#lݣ]iu!3Nq]kJ|;KvȌBf/c<]֡w.^7M#ӝiccZcD5iRZP)iP6 wZ5qQeU{m@ oco(zŒ].v z(8>8~pl_K=z3*G*'bP X {[-F>_&ܚdRW(\.DiM}/ԞS?N<`[;'r@]Y@eE]ٜemN fa;='(tT,SF vb[.DFV4-[{ZeFm7CtE}|OvIٲ#𐋓N^v}]}*27 Ϸ0t7lZ!n"Vzi9_x=OuDWEntr; =;β!^@T( RnOأ#Nxevs*[b5=p:ȮR_ 0GA"|(n )*3z;3f&VL3nNu1~,Vut r2jUMI[Ag]YӳƆug>Am:r @5 YͼGT+@T+(N7M7##)x踙ݾ'}ò]fc]1 LVvC+-쐧fD٦Q EGendstream endobj 82 0 obj << /Subtype /XML /Type /Metadata /Length 1716 >> stream GPL Ghostscript 9.26 combinatorial data analysis, seriation, permutation, R 2019-08-27T12:04:00-05:00 2019-08-27T12:04:00-05:00 LaTeX with hyperref Getting Things in Order: An Introduction to the R Package seriationMichael Hahsler, Kurt Hornik, Christian Buchta endstream endobj 83 0 obj << /Type /ObjStm /Length 2597 /Filter /FlateDecode /N 80 /First 703 >> stream xZ[SH~_яJ[}jjbVc;LNK%6q|~n}nH3"ä,LɀE!6bQlYX =N2)t\d4s 1)9ˤ+E,P {8|K!` $@ 8ɆND,C=!PEK8d&KyRJ&BJ R3m4N鐖W#-!3F H3`%T#qqM,Sg#GjM@R)fCpKbS) g)0Q*٢"4IB^ ԒVHPb?Ԓ4;k(Ֆ&@ !e)ݐ(  %QP C4>h8Wd- HCrD%!PiIGM-)Q?~8OyP>fOІМyGZ6eI]{4"suűu B"A.S,?qG:^6 U~O%ûI ((uh8JgD5+!~Hs$Gn` ,(ypJ55Vuq']H7.M?+6KUڍ^RFЭ22zsEvyYg\< BĨ(F@4M 0F~ۅڏlZ/"A#҉Y]%f}]iqغҫ)K [ElGʧʧ/UQRnVV4ND*D<j-5"Mdmuz%wKW#*DE+"vο%Ҫ.GHka^.N//.h8.:D)ݺRe\(.?Пy>=C):4o&bUg?ˬͫEKK3j>"*Mw|~#~~{?/%?_4$6/vI>\ `2Cod4S,[~;|L- wi{~czG|dc>=\'i6 >>z8t &7|:e6z|8_.~m%[Q=bnVܬ3HrqclOs/}|=ĞԦ)i~Z!s)b9b+ثD'5VH`kDqOvD`߲WyS4`z1Lfjn ԴCVt k$D0DŨA":Y6Fm}Qů28*EˡlFHR]VAzt[gܶxw\?ypu|_6A*2 2 WGyJQV7OA>52u'JD5WQ܍ pC֝jIoA%UM6.@HnjngheWW"+jޛoz7 6F`'f" /nCkOʅ9>| ٠J{ݪ,_7;T\HT$9?[y |ZP`naԒQN> stream xYms_qߚL w7Ɍ$۵:Qj&0uА_gA Q1ێgwo34 "ƭķaA,S\1--&dVo\B ?r f ) ୴+ `HwC 1k˙Ca\J!$QLHV31V c2 B&v3)4 Ib'XN1240]:Ao XБ#ԀJ(Gj2BrjyQԄ%Jz2D4Y1XUocoB#L`ZI%ӑ"(QACp48baQ[8Z".I,# @M [LӅ@ʋ#(Ҵ!b@lBbe'!PIBF1q4U2یH̆8&i jo%y^I(NXpӒq,x닒,w M$bY>1BCLOp\V\=]ǹ?3or7S'qd) Yqe2Y&ʳ }}v)"=ȊFٍ>#"[ig<q}wQ\u] ɛ 0?c˰ ұFq/EI [t^> y:2v"&EeΓ/bPLQPS1x4mzb F>./:Xprwśzɮ' R}@5 (:Wa#~V&i_ -[}Mv9k|fv(rb@=B3BMhf]2mҗO>*0{e0x]It8'pdmNrm?EY/|y#iVdg 9Í,}|>G4q=3Q}\vC糧d=-s: hQ.oOE*<+GbBB].MWFOFU8!tIozΊ"KrRȉ}3%lj85{9!_JpaVZi6͸͸m}+dj@$n TjBm@;Q7iM+ P-QͺrP ~ܣH5<_-W1%{HpT3C9Qtϓ:Y?6G֍BJ64W/ 'Q.R9h r_q'A \(|_C\ԙoiIe2zoCg 'kNxlcEF\y }ՓVjLkԓP̹2<葒Uu:vumC/"+9 ´ 8_D6(5(TI'lfW?]^OW]:(5,-݋/PȫhVh8K-1oM827CTJoT;+fA"^}yĪoo+U#ERSfi/ mZꤛfy]l75өn]]]_ˑc™f#h$]x]ŏx$᝺9U; 7\ \CO rKآr>i&Y"L'}2xGxYVS=^~ᛯdyZiAx0=Nꑐ8:^*NRύi7v(n/-M:o95?S] Pnm4\G\ZW#D5iDe5f|2h[-q]6Ỹ$XiyPe[}jVI^Thmd7`_l8zF*$ܒXKl`FYԩ*XL:,{BOvxsGo{^엪̥ ْendstream endobj 245 0 obj << /Filter /FlateDecode /Length 6801 >> stream x\IwGr͏O#ڹ/sƶf<# %MdXr̮IqtӁBV._D|Y?>W_:9L_?_\ǽg> vٷvjo .-;:c7Z >v9<.ltN2=}ӛc#YS&Ec/ve뗫k1wy0im^E4-_^⾠^THqJYeSҼ`.A ~5}%a r G:$x.X.6.ȍj#6w,@bU1.y*.e?N-݇MQQd`b AlR`0"n@&"(g[$\k0& a| gͳ ;&\- ~}j+.wBWtz@#M+k36- y`u3"_h  DAh#לc4tZdrۛ\9*b, 3#/ԃU A:ǃ'O,?7L9M.=Uˇpm :H+)d$OE l(<8VU5[.'0%l|sήED3m!8 GJTv4rg{x5d|K L#vAAX3e[U2-HB5 ]$w2JZ?ߝ7Ͼ])"%vV[ǰW(`  sJ*礡/+8)iI !OlAM`Gh/j{`=1,$1j)MͿ:܆NAQٟ,OHϼ1ξdC}|21w~m!C_TRHH³ R`Yh/{\MCIxE?@Rt?`S$b'L(0$S [s$M*d?(8:P(oڌjpW )KdPml CmZdܖ.,rxq7{,O n)-w^ˑ"LjwtjNuX'&{n Zx|!/LxIJC_넣P /-Fh6`*0ZvP4r2")b%+~T-Xڂ8>2tE6;c5h`N=cbd˞zR$x) p B YC߃3`6 C ]F~ƠxxTi omC^$\{<$0-P{+=%8횩@0{cvu@~wpxp0#ExXvd2:|U(TVSp(`{kx׀O)B)-^&a_xӌ*gѾ Hܛľ9(ü`T C% 5`6d@5zؔ#fӉE]K=Ox~MEa8 G`3 (ln!M UOWO4wnM{eo@0eoSIݜen)T|:M$AStu?>κ~wL0 7m`{y /p KX0rn񌽏IQ2vl}qWAEw%70GkQvs#I2t{PE|ו{i""ǧsdNP@{+D9X -ag2`֟ʗl_u?u22Zr['>іsMf~ -1;Q&cSЯNȠ`(iɪ +%il՛OᔮSI:)樏ۺr>̗Q\Q^\TS{NSXO&߇?3Va_> IJXDo"|7>=cݧa%cڴ'YqNXD)R ox"g{2`χǮ u`hβd*,xCD3h7tBiD%0H>:9!hF{6CU'h5+=:l% 0$l7rllɡPS4F(pW#y,TY;`w3{B߲$MSV?"†׃ZOVRCR83Vd<=,bvF=;bf2xFH+R :!ߖOeH%xH8r 5m\o*{fV[τH) g%VS3oEBeQ9`y/ 0U[ϡ-"'=Χ"qW,<5nhp ~mcje12d;ubY+h ucRyTxTEUXF;0{UO"ICj>XQZq˿Ps(`l;"!Y0#ךlu4ta޼RVΧMפ/$]' h<ކm.,DDZQRY/ղ^s < 9 թ c҉\',Qg@-vqiRS7}mFEΎPkbHy+*2K>Id3:Hu4ꩳƝ)l!5XGL ◨gԜLa]c|b|䒘a?0[(j,K'lȇ`ze@aqAxk>ONmTR b1}N,'TtaXB`uW6B MĹ8 ďTF⪱Ձu'z)p;PYS80\ݗ[y~zFatSr ^G9 ۦvO12ILVtw]Zu#|ջ;U ne)wPe 莳`CGZ՗2b|B=+ xOaQ u(UU}Vgeiim26oAd!@jY_0DAݨc8֔zqW8,_qRU)vIN y0B y%V0<:kYʻAn*@ILƃj;c.⹐nC۝!JɖN}&-ٜ^$6 *3(wky тy'^Nfש&*{ugXj͓ `Fz`+.9W }D.L!GB:j| t'||UO2q1L{,;Nvw2[ɤToSXJX=QZliO4Ґ{T;xdb\,E+oѠDn4>L?D~PͫI :YY[@DSl?Ϋ Ja~p+LۮGS%nS*1FkM]%h ]~HE/'ECO=U1~^$?$ y⻕qk ο[kMH7}V9د'xEq~6&e[z~G:& rυ'PtDžxR$xI-նԆܦJu^1m[VfTߖ{diD<ܫA؛цRYY G!\d;{L΂&PGbNWŝ(/uQ,tL6;&Y-ɗ -ZSZ? z4\_OBJ5Gw=5R eJ B$@GN(tE@xx$gj ]h+''{뎔d`vh(7JuaNN:Ueg,q$ֹ+`׆ 㯐gC?bL>X`9)5ȞI,: ||x +rޭ1Bb40 ~aezӯ{+Y74~qxr&'~F#?Ƞ Y1QV]ћ"6~DXyX=dacʣߥD?3&h<ωx|r>u("ROXN[t8Ih#oҫng7q]Xc qP g(a 3ճs󌭯cLnNCrIȵI=qCo. HLKzFr2@CV87EcŠK~*Yĉ!'5nS`o|I1/ *֘F\%uCU1Aڦob Cx^ݷ\XSA ;QOEi#?U60LaQA+ѧ8Ie'apO3x̬olUҜ;ݿUdW[ӓ^C s%w,Mv<&Zt&G|mZL#^!m;:=}~2j(_ٰWg2zЯ$#Ygx//wEdpvEө"+ydoWч āoV|*;6/\B|@ґ/#ʳ20> stream x=˒qIyvAdAB$"||`$`$/g;Uݳ .hUYYάo.}ep׷G<2׋/1Pb.?įl.RH׏vv06y56w?zC=_NW qO%Zg駙4Kl&RRs00"O!F{!F&MoE?aj|+~_nqwߗi|ǿ[ r #} kBi4ΔPw{`B1uۧ{,vO&#$_^B.?-%ʧ/hɥ,(h<^ϼ2p5Cv_(󚩟<[Kt@KƯV;>a-`Aq3\kZ8'tx(9X8L'ַ`0)lbg?"I- HDJ Π[E!| Fmӱ,>^0~|.%KT%rlZp| m6 n,DGO#P5Nr VNi @IP/y9$f f)6@NB^!Mu ؍!-F`:ۺ V2醟)\qڢkA@[4 +\up;H >'vHhgv8Τĥ6q$%-+RM1N.8 4m2&g溶=əCP!P'm_Mǜm8k6&c>i"=hsEѬ#Ͱ N!? *5<2>(f $P IhL@u[4)^H8{"ózYAN֒ŋ[rw/D7]X=3)ӀYy?r8q424XD"N$\vqzRl3dDh<ֽPM Ө Q܀CuρEQ-dt;ъ ͺ|ʈxV"B`;{:Z8u ?EṜyx+a^ ?ixp붌,RdyS. _T:O8L\o-ő4ϴlG|Į§x0gz%hdӓ.R6\[!s!>u ϟv>Ѷ3xDΔ`0\_0}}=R db4D͂sL"N΄|0ί_KSm=_`A4:@ |jZ颻H6"1{6o=XS)zp0$h}Gax.Mh}3$C"N]#3>p)`7VM8!bC >J{DAEdnDB-5'LJgCxh~ :IH>-$ mw['a6)~>ByspPGfzi-  >eҠqH+U ZIvK--gìSGwz6ǎ(N}OE`DRSzC^+!M l#t"}\ RMDG)P?L)ԝ-b#^6G˗pӊ>{ϙ-Ʊ]p N/i:Y5ԞG ,DɛuQ"8@eD^˺6m%PgKƔ;`j&\/"9j/z*U7,>{Ynh]*_=%4 8+s|e s.R铙6E0YWs~P VphQ`d.ř;̸bga.FJR1".d##ҿ=A=t&++좚gZCXoiV>5~-j?iU&uBOK\Ď9$RO!lb>XJ^;AdNLkap}7fH YF[C#"#c3v NYr\5z_i"$sC[Q얅&SbSbqx&rA ,R&৤S8ԦD{_c^kle9nAZUNrwlf@Z"0 =Pquӓ-4t0ٺ@!@.e)X๒Mna slrﻄިjVImqV=Ju?e͐(3Ro7t ,/!FmJʨ &*.{MH"ipߒxf-bLX[I4 MBwf$ݟޮ ;k ϢzLZܛM;\Q6Hicߏ,6WmiCfE.;L>=H_"z͔.\]%NaA{OXTDZ!7d1'x\dUS#L CU`w3_K.-m"b=YױGeӲ1Ο$^1 VWA$bUFl#9磍;e72k5[~e/; GdSE3 *yJJoe+?K"S3& gg.Iyiq&gea9uU"z 'a ŕk*!xw 9 ވ{C}Tb])%~ Yd _M2"Ei<3u~dVOSŞ]G bP`~#&}nY&sܡ5E#D `+V*q*S)xn6\lqj WJɈ2)A޸9Q„ kP`UŒo{dW\^,\ pDhF^D}20[z,8ijGڹNB݋|خy)cPsCKTW`D4V{-$(YbN vb4bT,xJU5nU´9$O*,_w\F~mt1}#"uVdFtk7Qco"*%U nl.Mߜve XUuM`Df)HRwG[2a:4?$jP#j.L@a}l F2 %R/XOv_1vy䀓ω>Hr wr ;/& ̐%<"Èb{u%<č^}X2g)}+pxyi` wÛ qBPi#n|AڋY!O^sPxU6qUES bEDfc)2ӆn3++kVf=L2Y:0QdwlQWaVIn/^ۡ!'A#+7CֈN{U(W+D66̌_^8=m 0,%m GUp+P3f+ UYJp3'znŖ|(m֋SuO2-Xm^\7fccCtz 75Ej `\TvG5,r>WE큞ꕏY/iA!(-ՂAvGuI-|LSevg]֒$+0]V|£gC'T*,qFzOkDU #b14dB2FnٯZ0&{>9i= gK Ƹ@5yuAY;~򪽏jcMh`!,OY޲z5w2+j"01bwwL1\VYf3 xmZQI c):݌EC%ۢOOgwOg )yéQysÎڹ x]ջ1q t%m~v=z=v˳!0`G!IA^eYo{ ZzeNeObS')V]QD@I4Hjo崾x*.V@ެ-at2 bӲ{qt밝ۼ\^* \Diع¢̟UH>``. SϸŭJ`.m˞DsyVT-åZӾx qFQC֚sIۦd(K)2tkO @*~Q ELX*^Zu j"T__{T;ecnYLf5%g\z ~jBOex*"R>1.al'Yi"ٵt=sY^myb1zt<"߸k]V";0wMY&W4vx$hOcD${8uB=U_~/XIz,&5eN.+ev-%Ô xZjdxx8t1I2IfK]Y|K/Pg*Dl0jhQo)x [`*,^%v;- Wf*y1u`.l>0TbtW75R+Kr=w('1Wq[9! L{urk>p$/nUVFZR\0Or{6BTywB[2sQxlʝc? STTyGjo~@ sF!Xp}.m@(B*PZ6Ӓ%9Dl4@2QPLkyL{oD"H^̪ F`ὡKL|/ !p|'!P@~zK8Wqu T?]ER\C)^1p"ZXa:>e%.i.z.kL3yc{UĆ%ْ-R: pZ9: fFkQA{E} /suChyݭjH-L\KJrkÉߧ8ߥz :zqL TuX!ѕ,籯4P2XR^-{QQ'^vaΨ[qxՃ+Xԋ: UݯKpmO@Tm44Fk\?Ͳ^v>i*oHeLo틍.~yMJu.g>#K͌5)՗~,~Wnwf 8@JmNTnP'QI)zoD\p*M H/d ni2g$;Ϻᢾ(ىH0猄kL~&SСV,3 Cnct*jǛelM"[Gf$BT"xjyO;ٲaVq~ s"_X븡-ԭj4]@dsN$dgci6qr92Q*-ؘ!Ig ~&-xe-g{)3X= 7ڛ~o5 |Q ]9=\Xk_$nj?dPt@w6B!-Uȣ>ZJhI\ ;i=F1rF @TSgtQծ݃ȴf\񲮠*(O$<%ǿ[ݺL)#k\P_G&ېjNu,]6 dC'"5a7^uL-N#L iq8I;IcZG R'pt+W6?m:"Hw wf4^Հ- ]uI_endstream endobj 247 0 obj << /Filter /FlateDecode /Length 7473 >> stream x]IuHкUSFAkȋB֘G|(nMΰYPoA!3EN$[r5j?'7~_߫ד_=q7CzjLC*8df'lp/%vI [-S1̔ES1 <5lblOAAc'G148EDG@H )N w&]דGG7w Q*^б0:X6I`|#r;_{,܏lQJdQE|.<OlR3P ެ~SXkn[ɔ8 HAq ^3@)j*IJ3B\Q+yk1GjSskBe6H}q$#vX'Uוߐ@K ]JF/cx8t&(TcCi$'nsPzwE;=ے[T=A`4QE0*&_*r|Ym׫3z݀:6"<|_7C[ ı@`ă3o h64DJ}H!E i/2![~YksѰ}0C16= N;w*/:ቒG͘44 _\y^H;[%lV)[s)ӰcJQHB2pFaG8*=xI`,>P69V-7GL@xSr eaMGkÃ4F^p4n  (]0Kg& _GodY*6>юJd1"w)۬ AvU2鑛qVΊp66D|kŇUFN tMB- enyǍq'. 6@ڔ!naa(>tuw'шMNVCcļ<#eqDzRȠ~+ɧۢ?DQ  z[U365fBft֜7rG$"Gl'q<]|."z `MpC%FWBwj?zM5ʀ=*#-.x.x?UL |_] @_[Gh )sE\\Z/ĕɯ H1 ~{|Π"령 z!A&2ќ LmK~8 7,[;~Ǡyd9nilQXO/jg!w`i)mB$Ьf6=&}tB,yZK-Pr^WoG4X6!/[l: *M >Ec``ᖣc.s0*'֠x1_YSX1.HqˁìC 9yDZ/\Φ)SU7z*וv"CnÒ &WHX\{=Z^XhK5V5U"47q4}G#+egRv]5\ !O͂|q ܣ?k"5u-1 @(:0[qj6&R=6nحW>؎J ܲs/ᓻں fi:4tN6QzR 'YV7O CH#jR [pMK9jƢ#z+g?3GrvV\V(΀WnǶ=Cg!΍ ni_8z]XAMu(Ƨ̟zsIYV"Jx ǒEavLs4Jz {H3.JD'n0tJ@Rs$Sy^XӜ5m9}6U8>㡒/Q7YKk6#?2R* -,zO'`h% 5}"H3*B8Js|iۅ#$#[Hb imJE0yY \-XuXϸ]N : I10G2-M}O]L<`y|4a@\Ie}ctpЄߨ)ыZ%3a\Kf51U |9@Kˊɸ6y?pJBY˝~Nj挫ce#VK.J|5A(uB3FӰ|}]؃[JYeP~]"?tog^CBÖ(})/H@+i]:LFq),dVpÔmʼnzp\z5ݤTBPjRڎ#K}*=m=nމj!eZ4M+?i}gGkt'@Sz]۹Ja.HA swV(콥dk3}s@*%|47Gqbѽ56Le,{tJ7V?흁e[FXNHi( PQ^4nnEJiˍœnyi6zu8k r@ݖq6|^ oV &b=UG@΅],Qk1.W]RU#6N}8hg.fxY% ճ30V8; g1+*S7Ո%XSb3w*˔? QP5QENH!EO1&WO?6Y}e4c7^Ԑxjp]03NbD, PptO2r9nP݌>46QԪ3mDb4\J7t$eF7@5nSұhO |^BDt^نNg(7x wvwPHO4߈w9_ׂOY*E!=泊:.AZ$S3 j/ay' EZ^\xr zIg3xyi2y%Z?

.zt~RsnjMwwݩYLh{Mm"Zr|72#ع=R tb묠d:T]ӯ,T;/=?M' P.qI;ܛI%*E|5^K܂K&"}1qC@qY}}&p0dtQG'!|YjtdȯwO%s6T劒ôIJ#)2S_ΈoG,v?$]m=w,BSçԏK[ [joxlj l(x}w11Nz7 ᜣ5K.˽i8oiQ]U[a.>H?n=[_%Λhr_*X77d|-ħBxl#Cqd} }RouN;" OAgVn7>]/ײħԢW >ۋaRpTE5Z ˬ R'0JEɃh>ZBG*+f6mJ$7j [Ur"oCl$nyJ-*-] -U1Pg%fJY_74$1{_˫k3~c>5Wց5[ ty+NolzZ2.o (CoC&ߟwݸ{ET mǴ.$})I_?<@2hWu+<_7l:te) P )_E!+MgY$fwwPޙv˺fifLKޒ tRzjow]TrKr*y&[ܪ>@UZ-ӻǵ4D$^mm RUv<l(PbKHp )B =}wm~J|sG| WZ%Dŵu#O[B&ZBwni0[1ƨ~;;bm[΄XEp=TS ;ny`(klImz%R 0]mK_h_[ux)-v Oz;Lh_薶76͑@v_V+|ym#Z=!ޝkЅlwR| )IAgQXHnw? .wH$!`?Dpk$}hdxZ2*Cxί$TlL>_|NL_t ,N$3T=SPbJs]4]-lQlP}صOk'VQuQJ*T\QQys}JɗHҲ+)y|6y^ͯi']Ak8Ō ͐?^n]Ӎ\TtRD.L\@X<_ցuűF*F$D[zsGϸd%w7,]m-.꬐!U]|aY9s+BajaK'B+o?C/b=*#դ( tBYNb 6}+2)UY d`9~kG8c%;6rNA~ ̮ۧKOSOD#t"hm$ӃdLYendstream endobj 248 0 obj << /Filter /FlateDecode /Length 5041 >> stream x\K;c.,Gػ KZF{h!e#qDR/*!k,ՠD"_>(w+^Vo/ +\#rw"*wAcvwb0o1֛f/]|3q/Fax?QǠ~k*=J!3,vaxImޫzZ#.1" >PF:ep}?4BvS[g.:<“ 9 a^Aim\%}PуZLLT*)ża&2B}?P5'ځQ3r*VJl _et'xL{z;Hw4fM0*4!("]7ZiDo 1:02JV `>QK!,nm5Fidypr`pbu:0޸d1 uTftJO`gXesz̃.hzcܱO}z/'ڽF(J/~UC[eo_qC+.rІ27HЕFM̦e J鷙AsR5Zsq4зdv%cDWMX0Zڛ4qSd{0Rz}|15[^yG ֤ ?AI9IXu]V3;"S,i 7RtTb u+( ؖ \Szy#F)|‰ zEll>=Yг:Tp fx$ylhyAo \Qҟ_=͓L ' ꢌM<ƾnc`:'X 1G:N01XNLLJс+nC(P$}6ϕWxo3WvGSbQaҰ›d1x*Hő<;"$1Ѐld8\ ֏(mN^Ny cc(2)ǝd4Jى+BW(tU2HZƆ[wƂ'ShYz-C\h*`'gP?wqV1Pڸ(uB}cMpWIN R{`R`v>¤X~Tѓ 9\zR]sԉS4&}5V?̺=MgacJ!olSݖ `PF(MF px#"x*Yпܚͻ8* DD]IІP^9xp{iůfp/Zr0MG;3$֦VH k+{01QgŮ_c<$$) @2ۂ, M*N{3 k .hۼ}IoIA1E!;xCx{5$$|Oƺ9%Fިw |Y>߫27|[B*@LNmPAǙ ;y6^څ@4u䖔,&:DhíƖ3zZE>iyi_ i!Iߏ@_ݴY#);4zvYQXZ[lMeUŵeOgt.թCe:Q/ Y&ԭ.Қ{k6 Pn,*G 69œa/W&'Nzd ;7۸3|n^gMSαQo7;a/1gN͌W090Pl7G֗[ioȒo1zSz*/&㓿6`ϛ?RfHzoPCVVa1Fp YZٱ% G?{QU(hgQ1"ZrܩTchO2i/PE2d["# ¯Qh5xDy8 sxqtS4L&&(͆YJQI튙7F?<: Uh}I&#~h{5BponrŸ`n}s ӛX&^m>ꡡ@VGN7-DZuj9Zߑv'KJδZ^~;yF?4hJ:إЬǍ^Bozu8}U*#?jWBG/1?-pMڀ6>qo0zvmG)+̸ (wE3zi[:]Ov> JQgOJCp >@X78D8Q-}8[_.rA|b}Tǿ^:iS.)FǽFhI6Yׄ#u*pQ>=IGt I%d0 %3Mբdڤ@,Y"7 vN`cV"*I3wp<*9Do d>˄vG>DQkMy@˨6&#Kw oR9KWHR<T?b1vx(^ux,QD%=p*ȇ%B*XCV KqP(~žOlb:uCtlf7.\OzxʑNV3YݠFj}k%/2Sg-:^Υ9SuY*jKVfYr"[ O 1 pS\ǧ͒v&i0ltΆދD!x5{D)ڦ$RJ7-9vj#JOC>OM7hk97fsAbZԡ4 8G F 徎|΄r/1b;i˯lL⋜mqqhBA9$ryjy#)BC^h< &*L8@#".mD⮁LEYz.GwmerVqNT:: 8 /&_-cmMll+JW"tzyT]TZJT GI]zI xح5߫ 7P!Z ⌮FrܚRlj0sQ5yHR?2s68mJ4D,WR1mS45=JiN(:uhv9jna0%eVkA)Fz{{0@3W rײ%}r*H·=hFɐ7usT Қ#Ϗ=1@d)n@Y \U{4+?,va9sYfᙅa9GG ;* j^b۲h-K}u+GRjAi17BjGSK, a憷>QtiKt4wt*S2~Y#}+s]sM.+|,odq?CYj609%li =sdf!@Rك9}wY.ďy4diwϰk.+NYl6+I4ZiFo#LH~t`fu2cUΫ<å[y,a=S=U4@*79bXi4;;sUmY]=eu8RR4^Նkg4LSN ӿ ,e2o1jn[?}$OR7aG XA9u(؎F-x E^~ǜVRd&Y,Dבafg[g˟Ϩ`Aܗ%dDS23 ̤<Ct''Hugek߮[ ZOշ+m8DV9qIA1 W/|$s\~ZUY`w .cw=MfRaHɓ9sF駗pX58>QW[?Sk2E^$03|[m dm$qCoɭr-l k N8h԰ |`Mcv:S |=4i8äJ(Ў$PZڢ` B2;lE)t{u^<]Nz6ٱy[_Q:[Xc3fkKChMMK3Ⱦf4.xOq귵e}[Q::bT<+=u.raOI5M/X G"_a5k=@']Q(Wni;]x'~Nw?[K> stream x\[suvU <.Ru/vV\v9-Ur"$AI}Υtb!)\\ޞoޞܟ7gz^":x*gg>r]_.*߼ت]) wAs|slZ͟=KFV659Y6oiD|]'<9d~9ϥaw9`Q b;xIYd0?s2>ja4`Iro9_A%ڰS6a]^m˳s|k.Oʩq_װX:>p<&$xնa[w7rΛn*uS k :" N6I:N`,gXҢ4PwB>yl܀hiB žPY/DjƇYwh i3,|ąl̷ˆ S[˩2m]f0iN,<$,韃ǦI&;ԙN>/d[m7OXa~W*dg=c2Xxvݢm݁PEWi /p}vP?ӁSe6F)s!& LѥnhةɢV=j3xr-bk]A;s&49mkТѯz[DFc*e{cEcMiAAp־kR sEàjÅ $UV4tK^{M3!t%-+}w8']3 Rց+wES5 pfm2R>E@e൧i5m,t{T1 (ffenO Χly1\+2UҿсA1o~X< yJܭS*Z>h|Gl REo-Sw S&Wc_awQ ْ^>hicޓ_B!}JYcd&[.6in֔A:o7'VdsKmEGD@J@  ]f:P8ALq!v1Ėɬvg9+bDSwh_K_ hjp}FD᧻aXָIE0m)xX+Kyp7yTnwoY >Qlo{xUfW[4cS/5uߡ,* ̠ka^&oQqHiûdZP53fNÿQ8cB !jVSɅcBR]īkHGy)%)++9wCJp7" ) jHA( cRCnyEV^4;pߗá>kѺ\=F ~P{к5I+^iOݡ;dx%}&D̬G.eQh7ބ tSq980~Wba8y 'T+vs:pbbI #~F-71AnU/Z=7B{+`Oe:<|_%q@_8G=d^ (hLV]-lD A]2~ [p/P9mҩ}-ESH{]vw,@AInY7hs^b))970}&iQI'- %̒@ g35YX)kEn?+_Ufa~"D|tvn̈~0;^hLq¿Eu95!,ǩ4 FVڬ8v L-E N|۽qoz `3>iI.ZbKpvi=[h0tWa@a6aD@3jowWNd~=|0iBN4 x`v6n$PmRb"^,ChcFbC<mu0b: .'<[hFO.p`2uͫ}P֨$JU0]~%O!yԇ\ VnPK#͋ =@Eς0ޙ>PfXb/R@=NyB\ۮ@wcqChOnH|ֹٹwH=$2G5z n FEh4|p{ڀ5)q@[@ԣzLoy{2E├4 isyj[~-Ӹ:Op*D8 }TI-'R)3 Ӂ.¹<)A[]\*KtC^6SkkX Db[M4L XoI-zݬUlfvu/X{Lpb g *ELל(՞텧7$fI0SL-BH?}K3 n7kc?zllpyefJQ6ra֘{n−#3լ[A 0_@f薹2|&3PjaGOSHñrL9立EE_i+a2PTD"F7r=l~J)vl%QpsX3lJ(/orr@sb0-' iLS-q(`%PZxᰕq)u^E#8; }3KqtFF6.;ۣ!T SG# hahyӢl_ )L"t̀l}#:iSk9֧и"55לjl%B!>ݛrJ)YIUlK=-L=vX›w ]Xrkn;:IIXͲ!±)g*A4Du7( ֽv9dX A/B+ltj,:`?"nɍ[kGysr# ? n/嫙W=g _><{#NZ³[s %J;3R'.xnMg4E[x*Ei?z!${W 3c֕>ov(ilat'?i4>̟9ifV.ߌ\TK?2 ZoⓕuYXӸCtKi9 @ӂIͺ %DFt&mV:ft sdGM15^hns]0 M]a8%5/.d'W' uk2`J X).rUYMbћW:0`aYM$X )d.ൡ1ױ:Bj6Fpɜ)+T-_wZ޿1O*;xc%K'S,}Z]<F!nGVd*4)hKg; ˎY&U{s")*Rs٤0 }[锧1Z G"l%qfVcݎգ]2^R\X#RеsbX$#M7x_AMށŖV˝dyYəcrT1]W@jh8'i$ۅ17d/g%K'XHD l^,[cv[ ߴyrxB>렪M~J`,E)2\c|DRÊz.[G{#\!) գàrZ^Hy CyKړljX^ Oo[::%. xtXb@A%Tr""e ͗ SjM/M 3v#ы^+'VN/Wϳ5h sځj7LC첫Njek͈Kgڊ$+"h?1m~E5j ߩہ* ;Sb˺kxX* o7\M]# I)J:yoOg @Fa@{(U Ӵˀm_+ f׃?dͯ@ی@;]fq197~h*>?T<>[09tr p.Q Ao }Asdr>!}@2,acd9\-9QY1@Zk=vhHt"P3yFIj%j 'qE.0UE7y+U57ӼeDաVyP V郆#KIi9)n 8y0f٨^⚻s']Xi#USQʓz3R2&VG2$?fM0 ~NvZEX뢞^jG rL ED,BU";7U8J춫5ԝd//C>3%y >ʦ^A[(!x+7GiIx$.bW UiĨq\츔"rZ9~;jFikOWz^)~c-ZD pZ*1;OgjTT t ] g7?D 3\qne2g07zuƫ|'ӽ밎 hg{ӅE0ਉȡ~|2$G3[HÕL UK(.N`Ccf5L]q~P?qmoЋ^x?u̻V<4 bzlBM]IYB烬q/\fcRVs|^YL0N}\pc܇TEWK;떔Os4@սOеKI ?+_Z^".y{n˵XzIK^˲OYL7n/Lj<vT|s ߋ] v ]\2[{ˏu|rJOm˛[Nǣ4nYCk];c(%E[dpНLy#=r*>fcD!ւgA0R^QI*_Ch@715@4mish.п6_u a<'S99l`^H@rFRLe69"gK#C<,n,^<_R2귬\oRp[h%vntyW㿖PVv_aq?}#ojo}Dc7ElʜHl?syݥ]9ʷj':X0 ͠XY*oIw)vicLg*wXo.-$,~7>]rg2e]:ѭj`z\\W'"PN\qDمa^y7+)UWqendstream endobj 250 0 obj << /Filter /FlateDecode /Length 5942 >> stream x\Isu? ]}PhƖ+b4&bC9)^fVˬ^0B/Jtr%/o߭^]ߟg2uUf p"ūU\y뻨l/^7U[;#_\}ݹTpƆFt:m>V‹K]XRcj}}Zw-."^ZPG| QtF:e>w4B6CW__tu_Z8o/ _HM.Zhӛ~m\޻h~Qwcr Vпoyk>P>/R8ʋ7{^2MU W]"¢BEb`JgƿZmE3ڿIh>j]齻"xe<%m g5#n9')<m8vwK+L^Sϲ S_ 58s[6 gz{<>nV q+sv `fmaClt` r`oؒ$xTh_y(QLRxRt1D~KeԹϳke WJ*7 mp%q&G ]V)J;sFu+;' :#"jTڊq@DwJvp6`D捄Y05heu[($- 4VJ@PC>z?"i[X6ԥL]#i؟fvr^DAt+f=mbz,Oy 05SdhQ61hcS;RTi:k&C{SVY_+tзIjl,,;aźyP+XrlZJbYLۼhbi7vXxOLQ)j`TS7!7oC{=~/ 6X줌{g0Y2i=144zgOK@1IN(ߝ)tY;W7g0*/oΞjE"aHc:TVXR G2b~Y5Ck9@RNI=!o߮Zr((/~WUkHJPb`l?yJ׭8VXp?~ТB?okZ(:M-q>ӇE+ нwQϭKB)pG \:YQ$gQgH$΁ d=mփ B #YtJ (}rWՋ1䮟4 ^RsTbɓ>,Z{BېN%d$AZ 6bBG@]Vc>FFB̘7Xhn _\x?Wf-MaKev4e:՞;t!,hur+>hsS އx%?I`*u8"$Em{k337dصZUK&Eް5̆d q7IOb.}vpҮߥ-d#1"\;Эd~^*/t;4r?rM]>e(,+gحy[u7I~A$Y(N#r!Fq&-Kb&?WRJ$}`ɩ$%‚B=W3eV02d%E Z%Z*RѾuY>`቉AE>`j~NEb<޹c_Ϸ ѡˑ9O\i8E܌ܒ C!r L wwnn4{% RAbM0GAH-uxp]0AQe,4VYHe$E0p)I:7l䯉if\M a*ٝh` @HmUi.oGqέpCsDrV%q m;IrM,%a09[_hI,vΓ7M8KMc[?ck+wuN3Nqe8$ l>udlD:d{C ]po$(A^G+gu&#N=5=45ftxWxԘ4N8*sq pxoE$O@-(@)aw`B;KVKKQSR!iT0 xJvtd[Z)tۙB5g7ÖY\bJ}( Tlh`ܐxh_vt}Q%)/PpA\2;[jP_J -\2x%$?jwsrA} j﨓~n-K{xz{v *5 &DE?1~Q /L5?KC;iw匞;mȩWN=2N&ѝo0%fA@`Z7JVaDŽR,Bk@'*UjCx (Ocj+,xN!<_'Iuh4*)hMOj3:{3`TNք;yQϦx,NսQj eϴs-UHyKss7,i>&4*T1Ŵ=Yy.="/)Mvu}?_%t,BjFUMBAs^tWcVV.idm ly/tB4%Y se4 )܄/^G`u{m՝#ZYgÑo25se~y-x"ʽ&n5jCz\֧mD(sҩnZ%q/&, w;|U^BNr!= ${*+FH9;ʕv^d>I(sO?&穨[XrT[3^>PWi82!QŲ('-U(h3c9 V5R)g,|]rT#YCg5"E8 _NOZ`̎t3z"Ȝ%i!aI|+9 y2~P΢stgv'Ƈ #cbXSأYY샯k"JSZs0LRAłySUHr*)(U1Nv9ÓaP2{5I18 qD2حCm\<|8M9 ;¦ %=He^r.4P{"eȫ^jqzOcGJF5@ׄ*CyNao-{3,aس)̟GL_鏒NȺi$?7Ņr8MӅ+$}CZ pkEt6"U+ 0QVjtB$|N2K&VXʮU9mvFxe_v<~N!,BS]%u۹.1d)Q*iXA$w} &n2PPF36&h=x}ɗ݄Q6i:5V05$9u t-4qjhR 6X2G)Ǘe3~W̫Ïydr jf"tئ^Jh6 1d\BQ#H^O lHI^ZB*%ɗ*ܲt_%'VDQt5"A僂2ݑ_A˲S$&cGB@6Fav,hܕc2ͻ;> R|{AY|WbسJRߦS6<3c@8=. g(A?6Iϗ ,A ׌L7SKRGS֋`5e5`<<I5i9e3ijQRnⳡb,_I0yyㄜU&6`MU9U{Ec0[۔6cH) r魅@l9ytd#Nq ),[I8=tY^V1cSnDȷ 1t43pM oҽzUOUv.eц/`Kj4-.]>^POu ۲wOn1 ?B 8@]clF-h8~r]Sm*OɴM〧1*E}Ds@cģjeH4c 0l-CP5\Uᘪj*O$y`|%-b"E&4=@n@B?B6$3Oc~LF<ѻr &Kی3QƘomY6XE9M0с2=&U-;X^||~跧.ȕל%/M"}q헓<`دaU<|qiR%aWХc?Gp ?wm.Auy>,c09!J1䧈aH7PLx q U+&ljy28qOr cINtie1)<(h1SV<"zm?=y;6OπMg#ȁ4VXeg1k3"tuT`8͸/8(%ɿ/p-^@pNtU#obN QahR /"USNKTݏxMCEZmSޓ`ci&6>@ܱZQZL?,J]Ѓ"ITJ/ y>s8:onl ;i6Ru*R&NH+'w$hrtۗ_GoR:Sb\|7.Y&~t)o+xgjӼ-g}v t" sSE)^'oN+!O11Rj0l8NXt~8-=Je\$ʐy*##T1"&> stream x][q3ؼ茧`'1l@(yr%-r͕lѿ>u^--zp/uo_~n7w_o^sh<\SscrJt7)pNy'7y҈X{qS>3%607\ȝM[8Ιf&L(q }w%'4:`1W].Xݻ8fgk:n/G%՘8 E|FCsLc_(T.L Ei+34m".J]]\%KsI^Y^/'쪞`ΒT{ fUUap? e0WBF>V1eNj>Uk=po&NCr'~p񝨬Z EXw%rP??c[Pʥ4Fݏĥ `+3ʾ@M)DЗ,;ҵYeAT[OKZs0u~FŕϧiNﳽsfz`Xn ?g.2>@`&w0E5f. sm?R&!gsgT9ҾU8P^VuukgƨWn(9=a7E*g4ci.Ra.ސI6k g2srsVkoyķ=/vk+<na7_}cw06 ` g'IC֝0뢙]_U9Wmy _lŷ[#,ֽJ8]_7mClɟuLFAye?))pY11;} ]!:|;\ 0ZV_e翑U\Һ@ )7x:xϞW/Wn οjW3Ig2~l '}N wx;ɝ3I;]s2uZ uxfGh~%KV=9%/ # %z; _D']h QZ|j#|q[:7'Ch+_چ"M=eK b4n6|Uڛ]5QZ]Gi+6pCF{DaP+*%q&&-9@.i 2&z#0e cC Y 9FD UMjFL݆3/Bsx͡w*#A3Jcs9(`ϨE$0[hYc!ƲI&RN-U%!UCٌ [ƢP O@Gj;-lBqQCSb)6UCTϣ~nBULXv^`|10A}8F0ѠDAMH~c4N#g1gw;u}ctt(uaBUH7+8BoD æzf ?-}o {f~y&zցʥz4ű`KlvX6\/E m* hDi$WPv:uj>HE RqhCNxUy {TplJ;O+s@}4El8HM*R~\`,S xɠ_ 3+|U >GyhD.,l>[gjr]0XHV[R/6ZVoЎ>T<,x\¬Jre.hG76@w Ƚ|㼎Ct\UXG&gu=HϡSL=9CǀsآϨ$>()Gk0[&6αqvBW3n_8[2(3) K3AsI3?!3#I4H4_{]/%l@  H-Dag@E $⏀@GUv g r/ Rs^B9%{69Dea11C& ףFT氶o҆3o*S_c =2BqtNqceAV9&@9',t'.$qu,~|hPhgT!F' oxŸ fŢSwdD/kz9t>X ^snėT'}D5Ot I62C MG$dl|כF=+"O7Îdм7l!}ݦY%pg{hJ+/zׯ%Ј8߃ÈaakgLG6JG26{CljQ4  [|#ѤeM Q "IRDڠ1lM|*`nqчJl̞m SaJ>)1&X@^1! '1ѝˬTα6OۢڨДnl]KU\-3/Du胵Nv3J6|#apl $L D3 `M >{.x=gLFK&iId}^l)`cPAVGE2w5@K~S+ k9fOMǞT:XYqT!/3";}u*;=\"f#LXd}ܡg՗֘erm::͢CC?K ;̩7'VI3O5 w}nmW$gŚ.ǎ%0K"u~{='{!cXl: >}YsŴT|raLY2MjAFb*JKEB3VeWAh‚c .R@b7?R]`RPE驚HakKZ9bc:S) 嘓:y,+S\uY!@@97X6V"Ѻ{`SPiw+p@gXfC+څY_r r:iAt3ny tNXׄʪ<{цD2= "O9bM 7 e̓&15c.-k4 "* d`{րZTE@{HcA>w<_PpTDdp9Q2c(uqtP Nsx4c RVDQ]NtPcggY8]iNI§ZBVó=2fSCBwf# "frn]e66n](M?Wu HȢ+1S AW3)u J"c~+Գ^++]=)knsE9'1ғ>_`"s%AъR1 83:ѣQ/cQ$GО%r\}#D:W1=#PɋLMR"k6%Ѝj͖q̶HxSp'ыdLPqz Gz:xVW~ Da.kϊ\n>٩ڳ*(XaE 4TC ?hLg! (7iTX=,|l*\\WY2i =*kNGrTW)c Ta@X'vc%2|1xkH,Uz[Ttpv itn"5./xn[> C0cۅg]5ACP(ž3N! f1t6t8.(aTC%ZQ ڈF$ޝ[!^z*d縧` QBIԄzC`Jw5L: |AK^ɜ/d >l-.#~yqV=At%B5-s[=${58×x4ty &aKMB09oqcU+!7餻!銝,F2`ɾ(FwDxLQB,Vw UZ5I?:.d8ZOEԭ([")y CApX;.mSvPBF]UG ~Ja89Ӡ-@ï#ջmOr"'U$w4*SۗlyCWƃ5Oƹu3f}E@pfD$d F׈$J5X{s6|@Ǣ;?pw d&N]s=1(J yk}e֦jfv8+jwP)B9]VfHW]-2Iɟ}2- bW|~bVb,؏McSЄXZO"QQjyс Ob2bꞖOuOI.6>^C/kFs*(d&N3T6'-QZsFK Dm>`5ĊNEøR8եv%7J޲ xA0dwAW'6zb yV*ϙEI>Ɖa1!D[92k~U'gE ,lM7fXB`F&֠ H E F%0^.>oUď|ZEJoC/ jo'xlUӞ<}m90\T\͆uOrM3򍝁:zWh҆Opd!4(gR`0͇fw]<\%TK 3U%JbK]}P iu1S2tST06^M@vDY?g:%]}%|ߖ*:stwͬJGXهW=9 &XEO?,N' %u|}Z䮘j-?}ݝm ?v<&\ff/S]D+by=X_?bd[x6hεIXS Kt?nC'.=n(i0 u˒[_|B[2$q!Xb_Gyϣ)M+@x+ũ@NNPCb5qVUꄯ}HQv@.]VbtÕ<uˁ"KRSgHM;J?8K?'eq8"2"Luڋ.N2JseK] 4J8>*z?Joh"qcbdee{!wu:v]0 rZB˾ *JѦM):O^Tl ~T.al'ڹ")s\)2_4/)lSfendstream endobj 252 0 obj << /Filter /FlateDecode /Length 7850 >> stream x]Ku>'KǿaJwiU YI9Nd;; 9ENS3$->PBs$R Ux\w_/^_W>/nG?>^]|ޘ!l/<{ğڋd/OO^=ڥ1wx>Oe_{spiS=_O <6yvџ֘hl_rn7LwM1'ݔw7a0N93uy3ϻ\ /<#&kɄxqKhiݑnda l;I" ϻszy7^rʓX]0tzE&Οh 3!#ҥO~{&aJywT.OHqx:8j/_!c·ilA^/ 1)_C|Xa`E'dRl3, ^N9S,k Y^o32L咣c|g:; J8awz B4/wWb7G|6-Pwdfwq`qrI47eNYE8hwyzwkgN+E"w'ŊeI>XEicC^W0|RBv;Dw;҇E#)Jʻ3(ly)X3/!.|m"SX[5KAθƗa "2wFReȳi_x%בARO/!Ke5@ݣV;)4OY0ל[nS1Y6{Vp|uz6w5ٖaIo- $5*ih~/D4>`6XrT, u 3׈^DBYN ` A {!! %+{-,`ԢdޢsbVV䚯y8pƉvd6,^$'xٌz0C/Jk['+P2C[ͅ`ƞd:l"\*pNCpzY(rN3a<ΆNO,i{|<<;d <<_ٜVh@<PFM`{c"C`8YO2*8H("'O;9lE|{}'wř {h9+|hc]FoفU Rۉ S5T(?fgBaV֏TXЂԁ$%fB0XJl4zMϚ7mӍsexLw_׫F+**͂vq!c*y{%@AomT^I{@U1Nk_ ߻Or(wz@U֓`M fȱxbWPyRG8( ȇcxX{ (=E.qGR7*p5Qz@3xi8~p3%.M%\li"CRRC$0 RǐL8;ńݥH4ꀾ1.G1y9l{O ׄ&Ɓ߭Be *|dT  c |fʚrw{4M,&zX'3Jy[Beq o^T9v+W@ Ɯ<(}>X aRPY>{PT5CN> )P!v*{~7ܶ':r` M2CqXt@kـ 8>1N5bG@}`NࠐHz:R3tNm|0R™7r9`bWf{Ӂ HSJthk`z});@Mg/ʿ=U^f5̙>-a}֨^.1x`|fe|کWɻ|uy=$G dN쨇gLƣ>MHD=od{.ɀ]/E: )?ǜyyo6O@*"Qr%xH\ M&c` !3q yp&!x9Y9\]c~hP=({XEl8w֤DaJO("9}Ia706(:)&qd [#6hr3?i n} g30A֋ ւ΅ Vγ15SΪ]4ܬ3*@  ~+,-8RЈ";N҂N!@oY0Qb e~r0Ix׶Uγ(y[(0 T^7>h8~|| =eW^Uɀ4}0\@T~u&*>ǸsT@WKIo/N=?k?OekQ /g62N( f__̪)`r+OCʴ2 "ҕbAS:5{ɱ+0Q@]hsHyKSQWLcOމY9߈x[m1TkHc4.O{g&'ᝈs("۶5~;0Ao3e8vq3*cð[")QMΙ5%eH_7JqR_],lFz%rΥ-{l Y4_yE҇gLũ_fHz"o,Y-;-,Wf7XZj.',eT(+6E,vρcO]e! j)L:q HToFR<9LNƩSxnOyh @$Iq5G-t]gsAUQ!j0i)&JKݯrPoRX*S3F+2l@]TSBI@˂cC1|Yd;R`,,)/d>um,H0yުRg !nTu(/N-qƠ㼻y4 "KK_߮+&ZPz`xi)&q Yq9P&Bu"}f9a~'rՐ#QW-VX(<J^|̒$,~{9.er]G_//Bg}q-뛴k'digKi0G%HA3Q%F=R ! OׁGUx`U%U'HM.ZBfuCzUb*ugľ>.8MS /`6wd;^FBw{`6TB J؃oܗW`ƪ/cf9yrБsZyϫfRx*->˲U=*gPEջۼ‰ |:wA])SW}I]z/أ| MJ:zLiIG+ӑ <&chWy{?$N%ó9OGd(%MJqW0Y7W*y^HH2Zqul ƫXaL5agϑGt"Z oi䟭 n .dRO WXv/maO G>^b^|`p P(9)) 3-n( uu'RG-5s]R1rT"įMP6["RvG`:GҁR-wEK~ʛt qh?pAVЗ0K%!{ xv!a:cIT%5" Mppjʭ)YYXQ%tglg)BD]s_ KlQ^MHKxqR AԘ.urTeM]i4s5rII}H}ɫi(E@[ 7 E)MEf SKW $Wˊj~N9Oi3 LdWdYnxA!ʛ|U8"E!s _- fg&jeT+; 88vY$;Z꥓KMg*J3B69NK2*۝< Υ*~cG#o 39;.ŧ*:30f^U2YK{[A2ެO]F1m׈h: rnoջ؃mtT~a;|_.g/) Xr:/z4~x2U_&BK/9x#W:ES51/w(kEsmA _Z8v5 /n?;R$ Js/U=99zB_E3SǓ P]*'-/vP~ ]   8.-Jr}Sm+ +7z"Y ߔCN l| i JtO"^eM"}'l r@G pVCa3p%,7fv1:\T3cmĬ(RrTVP޸0-:]\ņrxB)|KTc؏@L/ZqUg?xѢV/6mO7fe`g9|]yɭ":+Vgڝ鍤bG CW *fcU]8p}~ٲvUWZW]0v3tO'Df%tNhN2L]*=|Oe% 3$J|\ǻ28م%1~e[9qyQv kAxmͺN3tm3۴.+ rvt>͗fa-jEU)\lMWUm/ pr(՝H'Q$uאOKED]z7'U"=д:jFCP=&^}%nfuKe3֕7<[4 ]5%6D7h;1WˎRztW2> ոȌ?G*o\7vz̅+ ӆcBt+%c{OVjPxz\cRUa,kJ~cDQ,^9igÿF fmtS`*^{]hobQB;n}΂I[Y>ET멖X_iU+/Sja^m9ĩ=ALX/jiU7m7de (/{8|l(J= >C5*ݠYhu*v.s u{3E)|ӮZe6gx( ;A(^2BSE׺kc#5MȔM,wOrߴbTxs3'I26~*GCqm9֩Ռ\w'@#֍lG@~endstream endobj 253 0 obj << /Filter /FlateDecode /Length 7119 >> stream x][qv7'˜]~c*IlUICjECqI]ӗ{򃏰\zui4WO~yp7wO'=1׋_])<<Tӯ0.RHcq'_yF7i Ë4Kl䇯Y(%%;åsNçGZifr1+م8~Gqc/o '+LvzC&_:_,s}leOM)&e~gB|'O;aE l/t` S`6aKh%4388Ƀr.KpXO 'ޛK#>r%jJGg|VuzGty*Í'}, +]#GEvbYs&`)04Y8Rg`y)9W]gb&*ʵ2,9X\FfH˙/gd1ci`MʒZt)1DkkXJ $sL E1;)R ?Y9 !/D1NAy|zN ݄8srF/!a2Iۓb %Z#l@-R!ë$&B'ʷه_/# _LNO7saRCQ0Ҹ1y *xpbiFHz`mw*㉉jV);~϶qG7rRiq`OI -Ajw(N< xT [úIy xTrhpS_ ':aoq ȁ)yً3.uŋNR=SIh8ބVÞuH~lrIvW;`3~*P:o8 $ꅕ@ % ~]T3,;Ct_<`M,KcLX1:Z47/2:ſV+4~0%J0dB_:E5g3MBrژ9!0IU};34n1Z! f<3Y<xߗ2ŭFp}Blb/Y;ظ s9'=S=o{ׇgUDEK.|aK{0R~:Mx]K(b %u.tn7`2VЭ/"u*Y hp4@;+AwC0nĆѴI+yO24z*/h/3d#DlIi*DPآTcg&9/Ej^nӉ"\[ C?΃]v<;>S?x_,bEĽx/W$_̙hEьAqHOa>&$e0H چYF$ X]P:x^+^>3ÝIxz2"; TEpDdx|98f~2ÔGa\%7 ϝ8¸b0؈atp8έo??`:M,~No GxI "wwU+r7=?+Yc.[XGB)QH\9YT"m5h+@\Ld0NFcGHݿ ƼXT7, rؙR5:kD{uQvRwu*`di-ۉ%?|SiQ+ƛrBTmUt7bDY-󻻕22ARpz vZ IU) G)@HFʺ-yqt{ܒ)`] Ÿ87a.`^TL=<bNyHtA頏L]3VΰG7<0)n6x 8/ʈBpR,jS`XݞSN=-MHk~;sYu7"6a5BgHѨР\⼜\4L:#*( Q9:iYֺ9H>sTLg#*й3FqLd g6 Ϟ)΁*(~%>@g]-29B){EDX1`@y"[^Ӝ!yO~wh(W gV&3"7e" ߆lV5] _H,Bjj l+6Pl]M]駫6wħZ:׀Kl,z$pm.C~U,eB(ÛZ׹1)k9 :' "w\WV&i9­^$ C5H5;䮱-"ı*%apH'4aEJ f@y:u@}Z"*uة c6r+g;=DƷh$3,LT~kqJĊ|9πťuP <LGDE؛uoښV 0`'C؁:o>v^Ly], Yp;Ek5pwuWZXG77çRX0&*3xKcTu,SS-h( ȹ)߾5`իVlke>A "-{ `4R).|Tz_C^c1C"GITm3=~љ]'}ɩ(l߮?ׁkdnd}Y֜uյMX4aُ[Y$x4 R^/>1;:.}D{_"{:jwIeh0mNڧW@lܜDp LU%dSC*v8lN4rT9B&; c׺.|9^ch,zjA3-=߽i{hLڟ!xw|:C(&hyf~3:(|0Ҩɚ)aŐ w%͓L.(ؒ/2Rt2M8){q[e#C^5%EwԶ){Cؼjo;UVtw IW>[\p|FE *lhCoGj@_Ի]gY C3\DEe!ydxoUT}L)t7B>Qn]W:E}# ‚;;|RGޞۃnC$u5ֆHi|ip0oɨ[uU8qrB`4^a1}bܩFgb";+6zobr|!ROqocNfXr23u(l[ZF81KY{U,&=iԕQ3AicBۤ-WcYX"TWbN_|)KEzKfvr<_x{YG~!* ͈*/~Nb=V/w:?c'Jsi@IhƘ:\%^W0u7}*Q8ȫ:Wly:<;"JIs)Tt} ,V+"ùeLlJMwNlNtE䊪XpJ1󙛰 #Zvҝqܵ n-4ON>\ܮ٦K/On+?kS }3Y]jfP]iʃ:=;ĄѶV^,W_lm%}#g"A/!Hսt׮׷Pmfpet^{YɡA66e^ߑܹT,0cXcg.r#,7^9xtˇK#9N#oGnJ[OᙳąƏ!89_ާ8pPRt| ˸++p}Mrێ^,:fu9%ɷ6nK#,o]K4X'>݁JxfϸF/Ōşg{zŊѴ%*ޢyU^ v{89>2*ob9kFߵΕ8g/ d[ٚ'r)+!V`W3R~Ɔei] ,$4}!#S\\Z3];,m;QHa2e۾QˏRε@rui@|~W0Ww[et](Ao69w%!,$VTR,Z;:x=-2 ,I rfauj8q:@](uQ!ɉd&(=:ħbum l6*د> stream x]I7v'|Uu>hƞšE}f^H)~ xBVHTF"=@o6j_ޝo7739{s鯛˻.`D'SVYo.^z&8e7wg[vuRvٷ?dRp>mwj9YXC?RQ+ i{}1Z;)q#!wbS _T9Ng|/~Y/G\;׋ggLWrqci̤BFb~=~(erw˦)4́t_-Ν 1| jBKajB O߉MtӺb)wo v]'8V2 pD%)>>AQ B@$DBS3Zꨖ4LgMṂـ2GEdn'$E7Y测s Noλ^F pV Z/y"^9xT"ca:\㠭Y()PIA1Os 4[%=kwГ>ͣ42 Lo7\gisS֝zY\Zۺ0Psx l5700!DC7۾\2|$LFj_XSvp3 pi'MD2E\AٕnnqFTѿ֡sQ44+: URh<&꧲ $}|*@NtYY}eh VBiʀoBmm̟5_lh%uŜCK|=z- 7Y+aH{7m [S~F ۇWsY|ԥ}֥T^Pd#w3 3E3  Ps9o"z+a;7kG@ -MFdΤ8YkrE n2CR>94A r!V~bf~̂e ޥmue *,L:مx{[uȥ0mcMWj?StP!`k9Fc !z:d|jubX|ׯ"Шu?~WZ&EYgm=hs45^*^X t5 $A4]@ o6'+1-@~n:[䇴B Ě-,T/԰ڬNׂLF`$`%,C.j_=&m}ȆP [u3#ɼ$_E q:Z%R<׍fԲ R {\`b)< b)윤~>!C7d{GKn_^z[˖pHd2q+@C#l97|pþ-!K)JQи^s}|8| Beш8{mY&'1b?=';@~v)!@ޓ nrU 8fPJVG (oI^a* }< 'bfLfNiAH*sIFGI! .HsdC^*9c5v(,K)bչ~s=]5E̕+޷^G#i]fg:#O11|'K_'U>!y#}$V~nbQp?$9^橷жk(Y!yvzPV OH!+`y(rȝT\u5e F9JuyĤE'8 gS|bUb LHT*=Bt8T`66v {7_][ci v@ 0))0{Ɂ8;3.E\/-^= |xOs[zdh1х y՟FhmϛkCdBYcRIOWPnqGs6my+88hrƄ.Afy+ndP#wj = 5R23.HȖ!ދu[ }s_%;yJ!o =98#T=sP{+h g`Wt+>25pI$b&ނջ C]SĈDj;uT;Qx5Xhɝn(Kg;Ɗ ,4|69 d%{ű/'9용9Q6$)s2{ZK\lTTzV7(q,^DqCJX nƿe1}ZXtrߝP8tvjome9h}PZm#xc彿\4ޑ .]a!&DP"C.InRCǃ_um^rGA%>vݍ%@&K}FQv 8%"Py;_[q+Ru$czE"R~g# XHʁ]пQLNwЅf}D-Dݧd(]Ÿ+">`q/cQPc oےx׹Sf/edfW+ {,H,f U'9(+.NvnaީXѴ).IS4萦b+8üIcx< `<ӛYe3cK.2❦W07\)\l΁lRj.Bj0W+v 1MΛpn~E#İg@4B:i[ܞ=_F3F 6f9Tj%UJHUwzqn,$:a~K*J{k=45Zz1#Fw[v1^'@`lJ^~eφzH;Vѩdϡ?{~3`ZDԞͩa@* ]r, goŊ'"q4Q61˹\袠 0_dلi(Ky=eCf W#2XD ɬDL2ITip?DMu_B}Jk= G/ D]͏OۈjB~rd<&}-LISoosmؠV9Jq]E ӝi*tzcynQNl_\vDU%vo/=@iۣ΀"9/bX9rMϊXezMJt8(NX$KY(I%k")'MC8MnJ!&爨JJg!QRrD \5#4-R"y4}MpEqWƪӯRxFllS~AV{ {/O$AߋXL6R_0B%{݁gl+D*a*TD( Os+l_ͩ:Yi:%O4NE%AvpV06+<"z|aغ q pǂ:%u.ӄv5gn_s ^ .hMEvp2o֖ e+TȆ^ji_J AJO952*n<lS` .WM(/Z[EwO2_7sgZ9\sYsh1$׵WV jyQo/\#|ig~9XXI' S0pVԎ+xxuDkEP? r2\W]D,W=]Ѳ,>9w;[ڮb6<-|SΫ,;Rk'5O?cZ'X1;!cZ oǥ:18;Yi-]ƅrbv]*e]ikKGd"Owoiԃ(/J7,V4sK鏳XRwh^GXW94ueҬCyj;rVzI)\<4;N ?:@S*aMrmPJK0]6JVMwO)zQʍ?L9%@CVrbsR/o$0+PI _2yz~(=8[n&͞,3png^{6L2zyO=L Vo.{ }>GHr[)DtsWO oSҔ*-ς}bEFAqEh9`&bZδ|̲LJ,0>erꨫLj{ ~s}WM(}qż5f]m.brl *NCuQ*DZLwI~Ne Q=ѥ~RW$5/J]pv;kV]?`NEVOY9-|TwjvKUJU y|m>4'h^Gy!)3NdupS޺d<XT)牾k9-/cXi5( E"d:mccs?||h?-j is_Me!X|Nƍ}C]j%+/ i>tݝos0喳RDyV8q̜Wsۗ2ڵ+I2N =翎Ra7G^7Iwt^I4VVl,I)Ȥrs׏h⭮V‰95wD:~j5FOO!>u5jBd細dxyf"-.H$u:xBͣdP,oҔXj?0 81ץW)5e$_eLj_׏uKU+NQ 0u1ۡ3ׄW&e hvy_VwA0&GE`.zL~>W)V`nȚ1Ug<5i<*ᾤ 昬?EzP.=}U[LØOT3h}~2u]y j}TGwCw8¦&Ŏv` ,+ܹ=Rj;yt+`>?Ff 7/`endstream endobj 255 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5604 >> stream xXTT־+"UzbÎ%Q,D e@Jf6ҥW2( &{y1ER䭼Ţឳ}>L&c-r:Mq8L&#I}k8hMXGW M_ò:dwx{[g>zDiVV }H?@NR~4j$.\8=P7\H= nZmZ;1Rbe8I>F{D<ȑ&COaizH'C9p!v9E,X)h̋3T3UI٨r 8D/۠'̝GJ ϶&h\/8ˏv.U/ZDG?YYJUu.rg!3\m6-u]L*8} ml*MĎ 1b8lʷd*9c$B>Sqoq@d O 7(ˎ/ап67 Gx=JKpE)eBLiwt!5XX`Fd2$.8C5 &hT7&5X2 ^p l={ps Y͂\A["8Z'mJa2us1(L~H;zPf_ו؈MGaOLŎ+UVzs^p8֫zY-i0L^IʋOq<yXRލ[<. 8i% <6 #"oFƶSd۟j$s#[OZ;>=>{+|[ NJ7EkZ vEsYœlfqV,q cZ)pVkVaa4NCg^x]1et+싎pEQY+ljxi>Er]tR CEw03XquN45^=Wbq>_ {WHJOL/ؙ/dț806QYKHc{ BW<J4)@rlghD8X|}(3Z.ܭ -R{^:NrB)ӗhL Z4ypҋz`S"Pm.»Z -F;B#}ba-Xt=1H69-̢7Cb˹?&O"r-!PGf92n@oI+[&S;V+gͿ΢YKylԾY`biPK)|(' U ʣ5޻kio;m1GJfmÙcT9-1a%E߉?|tQ3l `mNӖoX;O+troV|9pT ivQ>Rw-:^V&*Ne^S[,"4R'cb44-vEщQBy,$tmJM.4rR_--D0)mJ24ؗύ=MTkwPѡNh4j299r/pZ6}=YJK=Z2(OilB:$^<KBݓf5IPM8pA*En{AT4M q+~Sf?k:H)VTi_@=]/ӗzɆ@,ĆP'C؏zEZ.Y9t8",0lV]ւr)HmMoo%OQ qdpVCs$64oNoF3źʍ,"Kd]xw#ޓ/SZ֨=ۑ^MNNh@j|>/Oʚ[[H^d1np{!a&92A{m1Z* M)GK)=dM;6t w?y !$ c;qGsb2G tH¯Un8LunkrFeu>Tێɵbd=kM:<I7` L _ ͜ǵ6leuAEZ69u\H^yťu*5ˑEXRlfOeDXqU= vAW{rMu@Tq;$2 e_:?>>q>~lnʳĉy-rM6^9'ТN/|8:Y+6n::SlyÖ}%z. 9Y*d.1N58&NAj/S}-dpHiY%@9eʮOc$y2(>LP)hS>;=wnȜEN}8윬%[J}78@PPV$%%$QCV1#ΤVǿ 7@Y'VqTa4\L(B{nmo}5w||;yzٲ{06څ8q%noq4c+외O"ei'&2vs;ulp Q07.e+5Jr>'S_+j&jg??)g&S/>:q_ Jb`m?{=(ߒ!47]toVw{V4$uB2C%=>Az)NNj p5ӮՆ*q<^?O:tߡa.}(syzXUQUJSmtQ5$[lv0^M. b"XtI6%;SkhO .dUyx*+k]+|ˌfb?!DYȈNq*eŐGC VqSuemG/QА\vqUAuu-v|&y̛G4S"BW;sJx?)s@Ow| sZœRJ<4R Yzʦ "(m@:G9+P_+Jλ*`ޞpSa3 2+dd 8) .溣@;ҫ1g)-DF̖j-Wn ty怦hMeo:|h9Onu WH߷xh6gNbKn?q;chtF?KRo R {fAP^Z u\îr^ۗq|NNs {0nI' иuQl-o],_ځr8h+i(kgHoy^vb4(1yC^gruto.L:G꼻Wb>|7 ;@e#2ƝSG.v N#)3?>\)D'F/ɋ1MP{WI*:M*gܲI x7v:ux7VQmp{Ivl`F(',1[elr)& A{Kendstream endobj 256 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2148 >> stream xyPgƻnA7v<=EK4&&(x1!01\DwӋCnFDѨx]SjJ 5}6xvVWuuW}}{hֆiqSs^2,~@m2 ~Csv3(ukfx<:<2m>&wX=1p%iMa7mLJ\DXN17xy KPVEj@]::P'D)i#ԺU:]ŋF/ƅ}6o")BتW%CZN)0ZsMS)u(^%$#mZ6SjvP;uzʝ򠜩ϩ/(OjRRO/Ѡlh.ld|+[%ΰ-/L$m3_bxL?G]8ߋIdn6k+ɰS"'*gjv.϶zEœY.TfcO_z dZt=N8I&FǙ.4/^J_pʳǨH,Q>v>STv,tB(h`gzDzH. 8Ê3 XhtV'ݙ3ڀñ?=ďiџAM%#-Cs ᣿mCk[jd"DsǞ3rqkz2D {* )@5%544UZ ʇ9I4Aڻī&--|F+_q}:^oݏYYhD:R` 8ܣY8`:h؂4HGkwh ^hE,S[? Sk Iig1L\:bxqG&Z*5%2ʼBj}7Xa _Dha9+MiF*A%GrM mpJiIB-B7KfexY\H;:7֮"S/! 2wiF-9~S #I ^k! NDs*̸);GZNoֿ5(7822,q5:ڏշȃXUuaZM͗mi-+YWJ[OXk:̩uj k4Rq因x)磆)0? 1d1]}9Ni]?U%C~},y-R={ͶK>%:ÐdP, VZyBV50C;2ONӅ*5TAS aӲ$.lό ~kF]]+E2:5ŞPUXb4;bNpK1%’y}sqRjkOWWDyZ-nɣsB!L#dnVnOgηo"2 'mP<]$й?d߮NpJ6Gm ޥ y_H_]{KH0B7>%pox޽-I. L \қG7RN/Y_:4(GbbBNmd '3$Te_H8=IV' 8" ?m6zfcxJpH;LocZCP-(Lˋ8iⱧ=t 3BnjorSB<ޠgɆ& DigeЦ8 4ӓ3\gt4a+-(8+3JQ|z5€!OiwJcp ]e2u )?rKrVѽƖ帄o]-`j Y.aO;fzt1>Dh-njq+O:^!D.BֱHںV؏#b?h@QPendstream endobj 257 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 8938 >> stream xztSWz+/hNTpoݖr$"˖llB `:PNH 0 Ϲ̿m̟5兤W9g}OgJ 8eS~P~ ~'Z X`w;hE>?:}BŁA!Æv3dʜ9:y! =Bv YF #,raaAM>?tb`c =dGG!K†ubYDŁA0!k=B{xMQn_cI!KC-س2eUH5Qk=yq&;~[oׄ艓'O:ma3g =G0z؝zcMQèuj8zAmާޥ6R#M(j35P[VjZDS j 5I}HMRej95ZAMVRөU j55ZC͢R$ʟGPPT &OPb-ަ©-ՃޡR((MzS}T_Zނ>Rc'#xû'zyjUh(ѭVע^~RU}[N| ٛ ߣ?oʦU<~oeWmdc'[owM>c'+zAmB!?}5ʈhPSb[׶bՌ]ٯmjG7C:MF+9X!4 v tWaCVHzflYdo[aȚoo*5ؠWǕ⃨zRQɅ5ǴPAepPV?^;uBFcBkG`k-oECeV~KV&AyF!?E.C;vP7ݬ6H! TdyE*]J&Ah1E~F5UB@llk$ؑiZu'AiY.MT%C.5# Ch*N*t PA4\zu׉ AIcb۷_2& <@g/z1@̣t60=eՎYX(*}^r"`tu+ʼ$'/.ԏ$BvO970Waq*N*z։˗l3Bb+eF~AP<ȇEozcP/o؁uҠC!<4@(?Pypi3 g@RR'Sv`^W =|$ϦɻMDAT0"\&S%x.+G٠4RcAD{B ҸX UL_LYa0_tW5&U0evRSͩo}q)5L<EEdCF j. 2 YE$Qں<۾гaq`'~xv&n[Lhk 1ڼ  ?G %0ZI"0{5m c7\:Nn oc=%)\pBcGs4l}8k%H[ 3<&#(b3rWL¹"ZEȪMn6Eaׁe$4(xQ[$b^ -nO*;ַgnv#E֣x K[Zlؒf<ˆu^;ƒ6nIŗwt1\o*$ u<򧥴d+8 ̰mHĐ \jFX<@ih\o0>F4sӷNK A#ghm;VCR'- HR~;SbD!2,l}V&@B,a@$8nZ~uգ[}9zXbƑ-#&am4ahz*A&:xYZN`&4PḽvķXgCHMPgh8̝lǡ4T uI W]MCz R?xV8nJ B̑yNfgC>Bư#w5(GbfۼY^?y` 9Rm(HIhJJ8%\K vCM|ħ=%̗M9μS_H4Yr{bqbJ#_M-ڟ vx-b삦ihDsV=KzVfD(Єf?^A.Gh GCD9C(縚o\ wtRyto!ΛУggXfw->jʫ7%%aI!a5 T)qqhTU@e=TQ5B*;.M1؎G\3:-3B2mbuIE\'8zVr$B6B249D5y57m/ ̜+QUܔ]Iev*oS~\`wVpb{r#7K3h6;x'[9!?Ţhafcj8XKawNDNHHJƗp-?h4b#XK ߝH5z%{i{ؓ<ͣ$5BԌٚ}WZ aW"ou¢TG\OtB\|dH#t%~IޡءKpţ;1_lONb]OƦ1{yKpՊ :(9>f_B0Oca>%IڔDb#zWmN fjy"4@w ,du@Q CC=}С8)ߣQIФlvw|[ҡҺ 9>9z 8`7TU͉/ȟl%X6I j doEs'N.D=>cmuQ z{n0PqYM/( bQ. ekekAS]-y>/}n3`C<M(ѴoD~V[GIy 0WCN IxGH:,muKͨ|W^ ~>ײx9O䄁 i՜ЖN EZD}* ) MUZ2JۤU6*/\G?,~˴zmvL4rtbb;) f@l7f4}mD9~4L.'ϐ! tAީ ްSAliva%!}%{]DNqd7U+/mJlNa7VV_tA=6ui0yIJJWuśxyhfHЮS/|9g+@F_Q!@P}pMPu=2G6+Z4G~{(#U=x!m؉U*{#+w?iHs*y D3>q%ee5g7.lA}--/݃چuҰC[ܼ# s39JQǮ \ ɪLr"-D)2K^$缘DgV{ PkZ|W‡0,4\FL,!y١YX%* "3cQuͿo>B4=Ńݞ:~,Fк3T,Dh{o ]^!(5t(l+WB8OMz)~_29YXEBuQJ]*;YVbN~jv#WCQ[S5a3 M9ʌF^Xkީ1))qu++̫m (wFYrƮo:X:wijP}b8ӑKy NWmvܭ Q'CUɐNVC#2; ߸l 4yAYoI} }@og+Y5_}{xig;&ޅd-a4nV =fFc+R]&QNDyMI(EHz|VЀ6GiB#.S;8kzWyʴd ) ve8&T$L$EK:3T.=hBO;lgĿ.%3x#G'X^eN5XS"1?|f sC}?Ŀ #\Angh4h!V᛼xI|C94Kaej&yܟ|2@܁l=&J͆c. c 5YM>1%_1K!%牧~cxn ɠ>& "](fn׾xRx֘bOFNnQ2~T,3Y2X!֠S0!"J0B^nFm#tɢbg %.)Cp0;FIe|l11zG՘{s`xHc&F v٠K1Mx&_N"aPŁG۳]^(bzŭ7\bO%ӓGpbֱՁˉo 1rCM~nh"JW53\XƼnႭsf,ڋ\IӇes!W>EO DX_ ߵ!^7;Y]d -F'/?9bG|Iӗn̹:r ɉ>-egl4 p{込z"v9]cqD[s?p!$ }-~!djaro.bU7컻!M  ffX6L@*4Z컀ѹ*ajԏU]CǛ/tY0{r2guo2F$$c9o+ ~OK,<%}qTnX]A`o7>?lG\8}tx6 ͵`j{C9YC5% [=Wm\'m8f'AvhbTabt-(>b%߈b# < $x M㯢o5=$"Ddn=ƛNU+2p'&l$wg!Nfz&G6h C^E:y”eXۆ{c!q rp~l`Su.ɵ[2o3ZޘI0rBNRIѧ4{%Mlי4y"=e$>C=r }Z_#zOx+l(azܔLSꔙ(22%x%$TvydDsX8}`U-KÜV7@vѲ8YjRQ ]%+"o: >`W8Mh&ֱc5&`]6Czo,'(p~7"q-CIx8Drѱ8D("z(ɷlF|jzymR>d V%D+6(飃_kB '`;,ƒ,=;vg&rPf$T3tU/.J 747 b\|Rf84MdyC%/$@A0W߳=n5Wui<>MOԨS0RՒ:1V{CnG˛\Nd6wWs>B^%O4]܁Py|"#],&' 9;HVwոPL> stream xEU Pg0ݭ" cQ<8h0FjE Sppf 7*9Dhp=1&ebbYuM̚kSm0VWQ{;{2-J&1k e[9-w*P㼖M6XҢ~ q2d1Icb#.j7EyGGE%F%Jc#BKcϝ2'(*aNL|RWuJDbzchBh|rh7&:Q6(*T91QI51!EqV'$ ?mw.򠨩5HS͔MvP5eC) GMRI!!se"oobv#LsMe9*iLY V9xR.Fs9'ai8Dm.d f55C;\3FƂrQu*N#ɐ'b$4iVTz$8 NK0hl-k((F`:HvC,)rZL$4ܦx {t#'f0\':7[٥ )Fk}Rip̯1I+bSz`D"ZŻS-/.uڋ$GA%74@(6p/ƒȑ!/ N@GsxPsȲD[X+"YߑRkӆi[3q N tr]cé_ .٦ząZ,q>ïQ)![}5LM|Mh+>XQ8meHD+[e7G*8Oan@ܐ"M=7[9o0C4%榭%pmӚ-6mglfa(pjEo*:`^uzH *Ë"eTm{r~ҲߕWC& MT %&8\SO:v7B"߯*v@G -IFCWw5_dBYc65i 85G 6۴ਥh:&q^4gAj*Hf`ge#:`Wk斺RL|cqwZK^|cg}ƹ2fC W/mj)f01-Yj238aDz&0}WʾҾ#T'dJۢRbrBdkoe` X l QEٙ >riaRm8C6lb/8KK'C.Co ~ CXbSȖTe4>+[#5@2 Щ ȵ*UR|-̲K.nVLPeB?$B_4_=MZC]R%x:1}-;4?lnv>/-U|h.? u5x~b_&SqՈU 9| =+vq5uG;T}O@Y|$`'#w'qE

0?՟{~p>+phVyԚ]G?w`kՙQC4¹Zf9sǠ<.GrC2)Z\6^aJÜ+x }΍ f#IpU*4.%wU2Hv ]!ML8׸hh8vBБB e~>+Td' ʖtNKj٨hSmzq6+)sP;}YRpL)z'E1CF6O=7;XhF6߬?Uq޽(-W;9d<&[t'2R7;K:QmLڢ &,` 9*-mˬcRy'=/p" fSS [s.B+_ϏJ5R!0òhoa麮 %'P uaiFǴ7h'"^,){WpK׷8 ՎdJ9$Y:ȓ|m#-,Z_.?eNܑN,FkMa\y%D NEɅ2}9I4bVV*RM+g o2(>"}0[["}Qwsqкό/۫XS噄W$rgD +0ST3U͞Nl I FK;,x'SIenK{8WgZC{aDf,r*eXW^A%01hE:J,-nkH"> stream xcd`ab`dddw 641~H3a!O/VY~'YMzxyyX~/=[{TfFʢdMCKKs#KԢ<Ē 'G!8?93RA&J_\/1X/(NSG<$C!(8,5E-?D/17UR=土[PZZZ`d{N|q00~Ksp跲ֿ^_n=E'l~];\| pBIOpb1y4^7}endstream endobj 260 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 8129 >> stream xz xSvBl8 V9edP2e.y<9+I35tn:R jKAAw{_<}Ҧ'{}:rrWoھ~ I\a3HlA2 U=a4F?1 $Ƨ*W'd&EED pٲs}-XwelXRTHP裂ȰؠGLY/G$,A"^=7=*%wkXrXRZXq)oņmt؄Ԕ$MaIqoeܪ k^O^.u}چodl }3?|sĖȭQn3V:z<,\%K_\|٣8)Tf4tV 6Lv,lNNY.*\nj<|^9uEŜ 99/p,l,Qpb9s9'8Orpr|88DgNyn>~X/Ocfo_>H%H%OĴ'Z ~wL؝>>Lt0nO~1i?}gטg}}&|rdԩ_LK>qzՌ3ft53xV qʹ}v%|5PY] pAzFO5@C 2Dvs;exWz4P& i>Vh7A 6[@FNIBh*yJ| >䢈~ji0; N荛@um:GCI6ҨuǿjFy PJ@ /*ΫU1;cKܳlVjHOfH6灹`pҫe'\@@LЈiJPf./Yim$k,{1+`CVh [|#@޵| R6_\_d$p6(sBt1' {-JR MA^mg/%Ocd *jB񿲼8祩xFtUZK+'O3 z ȅg؂k=5xi?pu6Ngڿ(y..o !`\ʨujo x7q0ƩX_4DEARB+/t;hʹj6\г'A˸0Jrir"ӅzN(bP=C4L-o4BA oĻg3 kVu)BH{'T@gRsh<*n##M =`2 .OxEI-P?,mAPJES |Wqkj x8d&g뚠3(x? q.{3` V/-{<<3thcBBY^Q/]XVZLMՇh&C$o}QzTKDyqZF"0ZN 55s6^ERhrHAK)%ނ x1٣ώwy}ƿl%(ي8t:h)iX&ci.6J:0_  hTtƚ@-#G!G5 :6ѫ98 А[j+Fi g!Sb^PAfSMCI6_f*Е[EuEO uP.iAMI5ç68;UDNoSf$Kb{̅Il_i+#',,)G%Uf,`{^3׈Hm_@6g m yjX9ĴS;t1Q7Q9 bU`+cn\h؛>hK~T;脗n1'p LRވќ6ي`;}%TU۵PQ$YJj;# }~W.8-Lu!֡0ҘTJmsQ$>B216~ ZĠ">uN]e -# ˾`2zƞpF]hu9!vƒ|~ :95aS3^귝(ZaIQm4fxe홐 T܇^؏hr'e> Ĕ,ŝ~A\whks7~!lQ5ɍG%4, oO胳pˇ|8MZ!$zJVpj@t[@u]řN 8e퐗Ts%~?C>cOkZoeT3VFΌI?w!χuYEA/Ƃ:}xWYvK͐gʪ1+4HҦ@$̮73|5!̬l'Bh.eZ4g-٠#RK]U!8ljҎ{tҖ[DX;0HR1!2gmx=}qAIG_ܒ 9zv- ;Plfj?=ud鞜pFmH{ Y 6{5Q5iIRR#)ǛJ'd5@}{=U0"5 OU9:m͌H9[Sڷ XL="~whUIajzezQ)j%g 2z<„KC#4mâҢh `ō.{K=3*0׷5eBl>[,y72B o26xlk|'(z"rgJ:zQ 7AEow;i2ؿ܋/zghF<6M2B1U!rdJCU:~ŷhtOq͓CLU7 rnj8ص*-%r*km'[7>?g_ By4Y@H:{̡=-G S?JХ^0 EUA&2jY@ c |3csWB9*lA!;+G&҉۶]IܮN$њKVm'dIE _7Mܽ7*AdMHsA P뭶:шS]g~GnlWBmIPWʼnvKK\O# 4XP|S2JZGC)Ɲ1JؙS:[:QR7NlXo #Ȭg@Vᒷ~/lD=xߜmZs*KpH u)Hj`o~ /KlmyG)D/~k2!j2^ZSkpѬٰ{zv8<,iTg!X]|"o/GS#pf-Zԇe Qt#mrLK ~ҢVC$QZ Tj32xvEZNA:AYsjpt HWkR5Puo963FuȤ44!HFQbP㱮3VzOug>:}2{vYEAD5ֺXXyz]ddl ilrqLmVHK`3Zɣʀg߱۝|/).ש[^ch\XhX#iĐA>{UgHjTTeaL.w"*uPNE9vН >, ~gIbCmMASA+sWOV&|;:|^ɾ؛juJ,Nľ(9(%8LCȂ >u ɥ}fS6qZBz|Rt?}u\2:p70j^CC:с'0 pM`,ZHsB F[ ԱmvG=>~|t15sh8wpdgM Mghq#uݼ}^-zj`."MJNNWUU; ŭY+="mJzP)DpfF'#b4֐ fg=O'OHfY>rsdF!\W@5+ATrHۈlΉ̑/&`v僙9 M'ў|8,w! ƨx: P?ګ Qɱ }GT`@Bl4Z1Qm%o%v9L?sE]k,̌ Pj߰WVTԺN!`AJu$(<-&y(zz(2'h_wI%t?E*`{Nsg+!B<ȇx41![PðUʤ,xd7ݡLB607^h5  ]QgɐM#S@2LJI,]G'b+N L-!0}+%;1$ !́ޟُv`̯T7NPr+[5Yߗ[>p V\ (`[ _Y{\THE *Dcӊk]u4ߐȌM.ͪkirz^ħޮϯΞ&Ogn7*Z+]E{uiBh~UupL[t Bdw$L œy^~㿎{d{{Dp_x}]-whzwTS+"/Kq "A+7 ]ҚR1f5!IqѕbG\bYx]/(#k7Z,N"tguT +lNW~[l ,hL2c 46x\Nq~}4c/"ӵ&[ou $,tBr cIV$~:=4q_P6ѧϫ.u>NhEP{J-'­W3KTN4'{@TcWhCsm;RV6M!5Yq8$8X]P[hu/2|I$RKe%6څFA>S+u01JN Ti5m`H=-+{{ ;(2^lnj7=F屓Ѡ/{/͍GfFIh ?_y9c6짖^F!ZNcNcz-6SS ,;t҇2YKH`Qҥx:2\/=@}˱V}Rs ^o>A$l"e5](MʌٝpOw?~W4AU Y<O>x ?j? 5pMa򝝗dՁ=fQnb.ډ*o>TbcR].Ge Wr[>֬!IГhQ>HJJyy$ sJCUX)pgZ\t;)Q`a@*Ԫ1dxr3SlUՔ> stream xWytSuO 3/v{c`SEA6()M4If}ޛ۴i= -P (<€sf|{-32y{l_>oϿg-g>(rt o\|* ejy~߇\^/-7[2Br@ cيfw\֞^gHۂD*&b 5b$̈́Ny[_y޸':hw]rqŸ_y(ҩ=7}h/`UVR|=@h́D)0L\90vٞMJ-idd:ϠToa鸗^")k^RG+ Fp7t71W-0 a8 * jp6v|jMV%T(̠3Pv}.OF5ӼVɊU  GC!=$De(8͸eV Ck\mVP@#T@Cc_;hlj(.mՐ0t:# @ӵD*[@cIF vԩ*r_7GO8K˟Uvrr.RG-N$*Cۆs'Ѭ]K=CZ8At4_rƜWG'Qu`$r9jvS'=cd} +99W==^L!W0.bOSGi'O0MxtcmծbxU gRuY>HPvjo/p x䟆Ѣdt?;-_x#rN0P 4xTv$GI>;Au>!=()Ku\39cma9c|OIi?Eup1k SKf%oAtKK414&qrsCЃ*w|B`71Daߞ<$;zv?YЗT67Cbb镂ٺ]K'|ot܅~s:B!/Z&2o^Hww`u&*}GD97q~-ty[ԪR@QTŻnH^.إԑ;R nDC\ Dcb|.\ PBEom+U(EYgT{z]d(7oe\_Af<_VD^eW7V և~DT!d3R #u/ƺ&yJh'I@fMFZi&%K9!f\,^v0ŏ86 e#N& *#鰚m Eېf:n#}'ovߠ{c<xf"AnVSi>ѷJ.wGɚWt{rw%biT~ 04I۠,`?5N?;N0 |DX΄rpN=4=9VIyU1'1o!W[$.qn'3 Dh?IoSf—cW*mw\pۏWW5:s(]-Iipna%{+*ˠ tuUQuB+bu 3/C5`4]\1(>p<̭wa/~ y-a+39>xEWN]qQ?ZC]+ڤ?ALzWy[gnQ5A\1'T\5$:2TLؚD FtYl}[V-fS{_Zu9vWc6`eI4fC?t sK _ cd MkP1Zn FMPUA?r2+qP&T eψ&K#uYz<] pP7t{HhBj\蹁 GȮh=n7Pǡh(by]Fא2%(|W2 F]ͼ ח#UL")vS_(e<¯T-J\jP .itRV D9ޟ>F>ڐT4X7iXuR&ms3IK:(bq\$ߤ\a3P&~<`B4e5/nF1`T~˺&Ts I5VG˔%U2FrY\.Rڻm;*;k1cDQV(?}з--v'ؕ>mwFrs@Dl9Jަ&t|Pt4pW Ϛr,z'h~*ܼmY:Kz'foKJf c:?."nNnVRSPכ9 L [\Nz6.iBU1kX8W?:Ӯ/scV= DfSTgϽ0E2  =A]8*@chkm(-m8 n\a1џ󏼉uWwoj!.@hZŃWI'g=cD~XOBۺS786 ޓLr屔-ޔhendstream endobj 262 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3101 >> stream xWypWo!K4`lvXàapNB!6o Z$[$el9 !$ 3d   Lyc*[.IUz}O2*l%ɦ%$oY3q4W&t4O8;Chb5;v \a?8T5e<&fuԋڢԼT}67UO袒ӳ5%%%KSse>٨l}VTX[tP!?O55W5Uҩ^[-ʣ(*2/6?8^!uszBv[fVݳO%ROQvj!ZDFRR/QK T DB%Pt di=+raʾӯ]3V虩ysVS8.DlD|*q* %_&%^r'wϯ LXge2k[l!z ?$ *^Cut1XsG@(Sט^e$]޻/z5>ǻ{6,baFA ʤhqƦk> j?$>Ꮼ-sm\6LV,Ugέh`n6 Je8;ӠF?{\R &:`w(@ o|ӣcq] /ob ?UBaHhp#0+=(H3|=ur8LoTFV]hUh!Z!<mbk-s8H4AD;|R6qN;qތ8SftDcmLƒ{ŗmەTNZϣ-~cO~Ņ@ r@~ϊzpASAw>#=}U2AI`i^$}d/nv]Z [wZ~RS%tn(ؼKϵnEgbi-co :h4PU6zB;~ Әb5l^Dj/8ǕO"yPK[jNQԸ-NgO(ӣό ؼBOJCr#ETUiL QtCUAMD)kGX&&dB>p2᠝P7x7潜Q8P [hg(o76#Gk4[buvǀg}u\Ck?>hHo$# ѪRHO1h!hxmQ)-yߣ92peoU7'6M[|.RVU }TѾFNth  C^>k_I![ZȀ8tfR0ѝʏ<4jqQC>:bz vF(\,…>R;DXώ!܋uh ce>KV3F*APs|mp$cfsكqμs^uNΨ:Vmwb{{Bϩ5V1J}{\Q\ءUE^ Iv+jВʙ̹U@,vO){3BsOz=`_WwoOYs k=-;j9x xZK|[56vڤq4#4^dl6vqqVyrz-BB6dx[.V1H^yKT 8쀬I WVYm>s3)㧡4*Z>,\P{P,:VI54Ǒ TpG.Rmi`'m?a\F<'(Q~OA ,V́;aQhķ->V©.Q =غZ#r-6,5ojx#=,~'g+(gr/DG樶AW-'~u#ߑKpZw[R8xj{SYG.]K1&M&1zOo#L4wn{f2p ߓ:DS3gFWaD~בy=:tOvu#qx.V ɚٿAJ_6ZMFț!5LE]'3~~aQALZk/PA8EGףW Fe 5Q-(_oñkk6!q8 %] \9<^K R,c# tM}E{scW1z{^o9k6ka;d[Kހz](.ZxH#a&Y'bO@-ϯ5ʻرcLXڊ]z{ΫݣhtxfSm>-,%4qdWP{]ݺ"yv;Vr 'csm=P /?BsCaswSGdU8"ІhHtwgu '1Sa:k@<,$z%JA&9!y(F.Ց[)z:FBŌg b (ۑA1Iؠ(FўhBNABxg-ZRC>Fn8[ܤkkPgo$Xu H(Jrja"8҉1+:H)oi2UVYdusM\"=D}җn-S4B5]Ri.$~8,^waJW B jGn8͏< xG'Z_vfc\{۞4?#괹ZдM.>'pP֨ ~)·]~%Nkymffʎp_r$endstream endobj 263 0 obj << /Filter /FlateDecode /Length 159 >> stream x313R0P0U0S01C.=Cɹ\ &`A RN\ %E\@i.}0`ȥ 43KM V8qy(-> stream x]O10 @UXҡUqP(/ СY:ߝ|reA>E0u- -m1,O)x@fw5|s^[+x$E b'Φ2?M%K17MR{;RB|HSendstream endobj 265 0 obj << /Filter /FlateDecode /Length 216 >> stream x]An! E L+Eޤ,ZUm/XAdkxHےTOt%6P/xEYcۏ.׽L~/ۇZ}8 KWzK8gZefu1Վ 87҅tGst@0f4@Y=A|l+sGVnaBr 4mendstream endobj 266 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1016 >> stream xmh[UM$jbFptiWa¨~X!MKҦ &IܼtژVYi3ѹn̯~/"~' *s("CE)F{ ^8%v.9.tW_RC[nvpE r.p- 9}.ONѽN}}θ&5z,6zi2}c{.+N^B͸"3C;M=4/x=a\ƸbRվ` Z+f{ !B2T*ڤV"@?dْVx 9~5UwpZT:&8[% ۾-O >Sd,*pBTG0s+YEyVa%C9?g!fP1;$aLFbb,³Jژ\,;ṛW* YBxlE|>_JJ%([ʢDV k*w#TL,d!gY:רE,wcfƶzuTd;r+ V>'@  OAI'9JI?2 rqឲxԤ9''3I(k'0!-SܵU>YXK?&g?opjxol)[X.Qu4t:(p@Qw:xKpS\}N/Fɍ.~i]GvWx^Ykֵ >ho1Cendstream endobj 267 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1819 >> stream xT{PTׅ\ݭN0mFV(@ cuYX%, Bpwe݀. Bz/G?=Z>k'%M%:6dY@nFr ͏I~ni]T P { ,@VQ uP%:v%t6MR~2P1~qLQϰ,[s()İTE6Tuzъj86 m_?ER$Y:io4(0 HyWL;צҔyݍ,^5za'90ء>EwȘ[&A+G0.~wF[8ױ@|xI&ścu1W!?&VPSsI>DE3tL5zMMрCZp5a/=7?1sxIpXw_ֶYs!FV.#H/oUVoc]>tЭ_`d amp~FRV@`_@< %р{'.i=nti_p5n\ _h+ƾXY>\Xбwo\o7 KuRq;. )"qxlL`3Scq^W"&EZ-Dˇl&Xh˱겢ؘ,^eXhū5^(zx\đ3B`I /»>1%ؠ4W6\:QâeHD$@xu#9F$l@G|} 5 rA+A 8r,ă6W6)Nb-67CJߝ.DL">tmr[᷂@EMV)}«*?ܦ? *.ւVg5UP{p:IGSJЮeT~'M ]lҫJjD?AHMVVŬR 9Qc`:cl;#MmM'Q.ωiH&$^_Ӕ endstream endobj 268 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1724 >> stream xyLgY'm%MdGm#JR!v kXsyvaݙ}>5v 9|@jR\׎զMӨTU,RuRI}'@@ *JCyBp_9a+綖c[.!>q+, @Rg+Q Bqd޽O<{%rmkL)ʈBF3Tr L A=DWW.BKm~vNIW+"NyT$$e2\sڷDPwrDjklVZێQAʑ !0=')CG"_$.0}'Y6<%*D7sTJ5óWo :vؗN}zyuGeH_ۀ3ZyY5} RnIh=N/9v#\GU5YFK竡D]8Ш- 3H_M6HPapm8m7qNs\(3D<|D`-̍q/^P,|_lo퍀,E< ~/. R!X(O@ZFBɷFM8C5_~}}o/=Poz@^f1y"/եqlzЅT\s,ޘLJf܅bǀ "&\ bSįi#m.+gˠ}ùnͥŁ$,KL ~4 Y,4%1Q}U-Mb>K:=A̼r9~3z 5hkZ~.X'o+⡞FStIŸVc4:-]\3~6%SX,p(ɌL4ˌ(A?xq'1O:a/eF:UVɪwk[c% sy=)cJШ4~xt$;q/6*0iXŸ:l`:jm|J{ 6o->`0$_S !lqS/0观\uȤgm?mǵdۉӽnos ˰G6Y' 2@@yAsqv'/F=n;rphu&zAqn0gn A;T'^ s-Yfkqco}/BvJӀqe{.3&Xtf_%* NJi8#s ΌlxDחO\Ns0x {wM MLękSWxq*l=:pơ JRCyǚ])J|4e/:\|x/P K'^Bftc44P P#=ޗ{?Xʾ {͹0:=;4IP<}9s7kqr G&RV6KObNV (9Zx6[-n[½8`<+db8dJ]MNa2oMo[TjUJ55`+p!LjHF_3.wC`q2(b^D c ZU6s0WXkn<f 6eI~endstream endobj 269 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 473 >> stream xcd`ab`ddds H3a!G*,&]nn?| ~/#ȘW_PYQ`hii`d``ZXX('gT*hdX뗗%i(gd(((%*&s JKR|SRl  L Y4/y{N'?/{Ѣj?٪KKJvϖ|R7ea]BtJk_n3g̝_3IcU9HL7erԉ}SpLo+[Esw9K%+kkj9g-ibGw[dum]eY-r7)&QQ9nK侳߮mZ>iƌ9SOm_5]}mƎu|ŋ/`-7}'Nsyx dendstream endobj 270 0 obj << /Filter /FlateDecode /Length 181 >> stream x]= wN [)CĒ.ZUm/@/8I҇s1њȋGpȵ*'eU͕xUXgpr\:zv8AY_Z0IM'HӕH()a)a)aK5 a m(vNk,.gOb_x_=endstream endobj 271 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 963 >> stream xU{L[U +=@/3+Qc[6X|;@c1w[0`)0? 1Jb2Ddl)o폓9A.Aq5u/4dy!䧃wo󙭖}g! v|cr+'?rmn~5olqbasXVYYG,/-$묲CrYe-h^M`&ߛaqc|QLQaLwzpkpPS%U5Ϧ*JU<>S`k?U0\>TMs4[g! WlA?#?SFXSOH9W@Q;} }\"#0_NIl%q{vb +]wNtai ʠ(C!^2M9%w&M٫7?[͏#R|Hq0 n,'؟qXC?X{OwkDX|ЈF`DQ/ND.Y_G5gp~m)թ`h(-d.l1eBCF|`F endstream endobj 272 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6604 >> stream xy\W bc53[QbTlbA1,,eiKacWXk}c1Q&1Q3"W{9y\DIJ$I889MtaHGxGÅ}Mߡ-^Dfbdf4rT8 )H$ I\" {yx[Oy>l=cڴyֶ~rnn~nzl{p6￯P(M=7Zi=]z?ZѩKd~!rkNw?EQeK./8xE]-l;?ٵcZuN>}79O:eۦM13z95ḟ??E'Q(j4CRkq:jS+5fQ+*j@}@9Rsj 5ZD l!9%RK ,(KʊSé)5z(KޥSf#IeBSEp} <kMԛ.2@%V풳3_߯MwYf f8 hr|!^CSICc-_:,zXհ~'-'XY>pxp<"`f8So,.b5/T 7 ho1h{l~e/G(R[*Q0JJMJCь_*^5iyտzՠ %]^wIY!( 1xfW[݋BIcL NZ `# eQn1)'ա(p5ԙ'Vt׍b<.~|N Հ{-Di7%gamv+UGN},p( D~RWFKR]6.bBmZiY:q&7#D~) ]}xƴKR# lRKB>v,5̆Ya"Ɽ8+(i; b]5`V*/O4n[Kbf2v2?L>׎VyI%'9!9Z Mrvyl?~r] 8=B40 Q?iX?ޛWwJ;Up˱J"lG-PU%uv[+mP>]r[=ItY haC Q#ş`TEL^shƕ᫜xS>tIХ({V}^ja$9B #}$xC[>]JoN5ڙ~S775XH_)gY쏋L]) 2"2#@X+UGP21sU0y*≒>mK:z]mYWxW%W"F~$ɛ 2Z63i 39K_0afjF_ uVF{Ct 6ٴebla׿mr>3"7gw949+lQFl6vxo ?TCBi}xi~UtIA!hbާ{6o)kITz5[@jO.am\0bӵYjЎeFg.\62g. (=qrop!\lU ]Vp%nlMCRL6sP-z6' ;nm`zIH8O꤁2K)F(SNF I^p,; &$i U%F{uLQQ+VPhpBtxUmi:R},`BOG!6$5qRL: Lz?FM%ܙuY@YG%YUL܊f'ET"Ԋʲ7隮y1? $eBfD~4T-Q[\NV1Ƣ~Ț҆ gd2K2Qb}w)/=ANKNڊ:ab } !%tgG J@}} c7H썗&K'Ui]4`rjHuQ3ߥ0B`p\잓PXQI~~IV[t aY݃uDTSL/۴p[j^jUF*g0?^L B(ʫ Ur *P)s`?qM^goI)p4+侅fgҶFeF`ѤnxP}C#>&K%\.XɍΟ_~mO!|pE'Oi ˠaUWjgYzj*  ,MC5sZ!Xu%jzx?i^E'#c2.%.H /zv-ԓY= Bv !u8z88ꘓ1CtukNJ/)R-d%G䀖Ʈ]:"^}P :hTZw@M\JUuYåQ 67 1Hj 5ޭ@FDX*p z#`n=~18wv)-hAi;6l[>B"Ky0~aM zg9r-ֺ:=٬myrfgS|cD.. N܍=c7{m# =+"fEs{RLFƇ G%[1efr0UǷ'7synUN@(!3 %ؒtDٙ%ٻ/>RQܬk -t)h.Wa1ϖ\gU|Bq#-rϢ/1)nF\n)1ؿ#ECS:їOR=A!о`#9zʐ-K3(,9#5+[B8֘Ƿ7]4 Diݴ*B-0hMɑ՛7/ɇWkd[x'ۄeU(!{WS1k i"dؙ(?i V+ {kssp)tY}o4ʨZLq`/4*,$D& ihjpPvn6gQYewpn)++|zl݇T4p4WH|yPL1@@GM[{ :nu W:7 )LR+,Pr_e} x9+}Dzg%LΓ@PLzC15F=3ݗ0I$)1 ! Fag`v>~}ktP+-XܖoG5nA΀U٨K/ͣ2Ӯ3, iQjdh<O6W ֥dԡ_& ;4 k@ zG :&kzd}ֈMpCLQx?q_.aQa0:wW!Dgݱeը_/Fo[MZR[' V-[Wn2ԈQ%*h-0'v&lZ#q!GH">H:?X]aa$ ۠uH21@SEUx#Fz)BXiWjDBXpqv%8&:H@lM(V Gz-xK('2`mTg7T95* l*+,Dg =VY'Cy} iab xWt-YlÖȘd`J#ʛ_>qoafh%̹`'=[Q.jyPOt'lAEjCDdoCpmqj l_gnL2cuJtA,\^b2g*!QI剑%XFJsuS СP,: UWT%&4.Vf;1%ʠwcmI-|N_gǂMw߮:Lp p$#{`۷ Gzj^DL"~6,)&&sd"`#\4A ЙsQJ8hԊ'$%#%>Uu=?Lx⩟>p5fysv5ĖcC/\i2/̏t~ D bxȶpen/Kٲ˽k*d%IS={nk'=\<Bx@yGڔ(:`q_NXnմ 99yEajT(ʶSN rѮIWB _5ZHeQeII,0RI0 (XBHALdidYanNnPWVv+PS ݇QCYu UDA.l|4iWwAr0`KV]Gޛ `] rxi_J8 &FsI&DCX Wމ><\} tK?@2D4?D1,4/~Ĝ ~&^KG+Pv:wad0|ϖ?؜dDBTU7yHJa8]8+& 虝'svAlShrsrҳ(@r:.3+lgۭ]ҽ-Ъў'58p1ūp}%n)//lrbEUEf&*at"@'.PH*{dj`+I7ݽ3(.v'{~ZWGy?6`c~I]r΄!`ѳ;m|εkj.\U{p\*YǽQr-ƮQY Td뒾?̼h%:wB]]u:6h$"He99 W~>KI dIJkl"$,NqsI.G3itAfm6|qe|wF$dkrz; &$|m0W}Qs8= 4pee線_n/5F_ч]FeX"Y%q^u*7{w>f)[^XL,K42nV]Gm_zFNޔʲq 1(!^]SMo7}+"[)\7Y{g:q@E&}v&Y}Q_tu =,*!)U"꧳`/fw@ܳMv j!-+GLuXQd|jzfcw'wݲ$>+oYeQu%m_Ăo3""Ǟ'7Zy"!01'XTgp.ӢHQmm ׋4Di1B8m?Mq6~:WDx$- 1 V`HEqq{i@(x_9V+ vۥ;tx5|zk|;=R#n:[pO ]$  F5 FEœƣ$~ Ft l!’XXH> stream x"CMMI60`d,B@F݂  id`nsCopyright (c) 1997, 2009 American Mathematical Society (), with Reserved Font Name CMMI6.CMMI6Computer ModernijJK#Qئytpnqnr|OYY%Zu~tw|Wn~i~m~zXgy}x{XbOXy`٫ds{krlsvxi1x@PXQoq}pmufV YKExÿ‹rr~}vCp`  7 Lendstream endobj 274 0 obj << /Filter /FlateDecode /Length 163 >> stream x]O10 @€XҡUqP(/ СY:ߝ|reA>E0u- -m1,O)x@fw5|M^[+x$E b'Φ2?M%K17MR{;RB|ISendstream endobj 275 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 559 >> stream x$CMBX80VPB@F݂  id`nsCopyright (c) 1997, 2009 American Mathematical Society (), with Reserved Font Name CMBX8.CMBX8Computer ModernqSR4sVWYZ=_YF7%*-/͋PIW #Iy{t`QVjCPսݾ=X<}RCiΉc`MsxHuttlm]S;=E"*`adPryU_l}7[BSLȊ{otHx]焿H 6'}P_^   7  /endstream endobj 276 0 obj << /Filter /FlateDecode /Length 5097 >> stream x\[od~W#}IbN. $X'.1;HH9ZVkA~vXaM4Ask._]?\Γ_~mx1_/~?La *.tMA˫۫Ug''4 fK;r>yFLp߳{]z~g읚o-[Z1VQS fVipJ}vg bC\f$෴ ΅f79 1|E[{<-g!|>RFSGNK-ӆ 6T nt(]%>zrJ {GwvG2YvWIy(E2@J$#^YpFj%=`E&Fm>6^~d{&mq$98ቾ[8'$bMΕ;ɺ(WD@Z`gԛ١(L% ,Zpq^A q +=XѲUVɺ>`pZ*^Od4(..>iT6VlOۈIs˄|S+|G< &#z rsD?W\@g~[96Y&i,QE#D|7+h;odkWMU 񉁿ݔw2?#5+8~M"-*&!4.::dJ*Qh*<T4"RciD|]㦝x;&P 3Vљ~Zne PA—pQpNISEHH-\>8id0k|}H.;;|mpv m!4- !Orn4HQCsGwkTVh!ecQc]M@tCk0,͐`|}aX닫&tFju#+e`&a < ^ F\ !ٍ\5$*WݨM,癣QDBNމNdW'΁N0+N7}ȱY m>7-Gbeiԡr}q%k%\P&G}||}i~6W&և|܇ ԋrZ+"2b;31+VF ^8P{nbRF4܁#m\›FJSy{~a *(93uþe.;,^;>^^T@8.SMp蠂tf;Ow nF}i+Dkjh *D_ =m'Bo_c@kRYIu]plK79D'ٖ_ +UkKiC"k*gkH<#n7Rh(2)=sGGc0vr+Ԩo2IʅW' oM/"ˉÕY&8$"P_ ̛+FB~*JMNO'$Xm50KisЁ1 d5H1/`#}te,ˬQfe#]GSigLq_ <~Q&w8?0.KF(]ckKlL juk❔r0!u5#>>kM|e:iG Ij2etB(UDVY3$6byp ta e~ߪt},bQT' }[3:`Nkַؓ Bm]4K44^mĎx bƞ0p6v!I17JU"5q5ǛO36ٸ(NKq!3I½"c(7 %l>2j~m71͵џ;kk2x(s%iSlTsW9 Ud4`% {/04>W" ZeVK+jqD,;<bh̎0ܮ8~T=Q(M M+MgW㌫"$۲T29SX4'r"$` ɤ;cfTj/XD0Kνre^X9l\>'<BW+&cldIl9UK8})P7xz];y z$I"QߑF~Z~0`:v? F>1P($0OIĀ5O*1F @@┶2j aj"P!EB 6_%ņ)Y: \etf @ A*uENjeNBR(}\,Cn{|*XMt3BuFz=J]bF>pŶ_Ӛ)!xr u=S 0h˜ՀHGM0PG ,JcvHu4@Vp.UaSzғL7s[G d XȪ(Ãns=MVtV]j7*"a&]2"zwi\|Lų~!/ܫ3; WAf.Ε\1>%`WJ,nXD֘sN)beQ4gd0)i{k\,e>5HkE)i҆ hש>7uG8zFDL夹âg8xrPZeb#o@}jqRRXm隝d@E֏`!A[6סÑ|67lOQ{ﰯoV;b4*e^j I'f[Fa<i,ޠ nZ*%я|g~J R, ةTaX+wR)|Qukx@7J'w/ۍqW  q;w wq,ٌx bzSWЙƳ`X2r <)  E⃤l<\>}LNT(`)l:uox52̲-|#?-jdXԦ_Gt{ YQJ?9ܨ gSaZ17oMI$̀qZm*碑!u +Wb)mص,*= Ee*#4+`& u fb̎?ӫBBS#ir%b1`% ez.&)A wvw;GUܬ`Nh[kb-n&m-DTFBN-̲zhiUJ J5~Tz=Wl ȢIEgV$S1?@aggb5T`BlQ0䉦ahH)k蹭,{"MCSp1 `Z@8 B͠@#C̕ HO>Ҹ.=&;oN8YX`2Ni<*NML->rEFkJŀ``P}Ru;":CC!Hg5%،i| riq pGKf.8Y(ۃ#|C#?^ѮDښ6Bej b셺`O˜i=y]#e~lrW3:HgZ 8^4k^)\X+t(O|5C:ڣ̰h7* PBR" ~/[9si**ci_3vxv`/ *'G)GxۗqV{S%1x'[ =i٪_ISk+Q cI qK)cĔXm{0L|Wc gh`LPhE+44]kYn3&=fTЅw3C6oUL8x j[`G_D]w5s?W?fbڧ2ϕhF釯 Xȇ.Lw &RMT2#"ʞJPƟb:ĕN6tendstream endobj 277 0 obj << /Filter /FlateDecode /Length 4654 >> stream x\oWG6N-')ND:E'IΐpoVS~3/ ˅_X؝/'2vQ;Z|r #>飈rq$*A.}vqzuI< {  WݳUpƆ|A[c*R/Bw.t8.+u/`):7d(_N]FF}E-PZ8mt÷H{!L鿁(+ L[+m\цu%+䶒WK.Kf8g޲Xb%ыq`)m[qΘؽ䷕r)%v}%E%e]T[k%E%}F2̨vO\|I'$ˮ$1v]ǒQrTSk b O!1=*}(vK4 YwCA "e{(qƅC<\9>c/}LvQ7d Wd:#qKQ:vr*5l;6q?xpȴ-e,пBx\A˱<꣎dѰ<|Lp'\Fuz'!o~>d30~^├!ncgdzaVG~wȩT-{* ZLÔ2_5o3*u1F"`|S=_0RT] ."La"QfREv5kwp~' ;a6cvQJ!`QER5 7#jWْ{Ώ%fQh%fSh3j#hNS=g%guqV.ϧjM"م4sҾ z`~ XFo:=9`ؿCF@ʞ76O/mWJJPɳJe%XH%]]zg|a3Id%KOIo{c S,cTݟY[dr`ټd,O̯amnD̑Mk41&&O4!R?^DO MbGha0E|/B$'`~q'nq ! |>AJ|2> H]:C$ GAOa:ETZ7#S |a!K "yE .AC<NX_A cM"?W<ւS WXTː}npژ9xD_D`aM@-B}F^|.!9AeOz*,'V?.ha=WSr|YɫJz)"*Cqƙ]"2@hX\SF P##FZ tDcI@LfObuY@!%ѬBtsҙ;>FeϨaH"M+!uRRA$DalXnwsm]-aw"ÛӂΤiǷ $tY@6%/6I5N#._Cg8ɡq9! )">zEV  2ąM MQ] ͌'H;rRns3w?|pƦՑixUu%/*yd9H{¨;z r/DN W8vb[IxQ.FP{#AL8V a> yBvK:{_0a´mFacR~3C(`4X^yݲ`\͡&򶒤&fΕ]85 6a)胱D/!E#ڄ::!>c[]騶{1}z`RҞWj"*r ų± S`. .3-|9|?H\07l^0Af,75f{-Kژ4|Ca(,l$¼qmEڰ#yC}Y9=)_H '-O R˪G qHӶac[B }:r }Gx#n~Z3R=LaIřȇ|"@{^i6J/ѧڟ)nbzRZգy_X5PkY2u1ۂ.N%2ZBu?OOz|CTMz4<4]Wq^ X|]ъMURؙJ~iZTDoNj3̷6JR7jDIӀ Q3"npSY2mZv[Q\ީGY)$XJzA ?K|s?5= _ Pȟjʷ}|V &Un)lICFV+Aߛyh͐ g%R:ůOW>Hz]G/*y#I&+1ir5 'i+mkyU}zry}6-$?=ѽ !ӢʓJ5?5=* k*M/Kq~ ϟXK&H Tz뒬YwkW8k ~X%;-%wSrcc \/DMiD*6coN9d!elc]jcʀƒD<~lvyXi9$%+DTgz5'kzS:wxfV);7gvԂajq.OH A0b}ءWGAeS(@mKvY:0 3{<*g'.}`bP[ާ(\ B_9@GBB&SNB^m z<,?f-F׶hRF WesUls/>n9v_^ai!bN_t|i1ްXnHK7=SH321fgK}.+!16ݧ 9q[PeMq|^ݩV'cTV}$ΰ}8$374Jvč)-!6W3#SWܺ#DZrG\`WTLu2sчQzdKP|z:IqڸNmߚ:pRtW٫"IJ$OvL>i%_Vkvi6@X,'d쟕מU#^_O$u[I8II$)( T HhO\CyeJ>gub?_eMWK@4OKO"9oN Ѩendstream endobj 278 0 obj << /Filter /FlateDecode /Length 4582 >> stream x\s$q~gGRyMyGCJrq9OtRq˳4<ק =\*wzJJ tucȿ^^^ zw/ qL?,]~}@OEW7yKo}]~R۽_,Ec^(;a[1zf1KH+*tL+) %t ں!2ݯp݇?OFM-#:=ŢIK!`= h@umjk1J`S8N9$>B*jw׸Q{=|RFXM9ؒyV?]\v.j}ɸ3DEe˥}pv1:cbmm~X/mgSWdmi*;lØԵצp?RW\"ޞ]ԦgiKmշW"^ 84!5IguJo`O~hH\dyء1/FY[M eM.bU Tk`APl4 RwBS2L8؀ ,[x 8'n?{>cz4m9o8BLXޭޏo%݀D6t_Q㮺%8M5nM+zӬ/6MFF%%%|6DEBDcI[!^eQ;s O# MF(ehYKtǥmr2{5%t{餱p#&ۓϊy 0:!?27+%e"Zm:`ehAV{W7U7cMm~`{XGqqXEyO{uގ 4h:ix+GNIܥ qLq`Ӎ3 d5*K%7s@`b6m[+`ANFgVPpjᵨ+*I뺓~0W C@!"xpUVH|L <8`# CJ\>jjP܋~ $vf"f)#|8@鄸 jJa`O>6ԭ7Gm- 2~3iS)fh,М6; M\JɛA3VM0$J4l=;RZ:;q$} H) +ZKD¸ ,'&ꌊq*oSHy'{ȱ+C<8Ʈj6c#PG"OZUDthG |EҮC j$KyM 8Ld" )~ n"ޥ>?1ۃol=;fJC.uJF[MSzO”xO?:iAMc'qт794"UbIǿp \c lLbƼ|__Iaʸ`/e=UmP['ACCV ")@nVMuv; SS;$O[D0n0 i\֏[(Cc} xL~[}eStjRLGhl\XH,WI') d4K2o֪Pv0ډ7~2y2孀Ч W5=Ĕ[ICy{y2P?ddfC&6(SgI]՛J<[t|ك+Bv,me' jxb/J`QpD_Qt nrn}fWXO@CkX84iRBRM4g?IEG$c(PS&1kiSY.~N_g$p#1v_#au-{n< l, ֨GJ {%o4(曍p~s8u[9ZZ.'N&5f>C8by'u|5 , su¼q1w  ΀1doYfG·6N=aljvyfL[hɉUd-g4\/m~.,!4<`TMl&!|Ʌ1V-b<ާvfI@h8]A~-h$TJ /f?K8`4}Vɔ5LS~,jHCl1+{}βJTB݂ivi@%T<}=M Mla`p>zޖ|@>jh^Uz֤={aZ2}`3t:S0pA 1A = _=NdLQv.iLY̴.FvضkiA:hY3PP4e0>w h#>8 u1=Zb31ʆloH$jU7S6Ǭ*7TR#\ZpIC# |~2J1+{>c!*V0LDH Z^2>t3<m䲹:lQxGRmddհ#?IK&(j7ZeƟp󜕐l>uYʦt.m5`:ɘTWd0XZap\֠hx&H4doїms}p q-,$l:ԧ@< DMiMa9MTE=!oVƏu=|V ~7F4eJ(2.Zp=S\N*JN`<_8}9b|n8smXCmUm>d=ڎ]Lvz:5{VxFa?,jmm`Mᴟcum#{^4J^w_WX6-| \ tXNa#vz09Լ>g;r/>?g{wlOy5~}rPg8 %Xgn$|c9d;L`˨ /RsWOyW|MmDv67wfdEAum> [CmC7~D9D܁x]wU'Nb޳^W̸"{U$#'zArnƝAm8EV ?N1tavsgNm0v¥A,r&x$4?lD5\D$>?' d|` \;N_o3Yfǣڼ|So1 70>^3ܰ6daw |H8!+S: u1ɉ^bһsqhag /{poU>kHԑiް7F8;iڔfQG3ڸr+9pIy%'.|4 /v#cϡawz.( M[-皰6qA?5HQ\Rh{ňSMp&@z'οf$:kj%O_gU-O=SY9|fEm^<]%y?&#IJIH/>Hz&熭YY43/T\Sx`){d Jg„QM?GҒ]Y% $OCb%&yl%!1񏯋HM|gN<~И/j쥟endstream endobj 279 0 obj << /Filter /FlateDecode /Length 6624 >> stream x=ks]qN#^4;i'mGv+H )R~},p.IKK.9S{}Wo}g<׳WoϾz3*,>[q/&GO/.}չڛO 9YvgZ8Y+'c4 k^0#)}/f:ŜCw:wSzvr awپqTʥ}oC8g b9#(ߴ)ϓ a 885aH9?3Gpdvq@fEr@ 飠z 9:4 d3Uu!Rb= ;O9Bor'}P8 \{]w8;7cʁ_+*dGT.(lpZW.sJ1ȧI 9 V |dwSCAcRM i}%P!̇ѱJ Ta` $@X5͂tEhG3_6+9mei} ɟx+Vl769vU0D}rr`{ ,}fARHQuf%iYӬYh݁+Ů|.!]n<ŊZ[p-Vv*B4)oa2+7Laߔ >пhOWLvt2Hs탋:# 2f_nwhI;y iHr@zO0'E'68zH[]ecIae rWŮh]'m|Y6JR"@pH-N;/ @Iۘmɬ) 7".+02+:];#"#Α 7r'gJX%LC[jŪ=&J36m[ߴ}~ RGڛ4P)tQpVq ~iȹ+<8qT {Lrٛ!ЭHEt lu"JrwͅLL?ShA' hKYJ%ч/lvLŝ(<D%c*"G)VS|Y Gnghyl&:AA8$@6uBݛBF煌Pc6 P  I aUX~^onXUw,=_l8FY..P8!Yeg@n0J JMtW>FGLJ֖tW ˟)^}RbC?`e8ܾ V֠N@j7ҿ5 9םa fx>?a4Nes,x"N*NRO;\z|yD{P jȋ$N׀|^eEcLB8 Շ&,>Cއq%eoݴW/Ʃk .FnQ6)L}f/uYB{+1t {*X c259E"8G ȔIQ,ޅ8!qS!bn~r ZYcǧm) Qm an%xzKcbS }`q3kk eeະ9kVL2S`C:oϝ=H[gp *5^w˯캕__ ߴUyj6|9nvhohOlߴ68,_`^NL0GxyeUݏfd_:UH*ݳ-Cxቀ@ɔ}j2)Q&}ڴ~6,8||iȒ_#ɳ/8zL3:PK%N-"~P"-k+lvùhSӖ@K {bi/pqt( y*rUY 񼬰(2Q"m55cMQ Q 6o8 rUA'oXXr53LSAGb$VR}޷'CUY\oW!@o<̬\QP#5Qy3$#Dw5%<ɜ~B2U6 ˒.eXR#:%W8( )E0e@%9觥&OЙ0x#oѡ}a.6A`߆I3QdEmEZ.~ѓ[pi鵈{zR0˭+P(i15pr:˃K;y) ǩ7b|Npa+pl왍n ?Te^%4$$B(e¡zU.*rQFz3`˫i#'e3%bQ椥ek9.z G'mx)]:ym&OS!3 e*p6&Wg) p߫rXewTHلH~b+pC﵊da3Vm(tUY:SL]2%cd'"w46mF a{ 链aA, ܪF٩ .˜<]3f|{u2`U MYI-@+UNjY|7qMCqjڷz$[+p?.b<xPcƒNe8&&LacQ.}V{|}-*+!Z~VSD!jyv|E9TF#O}*&daMKr)O\t  O|Ͽ a0m5m )CNXY4* j8g)8* 6I;ժMǂZ:BnyFPcHlG\*T>r݇ң1k.qR K9|\.]d>k>3&O]^lJT|Vh3RJ?&'3r5(Y50D6 dƜb->u)M%EaI%*#CVUv1uvVSHE! AowH9""."t䤨+ ݴzWu:c- 8&_i'mF[_qfp;\ɍ[ڃzD ?J7}Tfs̪~4GSz'zGBV1}u{׽$ ZUU~P;gW DMyՊ<DgfƟZL8υKJw1uv4L.AS> S6<`p~>~=<Z *vU"Y030,6.ρ-3M K;9oj/[5l@iⒻD+l ϑhˢr-d#ùw؅ G |(/6/t yA[DC6i95&" ՝/R;i@t,|\<7c:6@#̬x?{۰/ٌyRnZ8vaq_L7 WLQS- 5m7\ʕ[ߴԲL$͙"5<_4pL{Pq`[IbKl߄S5%V̉d3Z uǦ,!T"EߠU9C5.mtjo&Ί02:uBhKڌ$s۵koږ]$9ڝ&{ ɔҴd*TLuL,SS&ݪ\bv;+Dta+zh Djoo|z;J̮Ty" 2/|}-hrK4R8kI X-E bfH48Hz*+,*-/8"fTr^8oQ%*#$:}KZB(J&lJz|QgdKdjy-'Ԏ7nL ͐2aIBQ&PX@)DAnSlNF·CD"<'5ie`w~αy-[&Uuɓ\H h&ݘe`P~n} ,Ufit p钡6ma#GϭN~DQF˝HAF&ߟ]԰\#8I4L,\цaZ򌭕#I$ Q8-g]l$ MBd>Z B4͘Odi_w.9{af֔P7{&6 źC vZknC( SͿkuXS[1ĖΏQ3\] ($tؼ|t߉R(s>ce<NU0hZj^M({WrlSa=DPg6.OU1yB@O4IYu FfbΪ6/vq}(g/)endstream endobj 280 0 obj << /Filter /FlateDecode /Length 6501 >> stream x]I\7rV? GHa=oin69jIQ_\L{P Ё# K"/@ޞO?bή~b_oξ; )=lӾxv~dOy œ65{Sysݙ/Ǵy MI;jZc&75>-vL\mw#߼=6O%>b\57]Iz-oR\dLuOww>sJ# UJ lz0j<ͷ]tTG/W7y/g\ 77sRMo|ۛůz؛eo~5"]grf??9*!(YEEJ}7Nlo'>5Z<D#(bo";]ȕe&9}.Z#tq9Z֛NcGz8>GHɑ>(D7pK$zBo$ܮQ9?2v\JMke):{iDdȏOm,Rab ݼIje.˃85!}׋, FfI G,Oö+&?Pj(M`rh1L$>'B4CW2"Q`@SF' x? G1 `o,wB>"Z=,ށHƁT^!b~n2n6u! δqi䡫DbǭKpZyڼǯ;-iZCɥv0`\n ߟ?F.Lgo>g1Kж)9=oLEc'&oOnrx&;ļPSJH?T9i]p6ހnLۖ2yAqKА0N~j*E t0O$CӹZ`0Ti6)颅G=c[l"pG 9')qr #}6єk#<[qK: D$6? Z3~ѐ6zd_)Z&v"rz!%Weufj(9:%LDHNJ2o6n;%er-qdAA4^sacsQ%\Gr_;:VL )~7HLSeOQlZ!i I>sÒ씀8`T kp6 7:e"cЉ۶8g ؂9 qx<:\̑Yi +=\w5(dH/<,#Da-#8H!UQFǹWa6 o{2#a*?opRI4U I>$KB8ED Ԇ8=#N6kt5g|L,?ue1:.L4ϒ 1"%w,^CM}˓)<5(4P+̚S/6~6#L =I"-kEg;rȯmޒ\NV^7br,z04c:ּ審e+F^zN @.gRG[Mhl1#EI?3VQKC,Nn {u:WUh-m58j$V㊗W'q@w9oD: U[79AM!.c%*i ~a0 Ef{>#v@}Ir _Y@ٗÏF62)2H~VZ2"1]"2Lζ_C4GebDMϻ9FL> GuRt#7;4GpJ-L -: Dc>Ɨdt8c/C3YM^8I:ڹ[,#UU,s:Wx.|Гʯٶ"p8]81=nɨ3(oλ1)n&"oH(5Eln!df?BzL O;PN@^@r.J _EdJ LQ3@0a["M8Go)I#y\/Ek1g*= !;^}f|>M]S83xݝ%8)t5)ST^g¡1t5#S˞]ی"9BpTd4&:[KJ#aIZyL3R0)PƋ 壟"L /N1bu3|k+uuF(IxaHGp©50pX>_ᑃ= V]ѨGյ4̉g_О*!1M?rh >fX'k?( [fgym;ޯOKՈT$W ^S9V05`DL`q i}i3oH6O}6Qz 3<.!ǖ~:&?`Zpb|m҃z~EެjV|RE~{R|eoj弄\/;k6CP+l + %4pA\2q&EQW|Y'*Z}2Sua14ǩ0cQL^)Ë QIXZR _'1#c}W?B* h=]q?];Qӵw*7NgX9En%G9~W|nDZp~V Gv:ekW"Ƌ0a:_cK&<(?Vz'U/pGת7*%#L]VpY .qP=Ȓ08T$kPD elSEP.>  TXQ5R/t#3aR02|V)c\_"v&9Ƃ& 6ah@Lr %d`r9eqik wHPUE0~tr.OѲY ib WO]j ȅRvޱ Tꐻ!Mt'c J0x^dQ2cWX$s5ڮV+HCڀdfUx"}wEW :I^mb>Rs&/#,_nULVzu;\<C$ZdIrK, Y}FZ vbUq.:m-;,X+YySRr .RrRX&BI+^:1cot` djnūoG t+SI<-%%H&GzSyK B"qZ!Cj~ʚ AE"m,PS:U|*#M+yj&sZśU*iY>aI5t<߾bXLiwdUL[tS| hɌ7 '+]0ټR~ycI +*\^zlglOoTB9!†H<F/+fEU yѓ# Xz 3y}z7z7#ԷJ8d5̙i0(QRI\d2][/?sj~wĮDp8M^ [zextF>BLSS=sz26 2aDum @̱V~MHk$1lKgy3x8BCoL?=S&#s*j4U7+LDyj՛=-+[*01SK nw̵ pQb#^ ysǂ߱D<1ė:X1"j +(Gw..?v`?cBvk'A5z ~Z[T7m_zi\E`G{PLYѝV?1i 0ea1d¼3薍5S =ѹ*!"\fْ~igt1=.>K`LmǗt\.JǾ7Ż{o#yc?K7*`V.?+^l7?m\)G4Mjo!Faz_y罹^M#go}"eeb)漱xJsLEB㢯j=9h΄5_c*L&:UW8 [O̺H;˟<Fۜu ;^``ڻ:E>0KS=}r$c,1 ,=[^){|إ'p FƮTk6N">Dž2{A*Qm[|}^M̑1@(6vmA0R`)<ե+,p} 7<ì ӍV~n[+?r`i/j !LkQ+Wi~c UWm83^yeݹ?Z\i 3OW^ egHwzٵy'XO={ Ou.mUwZ&&?e\|RY֣,\yKWw5ݓiQ2endstream endobj 281 0 obj << /Filter /FlateDecode /Length 163 >> stream x]O10 @€ЅUqP(/ СY:ߝ|]"hcU- ee`Y8Ixwr"> stream x][s\q~gG-3;$Y ]yS[#9ZRZI  >ׯI۳oy/e s/OŹf V;㦠ٳf1fj'|0˭t%~3!8'7mnm~Pj}IYY*xefBͷ86{hia wq0d{Z<w |Uz]mYoA8I˦``k}g/ﲿ _ㆃZ9"l–fEٙ_Rv˺:?/l>pJ+_XFPw~# -ӥzʅ6OF-x%m> m3O轢;3Blį;b(L8t)L$CnxsET\ N/nQ/D&x:t o7{Ow8"AlUZ2WK l8?<ĵyC:o; !+1-Ҙ 0j7 pfE!XW.>l%H`Otc@k\U+'CgՊk+>2g!Lat4PqUWXNeVZnىlC v/VtI'<|{O[Xi+v"Z!!juJiBC|<4H Y 16&a(>-Hx_yF]+`k8> Ub9TfJgHj7.I 5t1ZWcGr2N/WDGWfDf5&%c@S1"6MG)M>6{@3AM`YP)S< N<Va\8(M,B{w w%7`FI~_6O|-@b$9TgSD2!ͺvDYlVe2a,mW?*M,8AjX2)=)8_`]i[/K33DFޮj=B5!#\l0e6YFP$" Wh },HkH HɈ2#W9mʛ.1b,yX_2*D'',Wj ـQ (-84ڂ 5/Ov1 !;}Y+$, b7:o n_Fb]"!ܡucS{X.?a6n,:!NCVgzd'P`uD:_GN31 $]x[A3k2yUP45b큘H=FRlɐ1֊:븨k0FԥA`&s af_ @AM .(^AדC%^uل08-q"4T5)o˹6m4e pzhjHiz).˔Jxt9Bq{z_s *%QqXY A6`6/#lpَ{:Fn:'ZfNDK-IASm]enT]Mj%a:$VD׹j6Mfy9N5sX0ׄ};AT؋'+?UF0 p"W1w3aŲ pΦKF@-_Ї8%]p.QQ.قKhpȤ8Hh1 yָxLc(1 `*IbH}{a\<8|Z*n ԇmvr%5˱ 3Yfc/4B״b>.n@`bL_<ݖ&Qap0&r_\W 䜻tRFۊ#IdBgHUA*-j .kTA#6 eVtLJ?C阷0]`ٖ-z]³]YʒLn /rг4ǜOt-q)Cr*eL1S>L?SM| @5ԛNs>mhc4gvX} VFdj7^MXuiK< AږGan+dp/x߁*٧uTK1NO(u*YbdMU,$VbQS G*k(\ A({.cUd,]EKAY\߭ğLcItg ޼]9=UT @Md'.(#yHHῶ&B it/_FPW]J+,ypU?;. -#=* $PD2]r+v62& ox]tuR ~v蠲۔8@ F"M S&IpbaIeU& GSi.;&U6Aw⋄U$cPZ&e7}ԮFlm/+ŧLx)6K[D U3À3>XA$)z$^H!טS)(JMXiQcz#y11rm̵ι"%X'f.JH> #g'  !.| |WVPЌ !Glh/hK>" j76< ChM c>slU`a1gOz&㢚WyD90-%Y%߂8 @3V *9Y&(xAU7KujTV3 U .w2 )@$pb-$]sO5rTk10ҙ@}ڜ[/30K@'PhX|EeݵLM9MCC'|B;*Red(dpEnޗC=3>w<1sSrEVSUpwm> stream x]An0E7`Lh6&VU {.xH_/״l/M%BYQC0PFD.:uͪ[^sbY5nyַ7ɝ(,֊kpKnt?svendstream endobj 284 0 obj << /Filter /FlateDecode /Length1 22344 /Length 8791 >> stream x| |SU97mo4 Ji{Z(KڴJ[EEAm(;: >eQTV23cf]qwv2]twνiRs{;wB !Fiin"h'{\!^URx -2H8eYJ0ԃ]^U,6.RIY]=+쩇"E-AKg=+B9gI8߂}%}X}k)D/$#ľ͇E;N>~ @!({nNҏyxuGDF܇8:t˱U*nO]#\}-I+]Ƞ9 g 4MFqMV܆Ol4u.J5J8 죳::CzEzEޢ- 2}~B+h;݆>#BU wx-y%#7 =E!OHDDf-- YND-d9j*HoD9?>%T+6/}bSEP&A! BzC.>0JcוH_xA؉2>CGppOcBIbYgX'CL7uaꣅggsgF!nf#sТy K1JB`*d˔HiB%q܃ ªJO.~FwN!ʞH2H"XVvAҒa]Ŝl%-[+ǎyҒحPU,-DLoiWvZڱz8Z>ǨnJcRn0P2wDԣ,rY.vla("[mdI$i![kH;mn*)ؼXA&p Y0IF؏'C??A(IW> -b -46tN&z;ƌYȯf~-DGTLA*3mJr-)z}}ޖdɤ8{N%ӳ9fm"]3m3əMo[Hja2=AtTh* wbVZTDiF^O|)lӵgy0L:Zrע^,W`7^PB~ L+$t?Pϝͱ `L]hhzEWGa /:XbB AzNowoBr ++C] ^ {{ػBg%F+WSX"YSG\ڠ'M .%vy=eJ7,x=?ty^, Ve1ԳUW`B`g5G72-#dӓ !8v!vԲ7AsO@d~ғ=Awo7uE?>7i<(mA__лq'Rg3``XdH-'yJՍp"Ս"l (9~\G1(^ oa}(q xr{#!ܥ++62Ή?Z.:W;:=V*De'+WdW\߸t:AV)S:H9:H>ғc x"ZIJV5;|k73X+ZI9ZIRF$VRNVjR.~ILK^.)ߨ\t$7.3Z2zɤ~$/)K&LӾhfƶ}iUGr\oRɱH&ՑX)U#VG7 G>a|G>yᣜB#ghM4oE\\U/W1\Q UilA!A"+I2ED!㉛Lgk:B!s&J" /qb@rlI7^ i=/>f=))THiZkpᚯG[q"ҋnuql^%RK!D~Sp}pǚF!Xu/pqegs1ܟ=Akk呫^qs˱pܸƥ'(pp,Q>ӏ[z$1NW~F16QA n:ƍK։Q>ѐOBG9X4qY'k%J!<+5n{ anOrBj Y31kZjKӜmhУ%9% h%&P;aO4||2[BnN9NԹs! q$梸s@:<75M^:=|Stg<-|'b;K|Ndhԙ}GIOÃ#L'z]lusF7Ƀy8^m,jb9ŽG|L1.e]Ntc$ެ: ׀c q8{8Zb3lGbl3d!ǥh;ýGnYo>7!.A9 bkCΚp/F|:t8Gb B5zMcch:q;C301-2}6z\kUj絜kmDIb3wȃ|F݆zt | \]N5hLn Y}u7T fŜ&Agq7֍䔝#he1Es[ H: =,ގ We?6;9ʈ62R吨0wHs z\&NsaV{6 ?U`:XZ&)|;O󠡕;YG NPG:as%s%+%+OnNhWII>v|5ݟ2?S&y)S]S3y#NGN89ٹÙ8F' 2z\Up\ ΛWM~ j"s!r!c{a5-#*ZJ,x?!= `X+p Td7 |>;=} >s=fb=NMdΧk54r#T_U@Q*io n(;,?^/0;K}Yz; 2Á7S o :Tx ~fP~~)&$ݧ½&&nDEm dCg,ܭ]wRuK;wÝu7J:x k;֪rX ؎v~mO*܊z5n1ͥ*ܤ*LT ?T ח?p _?^µ*΅kdZU*\•XBߊ>V@я5I? &h؇bx%G޳ٌi)uJAadHJNDyJaaAZP(fW1[{-kȩyI-ՔR`h?>hɘ~!2FM֞d6}l5M,)ޖJR%)))rJjjZ1%]*684:ݚ\R.'(Ӓg̐gNOn2O:/m/ϸ+yW.yWꮴ]RdJ6dcT NHYJRK9-)6dgR1';K,*.g)TO.zIU9ۗ]i3@U}/ogu#RWVN><5dCwPӧUV -F>dP?ДWHG؛vl^m$1}XTݑ=9MmCC*wTR]Ĺj1X̤H!2*I6uFFݯ>JcLgutYZ\ZMG :]}6ߪހ[8G^-d-bJ1$x6禽)ۓd$3Got?I={ޒ=U璊Gcu+t%tq}y%e[&|Υ?y諛{H&鱍1IB'o$rrjN`094jv^42ML3gOKQ{df=d?tK-Bh YdFqY2"L7Nu߁ǶmQ?FҦc軔 ߠ%wN1Tƨ M-ʫ]_ 5cB0f(cz=rд vƊqYE-P-U@Eq7*7ݭ]pEU5¶BwAGu o+ނ b,ZP䳊& =K{C_tW1wǵЊva/QZ/g7Ϋ]pkτ뿼~Wα ˩el_N0,M }ωĜl>:gtJ[JKJGJ(eu~TP _l0d,C=Qd-Ӱ1lLۛvtʜF=c1||jLHXvŻ\ߪU}W]KCݭY$+ڸ!D}I%z*e /Hm4 Ew3g5o7Qzјnf\U1`$1TŜUxi5yܫbeRwۚ</l·E!wޫ|:W}NxM-Ls~~~~n ?㶘ܬ9:M'O*,YW"uH!i> Yd L alT9%I(ӒA%tWFr ) PHb4dS~Ga*fe> mIEH&ҩA}kT?nkM ] >#7T77=Mvu8ASV"\-:FxCT' m>Őj15"4)lG$u.2> stream x]Mn! Fs n0?HțtE00L}ǸE G{]R\UQE 1BYn15]|tmn߯Lj+ ~wj?P:irGM7jNx JQ7J0nڣzbPӳ(X'Fg5(WP3QݱZ@Yg@ׇ գF :>A),ZӮir1߇%sh~m}endstream endobj 286 0 obj << /Filter /FlateDecode /Length1 21880 /Length 8358 >> stream x| t[Օ9+YG,?d;$E[N,ɶ[R$54!_P()4C#ڲHk >!os>v4$3FBs>weBh;"?싪+ y㿅7a~/?ڇXxnܧ7!A_+  `6e!ypbthy'/}=FWm%6E0KvF#a!w-{tx5}'14N.Bj1o_OгO֭K5xDD| @=x6G؃p1n^{Eϥ0Dw@ajWr-Bc^#Po..'*#,r^*E].ƗwE=,L8mImfGz}|@qlH'D)[ U-}W˯uNu,\-JkI3}bU'{\gkjy=MVOOu!2{ Vf'P'O| ٤at]*1ىRi?J^G>T!<`Ri!>~HdA."/g!Ts(!mfXeB㗵0:TcmlD3qvFWmId3E,`V1*_TNT?E?%9uș6BbmlD i쪆$3)mlA'y6Fc:RH?X&9ɜR<; ʽ9iW-/ˡh$XdXvǂ+I\#>3PRdQS~;mS(''b@p[/Gb3Ź)Bqy  / ;Av @N9}r" XT4@0'?2p`8sp8#@?2 '| O_h4aH_b#1sg,9@ $:i 0N6031 1Uv$L<dRS g 'Y C&Ҍ9@eNPUup603@07"r<#A0"ClL $19 z72^H9A83Ufhgr|74D{ր $9#a<[Nl|@Zejafz0@K/| b 0g_U<$q#O|*%0=I>؀f9攉 ZòA)%A`o#F;:X:2mZ!h$b,)#Q/_P=Pel@F%_0Ót¼.y$NJ9sjy ƌ䓇XXIF}~ 0U?SM" X 1yv]-rgWʖ&OpwWxun;ew){VwvyiGܲk-m+ZڗK`_{WnkYUCfȖ{ԽŻI[rҸ%w7h-]@ųBƎ5]-Ky Nr7yZ2 dR \ٳm^nkx]r˴c6whor{[:%Žͣ4[;&rR&NSI K=.wS4豥吠{Dgs X$ ']InsoqoG7ʪnSvwt34wu̞V>5~ډPl&`@'wy6m-Ө;k$.4 !KYQ[fDZSM<}wIh2`HFX2H#p8yr7`"7)6'MXlLdB[c8S\9-N*`< Th48`c,㜄P ks R!!sHBEW-S+.N=7uU L 3uSZ{V=MJJtR]p=Y$~D3jT.yI\KT+*$v{.h8"uDiDI>N-3)%iJ&u\~Yc۽쌪#l#䳩hfu$QuD䳩N TCOZȟ.|(|(/|&I$]hp>efch}&dSut ZP#(ڌb(J F~4u` 2Z0 _  #'0Wȍ+8=p $= ST@ih ž0@3>|Ql [F>-wD2` 5 07p2u6O7"mx< |Wr)0p@ P$ejH`3ӊs;-sP>Je\a-[0:9a-!Tš՝UkTSpy*`Mh>Ҽqb?9C{VyW}9X=G89_~< K?IFCZ$N2?z? [ ?ߝ&%Hp_녧 TAOAE8XTl>0NB0_˔()ClW܎p:3ܞiFnIpDxPq4NNjN6+ui6r} d4$ fP +wAs|*L~}DQ3[B~N;9i6jcg 2sQZ'f0'hOMJZc9 seq)͓}MՆzNa?dc?$Se:٬-*u>c@!Ԋ)i ^=&iLOoʔj=mtL3U=Ni:1g}<&W)L# "Ii#*;9),y:2L)K/H#Z$dXmzkzzxF vd]9Be~k<'On'A=S_ifh.ӆgT52mHbPi;&cr^~byȼgN.U# ƋʩT's)&9[.L{-#6nT5ű31 g#pglu;eVm24sU@Q#;6X |y%vd4j+R9Ьi,՚.U>W(ws+sq$ޤ,ߔkc),pLLm)ʰJ#㼉SrstO+I[ujݠGVTl6jVq~D[v̲USnR0;P-֮:K[]n/F+x,z8ۺ;#<~kHyX:#d&( w:Cŕ=قMܟ4SP!)皟$Ry{ɝY5̺әk3+5 /Sҫےzfu2kްoj-zՇw̪7s#d#>ӣZ$2=Qߙ<ҸԺǫF->6O~B WlV0F4Xeps ime!S1n.fd7ei0 })VO{րv38p]SMUwuAS+ϮDɟs?V?hr%)HB^u J }%}R🳯D'_\_Ne+iJi>=E+QiJt.JxW:{~V_EKw7>=v ~L؉e_.eJ~]&7Le$f]&u^ƹU_Nk/wDO_Xw}#)zG'ʉz.͹гvf9U\th'wtr:lV}檆e=j8o^5U5 kOAhC=@|]W[Vf9B~@>G~-#!_+W // 3϶I?W϶rSHB^./א]"C!K q򢉼]|A!4NFq1B})=gB~ҏ-%?'O+_!?xSSeI<8P<>#ߧɣk Gqw<GBw, ʤۮo}|8wM"{,2HvJ=Nߪ"waEft|3$Ȯo<'R7n]'}9⭷TI#[ )@n\mnT 7\ 0NOJ7^"]WG*}6Gi%0I&lWrM>ٖK ٢ͅdS1X@F88I|Fb 0DQHX!Ô&~,WȠ &4N`@[8[kfB礀B$sĿ]]U%#.ѧ\]MWuqL֚ȕpe+nW(d UUdBV(īnt)rtvTIIGi iSHB.'-d,s͞RB<{ISc4NKIK\ K\{q)Ni\2N.VE iPH|T_G.TȢ:p&.q<*7y)*]֔JRRRy~l%+pJ+3,)"ϣl39YRUiHT8,R8,ĞS%lj$ב"RfR,̤dp RnR%R)THA>ɷ|+I&@ -fn%EĤBJt71Pbpq  @"JƄ\ ES]"*$\w+> /dO-ICV֣I=gI "9xhd94vh6jV٭>}'I٭7AL7adxG*nE硇]&l˲ ee XV.bw[njgv-71*u_q̶jGW3x\ rLp z7G}rl̢|^na}mkj^ϯkU2 A``K$hfXȖL&cAfΈvީVd/Sq(PpSA<Yb1Y{j;E&rPByZGw:ǝt`c+OG!Ӯ2=geAqlL-.,B%C+1i:q+??w֮ |#)G#G I=;bt]J餔LYYI,#]ْ*rU+XJGOL9'9c.uҜ{6#k,]Qj~}W=tܮ] 0gYD%Q ptPj ]@ PYjI6'iTc`dZTXyU`m]RÃɍ:V0x|x/^<\'|1 c/ka=nRkP ،yȖ=-5jӥ6/Q!XKqo[MxjY+wBøG~/?Qwr݈ aVM;ӸJ?QtOg]=V> stream x]An Exhh6&VU `G,q}=LE?ݝkN>isʱcy@z[:Z;՝_}.oN䓑Dz|#u<]Q&y`iX:gQ7P7ZCl Q{d( 5=2J(Enmr))K)~L}endstream endobj 288 0 obj << /Filter /FlateDecode /Length1 20884 /Length 7819 >> stream x| x?sf$y/c{l〃 $۲ۑ+[H2%,4@HI/Me$JMm^n$6ۛ!]7vIpe %@{+!Ϝ&!$l!@:k {! O;۞&[Y&?70P%99ݻ7ɘs{+>s{pa|ZO_EMV#~7qkv;KyboC؝䙋XG~8 ob$D!r /dgpel%wµ,y !Sp@ 2W yS9E \>7_*piSrQq?|.{RBHl8.4 -8 ȻHE'|.D6y'"&;k1 md/u|\flޏNHT D~&!H}, >K6#ey\7ח#K܈dy >wB𤰘R5d~ (;}o;@~'tODHD8~t&iv t/*wC'*¡HPlki0 J%#II([VYKYuŗtAږʁc玬CX$ DQ!;[Pv P9 r B]1XU=ȴ_\OO/ փQ˾`WTRVȼ; yn'yC>_0Q~^4 ;Bqm$o t|)RNP h(JDEx*EQ% K YQȪ&Ҕ9DItKP3#A$c!9>OP^t6*':Ir!:wWhIzc P UWUIPhWiZC60Jir/+HJe*}Ͻ{u4wo ]2UuG^wDh;VcQu{IKSw|ڙ8Il^wHqsʐA*%>9_EQ,ev|C*a[TiˇD Nև |w0bdw8 UvLR(="F_0M'^$cNJVziT3Q#^=0Vag8 $ͩHaB}~b;ښ\+mN۝m+Fց2Zܶ%#Z-5ɶRGkEjw;:6X㚣eyYsm.űB6vTCwPdΆ8;ZjEȜS6Ѱۗ;ǎ8mɉT("jhk_t4/vY -ik/9ZdDֆ";eR\"پXlkin[Fav[ۖ٥孍6U(bs,ȍef*NSICv"wtzt8 .GM0vZ;w,H+ gLVq9] VV::ttP49ې]j϶&QxFtR@(zZnkA \`ѻw{|m-Ҩ;-k$.U%,v-yaآ^>л&RSw3`PD d2H+/yr݋"݋Ǣ 6J_H D1L&W#/jpDrRJ%T#hoz_*лqb֧K͐{C1 +*YXuݥֲ7:H:HJA5Aҥu= S4~gS& zj%9^+IZIRJU+I7V|V\C$]VVRjM+>$q%I+*4vs.`HI%LLؒIId?J$l+-il_Su$%%HWGTGRju$_Su$[SQgM D#]?B#]𑯢X^;&AŸ+v wW{Z9# $Dd&=$Fd2xH%֒|QBȤab$7#\u WFz-gW|3ۋUPBJm3b#!<f|섛I$# ~ N!f{ct0,Q(uu0xCj-y =>?;,Ae!u^ ~=W!\#(04`!nK-Nn}>>R ,ƍ1Ԍ; ^c(c2V夑=8Jڥ,Y*Bn|\oܑ(V1]õZ/B%kgO=lϧͨ5[4R>ba-T !|,yP5-i8capUq Z]eWRY(˃gܚ|zhc;qqԫEҌI 4Pc迪SIЕ0/RqnL.܍]t -=Y?âd@:1M3}l-U 4Tg:X=U[K)$-ÒeaVAдn+Kלm81W 0}]x4YjR(z7aaTk0qQ?2[BF8hֱtiܹce RsQRf Ǵhc%zNf2龦jCKWgrf>Wc$JԕRl:չ;T @=ޑXQdmtT^60e@vͧlLwRP;d'P-`ӾRt~f8?.F5VVX3(uG"FX.8_dXg[t(w5CnFO- mˎ=y;NhjiIɵlYgm'ӱZǫdn(\$P2`;=NBiy]ĥ֕nV-PjqyJ0{Ǵʄׯ/y.< ⲌW9?֞LôFH,7IخAw ^k=:JSb*N7/YIiɟp?H~Pz%I)C^]uKJ+}%)J8Ok4n_))'W/dJ}t#JxK+]|wI}>W+ZwI"ݥLwIv ~LKO$}LҘ.SY2I$b]&#t䏭$1@KmqmiKzG;.;J>ޑzGW7ʥ:>]񑮫s3۵u|ϕ7C$; CgU\U3O5˪*Vq-s?u X/~h>gc (pN?fmx~?#o]k=»g:w w~[-3 oʇ_?+\%rz&x^E(+3QP zX|US?jxyY|y*tT%~ X)pB8 3 qXx-VGX/Q 8*pH+{6<}B| +@.g PS*`_,~Y{%(YſٴI6m{U n/*Aa KЯ@lF!@HNzqm8+SG.u9 _Ȅ5 w*z$U0Y\Y +X׃:81 pǒ<ڍЦ@2ت2(w*a䁣(Kt`q4+4AhT%6B`[ V)prs sYBXu Wym0oIsŹ&c[avbk5F& P5+C2 ̛+ę^2W*sa q WMF04(ˁR4d/B1P셢,@(L8$/LDMMT`0 W O\U r@V1KLΜF$d(`@0|yAM=pqDnn}_E>m*"<+_|3Lf ݇A ##KR@Gʠ>* G$_%':z3N?<'DG'֋=x2M(כΏGF&ίYڱJ/^o2h2n'? QE5G~NƋxUK3Sufy[ɱC3Da0!~}Z|$^}̹FL/oz<uCΣ.߉;,?ۿ+ʖ _:w ?ӧ:z\Od*:3s2'*|p2m3Li*F=v9s$UL-d쨬r'b6rlx պg7J.^|uu|;u+Ǖ?$rÑwtuaV&m()6dz^2dCVcҰY@(%z,4d e'QϘsϧ5A*o\ͽLٿ7Og߫7UjYa,FK悌LLdn?Ca9: 3gTʕӦoenʥuِ& S Eӫ+Uu-+U+T-p\A*pN1js.k'WZsǎo.:;_w#¢gfp웿cs款ci{EδoݻboCQKճEC_A#˾Kn[039}3Lru匯d~l!:̐̏ds=z<'':~@h\8 ̨~ !p4E)򣊠GJQ2gZu'gq^ i2PLGPzS5=3#fz/q_Bt/B;7r3&] s{ C'9li: I9M'ϟA" ϨECҚW3}ZxiioM8-UM-&ԁ B~pŃ{}G]؎>uw)+QۭSIvhɽNj̹|J&49RIt 5XT$8`Zz& [<7>yt %reG5f6+{7>Qc1p8c{t}EE}E?+:[$."EEE_mts\ 30aȔƢEтzѳ0 > /Font << /R135 93 0 R /R137 95 0 R /R139 97 0 R >> >> /Subtype /Form /Type /XObject /Length 834 >> stream xVMGU6_`3+MUuEBrcR{^H,~]UU5o>vr:2SD<ͦ{uΑM&>P"Dg8Edr:,^Ǒ7ݛ=sYnvqqn^^m *d' [lzl"hIz=0NX> I'd58Nz@l,oMA b % `8˰*r 8 %N-HOh$H/v̨YM]]H[=Tsq%S-t)_F4$ɊPzpQ[y8N8Y UNe=DdPOGJWX#d^[kAۑv}s_> stream x[Ys~-?ͨjǸQJr)rc?ȩx)-ZKQ~} # WGJC F)i蔸⿋O .'o'uY\MarOK,_M«tjTKX.IEY=L"YcՓ4(!M[ån1q懔MLM+SqZjY8 saTWh{m{4*&m\SiE{*>kBo o r|21)Tt5F.'g M`cehojm,+8'NB(kS] ̂eQFwJ84HUa@V߅N"F r5vS){XEm @~t5B{< sviB h^罢 H֢ &賤9ZCQ4 ~کi!lҝR@Zo!DSZ[ NABk-ojYo24 ϊEhpαS܄3kċE"G`I=_Eϡ@tAЙf CRjLQlL6\h^2Wu4Z5錂o CdBqw*E͔sz-df!x̯ExwE@=J'; ũGyyl##љ“۵<7aC4ŘkeY%*p" 4a%Õ6*Q?Hz?[#&#dxQmD[=菁4Dw*iXlD%ٜtNjhF[sr(n{͋dG4=m?9r#JVPa=ex@t4g1I"XF;*cxuAb"~@".Y6I gT}( fidLsÌܙ)ŧRe: _4\e1'4|WMq0Y!kP:tI ؘ&g9.Ƒ7<7sx(x"⌨u:sg_$Oad@YpS1`+ȜRԵj ǧ!N:ˁ.ePB7!*O=gû[>Do>>l!4̟N$v3z?LuBdq,J{A˞AfU|z_۽ƶtߎ?,9#}fW(prY]L exb Vʢ2BɃ4o"fز 3L)-gGEl xU>J W=> <@BaT_EEECE(ݧ@2t5.wGKE/^NPt@TQ.7{H=_Dq2AׂO3'؄H1; { (z(r;0nuWx*S\͸6 JibQ԰,e/J ʼnAwӧCWvz<#tg ځC?sAG,9#>)܃()37X0 tWahv=4ё TeQZ"_b[3Fm}L(S+vX.j/H߇:kdTD4<*Y#3#452wndf,MhdĸtPPaZѱ |w.664=텏PJ~:``1j+5Io %K] *B}S`ϼy'x+\MNm =F#hEZπ(lm v PDI%=mFD4{KLW|C iEONBJ^$huI'j Ӵ"] kj!o]<>iu*o+@ݦpw;I,/Or'H]BqzG 7uːX2߰{Yj$ H>O5CMϽendstream endobj 291 0 obj << /Filter /FlateDecode /Length 6977 >> stream x]IsGvcGt̩{(8 5#)4"m4EA48u2eVVc%9tPF1;׷|oK\ /'Z:y V'?HU˳gϡ7e"Wr%+o]=?;nF ZH!P >h/7Nkfc^Ǜ}9ZAo~C2AI]Xcn}A3* +|EN٘;:LE.hB!D|Sz[Q)Ǧ`z EPAͻl3p (X{9tRFM9ؒi_o7/pQN B{Gk7q!?DgXkWgV83"aM!`+=HF/o£r&>}hCҼ,ץ+ͣHgl [ ֌*=` ;ON' f~MҿcWzEu qьA ˛nL0o,>=G@뗸(Ez} Zipp/ .k#z3Gxzi6hNqrXKҒҌo@L(ii~[w.9/?܄`fc6BȣѬA*OǞK󲻖Cm_J=XB}NxNjt P2k YH.Iw4PAGHMin$:[Ϙlݦ^j%gL pH}O2!?&7"7w %(Wwg0g\Spց[2Pl6K9kmମPnn\]6dZu~zAI4뿯Z* )+ j}V"O[m*?ݟNɎbienD.S,;.e 5D }H!,:ifv*'`*n ߎȾ\uvr`6fX_0|P-!6˯`DN dZI8ݎ ^"ڋ}oG%ۤWBAq5id\leK th8EJɘrm;—gK w;PW. Qk|I+\g9DA>@P&]岿C7)'r g+E3bn8U,s#nV[|7. ;)~q9gNh4PֻW#(Lx%;D[WyȁK`*V׊Q~Vhcdj^tIˌ=턆s_7OH里vCEBt kkگ_h6vQ%˚c2u} }3$/<0}@5@+\dV֒A:}|a 0qt:yTa$C]dXQ8_Dw'ï&1ym$Zcv_]5h, rvz} j}FXW( տl2Idk41% g(nUƂYQZE}Gȁu$eQ p}W,B}fIB)"~JdH`D|u8g0[@95B/[iu+$77]5 丨 (rN8?T)&mtq p&;~epY;&(v{CtRu:r%ѓش>mėd[2fhG#4 iVEx碯#Γ1HTgҌ'RycVu65.Q6p)r|e%M!řG9%X8WYU}!l,HW&9뒸/Iki88`217T'd(A Qsڶۖv{f2m c PWLrm*$ 2ܟA/#@X/"=."G{C` AW&@Ů1Xƭ޾i (6X1fq$`3M"{hSRE JxT 1jCDhT8씾>G.Xvul9JNL9-a^gm(+Oјs"w$cX)6ç)eCT /WD&#Ԍb"X:G&*[`Xe|\T6BT3Jc5˔>qiGJt)0U#63݋HP . ,Mj4aMH̗L_ (K`[V,dzt}et<`sB'E`C/)aQ3|) LB cfair <`1[T_cy4%`7t02^654p@\zoZKch%@`>#^#;iL篳@+R9.!R8*MxR5;닔f"?w 04$A ڴD n֎? ,'DijϊV P0[|!R Zq"D ~HA/g[(r4NVէd^Iݺǒ!w,m>9Ҁc@* dޟL@' 6W{wWW l4 )f yɏ#"w.%W@OK7$TByMQ!kݬ[Oh1,wVgo$")FW9+v'TRcLd\KJ?f@:Zk P֤S'""KjB;W*zbncj:jK.ࢦ(JPd̞9#)$Gs#X)A A9v?ljވFg@ m>/ħ#rGtZwy8#Ԛ>)Z_ +>4q5'fB3'Y yگ6]uda5N.qV{ѱG^ Jsmr~]%ȮEE ؠ+ a9P4Ft9ri   GW $-g6$ɂEjeh8 XiF&%Iu ıl69ѧ&&R|?g* ruﺧȓFCYCIT=aXM Ҧ`oiU7=Pt_#ߴZy ^(0Y!&Va- ?LdY?w0IIvH흾5?(+OURtYfbcwUb׳,dm2 咸aSz n$sY (w%=o9Me-jPVHN6z<7U_PȗtL:o2rĦ$ew.O3X/1U@, c{0҄G\tO4+?\ 1g쎑yb\[ %_{$Za9Jb013CZu-Gob$'i&==GPػ) t֧J rfD c5uJK38%o-cE\. 0Rە׆C6? S Ƃ"-ymg*De&`pj?v`ʁ}Q.A\ fLEdfEsem.Rnd黗U!_ui8:aỹC`ޙ|4,ϲpVoͤ{?OrËpK'ݼ7Km ȥ4,93V`QMi^u}wy^?՚"v=/^? -MV.|R~v^p Co.T"]k} j' YJqlPAY[ݭ,a'@f.$+)?"rǓu9@(V 'ݬ~~H}Zj9Oi*:DSXzj64}_'҅sw[:ml? f$յ}{L]9]/#'WY5lc,۹t]u}J.NQZy`!C Xo։h7 QGWĽCOCs/Sڌ{Znh^asv57 tLpL0V59{`Z !;mUiRSIY ^*>w)()ISgRnX^sLvD>Deꝗg} p /s[31~Vy\n 4F[vO% 5(S*wlIM\Z+3JMŷg|uOm|xs6_ 7|&-㝽Gi@TP6h0wBc-?ԓG8Nǂ`Oxz 1Â}V;n{ؖf?d\p^s+T]9|賾?t=(],H1%TN1=ZUeLeQS6; :',E^lqF#v_EҢ+Ck,pieO)apK AAh2uUq@ jY+۴-A ]!/yT|;`e;8+~%Hܠ&ܮZԘkeHR_QpjZEq?fO6jIl:l!M + bv=Ґ_~b B/)ٸ|3Ah%HqywUu%upnV2"u1EKPivχ 6p|+:5Jy؁aY=BΞ*^ެ,xGMt~ *cmG #{99&RUw1+lwFKZmTwygocAendstream endobj 292 0 obj << /Filter /FlateDecode /Length 162 >> stream x]O10 @ ]ZUm?eB:gׁm_Xց$i, x> stream xY Xڞ3jj B.nU[](uWP @BB d9XC/ *bDkjnW9O4,|}{GEx<ׄ];e)077ܿX&A ?w #Cs!p׋KŢظ1Qc S'O~#`^b(>*2)`ydZ\Lbd#!`0*>&M0&$.--y֤IBQ윱2VǤƈ2b VD&cf`ЬWBf3vx$‰ b% xXM"b1xG'6b"XHIbb2BKi25b:F +׉9b 1Dl!CmKMC ?O&b,C%Bb  xi:彙2A?A 9$-M`OK*~dq $IM/[T>epIM\ *EE z;v'5p"ikK)Mۊ@-{ߞ!(|u9&HS#5iEM'?8ԑmVɺv/tO֒K*I●qDܱ xt'cĮ fix- FAz?=뒰&;S:uN7l \E"@8A tvGnڅMq;/Ψ+zʚg.̗0Jy ~OD@`4@s8tpì%)@MF {uOҳ2]^{yQ+"Nr iIVԖtPܫWoMJa%Yl=n䈞 t,ȪWJj @[~-4Q燀:whDL:Í';H)@UJj p9\h  ZA@!hNCv9gU2n(m0RY&nt{#^3|0Hot!kbx*鮐d|[nzBER&rm(Kw;iKj bPH쪊fSE|/Ûw'h %vThR :#cnw㱏' yı>3WA$DF"*dHt3Nhq\{[.EUj{@6>4L*ecݓjE<_Y`a3 LJ*m6|_;[UȠad%< ]Ǐ$V A.|Zp:\(7}H03#goxNΏ9쑂 y Ҁ7Ѩ/]cM@xG+[ lP9}q2kݵBlե`U|t -TDm@o.gl(9 TYAUZRRf\9Q&fXGE`4תf'C7N%A.$t^lv34dB(V+MUZwڶ#DQڎF_CխZF ;@)E5:S--jwӣf\, 9!~ik/&jr$j&g`h$Wgce vKN3"#P 0Zg;A֦Q?R܃o mXg =NR$9O!EXr'{dID;=e Z2A# P4Fll65a=;Ε _AsÌ!u[G=)B_ ?};f#y-u[40;luA9+ВM+8Ty 6"~LWa>>|c>էiWa` pyڀ”ti&A,{]^'Z`nܨt}aMgF #NK%SLƕ&SbQi@㨷?Xs.sA*yojwM*tvW2^#?Pc]: Tw( FPNWAks򾏼Ơh`-H 2هp%4P|'kl,9 NO zz}wIk=V'ULNSvpR3x:=Lr3Dqv6wRa \g[f2Q#MqWς6ߛޮxBגO\ze:;ɯ4q@1S!S5,*j[w8fiyx (,t2GDoԬ]A1u4:@eCf54!p)8ܷ3dtiUQґ' = 2TP ./D!~i[VI(->KTŊl' e~/8@GJ6*72d4m7.rTl G}P'B((3:6*UN^~j UabfVƢ%Ol+O5϶ޝ!MKT{%d?K. Dž&IvXVL{z> ݾ# '/D~/~H]@]Pf);6gEj?]t}w *mg$u~zurjnLLPѮ+3u4w^v`ռy ;d{Lb +ϙDy@5y6xBqaƀea54|C޿\[Ţs~J 9OvTXQlK]pG.KPut>Z<WT M*9 ow^Yb Id7nlN,L¦KwצN%UlVt6JjMU6Sn _EN;hq+[;;8gWI'z\x*kfu.XjT0dvuG_P3rR ƍ=~0|t{ 78~. Z6cN?MZPgˁRoO?pV=֞$9b[&MM"};RHN/tEB~Ӿ!rбO Yf?xFsZaBPbhlihhaz )]GëܻG5*C>Oe𞥔pGhlLxmzaMۜܨ"XC_0-?Z&P8UHBk1f~"7d[H|q\Gnܔe j2%+ :{u(н2jCrFQʗ<}gY<[)zL9cU>3g./ox=ST8hQu4 dMmK.nTEЪqSDf/Zq|0(6 kvDr4USsvyrVYgx_/o?)|~'nF 0Z@s$8v^WwicFd\q|݀wƯt_1DgZ=) qm8Riղ> FFh6Sl+SPR҉IcX487rv<4lu}պga/ă;a J6K 2)Yy8Ńcm)c3J@gpuA83uE:7;B8>1&6y_{{N&t;L1ܢw2|"k^!6佊pE"OFGap- +^}7 Sи`|:6q]dTyPb(Q;Y FW zfR:K*k em&N$u(6w-egJ27)|[q5p/\Y SǻR.6kV}-jQ礠)nAW])MUF!VK5`r'9 [}I㶢k!gj)9(c9U' ҟKr>&|wΞO 33w~˻0ޫ4Rg]D>h [̅@kYu(9:)#"&ݙ׬TI-WJI88889Nl/$AѱDŽ_^n@@!XxB! ZGBQ`Nw># VeȴʸTNJlCi)s9S+֭?qȍR̆%JZϛvs=  _zPvU枧7pE~k>8wf`ZeBEHҬƊc],D _|BT"wFF3vt"' TO*!hj6b@!^)mn.oYih%G" lb D"PYAVR N蝧7[mP1A R`*s#Tr-6i Hnk0lF; 솣a` "8S$Q=/$mEbP_%LQTN`ԟ]xã]d$%Xya;@SQ|ʆb{3aC>B +(-p)un(%}:\]R 0ޣSH9@B+ZN߭rfTcj1T&STFj6Wd.xK!~.,BFޠT-t[&J2M7L;%%6˫5:X/3^?Vi-Ҙ]8vzlXV^Pv\\]Vd)UT"[)ec%/c) IO?kTU*"3| wKszvvzL8jsjWhms yx|KˋˁT)')c_CdB"< v\Rj08yG*& u4J_{iF oX(s-= UHӴӘ樳̀j()a=P48nߓ;B@Y>SzM!ڈP 7e6V8)#xLpsN& _os9U=2e`]tu<Ω?W=u0Pg#޿RZXaDh N@mV 4RuB^-(om$qԏ[,C =endstream endobj 294 0 obj << /Filter /FlateDecode /Length 3238 >> stream xZˎ\*7 !o;;|?[e!'li/ifF{FF|OʋNKogH JTbXSc\h_XwgҸ~;M ; .T5Ws7BhL7 6l=O^*Ǹ]W:8~' ق|ItecJRET܀Fw %@bhA=& I(;e %pYGG/eӢFA:uuewqSpc:3E|PNtVAN?X^m벃PB8pwQ Fw>|x/A6;㳃ع}oGͶٜ=?__6N޹3{?//[?~ίgリhauLh%̝v78ls><C\2(ܼ i f{1ʕ5#9ʕe;xdm[\|*A>r \93 ̕F˜LC18'B8o qAQ2b GP/U!Bn yQȷ y{9} WL/n\g{"wzvѵamtN-ײt:pk@:OWt҅dP}-"ڞG9GSaz2kZԿ48QTFz%Nuūb2I4h!> i( i)tG<9ƭ^BLPiP]UO8{l7.ky=֏O f`)&mA* V+<.8f|N~Ɓg @'ՓQ"EFaj捯fiqjdDnswA/P;V,+#c,BjhC|>6L +,}U]B_v@+U8S+\$֤\918M"L2ށ^:-grE2Rw3i -p dL/I[s_9c"aNwPk".Gǵb/@4U܈c]wgU`Jew@^zv}+,"> stream xWy\Wמ1df J$l."EE@@ ".mj-5 jb(*@Vg~n~%$sN|SsIMi:nk `hpy0d'91b%v,“Q"'nnwS@*ᮊ4A38@A @e<䅻lq^bgJx@*zH# otoBQJ΋1~B$sɷ[7 wZF zp^ \+QhaX-k`׀HL}/ &lݮ$Ds79hEM^qIGOH=+9  Sz_tj}J~ҢٖKMdzUWe*=Zy| rl6[,/]/]{#} q#ҧ}9#수1X9a:v_;+~ڊb-t_x:9Y|S.mc|%,g욒Fp`4ZnA X=Db{K 9fBB\Jj+}]/}'؅:ֵyoRO+kX!Rj}'"*x}-F+MC %b{<\ CҕZ)⧰(MYyX'[bΥ0 $]]`*ӯ/\7uv3;L- #Gfxts$" `/1$+d }縪&Οڪ7xz8wZ8 )f/Xj,NӴĘ` A[dRV4gLcwۏiF&ٱ!x~bl*|LJ8<0OQzjv*YEatx>5#שůG-A E.?bjdYXeCV`=-$(w2:잳np[CM")^6cU8 [a;d]kA &8|14Ie -j"^ ǿxw\n?~!,uKeξ~m!f!WTpXEaDwycn/E9ϐz, 0D kݣ:뙉`<K\!^R&Jv1>&ՔW2Y,O\mn|Sێ`P+5#YI̫a ,y{var~ٿaCm[7EwPJOeܘ9Rݚ,.{)[khDL+>]wTaR&ϫ.]z90h#48܀m]{*&s]h#5QEy^BBo Jz `U/CBn4aF8£s>w~5@Hjㆧ8׮|%7 -='vgrGQSd~ޅk ;P7DhxT`h=2n娑{\ pͫJGU9?tT=5_ P[ՕjL:Ol >2b&߯?yFKmLC]GyS=1DePB_1.JAđ͟3 5F{S@endstream endobj 296 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /DecodeParms << /Colors 3 /Columns 150 /Predictor 15 >> /Filter /FlateDecode /Height 150 /Subtype /Image /Width 150 /Length 29922 >> stream xiWUs( 2)(Lh &II4wmi ) 2̃"jqbF&9?>)zχz{5^kO<~Cor>>G~~Nwwq#??_e7o=餓nsh''O{.袇?^|:?ַ~ÿЇ>>_w'> /_@gvӛ Oxuw]7~{~WOOw~Ǡ~__g~ž}6n;ε^{QGso.c#~ }c}{կ6؏DC@ᶷ? A-5җ__`ţ׽u;wۿ[idw:7xo|c0 0%//[V PhBw֯N?_5?w ͠nglzW4or (4zg?{]o_׼x[! 77@+5Fv 7FOrhFGGubPCx'?I?ȭg hy{XްgOK?p_h[,&8 #8Bw]|A~ Ŀo }h~D=um ڛE|߱c_4ۿ׼*T?qs#A\s`x1Ǽկ^n!%8W^y%!߃`x+^_??q}' G<'WUx@z@OzғNqf:00+_J$}D:SD~z";)1"y=} Hx-*fп[l)".nڴ W_R}H/ &@VB2DV@ZGcʈ*5 $js@FY-@|0A'_[:'̩o~D:XjO}XxpzЃ.YNP밠4& |BJPctSŠA:7,;Nv2l 1& #mFND+:X^X@=d Mo;#} ՘>@ Bا.(1p n߾꫉PGX'_)dFi @ϧb0_FH/Z<`!6k[ ؐXHi|g DiaJ4ABsS 2(x#iXH`uZ(kNjhh"--|򓟌,lL,4fPw@UxIl?-lCP,-C6i!PLx쯟u w / sOc!aUh>lC=XS>>!a܁E|Ơ"hE fHg, NeYfEc\K9|&W]urdH! (.n=גA83 \N`ᥗ^ЌncHY#4:j /&v3uKKLvAQd1Cj\N,DsG> ,*hd~2e/L(yPYa F`r5}b!blcBy{Bg|3Z6 HB0`- }7A?I '! RoBj`ڻw/ZH/T HXc w ڶm{[x%`w𙆰4 ?5.A]&p!ab& !8دOJ5&|yCH4/-nBWG]w HOJIq`9-djH ߥJۜa!ut>cOy U׿3V# X^ Eԧm BC܄ TVK^1A\]@lw4)ch?vG= Cˆ\A̐XH= ld`ʀ$äuN Z`5* NYQPw@>)wԂB,+SV_124؈KuK?ϑn=ǝA@-%+ Ro8֊Ym ݢ,Dh}~fXa 9/w^!P,CBꄈ@*5xPD1qBLctxz&Fo>W^쓁t!|JR. .[,&mkl:wFqV-.!I"q\|a#3_37D}u! y$2`!\m ڀB6eۍpڝ[(`h<6 !j`MZvfP}ƨ薨iY"D;C8ObfeU *A"q% !h hB5A Є'Q3>Dh6Xz,V,nfzB3`Ĩ5qUQ$J ]Б@o ۝A63N]?mQvzazdFEQW V='=]x:Q9H40t1CJjO$[(ZxRE#`@1BDA@ٴ g5Ͽͅ`FRlg8OOKp[P a4ʴb-3uԒ뛋?wEC׼&,lQ񶷽 V57*׼衙&+L]:)i#ԎeG64B0̵ci:1hK{zIP 5׆X8ɹ@G>he|n-%u\H N^~\N*|'zsB0mn: 5:p)/t@R!D}ş@,;L䏔X^˰-oeM|˖-/x ey]mlG5q(.^EQ#՞cmt4PX#u~:y2<䃜“@xoiO&E!k"p!|ވ,.DA0I3QG\bVTNc05y$CP &"jwvdpdXdHكjf{Lb udLm'DF Y;#_xi~Ҙ":E8cH%m A<2AzHKeP#!.xt>ⵧ_ch8${R@P蹮NO_C<'eH q7At<@%Т*#CHRf( N?P-B/&*d~X,L;w=n˝W"#el6TfH 8}YguAA @C{; xh#jF?ДU@%^֔={>C 1Ab1 ?~)&v!FRT־]Pi6w'L ;{PAM B+GDo<̯p"Dڔ1/. !=`B1ƈi,cWDYDGDc\Csg*H Va4ːJe &)<Х OzHb"T^x}vʄsI'w9TaBK r3wD) ޽cʒ NP ՞41>XHdŒ\;3쐆 qTz:"`Cf/` yN蜯V s|l:a:vE}rI0=?fwg<'MH@5 `f : BK{.d-uE},w!b>"$g*#AP2PJ 2GڱbA) Q\{ApP{?eZM E}[DOD6fH)Օw[=>7\HOS1H eZk7_tbU;v*)D<$ݰfX`+: :R,ԦAFaP!iV9 l۝_"g6lS@Q+K²34X޽;"L!%8dHcv }JϐHX-vx FB/!2 ׵.9n&C<29d TnRB&Uʡlc\D{ӟN A;CŠːbr=ՓVh,C::dc=$>&}p+mRtĪ[ÐmgH)/rȩw ~>$iHLv IY x 62nvpltscd"F$ ZCZ~$D1$CČ<-1fC'0euŐ&C[wҔ-B ,#HГa3\̪!&dOA |]3$f"H <34X1A_W1-͛73\a(CF{G}4 >"67P]Sܶ{dB,_0x '(qDS09lc 閷8Yl I^p'~dHsC$eiP`}5]gQ1 Y!E[BC8ʓ66 YW_ NBD9xztug>ϼꪫyxA犝1W\dZnǜIfRH2ܑ/ tA`o߾}C4숋v߄\ ` u1(lRA\̚ ERe"Aۚ5fuYYo^'S'K!bg`HpҢ :LR֌0L2Ug n ^p駓ߵ7=B$.F'!Q=7 iJՌB(E~&RA3 ű0Ð\vj,W@b!(VZn۶OVx%@"f8P"r5>XH. " ;o}.6L8C:NadP^Eyoܸq2DrtjLD2 EjFNGBZH:-]8ҲT(B0#  &ڶG \H =lw&K~Ȥ4+`͈Zr%btc! v~I3eb uoG/@B?1JaOS@3g :J]p"@Ȧ ‰;v0S47Io-z-iMͅ`mH۷o/w =ueR||"+':GgGL e@)[DPLGLM)/B#5."YD, 6kKZG>ӶiP?#gN&21yLX#<@O>yqП|0{`K0C.QċZ;uB.Dn6r" 26:CJ e/{a.-| _ dIaa4/$S$?un@Hanr*F߽!" BD&Z2|x1i?P vͅp'<-l'KCk3!9BqnHIcQgvqB- 5!)n.4Bΐn'-IEa(‡,dpiy4pyj:ysp/c<#Şv|/?%H@Du!"b C+o 6jN~&YT<=\O;)Rwu^|N@ߺ@B"{TP^c.o$4-A9믧CV& kI'- ռkl'F79sGoxAGc*EQDЭ:$2-?W_}uiF%@2*;C GTtP  cZ\yր;*QHַ՜D8|C煾skϏԓͶKpYA }B6wAi;Tt^Hʩy K xN AcZ삐 [ )>u,YP}oU͒ 呕_FPW8^#R b_ IlV@l,+ W+he!)<ŏpdzI9HN Y/n zp M4Ը]q.,_xaaG\ ¬N8MHGNE^@3–@=F"\vቩ L%7~$=bh$CQ4FIjbydèܰ!(HK}+w:,К$F/$ 3V؃92@bQJf? ,ԿXȩs1Z_*N@B Q4F%G:8TG3I`;[c̽񌞙-VgRО違@/'J 7% N'3t'U.ّ!Z0l2H 6a_z7% iMwFolys!.]?VufjWCaA@'c2nl1T.#_Ю8ROZ^öm࠯Se݆D5_pixy!SiSb_ k8R<`%m琻hgx1TXN/~5$:1HX8 )`#%t-oa>JyWo ʄEE[޴HB<[ @72$$b3~!b },O ,|ex<|Gi}^Au&̣HE=hK h$j `3eT6e2YNuÐƈ/[kJNHI ^<3#]:7h'ndT7 aA;'aʣD 8-y(X'G)Ly]h0^B%QX3;RD ,+^猪:Uh|c\[}8sQ #Ml-mJ R-ҸBX ->8r|-`2`NULR^vpYf>s2% [E%R*(A\'RU:avurXiiJE/CмIՈŨxhxƊ2q۴ T\H9ף08G\U(ۀ,`P¶RYwKg?pN;.:9`vѤB x!A_}Q*WO:$RL:/s4$5XCQ&\h-d@*jtXTX#: % C4CĄiV?N=ؘ WdԃAuG ij:ZEIp5hIp߾}Faq )a -$YOD8Rӏټ[31V `6mڻw//H qdbÆ őn߾ݬ3J8Ri /.?UF8Rmͅ?Z;X\{|'?V(0z23Tš~rgtGΐ2@F +(@<ζHk'+91PV|N*ѰE8G&:Fр~bd-BEzOvT)6LmP7QhB"XN~1xR*C\Z#Q,-$/!9*b,<9nDYWNP :TN`֠`3SB d!4',=vX_ :ǹq\''|r9;v޽2\[E/#˷ؙr*Ijʄ 2؝! ,_Os OFlsu;S `Pp Tj)vmc?-ir<;w̐[XIE3XV綾^:3#$;l󓊊 V.b <"S'l4g-jO. ۤ1T}2/ hylf^ yFi n$?W\+$ (|!}tZOaE;ÿ`!+yMԃ70Pp[nxT Ie!<饹دZk$rBhbOFfN;ۜҶN o4`Kڠ7@ h6.>H{6l?%@܎hGZVNE ,d*N:f`aó%jxxH푢 ΕwbgoP!zP=R=)u v(ՒbmM-]*j{BSqT+'8V1g.MLKRFbwtky٪豍D~JDL?V6%DLHz%Msr2`89-3_=^$ԕj[ Pt`1^7P% ICHd1ΫŬ*WyrJaT=uN*8 >DaBVE}kr'C ()1c LRW&G'Spz$ C6ZT бγfv؟'P" /ne\Uh'HI~N=X2NڎLVڸ+AAHQɃ6f4\A*m ay/FSY* Q٤Ғ=FӴqMOfQLKBYz= f8J{)BbʵǪrbn4Et65hH{hhTn"(FSD9Dg6Yrt%q}0OT!qۼh " OD&]sGvVQ(LuLsም^YwU| @X{)81.9(fYfS, 趘rGbY"Y& k g,(% r):bgULYD(a^U`ѫ4{ش.Dt-sZU&?[Dp>Y];qG%`OafVD+_mn!,@`k 3mʹ7[lK70z-Zd%ΐz𠋁qAN  4ø-io}k'_6ؙC,&[`&(X^-[XX!r+r LjC&2]Qe*N:~Ϟ袚 TP5iMJ%j6!`%$˶%FUH?cx]/h_DdVЋMDmx_|qIB!F /Y<yƨצ+׾{*xD/Q"[lA(ݚ  {*!q)Q==9Go*/}w.V\DYVGbQ1FKs@[qZV[ux N&Yo] y(@.4wrqڜȷHohYnw2J:ٌ Գ޴i ;Waꍹѡf;. L!4g,8 B+>-пRxi"VW;8 #0>ST NSAY67vڢ /d!ނ3)%q ; RyԌFXo_ ^/ AByL ^o SD*.jѝMޘ `hB, [Η#a Dw65r 0i) Dz~x7d86O#5_.ki%|p6.%A#-׾~Ȁhnl#EBir;ZYwZR(pm2&Echк>%U24aZY,0h(3 py1\/ЁaO8X#d鄡z!,v0 ֺBb<;+PTtE\;FYwQgޙUk$eͩK;{3hAu&("ĺ˪Bġ Bq H{:k؅i&դdȻW!$wYԿ:v'bXNBr@"hrca(`.3ڭ M*ё/6XT.D"P<Y{_ To3grg ɿ"~~5˔vgР(ud|Mc0E3n,s iα|N8PmQdKU}'H!awmbκ|I+W’[ ^A AO?0CR9teh`2"'V\B7I:l Ŋ0# Ő򕯜j*5Fieq- ^C#BB}t# @kڹ3TpT)XB<锼XJ $i 糁+cU j`^y"G_@HV0vP#ÎP,{ 6ݢRh67hSi< /04!AGT:hs[!V_lܙ ;bQanֆlܹ3wuqǕT\W+V^L MvIG+[~}L) ^@ }FZXQ;3E3--j]-}Z>|f ;BU:e DF NI|ꑦ(ˊ&GfӶs5W% rGK"d%ADvz >|pMkN'Дv1(UzsʢFg-hWy+ؙ U$RCA2G:b<oURP@vk3H1h(hBj 8 sDZ_,c(r{VF)j' aD"h!B ܴͅ$+ |Ïy1KlٲgϞBGZL!Qr-3ddF:(Q{,* W2YTXJi_tB%eu붓 rzI S5з> '[(pUL;8SƽU;c-L'hYt(JK/G2b;"I^nUͰAݱڪ`,GiDFB2E]k=GrK`3{0nP']L8erǟBZ拋`<9 vgSޕ_Y~ڙ.E6h˸*J-**xct8 B GA B2z e`p5Vtg9O/-BxR⇖,Wywa%*Jlˎ|ۙD6,b2?)G'|QjWW,h!ŒDAG~aNcU3/P:\*ys+ V{؞f)wg)"EAP]TPxU~v ،u1hncv;^A6؊5 { #2f_k 36pN]uu!Q0n(j90EnzQ-X5#@"UՠBQςdHY jHָMx=rWF#/0W@O*^X,)ߓj$^$x2۶mZΨ?/D xaOh+2Vx¾W){3A>qVm܆f_Q& Q_S/Z;fLUܸBu#~Upܣ67 mV!HUAHf_.ȋp3.$ő̦u;y;F$tRv]Ӹ7e0tK =oADؚ2I/U7rW*v-*<a1ZP% 8UڶT.k?OhU t~[-NL> 6ZN"\O*bhv/~g;ec/X>9m7 w۝ћf퀎FHb))U(,{[Z*Z<}kOX3fHG}uBd`f%^LelkK m/M=1:y]_*k 6}z4*\3`lUͯ@,<êbalJ"e;v谩m'&gQ9x9찗\|63a'﷨Dms\TD|6I+wOMD 49ؙrw&=J4mM6鳼'0/B͍zƭ?%"ؒ{܈ɤќ"-|vG YɺDiҾqF[rkX[wSYn*y: *_dڕ/!]u %D(klvMw3V{p6S88 ";M?/TNZ%a͐Vv'B$.TZT}%Ц3\ۻ-ېwԼ34ЃX^ɛB3\vjAhæ/8-,.|IAK/տ* ^&`x-$:/QS{Q_v (C K6t Dk_Pv2#B,I9TZD  zetTc3k<R3\W^XڣUW].˨xQ;.Q| ~@fzniO/ kLS*^0KӊӾC+R¼kX˪p\.څ;r:tBD̅mu" ²|[g|BpLE.9lr>B`pg@[l1Y-B7VG,4FmAwa 9 qMr{njqPc`U˧艅XB!fle|w;,8|&W$U|>|;j{FX‚ jwfFuq;vgzaqkGPB)֋,sqۜ l'`!|KMY0/$k{*:)#6td6ʫ든ho*-p)LK{0E3 lmr Pd6/fI'kЂ)'fR"!❎|G0g@%7=$|mγJ$'|-NH}Vf,)Qs3W*HB.FMꜤb-ENٴmSobz@;CX "Z` $CАEEo/#Mz6Y!^-ÄP T;nicyn鸳i#ΰ]"] #8QґJetPnHhzD[DuHEI;%"j6:Q0|\[DѧlB9GZTXq4NfIdcߖ+RTn#Epaͩ!Ee`9KV:`iާ">[Q]pErP.,w洄iLҸ&0kG OD.9zIE.On*m@kNuf]]J۠N'vݝEv_,뺓JX1xjրxcUp,;jN}'a;N=p2<4`'.N^8 t+oSBy:ORo ªL|0ubu];lWMU^9dBy=RU#º#0`@nPY;l"8ѮXh6[T`լ .uIa+Ŏtɢ(zMĄNAED"/j+H%"lGa [r -U醃WP6X u[|4z\Au(d2Toz TmsթKb]c8#λrb @4ٽʭܸ>n߬S^#RtGl% bJiw2zZB%֭C q稄XdK޸%aevQHow"."1O}}ͮ  HzYgUSsa7()Ld:`K A..jw $Xd"+k/п `-\e\۵f|/-,>u8RjdD0;3#Tt,+.EyE3"X6ř_1M -qZc=0 He-h+9BTr7 Qti`HN+ԪJ^9ؚxsu ]fSilQGےӊ#m$Z/=lz.k^8GLF|4W =r`KNܰaW^Zr!3څ.^zn>DA'/۝龲URI:PAТf>KKtJZߴ؛Q[-o:l*qq!HX+a:fA:t+B(.H(TWJEKN Gm -y1uSFL'%Ql/EzeQ%@ǦS&*ZR^c~>1l-)B@K*+TJ5Rea-Q iy۵A](u: -29kZAw]QmpLH؆ :Zq3%uݞ']`"r 6*Zv*W9ـ[!vXؽ:쮈dvs>R՟`|S5B`POUPBDm~JhӕE)ľ2 UE !?㋷Č-6o\DJ11Ї>`ո+vO>lh Sb9UqMʠYupQ|vzy-ƥ@#(ϨJP&sa3--4WoVӾ]_|TtJPu΁˂: ЂJ)S{CFK f;y0@bz.9&mK+: 41Kl+ŭjmJzVf[( =y![[T" vAl"]匆 lU"<#d",]bSk6Iw$:[/jД!O=keFe73Gy^03Ha^Yje{. ԊjW_퟾T_S&V05YfH3PQt -ۙD[yŋyof^+#k']:l"ѾXnܸ;E*);nF,hj6%9Mlϥ2zT˫Ԭ*^fu% iZbuBx*Y[keKԮYߣŸD7ԧ;M۶hrQGͳ|w4h1Mk=( | UZ߱_kiŵ8ZZ д^Ԃp,y^Aɻ3"ߑ0C .B rSS։1-}AܲD5PUw"Ep gje];+bɼ +YuEjѡ\tȂjFQA|=:N j]\ /:xQ~e9Es}х遾bOAw(Zr嗣)U{Ak[5N@v.miؙȁG֌#PyXTqCEKnS'ٺu뮼J-J%Esw"Pkj[X BȻ.PdTBkZ=PXPOrHђfǙS=[W|" d)N׬P᭦dD j~EҖe)ȣ]ʈaŝMő Q>HRaƅ?ϏԱQ$ØNiEԍ ي<#z[3EsQ1]cML5>RD=Hn]t.|!PJԩ=[,.9S'A#P  !tK{՘n$ V EsmM"x2P(Dǘ FPU~/+'Eܠ@n-n7_صE$ wR w^닋-G.c9,Z,^47d퀊>tw wewǺEKЋعsg 1wՊo;~>9y_\"K e(FFAR/3Y8Xa.pJѹ N ZZ)-ٳgOEK`s惋8K/%t7fMD ;'&Ud$YɑnN; ޚ_Ǭ[ 154t& ߥ]”"k0⯄稀čM޲eKOWI ^Eg, C܊PY//Qƙ51V(.9]؂𵗁E霌3bLDSM$E8Lf,(`!EͬSvIҦCT:g*VWlI71~r `]ŧwɣ nGXp\Wb3T.ذaQ-\J%SAv`D{,~`RڞͅT@*[Ђ\Fr;]*@VXnȩ(q\~G:;T!Cd* qTB,hpzOpvşٗ îUԾQ  f;/$^ZLA-v3|2KG9R@ّS1*eUBl뭖/OlY*!jM6u9JB*RIVh5g ێ:YEH߮lWgiTCU+9peaV+b AU(EDh(t=X.4(w^1.l]Z>ΐ-['9ƿ;W +rVJI0n%yRA(h`A/OH*Acm̦벼V=j7Q8CuUJ /ő"/hmӯ%u?UbEK0|ls Ďx+]^9K4KoSkͳ염%&3:AZa@?L0WPo V5̔wr ARuhFo )ï[W[@~7Ef=` 2T䠓 2t{*:l2+Uw@2 =\,$SV hrp`u5B[@9<:*yCl4CK- jJyh# zkfPVsc2KDxMy3^HGyuXdgO@JECӑVvGJVVWV\(*Jt;- @,.6Y+:4bҋJx{М^` LV QЏƥǰ`{q iQ豺Ґ(ӍژT2)r%x;5 vWK.Jf \T8;uʢl%eks; UYaeqc+ zQ JEº*Z"p4: 1+EH&y]S)[S̯&ԊFC]?btfpA2rԠ䴒)-F:dYnsw42~ʇiiOQ*v֣FjJޛvg9 #&uԾBT;x)zl:)M]†lN"TP [yĖV%vg`ŨDKnB]7yYww6ftp؝P%gz7jW]ŸV4^ЙnNChJ3yWh}r*4W\Q:,濫%P0MUȯpGR_B~?3 :#/6׼z1*/!3Tߐ+Q{S./ls*r رrPSI D_VN2+ k54$썮_~Ai>"j0%I%_1Rf] R)Ύ"ȥ`y<=S+m [u"}ث[~qaHQD^vDC;i5fS5* ӹR# >|>^馂G)#/ԯj:]6Rƅ0TPɩ(#z\A^؊.BX `1`NgX~L64>eL&"*QO&Cr~N@/A ,BUDC%"*S dcAT#BVk|H=L3ls+*18XC| ]b:&Pyq*jE~ Џ9ԽeMVB]WNVXRl*jaԻlDH QEő"f ֭=wSajvǀQ agv_-ڕJ~p_endstream endobj 297 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /Subtype /Image /Width 150 /Length 2167 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?_j$GUj~lJ?Z1Tq׽?y (Oz~I[?wJ%Z(o^RmgV;O4ye"J*oV_sY6M _sKK@=i/NMR zpcZu=(J8UX v\bS@|f4*=*%#N 3NSNSL&SjE<MHP\SYGqOL (j\J D4n(ErUeUٺt*u@ʌt+AR)ӧ@ (T`Q:Sxqր=3ߥ3ciAo4 #5"EH\R&?ɠ {&Uojϱ۩C{TY% JEFPTn0Ua@+-0GۂsM104bץ8gqr÷Q(AOR1QiK֤^j؞JP8Uj>@Ѻ&ޔzi (.`qު09Z*UFO?V duGQ@A0S3h>,uy=MH@ǽ&J=)NSx۟Jx?>5 })ހ5ǵ[V-Jz.z]RHޜޢ=J] Qu"xUyWN*'4X֣+ ´X)N3o yR+΀ #0߯LWc/B\gҜPWoOj؜ǵ[BűZQQo@? ]hu=h4P֜}nQ9ߥkL~Qךk?JV-FWk?J}åFER6_\WQ -iQگLalңk<OүĐ߆1J/~E>sGz{.E.Nhێi~O'֩>րq''}誁s֪8MUD£=jVZ3RFE4ڥ=&7zc}R7zcUԤTn=;PT^j@ ֎}xgN?A~4y C1g׵^Qz0UsҀ!aaQDåFEJ£"GZL{l=6Lna֣n"7Ǡj7u2JO20F0zulP  zQEendstream endobj 298 0 obj << /Filter /FlateDecode /Length 8823 >> stream x\ Me/cw=sA cMdk;cWȾD"dmTiD bD Q蕵2,<3y_ӧOg~Y~os{8p)ѽdȏ<`Vp$Aij隤2~(QTXNTe%F0M1)'gMXM<"謤zejpϓ)S(xE(-<+iGVP(L/Nj0Zx,( w=)`(q]"{Gl#=ZDtBtBVDtĶmR3S y^ sy}.<#;Jf>rd-zw~-rwϴαZWlV.xzFYUcv!Ȓ@PU"zG;aEœm0˙H4VJ XLP#VPI*c&T2F(*FR#.H*c2m|+qXU$REfEwJ'BQ!*~0Ƈq䐈&a2o^5V7eUMQ m ݾhKႝ֧g硙u/w9$y.DՎXܤT?y!-WO3YԤ-J怖iqx ݺW)x-?W*>.i̷EwZ;GDz$t:cJ zTS|nnO$1c'f-Whfju7!T2ittۚ4`/3Eٛ[B?|\j"wckשgpi}U0guTWVWz*]mn9CKul7eF;l3N8yrǗiӤ]]}>hQiKj?gi)'f7ug͛Rm ؃} K^v#y箇^>ǜ gOnxgNӃlr= mzOIɦ|>YY'S_n|Cwcm;iqÝ-j[ؕQ=\f¾}O|F&κkuމ/*\iƍFU|rߢ{>ԙ[~Q=#O^_fzoOsN6~t[7j_X)9:ܜ0o^gW&Y+>~:_ۭF}h_xfoV]5*=ڑ{N4xAV,n){m;N{ؖk3 tJO{<0Gz{-Iqr}6O~-Y-:2rK9 =v}} WD~ۦߴx`eBly}\xΎg[io^չw[O鈘EKHc; iNظӎ5UNWXI*x}ߍԻ4cO?aK2vJZԘqhSf07ic^?xtg/w ko}':)5L8KV[Խo]3fp{t_<lj?[?LQOFQQW:7pYZ/\iF!/-U+0uu\Qmv6ƒ-]|6s}_vs3kj6Ea'?vU/3f] Ϛ+9Swek#W5;uQ]_jmx=kV5Ҿݙjk=:8bL4wncACwl3k:o@^N^D)Ngr H "&ꗙixhd&+':V`M mVՑɑN䕿ۉ:K 楦NR¥/NR9-Fw3YueX{/~9~G7ʍkpFwy6:Y:p3nM^z G<]x9;#=ji6[N)6?Vw6}9u7[ӡ]gkURi;U۵U _T:sKݛ޲ɓXRg\X/ _]Qvˇ$.ZZ#k4~w¼y 4cwpT!iY:~.ڑ'Mtkws;6ݳweSwa~On}z٢=UWѰn΅ёzvR{ V,z&c~>NYnwŎY ''O<b{/ mVdzHg>n cШ{lUL;s׶[@t_}yNW=8SE==g[9 M|dɸJ f)^~{T3Jٵ&Ēr;VWد.N~pL+Nl[xfkII>"doNȌj%?Q8:\ih߾3 snWz|~aO NouoƆZy_*mZG{xv/qͥ7nV8t{^r_MR e[%Bij1}zb;}?Yp;O\ JN6|j00+M+>ŽۙvA#Z/깃ޘ.OhyU^Щ o9cBaZK6z'S[tIY!H$uחjK|rtCmuӮWOZuau36u8y,]CE\<76NJJLLV[]|:FO/$4ϗ|y'_zdWĬ~w5-yb⩝Nm}3s۬>ͷ;ƪQiN,؅]k.G>1'%|4uuQN?&+m6Ưc*x^:t/3xsƬL|F_7w϶4짿hzjF8xw:w?\$xxj($jdJENI2 \ rj$H!ٜHalWUB,/*vs+|{j s~hS]|NBD!f T<pADP8aa]^K@l2@WBi&K!C#_4 &̷LgɝAUU4B р9h"SxE:-3.) dē4 ƐU0̛x \acB(esYlF wHbR/R;P JR%xã6ф`Sp5Ts@7d Jbz (S3(d k#Y2vDyUxM@쵘5a?+CIɊ"  p jϤ sjƞJj>3Ͱz`PD$A v"V3#@0 V 8HyoJ4AZN.9{{L 6$*:é$9# EޜYBGtJmɾ)4a>w#8 X(0$ I@ m6&'A".8Z瑙Xg,)|h2!ZL C7%K<)\U&q@,@q&"2>/$ qVz$ߋЉQ K*^Xb#^A+(k!@rn')bELFY1AC^ΠbGYx-r*ܴGea;i^aMA^y|0G' |12>YU=pFg|QM'Ge=fZ1zD7l<a/2 &Ԛ{:U$z-y|H.Qzes8 َ8E*z!hZC3xlͶFccѶAX`=>a=fmSC1IF9#"GT4;ZԄbBTB=Ҳ\%s DX: nM(Î:S,n'pnQ 9aY =?ݡ daP u@}?dXV $:Bz.mvURaj0TÏm#?Dc W2Wyl˗rb xr>KaQ#r0QE7|@D(UH{ N~s$`-gLt@(~ VŔc \D"y,0 4wy<`,@h'.̂S!ٟegIY5I$n+di:`jt,SM h \:,_jt%4k8zDdJq~լ7)&Nc}xȞ5^WM1;n9/D1YkF(Tӛ8#c$dY4Ar偿nX hJ1*\>Yd.[ɢQ@b͹)_B=ɇk *p%L pK4܅DfSP4ÌrewXV9@0g%I,`fIKq.Yuc1))i p#p$+D!3-D1(pIDQZ0i:}r @-e) ST#!&/|CM```x4f UTG9t}J _wKE(ĘNs`q΁ X[(Gh1G -0%TѬV-؁@iT&d ܦR)~ {!U!hb,bI76E#)J&g4UVUx +$$Fa%©d19ʺ{`Y"Nkxwak58H]s@uM` 6*V02s$Oh U,L?H>f o ,㌷=۔rgF+9[A<+C"dDgXt[3<0DY] c`w$F%n&,N:.66Զf rDktJO`qg~@]T@ 4 ۼ~N++GqBX 9_Y51mDApkգ :j%#F{OYȝ+UNYvg(vehW<< 29ߝd!D-S>1O,K[4$!.V;5ts=SmĚxS!2~ F#![V@]ıe^]'QW]R$2 *rHn6ӲФ;i"K٥[(]S.l-قDVTl}`(mUA)1 r9a:*/MiȆ c E3 auRC77AsC?%d\I'U -vD ,:QV`D_o`V D2kb@n] n@L[O/|ORT!kW2f8]/|xxW0[i@!ND?&½FbNbU1u>g(Z)x؂ NDn#WƩbB5r P=d2«@䒾^p8%D/h:{=RU ah$r8;9 N+d]`;2&`YZ-ul,4%J{h.wDO/@;Uh~DѕIGA "7/b>j]QWx̣XEB:·2Ym)XPe`*SUfsZ [vt=OLSޟӵ?#"4BId?s'8/SLA $0VU(TS7@a8SBߐX`s{]pLQشH{"n`hX) ,C{P fŐCF8 ~> Q/#%[:$eUec+`8U# pQyUS-=$(Rs70}g:)bYe^# /n ]{ uAq$#bK *=N+ ~C_9 e'3,ֻi,C&ˎ *g/BGsr|tʨp0;e k +4ըPɜ ޥ˹ŖχKП(sDJ'fNrYq<`L>J촒AjAe,د⸊l[dN^ 3f pcW'AeDo2)A-pR0VE#XҎhcRRÿtgu*83]YЗ0 LG$,)A:V93B`-00Q|7x&FKuO­YYWpr085:aA2rL!36" 5K'+gq6?g2ofqڦý;a0&b'u;_$/9&܎` \ L!OtP-%@BBl PwDTɞĂkr kq)45aȺ4FdXk~Ϯ(G0EWecBttG-mo6Qa+ %;d4dp |ޯR`C2c8)Swxl{x0s]E qlh#zN?3GAendstream endobj 299 0 obj << /Filter /FlateDecode /Length 2298 >> stream xZksTn{=G*ILl)>E 1ٽ: ===OsʹȿfߞY=ji&˿߭#mQWofT9roՇY#bk Ѥ ׳B*8cC^,Ec5wiXD*P Ehea) u1zRk݊$JAXtI2D锍զhZ:hk!q=#;ICO#O\ DdǷgQq糩6).ULR4|G4zFߐh+op!m!)̛hm)@猎~ eI^C<8zj_%xAs _X|N2g-AGP4P6DzERBCPe~l.qi Ѩqm jk\k[AMTx 9#<i;hB'OC#A2<9djX V kTXNc]| [㌡#U}H~& N[Fω.;B4vp{jb[- &aCL䇑ᙉ-{ e3}):dܧ8|5WPėdV3-d `]. ^UѣC㋂]PPq+dwd ̘v->L&\`4& NU݉z !%0j u Al) bLv`;B\S#8p*ܕ'"pB02,#NZ#fpWsݑjw8ц/u&]u1x8V杈Ae'hcP 0NX1;UvVy ߬^Z;Nk(7Fd^"ƩX>+y_ G?TBbu2*}"|X=h_h 79bm8_?9Yr !kX6Y?ڮ5ezÍ>+/6՗Ҧ@Nwv)h;l W,Nsư=L7%y ng_|5,7 G=fa6~3ZUHtcCJD(fmV㮸mw~Z҄rԥi (lO peK1o^wQq&.rInZhB7e|ZeE Qlendstream endobj 300 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /Subtype /Image /Width 150 /Length 2649 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?OQWE~v5בJr9^79q@ "ʌE6FkƾBsW|k>!zwuxgiPy47^,X9< #VcAҫ 8< >-BpWzA8}Ec2TR88)'@Mz5N;ہ֚P +sOzzT*v;T./J3N9+4d7jP{ʤTlT`8?^(DJ2GZPvMR*bS+c穨+t2^0=jaxQ@ x =joVw jĄcE)j( ?Jrڙ@֜ˁS 9?sNCoOjXaSu}AyZyB?ίMgV$O5DybF4yyQ֪  w{փY+Ayo /uO5#2V g{sޚOU͸#E- NPh~_ YMhGo_қ9@>n(] 4򫷭eSN61c4 #1K*yQ|U}B;zJɏ؎~+~ҬcaOTۂhIz_\.wzG;_%{*)o_qJqҢZ˷Ҙ/dBV;ێbGN,>Ҋ>ld:(}-;U;zѼ7x ow(wiZC|$¨dk̏Vs>@1+(-j"JT,c5:Ur#94 ]㚽+d>qɫ)H*)JsUgu?fc`HU*4JUX~(9gQެB*\{| Z@U~sҥ ҀhM |4?JPpi|øs@~#8?«cMo^pJۏjC+m1jBhgۏiZV4qVQeWjip_J;wai䚄;sSmON\'!4Ārz h),x.rXԇGQUb2߅g*)jyEDhb@<*rI$RX*{b4!E2 :(V9ߺ)h;:QE/Nwt9Q@w+;UlntdnJPFR6EbWr޴$v袀( ҢɢX{qޘ QEendstream endobj 301 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /Subtype /Image /Width 150 /Length 2665 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?g1Na9eq>S:v m= қ}j8@C*Cɪ;{Rnh"(\|L5{}v L?^6k=׭=?Fwzw \?^k5փnm@>ħZM6k?^ ޔӻ(Z(<ר}nk=?O?^x~`C|諏( 7Tcrqj#a@ ҂PA@R$$:ԄJYAT7N7c vS`t\wxkަ(l2ҧ,w43cQ7=;ٗ?SQ^xA>ߕ4oʥ:a+1>ߕLrxMF}('0TW)@~TSGP'_AT9z~L~B8@~_R7_n;PlʀOJB=GC𦓃@coMvsץq~'bߟYjIzԧ9Q[8pSPY-YOo'xIרs?8@; {J{u$j"yKOZd鳏!\ӁֺS ЅrJO^00y<z>^RGZp=*Zp#>i`<<O֊dF>̍ϲoOs?0 X{S؍׷=9hIKDO=Z\ ߇]6ạDƬm«AREW )@y8c/&E85GzGNbP"H4,yI>|j$Ϩs#py7O?tTLF֜l@ G?z\rƣ$gr2ztCOÿi`}+^"NLPB*3{TdqҀ"lQNaJN6:b9!h'$|ʀFFiGL[iF?9:T}E8h4l &8Z &$W7|€$g;󚅛)žA@ ]֗{g0?j7s֠?56p>J2>LgSFG tT8SMF0~iq@UtnnJoN(R pj, E_oNW7r8'+'ZhB7N('q?(L=h40lA7Aj>MG0}(Q1ҧ#*V*28N N88jL{ iJccX}*2>!@JCN; b&Wdp$W7EEP4Q@[dxJ( j2Q@Q(ixkQ@ uQEvEendstream endobj 302 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /Subtype /Image /Width 150 /Length 2230 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?SOz\?.3Av0{ !xi2r8FڞAToʂqJұP3ןWJ͏0Ozp8(AROҥrx}(\:rTa9MM/3w&wJ{S׭DOSL4}j3@Sb?ʊͪ8i8SWOSv jH=i:tݣ!QP?o?SH֑ qң?Jk(ӵe#Jb1zSA|}(\JTO^ҤrRA=h@]JxaJ ҟAPxN[=_)@kx)v+5Z @Kv*h?j66l}Ҋ|PL9NÞMEijoSXr*s4G&2oGDtZ72R :HO~: dnPiS<;BJTCZxs@楌UϭM ў(G'h l94}jWʹ}iƚÞ!_jk/eޏ?֩0x0>HPDI!DNV?S@1HP4L`v 5 >A8S{P~,mȪ8c~z6l`aɦ~5#iIӿ L{PN}i5|?x5E љ*-DE5'NyFG9R=p8=qW_sތs??)Ҝ Tc<*]xQMޔPD3oLf(2ԛ}LRh=_jU ZWU\jkMLE1& aMaJc~T 1Ҁ"fۊv9ΞT(~EKUҥB2h?򢘌6@Gey|vJv3IPSXUJaOd^,{߅QhU+LuՂ$g&*r8 ҙҀ!+7TM4ǭVqJaUCaC8*Oj \~4T2?QQ#hLxi_ۥPL|Q@ )?Pm UAEAL4Q@2 hAPJ0(#tAQ@h!';s:(endstream endobj 303 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /Subtype /Image /Width 150 /Length 3083 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?#9=(2Q7jҀ&Olƅ`yj%9aN?{Z(1sEDLϽuK15h?=jҠjUy@+xիG8TUzջ5_#j89~5hbsZK?f(_@zSQz"8 .2OZFQ@yǓ֙sɥG3J)G(n5R{TH$ IJE8Ed;ac OJ{ptx?DxSۭEsG򠷽 z:PaE:|5x;m=*5q@֑׭5@7<~HtizTg@ fn>S[ey:|4l9jrhP6MR:UN]:V M*y=xl}i~oxg@u?o6q5/_/QuI?J;\nZ\cX*9@ws(ywWhG5R&ڣ5^&3si/׷ pzɟܞ 35 Qɠ NwdE ]3d}UH^94Dzzn\ndf#eH:%cQMsɢ:wQR*_7Lfi@FF*ZųŹzvFv>vKHwzoan"5k{* @ Wcf   I!V>_a@Xkq5-Ae9$5n!; ^OJJ񞾵'١P~,`n_f)#zBf%e\6qI>gJ@X9}Rк{UF5miZmRدT-/GnƳZ֕-Pw GK0jֹ\:Q'<GU\4#toTŵ9X$8U3ګ-֠50"1x.B,zJYA km5:l38jO^/[=(O#nV1,[JcE88 j>z_0uRL[= 9tJEެ <8?1n$g OIUUmŰ>J74~\FPA#+5Ѷ~_jEV~qP^Ԩ2Q6߾?*r#n_v@':wMsu;ژ S>UQWƮj#)Rǹy9^=M#@ڣV;O֤RҒ?D ?nП?Z;~un70wz3.Ԫ1nިIQIlԓ!=igր$f<&NhhߟTqpb@p;Ы~(TS4P)~S z rxQ@;sA֊()Xjފ(U^:ջ19q=(euQ(byaP>N# P$EPendstream endobj 304 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /Subtype /Image /Width 150 /Length 2702 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?ͩoҗsE͌RH>dL\@PLsހ2G<~T=饎;֟&NU՗*VրsV0Y?Pj;f@vSJSw}iaרjww5H7:յoh4v1E2ݸEysJAC/48Tm>#zRr)U,F3V܌e*ͣ.UÚi= ;ae>4FzB j4#oZеt؟SSڭlF繩 uîVMRnեaxh([Z(βLbsN<}*6#4hȤ@s@ ~fL S1W7SӏȟJpZ}Wrw hyo M!׸2yscdsPƭNȨjb}MN֢ f msh,[crqEqX8*`?Z@3OJm䠿)}K`瘫sN/d;ipUNHڄZQ6f?f/5ȓu AbdǠۯ:?ӓz㢐Rn_ݼE\ƀ5_P|j5~TߠPHPCm>yTϩX_x >GG*ԟ~u??¹_UMoA +*79e$2FkSUg;:P]x-jv})8?0Tw)zUjwSjshN ӑZK qڨ:?wG"Ѣ繬285p\'٢#zPpߥQNRpqߕ9SHzM5ѿ*C9~ӏ^RwN$*!Y-P'ݻ{ U# j))ϭ>2pxoʛ"NA wO^:PWR~vmJF'w_Ҕg&N;{Q~'#*$[Gհ߽M QNn>tPMqMDjc ]OԌ%Wih̓#ӿҳ7N޵sSLI'Vf n9fji׊pʡ]ߕH4_wRǁQ򧎔n^iG%Y(G5go<|5 ȫa٣@xQS@ L7ߝ1՘a@v}p~F˰Mb0hl~t.~~u*N3@e‘+)`S'UǙ/!YJ?)+ °#MҚ*TXpv)9*ʬ;N9UO'VRTy~/aY*!GcSŸ,q޴cs}TW",~$=)ʧcqUTS'R'G ޘ=ܾV#;L{Pc@[ֆpw?j1֊) @0ƀ~Q@. (`83EB> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?<5~1sNF> R,8NWmݪr5mRU 9S1W(sڱPGY{P==i1)b7uMD|yM1H构s[V>Z=byOr1ր&;>hjxր,Lǟb9.~o£֦uJgҀNJU<} O>zOOΜ5,QpZex^G_Z~V Aά7Qր7~v:zg_?:T`SE5WD_qA})Σm"9=i/QWzt Szb3^IU4|4'QJuq@TRF<|S@13xT!Ȧ[8rßҀlғAS$/@ ɫ7$'eJyOE]p7/0xr5ҕ@O9Ҁ"U~駨ЩԊP6OTJx=M/*! 9N]OiHSz$t1*}9)Lڀ,{7tx9@F'QSFrzSѾj#`GZ*9`h Tܿ(AUE=e~> stream xX]oT7}};FBJXJl.G{K`l)yA1jC'HmH6ıۮa c+ O7x9kos& fbl %E4"gSjn꫁veC# n"Cɫo|6Tkلq -F[ק e# &&lL mMI0Sx<\nŘ^Ah\|2HUl;:X"RҬѬD,b ȌA4Gf,OpkVXc%lHeyGlKY׋,b>mr5 |C6$$ 8-a06i-zkNM@,XMbg9d۫Á-bu4H;%KmM5")`Igjkր(֮{zH] Ju) 69NMQ WgRdz.kn}SefQ @"9]*.HyDpP2HĩyŖĜ}xi{uqaw,X.IV8Y,/%% {QY2 ZdELoѬ3[=2cXNQ$5*ڻbKE5p@%|EǧX/K(+뼲un 9Fh/\ɊuMyY6XBR0XX-PviF}jwxkBKR4i&1YFDv"c5$.{A}y~0w(]9 {ew'jCbHu٤s"GI,ff~v GϚ^~ge~N"{s![E 3 yq@fPnGfT8 3Va-XV,x.,!/"a̲pPk`H8S%pCv,z 7?Xq!B.Q#I.kBJK,Q=L Q e Y "0Nڡsޏ #)n6#$rnPAB0gmY`pdn}hb>V{B?Ȥ"x֥`;endstream endobj 307 0 obj << /Filter /FlateDecode /Length 160 >> stream x]O10 @b C 8QC_Ct;,: ":ր#MEY' ߔ/uWBi )(HEѵtXIG`4.qJM5☛&e=O) p{Sendstream endobj 308 0 obj << /Filter /FlateDecode /Length 3569 >> stream x\Yo~'#";{ ()>dXIܕ13lV >쮮jӾhH?㫽zl'~ړyљ8^Y*mpz]ݟ_=iV )m.g9>T]iӘ T8=Ù* sBe|#Z%v9M3tں:﨤2G n}8& NOt)7[]g*,LzNFePir_7qXx8e,HQ:pʨH;pPwS.I-x5rk'{㜠p?ӶΥiO5gLhN \xȲr 7K?9Y[!\֢eKvS[ȱއ,'g,v ὦs/ %%D ;)"x蛬qZZU4Iw/UK <'pk ;6^xC|K;X6 i93[kf\F vIV;3"60Kv%mMwUL蚌} f͒rʲ)˥5.!Ne^=#PYB6O |Hc]ڀ;FH?ܛI7 9{W;<.NvbwdO}*NC5 Uv5#oٟINW.v5p5#гDGc;̒hld;g#- mlul#iCsk ͽN0i4zOh #D=Qk"튥0<-2q @ޥ#Was)[4WϷFRYZ_e݋Td1Kr_Y.@w7wN dP_RtJj]IMcaV¾ p7CPG!`>L)GGPp%pf)}@x_Yd2o _#^nˡX= %; pK(芥'^UlYc#gHK;Fwᚴ, t;ݯsdr}]~I(Qe$<{2ߢ 8`b2cygZrdv.kNmp z8-d E:aVwh0RbOtBN^;zM8+9Bċ|tfWh9MWmnrX7e͏EzKAT7=z<[t>qri)IQnUcSHar!Qg?l 9jŸxJ(] ҟNx96)vC 0/))ta|[W+9wpg9U}}B̆z9k2# :gxr܉_3w]oYsع\J<~~ oBnPs䳅ӊC.䀶 @.r\ Nb!`f:]{؜݄OX-rU%l+6Ug' Vuvv{F%FYYԿLC;휛l0a7(w29=e?xwMdt@xwIL2y{G>MbGw^&0zv" !;e+{ *XmU " k/Aq^[w&(4d#scT޻=@!OOГ%N@@9"/Y}9bBͻwd4TJ*L 9$ufC}\~ aja ُY^)cY ,v`(|͂2N.?)WJOSV)_K:c6]W}.@݂Nr]<*roe:.t3R>?fHuͨzu (^D]$3d;TWFكDie?+|]*F))=lO k& DRGoRӧgab]QxI=Q0{QTa4vܛZ8kJeOjYF_Ku˱aOp%x51|;AU/s.\D {_ş$]endstream endobj 309 0 obj << /Filter /FlateDecode /Length 3041 >> stream x[Y~_dcP28KZ.W$W俧aq))$#T譮q׊./>{ҫQw|~HĿ'aJ;/OΎVqımU|u./ctй=NXx\dl%'ͤN$$D2py7&i G6O5caS ֡ !Ha&UͶbL ;,*k'āi$cN)i $a%!3i)%HUCBYB U auUb@K2ziPz8 IX͎;eUpno&\Qi~~YZ+B8j@[Υ+&tG\NRI`Z#ɥӌB}>b;L^: M=VV> syX]/b)88tmJ]+bMR ϪSR#GhPdTE"^ʧ9y]ݼJq&D `܃⊒u}@J  Hkmv]0Hΐܲ +$% V؂fdܰ5ʐ?Wpk$HnDrnA%![r ɯ[$$pD;V?LFb $6A#5puE9 ^Ɔe~:CKztt赡gCHqT]'ٞa]E;`&7^'T^CAgՙbmrmݫhtNE&Q&%n5:QBO,E0ZFfW^ Xkh5ps:S4xQuB`ADv -1Qh^Q[l0:" sϔAn$5%9z|%D횟 &Q-hapN Z.mz5Hz' 1iMː1V!HUQLI&֡e^`\!@$H"]%$ըoQ}Ǥ85c!OUD^ ~*aNw£k2 QUd}Py&/  C' ΀J鳲UHF*"ywdXGn{?0Z./!w#-kJ1+T_8E>Q> cLE& ɳ@}Xtnp*}8{pgLHa 'R5"!`< _ӯ5i$)ZTء Dr$C$"yCPS.'S-NޕK$ɡ]Ŀ|3D8?kICns}.!˰I1~9^|C%ˣ%A$J=UEC-Y-gxUERVXmw?m} m{u@oD%3(w,c@-kVAgr$9xv2ΣU+oM!9$SEx Ⱥfϫ)[>e~zD$3c /M$u[ -ol3oSBY䩅@=`%+<[*.X [vujvG X/1]endstream endobj 310 0 obj << /Filter /FlateDecode /Length 2241 >> stream xZ[o[~ 9,ē_@8E-RGE9"u-R%;Yr)ƱܺH soS) f - ^N~4[L8`$MStZm{/fruz8cYo[̄ SU[+|V׳mǁ2m& 倇3i\w8wR.j\(Hc7BhLwywJ@*08k 8B+ {n8 CTb= 3'S d{'1){& $d杲0ϐ(h4=utBN^gΥ14(5+$# !Kfr$$S 3fo;^"yTZ!QM Ivr3q+)tei;ں!~6Lٞq7 3$p8bmy0@H>Gϑxi2|Ri R'jlA^4ϐ|lՁA%`/peLjbC2=תowSx>mmFIxZ5#/Y䫵gtgNjfDڝ pt,2hrU};:jE|?ۧDa==+8O T3Eǽ@ŷ4.fu,[7S>" 7GX0Ϛ#X}r$C_JH 1$`HbN D oQvuW0&|:_i/|fQ7grO\a*cze8q3]^| %sS }!VJo8eD52^0Z<-Q0 &dh v.܆;@aT[*CG-NũJuCmfCN q+d8tJ:5u\#@2۫GѦJGj[(|ǰAuJ2iNeqCV^`vP:~~AIfeN?P{$P8LlrbUHwY+LZY΂5Ut"]|Qx1ߨXAc8$KGTj5T\'T{CI&ar##` eϳeI{yu#%ufb97eXUdEP~,vab2\ť|7.wڱ>.Ԗs97&o$)<2b0p.bd;O\!YR02a,ٌ\ߥiCXf]x&@U6&Ë'?R{^J$RJXf)RK蘃Q cj_ɷzQ2Boqt˱ɥ/uǤ8pOK xKLC +HFJeBqȓ7#kM}D0iGT!bA /FL%v\*W 7A![47IMhPӮzhxϕmusl=0!0W{ʅE;Kzx=͢]  `'A;R_ln)u> stream xK,Ivf7_qY@3ti HzЀ#ReD]V=?m~/Qҏ~?Aly_iZy~le{T~_ޯwW[/͟_?UJqۯ_пfcnybx~;#Ro_e1w6Kz_1zwr/_m?X2gZ~ǝp䁶W~W;W ;W|M=2S?<oUF<<g)Y~ͪ?mm|U9vzE=x|xF;{83{p~!xi5rv!ЏK(~?Y ?OowgŻGop6vpv8wgCǐhkhamy4^n a"%jv(kvgܶ3*a̤w};_zg6VS,wpioYԳ`Oq*QnVXY{/:.j2"gc1{`??<޿Vt E\܁^5"N=GQowg{󾭞7oq -rzz}Wl7[bo#}s[ )ţ=\Tb魔|xzRN{%Ǵ72rfPGڸ[ګ+^(h+cۇW0>iw_ɿU{Ed袛6~v^{UwWvqn~v6o^o9ث+VKUpfo[-}jOe{2?:0-sL~4:}7>w7>)1-oo3Oo澵~ZχZZ}|UjЉ?]ɇ?t濙C=u ءo[m:sHSYC|s?_N<;y:?~F-o.|jͳ-üO=l3Om=4ywc>mاo9as>oMkv0iS w)yvW<>n-Ӯi݁s;awvz0|&Az&8]pd .ا}>>n'~88O :vN%y<>|3].3v#NuiW⛹ߕ8~wⴠ|ޭnOnya:{ͳ|ցtE2=^݋?b 6z'ďj.Ƈy(_]ӭaw5N~8թ]Ӆz8,n7n)?z~t>.?߇]wmwCSݐ=rq7?3<6]MR~؇ݐ#AvCǡ} 9vH}0O!Kw0 {[7i8F3=mi#R9>q0~i}CE>~!u/any?䐪 Cx9{!a7F1R77ƈO6>Ӿa-w?Ӷ!/"Ux9D>mi{8|GNM/.␜ݒK(|ا]wI>._Dq?b<K0rw>d>nX=AGG6Gg9r8ǿx7?X؇?8&ɇyq=R7rJ| gz+kJ>^~}3ű{&կ3bg0O{%n:U *c?X)J|V<Ir8$$y_Ya6In$~sӦKÖkqkǭ30O;"*>V~GXş6Ficx֑Aa6F}>Ⱦ%O#yc?oqc_٧}C^E>?7%z+-?㶈+("aS|O#Ux9qsp=nisO#͑ao|}OlaBݧ~ {{"[!te+u'4NH{}aܮnanA|p n6p};fpxpmmԼ˾HwPWtw>]wT^wɮ7 pZ]qDmqmϴn;4xEX* >}x>uIm>ܬtPhtx>uVs7o5gjpwuAm1Ck9{J~uffgvhYrxn??1)~7j#+>B5?=4OwLݿ??PU|we3Sݐ?_?jw?2gn/f?{Yxq/[$~ ?q|D$[߿G?ᅣnb<ꩯ1QxϾJɗc¸3j<_إu{< _cJ)?r8[zk̨ҐT[{>36r/dz&Z>|+46w>dytsܦ;Ps̨n\֢kj[?J#Z}l늺8l5ֹpUlߘ+Q_cF7ͭ^SxS_cs)?zQ_[;PؼB!K^jƷ?LZ@c˒_R繬]}l^`S~l Oc(s훷njJ(1~05xNsY }l]G6y=P6c\jYC9uI{ֹVjDac:JY}l=+walu ^zVWi-ؓu:T֥֎ǾW>d3rdqW6C*Wqz=ָI/pCjw>klY&GV۸IsK~.N~Շxk[)ځfi"h@#Vk@wO} G.~sGV)?zDT>^+܏U8=57[:εǙzhZfZ뒎rÁ2PZVϿ1o[?6fy.ەkj[Qns4&3J5rvsr2r4Yg9#IrܤnȘz8JO'~lR:y.ۤ-j[?wSz_]Qr&9|=KxA]fA:PslQ\׳-@c\WJL@m{fC1G%;Psl=K4 GjsZ( 3>?63wo\>>լ9h訯u%.?J~غy*#17BOfSG| ͫ :=ydls!?zǾajNs}/Q_c:yͿq<g:5 r=P׳XϿqLia\SJ5+wG|7c\i]>|8ʏTc.#׻9εRڮW{v=͕h3uIx9WGg=>PslynjVʝzk;؏MjvB\_Ɩ=q[?uϿ>u^Vz#N@ͱX)?FZ9N&5v&.l9εR s EsOcs%_\S_dzwz^+wGGȆ֙Df9N9lp1z6& sI粿YcF[f<:0爥㡯!cp.;<5f}Ad[|"@;/u`PìqlS};Pzݯ\n}lmc+MqE]tW_-9uI沍4Y}aKB0?:e@c=Ǿ^AksY>J?GR|=uٛvCaoqC+˱wEϗS?%u4#K|9wY M :M93h;0~hK0.tCS؜kr~=@c_Q'?@ͱyusT|;.\WyjQ#Vx1w^#n?s-˵6}xfZ'ΡپW$)ȍ'uI=rOc\ "c]<9gіFa}w{k7yֿ-܎=Gy楙5uk+;OciJ!:̿q}csl&?*wn֍ߖ;[ ]Alj(7NBϱuK]S>6q96;klfW uhYEqc_Rǹksl= .@c#^P_9εPly&"1:t(Ϳ\}dݶ<R8@캌o4Ǿjs8{vC7t>#sb3*k;@s+"`d}l>TyNrӯ[4ؚ+4Ֆ>R*DZOﺦsa낺8b{~lkse:N5ErZr/1:;: 2ֵ䞙C_&\3y>67ξn cKX.KR~zwWjs]R>k kj[@c\W)ďsv닞[纤Nsu:)k̞R;5ukKZ~fJ2ɗe੯9%t\5fԘc|KyMo2ƶ/KgS_c. gS~a<շIDc ;N9NsI]q<|{_Z篠xh}555rl5hOZg_f#z.<&CJQzNWK׏ssTܐbe=0jwDOcn "+J:B 294܈b?}l~Mӯ߷ o{*NSُ)KR~GyjpϾs/~l>?Ͽ,1j?~K4֙Ɵ;}ʏM_wWi*W>?}h>aNo:x13sh=ý?:tŜ'j-T oJw~<sx}l=*wdz?=l |[:v4~S[Qk}veKA}C&fsT5Ns_i-+u[)w jsuA_ЬʸR+h[:|8?NPMt@cFۿNsmS_cy9Ͽ~%V x@kKxO4rMu :G}/f~t>kǿN?}hr!7z8ֈ^Q\{VJ?{}lyB.Xʍq:?ֹ.\$\ zˁֹrc_@1Gz^i^X܍sn-랭r۾.:LB-Um݃tC:Md`,im>1ap˳alX+:ϵI$u1/:wS 3-?<};b 4n#G#.9\Sg_/cr턯el:՜ʯ[մ [纤NsղL·vֳbo \Xd>P:uQֆY+Q1GErcy]Rlp;P:Bߗ3j{:MBYEcӯ|ݘ{s}vVj٘6K0ֹOS_\>N!['o?uyaIomlPj c_L @{rP}w}ޕxACs}|uNj,&;(}N%BR="W~udl\u2>O [BYuq9SIT(T.8ۚE ҵp0uH,o( m2s8ʻ.tMP&3!ɻ.jV m 4"o( u%ɻn@ dNACGЦǒu5AZ9zUfn<:q3Q!eccK`^Xrw]FC-o( ey&ɻ.VAEu r-GpCIh=jU^zyr.~R}[2V!.jU}2V Z> @%ȻnʫfW^n?m)>7\+kUu}q/q{r+變@ܬ uW9u@a*)MysEwUZIB]֗ zh@ޜtQi!݀ sKFڔۡysQUd%nSn6yg]TF:mʛ/`.i@n)!hEu@Mui@n9u݆PwhSCdK^!ȨPH@;)o;V@RhwLj\]78ԿnDC#[o؂OY+oDޜӦj?vD| 5'U]˓%@Uf BUʛa_),u҆Uޜx *oyu҆/|̘I7N4c}'~hBޜwW~_ t8 `B "^lvH@"R"! KDJ '?tU^v! R,KuwHgBJ!@ITCC$T2j?ILY'rޝ@A0DR6,9_@zQ#oW;!}ėjw@1vAlxD/r48!)IlHK;/Kz)b:ٿbtP"1!Յ;=vH%91, 8OlՉ닻!H$T{t(o'mJY'ղCN.( mJNH9;DB e rJ!4Ԯ ~>Bڏ$r rQ^:9%R, C=w~B P5 i>C 6$H`%TCd^%wH ZIB:(YhQrB Y_JNJ%eCR{B!!_;DB Ъ/ c!H%K; ۏwڏ)Ъl]6$EUeR Hml\l/%tM7R RK ;3!P-)9!]i?9E=ʻR^ Hd;DBnHZ"Ej滏wAWμr_wH0oXA:-~Lb]ILɿD3I .$c_'R?2!Ѕ ywN "IQtІ$Pxk ē4HFBQ'''iL'iH$$ b((i 9bHPt!O2O2 LcHxxxҽG ɧM2M2R(D5@4IS)#HPt!K2K h2=2= i GGSV:Vuz{1o; *t"d d@( dxx"Nkehh! BA$%!}Ce U/ $#$)J}H4B@4I >A:XDIFIRHKǘ/M!ݡ48(D7@d:u$d$d$$tH iOI2I2IC $g!!Ўd$$HR@{JHI i FFFbH'rAJ@H բjAHHm}k:I z $@z@jI2IBZ4H'HI2:')ٮ d$$tP#9 P5##!}?mZ6@+((}JHDBHI5R-ٲ d$A:F$#$#$) HFHFHbEl4R-##!],"";p1I dd$$tP:DDDI# "!vd$v$Ȃc4@rienKk;BZ6H&!I2I2IBګNDLDLDL@q$q$q$q$1DkF"d"dzWC:(z!!!!@j1$0$1$1cB I@!!!P,##i )ZA$D$D$IE TC$D$D$I e"tv##I!P-"HđLđ Crj1$1$1$1Dq$DHt Ht iN3q#p#! n$}3T H&H&HD€ P7$$$9 rވѯHT H&H E2E HbH(((Ҳ4HR"""i KR&ł((0H'FA:Wxz@X,M!P.'''i@ׁxxx{AZLDLDLD{ ((OI E2E2Er@ڕP#Q#Q#^% Ɛ0NiFx/XB:1DLDLD4HBG2G2G iG  !ADIH@BlG2G2Gr@z)ҏDLDAEC:DLDlY@HKHc#B@,,IcHP%$$$ !$etN$$i@;! Չ(eBtHCR UBA)H ɤdbGfbGHcd0DR' !n=$C@!˴eik@Z6dA%%9 mVgbIRH[X xt!3$)[XXR 5L4i:Mr@f@A$ i(}HH$!"If"ICI!^LbIC,Ict($3$jHD[w(3$h"-L,BJ%9 K$i^p"IbHgH$R%!ڎ4@ۑ0,nPDR*2#)D>3#s^8w6MBZD4HW&%xҭL<ہh0 Hkhe#- 4IʐJu&A$ !Ъ,@6H8$1XKr@P%R- شDĐ;HԖ$HR@z@KA Q2QBEIDIDLLLI iS2Sr@TR(I!У@D4\ĐeBA:ړ^JGT G $ F#16UnoofID " "P{"k=It'iJRH'jA<bH5Hz} @=TbIVbIH["-J,I 1$*$+$+$  $+$JM Ib8hQM }OCd1'Y'9 ]O6R(D(7TWIDB r'Y'9 TD2 "SVGVGTGR GVGCH!#+#91~IDD4\2M4J4It&!]5'Y'i@'[ēUv`UWIIRH{xB $)Z?ht!;$ "!@$+$7 OC$SQ Qـ(i H(!Z4@mC2 Giɀ,$1UOr@OBQ @%)[% "!?>k Er@d-fF I Au ڀx;* "IbH>oD7"InDYL'Ё܈$ICI P %!mToĒNDĐ Q$ HEB伵#iNq$  `v$7HDB$)07 ICB; &F$-  IRF/%q$q$KI dR,2ج؈"EB#A$ҽIH@ FI FS@H d!墀mP#)BjHb?܈!!}c V HnD pڐ4HTTJ6+!CC:(Đ4Hg1$13WPm 6$7bHRQEr@EBGYIdX$)jt6P.$mhQn@(D܀$ISođ܈#GC$(CI$ɍH$1 )Đ܈!!bH# ɍ1i6$I bA:@H KjE#Q#ԁPi5\i a FI ^eb/!FI i H+P$7HbdlY!І@ (DloH$/0Z#CЈ!و!و!I!ݪlĐ4HEEB\DBFIH C#d$eHP@ d#d#$tP"iQ$Q$1sE#d#䀴*!P,!ـ!و!!P+!و!و!!I1$1$)E@H( !d6H+~c섴Vm>4I6IRH{ՍxxxHHHH!I`KKr@Z (DlDlDI Dl@lD9$  d#$tR2)DlD4HBA d#d#$Sm YJzlDn=bH?eP-%و%9 P(3@,F,ɝF$I B$F$F$It(B4F4F4IHHH وiIvF#zdz1$Jʅ#ϛMI6I BnOOOr@v~KjKKr@ PhAVT7bIb)%و%6KcH_bI6bI6`IC@!bA,F,It(D=F<i ךdۀT= ۀ/M!P.&t%$A:MI6I6IiOOOOr@V@E[X #HPȅӖd#䀴,!bI6ؑBuR-ـitRو9 -U7bGhylMMr@ ف7:V%$ Yo IbHII - ԭJd:$ dz;$;$gNNMNI hKKR ش$;$ ) A:]N44IcDB IvIvIDB 6(Cr-N,IHt YHݠ՝8eBGG Htv#ى#i $1DN["k׽GHG^u6~aU!zēē;$)=N<QCE DIѤ'9!jQȖ$'N4ftN*$9RI:IMC$(RI# G GD>9jHi?±@^ԍ J@Đg'9!INAlldB{!k)}i VF$'DBjڪ,^'IbFhb4I@B:(lYOrB4-Ls,$'DB"'$hMC:&@~t(o' JN%'" ]P:44֥1:]{B3H*oI$  r9 ].##)#b@ zd z䀤0=!i6Bm d d A$ "P{xx0x0O2O -@<@bHEy}4li{3uZN $$$i E՚d d1$1 ҏ}D D D4A$)Z Dv%sB,@,@,It $$$ V)  d A$łhh2@!]u&&* !O2Or@HI!z"=2= rNItFAN@,D,D,I i:K2K2K2K2"d"d"d"$HP@ d"䀴,!@Q$Q$1sRI dd"A:ҊAjE2E bADIHC DLDLp1DD#1$1$HP!!9 }AC$(@DIHDDDIt =Jt iNnQ#P#! j$@ jd"jdj.L€ P7###9 rވѯHT bH&bH D It!!bH&bH&bHH"Iцd"@B%bс!!i dR=Id !*h A2"M2M2M C&d&d&A^A$3$3$3$&)ĐĐ4H_bHbH(((Ҫ4@F"""9 PI!P)i jd&jd@D4HBi:m&d&A: TibHfbHD I =HH~ZFA$9 P(1$31$)$?$3$[I!d&@%H`˂BZD4@ ")@9dHfHCB*###ip$)sBLItް YHݞ֩3$td&A$ PnOf"HC@I hGrt lT`%hOSt B <S$2`e@HH^u&$$$ T4!$I!Щ$d&A:i2Kr@ZĒAhTV THR\8-IDfҒA$"d&A:)ĒhPn@4FXҖd&䀴Rm YJĐԒ@H"GC YHОH~Q$1NBu&Az!!bHCH $bjE HDR =Hhd"NՙJ@H i72k7^7فY= P$I!Ш$@IHLɆE׎$ezkz@I= $HPtQm\BI ,@4FEr@`nT$C` v$1$΀Qm YKHb$E7( "'+A!$d/Ē4H'XX B,ID4B4I iMMr@R%I!ݡ4@w( "! 1$'A9 mS#@$B$I DR-9 PI!rޠXDRYI!AHHt?h=+ VA$ jKKBڒ4HX0K2:/6, $ $1B$A$B$I )iHHb$Ew* q$ "!В$tR2lZ"I"IbHGhMMBfTDB=BbH'%jA< FLɍFDI hQr#tE0At ݅4dAUSr#Wm^qiSr#LIct)I!P-)S 6-(UɍZA$d-N^t rNPH/"D4H}%7"JobJb,6%7bJHדHZA$h (!-i IbH/%$ !B@!AH?C)z#~A$!m'j7"JD@.$1DT{0O ;骑FDI ^A:DD%7"J1$ړnUnēBnē4AZ܈(R. ص؈(!]x 7bJS@LI ShSCd-)i ~(P%QR.޴؈(!} ꍈU TR)I!Т$A$Z4AZܴ*9!`= c%@_@Qm6`T/#m3oĥ܈&Mr@ڭވ&MCdQAHx$1DR p "!ТFDI iz#$x*"F,I >eN@ ,I4R*$i$1DjE#eX$1DBN bInĒĐ:p !F,I I{X%$tP:WIr#$=GIH@'a}Nj/I$!I@ $Id$ )hZN$S0 QшـIFjшو!yCm8_7F#d#$H^Hε"iQ$1H`EEC:(D4Hg((ҙ 6@+("88MJHvE#d#$QmAX-YBCiA$X X!9>u#d#d#$HPtMMMMAŵ%R*#و#it H6H6HRH GGGBXčl (DlDlAɤZ77i7^m7HiLU((("ъA$ d)uC$0zǢEE AFFI ,jCCCBQI It"و"I!P. سhDlD4AGYH d#d$eHP@ d#d#$tP"iQ$Q$1sR1$1$Ui bA  F I ZA F F I O I6IRHWU== F#|j!SD27NI6IRHՍhhhX }JH6H6H6H?'d#䀴+݈%I!]1$و$و$i @H HH%It$و$i@ d#A: $$$mi G"I):(8 :@!A H|tHbH^NNNId0$҉$ى$ى$i $iINHH 3:#;#!!ЭGR.ىىi^' ,ẃA$N$N$2 HvH S HHtC$'Kى"ى"#1/ Q$;Q$;P$!|E(DD4HB$)ZD6 "!@YpHƣAq$H'A:NNNIB$I uҒd'tH PnPDB{ \9-Iv"IH HHHHȑȑdR Ni9 ##v`ru4q$;q$ Y $t`#ى#iB"k :(՝8B:đđbH"ى"9 Ѓ$$HR$ى$+Y@HKHK $;$A %ى%ى%i ~ۀ ɉ$;$ "u2d!ArBu'@:@D4HG`#UB:DD4@;"Iюd'Z  ǍT`G^u#tjt i;$;$N,I iKK}KKCK P&!SwIgHbH8t҂$$ykI "I -Iv"IDB$)-IH@褙!- ,~kzB*7fRNH]dqB ]̐IdIT$9Aꎛ VHNdwrB$ $It"9! rt ިY'FH@%v$9!}GmTJoddrB$ 3JIrB$ t"QoW2ދZ6Hv '#IG TOd@:"INIv '^ uBerB$@䐮;I+!HKC:)I7('CH%$t%9!s~$Hd IN$9C:2IdC:'v$'C֒A:&Y Ў21$ Hp#1D. GNH hzB: `GNHBix% a(lIrBd$% 0HIrB$ d)CF""ABp$8Jz2:@44!)RI(!$HR@d8uB$*`עz,  $E*!2AHj!Кdt&!ФH$'!iTOdT `I8!C[Z$I@B$(E < OC:( F6+i>RH'e#B둓!`V'D2Z\^8K9!VO$'K5 H8$p$ -H Iڕ  hAR$TIȕ$#9!A2I.XXPhhhJHRc $t2Mr@hڒ Ē K2Kr@r2:' HHHbH%bA$@$@$I hI -I-IDETbG`GCB H###13za3f d d $=C4IH&&I!P6"ذ@ D4dAQiɀAII2( }Y&&&IbI bIbIbH% @4@4i_C$(d%["'$~ A:=bIbIbIiM2M2M2Mr@V@EKH #HPȅӒd 䀴+!"I"I"I GB##!N ##@H ## !ͰojxBjK2K2K K `IbI!A,@,It%I!P6%%%9C@@&$N%ՂHHa#BI2I bIbHGXXX mIbIbIDB JrA4@4IH$$CJu $@ dd A:łXXX HkhM2Mr@d-C@H9#tPG;gIWC:%ď ڏ4g_7'9 -MIRH{xx;xJIt!; "!@% "!Fu d|%n0H^HI.Os(("!HFHDBb.A$h`HHHQmdc<I2Ir@$I!]HFH+(H{( H"Q$#Q$ "!Bڑđđ4H8Q!dԎDO!dR9 P ( q##q# "!@C($$$9 !#!HFHT+(/ $  A:mH$H$i iI2I2I-IRT "IF"IDB7,DdH<i  *dt@nP3I! $t&i(MBA&iU''I!IFI_3T"IR( P#$ $etJ#9 -TI Ԏ@ @YLr@( 7C:7 "GbH'ȑi66GCdM#i v$ "a@$iس $@:Ir@"IADD^HR*#9 Ѕ$A:Ғd$@Ȯ$1 H,IH @CB$*$ک6HXkI,It%iZe#墁M "IbHG:Ir@IBX :@,I %$ ! A:Ңd$td=e'[C@6d:#4^90h ^ړȓ$Pdz^A.U2UBWi̋A2Ru"dHDLDnVDBF"d$eHNtHĔ4HGA ZR-**!JC@TDTI ) !ݣLD96%1DE[$BDDDI A:T bJ&bJRHhS mJRH( ")л !AʔH d"$ W= P.!9ҁIU(i %1DF{ ; .d"$􍕁Wm,DLD**1% 1%)[di**I!UDB@R)ez@!r\SR+8 d"d"d"$D\D\D\D\I ZATDTIHZ J&J&JRH[ U2U2UB\Ur@\hUrBRI d"䀴3!P-"""!ƸpVP5)))!bJLDLI ldςPH'e#eB %%%)ZD4@ j\4kALDLIt  J&J&JRA$ڔLĔLĔ ~hZS2SC$'XQ2Q2u`LcHbADDDDI tR+(((!mJDBMDLI #d$j2 KcH& A2A2kA9`-Nc,%3%3%w ]&d&d&A$ E#U2Ur@ڪDd^IIfIfI#!P4'''iN'iH$3$ "!@(DD4 1$(㐉''#1A2բGG2v2HF`@VTHVHbHA{I -IV"IR,ި$+q# " ݞ4H@Osp#O(#NmNq#+q#+q#4n^u%d%d%d$e]EJJJI ݝ eUyiTAGThV7TP"P]T#]m?4: AG u03,k4&:fˑT4>b2d>}o#:k\.u>wWI`@ dCIlUCvP $"HbIAj$ H6DĐ"H*Ɇ"Ił( Q$"!@iđl#GA%CɆ8 q$)d/P6đ.Q$HRTh"ER v Dl AC$(XC!dC I A!Bv !CCvT*!fdHeP$T bF6Čl!P/n7ʹ q$)DNV$@Ɇ(e/,H6DTBeMQ$H6D-T+DB`+ Q$HR6$W4Đl! O!@+WhMjc\i jA4h $"@Xu dC4Ɇh {A'O!dC"! !P/  lAR'ɨؾ cOR5&&)("!M+ $J%$$C iIII*cxExx !h; ٢d @U KeV@`V@PJMR!;DĐ=#d BBRPI2BLICvPxR*!X|`HFȎmHFNۧHmHFtHR@BېtVR+!C 7!P #n#n$5Jd^GHg:,|IHlER!ҥ!y@ G IG I kUCCCvP"H:"HbNK ! $HR@p୅##$HTJH UGI BBv$$I!ۤT$3@$I k (88٪4H@ #$H@ ##$SR!;ĔtĔ]-JQQR!;(CIWZ!^mT+D2`/;8"H:"HRV-HpӔ`P%%%%!;,DtDȶ1B*$$$1D*$$$1Dg[  #$Ԥ\OOR!;"ՂjHHWG"JRPQR r4ۓtē5ycAvVW`Q [VN# bG d#I-%YK2$1%I!{ dA,IH@=ID Iګ D, }kR (d YAR!AC #@,  (" )kSTAv!dA ɢ>Bv dE @`ݑ(K ɂBА ɂ$"@Xn dAIH@!mHĐ,!bHbȎ 1$ bH*d%)(D:-TčT مq#"!B1"GD~M6""YER PbȌIE<Ɋx$+Ibȼ*bJVĔ)YSBfAQ%+"J*DB {R!rlQ"$lZ!;D(YQB\QR P.(YQ2vP)ď)mLcT "HVD !rl?"~de/y͌wٺpg)U;Y=wvL4.q/zf8/r_+c7l"3nuz!|wfdP}VvfLL_#ǘuںs3^dM/ 1>7y@UsmeT \ܔAH*^3_ yNFmO3JjcbO,};ݦ x߄:P.W+-VO_El{f_8CikX .7fad}3? a+}s`N3ڇyssǡA^3#!9¼+CCf٪Kv_۱u)glxֆ= J+3?f6i㬟pwl8uI'mشgq[I?Z~fyݳw<3N솭oݲe9/y )gϼka=ΜvK%2NʵNg͌ΠVoU9ķvB&N:OzTǫ?#ZF k_Rt)`XJoU+"Y窸uUYkԕ]*^zȯsuU^|^wߺoׯ[NϾ#coO}і7~ȫݰnw/PG6M=?|馛>s=_?g:S}n~~~҇Ї^\pۭ>iE;w;Ë[}ٟ7λ8p콻~o /C7Ǽcޝƍgx .xvs_|9{ÿ4..>G_&8-{O~7|M{Q/Ǭ]noz{̗㮺졯Wy;⧇=+nkO;կ}m˚׹8/-=m}_837Io'|y=?xҦ s3xG?{u <暫7 vו??/Xv폯gOY7oks}}Wu߸~Æs̷}w?>-w;x;/yK?aw8wosпU͇g׾ȭZ7>;];Sx_zuknߺOy%/yɣvO~G}{k>k7&U;fnx֜rma~?:-\=gg/c3h;inew{qw {~o~_⽧7.=pܗ~t9oo'nȿ] ;G}n8kOr?}'xW}ǯg7}ڣ^g.|M8 O|Cr~珻7?q+y՚v{+>m,!?uZWVQdZk+k}ȴV-c;kqŽ^mvl+~],{ :sqRdYC߃^94' 7)4<@/CƕsyDwE6+'#0Xd{2)S9]~.n6ánG>/a^zAvМ87_/OmhӔKtH3t`9ݱUmzٙRv(]{JQJVF[]ʕ`_6d^bݰl`ym ݡN_(m=wNb:٦_`A?j#N`a\R{l1;miͰ8uYlN¨N=F$12+j/ >ԃzt94~kQI伺Y?+͊FltXWVI.8Vj˱%ei,J''Oft{:+gFndqtɆr(.vkݼ;}^K6-K?m7ޒ5X{7wur^'9\}DB%OW/h/+;ս[¾"C\V4EoΞ+\;"fJ ~-gw!슟[ N6wؔ^<`~֩ΕMKfC]9pe+†rNiVl&mbgkzU5ktjg @hQ`˓+6pEJ*"L_Bbţ;tk"Lv7ZBja^aX?.6ַuf79Lf˩,Hɝ_=3kpںF_PbeН{+]_e5zy.~]]r?j=x{WYkI]esr!/(>RƟ||i)bwD)>YwVlG1]hB'[>Hl-ǃ:huN.Xaz@Te~Mgjœ-g<{w*dOkaO%@.^طNU XV:AݓH[ ΍y}|@S]+׽w硫.w=? _]#b'Mz׍[iޕHr 1bضx'+9>Y}ʺ]?+H4=>KO:JOo<^e캜ѫx$7aO!uVXJ:ٌ#T?LeXoUd#ilѐ'>"Sn\58+ML. %swіOڹ>6u g[y ߋnYԬ{:ƥaBAC3 `-Ve6}7n .#r$<2e-E U^BW(׳'BE%hvzԌ|d2CoG_lԬ']M8Mu"' u$VCM-!~XbR'aS\.%0-pAQ6v,]Ҏx5\13*Nx!TE$q(+eןuǴt Qn}x9[ۖ`i_f_PFw.Uv'ܬSgK9{/|MBSC[8u |^dW'#H }IJknʅLn34O'gL6L6/lln pP+'~͝SOcFn'M>|lf뿸}dsd+'ϜlO6rkS?ڰ05ټ$;tV>Vdl2ѺR+4 OCU˳SCɋP*C7u݂iRjnNY+|zt>GX#Y^JAypPg8m1mWjgXQR8We;1oM>&5Xczaٕo|x1rI%cW*_J-_eڻb)1=t)qTBJsSv֡!ޤT#?F %uV[cݜ>CUK2J3~.MFR{/OVo*AydްUԊ|GWtzl{Ki51^2^\>?dӤfXMԤ*`+B̿~V=^`-T{^Tu{r2ݓ~HD4.Љ._6gGN q)}*i4<ԙGF=^CUގNcsףztӂUֶR%)ki^N 6P,57Z ߔ:?ɪQ~åAt nҵrhYh{"_f\&Anv6!l,;A+]{/خeIm>tl?zROT|[7qWdU*_b$Mm<]:F̻-6R:>Fr@;Ə,I/n]e7n*^{\qo<&iq`R<+ůSui{|(BIWS}"UT6+JY}F;Ӈs<á_y;3Π{/\>UQ5}5у7ʸ"[7ZL/^de^͋wzu;R\ˊմ!^]C5[&wd3lflƷ{c> stream xTiPSW/{y F!>"/ UꂻVE Q" AXjA.n5h"(¸`GLGGr^zc77s}0H!C tjNd$'E )WHdRJ/¾r8؋~P,]a(7kFBB'+2-Eh[hRi`jdLYL f>)ӬK!541+jٲ*)Κa0jGP_4!=fDB\th2ESTĠH(mC-˶.˧7ʯ*E_YdlT$6)|2m@ ߃5VpcRv8< |SEJ,ŠCtF # C5A0 F)"֨=~\&}ʵR1te!DN6^[k7# bҕ|CrO&l,;5$ >;1/` :>=4ئAe0#̥MB7Z1^ F_y?QNlJt,6 ̈m$>uy1Q[_9zۃd? BE Np Ƿ4^Zݎg8\UEICܯ[؋cPCX'%+|"3vzڣGwr]Qހ$C$Rq2x20R!md&8I8LGi%=ٚ=+ϯ =jrKsJ~iʪ%eV1dCɆC4J|NTn?b?_OG%M=RJv}#sE XO*8 %Ap'v:ّ-;7/ 2r ¤Zq#ݪQ%Z5cqe/D{c-lRЦ!+̕A.(A6" &|⋕?;1|Кf׬X롵&!|ȍW-UEu"6m+PN]FƂQ j~f>Ragm;zz`sEۘTt& {`B GIC, r;$B<.qѣH;H, ` OOM߼uG]'+Uހ.uvI#lyԿh]F@)޼*J@O&OШf\z3_̫ ɫqh*yWD;>ϡF BQ)ކqƵ'#xP Ʉ! :~[(eE"N*V^k۸Sq*O,*C?gS9\Fg ]=]2weXfݒ3xػڰp`Xd`Sګt(%&{g3E˨G-oO!]Fş>/ -5]]p?rP"_Β]Ut$qyӬC0)8y=TIiZFz]D/TJv'L*].Al/hJ};!7=Wendstream endobj 313 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 335 >> stream xcd`ab`dddu 21~H3a!.,ݦ|=<<<,k*={3#cnas~AeQfzFFcnjQfrbobIFjnb ZRaQRR`_^^[_nPYZZTWrp-(-I-ROI-c```4d`b`bdd{7m}ClΕVNHa_}r?Yu*r )lov›݇(oJ`W鞱FlYN^;q&{r\,y8WO7>*uaendstream endobj 314 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2531 >> stream xV{PSg1{xݭIWZcvJZ *h!A^HDINB< FD EjKG[q]ۺMhmww;IL}w~9,,d bBXLE=;:}b|")tnͬ )0{6|t䚆()bUevZ*h1Xe K-篕R@&JDryw+R6JfxE^P ,TūcRKsD J] \HPʳuZM!R+0 V(n 7]!K{dۉ`I^,[` zlm6a?`[mv,`a߲Ϧ\a/apC lgR'?1Q#A]/-tLG!(s<:,ڎ?z; vp<2rCyt!|O5ڃ'QԺE )m(TfN8=*ï֔m1& "Zsh*w~C%Eq:&XU!sO?{y (C!׌E!;;]i;mZnч8=6X ͗'uƺSQBG>l2LťeYzuYN'-*:lȯ=t>S}zk5WQx <,kUu A)ڕz'=!^ۨ\#DwKU/W["(m[{aJEXߏ߹5V%n^&g$ԟX;|{ceV&o[ gjkp2f2G+%)[_䢿q a3$}_x;=DTe9ԅzAB? Aq;Sk-I7&!f%BzSe-~Ŧ\Wqu HczwktY)p\n{K7@X m\3DeߔIJ-|s9x-ƣXiMƬUp3>Kn2n |^FP4e5Rul6ґ%5`aƽ_|w-WA"a0qpPPl(+ݲjK_ԘP wvL*s`dLLj&:e.S2StC{R? c3B46ؽ.G3[uLR0;13V A:71ɏv@~FyH#k$2:q ;! U uY鲽"Ta;@+QLy@'dkx\ᮛ!|q|l f9BP6ޥ4|=YSoL\ݪd ĿbТ[F.O`bLx 'Rs 7v_ozA\հLGwwp&%/3eUi/1~ɏIz7?ooaڂ IFPL;ZoU651Jhv=Ƽ_C?EG@:˪K<%#]ZA( A p Fz&:X(tl4t(rlm{N5jsZZ{^Wn DLjtz XБ뾷hJ$#@ܻvwwCxF[m{kWH3%쎌F,HH\%LJ &v%3׻ 72'_|UQbjeli QN.:\V_jrqZ[W(Ҽbbמd}6oiD62|_Uh3aD"Pox~7!]NsWyif??km6 \^y%4vLV(:.1ĦONyQTeO's.iDmHr1-KlnS} φ&ii{`B)x͙tFNRYL EX߰:,~c>߻x^/gdAL}4yz6JէV0)1F*Kun%PGA'XDhzAyd㣠8DG Aݸ0z%c'W~2>`@a2X ^I%>6_H>G%_$=\Q+vM$atTB3RUupz6>- GUx-I d3endstream endobj 315 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1726 >> stream xTPgeòU]u7wN;(wV𦅠"hųJlH6H8~3*)殢G[s΍W:7oϛMη>>/"0̜MRCoL\컟U/Ҿ(D Z3Ԋ84BeFd F]ǫSSOHNNg:R/QZu%8NWyCڲeeԴ3(x|ڤ6Qgqz^^Y\~fr36s]jðz`4jH+Y, rBΊ +A PZ H鉊Ӏ[p.HVkUIz)iXAW+_Vufʤw/^ӤȪLX`MA26~OT*'iG>a3_N-ެϨ{J@L[2]SG {lh*:U.Y0vP[(0 8;[}3ڳ%hdU76'9-!otfsC^vq Kaf1)ӭD)^քի8dߐ\ojiئ20z']b5!H>!3vt*ZT. (6jMUAj$_"psi3H{=%O .G' swnSIA;Ԕ·a|^Aρt}>km,Z݀, ԋ9;.ƣ A@(jZٌI`RT*wGq%'D >[j/0ۙZ[r-VfMlYWaoyury,(@т}#-=+7.^:w=H]/b@;QLh6W<|>=rҸJȚ6 1-1A~yGSpr{kz+|'p!>&`T&gumpm^wK_ }GNGKY_M^r=v-2)#=&nWʀ;r6Q)΅}u@lQ@`xxll0?p @kTk KP89v}ZC=HCUWC[A> stream x\YsǑ~G Գ>vW!ڵ6d9LAOc@ ‒_䥷É:ݝtϠG'>=_էIF7ӳ'IClRvƤ|.Wk9Y{xr0PS+UV6;c4nn8Ip%z:ŜEq:݁_tJφƧ>/^z-B.ror6}^^[I!{}mV*iem}WCm6S]mjŸ4O/k6js_uOk6?͏9v]ٛnߛnj.Iĸ0IXCͻ2u 8L3]|j8zc]6G|[b3PM >/χǞuJf_" 9>}6U|h@)< p}F>ʾ]mk6oksWble)Z~Ч>)em~W_ _5mm`L<=߿L6 rS8eCVH6 gq Yoin°%2^ )W~-ưxNYiEAEN(͛:veP V&%%*f'GPa|?TiYv! ;ejǥyǓ'\N7H& D$F*C?gQiغ k($(8sA"O@iro ?d*z}hVYS91F~גzK:ǬXz@rr+,w5#F{O= HcYPiaCZkN5Qj`FjX e bE(6S14#*υ$u)X z^='A3Gi<CA}Z <ċ5ݗmi+-4~@TH?,5TcbF=+gXSkb!n_1Q^tVg:NZM,&V摧F4H Uo*&J'9pFJɶN4h{UI32hڃ1,x/\by˭q?(늚6D8SC іĶ_(\#!=kXmr ZE)>qv1q0aA!q>]|F ʁO =/{Y[:ƆmYo=ݤ0+ ?!Bsd Ǡs{C_p .{/׳'y 5Sפ9/"ǣ6yCpwt'I^R,ق] D!HUlGgAGa]@7_IgpH8>~HͨPqy6D0߈`ðOxB8JspWCJNq*nvJz?[I &(#zq1'X^ļ?`4b8zw,VG04(F݂ 8H?alL 'e.(VW@d䠃8׳#tP^﬉ c} F29-"I[I%gNpɡq?@,7KeI.0pյy\q͋MjFs31|Pf<ۑ=6g4TSȤ)XKj<  V8:e(y0pCqH1,wDT=˓&/),#.+$7 ǃN(pk(J'kбuշǤ'x_UeiK8tBB3_R͎&+dPcYEAxQ}oCq{?W_N,F6heEsn_QE"f 5(dH.H@RM ԇ])BSP8/c]7TJW-+Qy!DE'sfS2>" 28l&A6XWC.W;-&#-odx96Q]Io kLU ;8ߨ2)6K 1M0(YX;vռ;K7Ś%0 5,:C𪇈{Tڂl"L03'\9ak]x3B{坉LhٖghQioIC̊+.y4עjxR!ApwCFDyjlOTLQf#JADg>$L'%FWcOUXM6A5Hf0:ژ6ڋ Nx5_0xZ EY6FȜv]*iTӦnB`1;YmԶNڅ=CbͨƮ,"tWBl|䂶lHęEPY@p-klm6rRhqQhR?+`(Cjۥă<ê92*^*jYĺ23$}d Y%8V\lJU Le, @. S̜L[$0joA>AW qT-HTlHHp]]"bZ#t4Fd ŊG+8*uX+o/&U8Dn?:0J5'GkN*cZ1ԉ~*iKFǒ$P/@-"z6K%pKf''܈fDi,!kZq浄غ몀޻Jf9NX%ԜMڐVRb+"K)7J3FL.b CuĪBiK0"gMe1$2-%H`A21jtScP@Cx8r$9h +<¶6wmf?Ru1dؕҳ =z~~hbl;׌]TLz͡R_9dvf . h$eA4LoOY(UJs.4oJEL:O#9 &L\(A Ehq ŧ,Evc{e[akR6k\{RJ0d|WKTxfOq]ހ֖Jeɥdڈ :M(E:s5/;T18y+˽BqKSi{SD5aR#{Qx#m2̰ٙyȂɉg9] ʔA(hb-kdp-*o8"brQ{W$z# |mK1͂}Kn#E9: =FКk>FPJ> RK~Sq&&e"niWg41ش][O#4xy1|1 Gy=.4_ qU!mn\n'%Ëƈ3S <8ό MRxp?|}- wBϿ ]}F2.r:񞼍PT/tZ\L TV|O|PxB]Ήw-88#q-F.U͒p'8Yg"歾͸h9ݵtJ߫twnT8gœִm1erSt1)4EבX{,7znq>EvL=%VccE;Iƛ2-*X16!7Kbo͊,0`yp(f =N(l-mt(0IlP^s\\|Sh=%mDed??_6~;WspR0ϡkEdѠ7#P{å1c k=F(Sn]3R_\ _Q>-@L hϱWvh+0㧌2.)uGj@}OV/%m?'Aq.M%c[~(\'7pr=gsZEߒYNN{Y!zDmwYzpD*Y)&+50iƒKGQ(?1ih)M öoKYNlmw{7Ƒ֔BAbA*L6_LHQ]#s+=Ebtw *RtIWFh ˚?ӝE[bw9uz)C·2>|Lj5x.zVGeva?o 4q'R*_d5?^&ApT.!Uʥ48ፐT={ *?P"Xe-,pmY$ㆫ1\}V UQ_V5{y۰-z[=ۋ._thH=^:,Zo_OuѽܽT(h2%KIqI/xnܔ_7DlD5ak;K4fLz6XOqr  ˲KP?{Yqjpd}(!7vgf%汩f`YʝeKCXPغH10 %^K@]/>3L*Y^;X"Ь@oFp+f䞽9hV*pM{ . ! ajB ϰyBL9*(kҋiDXM2}kvä D.00͝c߻;/@ 6g[GI;*yendstream endobj 317 0 obj << /Filter /FlateDecode /Length 6511 >> stream x\Ks7s#>Uo7p3g3VFIQlYds}ؿ@Udk *D"_>P?[s:'NnOӫN g0"yx-c1^-ѝŅg'?݌[7q ٸM%0olY(%%;.7͙sFᛝt cE3֌.G]{Z'8/̔X~ym(u`/VFXlGX}7}O:_SSI6( ZmCv7Lx l;XFؒu<[> ?*򠜋%8g' g<9ޜ1 PrՏ|2G77͞iY䭕~֩1A|UcYVZEpF8EG?t:/ԏ՛<<\UYJч G.I^Vmͫ yF-TY(Âٿ8|!ǥŤ|Hw ?k4>` q `vM>;,2B]Wѡ*BcS~՛m 76g)>Ʃ4[ǒ*yts TO`,~mh#* ܲuDJUF+a]wZ2ԮՒ7yZN L U:0dŐXzE8Jױe<>b= 7^ܘ yn6YTH{IGBM0Ґ$ObxbEWhY} SUJ̴ Xj:W]\qBoYn$c|*5q2ZiU`x/+FdDa% @-[c(ɋ3p#'X10򄝏P,9F/\5 &,0)֞#%OwLyyP@c*e3˽-J0 jJGhEk }߈&ʋUzP򧔵|I2kf!tKAlV-If}-fݽt)ucޗsxׂɚkTmI";6+22I+jaDJ|qF0M \ hwfᔨİS1Th0/:Tu7<-tˆ@B< ޚQ݅wbӒrC߭vY?ߩǓϧ>CjCηͿ̃g4MV ln\omXqP~AȰ#VA2ْaeO4X?S!O&!A#ijR: t?nCcz 0'cv_b1ʇS"Pucb:[[I =6t}*Jk~VxCƈ.{dBP'״B?Ky> ҭ򇢛vч͚OQg<8cxJ"=/md2 6`R(!+1G]_`/[O}uv ֋,mݓ {`.IHs k,=/j~\yY>$/JRq OP69ZJ;e+3lϭ)s -8ԶH{B> 8V:By&\k6/ z.,J @K: wLBxCB;bO6ׄؿ2甒'`$.^!LS? <"$;DnZCF3uj0.i:~ޔ)*ɥfvCH_.P}T@l o|ue@fEX2L/2`K\$>EhqPM:SYFoN4v^QǍSI<{ |zC.;UԚ*S57!9L'/,K~l<ܸBS,?-J4KdkWa&8R+(YH*53yI 6ၛ<8QP"a:M~oL+v<--w1_cz8W^=Kv|O^3F+Z cnhl۴M_]YQ *: M*A}KiW涩ed,'!xu#1%,5u\#KUIKWC?TԌ 7~o_5(ʚ4oi}>VvH;_Sr&]o|7:K dDڳnoQKPK&}GPCH$[@ Hw.L^BKbw\@?>pBmTi4&]ب--M8W͔26`GK.G s]B6w#FGkE>vm-o|y(GRU_}9?N̨VtgphOE?B,Q:¸V|کF&(6bWC1i2_Pk>G2@lN1C^/ v)nb]W~(c8~!`dC[M`dEg Nn1YHvznXȮ+^w319ѹ%Vm [p8N%+bURhLqI^ %#^aqRm q*:F3CeguB8eKW"u>7lʭg|եp3LД܏_ZƇG50S Ne_ !B^m\'&eg?lZJWrż-}ݽMslq| {SQebVF1xnC)f;@߶c#rԓO@ A{dJ[f͹]ӳTURWGr}e2P1󍐈HJ/u EK5TvقVl̦zD`5ŁGc |UP45}ԦˌJ Gl;.!b;ȶ20 L4FpPSWݞxQx]`x{,%v\S1;> stream xcd`ab`ddt v04q~H3a!S,&Mnn5ߟ }/=[9(3=DA#YS\GR17(391O7$#57QOL-Tа())///K-/JQ(,PJ-N-*KMQp+QKMUUp-(-I-ROI-c``` b`0f`bdd3{m>d|]?ʿ_=5#vnaKoH=}ZlX'}wf7,ֽ[9+}*wJ=!/pq.3endstream endobj 319 0 obj << /Filter /FlateDecode /Length 7011 >> stream xŝMs$qssáo"EwK,i{gǛoVOrʧkrv͡^/W\Շ]5=ՍS/s\9|:94p\0 q]ǮnzipNDZO 2Mmu{wxZ_o"|gac8Ww+-s7˩ƶi7k)qkq髟O}3q^ϕ-Trje]KO+0/!|ɭzfYiZ?׎P| U۹;Dn E_mJs?{i\2Su{7ku7`xU_P~}^n>Dh;64)}?|4uaC ^}s'L?E>=|,m' 54[ qM)8#,2ЅfqPY[׋}؎+yoƗ0=4k߅ڱ;v6II0^fl jױC37)i8I,& \.·֒I ɭѷc,ɅijJW74vnba4W'jׄ5]zoǹ I@M#Ȋ<n2FeY]$tu.cKkpۄ)Rv4tLBADŰ 쀤Qn榴ǰ|IISݙ$ =Z,-,W҇YB}V s zк )aY94ITd*aC7퀤$co-fՈsA.LKՙV8AJP&Y^O8 N%@d *!FEd2 xSQSRMT*S' df(ĨX 1A,2 jV|p K Q>xJW%^:yEK |B Fen .<|pu\Eah]T|%03rbfZp0i(? ( &>bbV$E1 >E\ieaguTB> h G91C32MF; lV()sJBQ$%!ZdPIfpu͓PI*'S.1LB ;3(M PvS,+>^.; '\@Lux3 aS3S|l`.6 }>9(E; 5^Ԗ[5ӕ jsLJ@g`|qZ\ mB}N+3>&+^qlIw8 ޤ1fx2]OP8(k _|Rc:Ix1x Az@vq3_2(;jO;2U^$١PbN·O*BMZCT|CVl6ߨDM2A:!F !Qnz{]U.nD&`Mh'K{7KR$,Fr_ %-Gr\poxK'P1tZ{;<>Rz =$ wh) ʧC` (fe!03ޘن@/h>ȿ4WPw@`!e& (L@Ck`WRR; 5JdQIJٓd(^&Q]On|HIQ6ɀqe" O=&qtl3)\DgS2Z; _dKyEf1nU1|w@ٟRKO'R| ZdSoڂqIz(hT!\V0˅daFIojZ6}` R AC χ5wۻ}s`&>DQNPCYl74%Gf:h f]7Q\Y.\&ajS$>.p:e5t=,_j,x$EprJ'zMxDƌ[D&s"..Df!HX^3]@Qҧl UJ*n\c:\PAKEQcY1$| ʮC晇ɇqe CjŇ@hdj.@V:4 3]W\͌m@408C;U.&D: oy hOu<|q+6թ+QxY ?3c7ezѫx,V6%sJ!.IyETx>D =bB"dL% "* TmmaCu*p-p(!ӗḞvLu%نv G]\h2|sct@{^\RYwtS_+* N+\K.22\]e$|U ,FEg·@ex:c8~\0Խ(_ /oz-Sc{zJ)gũYkx{uk9m-RiۧûOOsӮ~}S3毇onG ؿ~:|}r-CuXl#}lnn[BϼOU *lUmϧ :i_,SS=?>tޙTh$ާ-u4zWOAM=VSH }CKKû;uZs=Ҕ./|NJ0ݨ&+UDooz(.}Z졮\XiFyl~v锫Z݋LpO%o%+̏ 䞔K~r~}5]>lto?x~1 [{;^wk*ճ/NݩnGw_><dχwՇ~\7?t7:it|/3A0z17R{;Q1K\ĨŬz}5˳w^χ?StӚ >zsݬY3歝"YhN9=b)y*?Μڪwb$K>]lۇg)ޟ6DӋC$='2R""s_ҟ},ÔjId;n&ݻK[f. F1^fCz;ćfN}؇C+F>w>S(oYwLurgLu;d>7lgŽ(R> /@|&Sf}*3w*;M *&(T[NYpo!/TʛP CA>7 '2w@y@xeNJu-lBRsIj"l/1?w}{BawT:Đ~MvLI%Sng%x3n/D_92K|92mR G {d ]0 ..c $tl2&Cz !Hኒ+R( l2 )\IB#҇dTd*CPQeQJMe dE?sDf+݉&Ðh2 Me%sd Է-( (@pA% M[ &L,70^-d2l2 MM!}\&{bNw@cLmʈ|({N1:t+&cҮ(\&yAdud.@dt,.MZ\( O}( W"dafS> xhIJ|(+oۇJ\e1#҇ɘy1=O/U@j#! CwF2*aH{*cJTƌ/jCT2T\:tT41a 'z .UƈE:`eKaaP|(3*ɮˀ^!P#$Puz"z AcjR^ ⥔ЇclC1<,Eنc:!={\KPcxf*"CQd$%`Qdx>)G"]l' /Ee(2|urc)e1VD1|gޘ,}yH wuשM2A:I th I|)SI#7K!JSw@ȩJzBRO> )χr `O1`s7Wsm0AAUɴSl噉Sl%Ho`Ї J{rN}{ʇ |B9w:Ci1J dz)Jsu*A(鋢x:(=J6TH3wxϓNC9cS_׊T)Jw@`F>Ձg  S,!Qiw@$4bǦ#- 1j: : o_@|YpەDA(|S[ * Tҵ)@\.| t>%ČM |SaHPjc@gҏThh*T>aC3uf!HxO>mRVC`* |S1LJThMJ*~aL:/$ /x%TI}$R(!쨀%K*n:Pn8&q9>2SN p/٥Gv@Yf >2Ðr2cn9xI5 f[t(d3\-QR!:J W~1J A: o[DKth)TRga()XB>ʢ5*qa >E{2 *ENMR|CR:czQ/>>(DsW?C<0ˀ\Р@>³R! \ex~,ip)h)\ڙµҺ]M$p>bV8#I13:P6T\LlCdLm]ǘnDE!12;z CfH ÐG Ðze=FA[&LV4QiI c.NIZS'$yNRT0S:Ԇj];If.{R>]&eA |!iRMA *` P}4Ň v|(Cş*e0BNCY+|RقVÿe+ zʆb!%c~-eŘUWe1sI'ul1e1~ ‡!sc˥ PˀLT.˽ u19ߙn֔ԭT¶Qo-|I+Ђ]-`"UuE6vٔFmtsARy&y.M6l]Rv54:WXsM r{LQ9*ҜnMy}S`DzRL#i&WT5T2^^9tMc{)`bsT*m$trOARSK)6Н9r sKoO&|wJ=fZu)~?ʄzoՏߴ!bBsuᱮ祑~\1PY^/M[}ҭQB.c8V/骧0y[N͞u_iz~=KWעI4_K >_cTH_f|'eMD&5u'7gAOkك):n/ ޚrK7'qgMgyQx1*^q-d$]f.?扄s}րn}dn&SlOd ~:N"r{.6t<;68 UfIQC 7hɇendstream endobj 320 0 obj << /Filter /FlateDecode /Length 2774 >> stream x_s6)L%ִM4mZ}hAd ,&ؒ~<q$Uۈ ׫ſTuhş _+O?Ӹ։jpgTw}TW/Fmny6oLwιf9~Y^(%=ׯzPj뙶U7PΪ,3NwZٹS? 7{m}X}?禮?gS/ DoMaMY_ӭՊ#q{"ܰRKi֤$ՠ׾PR4}V׋Z׫OJhzMW)݊JJ۫n_}#tn4TЅo_Mɥ %}˅05@qPj5Zb%)Tp@i\NW1q]fhĥ5~d;vR6@k+2PƧnTN:G5o^2_ 5W+R|+4R*X Rb3ծ,, DpbX&@22B 'Ze(P튬2ff+6;g_d ugPHi:"CB^?v"Cj7z*_SʿTB׿<7Z|U1A<|3R*RbC+`LBg2K<Q"ӱă%މ,2KRbCJTC|v3S.E״BztP=~x~s6׻ÑEa/ ?3mW}vnұ?6KF؝/nc'pՇӇhWG:~OI'7HQMs߰8ld{ڶommbYLׇ.좒ˆ016*hXpFUp4G~ Ņa%D €0`(.  € ŅCqaP\0XsrNYy= fZļ! Jy)^yBu!D^y!:"Cjw.ESʙ0F JجtwAJ㬁ѬѬX5Y!5Y39tqST QAEjyXyRb5Jyz%~0 1eR3B Le( t&9tE~* DY&0mLHlPZF*!VX RbALHC,Psc&@%4f( D!Q&@L-rfTd P2A<~ĒN iRʃTCBϡD&heV(03C103C10t&9tE~*ʔ X)fR^?1C!:!:"Cj7z*t'ep,N?6z}}{mPlۃNas~C@.Ы#;dg}ܰeIۇ\zR>iow+l*2;,p}:&pӅZopח'Y3ӰUW6|y!UpvrFg\κzr#l;]?iKm^-~˺~ǡ em}==~n #:ZS|'Y Ή-'BUM}{7Ne oeB =c6?l8̛FzX8<ͷenYvF8ر6#pẋdT5~pRpQJq8 OPg@f3~g:[7 eo 9endstream endobj 321 0 obj << /Filter /FlateDecode /Length 5013 >> stream x\(F:ebwFF\asm]~ı„]VӭWڮstwk7[!B%tz@+Uv1x^,Y{0rX!:<%igDFv{BRŷ]j#@WOavTVz>8S}u.Ż e] acFDY Ow5 /#P~ =}R7 V̥EXKY$h{nAvIw pM hOO#7^1gڃd6zSOF$WWDEW=0q[kt|_eͬt) -A쎘X᥅r99-Q OCm+H  8ctY;8ISyEe$dr<0( f>>w7 ߯+k`p}>[ [{/5hL:-r+ԭ2fRQV@!a~u3_m*'r Y"8mL4#* q.2afH, h*AAq_h+*B/6tq2W:҂3-r pt\/szJm2F~Mv50  T$Y`Dm*Ѩ VKrNF :iߌDR!.Ib\n8͹EQ'4!ub+e-M@Om|0n  ]W%5qP0]6x<މs}޸kx^zHj߀=f-\wTd!J,:M>u%6˞o \e5J1"|g.DD{TE+uxPOnlc5Cf5᎙1֤5ș Zٞ =5 LtWIФI8QfS ў[ G`^ELspaE'IĞ0ͮ1T1wc@;*pGQm/Ef\pq"H3 zHWs-[˭ިxarNf 9l\c V3cYh読JD5IkjXK .pCņnmfQJ0[vVNr6ܸe[/;exsGF<Y>eg& 1 & \uOi2H$p$e.Eyx9d!INxUgu"mm2Nk>]n,dmr.m2M$f!Ss܁}A ]f9s'hxB 2]%Ӆy+]nW8N ?mǔ[c[$]eC5 7j6SUhG(y |B+*PLg <נ: kak:d#ǹ ykcߗd?MG[n*WˠaJxPTځuvyLI) |6yYTJiI.CmswoJnU1˅w$4FUAV2x0 |CtЅ20Ͽ66..+ `JaQ'8@y3~JT!cVwuz.X;J2*h}\C__WvuS) ~܇:,:["錎:i{6OGM^wIg>W|%x{]:S\f X*Mۺf˄w|,r=':#_"_-ۢbsDhbONkb胮<Ȱ^86^O,oa_-GN%H;0O6%}O{'H4m*~e [P'SoN i?YNz8^eh,1rVoOĞ0!Ogḁ$%d9++l%x[g=\uOʞ7ĭvKڤyؔRkm R)ACuaQ| x&W[N856/.-/S] t3r2r/d@S~&ZKK=M[/.*rkDHM7DNnnGUJ[=hqbiۇLKT:09 t&׆&+q@ r. SJ+ǶJcPlLɎDþXy;\l(A/v6h{*4&,Fy"4f?,KxbOYZ3zr WZRōB?@v.Ϥf)4"\G3hq̕^}``f.6Sc837LNwC/^OWY>w3 Q3k,24]`L쩝405 fV˓xjf9:*^n$u[ʊZϠf rʠGf' Tcqԧ2!FbRXrɷz-4#p4&A}LLCֺ?B=/MM`]^#6Nn UfIȒ@)'XEh3sJ52{2(e~$ ٫\s/k z$qɟ 7L_vS% |aJo[\uM8trb'`Q),ɢm5 檉Wx@Je^=zm3M+yU.K0NOy|UIοYoj&2}vݯu᧕}O% O8Mj6-Q6%DKV^趻śۺK$~]oő8}Rr?vogmwn ]kw7f[ux!>tqctx8 o_nBٞ/+sPNʅ"VO&?\8`mU7_=@@p{3[Bc70'v2 {K%y3wGo0em'?pj )20'η_$pKlFe!LB!LQJSKB~S3Lr}nlKawʸsliyR'5 _ 9RoO]ɰ*, |:dSzzz5*hOK3s]2105DzXPفdISnzdzdQ} lGIjJ珴 U5:Jk&(1lx ̶?@g*Ok}IfGֶ95oЪXH榵Xz]l4ԊvCwN gspݟk {bY-/d*غe]25N;n2R isZckZjzէ g_4ڥysJmiF؜:a/+ XP0 |*)-S"jRK_(Ɨ1B&umbD_=eԇ ȏqkһhnzWGmtS_b-^?fV]Q7;2@vzuj2U+*'u3~\y~,s>; usgs2W2c 3E/)_fVudا_ P݆6Fץu}w w+˸gT&D~ذ'%2v 6.//tҐQ~o_vگ(#=}uw[ʁ0){Ou8zuƔG34oFu(jPb=q;ą׾q z˳Y8{]:cjo/ `LĿ\Lnendstream endobj 322 0 obj << /Filter /FlateDecode /Length 151 >> stream x31ӳP0P0T06P0P05WH1230!U`aS027i`9'O.}O_T.p .}*.}gC.}h\nn@n.P9?47XΎEAmGTa?ߠ pS! B)endstream endobj 323 0 obj << /Filter /FlateDecode /Length 161 >> stream x]O10 @vA,tahU@p' aKB,N>~l#GpƲ5 HeQ7-Yy!' dv~W3|ʫzӴxO$ڪZc:AMq6?M%k17MR{;RA|@Sjendstream endobj 324 0 obj << /Filter /FlateDecode /Length 3224 >> stream xZɎ5l:p}!ImЁ4fOS="ǿ ĿG.UYݳ|09Q/֌\פ5qɲ:NzH=W?e}8K7U*^k[e}^6Jl#jkl&#[EDsƤZf<bt9n|;L[0CZF W:n eIi~c*+ ULȨT Y7%!01+7FG`v՜İRCnցBsuQi=а cY&p%ԅЁcV0D\Dԗy$'B5YfKCŲ&ݧ`lb_--Uh!d(g^05ZDьSmd4w>6U4I`Lח**i+Yh_bY; ʷi¸"[\c:[8æ<1Ak3n<-a3/dJPF cnY{oN8) ޠ0r+6%avHa?ZPO1 .r'ӵܰ,:a}uK VE\&ԓrI"I(.`H~ME"/MnCF&csgrY~"0)*1Olt.+OgY5QجHn9-2 "Y"_GIİ,.p6E^hjpu"/B6|;t6$D~HY\gruER^K68oKy WJ?eo rmV"͏ҸgҹzrȳbWVQHyQj%͓>h*<(ur/ި0%~Vx[w&:rєv׋$]qIj+Q׸(|D *(L6Gwyءh^d&8Z޼iz}6+gʼnѶmZd6ChqHByt{Zrn/eeqwtgbF9FP6C󇯂[ոQgg6; |+'٥r8|Z3?υ8^_?DT[7J'kw$ le*|+30q4P\f8FczAXC7ˇLVUSb47[.H,St B@l k}?gZMѹOG 8k : D:''&guFڳMˈt>J-;*bpߝϜʙ(e059˃^)JE3wD:#]Yf4g}܉i9CG~q@ܟ#mH`3YO$~^D3k440pޏtM@f< H)s歯h扛.jjٍBʒ$M-@|m?[a9ծbQ:*34̿r . 7+[z&&$#Hv[6ab?+G>0Btq_Sajz'}n_*i6>]y|2ͮ| B:O0m= 4Ƃ!\׫dbw $MݍUv݇/`e>~>HiQ^PyW)ipęUص>ʗm7r ͈qE 1]1t&^r0*>3$`#K0#}'m!>M =LXC|[fȏ8VjRTnRq ˽vq nY~%8+KMqgS$y 4z^Bf;+~K *2'c ݄p'o?av/ p29X *Rg~qǗ_A|~ӿ{)?RX~nS;ƻqQZBV]Xwɮ1tlh-AN½'Qvlo;FRߜg?vK m$5 E%gĹQiET`"4J%jXOP7|n㏚MZ#e򁚱YuďF̱ 6ӂ 6]9aݦۗm{ճg}A+ # D4<_ >.m6F*̤TBrwB~Xg9zK‚wendstream endobj 325 0 obj << /Filter /FlateDecode /Length 160 >> stream x]O10 @UuA,tahU@p' aKB,N>~l#GpƲ5 HeQ7-Yy!' dv~W3鼯=NRP> /Filter /FlateDecode /Height 150 /Subtype /Image /Width 150 /Length 29442 >> stream xyUYgʲ}_lO*ӌ6-ʒpaUag`d~\rh70iX^fefVj{j ]{}|ι>>N8x{~o}}??g?~[ww雾~))ɟOTOxggc?_^oYY7_O{֭['w~wڳgϟk o~}ܗ|ɗh's>ss9o}7~Ag _e_wFo{OD˿ ǣ f??+yؾ}| <щQgs __>?;; m{{ τ8/?>~ꧼ`GOC뮻7;k{S %Aݻwcc>?[[n?㣏>}{{Y?^jB06 X'>]w^_X IOzf˿E >*췾O;vl޼]zPq÷-r7|1y] y{X_}{7b2oF"Km۶߮ρ @'FB(g__?3qHkHXEC~~8A?uL>S?ubP͐߂xt ~~W~%um}C\{?G)c=%B410f?ѣL0}}mo60g$4 !@>~w0:_U~7WzN?2D>q%IFAħ?z/"> ۴6fNy~~+?yF|!:hѐz PD:T<³: {XDJ#d@<dl/B:*HYC? :mRX|zȐ` I  <MKb x,`y@To`x6K M49ӧH!:Fgo!˿Kbπ!A '0 Sf<{1Y`6mڄۍMfv5>y[@#+܈!JAz7C2PSblثE ۈ܈7V1  ;+͵P4= ,$#'@kdx@0a$LL{HM$/d8kS 'PP//VX\RdBIR"Z^#IF Dx}S2>`p+|='!֝s9MRM `hRa!={55$Q'?ʥOzOOCT 0M>f8c^;0B6Z8 8 =0m2eb|tB1O ?,׻??I]#$ahANDmϬ($48ݾ G ҿ9jxf qV)}'(':;?kzY#`E4F%: '8cH_# ĂE5HX n2_I: ]b!QwM7Ds0uQ{o]QR><#9pIC!/bĢcİw@eHgN F^"M+ ;ǼbTjD :L.`D3' [juѲA暈/CE7 %/y 'p@6#lKPgǤ."-$#آWni'PCǤz@@9ecA aНCpBc!+BYB5b/S퍨 T8I& $<MLQZ +*# sy b" Yt}` N`*L1g=4$ϧxnذXLic`'~'`` \e F jD;ZRHteL*jGǤ'NG?#ңsZ⊋.OFOkyw{4[p4# EG7hb'&\[Mpyyx7!&k;! ΋'[o@[la*C&*/G|_k\@їhL>eS2FBL`#Q&w[a=$:sÐ I^vb[iN 8=}%"}߬_;Z3q#, ɠNfMNn#\ d)'JSG7[CF!@ 'DxIU[l ̶174ھ};قC2ί{!b$@,26qb͌  %yX<˜c<4 Ǻ6b'0i#4/7ed@ C#qH CP/|!.B(M g֭PVd g?Z("΀!} 4!괴u͈ -nZXD{{NQ-d|@")$0S <";F&e'C d4H 2~{#P'"No@sOt8=k4-?<ΰ**Aw\!*gK@H׬r>'+o@ p( Wko&$35yMkQO^4Kؽڕ6$@eMX6m1_QBx1wZFy陃`jF6P?^ԉςS `*/|BmVFq`iAFh9K*g i ,R^XOqmE1Yi c| XB_C`fՃ~Hᰪp:Iy+=c-2k^hP 2})\:lso =k 2A9Vg0~D릿nan #Jf^,jljEd'p{.IЅ@ =tpP QsD`ZF?dc5hY5[UΑ l~BS`}EjA-1 NHn!.@%A\F "Ӏ׉QZT`}8d}InSbBs[cYweG'L -cǢ2ziR)d2_х࠲4/<[@gMAFJ/pU GbK kuT ckaKBtͽD>E_2-(慞3M-m5E1n{m ~=PPg2r:b+z{(`tD`/POlrMnKB`؞hmPZ @i_3 N_5h- 9r:ߵO1ҠdoD]7bxJ iۖ|I,yfRf3SZ3 /z3 K RZ#֊ [>5}_lk#ECXD\d WԆ{fDޯCtP|m߾L% kp l#yDVRw%/iB@C@PH lT` D™fXx cĮcл& kf ~N4;_`  UnfeOq3UR@"m6TA@TA7,Sw=CN g$8"ysFIڷ$D_hPz '`!ԛ3Dxa ->y}L)kF2hn Kjoj_R 8M MQT!E<15#)~tʘW9Bq(Qsv|EAcAi l3&3lXq۶mNși#(o I'(pCyOtf>ysP s;)= b; 9Ba0%1qO uaH~vt},XY654R|_P3ԧ>bB34@2kFLHPHO[Mj њnKPDG~jP%rTU B!ph _5WZJ~Վ f_(f6Qu/}K`2&\k`ZVgJPU1Dߛ0 ю(L,l–[. i3XEr=ɐ5vlђ/P^G;&Dҟ.| R- 77Oh0?X< ݤbXBi)i|sZR!Yg?٢a/ YVgn.{>p]J3D}Z~]yw31)lZU0+RF]fM魖;e $vUˇ(TB`=8R3Ѡ@(z07sc3-7 ,Bتҟ F@]W.y19tT[-/K:Ԇ1$D}R)F'%RYUF'Dko?@dtw,u{]o2b+&yLHL= ᕂ/?'6dL4q־Z `W%^^;w`2$?a;<0fkW"e\-ve!>"Ҧz(l)nyR'MK cpI(ADyw"t|acRV;"&٘<,̐/_gGZԛzwq nTG:SoV,eH9Q-!F.C =/zSAC˽ud ([!;c SӺ/0c6V">&ZAd%-seQ4Ɨ@(:X4OX`#@,^LږǖoDQ6(t{X]MKP+/ t @96nV*_ -/v|M* IEp 6t 'f?& uQF Qen.Y/xTel%5c foyoNx}EЭqʗ2dO?F 6z`fIyyCd ";GA# )RmG/=}epywBsei zֳEN}NtV OHQ:E,v]{6HMhjtR#8f8_XJ{R İr!zI%$H맿NAۍĂlҸ,w0τ.b󨍁7\;*T6mpd"$,vm@xߌd-/)ZfMf/?CX`#£™V@ڔ-{L$ZXi6~;/-dP6A$bR솘%_Ȓp +5@,Bt,v]'=PJA ꪂն }7бa_4-^Ymڴxs0VPvPoEX-< pGeص/]EKvAXfe8Pr %%>eYRx9'`e\"6攥D\1XFݙr)-}+ L("loѼm]G5XœT  %N k7VwGy$Ë= #j'SD T<ğoBdDt3cQ|* Mdl2$HQ $dԯc[%CV&a3?C =?hIe 2ӴՌv,fԦPћ7x hmZxW0ZO\B88g'h0c1Ԏñ!2iдЄ A2=F [kc1ia3r@oq +<` 9#P bGV*^TFo8"\ T:SDZ͔M2j p-5!Ȩ-AGD*0iIhg(j4S& p^Fs![\QvA#"5?"*#j@n\8(b_|1GxD<%KӈHIʘhB1GF|(9j jg%>jA"oY&Wd4B9M%MYh*9Rfs! )fSB!#"qʗnܸ1r]BjRB<"’6zH ;jނ<"DEKZ#g6W6huf KEn"N =Lܱ HBbۤ XC3ם%tN:A"<ҫ4!rLb'.@`~aR67;ess$S4F,#@ hviMŬ 0^ݙ]cjO;;& ;pjmҲs᫟PxL*y,4A3n-MF1K-O%PW#-Pů,CZnzE߶UffH@3Lr٭A,-'mΎ5Rpu,t} xb(ljpɫXVcB1V*~uGF-D.F#QQH 4hV9ĠUˤٶVgzRN>"BBOt҆0F4Y,٬:b>7TkbTr fT+5aTʚ!ŕxZd5%*,TkesWh^iK@DK:ahX 7*Q J $`+gQlZY%el M6FRS%e#€KN1ryTiB F[n'O:x ٪/M6ѣ^d0L%3fep֠T*3je|Wnՠ"#Mz#"[ bj=豜eIbes<:D|궓MpFBqi+ >AS-sdSB]=cN*ťY=*؊P4p4^'n1/l*GZcT|5ҟm#!=o,XMJҠC\*!z*&K'Op[ҟ P%6cc%/m0ɧr+z23%%;ygQU`%ġ,/jr !UIB\%a$=D׸D)J}B (W*^YTTH8aJ#&*if;-1b\Yh VY{7p_Xm|1nOx E>u~!TQM*١C(~ɐ{N/䁨~<>_Ȗ^/,hFAI޽B0`^_HM B0mN i|Nz|aU'+QGa~-°z?%&aO,,IǤQGK)xJQy0RJ[ eꑕu?)MR0RoVA8wIrcU2faf)Y/#U>I^+ x@VèSυ3mEď؏$ܴ*RLV$_@//xGJ kA&.dhO*>A˚ RʙL֎QUUD-L6Tztj%Dҷ;4ҾAp-z7eOUVuOi:(ӗ0#J R/q|) 2MI!(56 0o ҙ+v*pm!ǦsWmMّr)^FmR BG۵AӀ`,-4`tʖ V[V8Zh PH!4T7y y fø] bafmh1Ёn4b1͚WApZ'C;+rgEP,E Ik w]x.l AmUMHY(K&<3$~tB&3XH{[$ -Xw&[27{%kDBbpkx8ۦ8qQ!)MkzXAi!mT]C"HhP26. w+EnhyAw-4]Debna[?ݽOF G/8v$xɈL`yAl}3G\[riV^a!b- 4L3M%CH&ܹs'3z#q~??w-\hߵOsnsԨS1('pK骑f /xIF*sq;DT38* (6Q YZ.'18( ʐWq0k8HuȠC?+ . lk nKN5vF b! *q8Їn|!l^:p]Z-ص@"K/BkE̯՜Z{K JȯW˫𣤳کe'+#rbn4#'5+ Dž?vB`U#0heV8$`:Ӽ0-J"RZؙvM DMqqKFLiq;=z AP_}{%%"<`jOHYflJFt¿ia ;U#]5LH3\]JYdSZwAZOHji`g*ȟW.ehOR歰"iaE3EřfĜL uvj4iw,F nI1@t%Ex[r6Ue#e~1BlKLiY@F@o^oZL ;b s g  4ZJeH+)۽?r.nTݜ^8#AMΔǁiNB}AL#Nsv/^U|؍u7{%,bGD[{L3$ճopΠ R|!Q# 9)2%ʔS #80'nR6`,0˫Ҝf (D fuۅ?XL &qsawX@U}V-hO.ѸUvB.ީrweN7!f3qAeXZjJ7jwGlh-t RbIEƚft/Jr}ưraZ6L@`JhщQ1E0]]`Z[|J8׍j^O%e"Ϳv>/5ru|;C t"XD*ص_S)w[EuO ;k%&B *^T߸QM !0O}w F/:dqO5\c;?fyfBu u ?)O JW("<."]s]iWPꪵ7Gdw#՚M)yr . Q, b.yaAtı2z^{_N™ u;BkOzK_[De7/$ޕpia(mޖnfDˍ۽{wQs_qQKvyxEѱ_TxKT!AI7p,mftv Mak29 /κ;$u-VZveGZ)Y-/ZHB-)(BZX=]%qp 8a3UjB5f@EWD]O:52P3C m16̚AsiF$:Q:ܙDS)?5/,!?-lA^ॅ)+8 q&7诬VةU.%m727W7|HϪЀz^ϼ*p>aEy8Ì쓬-nQ0rc"cQe<+6bZUP-.`f5'O"uOtOt-A]8ݼliv( +j ih ."b+(uޥʋ3bV*0z&փ@ħk똫DI.yU,6S;Khs'dá ؼOĶ|NvPbpǎ7nIs'pq$sO:F-P&7@bh! ]kJC bjy*8 Lt15)O DCs2O 2 M*tHuH;rZ.c'P!l.cfE%#-sBaEhЅːR#fj*XPGo{ye&-Pbg?uht҃""$qV{ȻpސY"n:!" ~*"ńehSݓ>Cd~W{tF..ͻNt_#^9u?r+_ʖL7jSK]ޅqpdvכ#aI%zCFk Mw V0\d*-ipb mr~{*:NY}Lw7jwwt'<.}*%5F-.3YGpY.Myv wX֜[JtDwT/e*k <ټK%.&wu{B@HGI&|m6{Uۿ,񜊺_J1P:٤svy"ZOau"XN6iVY<ʫS*c;[oZL[#-wdKn<ݮl޼&zGB *>t-OeDp̫A#H0i˷ՊvתY*3y  lRYZgn~1e? ,C<+<`^..:#-Á s#8S=8wŰ&$Dn>b<(UPi=}F_TԷJGYt E\‰& XjGiiR:4ά9n؜>nve`ZdГR܉$:GbJqxQʒtA\|}vSxANZk/mX.&w#0}J_\jJo{X,mPefwp_gqh:O_DKBl˷#z1jHapSAJQ^ 6F˫Ӫu2H|YW{aXe^'tR˺vb/}V-^Nd[3ʫ_ \z)f8D &qyڿ$Yٸq!8BRcL] kѥfS@5 B*!v@TUB]0wy XxG92a;w{q'wsLڹs'5i [נE),4:%vg^s5d 鈨YБGX:ߕn lB!Q:Zs BMQ %Bs Иax5&ڏ ڷBd΋FbE۲˝\ofyeg!ܢa L1@aUi!WAI]K2ՙ+Uݺݻ+(!}hRSTMQYodj%(MwwL #|hNeŝ/me*'d8Aq^sP[*sݯlB"S0)bH\&ⵘ:%nո+C ܞt||xE}A&1Hͱww_)'MZ4Sv*7{:gwd¶M7V"Z~tmA:V /b BZ 2Meqn+E||l mUp:L E<'ةϪݛPu?)C w{.1v6.>3SDWM`F Q-b[!誚ps-DİܱF * 3C .] f 鴰D`R>aZҶ"X^L/H'+DsW GW ^H6n&Ĩ^ŦԞ@,k%4Uog*vڵ~뻃ׂKZȥɦq+r,LZ£7 yg*`g4xl6Ы5W} 7@r ztM%WX`%z2¨ ,QGҨ OyR;PgL%~Ǽ2to$V:q/Eo.' uQJ$E[hnw\oM2١y5 s98 $913 $Dc}d2'XMX햔8ӝo`smڭ5R}N1G:v\lESag}W֌t1TG-߶)OTt#~$g/moqsM慝 }.QaT`*1Y!ITT!v*۶m떞v*Sw-5R%D`%:yڙ/ 3v*)^_v\12z Dž?fcnyz>/6NWWfTB9nᄮ⊒ڹ,DGBZ; [BtrB6N3/'ʚ#vOewwjubew,fYLX,ֆH!*wCe BŸ̕W^ ֈi#M݄4 ڰՠ/&AD* fS{vTˍ|UIPǎtiӦ".SLqAE҉HGD۵7"tPPhI/2T ;y%N1jVз.w':k饗 6tDL{VˈvEmb H.)|׭>Rxh ΘʤcAZ%D:ѪjM'Y)UdtiUw(XȜOxtTm,!wԺbT(!^JϖƒM=aZzn͖4蓲v2&ǚ{*oJfֲU,(x bV sLӉ$om;=ȟ-m,yB9"Qwdt#ҟ(Xm<; 5Iڍk Mhw65T %&^ܝ_? ǕDO6ԙlH/!#XRu(x]8#;] ҟ?~aG_qt'o t=4Ն-c1 t'=uY,L5]Oؙ !`U)ЭW͝BvȈHyUdm<'m8bB%#"be є(֕^o]D# oΝJMQpQjt`Z,!`ŭ$n٤K:S1j:d!tZh2TT F&>Wu;:'䥎,2h*4WB>MGV4M;F^ґ_/`uDtԝ)!TnR/fIj`v4f~g __JҀ^ۮ\PvY՝w24ΰQyGNJwļT஁c-6ChH.`؝Mt=igDX]*Y&gz(Uzʑ,Dnt/nt8k_`^*B<+T3P9抩zqlz]|lX؆Z7e Vmha,b:>A\:ٔV /-|\NTȶD gj2"SVbkS22^46/++S}Glj GIQ'0FMATr3<'BR+wDz蚒qG;G,1׬͖0Y)`17 eFVC;'Tn-zcJђO?ZxcօYTt,NTq!m6a$16[,$]4 > Mc۞-t"eiJ Mз&Y.ۜfwC$8Ea!vxւh:bPiDV(`9"QcL*F.E;P,-]EdwʷrgЕ™vMUZZ@=$uږ/Њ<І$RJԛxӞ6/CɔHo49ͧQabW>%bK؂::'!4J !3מd=oHruP(tsjX[ْS*P ,/ӕ]-g*1J8SMk7?k}1B:eުK`Jkux,\SbM PV^ f|i6+"͊vK`a/|ΦR +&R tJ%ȝk0'Z`]Js8ě\\@Ok2% -I!~ul*".CO@>tƏhMHwEej};Jњ1ǡeQ3 kl< ,)2Pl2T90x+Iik=}gaYνť*@X* mFwHC?;"M!-(_Y _H+վg;rM4/$j#/ݖ! .m^9 m1\NŠ0M+ASHFm::Bp=Y՟]},jeh$mTo$鍘kX/A!A!'`1|QJZЭAĬ"2%"]ּ2vb!XDvh͘V { DgͲc._L9J9T|\lbFs&q-ܲ4J0 m+Sj'2`KL]m޽E/zQ%ãG-(7&/2hD.+Q}i߃. B"^ܸq#:TqK±tELO5nQzh D4`H_+b=*AebwH[l)Ϡ=":Ӯn;G8"™ٴHMO`ds>-!}D~#muӹJ} <$ڔ `wڭ QE}6ï'TmD˨~ce0Y|=ijl݇{ѻ9ͿEIꤊ# ])vV*Щ6ʝMtH)~K?xRf/| jѣ bnԦ 7jWoNv[?WP^O7l h(wx[ 5]Oz~VJZX[5ذ&,`!]1ڃ*h^WW)LZCiq}^"TҟFQ=ьBT q._6 i!~~E՟#~vmeQ˷[D,/`B 9gLtʷ [L; v̈́&t *!άTB~"ѿ=S2nGL7 m);ӤVrvY'> 5*Y5V#vX"WQ${LhF~Þ|d뻿e&P; LJ#Ttg< Q@.n5)dm[,&-{S;]\2|p $1/P'#{~, `3.mj2KCzo 7z6;+(b[IpbX8\!bD i E̖v&|xRtUPŽyX ,;" 臂c)CS(ȓk"zիb1*Q8ǡ=ϫ QR+_y%j\în޼zۺy Rr<"[IO.EoRWr~HC07tӚI%eHIpًKӑ`'>/))jD;߻OZ|i'EBDJݝ+-{,LE u lcPW$XN߃c=S'`;NB[ ר * _.: mD½ubmT!s: <&cjw1elhDD+.Z~3Z̛N@ [U7mWռzﻳ e5B ] 8dLj ڧzj}w6HOi=kab ˅* s6d[Dg~e69 .KXc# 6@T|!裏|>1ݜߊeș"mx+8kߢvI# C35;cl3Bh^vez&ݜƗ&pX4]+l:sZh744#M:+%0Y$RZʨ@|!`ʝ̫WfSkMT~rƏpЫPi-/?U #Yͥ"ݥpf6]ZV?1B{ƦTSQh:Z KK-$"Hpk~ENzΰLkܴ{ 3-te U*KGmn< M=:0lnSK+-x-LfY1D7z *0lkjy6wu>HKMoLZj,v"+?0^TP{{@T:۳%geP'Vly 1-V%ߖ2RXijؾ|\AɢrؕKЭ~҉WqU/:B(yfY|a%9'k&)[0<@O I(+?fmL2$9)5ћ±Sq㶘(Ծ뮻J));_1ie;d[oRgĢ?s_8ά K.W|!]0-Ubd ړZX/|/YlH`X"vr~-Lw*fKp+=MuȚWFOȃBd6U5:*^JlxMVR'2(.HFw0uSFay:nЉe2:W: PmDzDy>(}l\ D)Պal%ЋݪD 6_LRB1+#<*XP\F읮LTt-B`y]TЭ]ڼp\A&ήnJ&GxY*ѐ;f_ l۴iSiτ@S'8KEəMln(3 R8 tѤ pq^{-o^Hqk,EUz(`ggF(C:D̵&љF"v,Νr[Tېɦ&OX2e)A- )}R Uӭ` &3DzٹѦ9 :"#BE *F::J:CƿaKl)$잘Nv^C4i]F8DHsɺJeb'+ḚkW&m@&_bc`L+S( KT FtnK]I^D)N^YV[%IyIHB(6AeH Saa*bI@Pf4v]9!cB|V)k˼D<l~&TS _Hs& n> Plp$Dl9Ӫ߬|Mf$k?UQ c?Wm6)y_rp;?[SwLJ?祃ʝLt8KZ;COhӟ G|NO#wjKF$TtDtbgSFCPEQ M=|xGI^^i@5L/>'Pe:hR_z`X`37_Τw4yWrT|L*hdKE"Qev^M)h l>Y67n\/M5x?O` 2HT3&=oΕkG7j.k(0", gd$Cerde4s4ǀ2/Rkz,`X8ƱNnv A0.}zWFb̬L&*q(OU*Bh0Vbvv<"_BFv6OC)H 2$oaH`mjb[%KJdl#NEyT]F f1pqʣ!_vv忈T! [[/-fMh_V;XBVVy@_S%sSΖ Ά Rh'sj ib > stream xX͎EFi!AC$$B"#fw]`;npExnx陮1(Pyꯪk!;%$+g7#g徑Q(?g7.ɤ_DT"%i^pᠻ,ϛڻ 譋b);q=k2^ Bbi$$֐yo+&A U )BYK_h:&%~HOFzߞ=)m|}n\ 't4 B|*9?-$(X_`]txV1N9aJ}@k,|/afčTH[D<$e6qݺ׬x[SC6jV'biV'yg`wq~}vrXh}kjmE]1dyrNyE}a*q..Ro8,R~@MFmh{;'uy{*$ڔM^*ژDypTk8vFi|Y76wG xWSֺzw%)Ңj* ]'4J8{d֝!dMZDUoU{yMIh)GEET#-%pG쏲 CM9 ^sI e@fY\0<= 꽚0ddo\ޓ|o2˅;s$s9qqKk@rˀ8\2eBk@2 j*,;U*wVqqلEWɵKjx'2\fqg5GmmrN-of ؉^3aRg#\[bݜSg۪gJ~KឣV:IwRǬ䙍 T/JUD¤qRaRM`R#¤JFJ mB*m&U&5"U;_U4 6V{Oy? qLo OI »jf"N ۇJUY* H {TE{NUW?EHJDC =cl.Yps[>p-6};gSV/H:Թ_ ̈콑 qerɄY_h|Kلۻ?IRJz6)F%ɖ8&̜CGBwf`WqJz!(,EA.4} 63~endstream endobj 328 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /Subtype /Image /Width 150 /Length 2379 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?6{͇`c > i0P<@ 8Hf{ 4a@8#H40{ 9ON/#HRDz eZKi^֚O'8Dǎ,?Qvҷڀ-*KWr{ }#i4)9 d'؞¦rGsKR8Ps' {R3|߇(aeR3 XVGv1WQQҟl_Ҁ,>X{QHd_,~uPtSۥ2 (i)[%f^ʩK]?Re,;|Ma9N J44#Ԅ|R1n(PN݅In8v`<ס 6|_AE<^Ҋn{tPEP%+u U)~R@ 4Pz(E NP1?JBwNQ!^ !)h׵4/>l^GzPc?t>Ҋ[oj:(cun{/*/WT%XhOҖPz( ("$4 8'TÃڝl: cR<׭:TaG?/QmhI?G@3~TGV _oj*0?*Ӽ/j4O6AR:SyO֚>{z-Qz S~ͣQz S~SҌJS~S<sM1O7> /Filter /FlateDecode /Height 150 /Subtype /Image /Width 150 /Length 684 >> stream x훉 D?z6@@hNWj5xadA#p9F©XmJJ<)Vֶ{[MH{4,f4,{o?dƗa!xaXa!xaXa!xaXa!xaXa!xXsbTDY k_U 2i'~Trǰ5Grn%f VXbYMhc58C`:o @Ɇ3eI>[Wbhͭ<Vb7NV]#Vpʳ+V`zܚZd\ ^2 ֲ0v>OV4 b8?ZN|PM7{R}훋Uoӱ|goVC +!j.l^NTN,t+QR~7 l kce/VoK\ҍVZ-J$kͅmU{ CVv3^vȰi^ = V2zXeX[/;}C>3BYs+0PUBDA X%X e%:hk%rFJVbD"Rϭڸ kS{R!2,Efp,hXXCX#6Ua!2,Dendstream endobj 330 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 150 /SMask 329 0 R /Subtype /Image /Width 150 /Length 2914 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?,{ۯߑ0^ÅĒX\^tgHUN+zqj}GnɌVsY^-Bio0[ts8tWap :SK$[h42?6#f{ +d1m!ެ$X3p06 ]"6as 6v$wǦj 7w8PGEOձX;;hڶh((((((Ǘ dx})2o>)’POM(rmV/\m[TQEQEQEQEQEQE2:mj#@ iAI@m?Vb;E?յ@Q@Q@Q@Q@Q@Q@9?I>ƶh oEtoȯ4+ϟE(M|+_kj5VCeټHq= y S}\ |K5ͤSܗ2"(@3!vs\`lvZ| FGV] r3=JȠb2}g? I|Ed v"ZfitY c6NR RM#Y9 Ҁ=bKhF= CgFHuǧnqFA+:[dW,OF|q{ooe]>PlrĞptS!m#oY7(;((((<]# @ZkF{>s$6Fp~Q 9xuVR(=*Μd[%$]s9OZ_ɩ3?d&NѸs{<gIsKsک<t}!u(kt^s̤$4?u']Gr2E+Ɇ 8c?ӘY'` 0 L25gM6 8=[dE$50;p?O<~&S,9ޮv 3i/58yZWHsݎyc=hZQ=S bD 1r3 [_pE--pș3`{緯b nP* ((((ſ0]?F9ohAhQNCPqz1l|.1nӵ1ylOxR`av\ (G\r^0?@MuzVfe%Nz}q֮z+}ݬٌ#NqO,7DεwpYwa0:c[ٴMrSt<64TE 0QN ( ( ( wſ0]? zCE袊n9PiZ{KTfDY =F9t*pdʞ(H8}^ J̷9&@W'n„r1s4 _[u7 c+8?_SWEб1eQtꗅzae/**bO^((((((z/Oʧ"MyeQ@Q@{{HzPeB<6"m~ǵ^y'V d^կ?!Pݷmi#o@і^NzgN:QKuٻ19;8-8((((##daR2Q@t+dk~W*O'N _GN>®Q@=Fl-ϟEOmc|*b ?Xmѻ l#=~)i"vlUA֭n[˅7nlS@ UQn;BEX;h&܋![v0(J(((((((( ^ğMMP(endstream endobj 331 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceGray /DecodeParms << /Columns 100 /Predictor 15 >> /Filter /FlateDecode /Height 1 /Subtype /Image /Width 100 /Length 18 >> stream xcπ0b$dendstream endobj 332 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /DecodeParms << /Colors 3 /Columns 100 /Predictor 15 >> /Filter /FlateDecode /Height 1 /SMask 331 0 R /Subtype /Image /Width 100 /Length 27 >> stream xccbbb\ > stream x$ pK.nOA>Ҏ|4ZIv,v5c0Lɪb?>W'7?x{~xhσd?6jgV6[ )&?ݘO)36e|Zk`vu/'=xѸshe8\ @;m W8;!;7}UD4 6:!\ ޅH.0z@1iEb+DjckPh<$)Qb2Kh䇰cf0nC/["G1+|@Zim \1@V# QLЍ`J|:ȊrJ6eA>B0CB! Ç}&41GL!WW %XM/ҏdž}P)dmj^<`8\^'v R0͋9|&[T}+}!傉뇑Il3؅I.3RY  1H^WM#;zJND%Z$/V6H' A1ܖ.[b{ +Na{"kyy$1?ZVG`O4UX!55N'_J^?7SYi s*"\J 8E14e3&䚲6ّZf G\l ?]r^ tEi)\ROᛑsK_̄Z!L'25bx*Dc%ChL(̓ȅdYd2̦UkoLag'SSX ~pa(.}܀ i< ռH`d3 󺱔(!8LߤqQ,!j77x!8VSr)%e?uu=bQ7l>mJ]7-3U&s{ڷfOaTT _YTIp6GlTDnSV8\;}.SCTC\=X(r=0+2dcU+2Y۔Ȳvs"YKP#xS7-$3`.+ 'u1 ʄk + =>t_{+v﮽9h8vO$cl9kb+]} Ju}LHٲ>טs33 f7%m#LAejߨz1M96T5~} r# `o7{qTt[uOxY^n=QZ1@1V,mE:Jy|,Br2X Y.z3OGm564{ƍmfNRc)51s]O{brTu,9eMĘvkM '` yl%/X"c=ЌJo(Ktui=3 ɥxQ'f4AјE3@HN8$W=m>Yx<%Yhc0V LU+':Sq`.6byKʢ.т?AwnJt/'|qoYb ?b7a5h_'J5Q? uj+ȼYKg/,٘Z08h,+b֕`(,[gn֌/9B@y_7y0_m45h7I%p19 A-ck#.3oX󖂅j^W4恭7T%7@͌[|,7]i~ǣ6 "=DQ(eQIκpKzCX"Vy0("b3=t#&?)Wc@LO]^|TI7ƻ|g!bG+N/z ^{s+bao=g0yYM꯹ 61vyPy' sYLz}u:ޕF.7ayoo$p$\eML^HV+.3$: DOwkXa^ dײ^[7i$g_UGb(⤎m沥k ů; !4&سWΝo\$d 7oi+bLvQ'& oj'vX ("nB"i̟w{qF0N$[.?r]x쯰T^ܛwZܵ$Yn6? $Cl[Mζ:?챛endstream endobj 334 0 obj << /Filter /FlateDecode /Length 1078 >> stream xVn$5F> F.eC6?$Z$;h dd2DgXnpq}((rsF4{Ηbz\l q+*|)wf٣I gE I :9/gK67 VSB]W1R@O겙9M c!u`\ u>Z461+Dr^P}R`k͖3!1.xh w#7'<$mr ҒC\_ʗFJ iZ{%9:r2]qnɂ:%>S\_K|^lPLK>@#_Iӝgt-OLחWZfS"eH8ܕ?㏾vo/|ŇCy .ڲ(mZ GߢIw A9*H XczrQK=A% h#n1pKFMP&JYL,&)Pٔm OJ7]/>ܐS+K{=P'r:Eey%\& O1,fa< &sQ ؅{W؍xԎYF0Y:G.DHۣw1Ls1Uis%9y\']mdX8zgeZ3X>Y+iNVPze3 {P2m[ YИ,&'DYF&nRlZ[~=HF56H?HzAΩ(rGնN3[V?[> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK" }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?=*[V(@RhJ`Jƀ#͇MBaqNTWMsߗG5Vr.n!>~UUuk>T_]ӯp;' _gUs}z׳oSj'8ʳ#nzՐu jlN4EPf fO>S =H͛֒Jz=EX udo;@6_oSeVϢ(3Sp3T fEPN]qߐA1%y>?endstream endobj 336 0 obj << /Filter /FlateDecode /Length 6700 >> stream x\Ys7~W̏`a:Bln@_H[0El![ HZx7!A(y~Y<`?ӫG?sxp蟏z9:zx|NcRUuApa;8z4::tz4e5up\<FSSc ;8\cgRzXc#8qtޛg_T1/kviKv;=*8k<)Aէkf3<p9 I'{⭿RT $d1ko b* fIFD<,>Q  =$ CYĉLJ7"pW^קVHAF'vVua>Jۆ}v{_\{$uد&Ea¶gd}}B~dyo=ʠ9\ L@'C=n` u"aA]M/I!|x7HHx (?ɑ|ɓJB) 3 3aaqfbr j4KL3rYIoֽZbV)6@F9{[ WfĽ ⾈[)Z4me >L7@8A$%^%̙THOS&e""oqNg("eV(\Vіy2If ?_|.xt@ CccYMkXHx^4$po$I#u/esb4=WY%,^?!,YQ9 h[^/FǗ&w*be(?~UX$ .BLrYWBSΏ3:ĒhvY : 6C2Kztw(mow1Re \{s:דm;:q/-u;`'Rt[n{C &)e"Bg&E0~yu#Oײ\eT|[b-+Ii:lEc%opUޝ1s&ԛb~ R}FKI#81(m~?/ XȁjY}Ě?:eә,qlamT''_IR%!*k rP6\Oktt"ܐ)ynj|.|0@EӲS,҅V\ *ȳrgRoNV 50KVYA,l pZ{@"blv_$IXBe_}C~d kciG~L@DR-fa xAIe{L=C7M鸒 վ>d GB)NfG9ShHsXjD tX/v{1!LK&skq3<82H!M >c"X<* WJfC`s@]XK90ѼsZ D;}biJa Ls#K#*E^&}&4  )U0.[[I:YיUR@{pD+$-UTtcxVրb t}j k^؃"P1ҿ֯-?˜ihv|Īr~M>H0\+gB )%[$e9Č'Vv[u,+`U``k`MT T˯+g&H"vƪ~!Da%%B5A9$V;pΣ_Dn: 4u|HN)pp<)Ԇn Lj}UF(- 9/ikZ=2M{qa. kp*hU(#=%VzUEpUsbU.&E,9/~HKדEՈ-^QAƨ3?Ĩjδ^m.tfjp[jXh:'zD"g$TM8:DY9<yᒎgAw af& jy w Z Dt4D;M/YhqDž%X~ѷ0VKjmo!a6A.$\K., m~;Q{K'9XPi[#70X<z/BI_'JDshxc y %Q1 2; @)>]IT{ҕsB<sʀfei`ϲSdjCM@;Kem"?8څj[LyVa[<W>,:1e?祙 IS7XǘRMhC&fZfz ` 2${6-L6 &L)`$Z(!.Sd[N6#h­,=2+ c=pyHAY c8-_mLj0QBBg }Z(L5}YmgAfp:JH)LGD0{G2{ɍM`%:d +,Fl2QJ.KA[]}tG"h, !80L[= 0E̊k&+okUĵ^:)KNOc5`v>ɒ&)'mVE,c_v9Vf,|'uO%{IU?b3/"9#*6Ux7ՃƐ]/ynN{m|yOl86ZG >I-T̓KoO qnbJ u (ښ`"m&%!w): i,7^(e{f*"<.TOӦ~%;cB)WY\Cq@j'*t6쒖PC|Ԝ'ƻbk31+|㳩k8H>e>Nwz) XL`Ӄ"2a[{44tI)>! 4M= 5糥By<{*99^h뙏,RӶ"prjvq²)E,%6I"N;:VMѤL@tijK圣AA9ٶU?{%@.|4n\W ^AN P)t{\Ae_HRzgD55eyoZůsgT: >@s/" 4EHm4WXwYZ$cvᐅAogm %O؄@X˺kٷrfiҌͱxs+^Ѽ-lˮc|+ y۹ri;T&ձ\$"qt[c4V%Ctm;rԅ+EĄ-!`2ں=@^b> F&w8`n&.mvb9*Fyb`ِN%c~;y3\S|4IsAEG|@)_05(7eE>{EL_P2? QF#*aMB{`TF+1x>*iU~JZ,tel()Nb6KH4_ԨU€U*l? Odq/~pAݕ!qN%eUd"kD,^(9m|$3XK<lj)<ȧ/FҮJr AĎTk1*L<3N ?Qiu2cyPENħr[)ECw2<W4"ƢJȳ6YWa+hC}czH/$8ON]pٔmeCj=*GJoӡ$Of3DI/!c-mtó0#B7pcAz۳__+ݗ;"Tn݌!H\cmrEq Uɺ\3$"})O^0r庰4Rvs2 a 4Z҄ʵb V!T㵑+ ԏ"#&hl!%ύ 3yR@ !qF_Ԑ*/#pg!0V>w2X1M6?J]4{_s]H4js3Tllߛڼȑ!tg%1_YN4EUmBZʨu?8B]_($+aVYe{"QUץi H̑l2sN5dx&X6O9+nshǛ5ࣧa rETx8ѧ'b8xbUS__98lZW$9u/]lyJ;i&3y_yŢ)'X:]4 U=+.N{UU-AANd9?):|Q0סּεAųYOPEB_,E]G1 k<.}}USͫINU$؊W-c_QJ˥O KnC?Ngk(7|-endstream endobj 337 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2309 >> stream xkpW 訵UHJ54ܜ`ll,$ٲd˲dIlb{tdIeK$-۸1 IҦI&$Hچo=LdӤәؙݙf9g9X۱o{uKzo85s1rRNN-ş?=sږ>MFM}Eo$7? ǙEBҨ5@ sdΠj`%LkhN_wk G*ݐ\=(c4BCXVhqx/xcRU7zr'sZMИ)uz:&Ztά{åFyYb~,^qe%3δ%F)dߍKY\(sIޜ<&S'Bx[^Eo[~~Qq5%d*Ӊ󗏌l?q EL#}(-|=sRHb㣑+9C[h&dD8S! Ǡ8τ~ԫ;%)$11CeNG\_Y^ۯ}#PeYS-ЏkoԒ;y樧xTVDcuYՁ\mm.fЪ3X2^^CsFd .U7 u lhW\jʀPlɯ#UKYZR_x~SZϱdKv|*o1La7owWwV]'Ԓ; _Sqq",9$3SgtVRLJ/H3{u}un CK[+ > F&%tn`jۄ/OCΤ]GS݉=.=EDә tzl]lae !~l!a p4xur-Wںaz'N JlE4RYlk3gώ}98aVrZ}$&; {5fb۳+òc(g}*-q`:mz5v4ZbY2) v@KD.SV+v kʡ%d& 9*D\lcՏ Kh%ߺQ x|͸g%A}}s!v`lBy_CI"AWheŬh!3'$ O}؞]= IwopohzhüQ^ljPxu;;"zn\̰˼*`gVd5uR/Gcggn0kϵd<i%nv'$}#¡UgSU+ ODMH쯣I\"m#!bVeR,]d5d-utD\[B0U!Mx\en08]+E5I2:vvS蝛o1?EH7OKc?gyendstream endobj 338 0 obj << /Filter /FlateDecode /Length 7140 >> stream x]Is7+#}ӉpDhcVKJEѢX2e[*,3>Da}6qP{#/[wfָw|[ޗ#X21çjOE7$o C2nŭ_W?jd?!V: ~gͥ^m֥}7FCﰺ.P}A:&EfJm q|S'z -v)w~'K#L=U#LpbΓ:uwJIi/k}Ǩh9{Xїհz|J%M{ؒ6TIȕEz2mYWb+S.h.Pܿa(zPɷa'DruZ>1`ĚYNYk$>C Yoٯb4qgci}:jߎHV+384I+Jqu5,k!œwOhX7͟,ܣAb\5PB&MXqlIX\\y-r%vxגI!?&9} SMGdy]ooY)P) C.i#qI&0{ټ4*ʮCq?3?^; o\ë'nŎ焦R~PSĐ2 ~:a$Ԍ[Ik~ @QIMGAGRzk>$bl3H.ѰFD-4"K&%F=ߏ Š g~x25% Wڟ:GL*V pxE3;g^Z] potɹ [O];諌X~J9L-nSg7WnHS3nRG:ĝO=B&Q^@Z= -,F>@^R0 P"U@C])Hp$֐x/+.jm3>,(T `=8(hSp> e)7zT)蔈d @Ҧ +cqd 9&QYiw)aq ,tP!}KU:xD Fjlw$$09klYuv5+BK: [ O+̅8ёqT:;OwJCނq4`j 2@$B IS.)l cO앂ZXvWa[bi"Co߮+bPF][9" IZ0J}=!aHG?( D$+nbr4huhHtzЙ%$/f:@=|^=b^7>eZ=Fe3:ɛBV@lrqڜH܉7o`d]D.ظӮ•k\بr@z rV`+p&2[ A:Ogq{9 ;}3bxXGr" ձw X9"<3X%V.b?!XMѭ+ (LxÆw ۳ݚz|@ T|E}ke/`eb`21%xSY1J*ŰDHX&܎$) *C{Al/xXkP,o a:Ry>4gQڙh5PcF+Վtt2nhD[qg;aX}uS%TPL NV2 W[X=Zj{bo J>_<'=yq|YsQ=Dw6gwj~mTUcmy6B8g\*6jqmm;;qm~^b )v8]k6=qWtԟoנڷ2D}>XSp8BƂ=kE#b'FagPQ)M@u @Pp֭.kPBޟ)N(B`Q$JIګ jY#ok &4E?qDTM6t06k|S6lߓ>@9:e#kډblۏP~OSs`&yjGn+2;Qo6`7u#E{0P}D7#SGO =y2 BP *a L5Ыt82S-:.ͭ0ۊsmBT +|R[1L;`a$U 8*f*.7 1N-ZT1X} x*%-@"Y뒍 n͞*p_IuxE%˻t} g}\bQT}]ph IƝ`P0ˀ0t#7^0]gwr@[09X8hv|swvGFvev!Rpr͂7_LlwF}r}.HH$M@]Nn`mĻp&Y+mEΙ=v{e"NNk W3('bgLuB_Ӎq⎋ SE}A少z1Ix9&T0F(E"a!i `'6(+~M;!ۨP}w9 idcyE^fn*8O6{kvFL!kW9skQ4({i*{ xLX\)iPK ?acA}Ep_CmVof|ԵfXC>@) ښ(dι$Ғ\κ#p^^hvYuj 1ж;`ƕ̴U"}{t*Z#7>q^H @_gz^TuOie]Oo!8Pc7ST $:{  U G/ |LtRDʀ"Bv}]7ZM a #~F?Mr\bUhv9Bh4h=~7'%fyɒ@\El=Pb\1bO+,  X08Z "-)NFLhAX `'ܩM-:^"!:|DDX6/>ZUO}SCu6LY}9]6sLYy"d;rGT+SKuZXx܌KS|rU M(:E}o9Vo8N` Rn&jmr/Us_v:W ӘGr%Fd]$7Ѥ!`1D,ݺx,C ʏ@@L`T(guvL\<^1t/[*k>9 ;',h!E4.\_)ay$Oe(lVl* ݜ0jNoT_k5q@9RvZJ9xY# b!4űJuIW1K\;m/>ΗCsqg41!-FņQw|JUeM):̛k1Fҏ22W)Lke]&HK;gN(^b. E )؎m% Ƈ3%n#N`q7-‡jZFɒ]q9 I 9O T7j:*UqJޫb.he}J6gFoFA yu?3.$)4UIIJ aY&8oP3Ӧ53nf&V/$CNιMq*`l]ˋ=mZ %8%[%0xt[ XJoKQ.]ѝqT(GJV x=2JXQf8FcGm2d ;c|vE*#(a-b: =XĠZOWR͗Em~>ۼSk6!(`S9Mi E;L/gd6ESDRjqm0;6E`Wa3;֔vZkYx=MQwԧ L5ώ2XRaLZ^a(nIuRP6 5g>$˯%<&V@,`cj|,odPXpâkJ\j[fXj.]BҘko_(UGt޵ke?gy0FzQ& ,Mv紡ˉCd]< B2AU;)-Pw*G-±Vv r8ڰxy~ /X{u6Ӓs.c҃MhW< *i[,hqXjV<S)PF|MLlzդǔ ~LZikUs7hFB1hSS]@WG ݉L򻙳IJE~\$讀n'-ʖ2o"MbOXYlrg ;OaˮOAa4v?ASendstream endobj 339 0 obj << /Filter /FlateDecode /Length 5230 >> stream x\[oGr~g D^2'}Z^+ZXy8&#IKoO]zPm!X,?xzOoiG0#>O~>[tٴ:LMyz{:P}*c RQ'keC.p9FmV^#v N1'ns?tJOƧ>;]0U!t'R+G\ovN`} pJ)H. ](D2I9[eXc 0 >ְ׽O9+Z'Mqt_?R& Ai^wCی6EqhFw%p uGZ/{t#nswHgr2Ћ +zeB7-O WsR5`8唇'qe"][:;=T{fлн"wpg^C u%/(3 U Ƀ=mi1l5*7/Aj1忣Nw+t"9y ƌP ]'\6@F-Cj|SHV4\W_agEmQٔs{T; WHTĝwmsF xЏ/sM3J*Ýn{.ex؄;ӮEȣ9@l.PCa!|s?/S.zigB7lY:&WtփZoAw?ӤwʖmzmK]V_>ݟߺ'a[R@au|D`l)tOQ{)FMrJDS҇lmt{oٱ#Cx+D%ృ3-nLz- š퀩Dwp ndAF66tL^k7qp2 g ,%^(] uHw .y4 B^ y %_@h",*LV8Q ~pF[8^CZ88͌p̦Ί.YNw^)!g&Y#O?y u*/*_-%)6~/śoYv:2D{QgZ5 I9ӊ6c ( 'BQxLP#_;W|V!X-h- 5 Y>7QkaC<~[MRsE7%8](v&tHmJNڹj8"ӬVmΓO)@ lePOUGKW’}[X욶AJ ]yz]WΦvPn+-a+1:4.u7a%w1#a!&)N!¨T K@X]Dq`bxctߕB_-Es!Tc0l/x, _$IDG;+nlw6vWn;ŒrD`_L(8"a~;'EPe8tmA\[_mx@}v.a;S@| r  ɣJ%U#+HZi&?D=C#LX@CPށɁ{OI#8hgt*47"h fqi]yGf5aqudoI\\9!zp46prri&z*E{uc{BT7$gw0Xmrv/y "Xo"E#ZkaeDN[IQLg6CF7j| (µ]: o!<)Ģ%%nY @zk 5bdW+N -]_?Iˑ-#zq{&%q٫9{" D9}тv R߲28$ 3IZD3 S0IJmSuSELcQ-!`uaAd)~'֗S 87fAV}cjOwN1a"ʌ`MoerEw -2vyKUQ$x EN-ا&~AY&rSHJ*`nDr)Ɔ$^024VpǖSJDcdv $ 򸞅y4]ޏHf9eۄXDl| m@cSp 1DJ0\T7BIL=| H;4oX+6{;,0Pts\/y5 $)l46er> G 3}`˙iBL5GD8 m[oޔ~S*-DOc4Â!dBLu'8CF{_@N!BS\Ow acŏWvu>×uxXa?;3Nu:|SdzgWnf7$dXϾ drc :\ᅸqCwW@d~ 'nP ?q Ò sd}^X}ďjRن;IS\"4kV5zK +=$^<զg @ok")@ t\I}XzZeQ uZ/¢V"Smr+h1rWMci( `'wVu|\緻`1S 4}+۷Ek9:@_P vqV6-FiB{釧ڃn3ܘx[n0;uz\8*.[&6gv#KF; ϡ3 &ߖQld`CN U e6At/E 4` +O=r9@ %4v `A[0+}dQ]<gQ씜Sp PB7[60< mr7%ՃY蕵to qhk#7←Xbvb$;V|OvaBLnPw&RC90@La\T}HпdJQ_O!qU BYSFw pXx(Mېt"$F&0B$o5Z/86C[nL F; ^td׾:jvMb$ͬ%eY"6 r{м Nji_dWrY6 fPjd(%o+qc3=jhOpbrS #@HYL"#&]|_#*n܉>6$@y0 t#~P?&dW߇  XC]3xL? PXgHI/px֘Ub(‚lb#CZ[* Cc? „Kb#WD)y& 5e*iy'_hc2Cʆ6I[ AnT+iH(fwC/)C_e";x]YlyD({;BRiOK& I 6 OK NRo)"m?R˕Q(.}i -b ?" "LWY(#({K%Դ;=s  mBy$>cm (;h;fݤ,tb޲|;$uVG`^͠~=2@ _a&(wU?^V++F"-\h) nx\ʝj3xݾ!ܧN ?>~Bj$E<s44s啶Ԇ]I3PskxoLx\2Yw0|wo?(8[˕]t-M‡~gh~F45bm\0}5)Í4*Km A 4 ^{[(F|vOsRP?Dmr\IzYA"EgǝUBG|qOFȭe#~B!.*Ά:ע=ܓ$;=J''q\~SXi^,n˄ /8QVl6?o~viUBIZ3N_jי^m9C`!J#'g\kB*61 vay)o[gjT4|!az=7+_xW٧uxVocvVo#q^7u(Dщo =o^&fmNqfukЕٹK0ן?+zֳOVU/&Yendstream endobj 340 0 obj << /Filter /FlateDecode /Length 1107 >> stream xVMo7S-S6@Ѧ*r0zP;RmɉdշwHmp37^rӜ}o}|ldM|NJ7yle=:z{ԶoSK `źA1NށfWbq֍e7Z?.Ӟ|h2|W ,zh :KTF7Jk׃ԬFh43cd;Ӷ+o' QTGB‹N#%xGxx3`ƪA_6oOhpFCڈQ8"FʍFΈTDowZj6Bc:w@UmC;2R-v:kj.7-~-EnO:?yG/Rꃔ ^2IRR+Bַԛ0M"!0З*A!mӵ*# W9FR|'[yHgLw̋<)\1nb͠/,ţ"Ey@z8L0_c1$$LIل]lNC7漋O'B,oދШ3Ƙ {d-IW#,VU*537'b^sWm1żq ts{D({PFs,rèNt=DI2C܏,DJ.hq9,esD +RZry8kg.q1&SSeYL\> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 342 /ID [<75e273a222b8e2cbfbe2362f15813fa2>] >> stream x=/Caǟ{Ini֭Җ!&D"f0 ^:y|"$`"Qwhz_N\-crX%!&ؙ^n(ݺx5D*wtte,7uY=18G+%; qTs"b,"VĪEz0.O 7Dm?_- Μd֡\Gf7I]Fb.n~W܂91F>|_e_~*y/;;otDgSl&7K^ᘜ-HM endstream endobj startxref 437485 %%EOF seriation/inst/doc/seriation.Rnw0000644000176200001440000024016713236107323016470 0ustar liggesusers\documentclass[nojss]{jss} \usepackage[english]{babel} %\documentclass[fleqn, a4paper]{article} %\usepackage{a4wide} %\usepackage[round,longnamesfirst]{natbib} %\usepackage{graphicx,keyval,thumbpdf,url} %\usepackage{hyperref} %\usepackage{Sweave} \SweaveOpts{strip.white=true} \AtBeginDocument{\setkeys{Gin}{width=0.6\textwidth}} \usepackage[utf8]{inputenc} %% end of declarations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \usepackage{amsmath} \usepackage{amsfonts} %\newcommand{\strong}[1]{{\normalfont\fontseries{b}\selectfont #1}} \newcommand{\class}[1]{\mbox{\textsf{#1}}} \newcommand{\func}[1]{\mbox{\texttt{#1()}}} %\newcommand{\code}[1]{\mbox{\texttt{#1}}} %\newcommand{\pkg}[1]{\strong{#1}} \newcommand{\samp}[1]{`\mbox{\texttt{#1}}'} %\newcommand{\proglang}[1]{\textsf{#1}} \newcommand{\set}[1]{\mathcal{#1}} \newcommand{\sQuote}[1]{`{#1}'} \newcommand{\dQuote}[1]{``{#1}''} \newcommand\R{{\mathbb{R}}} \DeclareMathOperator*{\argmin}{argmin} \DeclareMathOperator*{\argmax}{argmax} %% almost as usual \author{Michael Hahsler\\Southern Methodist University \And Kurt Hornik\\Wirtschaftsuniversit\"at Wien \AND Christian Buchta\\Wirtschaftsuniversit\"at Wien} \title{Getting Things in Order:\\ An Introduction to the \proglang{R}~Package~\pkg{seriation}} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Michael Hahsler, Kurt Hornik, Christian Buchta} %% comma-separated \Plaintitle{Getting Things in Order: An Introduction to the R Package seriation} %% without formatting \Shorttitle{Getting Things in Order} %% a short title (if necessary) %% an abstract and keywords \Abstract{Seriation, i.e., finding a suitable linear order for a set of objects given data and a loss or merit function, is a basic problem in data analysis. Caused by the problem's combinatorial nature, it is hard to solve for all but very small sets. Nevertheless, both exact solution methods and heuristics are available. In this paper we present the package~\pkg{seriation} which provides an infrastructure for seriation with \proglang{R}. The infrastructure comprises data structures to represent linear orders as permutation vectors, a wide array of seriation methods using a consistent interface, a method to calculate the value of various loss and merit functions, and several visualization techniques which build on seriation. To illustrate how easily the package can be applied for a variety of applications, a comprehensive collection of examples is presented.} \Keywords{combinatorial data analysis, seriation, permutation, \proglang{R}} \Plainkeywords{combinatorial data analysis, seriation, permutation, R} %% without formatting \Address{ Michael Hahsler\\ Engineering Management, Information, and Systems\\ Lyle School of Engineering\\ Southern Methodist University\\ P.O. Box 750123 \\ Dallas, TX 75275-0123\\ E-mail: \email{mhahsler@lyle.smu.edu}\\ URL: \url{http://lyle.smu.edu/~mhahsler} Kurt Hornik\\ Department f\"ur Statistik \& Mathematik\\ Wirtschaftsuniversit\"at Wien\\ 1090 Wien, Austria\\ E-mail: \email{kurt.hornik@wu.ac.at}\\ URL: \url{http://statmath.wu.ac.at/~hornik/} Christian Buchta\\ Department f\"ur Welthandel\\ Wirtschaftsuniversit\"at Wien\\ 1090 Wien, Austria\\ E-mail: \email{christian.buchta@wu.ac.at}\\ URL: \url{http://www.wu.ac.at/itf/institute/staff/buchta} } \hyphenation{Brusco} \sloppy %% \VignetteIndexEntry{An Introduction to the R package seriation} \begin{document} %\title{Getting Things in Order: An introduction to the %R~package~\pkg{seriation}} %\author{Michael Hahsler, Kurt Hornik and Christian Buchta} \maketitle %\abstract{Seriation, i.e., finding a suitable linear order for a set of % objects given data and a loss or merit function, is a basic problem in % data analysis. Caused by the problem's combinatorial nature, it is % hard to solve for all but very small sets. Nevertheless, both exact % solution methods and heuristics are available. In this paper we % present the package~\pkg{seriation} which provides an infrastructure % for seriation with \proglang{R}. The infrastructure comprises data % structures to represent linear orders as permutation vectors, a wide % array of seriation methods using a consistent interface, a method to % calculate the value of various loss and merit functions, and several % visualization techniques which build on seriation. To illustrate how % easily the package can be applied for a variety of applications, a % comprehensive collection of examples is presented.} % <>= options(scipen=3, digits=4) ### for sampling set.seed(1234) @ \section{Introduction} A basic problem in data analysis, called \emph{seriation} or sometimes \emph{sequencing}, is to arrange all objects in a set in a linear order given available data and some loss or merit function in order to reveal structural information. Together with cluster analysis and variable selection, seriation is an important problem in the field of \emph{combinatorial data analysis}~\citep{seriation:Arabie:1996}. Solving problems in combinatorial data analysis requires the solution of discrete optimization problems which, in the most general case, involves evaluating all feasible solutions. Due to the combinatorial nature, the number of possible solutions grows with problem size (number of objects, $n$) by the order~$O(n!)$. This makes a brute-force enumerative approach infeasible for all but very small problems. To solve larger problems (currently with up to 40 objects), partial enumeration methods can be used. For example, \cite{seriation:Hubert:2001} propose dynamic programming and \cite{seriation:Brusco:2005} use a branch-and-bound strategy. For even larger problems only heuristics can be employed. It has to be noted that seriation has a rich history in archeology. \cite{seriation:Petrie:1899} was the first to use seriation as a formal method. He applied it to find a chronological order for graves discovered in the Nile area given objects found there. He used a cross-tabulation of grave sites and objects and rearranged the table using row and column permutations till all large values were close to the diagonal. In the rearranged table graves with similar objects are closer to each other. Together with the assumption that different objects continuously come into and go out of fashion, the order of graves in the rearranged table suggests a chronological order. Initially, the rearrangement of rows and columns of this contingency table was done manually and the adequacy was only judged subjectively by the researcher. Later, \cite{seriation:Robinson:1951}, \cite{seriation:Kendall:1971} and others proposed measures of agreement between rows to quantify optimality of the resulting table. A comprehensive description of the development of seriation in archeology is presented by \cite{seriation:Ihm:2005}. Techniques related to seriation are also popular in several other fields. Especially in ecology scaling techniques are used under the name \emph{ordination}. For these applications several \proglang{R} packages already exist (e.g., \pkg{ade4}~\citep{seriation:Chessel:2007,seriation:Dray:2007} and \pkg{vegan}~\citep{seriation:Oksanen:2007}). This paper describes the new package \pkg{seriation} which differs from existing packages in the following ways: \begin{itemize} \item \pkg{seriation} provides a flexible infrastructure for seriation; \item \pkg{seriation} focuses on seriation as a combinatorial optimization problem. \end{itemize} This paper starts with a formal introduction of the seriation problem as a combinatorial optimization problem in Section~\ref{sec:seriation}. In Section~\ref{sec:methods} we give an overview of seriation methods. In Section~\ref{sec:infrastructure} we present the infrastructure provided by the package~\pkg{seriation}. Several examples and applications for seriation are given in Section~\ref{sec:example}. Section~\ref{sec:conclusion} concludes. A previous version of this manuscript was published in the \emph{Journal of Statistical Software} \citep{seriation:Hahsler+Hornik:2008}. \section{Seriation as a combinatorial optimization problem} \label{sec:seriation} To seriate a set of $n$ objects $\{O_1,\dots,O_n\}$ one typically starts with an $n \times n$ symmetric dissimilarity matrix~$\mathbf{D} = (d_{ij})$ where $d_{ij}$ for $1 \le i,j \le n$ represents the dissimilarity between objects $O_i$ and $O_j$, and $d_{ii} = 0$ for all~$i$. We define a permutation function $\Psi$ as a function which reorders the objects in $\mathbf{D}$ by simultaneously permuting rows and columns. The seriation problem is to find a permutation function $\Psi^*$ %$\{1,\dots,n\} \rightarrow \{1,\dots,n\}$, i.e. a %bijection that maps the set of indices of the objects (and equally of rows and %columns of $\mathbf{D}$) onto itself, which optimizes the value of a given loss function~$L$ or merit function~$M$. This results in the optimization problems \begin{equation} \Psi^* = \argmin_\Psi L(\Psi(\mathbf{D})) \quad \text{or} \quad \Psi^* = \argmax_\Psi M(\Psi(\mathbf{D})), \end{equation} respectively. %This is clearly a hard discrete optimization problem since the number of %possible permutations is $n!$ which makes an exhaustive %search for sets with a medium to large number of objects infeasible. %Partial enumeration methods and heuristics can be used. Such methods are %presented in Section~\ref{sec:methods}. %But first, we review commonly used loss functions in the following section. %\marginpar{two-mode data missing} A symmetric dissimilarity matrix is known as \emph{two-way one-mode} data since it has columns and rows (two-way) but only represents one set of objects (one-mode). Seriation is also possible for two-way two-mode data which are represented by a general nonnegative matrix. In such data columns and rows represent two sets of objects which are reordered simultaneously. For loss/merit functions for two-way two-mode data the optimal order of columns can depend of the order of rows and vice versa or it can be independent allowing for breaking the optimization down into two separate problems, one for the columns and one for the rows. Another way to deal with the seriation for two-way two-mode data is to calculate two dissimilarity matrices, one for each mode, and then solve two seriation problems for two-way one-mode data. Furthermore, seriation can be generalized to $k$-way $k$-mode data in the form of a $k$-dimensional array by defining suitable loss/merit functions for such data or by breaking the problem down into several lower dimensional independent problems. To assess the complexity of seriation of $k$-way $k$-mode data, let us assume the data is a $k$-dimensional array with the dimensions containing $n_1, n_2, \ldots, n_k$ objects. If the loss/merit function allows for separating the problem into $k$ independent problems, the problem size is just the sum of the individual problems. By using complete enumeration the size is $O(\sum_{i=1}^k{n_i!})$. If the problem is not separable and the optimal seriation of each dimension depends on the order of the objects of the other dimensions, the problem size is $O((\sum_{i=1}^k{n_i})!)$. For example for $k=5$ and all dimensions containing 5 objects, the search space for separable dimensions is only 600 while without separability it is larger than $10^{25}$ clearly too big to be solvable in reasonable time. This shows that for data with even only a few dimensions and a few objects each, finding the optimal solution is infeasible and loss/merit functions which allow for separating the problem are highly desirable. In the following subsections, we review some commonly employed loss/merit functions. Most functions are used for two-way one-mode data but the measure of effectiveness and stress can be also used for two-way two-mode data. For the implementation of various loss or merit measures see function~\func{criterion} in Section~\ref{sec:infrastructure}. %\section{Loss functions} %\label{sec:criteria} %In the literature several loss functions are suggested. %We review the most commonly used functions. \subsection{Column/row gradient measures} A symmetric dissimilarity matrix where the values in all rows and columns only increase when moving away from the main diagonal is called a perfect \emph{anti-Robinson matrix} after the statistician \cite{seriation:Robinson:1951}. Formally, an $n \times n$ dissimilarity matrix $\mathbf{D}$ is in anti-Robinson form if and only if the following two gradient conditions hold~\citep{seriation:Hubert:2001}: \begin{align} \text{within rows:} & \quad d_{ik} \le d_{ij} \quad \text{for} \quad 1 \le i < k < j \le n; \\ \text{within columns:} & \quad d_{kj} \le d_{ij} \quad \text{for} \quad 1 \le i < k < j \le n. \end{align} In an anti-Robinson matrix the smallest dissimilarity values appear close to the main diagonal, therefore, the closer objects are together in the order of the matrix, the higher their similarity. This provides a natural objective for seriation. It has to be noted that $\mathbf{D}$ can be brought into a perfect anti-Robinson form by row and column permutation whenever $\mathbf{D}$ is an ultrametric or $\mathbf{D}$ has an exact Euclidean representation in a single dimension~\citep{seriation:Hubert:2001}. However, for most data only an approximation to the anti-Robinson form is possible. A suitable merit measure which quantifies the divergence of a matrix from the anti-Robinson form was given by \cite{seriation:Hubert:2001} as \begin{equation} M(\mathbf{D}) = \sum_{i y. \end{cases} \end{equation} It results in the raw number of triples satisfying the gradient constraints minus triples which violate the constraints. The second function is defined as: \begin{equation} f(z,y) = |y-z|\mathrm{sign}(y-z) = y-z \end{equation} It weighs each satisfaction or violation by its magnitude given by the absolute difference between the values. \subsection{Anti-Robinson events} An even simpler loss function can be created in the same way as the gradient measures above by concentrating on violations only. \begin{equation} L(\mathbf{D}) = \sum_{i y \quad \text{and} \\ 0 \quad \text{otherwise.} \end{cases} \end{equation} $I(\cdot)$ is an indicator function returning $1$ only for violations. \cite{seriation:Chen:2002} presented a formulation for an equivalent loss function and called the violations \emph{anti-Robinson events}. \cite{seriation:Chen:2002} also introduced a weighted versions of the loss function resulting in \begin{equation} f(z, y) = |y-z|I(z, y) \end{equation} using the absolute deviations as weights. \subsection{Hamiltonian path length} The dissimilarity matrix $\mathbf{D}$ can be represented as a finite weighted graph $G = (\Omega,E)$ where the set of objects~$\Omega$ constitute the vertices and each edge~$e_{ij} \in E$ between the objects $O_i, O_j \in \Omega$ has a weight~$w_{ij}$ associated which represents the dissimilarity~$d_{ij}$. Such a graph can be used for seriation~\citep[see, e.g.,][]{seriation:Hubert:1974,seriation:Caraux:2005}. An order~$\Psi$ of the objects can be seen as a path through the graph where each node is visited exactly once, i.e., a Hamiltonian path. Minimizing the Hamiltonian path length results in a seriation optimal with respect to dissimilarities between neighboring objects. The loss function based on the Hamiltonian path length is: \begin{equation} L(\mathbf{D}) = \sum_{i=1}^{n-1} d_{i,i+1}. \end{equation} Note that the length of the Hamiltonian path is equal to the value of the \emph{minimal span loss function} \citep[as used by][]{seriation:Chen:2002}, and both notions are related to the \emph{traveling salesperson problem}~\citep{seriation:Gutin:2002}. \subsection{Inertia criterion} Another way to look at the seriation problem is not to focus on placing small dissimilarity values close to the diagonal, but to push large values away from it. A function to quantify this is the moment of inertia of dissimilarity values around the diagonal \citep{seriation:Caraux:2005} defined as \begin{equation} M(\mathbf{D}) = \sum_{i=1}^n \sum_{j=1}^n d_{ij}|i-j|^2. \end{equation} $|i-j|^2$ is used as a measure for the distance to the diagonal and $d_{ij}$ gives the weight. This is a merit function since the sum increases when higher dissimilarity values are placed farther away from the diagonal. \subsection{Least squares criterion} Another natural loss function for seriation is to quantify the deviations between the dissimilarities in $\mathbf{D}$ and the rank differences of the objects. Such deviations can be measured, e.g, by the sum of squares of deviations \citep{seriation:Caraux:2005} defined by \begin{equation} L(\mathbf{D}) = \sum_{i=1}^n \sum_{j=1}^n (d_{ij} - |i-j|)^2, \end{equation} where $|i-j|$ is the rank difference or gap between $O_i$ and $O_j$. The least squares criterion defined here is related to uni-dimensional scaling~\citep{seriation:Leeuw:2005}, where the objective is to place all $n$ objects on a straight line using a position vector~$\mathbf{z} = z_1,z_2,\ldots,z_n$ such that the dissimilarities in $\mathbf{D}$ are preserved by the relative positions in the best possible way. The optimization problem of uni-dimensional scaling is to find the position vector~$\mathbf{z^*}$ which minimizes $\sum_{i=1}^n \sum_{j=1}^n (d_{ij} - |z_i-z_j|)^2$. This is close to the seriation problem, but in addition to the ranking of the objects also takes the distances between objects on the resulting scale into account. Note that if Euclidean distance is used to calculate $\mathbf{D}$ from a data matrix~$\mathbf{X}$, using the order of the elements in $\mathbf{X}$ as they occur projected on the first principal component of $\mathbf{X}$ minimizes the loss function of uni-dimensional scaling (using squared distances). Using this order, also provides a good solution for the least square seriation criterion. \subsection{Linear Seriation Criterion} The Linear Seriation Criterion (Hubert and Schultz 1976) weights the distances with the absolute rank differences. $$L(\mathbf{D}) \sum_{i=1}^n \sum_{j=1}^n d_{ij} (-|i-j|)$$ \subsection{2-Sum Problem} The 2-Sum loss criterion \citep{seriation:Barnard:1993} multiplies the similarity between objects with the squared rank differences. $$L(\mathbf{D}) \sum_{i,j=1}^p \frac{1}{1+d_{ij}} (i-j)^2,$$ where $s_{ij} = \frac{1}{1+d_{ij}}$ represents the similarity between objects $i$ and $j$. \subsection{Measure of effectiveness} \label{sec:ME} \cite{seriation:McCormick:1972} defined the \emph{measure of effectiveness (ME)} for an $n \times m$ matrix~$\mathbf{X} = (x_{ij})$ as \begin{equation} M(\mathbf{X}) = \frac{1}{2} \sum_{i=1}^{n} \sum_{j=1}^{m} x_{ij}[x_{i,j+1}+x_{i,j-1}+ x_{i+1,j}+x_{i-1,j}] \label{equ:ME} \end{equation} with, by convention $x_{0,j}=x_{n+1,j}=x_{i,0}=x_{i,m+1}=0$. ME is maximized if each element is as closely related numerically to its four neighboring elements as possible. ME was developed for two-way two-mode data, however, ME can also be used for a symmetric matrix (one-mode data) and gets maximal only if all large values are grouped together around the main diagonal. Note that the definition in equation~(\ref{equ:ME}) can be rewritten as \begin{equation} M(\mathbf{X}) = \frac{1}{2} \sum_{i=1}^{n} \sum_{j=1}^{m} x_{ij}[x_{i,j+1}+x_{i,j-1}] + \sum_{i=1}^{n} \sum_{j=1}^{m} x_{ij}[x_{i+1,j}+x_{i-1,j}] \end{equation} showing that the contributions of column and row order to the merit function are independent. \subsection{Stress} \label{sec:stress} Stress measures the conciseness of the presentation of a matrix (two-mode data) and can be seen as a purity function which compares the values in a matrix with their neighbors. The stress measures used here are computed as the sum of squared distances of each matrix entry from its adjacent entries. \cite{seriation:Niermann:2005} defined for an $n \times m$ matrix~$\mathbf{X} = (x_{ij})$ two types of neighborhoods: \begin{itemize} \item The Moore neighborhood comprises the (at most) eight adjacent entries. The local stress measure for element~$x_{ij}$ is defined as \begin{equation} \sigma_{ij} = \sum_{k=\max(1,i-1)}^{\min(n,i+1)} \sum_{l=\max(1,j-1)}^{\min(m,j+1)} (x_{ij} - x_{kl})^2 \end{equation} \item The Neumann neighborhood comprises the (at most) four adjacent entries resulting in the local stress of $x_{ij}$ of \begin{equation} \sigma_{ij} = \sum_{k=\max(1,i-1)}^{\min(n,i+1)} (x_{ij} - x_{kj})^2 + \sum_{l=\max(1,j-1)}^{\min(m,j+1)} (x_{ij} - x_{il})^2 %(x_{ij} - x(i-1,j))^2 + (x_{ij} - x(i+1,j))^2 + %(x_{ij} - x(i,j-1))^2 + (x_{ij} - x(i,j+1))^2 \end{equation} \end{itemize} Both local stress measures can be used to construct a global measure for the whole matrix by summing over all entries which can be used as a loss function: \begin{equation} L(\mathbf{X}) = \sum_{i=1}^n \sum_{j=1}^m \sigma_{ij} \end{equation} The major difference between the Moore and the Neumann neighborhood is that for the later the contributions of row and column order to stress are independent. Stress can be also used as a loss function for symmetric proximity matrices (one-mode data). %, %since it can only be optimal, if large values are %concentrated around the main diagonal. Note also, that stress with Neumann neighborhood is related to the measure of effectiveness defined above (in Section~\ref{sec:ME}) since both measures are optimal if for each cell the cell and its four neighbors are numerically as similar as possible. \section{Seriation methods} \label{sec:methods} Solving the discrete optimization problem for seriation with most loss/merit functions is clearly very hard. The number of possible permutations for $n$ objects is $n!$ which makes an exhaustive search for sets with a medium to large number of objects infeasible. In this section, we describe some methods (partial enumeration, heuristics and other methods) which are typically used for seriation. For each method we state for which type of loss/merit functions it is suitable and whether it finds the optimum or is a heuristic. For the implementation of various seriation methods see function~\func{seriate} in Section~\ref{sec:infrastructure}. \subsection{Partial enumeration methods} Partial enumeration methods search for the exact solution of a combinatorial optimization problem. Exploiting properties of the search space, only a subset of the enormous number of possible combinations has to be evaluated. Popular partial enumeration methods which are used for seriation are \emph{dynamic programming}~\citep{seriation:Hubert:2001} and \emph{branch-and-bound}~\citep{seriation:Brusco:2005}. Dynamic programming recursively searches for the optimal solution checking and storing $2^n-1$ results. Although $2^n-1$ grows at a lower rate than $n!$ and is for $n \gg 3$ considerably smaller, the storage requirements of $2^n-1$ results still grow fast, limiting the maximal problem size severely. For example, for $n=30$ more than one billion results have to be calculated and stored, clearly a number too large for the main memory capacity of most current computers. Branch-and-bound has only very moderate storage requirements. The forward-branching procedure~\citep{seriation:Brusco:2005} starts to build partial permutations from left (first position) to right. At each step, it is checked if the permutation is valid and several fathoming tests are performed to check if the algorithm should continue with the partial permutation. The most important fathoming test is the boundary test, which checks if the partial permutation can possibly lead to a complete permutation with a better solution than the currently best one. In this way large parts of the search space can be omitted. However, in contrast to the dynamic programming approach, the reduction of search space is strongly data dependent and poorly structured data can lead to very poor performance. With branch-and-bound slightly larger problems can be solved than with dynamic programming in reasonable time. \cite{seriation:Brusco:2005} state that depending on the data, in some cases proximity matrices with 40 or more objects can be handled with current hardware. Partial enumeration methods can be used to find the exact solution independently of the loss/merit function. However, partial enumeration is limited to only relatively small problems. \subsection{Traveling salesperson problem solver} Seriation by minimizing the length of a Hamiltonian path through a graph is equal to solving a traveling salesperson problem. The traveling salesperson or salesman problem (TSP) is a well known and well researched combinatorial optimization problem~\citep[see, e.g.,][]{seriation:Gutin:2002}. The goal is to find the shortest tour that, starting from a given city, visits each city in a given list exactly once and then returns to the starting city. In graph theory a TSP tour is called a \emph{Hamiltonian cycle.} But for the seriation problem, we are looking for a Hamiltonian path. \cite{seriation:Garfinkel:1985} described a simple transformation of the TSP to find the shortest Hamiltonian path. An additional row and column of 0's is added (sometimes this is referred to as a \emph{dummy city}) to the original $n \times n$ dissimilarity matrix~$\mathbf{D}$. The solution of this $(n+1)$-city TSP, gives the shortest path where the city representing the added row/column cuts the cycle into a linear path. As the general seriation problem, solving the TSP is difficult. In the seriation case with $n+1$ cities, $n!$ tours have to be checked. However, despite this vast searching space, small instances can be solved efficiently using dynamic programming \citep{seriation:Held:1962} and larger instances of several hundred objects can be solved using \emph{branch-and-cut} algorithms~\citep{seriation:Padberg:1990}. For even larger instances or if running time is critical, a wide array of heuristics are available, ranging from simple nearest neighbor approaches to construct a tour~\citep{seriation:Rosenkrantz:1977} to complex heuristics like the Lin-Kernighan heuristic~\citep{seriation:Lin:1973}. A comprehensive overview of heuristics and exact methods can be found in \cite{seriation:Gutin:2002}. \subsection{Bond energy algorithm} The \emph{bond energy algorithm}~\citep[BEA;][]{seriation:McCormick:1972} is a simple heuristic to rearrange columns and rows of a matrix (two-way two-mode data) such that each entry is as closely numerically related to its four neighbors as possible. To achieve this, BEA tries to maximize the measure of effectiveness (ME) defined in Section~\ref{sec:ME}. For optimizing the ME, columns and rows can be treated separately since changing the order of rows does not influence the ME contributions of the columns and vice versa. BEA consists of the following three steps: \begin{enumerate} \item Place one randomly chosen column. \item Try to place each remaining column at each possible position left, right and between the already placed columns and calculate every time the increase in ME. Choose the column and position which gives the largest increase in ME and place the column. Repeat till all columns are placed. \item Repeat procedure with rows. \end{enumerate} This greedy algorithm works fast and only depends on the choice of the first column/row. This dependence can be reduced by repeating the procedure several times with different choices and returning the solution with the highest ME. Although \cite{seriation:McCormick:1972} use BEA also for non-binary data, \cite{seriation:Arabie:1990} argue that the measure of effectiveness only serves its intended purpose of finding an arrangement which is close to Robinson form for binary data and should therefore only be used for binary data. \cite{seriation:Lenstra:1974} notes that the optimization problem of BEA can be stated as two independent traveling salesperson problems (TSPs). For example, the row TSP for an $n \times m$ matrix~$\mathbf{X}$ consists of $n$ cities with an $n \times n$ distance matrix~$\mathbf{D}$ where the distances are \begin{displaymath} d_{ij} = -\sum_{k=1}^m x_{ik}x_{jk}. \end{displaymath} BEA is in fact a simple suboptimal TSP heuristic using this distances and instead of BEA any TSP solver can be used to obtain an order. With an exact TSP solver, the optimal solution can be found. \subsection{Hierarchical clustering} \label{sec:hierarchical_clustering} Hierarchical clustering produces a series of nested clusterings which can be visualized by a dendrogram, a tree where each internal node represents a split into subtrees and has a measure of similarity/dissimilarity attached to it. As a simple heuristic to find a linear order of objects, the order of the leaf nodes in a dendrogram structure can be used. This idea is used, e.g., by heat maps to reorder rows and columns with the aim to place more similar objects and variables closer together. %For hierarchical clustering several methods are available (e.g., %single linkage, average linkage, complete linkage, ward method) resulting in %different dendrograms. %However, The order of leaf nodes in a dendrogram is not unique. A binary (two-way splits only) dendrogram for $n$ objects has $2^{n-1}$ internal nodes and at each internal node the left and right subtree (or leaves) can be swapped resulting in $2^{n-1}$ distinct leaf orderings. To find a unique or optimal order, an additional criterion has to be defined. \cite{seriation:Gruvaeus:1972} suggest to obtain a unique order by requiring to order the leaf nodes such that at each level the objects at the edge of each cluster are adjacent to that object outside the cluster to which it is nearest. \cite{seriation:Bar-Joseph:2001} suggest to rearrange the dendrogram such that the Hamiltonian path connecting the leaves is minimized and called this the optimal leaf order. The authors also present a fast algorithm with time complexity $O(n^4)$ to solve this optimization problem. Note that this problem is related to the TSP described above, however, the given dendrogram structure significantly reduces the number of permissible permutations making the problem easier. Although hierarchical clustering solves an optimization problem different to the seriation problem discussed in this paper, hierarchical clustering still can produce useful orderings, e.g., for visualization. \subsection{Rank-two ellipse seriation} \cite{seriation:Chen:2002} proposes to generate a sequence of correlation matrices $R^1, R^2, \ldots$. $R^1$ is the correlation matrix of the original distance matrix $\mathbf{D}$ and \begin{equation} R^{n+1} = \phi R^n, \end{equation} where $\phi(\cdot)$ calculates a correlation matrix. \cite{seriation:Chen:2002} shows that the rank of the matrix $R^n$ falls with increasing $n$ and that if the sequence is continued till the first matrix in the sequence has a rank of 2, projecting all points in this matrix on its first two eigenvectors, all points will fall on an ellipse. \cite{seriation:Chen:2002} suggests to use the order of the points on this ellipse as a seriation where the ellipse can be cut at any of the two interception points (top or bottom) with the vertical axis. Although the rank-two ellipse seriation procedure does not try to solve a combinatorial optimization problem, it still provides for some cases a useful ordering. \subsection{Spectral Seriation} Spectral seriation uses a relaxation to minimize the 2-Sum Problem \citep{seriation:Barnard:1993}. Rewriting the minimization problem using a permutation vector $\pi$, its inverse, rescaling to $\mathrm{q}$ and using a Lagrangian multiplier for the constraint on the permutation yields \citep{seriation:Ding:2004} the following equivalent optimization problem: $$\mathrm{min}_\mathbf{q} \frac{\mathbf{q}^T L_\mathbf{S}\mathbf{q}}{\mathbf{q}^T\mathbf{q}}$$ where $L_\mathbf{S}$ is the Laplacian of $\mathbf{S}$. The optimal order can be recovered by the sorting order of the Fiedler vector (i.e., the second smallest eigenvector of the Laplacian of the similarity matrix). \subsection{Quadratic Assignment Problem} Both, the linear seriation criterion and the 2-Sum problem formulation can be written as a Quadratic Assignment Problem (QAP). However, the QAP is in general NP-hard. Methods include QIP, linearization, branch and bound and cutting planes as well as heuristics including Tabu search, simulated annealing, genetic algorithms, and ant systems \citep{seriation:Burkard:1998}. \section{The package infrastructure} \label{sec:infrastructure} The \pkg{seriation} package provides the data structures and some algorithms to efficiently handle seriation with \proglang{R}. As the input data for seriation \proglang{R} already provides \begin{itemize} \item for two-way one-mode data the class \code{dist}, \item for two-way two-mode data the class \code{matrix}, and \item for $k$-way $k$-mode data the class \code{array}. \end{itemize} \begin{figure}[tp] \centerline{ %\includegraphics[width=12cm]{infrastructure}} \includegraphics[width=10cm]{classes}} \caption{UML class diagram of the data structures for permutations provided by \pkg{seriation}} \label{fig:infrastructure} \end{figure} However, \proglang{R} provides no classes for representing permutation vectors. \pkg{seriation} adds the necessary data structure (using the S3 class system) as depicted in the UML class diagram \citep{seriation:Fowler:2004} in Figure~\ref{fig:infrastructure}. In this diagram classes are represented by rectangles and different symbols are used to state the type of relationship between the classes. The class \code{ser\_permutation} in Figure~\ref{fig:infrastructure} represents the permutation information for $k$-mode data (including the cases of $k=1$ and $k=2$). It consists of $k$ permutation vectors (class \code{ser\_permutation\_vector}). This relationship is represented by the solid diamond and the star above the connection between the two classes. Class \code{ser\_permutation\_vector} is defined \emph{abstract} and only its concrete implementations (classes connected with the triangle symbol) are used to store a permutation vector. This design with an abstract class was chosen to allow to use different representations for the permutation vectors. Currently, the permutation vector can be stored as a simple integer vector or as an object of class \code{hclust} (defined in package \pkg{stats}). \code{hclust} describes a hierarchical clustering tree (dendrogram) including an ordering for the tree's node leaves which provides a permutation for all objects (see Section~\ref{sec:hierarchical_clustering}). Class \code{ser\_permutation\_vector} has a constructor \func{ser\_permutation\_vector} which converts data into the correct concrete subclass of \code{ser\_permutation\_vector} and checks if it contains a proper permutation vector. For \code{ser\_permutation\_vector} the methods \func{print}, \func{length} for the length of the permutation vector, \func{get\_method} to get the method used to generate the permutation, and \func{get\_order} to access the raw (integer) permutation vector are available. To use an additional class to represent permutations as a concrete subclass of \code{ser\_permutation\_vector} only an appropriate accessor method \func{get\_order} has to be implemented for the new class. For \code{ser\_permutation} a constructor is provided which can bind $k$ \code{ser\_permutation\_vector} objects together into an object for $k$-mode data. \code{ser\_permutation} is implemented as a list of length~$k$ and each element contains a \code{ser\_permutation\_vector} object. Methods like \func{length}, accessing elements with \code{[[}, % ]] \code{[[<-}, % ]] subsetting with \code{[}, and combining with \func{c} work as expected. Also a \func{print} method is provided. Finally, direct access to the raw permutation vectors is available using \func{get\_order}. Here a second argument (which defaults to $1$) specifies the dimension (mode) for which the order vector is requested. All seriation algorithms are available via the function \func{seriate} defined as: \begin{quotation} \code{seriate(x, method = NULL, control = NULL, ...)} \end{quotation} where \code{x} is the input data, \code{method} is a string defining the seriation method to be used and \code{control} can contain a list with additional information for the algorithm. \func{seriate} returns an object of class \code{ser\_permutation} with a length conforming to the number of dimensions of~\code{x}. Typical input data are a dissimilarity matrix (class~\code{dist}; see package \pkg{stats} for more information) for one-mode two-way data, \code{matrix} for two-mode two-way data and \code{array} for $k$-mode $k$-way data. For \code{matrix} and \code{array} the additional argument \code{margin} can be used to restrict the dimensions which should be seriated (e.g., with \code{margin = 1} only the first dimension, i.e., the columns of a matrix, are seriated). %\begin{landscape} \begin{table}[tp] \centering \begin{tabular}{p{5cm}p{3cm}p{4cm}l} \hline Algorithm & \code{method} & Optimizes & Input data \\ \hline Simulated annealing & \code{"ARSA"} & Linear seriation crit.&\code{dist} \\ Branch-and-bound & \code{"BBURCG"} & Gradient measure &\code{dist} \\ Branch-and-bound & \code{"BBWRCG"} & Gradient measure (weighted)& \code{dist} \\ TSP solver & \code{"TSP"} & Hamiltonian path length& \code{dist} \\ Optimal leaf ordering & \code{"OLO"} \code{"OLO_single"} \code{"OLO_average"} \code{"OLO_complete"} & Hamiltonian path length (restricted)& \code{dist} \\ Gruvaeus and Wainer & \code{"GW"} \code{"GW_single"} \code{"GW_average"} \code{"GW_complete"} & Hamiltonian path length (restricted) & \code{dist} \\ MDS & \code{"MDS"} \code{"MDS_metric"} \code{"MDS_nonmetric"} \code{"MDS_angle"} & Least square crit.& \code{dist} \\ Spectral seriation & \code{"Spectral"} \code{"Spectral_norm"} & 2-Sum crit. & \code{dist} \\ QAP & \code{"QAP_2SUM"} & 2-Sum crit. & \code{dist} \\ & \code{"QAP_LS"} & Linear seriation crit. & \code{dist} \\ & \code{"QAP_BAR"} & Banded AR form & \code{dist} \\ & \code{"QAP_Inertia"} & Inertia crit. & \code{dist} \\ Genetic Algorithm & \code{"GA"}* & various & \code{dist} \\ DendSer & \code{"DendSer"}* & various & \code{dist} \\ Hierarchical clustering & \code{"HC"} \code{"HC_single"} \code{"HC_average"} \code{"HC_complete"} & Other& \code{dist} \\ Rank-two ellipse seriation & \code{"R2E"} & Other& \code{dist} \\ Sorting Points Into Neighborhoods & \code{"SPIN_NH"} \code{"SPIN_STS"} & Other& \code{dist} \\ Visual Assessment of (Clustering) Tendency & \code{"VAT"}& Other& \code{dist} \\ \hline Bond Energy Algorithm & \code{"BEA"} & Measure of effectiveness & \code{matrix} \\ TSP to optimize ME & \code{"BEA\_TSP"} & Measure of effectiveness& \code{matrix} \\ Principal component analysis& \code{"PCA"} \code{"PCA_angle"}& Least square crit.& \code{matrix} \\ \hline \end{tabular} \caption{Currently implemented methods for \func{seriation} (* methods need to be registered).} \label{tab:methods} \end{table} %\end{landscape} Various seriation methods were already introduced in this paper in Section~\ref{sec:methods}. In Table~\ref{tab:methods} we summarize the methods currently available in the package for seriation. The code for the simulated annealing heuristic~\citep{seriation:Brusco:2007} and the two branch-and-bound implementations~\citep{seriation:Brusco:2005} was obtained from the authors. The TSP solvers (exact solvers and a variety of heuristics) is provided by package \pkg{TSP}~\citep{seriation:Hahsler:2007, seriation:Hahsler:2007b}. For optimal leaf ordering we implemented the algorithm by~\cite{seriation:Bar-Joseph:2001}. The BEA code was kindly provided by Fionn Murtagh. For the Gruvaeus and Wainer algorithm, the implementation in package \pkg{gclus}~\citep{seriation:Hurley:2007} is used. For the rank-two ellipse seriation we implemented the algorithm by~\cite{seriation:Chen:2002}. Spectral seriation is described by~\cite{seriation:Ding:2004}. Note that some methods implemented (e.g., the rank-two ellipse seriation) do not fall within the combinatorial optimization framework of this paper and thus are not dealt with here in detail. They are included in the package since they can be useful for various applications. A detailed empirical comparison of seriation methods and crieria can be found in the study by \cite{hahsler:Hahsler2016d}. %Over time more methods will be %added to the package. To calculate the value of a loss/merit function for data and a certain permutation, the function \begin{quotation} \code{criterion(x, order = NULL, method = NULL, ...)} \end{quotation} is provided. \code{x} is the data object, \code{order} contains a suitable object of class \code{ser\_permutation} (if omitted no permutation is performed) and \code{method} specifies the type of loss/merit function. A vector of several methods can be used resulting in a named vector with the values of the requested functions. If \code{method} is omitted (\code{method = NULL}), the values for all applicable loss/merit functions are calculated and returned. We already defined different loss/merit functions for seriation in Section~\ref{sec:seriation}. In Table~\ref{tab:criteria} we indicate the loss/merit functions currently available in the package. \begin{table}[t] \centering \begin{tabular}{llll} \hline Name & \code{method} & merit/loss & Input data \\ \hline Anti-Robinson events& \code{"AR\_events"} & loss & \code{dist} \\ Anti-Robinson deviations& \code{"AR\_deviations"} & loss & \code{dist} \\ Banded Anti-Robinson& \code{"BAR"} & loss & \code{dist} \\ Gradient measure& \code{"Gradient\_raw"} & merit & \code{dist} \\ Gradient measure (weighted)& \code{"Gradient\_weighted"} & merit & \code{dist} \\ Hamiltonian path length & \code{"Path\_length"} & loss & \code{dist} \\ Inertia criterion& \code{"Inertia"} & merit & \code{dist} \\ Least squares criterion& \code{"Least\_squares"} & loss & \code{dist} \\ Linear Seriation criterion& \code{"LS"} & loss & \code{dist} \\ 2-Sum criterion& \code{"2SUM"} & loss & \code{dist} \\ \hline Measure of effectiveness& \code{"ME"} & merit & \code{matrix} \\ Stress (Moore neighborhood)& \code{"Moore\_stress"} & loss & \code{matrix} \\ Stress (Neumann neighborhood)& \code{"Neumann\_stress"} & loss & \code{matrix} \\ \hline \end{tabular} \caption{Implemented loss/merit functions in function \func{criterion}.} \label{tab:criteria} \end{table} All methods for \func{seriate} and \func{criterion} are managed by a registry mechanism which makes the seriation framework easily extensible for users. For example, a new seriation method can be registered using \func{set\_seriation\_method} and then used in the same way as the built-in methods with \func{seriate}. All available methods in the registry can be viewed using \func{list\_seriation\_methods} and \func{show\_seriation\_methods}. For criterion methods, the same interface is available by just substituting `seriation' by `criterion' in the function names. An example for how to add new methods can be found in section~\ref{sec:registering} of this paper. In addition the package offers the (generic) function \begin{quotation} \code{permute(x, order)} \end{quotation} where \code{x} is the data (a \code{dist} object, a matrix, an array, a list or a numeric vector) to be reordered and \code{order} is a \code{ser\_permutation} object of suitable length. %The permutation for %\code{dist} objects uses package \pkg{proxy}~\citep{seriation:Meyer:2007}. For visualization, the package offers several options: \begin{itemize} \item Matrix shading with \func{pimage}. In contrast to the standard \func{image} in package~\pkg{graphics}, \func{pimage} displays the matrix as is with the first element in the top left-hand corner and using a gamma-corrected gray scale. \item Different heat maps (e.g., with optimally reordered dendrograms) with \func{hmap}. \item Visualization of data matrices in the spirit of~\cite{seriation:Bertin:1981} with \func{bertinplot}. \item \emph{Dissimilarity plot}, a new visualization to judge the quality of a clustering using matrix shading and seriation with \func{dissplot}. \end{itemize} We will introduce the package usage and the visualization options in the examples in the next section. \section{Examples and applications} \label{sec:example} We start this section with a simple first session to demonstrate the basic usage of the package. Then we present and discuss several seriation applications. \subsection{A first session using seriation} In the following example, we use the well known iris data set (from \proglang{R}'s \pkg{datasets} package) which gives the measurements in centimeters of the variables sepal length and width and petal length and width, respectively, for 50 flowers from each of 3 species of the iris family (Iris setosa, versicolor and virginica). First, we load the package \pkg{seriation} and the iris data set. We remove the species classification and reorder the objects randomly since they are already sorted by species in the data set. Then we calculate the Euclidean distances between objects. <>= set.seed(1234) @ <<>>= library("seriation") data("iris") x <- as.matrix(iris[-5]) x <- x[sample(seq_len(nrow(x))),] d <- dist(x) @ To seriate the objects given the dissimilarities, we just call \func{seriate} with the default settings. <<>>= o <- seriate(d) o @ The result is an object of class \code{ser\_permutation} for one-mode data. The permutation vector length is $150$ for the $150$ objects in the iris data set and the used seriation method is \code{"ARSA"}, a simulated annealing heuristic (see~Table~\ref{tab:methods}). The actual order can be accessed using \func{get\_order}. In the following we show the first 15 elements in the permutation vector. <<>>= head(get_order(o), 15) @ To visually inspect the effect of seriation on the distance matrix, we use matrix shading with \func{pimage} (the result is shown in Figure~\ref{fig:pimage1}). <>= pimage(d, main = "Random") @ <>= pimage(d, o, main = "Reordered") @ \begin{figure} \centering \includegraphics[width=7.5cm]{seriation-pimage1} \includegraphics[width=7.5cm]{seriation-pimage1-2} \caption{Matrix shading of the distance matrix for the iris data.} \label{fig:pimage1} \end{figure} We can also compare the improvement for different loss/merit functions using \func{criterion}. <<>>= cbind(random = criterion(d), reordered = criterion(d, o)) @ Naturally, the reordered dissimilarity matrix achieves better values for all criteria. Note that the gradient measures, inertia and the measure of effectiveness are merit functions and for these measures larger values are better (use \code{show\_criterion\_methods("dist")} to find out which measures are loss and merit functions). To visually compare the original data matrix and the result of seriation, we can also use \func{pimage}. We standardize the data using scale such that the visualized value is the number of standard diviations an object differs from the variable mean. For matrices containing negative values, \code{pimage} uses automatically a divergent palette. After using \func{pimage} for the original random data matrix, we create a suitable \code{ser\_permutation} object for the original two-mode data. Since the seriation above only produced an order for the rows of the data, we add an identity permutation vector for the columns (represented by \code{NA}) to the permutations object using the combine function \func{c}. This new permutation object for $2$-mode data is used for displaying the reordered scaled data. The two plots are shown in Figure~\ref{fig:pimage2}. <>= pimage(scale(x), main = "Random") @ <>= o_2mode <- c(o, NA) pimage(scale(x), o_2mode, main = "Reordered") @ \begin{figure} \centering \includegraphics[width=7.5cm]{seriation-pimage2} \includegraphics[width=7.5cm]{seriation-pimage2-2} \caption{Matrix shading of the iris data matrix.} \label{fig:pimage2} \end{figure} \subsection{Comparing different seriation methods} To compare different seriation methods we use again the randomized iris data set and the distance matrix \code{d} from the previous example. We include in the comparison several seriation methods for dissimilarity matrices described in Section~\ref{sec:methods}. <<>>= methods <- c("TSP","R2E", "ARSA", "HC", "GW", "OLO") o <- sapply(methods, FUN = function(m) seriate(d, m)) @ <>= timing <- sapply(methods, FUN = function(m) system.time(seriate(d, m)), simplify = FALSE) @ \begin{table} \centering \begin{tabular}{lcccccc} \hline Seriation Method & \Sexpr{methods[1]}& \Sexpr{methods[2]}& \Sexpr{methods[3]}& \Sexpr{methods[4]}& \Sexpr{methods[5]}& \Sexpr{methods[6]} \\ \hline Execution time [sec] & \Sexpr{round(timing[[methods[1]]][1],4)}& \Sexpr{round(timing[[methods[2]]][1],4)}& \Sexpr{round(timing[[methods[3]]][1],4)}& \Sexpr{round(timing[[methods[4]]][1],4)}& \Sexpr{round(timing[[methods[5]]][1],4)}& \Sexpr{round(timing[[methods[6]]][1],4)}\\ \hline \end{tabular} %%% fix me: for the vignette we need something else \caption{Execution time of seriation of the iris data set for different methods.} \label{tab:timings} \end{table} Table~\ref{tab:timings} contains the execution times for running seriation with the different methods. Except for the simulated annealing method (ARSA) the seriation only takes a fraction of a second. The direction of the resulting orderings is first normalized (aligned) and then the orderings are displayed using matrix shading (see Figure~\ref{fig:pimage3}). <>= o <- ser_align(o) for(s in o) pimage(d, s, main = get_method(s), key = FALSE) @ <>= o <- ser_align(o) for(i in 1:length(o)) { pdf(file=paste("seriation-pimage_comp_", i , ".pdf", sep="")) pimage(d, o[[i]], main = get_method(o[[i]]), key = FALSE) dev.off() } @ \begin{figure} \centering \includegraphics[width=.3\linewidth]{seriation-pimage_comp_1.pdf} \includegraphics[width=.3\linewidth]{seriation-pimage_comp_2.pdf} \includegraphics[width=.3\linewidth]{seriation-pimage_comp_3.pdf}\\ \includegraphics[width=.3\linewidth]{seriation-pimage_comp_4.pdf} \includegraphics[width=.3\linewidth]{seriation-pimage_comp_5.pdf} \includegraphics[width=.3\linewidth]{seriation-pimage_comp_6.pdf} \caption{Image plot of the distance matrix for the iris data using rearrangement by different seriation methods.} \label{fig:pimage3} \end{figure} The first row of matrices in Figure~\ref{fig:pimage3} contains the orders obtained by a TSP solver the rank-two ellipse seriation by Chen and using the simulated annealing method (ARSA). The results of Chen and ARSA are very similar (except that the order is reversed). The TSP solver produces a smoother image with some lighter lines visible. The reason for these lines is that the TSP only optimizes distances locally between two neighboring objects. Therefore it is possible that in a quite homogeneous block several objects are enclosed gradually getting more different and then getting more similar again (see, e.g., the light line close to the upper left corner of the TSP image in Figure~\ref{fig:pimage3}). The second row of Figure~\ref{fig:pimage3} contains three images based on hierarchical clustering. The visual impression gets better from left (just hierarchical clustering) to right (first using the Gruvaeus Wainer heuristic and then optimal leaf ordering to rearrange the branches of the dendrogram obtained by hierarchical clustering). The most striking feature in the image for hierarchical clustering (HC in Figure~\ref{fig:pimage3}) is the distinct cross going right through the center of the plot. This indicates that several relatively dissimilar objects are caught in an otherwise homogeneous block. This effect vanishes after rearranging the dendrogram branches (see GW and OLO in Figure~\ref{fig:pimage3}). %' To investigate this effect, %' we plot the dendrogram obtained by hierarchical clustering which is used %' to order the objects and compare it to the dendrogram rearranged %' using the Gruvaeus Wainer heuristic. %' %' <>= %' plot(o[["HC"]], labels = FALSE, main = "Dendrogram HC") %' plot(o[["GW"]], labels = FALSE, main = "Dendrogram GW") %' @ %' <>= %' def.par <- par(no.readonly = TRUE) %' pdf(file="seriation-pimage3_dendrogram.pdf", width=9, height=4) %' layout(t(1:2)) %' plot(o[["HC"]], labels = FALSE, main = "Dendrogram HC") %' symbols(74.7,.5, rect = matrix(c(4, 3), ncol=2), add= TRUE, %' inches = FALSE, lwd =2) %' %' plot(o[["GW"]], labels = FALSE, main = "Dendrogram GW") %' symbols(98.7,.5, rect = matrix(c(4, 3), ncol=2), add= TRUE, %' inches = FALSE, lwd =2) %' par(def.par) %' tmp <- dev.off() %' @ %' %' \begin{figure} %' \centering %' \includegraphics[width=\linewidth, trim=0 80 0 0, clip=TRUE]{seriation-pimage3_dendrogram} %' \caption{Dendrograms for the seriation with HC and GW.} %' \label{fig:pimage3_dendrogram} %' \end{figure} %' %' Comparing the two dendrograms in Figure~\ref{fig:pimage3_dendrogram}, we see %' that the branch left from the top is almost unchanged. The branch which is %' responsible for the light cross in the shaded image is highlighted by a box. %' The Gruvaeus Wainer heuristic rotates the highlighted branch towards the right %' since the objects in it are more similar to the objects in there. Finally, we compare the values of the loss/merit functions for the different seriation methods. <<>>= crit <- sapply(o, FUN = function(x) criterion(d, x)) t(crit) @ <>= def.par <- par(no.readonly = TRUE) m <- c("Path_length", "AR_events", "Moore_stress") layout(matrix(seq_along(m), ncol=1)) #tmp <- apply(crit[m,], 1, dotchart, sub = m) tmp <- lapply(m, FUN = function(i) dotchart(crit[i,], sub = i)) par(def.par) @ \begin{figure} \centering \includegraphics[width=14cm]{seriation-crit1} \caption{Comparison of different methods and seriation criteria} \label{fig:crit1} \end{figure} For easier comparison, Figure~\ref{fig:crit1} contains a plot of the criteria Hamiltonian path length, anti-Robinson events (\code{AR\_events}) and stress using the Moore neighborhood. Clearly, the methods which directly try to minimize the Hamiltonian path length (hierarchical clustering with optimal leaf ordering (\code{OLO}) and the TSP heuristic) provide the best results concerning the path length. For the number of anti-Robinson events, using the simulated annealing heuristic (\code{ARSA}) provides the best result. Regarding stress, the simulated annealing heuristic also provides the best result although, it does not directly minimize this loss function. \subsection{Registering new methods} \label{sec:registering} New methods to calculate criterion values and to compute a seriation can be easily added by the user via the method registry mechanism provided in \pkg{seriation}. Here we give a simple example of how to implement and register a new seriation method. In the registry we distinguish between methods for different types of input data. With the following two commands we produce a short overview of the the first few available seriation methods for input data of class \code{dist} and \code{matrix}. <<>>= show_seriation_methods("dist")[1:3] show_seriation_methods("matrix")[1:3] @ The overview is intended to make it convenient for the user to choose an appropriate method. It contains the name of the method used as the \code{method} argument for \func{seriate} and a short description. To get just the names the following function is also available: <<>>= list_seriation_methods("dist") @ To add a new seriation method, we first have to implement the seriation code as a function with the two formal arguments \code{x} and \code{control}. \code{x} is the data object and \code{control} contains a list with additional information for the method passed on from \func{seriate}. The function has to return a list of objects which can be coerced into \code{ser\_permutation\_vector} objects (e.g., a list of integer vectors). The elements in the list have to be in order corresponding to the dimensions of \code{x}. In this example we just create a method to return a permutation which reverses the original order of the objects, i.e., which returns the reverse identity order. <<>>= seriation_method_reverse <- function(x, control = NULL) { lapply(dim(x), function(n) rev(seq(n))) } @ The function produces integer sequences of the correct lengths, one for each dimension of \code{x} (\code{control} is not used). Since the function works for \code{matrix} and \code{array} we can register it for both data types under the short name `Reverse'. <<>>= set_seriation_method("matrix", "Reverse", seriation_method_reverse, "Reverse identity order") set_seriation_method("array", "Reverse", seriation_method_reverse, "Reverse identity order") @ Now the new seriation method is registered and can be found by the user and applied to data. <<>>= show_seriation_methods("matrix") o <- seriate(matrix(1, ncol=3, nrow=4), "reverse") o get_order(o, 1) get_order(o, 2) @ Criterion methods can be added in the same way. We refer the interested reader to the documentation accompanying the package for detailed information and an example. If you have implemented a new criterion or seriation method, please consider submitting the code to one of the maintainers of \pkg{seriation} for inclusion in a future release of the package. \subsection{Heat maps} A heat map is a shaded/color coded data matrix with a dendrogram added to one side and to the top to indicate the order of rows and columns. Typically, reordering is done according to row or column means within the restrictions imposed by the dendrogram. Heat maps recently became popular for visualizing large scale genome expression data obtained via DNA microarray technology \citep[see, e.g.,][]{seriation:Eisen:1998}. From Section~\ref{sec:hierarchical_clustering} we know that it is possible to find the optimal ordering of the leaf nodes of a dendrogram which minimizes the distances between adjacent objects in reasonable time. Such an order might provide an improvement over using simple reordering such as the row or column means with respect to presentation. In \pkg{seriation} we provide the function \func{hmap} which uses optimal ordering and can also use seriation directly on distance matrices without using hierarchical clustering to produce dendrograms first. For the following example, we use again the randomly reordered iris data set \code{x} from the examples above. To make the variables (columns) comparable, we use standard scaling. <<>>= x <- scale(x, center = FALSE) @ To produce a heat map with optimally reordered dendrograms (using by default Optimal Leaf Ordering), the function \func{hmap} can be used with its default settings. <>= hmap(x, margin =c(7, 4), cexCol=1, labRow = FALSE) @ With these settings, the Euclidean distances between rows and between columns are calculated (with \func{dist}), hierarchical clustering (\func{hclust}) is performed, the resulting dendrograms are optimally reordered, and \func{heatmap.2} in package \pkg{gplots} is used for plotting (see Figure~\ref{fig:heatmap}(a) for the resulting plot). <>= hmap(x, method = "MDS") @ If a seriation method is used that does not depend on dendrograms, instead of hierarchical clustering, seriation on the dissimilarity matrices for rows and columns is performed and the reordered matrix with the reordered dissimilarity matrices to the left and on top is displayed (see Figure~\ref{fig:heatmap}(b)). A \code{method} argument can be used to choose different seriation methods. <>= #bitmap(file = "seriation-heatmap1.png", type = "pnggray", # height = 6, width = 6, res = 300, pointsize=14) pdf(file = "seriation-heatmap1.pdf") hmap(x, margin = c(7, 4), labRow = FALSE, cexCol=1) tmp <- dev.off() @ <>= pdf(file = "seriation-heatmap2.pdf") hmap(x, method="MDS") tmp <- dev.off() @ \begin{figure} \begin{minipage}[b]{.48\linewidth} \centering \includegraphics[width=\linewidth]{seriation-heatmap1} \\ (a) \end{minipage} \begin{minipage}[b]{.48\linewidth} \centering \includegraphics[width=\linewidth]{seriation-heatmap2} \\ (b) \end{minipage} \caption{Two presentations of the rearranged iris data matrix. (a) as an optimally reordered heat map and (b) as a seriated data matrix with reordered dissimilarity matrices to the left and on top.} \label{fig:heatmap} \end{figure} \subsection{Bertin's permutation matrix} \cite{seriation:Bertin:1981,seriation:Bertin:1999} introduced permutation matrices to analyze multivariate data with medium to low sample size. The idea is to reveal a more homogeneous structure in a data matrix~$\mathbf{X}$ by simultaneously rearranging rows and columns. The rearranged matrix is displayed and cases and variables can be grouped manually to gain a better understanding of the data. %To quantify homogeneity, a purity function %\begin{displaymath} % \phi = \Phi(\mathbf{X}) %\end{displaymath} %is defined. Let $\Pi$ be the set of all permutation functions %$\pi$ for matrix $\mathbf{X}$. %Note that function $\pi$ performs row and column permutations on a matrix. %The optimal permutation with respect to %purity can be found by %\begin{displaymath} % \pi^* = \argmax\nolimits_{\pi \in \Pi} \Phi(\pi(\mathbf{X})). %\end{displaymath} %Since, depending on the purity function, finding the optimal %solution can be hard, often a near optimal solution is also acceptable %for visualization. % %A possible purity function $\Phi$ is: %Given distances between rows and columns of the data matrix, define purity as %the sum of distances of adjacent rows/columns. Using this purity function, %finding the optimal permutation $\pi^*$ means solving two (independent) TSPs, %one for the columns and one for the rows. To find a rearrangement of columns and rows which reveals structure a purity function is used. A possible purity function is: Given distances between rows and columns of the data matrix, define purity as the sum of distances of adjacent rows/columns. Using this purity function, finding the optimal permutation means solving two (independent) TSPs, one for the columns and one for the rows which can be done very conveniently using the infrastructure provided by \pkg{seriation}. As an example, we use the results of $8$ constitutional referenda for $41$ Irish communities~\citep{seriation:Falguerolles:1997}\footnote{The Irish data set is included in this package. The original data and the text of the referenda can be obtained from~\url{http://www.electionsireland.org/}}. To make values comparable across columns (variables), the ranks of the values for each variable are used instead of the original values. <<>>= data("Irish") orig_matrix <- apply(Irish[,-6], 2, rank) @ For seriation, we calculate distances between rows and between columns using the sum of absolute rank differences (this is equal to the Minkowski distance with power $1$). Then we apply seriation (using a TSP heuristic) to both distance matrices and combine the two resulting \code{ser\_permutation} objects into one object for two-mode data. The original and the reordered matrix are plotted using \func{bertinplot}. <<>>= o <- c( seriate(dist(orig_matrix, "minkowski", p = 1), method ="TSP"), seriate(dist(t(orig_matrix), "minkowski", p = 1), method = "TSP") ) o @ <>= bertinplot(orig_matrix) bertinplot(orig_matrix, o) @ <>= bertinplot(orig_matrix) @ <>= bertinplot(orig_matrix, o) @ \begin{figure} \centering \includegraphics[width=15cm, trim=60 60 0 0]{seriation-bertin1} \\ (a) \includegraphics[width=15cm, trim=60 60 0 0]{seriation-bertin2} \\ (b) \caption{Bertin plot for the (a) original arrangement and the (b) reordered Irish data set.} \label{fig:bertin} \end{figure} The original matrix and the rearranged matrix are shown in Figure~\ref{fig:bertin} as a matrix of bars where high values are highlighted (filled blocks). Note that following Bertin, the cases (communities) are displayed as the columns and the variables (referenda) as rows. Depending on the number of cases and variables, columns and rows can be exchanged to obtain a better visualization. Although the columns are already ordered (communities in the same city appear consecutively) in the original data matrix in Figure~\ref{fig:bertin}(a), it takes some effort to find structure in the data. For example, it seems that the variables `Marriage', `Divorce', `Right to Travel' and `Right to Information' are correlated since the values are all high in the block made up by the columns of the communities in Dublin. The reordered matrix confirms this but makes the structure much more apparent. Especially the contribution of low values (which are not highlighted) to the overall structure becomes only visible after rearrangement. \subsection{Binary data matrices} Binary or $0$-$1$ data matrices are quite common. Often such matrices are called \emph{incidence matrices} since a $1$ in a cell indicates the incidence of an event. In archeology such an event could be that a special type of artifact was found at a certain archaeological site. This can be seen as a simplification of a so-called \emph{abundance matrix} which codes in each cell the (relative) frequency or quantity of an artifact type at a site. See \cite{seriation:Ihm:2005} for a comparison of incidence and abundance matrices in archeology. Here we are interested in binary data. For the example we use an artificial data set from~\cite{seriation:Bertin:1981} called \emph{Townships}. The data set contains $9$ binary characteristics (e.g., has a veterinary or has a high school) for $16$ townships. The idea of the data set is that townships evolve from a rural to an urban environment over time. After loading the data set (which comes with the package), we use \func{bertinplot} to visualize the data (\func{pimage} could also be used but \func{bertinplot} allows for a nicer visualization). Bars, the standard visualization of \func{bertinplot}, do not make much sense for binary data. We therefore use the panel function \func{panel.squares} without spacing to plot black squares. <>= data("Townships") bertinplot(Townships, options = list(panel=panel.squares, spacing = 0, frame = TRUE)) @ The original data in Figure~\ref{fig:binary}(a) does not reveal structure in the data. To improve the display, we run the bond energy algorithm (BEA) for columns and rows $10$ times with random starting points and report the best solution. <>= ## to get consistent results set.seed(5) @ <>= o <- seriate(Townships, method = "BEA", control = list(rep = 10)) bertinplot(Townships, o, options = list(panel=panel.squares, spacing = 0, frame = TRUE)) @ The reordered matrix is displayed in Figure~\ref{fig:binary}(b). A clear structure is visible. The variables (rows in a Bertin plot) can be split into the three categories describing different evolution states of townships: \begin{enumerate} \item Rural: No doctor, one-room school and possibly also no water supply \item Intermediate: Land reallocation, veterinary and agricultural cooperative \item Urban: Railway station, high school and police station \end{enumerate} The townships also clearly fall into these three groups which tentatively can be called villages (first~$7$), towns (next~5) and cities (final~2). The townships B and C are on the transition to the next higher group. \begin{figure} \centering \includegraphics[width=12cm, trim=0 40 0 30]{seriation-binary1} \\ (a) \includegraphics[width=12cm, trim=0 40 0 30]{seriation-binary2} \\ (b) \caption{The townships data set in original order (a) and reordered using BEA (b).} \label{fig:binary} \end{figure} <<>>= rbind(original = criterion(Townships), reordered = criterion(Townships, o)) @ BEA tries to maximize the measure of effectiveness which is much higher in the reordered matrix (in fact, 65 is the maximum for the data set). Also the two types of stress are improved significantly. \subsection{Dissimilarity plot} Assessing the quality of an obtained cluster solution has been a research topic since the invention of cluster analysis. This is especially important since all popular cluster algorithms produce a clustering even for data without a ``cluster'' structure. %A method to judge the quality of a cluster solution is by inspecting a %visualization. For hierarchical clustering %dendrogramms~\cite{seriation:Hartigan:1967} are available which show the %hierarchical structure of the clustering as a binary tree and cluster quality %can be judged by looking at the dissimilarities between objects in a cluster %and objects in other clusters. However, such a visualization is %only possible for heirarchical/nested clusterings. % %\marginpar{Cite Pison et al 1999 and Kaufmann and Rousseeuw} %For the an arbitrary partitional clustering, the original objects can %be displayed in a 2 dimensional scatter plot %after using dimensionality reduction (e.g., PCA, MDS). %Objects belonging to the same cluster can be marked and thus, if the %dimensionality reduction preserves a large proportion of the %variavility in the original data, the separation between clusters can be %visually judged. % %Silhouettes Matrix shading is an old technique to visualize clusterings by displaying the rearranged matrices~\citep[see, e.g.,][]{seriation:Sneath:1973,seriation:Ling:1973,seriation:Gale:1984}. Initially matrix shading was used in connection with hierarchical clustering, where the order of the dendrogram leaf nodes was used to arrange the matrix. However, with some extensions, matrix shading can also be used with any partitional clustering method. \cite{seriation:Strehl:2003} suggest a matrix shading visualization called \emph{CLUSION} where the dissimilarity matrix is arranged such that all objects pertaining to a single cluster appear in consecutive order in the matrix. The authors call this \emph{coarse seriation}. The result of a ``good'' clustering should be a matrix with low dissimilarity values forming blocks around the main diagonal. However, using coarse seriation, the order of the clusters has to be predefined and the objects within each cluster are unordered. The dissimilarity plots implemented by the function \func{dissplot} in \pkg{seriation} improve \emph{CLUSION} using seriation methods. It aims at visualizing global structure (similarity between different clusters is reflected by their position relative to each other) as well as the micro structure within each cluster (position of objects). To position the clusters in the dissimilarity plot, an inter-cluster dissimilarity matrix is calculated using the average between cluster dissimilarities. \func{seriate} is used on this inter-cluster dissimilarity matrix to arrange the clusters relative to each other resulting in on average more similar clusters to appear closer together in the plot. Within each cluster, \func{seriate} is used again on the sub-matrix of the dissimilarity matrix concerning only the objects in the cluster. For the example, we use again Euclidean distance between the objects in the iris data set. <<>>= data("iris") iris <- iris[sample(seq_len(nrow(iris))),] d <- dist(as.matrix(iris[-5]), method = "euclidean") @ First, we use \func{dissplot} without a clustering. We set \code{method} to \code{NA} to prevent reordering and display the original matrix (see Figure~\ref{fig:dissplot1}(a)). Then we omit the method argument which results in using the default seriation technique from \func{seriate}. Since we did not provide a clustering, the whole matrix is reordered in one piece. From the result shown in Figure~\ref{fig:dissplot1}(b) it seems that there is a clear structure in the data which suggests a two cluster solution. <>= ## plot original matrix dissplot(d, method = NA) @ <>= ## plot reordered matrix dissplot(d, options = list(main = "Dissimilarity plot with seriation")) @ <>= pdf(file = "seriation-dissplot1.pdf") <> tmp <- dev.off() pdf(file = "seriation-dissplot2.pdf") <> tmp <- dev.off() @ \begin{figure} \begin{minipage}[b]{.48\linewidth} \centering \includegraphics[width=\linewidth]{seriation-dissplot1} \\ (a) \end{minipage} \begin{minipage}[b]{.48\linewidth} \centering \includegraphics[width=\linewidth]{seriation-dissplot2} \\ (b) \end{minipage} \caption{Two dissimilarity plots. (a) the original dissimilarity matrix and (b) the seriated dissimilarity matrix.} \label{fig:dissplot1} \end{figure} Next, we create a cluster solution using the $k$-means algorithm. Although we know that the data set should contain $3$ groups representing the three species of iris, we let $k$-means produce a $10$ cluster solution to study how such a misspecification can be spotted using \func{dissplot}. <>= set.seed(1234) @ <<>>= l <- kmeans(d, 10)$cluster #$ @ We create a standard dissimilarity plot by providing the cluster solution as a vector of labels. The function rearranges the matrix and plots the result. Since rearrangement can be a time consuming procedure for large matrices, the rearranged matrix and all information needed for plotting is returned as the result. <>= res <- dissplot(d, labels = l, options = list(main = "Dissimilarity plot - standard")) @ <>= pdf(file = "seriation-dissplot3.pdf") ## visualize the clustering <> tmp <- dev.off() pdf(file = "seriation-dissplot4.pdf") ## threshold plot(res, options = list(main = "Dissimilarity plot - threshold", threshold = 1.5)) tmp <- dev.off() @ \begin{figure} \centering \includegraphics[width=10cm]{seriation-dissplot3}\\ (a) \includegraphics[width=10cm]{seriation-dissplot4}\\ (b) \caption{Dissimilarity plot for $k$-means solution with 10 clusters. (a) standard plot and (b) plot with threshold.} \label{fig:dissplot3} \end{figure} <<>>= res @ The resulting plot is shown in Figure~\ref{fig:dissplot3}(a). The inter-cluster dissimilarities are shown as solid gray blocks and the average object dissimilarity within each cluster as gray triangles below the main diagonal of the matrix. Since the clusters are arranged such that more similar clusters are closer together, it is easy to see in Figure~\ref{fig:dissplot3}(a) that clusters 6, 3 and 1 as well as clusters 10, 9, 5, 7, 8, 4 and 2 are very similar and form two blocks. This suggests again that a two cluster solution would be reasonable. Since slight variations of gray values are hard to distinguish, we plot the matrix again (using \func{plot} on the result above) and use a threshold on the dissimilarity to suppress high dissimilarity values in the plot. <>= plot(res, options = list(main = "Seriation - threshold", threshold = 1.5)) @ In the resulting plot in Figure~\ref{fig:dissplot3}(b), we see that the block containing 10, 9, 5, 7, 8, 4 and 2 is very well defined and cleanly separated from the other block. This suggests that these clusters should form together a cluster in a solution with less clusters. The other block is less well defined. There is considerable overlap between clusters 6 and 3, but also cluster 3 and 1 share similar objects. Using the information stored in the result of \func{dissplot} and the class information available for the iris data set, we can analyze the cluster solution and the interpretations of the dissimilarity plot. <<>>= #names(res) table(iris[res$order, 5], res$label)[,res$cluster_order] #$ @ As the plot in Figure~\ref{fig:dissplot3} indicated, the clusters 10, 9, 5, 7, 8, 4 and 2 should be a single cluster containing only flowers of the species Iris setosa. The clusters 6, 3 and 1 are more problematic since they contain a mixture of Iris versicolor and virginica. To illustrate the results of the dissimilarity plot in case a clustering with a $k$ smaller than the actual number of groups in the data is used, we use the Ruspini data set which consists of 75 points in four groups and is also often used to illustrate clustering techniques. We load the data set, calculate distances, perform $k$-means clustering with $k=3$ (although the real number of groups is 4) and produce a dissimilarity plot. <>= data("ruspini", package="cluster") d <- dist(ruspini) l <- kmeans(d, 3)$cluster dissplot(d, labels = l) @ \begin{figure} \centering \includegraphics[width=10cm]{seriation-ruspini}\\ \caption{Dissimilarity plot for $k$-means solution with 3 clusters for the Ruspini data set with 4 groups.} \label{fig:ruspini} \end{figure} The dissimilarity plot in Figure~\ref{fig:ruspini} shows that cluster 3 actually should be two separate clusters represented by the two clearly visible darker triangles next to the main diagonal. The dissimilarity plot using seriation is a useful tool to inspect the result of clustering. It is especially useful to spot misspecifications of the number of clusters employed. A more detailed treatment of dissimilarity plots as a tool for exploring partitional clustering can be found in \cite{seriation:Hahsler+Kornik:2011}. \section{Conclusion} \label{sec:conclusion} In this paper we presented the infrastructure provided by the package~\pkg{seriation}. The infrastructure contains the necessary data structures to store the linear order for one-, two- and $k$-mode data. It also provides a wide array of seriation methods for different input data, e.g., dissimilarities, binary and general data matrices focusing on combinatorial optimization. New seriation methods can be easily incorporated into the \pkg{seriation} framework by the user with the method registry mechanism provided. Based on seriation, \pkg{seriation} features several visualization techniques. In particular, the optimally reordered heat map, the Bertin plot and the dissimilarity plot present clear improvements over standard plots. A natural extension to \pkg{seriation} is the synthesis of ensembles of seriations into a ``consensus'' one. Such ensembles do not only arise when using different seriation methods, but also when varying data or control parameters to obtain more robust solutions (see e.g.~\cite{seriation:Jurman:2008} for a recent application of such ideas in a molecular profiling context). The \proglang{R}~extension package \pkg{relations}~\citep{seriation:Hornik+Meyer:2008} contains a variety of methods for obtaining consensus \emph{relations}, covering consensus seriation (where the relations are linear orders on the objects) as a special case. Future work on \pkg{seriation} will focus on adding further seriation methods, such as for example methods for higher dimensional arrays and methods for block seriation which aim at finding simultaneous partitions of rows and columns in a data matrix~\citep[see, e.g.,][]{seriation:Marcotorchino:1987}. \section*{Acknowledgments} The authors would like to thank Michael Brusco, Hans-Friedrich K{\"o}hn and Stephanie Stahl for their seriation code, Fionn Murtagh for his BEA implementation and the anonymous reviewers for their valuable comments and suggestions. % %\bibliographystyle{abbrvnat} \bibliography{seriation} % \end{document} seriation/inst/CITATION0000644000176200001440000000117213422436662014372 0ustar liggesusers citation(auto = meta) bibentry(bibtype = "article", title = paste("Getting things in order: ", "An introduction to the R package seriation"), author = { personList(person("Michael", "Hahsler", email = "michael@hahsler.net"), person("Kurt", "Hornik", email = "Kurt.Hornik@R-project.org"), person("Christian", "Buchta", email = "Christian.Buchta@wu.ac.at")) }, year = 2008, journal = "Journal of Statistical Software", volume = 25, number = 3, pages = "1--34", url = "http://www.jstatsoft.org/v25/i03/", month = "March", issn = "1548-7660" )